diff --git a/C11-FrontEnd/C_Appendices.thy b/C11-FrontEnd/C_Appendices.thy deleted file mode 100644 index 29c1d8b87a2c05dba548768e4d4c8b39aaf203b5..0000000000000000000000000000000000000000 --- a/C11-FrontEnd/C_Appendices.thy +++ /dev/null @@ -1,396 +0,0 @@ -(****************************************************************************** - * Generation of Language.C Grammar with ML Interface Binding - * - * Copyright (c) 2018-2019 Université Paris-Saclay, Univ. Paris-Sud, France - * - * 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 C_Appendices - imports C_examples.C1 - C_Conclusion - "~~/src/Doc/Isar_Ref/Base" -begin -(*>*) - -section \<open>Architecture of Isabelle/C\<close> - -text \<open> -\<^dir>\<open>copied_from_git\<close> represents the location of -external libraries needed by the C parser at run-time. At the time of -writing, it only contains -\<^dir>\<open>copied_from_git/mlton\<close>, and more specifically -\<^dir>\<open>copied_from_git/mlton/lib/mlyacc-lib\<close>. All -files in this last folder are solely used by -\<^theory>\<open>C.C_Parser_Language\<close>. The rest has been copied -from the original repository of MLton -\<^footnote>\<open>\<^url>\<open>https://github.com/MLton/mlton\<close> -and \<^url>\<open>https://gitlri.lri.fr/ftuong/mlton\<close>\<close>. -\<close> - -text \<open> -The purpose of \<^dir>\<open>generated\<close> is to host generated -files, which are necessary for a first boot of the front-end. A major -subset of these files can actually be seen as superfluous, i.e., in -theory a simpler loading of a ``root un-generated file'' (generating -these files) would suffice, using for instance -\<^theory_text>\<open>code_reflect\<close>. However certain generators -are not written in a pure ML form (or are not yet automatically seen -as being translated to ML), so some manual steps of decomposition and -static generation was undertaken. In more detail: - - \<^item> \<^file>\<open>generated/c_ast.ML\<close> contains the - Abstract Syntax Tree of C, which is loaded by - \<^theory>\<open>C.C_Ast\<close>. - - \<^item> \<^file>\<open>generated/c_grammar_fun.grm\<close> is a - generated file not used by the project, except for further - generating \<^file>\<open>generated/c_grammar_fun.grm.sig\<close> - and \<^file>\<open>generated/c_grammar_fun.grm.sml\<close>, or - informative documentation purposes. It represents the basis point of - our SML grammar file, generated by an initial Haskell grammar file - (namely - \<^url>\<open>https://github.com/visq/language-c/blob/master/src/Language/C/Parser/Parser.y\<close>). - - In short, it has to be compiled with a modified version of ML-Yacc, - included in MLton itself - (\<^url>\<open>https://gitlri.lri.fr/ftuong/mlton\<close>). - - \<^item> \<^file>\<open>generated/c_grammar_fun.grm.sig\<close> - and \<^file>\<open>generated/c_grammar_fun.grm.sml\<close> are - generated using the process described above. - -\<close> - -section \<open>Case study: mapping on the parsed AST\<close> - -text \<open> In this section, we give a concrete example of a situation where one is interested to -do some automated transformations on the parsed AST, such as changing the type of every encountered -variables from \<open>int\<close> to \<open>array int\<close>. The main theory of interest here is -\<^theory>\<open>C.C_Parser_Language\<close>, where the C grammar is loaded, in contrast to -\<^theory>\<open>C.C_Lexer\<close> which is only dedicated to build a list of C tokens. As another -example, \<^theory>\<open>C.C_Parser_Language\<close> also contains the portion of the code -implementing the report to the user of various characteristics of encountered variables during -parsing: if a variable is bound or free, or if the declaration of a variable is made in the global -topmost space or locally declared in a function. \<close> - -subsection \<open>Prerequisites\<close> - -text \<open> Even if \<^file>\<open>generated/c_grammar_fun.grm.sig\<close> and -\<^file>\<open>generated/c_grammar_fun.grm.sml\<close> are files written in ML syntax, we have -actually modified \<^dir>\<open>copied_from_git/mlton/lib/mlyacc-lib\<close> in such a way that -at run time, the overall loading and execution of \<^theory>\<open>C.C_Parser_Language\<close> will -mimic all necessary features of the Haskell parser generator Happy -\<^footnote>\<open>\<^url>\<open>https://www.haskell.org/happy/doc/html/index.html\<close>\<close>, -including any monadic interactions between the lexing (\<^theory>\<open>C.C_Lexer\<close>) and -parsing part (\<^theory>\<open>C.C_Parser_Language\<close>). - -This is why in the remaining part, we will at least assume a mandatory familiarity with Happy (e.g., -the reading of ML-Yacc's manual can happen later if wished -\<^footnote>\<open>\<^url>\<open>https://www.cs.princeton.edu/~appel/modern/ml/ml-yacc/manual.html\<close>\<close>). In -particular, we will use \<^emph>\<open>rule code\<close> to designate \<^emph>\<open>a Haskell -expression enclosed in braces\<close> -\<^footnote>\<open>\<^url>\<open>https://www.haskell.org/happy/doc/html/sec-grammar.html\<close>\<close>. -\<close> - -subsection \<open>Structure of \<^theory>\<open>C.C_Parser_Language\<close>\<close> - -text \<open> In more detail, \<^theory>\<open>C.C_Parser_Language\<close> can be seen as being -principally divided into two parts: -\begin{itemize} -\item a first part containing the implementation of the ML structure - \<open>C_Grammar_Rule_Lib\<close>, which provides the ML implementation library used by any rule - code written in the C grammar - \<^url>\<open>https://github.com/visq/language-c/blob/master/src/Language/C/Parser/Parser.y\<close> - (\<^file>\<open>generated/c_grammar_fun.grm.sml\<close>). -\item a second part implementing the structure \<open>C_Grammar_Rule_Wrap\<close>, providing one - wrapping function for each rule code, for potentially complementing the rule code with an - additional action to be executed after its call. The use of wrapping functions is very optional: - by default, they are all assigned as identity functions. -\end{itemize} -The difference between \<open>C_Grammar_Rule_Lib\<close> and \<open>C_Grammar_Rule_Wrap\<close> -relies in how often functions in the two structures are called: while building subtree pieces of the -final AST, grammar rules are free to call any functions in \<open>C_Grammar_Rule_Lib\<close> for -completing their respective tasks, but also free to not use \<open>C_Grammar_Rule_Lib\<close> at -all. On the other hand, irrespective of the actions done by a rule code, the function associated to -the rule code in \<open>C_Grammar_Rule_Wrap\<close> is retrieved and always executed (but a visible -side-effect will likely mostly happen whenever one has provided an implementation far different from -the identity function). \<close> - -text \<open> Because the grammar -\<^url>\<open>https://github.com/visq/language-c/blob/master/src/Language/C/Parser/Parser.y\<close> -(\<^file>\<open>generated/c_grammar_fun.grm.sml\<close>) has been defined in such a way that -computation of variable scopes are completely handled by functions in -\<open>C_Grammar_Rule_Lib\<close> and not in rule code (which are just calling functions in -\<open>C_Grammar_Rule_Lib\<close>), it is enough to overload functions in -\<open>C_Grammar_Rule_Lib\<close> whenever it is wished to perform new actions depending on variable -scopes, for example to do a specific PIDE report at the first time when a C variable is being -declared. In particular, functions in \<open>C_Grammar_Rule_Lib\<close> are implemented in monadic -style, making a subsequent modification on the parsing environment -\<^theory>\<open>C.C_Environment\<close> possible (whenever appropriate) as this last is carried in -the monadic state. - -Fundamentally, this is feasible because the monadic environment fulfills the property of being -always properly enriched with declared variable information at any time, because we assume -\begin{itemize} - \item working with a language where a used variable must be at most declared or redeclared - somewhere before its actual used, - \item and using a parser scanning tokens uniquely, from left to right, in the same order than the - execution of rule code actions. -\end{itemize} -\<close> - -subsubsection \<open>Example\<close> - -text \<open> As illustration, \<open>C_Grammar_Rule_Lib.markup_var true\<close> is (implicitly) -called by a rule code while a variable being declared is encountered. Later, a call to -\<open>C_Grammar_Rule_Lib.markup_var false\<close> in \<open>C_Grammar_Rule_Wrap\<close> (actually, -in \<open>C_Grammar_Rule_Wrap_Overloading\<close>) is made after the execution of another rule code -to signal the position of a variable in use, together with the information retrieved from the -environment of the position of where it is declared. \<close> - -text \<open> In more detail, the second argument of \<open>C_Grammar_Rule_Lib.markup_var\<close> is -among other of the form: \<open>Position.T * {global: bool, ...}\<close>, where particularly the -field \<open>global\<close> of the record is informing \<open>C_Grammar_Rule_Lib.markup_var\<close> -if the variable being reported (at either first declaration time, or first use time) is global or -local (inside a function for instance). Because once declared, the property \<open>global\<close> of -a variable does not change afterwards, it is enough to store that information in the monadic -environment: -\<^item> \<^bold>\<open>Storing the information at declaration time\<close> The part deciding if a -variable being declared is global or not is implemented in -\<open>C_Grammar_Rule_Lib.doDeclIdent\<close> and -\<open>C_Grammar_Rule_Lib.doFuncParamDeclIdent\<close>. The two functions come from -\<^url>\<open>https://github.com/visq/language-c/blob/master/src/Language/C/Parser/Parser.y\<close> -(so do any functions in \<open>C_Grammar_Rule_Lib\<close>). Ultimately, they are both calling -\<open>C_Grammar_Rule_Lib.markup_var true\<close> at some point. -\<^item> \<^bold>\<open>Retrieving the information at use time\<close> -\<open>C_Grammar_Rule_Lib.markup_var false\<close> is only called by -\<open>C_Grammar_Rule_Wrap.primary_expression1\<close>, while treating a variable being already -declared. In particular the second argument of \<open>C_Grammar_Rule_Lib.markup_var\<close> is just -provided by what has been computed by the above point when the variable was declared (e.g., the -globality versus locality information). \<close> - -subsection \<open>Rewriting of AST node\<close> - -text \<open> For the case of rewriting a specific AST node, from subtree \<open>T1\<close> to -subtree \<open>T2\<close>, it is useful to zoom on the different parsing evaluation stages, as well -as make precise when the evaluation of semantic back-ends are starting. - -\<^enum> Whereas annotations in Isabelle/C code have the potential of carrying arbitrary ML code (as -in \<^theory>\<open>C_examples.C1\<close>), the moment when they are effectively evaluated will not be -discussed here, because to closely follow the semantics of the language in embedding (so C), we -suppose comments --- comprising annotations --- may not affect any parsed tokens living outside -comments. So no matter when annotations are scheduled to be future evaluated in Isabelle/C, it will -be not possible to write a code changing \<open>T1\<close> to \<open>T2\<close> inside annotations. - -\<^enum> To our knowledge, the sole category of code having the capacity to affect incoming stream -of tokens are directives, which are processed and evaluated before the ``major'' parsing step -occurs. Since in Isabelle/C, directives are relying on ML code, changing an AST node from -\<open>T1\<close> to \<open>T2\<close> can then be perfectly implemented in directives. - -\<^enum> After the directive (pre)processing step, the main parsing happens. But since what are -driving the parsing engine are principally rule code, this step means to execute -\<open>C_Grammar_Rule_Lib\<close> and \<open>C_Grammar_Rule_Wrap\<close>, i.e., rules in -\<^file>\<open>generated/c_grammar_fun.grm.sml\<close>. - -\<^enum> Once the parsing finishes, we have a final AST value, which topmost root type entry-point -constitutes the last node built before the grammar parser -\<^url>\<open>https://github.com/visq/language-c/blob/master/src/Language/C/Parser/Parser.y\<close> -ever entered in a stop state. For the case of a stop acceptance state, that moment happens when we -reach the first rule code building the type \<open>C_Ast.CTranslUnit\<close>, since there is only -one possible node making the parsing stop, according to what is currently written in the C -grammar. (For the case of a state stopped due to an error, it is the last successfully built value -that is returned, but to simplify the discussion, we will assume in the rest of the document the -parser is taking in input a fully well-parsed C code.) - -\<^enum> By \<^emph>\<open>semantic back-ends\<close>, we denote any kind of ``relatively -efficient'' compiled code generating Isabelle/HOL theorems, proofs, definitions, and so with the -potential of generally generating Isabelle packages. In our case, the input of semantic back-ends -will be the type \<open>C_Ast.CTranslUnit\<close> (actually, whatever value provided by the above -parser). But since our parser is written in monadic style, it is as well possible to give slightly -more information to semantic back-ends, such as the last monadic computed state, so including the -last state of the parsing environment. \<close> - -text \<open> Generally, semantic back-ends can be written in full ML starting from -\<open>C_Ast.CTranslUnit\<close>, but to additionally support formalizing tasks requiring to start -from an AST defined in Isabelle/HOL, we provide an equivalent AST in HOL in the project, such as the -one obtained after loading \<^file>\<open>../Citadelle/doc/Meta_C_generated.thy\<close> -\<^footnote>\<open>from the Citadelle project -\<^url>\<open>gitlri.lri.fr/ftuong/citadelle-devel\<close>\<close> (In fact, the ML AST is just -generated from the HOL one.) \<close> - - - -text \<open> -Based on the above information, there are now several \<^emph>\<open>equivalent\<close> ways to -proceed for the purpose of having an AST node be mapped from \<open>T1\<close> to \<open>T2\<close>: -\<^item> For example, we can modify -\<^url>\<open>https://github.com/visq/language-c/blob/master/src/Language/C/Parser/Parser.y\<close> -by hand, by explicitly writing \<open>T2\<close> at the specific position of the rule code -generating \<open>T1\<close>. However, this solution implies to re-generate -\<^file>\<open>generated/c_grammar_fun.grm.sml\<close>. - -\<^item> Instead of modifying the grammar, it should be possible to first locate which rule code is -building \<open>T1\<close>. Then it would remain to retrieve and modify the respective function of -\<open>C_Grammar_Rule_Wrap\<close> executed after that rule code, by providing a replacement -function to be put in \<open>C_Grammar_Rule_Wrap_Overloading\<close>. However, as a design decision, -wrapping functions generated in \<^file>\<open>generated/c_grammar_fun.grm.sml\<close> have only -been generated to affect monadic states, not AST values. This is to prevent an erroneous replacement -of an end-user while parsing C code. (It is currently left open about whether or not this feature -will be implemented in future versions of the parser...) - -\<^item> Another solution consists in directly writing a mapping function acting on the full AST, so -writing a ML function of type \<open>C_Ast.CTranslUnit -> C_Ast.CTranslUnit\<close> (or a respective -HOL function) which has to act on every constructor of the AST (so in the worst case about hundred -of constructors for the considered AST, i.e., whenever a node has to be not identically -returned). However, as we have already implemented a conversion function from -\<open>C_Ast.CTranslUnit\<close> (subset of C11) to a subset AST of C99, it might be useful to save -some effort by starting from this conversion function, locate where \<open>T1\<close> is -pattern-matched by the conversion function, and generate \<open>T2\<close> instead. - -As example, the conversion function \<open>C_Ast.main\<close> is particularly used to connect the -C11 front-end to the entry-point of AutoCorres in -\<^verbatim>\<open>l4v/src/tools/c-parser/StrictCParser.ML\<close>. - -\<^item> If it is allowed to modify the C code in input, then one can add a directive -\<open>#define\<close> performing the necessary rewrite. - -\<close> - -text \<open> More generally, to better inspect the list of rule code really executed when a C code -is parsed, it might be helpful to proceed as in \<^theory>\<open>C_examples.C1\<close>, by activating -\<^theory_text>\<open>declare[[C_parser_trace]]\<close>. Then, the output window will display the -sequence of Shift Reduce actions associated to the \<^theory_text>\<open>C\<close> command of -interest. -\<close> - - -section \<open>Outer Syntax Commands for Isabelle/C\<close> - -section \<open>Incorporating C code\<close> - -text \<open> - \begin{matharray}{rcl} - @{command_def "C_file"} & : & \<open>local_theory \<rightarrow> local_theory\<close> \\ - @{command_def "C"} & : & \<open>local_theory \<rightarrow> local_theory\<close> \\ - @{command_def "C_export_boot"} & : & \<open>local_theory \<rightarrow> local_theory\<close> \\ - @{command_def "C_prf"} & : & \<open>proof \<rightarrow> proof\<close> \\ - @{command_def "C_val"} & : & \<open>any \<rightarrow>\<close> \\ - @{command_def "C_export_file"} & : & \<open>any \<rightarrow>\<close> \\ - \end{matharray} - \begin{tabular}{rcll} - @{attribute_def C_lexer_trace} & : & \<open>attribute\<close> & default \<open>false\<close> \\ - @{attribute_def C_parser_trace} & : & \<open>attribute\<close> & default \<open>false\<close> \\ - @{attribute_def C_ML_verbose} & : & \<open>attribute\<close> & default \<open>true\<close> \\ - @{attribute_def C_propagate_env} & : & \<open>attribute\<close> & default \<open>false\<close> \\ - \end{tabular} - - @{rail \<open> - @@{command C_file} @{syntax name} ';'? - ; - (@@{command C} | @@{command C_export_boot} | @@{command C_prf} | - @@{command C_val} | @@{command C_export_file}) @{syntax text} - ; - \<close>} - - \<^descr> \<^theory_text>\<open>C_file name\<close> resembles to - \<^theory_text>\<open>ML_file name\<close>: it reads the given C - file, and let any attached semantic back-ends to proceed for further - subsequent evaluation. Top-level C bindings are stored within the - (global or local) theory context; the initial environment is set by - default to be an empty one, or the one returned by a previous - \<^theory_text>\<open>C_file\<close> (depending on @{attribute_def - C_propagate_env}). Multiple \<^theory_text>\<open>C_file\<close> - commands may be used to build larger C projects if they are all - written in a single theory file (existing parent theories are - ignored, and not affecting the current working theory). - - \<^descr> \<^theory_text>\<open>C\<close> is similar to - \<^theory_text>\<open>C_file\<close>, but evaluates directly the - given \<open>text\<close>. Top-level resulting bindings are stored - within the (global or local) theory context. - - \<^descr> \<^theory_text>\<open>C_export_boot\<close> is similar to - \<^theory_text>\<open>ML_export\<close>, except that the code in - input is understood as being processed by - \<^theory_text>\<open>C\<close> instead of \<^theory_text>\<open>ML\<close>. - - \<^descr> \<^theory_text>\<open>C_prf\<close> is similar to - \<^theory_text>\<open>ML_prf\<close>, except that the code in input - is understood as being processed by - \<^theory_text>\<open>C\<close> instead of \<^theory_text>\<open>ML\<close>. - - \<^descr> \<^theory_text>\<open>C_val\<close> is similar to - \<^theory_text>\<open>ML_val\<close>, except that the code in input - is understood as being processed by - \<^theory_text>\<open>C\<close> instead of \<^theory_text>\<open>ML\<close>. - - \<^descr> \<^theory_text>\<open>C_export_file\<close> dumps all - existing previous C code to \<open>T.c\<close>, where - \<open>T.thy\<close> is the name of the current working theory. The - dump is actually restricted to \<open>T\<close> (parent theories are - ignored). -\<close> - -text \<open> - - \<^descr> @{attribute C_lexer_trace} indicates whether the list of C - tokens associated to the source text should be output (that list is - computed during the lexing phase). - - \<^descr> @{attribute C_parser_trace} indicates whether the stack - forest of Shift-Reduce node should be output (it is the final stack - which is printed, i.e., the one taken as soon as the parsing - terminates). - - \<^descr> @{attribute C_ML_verbose} indicates whether nested - \<^theory_text>\<open>ML\<close> commands are acting similarly as - their default verbose configuration in top-level. - - \<^descr> @{attribute_def C_propagate_env} makes the start of a C - command (e.g., \<^theory_text>\<open>C_file\<close>, - \<^theory_text>\<open>C\<close>) initialized with the environment of - the previous C command if existing. -\<close> - -section \<open>Inner Annotation Commands for Isabelle/C\<close> - -section \<open>A Guide to Writing Semantic Back-Ends for Isabelle/C\<close> -subsection\<open>General Principles\<close> - -subsection\<open>Example: CLEAN\<close> - -subsection\<open>Example: AutoCorres\<close> - -(*<*) -end -(*>*) \ No newline at end of file diff --git a/C11-FrontEnd/C_Conclusion.thy b/C11-FrontEnd/C_Conclusion.thy deleted file mode 100644 index 80d38979f285e54afec9ac00b150bfc29dc6bdb8..0000000000000000000000000000000000000000 --- a/C11-FrontEnd/C_Conclusion.thy +++ /dev/null @@ -1,47 +0,0 @@ -(****************************************************************************** - * Generation of Language.C Grammar with ML Interface Binding - * - * Copyright (c) 2018-2019 Université Paris-Saclay, Univ. Paris-Sud, France - * - * 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 C_Conclusion - imports C.C_Main -begin -(*>*) - -section\<open>Conclusion\<close> - -(*<*) -end -(*>*) \ No newline at end of file diff --git a/C11-FrontEnd/C_DOF.thy b/C11-FrontEnd/C_DOF.thy deleted file mode 100644 index 51a30e65911b24a72fa6f93846868800a25090f9..0000000000000000000000000000000000000000 --- a/C11-FrontEnd/C_DOF.thy +++ /dev/null @@ -1,246 +0,0 @@ -(****************************************************************************** - * Isabelle/DOF - * - * Copyright (c) 2018-2019 The University of Sheffield - * 2018-2019 Université Paris-Saclay, Univ. Paris-Sud, France - * - * 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 C_DOF - imports Main - keywords "+=" ":=" "accepts" "rejects" - - and "title*" "subtitle*" - "chapter*" "section*" "subsection*" "subsubsection*" - "paragraph*" "subparagraph*" - "text*" - "figure*" - "side_by_side_figure*" - :: document_body - - and "open_monitor*" "close_monitor*" "declare_reference*" - "update_instance*" :: thy_decl - begin - -ML\<open> -structure ODL_Command_Parser = -struct - -type meta_args_t = (((string * Position.T) * - (string * Position.T) option) - * ((string * Position.T) * string) list) - -val semi = Scan.option (Parse.$$$ ";"); -val is_improper = not o (Token.is_proper orf Token.is_begin_ignore orf Token.is_end_ignore); -val improper = Scan.many is_improper; (* parses white-space and comments *) - -val attribute = - Parse.position Parse.const - --| improper - -- Scan.optional (Parse.$$$ "=" --| improper |-- Parse.!!! Parse.term --| improper) "True" - : ((string * Position.T) * string) parser; - -val attribute_upd : (((string * Position.T) * string) * string) parser = - Parse.position Parse.const - --| improper - -- ((@{keyword "+="} --| improper) || (@{keyword ":="} --| improper)) - -- Parse.!!! Parse.term - --| improper - : (((string * Position.T) * string) * string) parser; - -val reference = - Parse.position Parse.name - --| improper - -- Scan.option (Parse.$$$ "::" - -- improper - |-- (Parse.!!! (Parse.position Parse.name)) - ) - --| improper; - - -val attributes = - ((Parse.$$$ "[" - -- improper - |-- (reference -- - (Scan.optional(Parse.$$$ "," -- improper |-- (Parse.enum "," (improper |-- attribute)))) [])) - --| Parse.$$$ "]" - --| improper) : meta_args_t parser - -val attributes_upd = - ((Parse.$$$ "[" - -- improper - |-- (reference -- - (Scan.optional(Parse.$$$ "," -- improper |-- (Parse.enum "," (improper |-- attribute_upd)))) [])) - --| Parse.$$$ "]") - --| improper - -fun enriched_document_command _ {markdown} ((_, opt), src) = - Pure_Syn.document_command {markdown = markdown} (opt, src) -fun open_monitor_command _ = I -fun close_monitor_command _ = I -fun update_instance_command _ = I - -end -\<close> - -ML\<open> -structure DOF_core = -struct -val (strict_monitor_checking, strict_monitor_checking_setup) - = Attrib.config_bool @{binding strict_monitor_checking} (K false); -fun declare_object_global _ = I -end -\<close> - -setup\<open>DOF_core.strict_monitor_checking_setup\<close> - -ML\<open> -structure OntoLinkParser = -struct -(* generic syntax for doc_class links. *) - -val defineN = "define" -val uncheckedN = "unchecked" - -val docitem_modes = Scan.optional (Args.parens (Args.$$$ defineN || Args.$$$ uncheckedN) - >> (fn str => if str = defineN - then {unchecked = false, define= true} - else {unchecked = true, define= false})) - {unchecked = false, define= false} (* default *); - -val docitem_antiquotation_parser : ({define: bool, unchecked: bool} * Input.source) context_parser = (Scan.lift (docitem_modes -- Args.text_input)) -end -\<close> - -ML\<open> -structure OntoParser = -struct -val _ = Theory.setup - (Thy_Output.antiquotation_verbatim @{binding figure} - OntoLinkParser.docitem_antiquotation_parser (fn _ => fn _ => "") #> - Thy_Output.antiquotation_verbatim @{binding docitem} - OntoLinkParser.docitem_antiquotation_parser (fn _ => fn _ => "")) -end\<close> - -ML\<open> -local -open ODL_Command_Parser -in -(* *********************************************************************** *) -(* Textual Command Support *) -(* *********************************************************************** *) - -(* {markdown = true} sets the parsing process such that in the text-core markdown elements are - accepted. *) - -val _ = - Outer_Syntax.command ("title*", @{here}) "section heading" - (attributes -- Parse.opt_target -- Parse.document_source --| semi - >> ((enriched_document_command NONE {markdown = false} ))) ; - -val _ = - Outer_Syntax.command ("subtitle*", @{here}) "section heading" - (attributes -- Parse.opt_target -- Parse.document_source --| semi - >> ((enriched_document_command NONE {markdown = false} ))); - -val _ = - Outer_Syntax.command ("chapter*", @{here}) "section heading" - (attributes -- Parse.opt_target -- Parse.document_source --| semi - >> ((enriched_document_command (SOME(SOME 0)) {markdown = false} ))); - -val _ = - Outer_Syntax.command ("section*", @{here}) "section heading" - (attributes -- Parse.opt_target -- Parse.document_source --| semi - >> ((enriched_document_command (SOME(SOME 1)) {markdown = false} ))); - - -val _ = - Outer_Syntax.command ("subsection*", @{here}) "subsection heading" - (attributes -- Parse.opt_target -- Parse.document_source --| semi - >> ((enriched_document_command (SOME(SOME 2)) {markdown = false} ))); - -val _ = - Outer_Syntax.command ("subsubsection*", @{here}) "subsubsection heading" - (attributes -- Parse.opt_target -- Parse.document_source --| semi - >> ((enriched_document_command (SOME(SOME 3)) {markdown = false} ))); - -val _ = - Outer_Syntax.command ("paragraph*", @{here}) "paragraph heading" - (attributes -- Parse.opt_target -- Parse.document_source --| semi - >> ((enriched_document_command (SOME(SOME 4)) {markdown = false} ))); - -val _ = - Outer_Syntax.command ("subparagraph*", @{here}) "subparagraph heading" - (attributes -- Parse.opt_target -- Parse.document_source --| semi - >> ((enriched_document_command (SOME(SOME 5)) {markdown = false} ))); - -val _ = - Outer_Syntax.command ("figure*", @{here}) "figure" - (attributes -- Parse.opt_target -- Parse.document_source --| semi - >> ((enriched_document_command NONE {markdown = false} ))); - -val _ = - Outer_Syntax.command ("side_by_side_figure*", @{here}) "multiple figures" - (attributes -- Parse.opt_target -- Parse.document_source --| semi - >> ((enriched_document_command NONE {markdown = false} ))); - - -val _ = - Outer_Syntax.command ("text*", @{here}) "formal comment (primary style)" - (attributes -- Parse.opt_target -- Parse.document_source - >> ((enriched_document_command NONE {markdown = true} ))); - -val _ = - Outer_Syntax.command @{command_keyword "declare_reference*"} - "declare document reference" - (attributes >> (fn (((oid,pos),cid),doc_attrs) => - (Toplevel.theory (DOF_core.declare_object_global oid)))); - -val _ = - Outer_Syntax.command @{command_keyword "open_monitor*"} - "open a document reference monitor" - (attributes >> (Toplevel.theory o open_monitor_command)); - -val _ = - Outer_Syntax.command @{command_keyword "close_monitor*"} - "close a document reference monitor" - (attributes_upd >> (Toplevel.theory o close_monitor_command)); - - -val _ = - Outer_Syntax.command @{command_keyword "update_instance*"} - "update meta-attributes of an instance of a document class" - (attributes_upd >> (Toplevel.theory o update_instance_command)); -end -\<close> - -end \ No newline at end of file diff --git a/C11-FrontEnd/C_Intro.thy b/C11-FrontEnd/C_Intro.thy deleted file mode 100644 index bce0fb10a9b43b8b35fd4e2f97f8401b6d21f08d..0000000000000000000000000000000000000000 --- a/C11-FrontEnd/C_Intro.thy +++ /dev/null @@ -1,131 +0,0 @@ -(****************************************************************************** - * Generation of Language.C Grammar with ML Interface Binding - * - * Copyright (c) 2018-2019 Université Paris-Saclay, Univ. Paris-Sud, France - * - * 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 C_Intro - imports C_DOF -begin - -open_monitor*[this::article] -declare[[strict_monitor_checking=false]] -(*>*) -(* -title*[tit::title]\<open>Deeply Integrating C11-Code Support into Isabelle/PIDE\<close> -text* -[fred::author, email="''ftuong@lri.fr''", affiliation="\<open>LRI, Université Paris-Saclay\<close>", http_site="\<open>https://www.lri.fr/~ftuong/\<close>"] -\<open>Frédéric Tuong\<close> -text* -[bu::author, email= "''wolff@lri.fr''", affiliation = "\<open>LRI, Université Paris-Saclay\<close>", http_site="\<open>https://www.lri.fr/~wolff/\<close>"] -\<open>Burkhart Wolff\<close> - -(**) - -section*[intro::introduction]\<open> Introduction \<close> -text*[introtext::introduction] -\<open>Recent successes like the Microsoft Hypervisor project @{cite "DBLP:conf/fm/LeinenbachS09"}, -the verified CompCert compiler @{cite "DBLP:journals/cacm/Leroy09"} -and the seL4 microkernel @{cite "klein:sel4" and "DBLP:journals/tocs/KleinAEMSKH14"} -show that the verification of low-level systems code has become feasible. -However, a closer look at the underlying verification engines -VCC@{cite "DBLP:conf/tphol/CohenDHLMSST09"}, -or Isabelle/AutoCorres@{cite "DBLP:conf/pldi/GreenawayLAK14"} -show that the road is still bumpy: in particular the empirical cost evaluation -of @{cite "DBLP:journals/tocs/KleinAEMSKH14"} reveals that a very substantial part -of the overall effort of about one third of the 28 man years went into the development -of libraries and the tool-chain itself. @{cite "DBLP:journals/tocs/KleinAEMSKH14"} expresses -the hope that these were overall investments, that will, once done, not have to be repeated for -``similar projects''. - -However, none of these verifying compiler tool-chains capture all aspects of ``real life'' -programming languages such as C. The variety of supported language fragments seem to contradict -the assumption that we will all converge to one comprehensive tool-chain soon; There are so many -different choices concerning memory models, non-standard control-flow, and execution models -that a generic framework is desirable, in which verified compilers, deductive verification, -static analysis and test-techniques (such as @{cite "DBLP:conf/tap/Keller18"}, -@{cite "DBLP:conf/itp/AissatVW16"}) can be developed and used inside the Isabelle platform. - -In this paper, we present such a generic framework in spirit similar to Frama-C -@{cite "frama-c-home-page"}. In contrast to the latter, however, it is deeply integrated into the -Isabelle/PIDE @{cite "DBLP:conf/itp/Wenzel14"} document model and offers, based on the C11 -standard (ISO/IEC 9899:2011), a parser, IDE-support using static scoping as well as the usual -parallel evaluation techniques for SML-based, user-programmed extensions in Isabelle. -The genericity allows for "plugged-in" concrete semantic representations available in -Isabelle/HOL@{cite "nipkow.ea:isabelle:2002"} -such as AutoCorres@{cite "DBLP:conf/pldi/GreenawayLAK14"}, IMP2@{cite "IMP2-AFP"}, -ORCA@{cite "bockenek:hal-02069705"}, and CLEAN@{footnote \<open>Part of the HOL-TestGen distribution -\<^url>\<open>https://www.brucker.ch/projects/hol-testgen/\<close>.\<close>}. This also includes -generic support of semantic annotations controlled by specific semantic plug-ins. -Our framework is sufficiently reactive to be usable for C sources such as the seL4 project -(we discuss their C-parsing tests in @{docitem \<open>c-tests\<close>}) ---- although this depends, of course, of the computational load of the semantic back-ends being -plugged in. Our framework supports annotations for multiple backends. \<close> - -figure* -["C-sample"::figure,relative_width="60",src="''figures/A-C-Source''"] -\<open>A C11 Sample in Isabelle/jedit\<close> - -text\<open> @{figure \<open>C-sample\<close>} shows our new \verb+C+-command, that analogously to the existing -\verb+ML+-command allows for editing C-sources. Inside the \inlineisar+\<Open> .. \<Close>+ brackets, -C-code is parsed on the fly in a "continuous check, continuous build" manner. A parsed source -is colorated according to the usual conventions for variables and keywords. A static scoping -analysis makes the bindings inside the source explicit such that editing gestures like hovering -and clicking may allow the user to reveal the applying or defining variable occurrences as well -as C-level type information.\<close> - -text\<open>Our framework allows for the deep integration of the C-source into a global document in which -literate programming style documentation, modeling as well as static program analysis and verification -co-exist. In particular, information from the different tools realized as plugins in the Isabelle -platform can flow freely. This increases greatly the development agility of such type of sources -and may be attractive to conventional developers, in particular when targeting a formal certification -@{cite "DBLP:conf/mkm/BruckerACW18"}. \<close> -(*<*) -declare_reference*[background::text_section] -declare_reference*[annotations::text_section] -declare_reference*[backends::text_section] -declare_reference*[conclusion::text_section] -(*>*) -text\<open>This paper proceeds as follows: In the @{docitem (unchecked) \<open>background\<close>} section, we will briefly -introduce Isabelle/PIDE and its document model, into which our framework is integrated. In the subsequent -sections, we will discuss the build process (relevant for developers of similar front-ends, not -end-users) and present some experimental results on the integrated parser. The handling of -semantic annotations comments --- a vital part for back-end developers --- is discussed in -@{docitem (unchecked) \<open>annotations\<close>}, while in @{docitem (unchecked) \<open>backends\<close>} we present some -techniques to integrate back-ends into our framework at hand of examples. -\<close> -*) -(*<*) -end -(*>*) \ No newline at end of file diff --git a/C11-FrontEnd/ROOT b/C11-FrontEnd/ROOT index 8c89f30a2573766ad2c94e2858e9756c3d9916fb..5a5b6b40d382fffd5ad642226ca273cacb1ab42f 100644 --- a/C11-FrontEnd/ROOT +++ b/C11-FrontEnd/ROOT @@ -34,42 +34,23 @@ * OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. ******************************************************************************) -(* For modularity reasons, and to ease the importation of a specific session by - semantic back-ends, theory files are (at the time of writing) not regrouped - into a unique session. *) - session C = HOL + - options [document = pdf, document_output = "generated/part1"] theories C_Main - document_files - "root.tex" - "root.bib" -session C_examples = C + (* a standard test suite *) - options [document = pdf, document_output = "generated/part2"] +session C_examples = C + theories "examples/C0" "examples/C1" "examples/C2" "examples/C3" "examples/C_paper" - document_files - "root.tex" - "root.bib" session C_document = C_examples + - options [document = pdf, document_output = "generated/part3"] + options [document = pdf, document_output = generated] theories - C_Appendices - document_files - "root.tex" - "root.bib" - -session Isabelle_C = C_document + - options [document = pdf, document_output = "generated"] - (* TODO: find a way to concatenate together PDF in: - generated/part1 + generated/part2 + generated/part3 *) + "document/Rail" + "document/README" document_files "root.tex" "root.bib" diff --git a/C11-FrontEnd/document/README.thy b/C11-FrontEnd/document/README.thy new file mode 100644 index 0000000000000000000000000000000000000000..aa58999cee73a784d3a505885d99cd4d48f1ed78 --- /dev/null +++ b/C11-FrontEnd/document/README.thy @@ -0,0 +1,207 @@ +(****************************************************************************** + * Generation of Language.C Grammar with ML Interface Binding + * + * Copyright (c) 2018-2019 Université Paris-Saclay, Univ. Paris-Sud, France + * + * 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 README imports C_examples.C1 begin + +section \<open>Structure of folders\<close> + +text \<open> +\<^dir>\<open>../copied_from_git\<close> represents the location of +external libraries needed by the C parser at run-time. At the time of +writing, it only contains +\<^dir>\<open>../copied_from_git/mlton\<close>, and more specifically +\<^dir>\<open>../copied_from_git/mlton/lib/mlyacc-lib\<close>. All +files in this last folder are solely used by +\<^theory>\<open>C.C_Parser_Language\<close>. The rest has been copied +from the original repository of MLton +\<^footnote>\<open>\<^url>\<open>https://github.com/MLton/mlton\<close> +and \<^url>\<open>https://gitlri.lri.fr/ftuong/mlton\<close>\<close>. +\<close> + +text \<open> +The purpose of \<^dir>\<open>../generated\<close> is to host generated +files, which are necessary for a first boot of the front-end. A major +subset of these files can actually be seen as superfluous, i.e., in +theory a simpler loading of a "root un-generated file" (generating +these files) would suffice, using for instance +\<^theory_text>\<open>code_reflect\<close>. However certain generators +are not written in a pure ML form (or are not yet automatically seen +as being translated to ML), so some manual steps of decomposition and +static generation was undertaken. In more detail: + + \<^item> \<^file>\<open>../generated/c_ast.ML\<close> contains the + Abstract Syntax Tree of C, which is loaded by + \<^theory>\<open>C.C_Ast\<close>. + + \<^item> \<^file>\<open>../generated/c_grammar_fun.grm\<close> is a + generated file not used by the project, except for further + generating \<^file>\<open>../generated/c_grammar_fun.grm.sig\<close> + and \<^file>\<open>../generated/c_grammar_fun.grm.sml\<close>, or + informative documentation purposes. It represents the basis point of + our SML grammar file, generated by an initial Haskell grammar file + (namely + \<^url>\<open>https://github.com/visq/language-c/blob/master/src/Language/C/Parser/Parser.y\<close>). + + In short, it has to be compiled with a modified version of ML-Yacc, + included in MLton itself + (\<^url>\<open>https://gitlri.lri.fr/ftuong/mlton\<close>). + + \<^item> \<^file>\<open>../generated/c_grammar_fun.grm.sig\<close> + and \<^file>\<open>../generated/c_grammar_fun.grm.sml\<close> are + generated using the process described above. + +\<close> + +section \<open>Case study: mapping on the parsed AST\<close> + +text \<open> In this section, we give a concrete example of a situation where one is interested to +do some automated transformations on the parsed AST, such as changing the type of every encountered +variables from \<open>int\<close> to \<open>array int\<close>. The main theory of interest here is +\<^theory>\<open>C.C_Parser_Language\<close>, where the C grammar is loaded, in contrast to +\<^theory>\<open>C.C_Lexer\<close> which is only dedicated to build a list of C tokens. As another +example, \<^theory>\<open>C.C_Parser_Language\<close> also contains the portion of the code +implementing the report to the user of various characteristics of encountered variables during +parsing: if a variable is bound or free, or if the declaration of a variable is made in the global +topmost space or locally declared in a function. \<close> + +subsection \<open>Prerequisites\<close> + +text \<open> Even if \<^file>\<open>../generated/c_grammar_fun.grm.sig\<close> and and +\<^file>\<open>../generated/c_grammar_fun.grm.sml\<close> are files written in ML syntax, we have +actually modified \<^dir>\<open>../copied_from_git/mlton/lib/mlyacc-lib\<close> in such a way that +at run time, the overall loading and execution of \<^theory>\<open>C.C_Parser_Language\<close> will +mimic all necessary features of the Haskell parser generator Happy +\<^footnote>\<open>\<^url>\<open>https://www.haskell.org/happy/doc/html/index.html\<close>\<close>, +including any monadic interactions between the lexing (\<^theory>\<open>C.C_Lexer\<close>) and +parsing part (\<^theory>\<open>C.C_Parser_Language\<close>). + +This is why in the remaining part, we will at least assume a mandatory familiarity with Happy (e.g., +the reading of ML-Yacc's manual can happen later if wished +\<^footnote>\<open>\<^url>\<open>https://www.cs.princeton.edu/~appel/modern/ml/ml-yacc/manual.html\<close>\<close>). In +particular, we will use \<^emph>\<open>rule code\<close> to designate \<^emph>\<open>a Haskell +expression enclosed in braces\<close> +\<^footnote>\<open>\<^url>\<open>https://www.haskell.org/happy/doc/html/sec-grammar.html\<close>\<close>. +\<close> + +subsection \<open>Structure of \<^theory>\<open>C.C_Parser_Language\<close>\<close> + +text \<open> In more detail, \<^theory>\<open>C.C_Parser_Language\<close> can be seen as being +principally divided into two parts: +\begin{itemize} +\item a first part containing the implementation of the ML structure + \<open>C_Grammar_Rule_Lib\<close>, which provides the ML implementation library used by any rule + code written in the C grammar + \<^url>\<open>https://github.com/visq/language-c/blob/master/src/Language/C/Parser/Parser.y\<close> + (\<^file>\<open>../generated/c_grammar_fun.grm.sml\<close>). +\item a second part implementing the structure \<open>C_Grammar_Rule_Wrap\<close>, providing one + wrapping function for each rule code, for potentially complementing the rule code with an + additional action to be executed after its call. The use of wrapping functions is very optional: + by default, they are all assigned as identity functions. +\end{itemize} +The difference between \<open>C_Grammar_Rule_Lib\<close> and \<open>C_Grammar_Rule_Wrap\<close> +relies in how often functions in the two structures are called: while building subtree pieces of the +final AST, grammar rules are free to call any functions in \<open>C_Grammar_Rule_Lib\<close> for +completing their respective tasks, but also free to not use \<open>C_Grammar_Rule_Lib\<close> at +all. On the other hand, irrespective of the actions done by a rule code, the function associated to +the rule code in \<open>C_Grammar_Rule_Wrap\<close> is retrieved and always executed (but a visible +side-effect will likely mostly happen whenever one has provided an implementation far different from +the identity function). \<close> + +text \<open> Because the grammar +\<^url>\<open>https://github.com/visq/language-c/blob/master/src/Language/C/Parser/Parser.y\<close> +(\<^file>\<open>../generated/c_grammar_fun.grm.sml\<close>) has been defined in such a way that +computation of variable scopes are completely handled by functions in +\<open>C_Grammar_Rule_Lib\<close> and not in rule code (which are just calling functions in +\<open>C_Grammar_Rule_Lib\<close>), it is enough to overload functions in +\<open>C_Grammar_Rule_Lib\<close> whenever it is wished to perform new actions depending on variable +scopes, for example to do a specific PIDE report at the first time when a C variable is being +declared. In particular, functions in \<open>C_Grammar_Rule_Lib\<close> are implemented in monadic +style, making a subsequent modification on the parsing environment +\<^theory>\<open>C.C_Environment\<close> possible (whenever appropriate) as this last is carried in +the monadic state. + +Fundamentally, this is feasible because the monadic environment fulfills the property of being +always properly enriched with declared variable information at any time, because we assume +\begin{itemize} + \item working with a language where a used variable must be at most declared or redeclared + somewhere before its actual used, + \item and using a parser scanning tokens uniquely, from left to right, in the same order than the + execution of rule code actions. +\end{itemize} +\<close> + +text \<open> As illustration, \<open>C_Grammar_Rule_Lib.markup_var true\<close> is (implicitly) +called by a rule code while a variable being declared is encountered. Later, a call to +\<open>C_Grammar_Rule_Lib.markup_var false\<close> in \<open>C_Grammar_Rule_Wrap\<close> (actually, +in \<open>C_Grammar_Rule_Wrap_Overloading\<close>) is made after the execution of another rule code +to signal the position of a variable in use, together with the information retrieved from the +environment of the position of where it is declared. \<close> + +subsection \<open>Rewriting of AST node\<close> + +text \<open> For the case of rewriting a specific AST node, from subtree \<open>T1\<close> to +subtree \<open>T2\<close>, there are several \<^emph>\<open>equivalent\<close> ways to proceed: +\<^item> for example, we can modify +\<^url>\<open>https://github.com/visq/language-c/blob/master/src/Language/C/Parser/Parser.y\<close> +by hand, by explicitly writing \<open>T2\<close> at the specific position of the rule code +generating \<open>T1\<close>. However, this solution implies to re-generate +\<^file>\<open>../generated/c_grammar_fun.grm.sml\<close>. + +\<^item> Instead of modifying the grammar, it should be possible to first locate which rule code is +building \<open>T1\<close>. Then it would remain to retrieve and modify the respective function of +\<open>C_Grammar_Rule_Wrap\<close> executed after that rule code, by providing a replacement +function to be put in \<open>C_Grammar_Rule_Wrap_Overloading\<close>. However, as a design decision, +wrapping functions generated in \<^file>\<open>../generated/c_grammar_fun.grm.sml\<close> have only +been generated to affect monadic states, not AST values. This is to prevent an erroneous relacement +of an end-user while parsing C code. (It is currently left open whether or not this feature will be +implemented in future versions of the parser...) + +\<^item> Another solution consists in directly writing a mapping function acting on the full +AST. However, as we have already implemented a conversion function from C11 to C99, it might be +useful to save time by starting from this conversion function, locate where \<open>T1\<close> is +situated in the conversion function, and generate \<open>T2\<close> instead. + +\<^item> If it is allowed to modify the C code in input, then one can add a directive +\<open>#define\<close> performing the necessary rewrite. + +\<close> + +text \<open> More generally, to better inspect the list of rule code really executed when a C code +is parsed, it might be helpful to proceed as in \<^theory>\<open>C_examples.C1\<close>, by activating +\<^theory_text>\<open>declare[[C_parser_trace]]\<close>. Then, the output window will display the +sequence of Shift Reduce actions associated to the \<^theory_text>\<open>C\<close> command of +interest. +\<close> end diff --git a/C11-FrontEnd/document/Rail.thy b/C11-FrontEnd/document/Rail.thy new file mode 100644 index 0000000000000000000000000000000000000000..dcf4afc46861978677c2b80e8665d7e7fa0b99f8 --- /dev/null +++ b/C11-FrontEnd/document/Rail.thy @@ -0,0 +1,132 @@ +(****************************************************************************** + * Generation of Language.C Grammar with ML Interface Binding + * + * Copyright (c) 2018-2019 Université Paris-Saclay, Univ. Paris-Sud, France + * + * 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 Rail + imports C.C_Command + "~~/src/Doc/Isar_Ref/Base" +begin +(*>*) + +section \<open>Incorporating C code\<close> + +text \<open> + \begin{matharray}{rcl} + @{command_def "C_file"} & : & \<open>local_theory \<rightarrow> local_theory\<close> \\ + @{command_def "C"} & : & \<open>local_theory \<rightarrow> local_theory\<close> \\ + @{command_def "C_export_boot"} & : & \<open>local_theory \<rightarrow> local_theory\<close> \\ + @{command_def "C_prf"} & : & \<open>proof \<rightarrow> proof\<close> \\ + @{command_def "C_val"} & : & \<open>any \<rightarrow>\<close> \\ + @{command_def "C_export_file"} & : & \<open>any \<rightarrow>\<close> \\ + \end{matharray} + \begin{tabular}{rcll} + @{attribute_def C_lexer_trace} & : & \<open>attribute\<close> & default \<open>false\<close> \\ + @{attribute_def C_parser_trace} & : & \<open>attribute\<close> & default \<open>false\<close> \\ + @{attribute_def C_ML_verbose} & : & \<open>attribute\<close> & default \<open>true\<close> \\ + @{attribute_def C_propagate_env} & : & \<open>attribute\<close> & default \<open>false\<close> \\ + \end{tabular} + + @{rail \<open> + @@{command C_file} @{syntax name} ';'? + ; + (@@{command C} | @@{command C_export_boot} | @@{command C_prf} | + @@{command C_val} | @@{command C_export_file}) @{syntax text} + ; + \<close>} + + \<^descr> \<^theory_text>\<open>C_file name\<close> resembles to + \<^theory_text>\<open>ML_file name\<close>: it reads the given C + file, and let any attached semantic back-ends to proceed for further + subsequent evaluation. Top-level C bindings are stored within the + (global or local) theory context; the initial environment is set by + default to be an empty one, or the one returned by a previous + \<^theory_text>\<open>C_file\<close> (depending on @{attribute_def + C_propagate_env}). Multiple \<^theory_text>\<open>C_file\<close> + commands may be used to build larger C projects if they are all + written in a single theory file (existing parent theories are + ignored, and not affecting the current working theory). + + \<^descr> \<^theory_text>\<open>C\<close> is similar to + \<^theory_text>\<open>C_file\<close>, but evaluates directly the + given \<open>text\<close>. Top-level resulting bindings are stored + within the (global or local) theory context. + + \<^descr> \<^theory_text>\<open>C_export_boot\<close> is similar to + \<^theory_text>\<open>ML_export\<close>, except that the code in + input is understood as being processed by + \<^theory_text>\<open>C\<close> instead of \<^theory_text>\<open>ML\<close>. + + \<^descr> \<^theory_text>\<open>C_prf\<close> is similar to + \<^theory_text>\<open>ML_prf\<close>, except that the code in input + is understood as being processed by + \<^theory_text>\<open>C\<close> instead of \<^theory_text>\<open>ML\<close>. + + \<^descr> \<^theory_text>\<open>C_val\<close> is similar to + \<^theory_text>\<open>ML_val\<close>, except that the code in input + is understood as being processed by + \<^theory_text>\<open>C\<close> instead of \<^theory_text>\<open>ML\<close>. + + \<^descr> \<^theory_text>\<open>C_export_file\<close> dumps all + existing previous C code to \<open>T.c\<close>, where + \<open>T.thy\<close> is the name of the current working theory. The + dump is actually restricted to \<open>T\<close> (parent theories are + ignored). +\<close> + +text \<open> + + \<^descr> @{attribute C_lexer_trace} indicates whether the list of C + tokens associated to the source text should be output (that list is + computed during the lexing phase). + + \<^descr> @{attribute C_parser_trace} indicates whether the stack + forest of Shift-Reduce node should be output (it is the final stack + which is printed, i.e., the one taken as soon as the parsing + terminates). + + \<^descr> @{attribute C_ML_verbose} indicates whether nested + \<^theory_text>\<open>ML\<close> commands are acting similarly as + their default verbose configuration in top-level. + + \<^descr> @{attribute_def C_propagate_env} makes the start of a C + command (e.g., \<^theory_text>\<open>C_file\<close>, + \<^theory_text>\<open>C\<close>) initialized with the environment of + the previous C command if existing. +\<close> + +(*<*) +end +(*>*) diff --git a/C11-FrontEnd/examples/C1.thy b/C11-FrontEnd/examples/C1.thy index eb4c57fa67f0b18d0767e9224b49aa740fe7aa54..4201d4bd865f875afa2a43ba473436175c1de804 100644 --- a/C11-FrontEnd/examples/C1.thy +++ b/C11-FrontEnd/examples/C1.thy @@ -248,11 +248,6 @@ int b,c,d/*@@ \<approx>setup\<Down> \<open>fn s => fn x => fn env => @{print_top subsection \<open>Reporting of Positions and Contextual Update of Environment\<close> -text \<open> -To show the content of the parsing environment, the ML antiquotations \<open>print_top'\<close> and \<open>print_stack'\<close> -will respectively be used instead of \<open>print_top\<close> and \<open>print_stack\<close>. -\<close> - subsubsection \<open>1\<close> declare [[ML_source_trace = false]] @@ -291,8 +286,6 @@ int b = 7 / (3) * 50 ;\<close> \<close> */; \<close> - - C \<comment> \<open>Nesting C code and propagating the C environment\<close> \<open> int a = 0; int b = 7 / (3) * 50 diff --git a/C11-FrontEnd/examples/C3.thy b/C11-FrontEnd/examples/C3.thy index 67177fe31f60789dd1dcfc9c6be5f86852c814cb..6495fae23545d09535c1800279ca21c3f7160fa6 100644 --- a/C11-FrontEnd/examples/C3.thy +++ b/C11-FrontEnd/examples/C3.thy @@ -76,9 +76,7 @@ unsigned is_prime_linear(unsigned n) /* No factors. */ return 1; -}\<close> - -C\<open> +} /* * Determine if the given number 'n' is prime. diff --git a/C11-FrontEnd/examples/tp-preuve-c/README b/C11-FrontEnd/examples/tp-preuve-c/README deleted file mode 100644 index 8f4086542ac8784611a7e703455200896ea8db42..0000000000000000000000000000000000000000 --- a/C11-FrontEnd/examples/tp-preuve-c/README +++ /dev/null @@ -1,3 +0,0 @@ - -/usr/local/isabelle/Isabelle2016-1 jedit -d autocorres-1.3 -l AutoCorres tp06a.thy - diff --git a/C11-FrontEnd/examples/tp-preuve-c/intro.thy b/C11-FrontEnd/examples/tp-preuve-c/intro.thy deleted file mode 100644 index 528f31d36cc2821532182ce610fd0fff11140d8c..0000000000000000000000000000000000000000 --- a/C11-FrontEnd/examples/tp-preuve-c/intro.thy +++ /dev/null @@ -1,106 +0,0 @@ -theory intro -imports "AutoCorres.AutoCorres" -begin - -(*** - Equivalents to some of the terms from Xavier Rival's lecture on Coq: slides 6--7. - http://www.di.ens.fr/~rival/semverif-2017/sem-04-coq.pdf - ***) - -term "0" -term "1" -term "True" -typ nat -typ bool -term "\<lambda>(n::nat). n + 1" -value "(\<lambda>(n::nat). n + 1) 8" -term "\<exists>p::nat. 8 = 2 * p" -term "\<And>a b. a \<and> b \<Longrightarrow> a" -term "\<forall>a b. a \<and> b \<longrightarrow> a" - -definition myzero :: nat -where - "myzero \<equiv> 0" - -definition myone :: nat -where - "myone \<equiv> Suc 0" - -fun myincr :: "nat \<Rightarrow> nat" -where - "myincr n = n + 1" -print_theorems -thm myincr.simps (* automatically generated rewrite rules *) - -(*** - Some simple proofs - ***) - -(* To type "\<and>", type "/" and then "\". *) -(* Similarly, "-->" gives "\<longrightarrow>", and "==>" gives "\<Longrightarrow>". *) -(* Alternatively, type (part of) the name in latex (<backslash> Longrightarrow...). *) -lemma "(a \<and> b) \<longrightarrow> (b \<and> a)" - find_theorems intro - apply (rule impI) - find_theorems elim - apply (erule conjE) - apply (rule conjI) - apply assumption - apply assumption - done - -(* You can Ctrl-click on rules and symbols to jump to their definitions. *) -(* Pressing Ctrl-` jumps back to the previous file. *) - -lemma "(a \<and> b) \<longrightarrow> (a \<and> b)" - apply simp (* Apply rewriting rules: LHS = RHS. *) - done - -lemma "(a \<and> b) \<longrightarrow> (a \<and> b)" - apply clarsimp (* Safely apply rewriting rules and intro/elim/dest rules. *) - done - -lemma "(a \<and> b) \<longrightarrow> (a \<and> b)" - apply auto (* Try lots of stuff... sometimes gives a mess. *) - done - -lemma "(a \<and> b) \<longrightarrow> (b \<and> a)" - sledgehammer (* Ask Miami... *) - oops (* give up on proof *) - -(* Type "[" then "|" for "\<lbrakk>". *) -lemma "\<lbrakk> a; b \<rbrakk> \<Longrightarrow> b \<and> a" - sorry (* cheat *) - -lemma "myincr myzero = myone" - apply clarsimp (* apply myincr.simps *) - unfolding myzero_def myone_def - apply (rule refl) - done - -(*** - Equivalents to some of the Hoare rules in Antoine Miné's lecture on Axiomatic semantics: - slides 13--23 - http://www.di.ens.fr/~rival/semverif-2015/sem-07-hoare.pdf - ***) - -find_theorems "\<lbrace>_\<rbrace> _ \<lbrace>_\<rbrace>!" -thm skip_nf (* axiom for skip *) -thm validNF_return (* like rule of assignment *) -thm validNF_weaken_pre (* like rule of consequence *) -thm validNF_if_split (* Tests *) -thm validNF_bind (* Sequences *) -thm validNF_whileLoop (* loops *) - -lemma "\<lbrace>\<lambda>s. True\<rbrace> do i \<leftarrow> return 2; return (i + 3) od \<lbrace>\<lambda>r s. r = 5 \<rbrace>!" - apply (rule validNF_bind) - apply (rule validNF_return) - apply (rule validNF_weaken_pre) - apply (rule validNF_return) - apply simp - done -(* try: apply wp - to activate the Verification Condition Generator / Weakest Precondition Calculator *) - -end - diff --git a/C11-FrontEnd/examples/tp-preuve-c/tp06a.c b/C11-FrontEnd/examples/tp-preuve-c/tp06a.c deleted file mode 100644 index dc217a1f02a77c2c030070df26b68c260357f88a..0000000000000000000000000000000000000000 --- a/C11-FrontEnd/examples/tp-preuve-c/tp06a.c +++ /dev/null @@ -1,21 +0,0 @@ -/* - * Determiner si le nombre donne 'n' est premier. - * - * Nous renvoyons 0 si 'n' est compose, ou pas-zero si 'n' est premier. - */ -unsigned int is_prime(unsigned int n) -{ - /* Les nombres plus petits que 2 ne sont pas premiers. */ - if (n < 2) - return 0; - - /* Trouver le premier non insignifiant facteur de 'n'. */ - unsigned int i = 2; - while (n % i != 0) { - i++; - } - - /* Si le premier facteur est 'n' lui-meme, 'n' est premier. */ - return (i == n); -} - diff --git a/C11-FrontEnd/examples/tp-preuve-c/tp06a.thy b/C11-FrontEnd/examples/tp-preuve-c/tp06a.thy deleted file mode 100644 index f948141cb3358162de19571e5003a401330e1877..0000000000000000000000000000000000000000 --- a/C11-FrontEnd/examples/tp-preuve-c/tp06a.thy +++ /dev/null @@ -1,147 +0,0 @@ -theory tp06a -imports "AutoCorres.AutoCorres" "~~/src/HOL/Number_Theory/Number_Theory" -begin - -(* Parse the C file into the SIMPL language. *) -install_C_file "tp06a.c" - -find_theorems (140) name:"tp06" - -context tp06a begin - -thm is_prime_impl (* The specification \<Gamma> maps names to program terms. *) -thm is_prime_body_def (* This is the SIMPL model of the imported C function. *) - -end - -(* Abstract the SIMPL model into a monadic model. *) -autocorres[ts_rules = nondet, unsigned_word_abs = is_prime is_prime] "tp06a.c" -print_theorems - -context tp06a begin -typ "('a,'b) nondet_monad" -thm is_prime'_def (* This is the monadic model of the C function. *) -thm is_prime'_ac_corres (* This lemma relates monadic and SIMP models. *) - -(* Loop invariant for "is_prime". *) -definition - is_prime_inv :: "nat \<Rightarrow> nat \<Rightarrow> bool" -where - "is_prime_inv i n \<equiv> i>1 \<and> 2 \<le> n \<and> n \<ge> i \<and> (\<forall>k<i. k>1 \<longrightarrow> n mod k \<noteq> 0) " - -(* The loop invariant holds coming into the loop. *) -lemma is_prime_precond_implies_inv: - "\<lbrakk> 2 \<le> n; n \<le> UINT_MAX \<rbrakk> \<Longrightarrow> is_prime_inv 2 n" - by(auto simp: is_prime_inv_def) - - -(* The loop invariant holds for each loop iteration. *) -lemma is_prime_body_obeys_inv: - "\<lbrakk> is_prime_inv i n; n mod i \<noteq> 0 \<rbrakk> \<Longrightarrow> is_prime_inv (i + 1) n" - unfolding is_prime_inv_def apply auto - using less_SucE apply auto - by (metis Suc_leI le_neq_implies_less mod_self neq0_conv) - -find_theorems (205) "prime (_::nat) = _" -thm prime_nat_iff' - -find_theorems "_ dvd _" "_ mod _" -thm dvd_eq_mod_eq_0[symmetric] - -(* Q4. The loop invariant implies the post-condition. *) -lemma is_prime_inv_implies_postcondition: - "\<lbrakk> is_prime_inv i n; n mod i = 0 \<rbrakk> \<Longrightarrow> (i = n) \<longleftrightarrow> prime n" -unfolding is_prime_inv_def -proof (rule iffI, elim conjE, hypsubst) - assume "2 \<le> n" and "\<forall>k<n. 1 < k \<longrightarrow> n mod k \<noteq> 0" - show "prime n" - by (metis Suc_eq_plus1 Suc_le_eq \<open>2 \<le> n\<close> \<open>\<forall>k<n. 1 < k \<longrightarrow> n mod k \<noteq> 0\<close> - add.left_neutral dvd_eq_mod_eq_0 gr_implies_not0 less_one linorder_neqE_nat - nat_dvd_not_less numeral_2_eq_2 prime_factor_nat prime_gt_1_nat) -next - assume "1 < i \<and> 2 \<le> n \<and> i \<le> n \<and> (\<forall>k<i. 1 < k \<longrightarrow> n mod k \<noteq> 0)" - and "n mod i = 0" and "prime n " - have *: "1 < i" - using \<open>1 < i \<and> 2 \<le> n \<and> i \<le> n \<and> (\<forall>k<i. 1 < k \<longrightarrow> n mod k \<noteq> 0)\<close> by blast - show "i = n" - apply(insert `prime n` *) - apply(subst (asm) prime_nat_iff, clarify) - apply(subst (asm) dvd_eq_mod_eq_0) - apply(erule_tac x=i in allE) - by(simp only: `n mod i = 0`,auto) -qed - -(* Measure function for "is_prime". Must be strictly decreasing - * for each loop iteration. *) -definition - is_prime_measure :: "nat \<Rightarrow> nat \<Rightarrow> nat" -where - "is_prime_measure i n \<equiv> (n-i) (*** Q5. TODO ***)" - -(* The loop measure decrements each loop iteration. *) -lemma is_prime_body_obeys_measure: - "\<lbrakk> is_prime_inv i n; n mod i \<noteq> 0 \<rbrakk> - \<Longrightarrow> is_prime_measure i n > is_prime_measure (i + 1) n" - unfolding is_prime_measure_def is_prime_inv_def - apply auto using le_eq_less_or_eq by auto - -(* - * Show that "is_prime' n" is correct. - * - * AutoCorres has applied "word abstraction" to this function, - * meaning that you are able to reason using "nats" instead of - * "word32" data types, at the price of having to reason that - * your values do not overflow UINT_MAX. - *) -lemma is_prime_correct: - "\<lbrace>\<lambda>s. n \<le> UINT_MAX \<rbrace> is_prime' n \<lbrace>\<lambda>r s. r = (if prime n then 1 else 0) \<rbrace>!" - (* Move the precondition into the assumptions. *) - apply (rule validNF_assume_pre) - (* Unfold the program body. *) - apply (unfold is_prime'_def) - - (* Annotate the loop with an invariant and measure. *) - apply (subst whileLoop_add_inv [ - where I="\<lambda>r s. is_prime_inv r n" - and M="(\<lambda>(r, s). Suc n - r)"]) - - (* - * Run "wp" to generate verification conditions. - *) -proof (wp, intro conjI, elim conjE,simp_all) - (* 1. The loop body obeys the invariant; *) - fix s r - assume "n \<le> UINT_MAX" and "is_prime_inv r n" and "0 < n mod r" - then show "is_prime_inv (Suc r) n" - using is_prime_body_obeys_inv by auto -next - (* 2. The loop body causes the measure to decrease; *) - fix r fix sa sb::lifted_globals - assume "n \<le> UINT_MAX" and "is_prime_inv r n \<and> 0 < n mod r \<and> sb = sa" - then show "n - r < Suc n - r" - by (simp add: Suc_diff_le tp06a.is_prime_inv_def) -next - (* The loop counter never exceeds UINT_MAX. *) - fix r fix sa sb::lifted_globals (* very ugly that this pops up ... *) - assume "n \<le> UINT_MAX" and "is_prime_inv r n \<and> 0 < n mod r \<and> sb = sa" - then show "Suc r \<le> UINT_MAX" - by (metis Suc_eq_plus1 dual_order.trans gr_implies_not0 is_prime_body_obeys_inv - tp06a.is_prime_inv_def) -next - fix r - assume "n \<le> UINT_MAX" and "is_prime_inv r n" and "n mod r = 0" - then show " (r = n \<longrightarrow> prime n) \<and> (r \<noteq> n \<longrightarrow> \<not> prime n)" - by (simp add: tp06a.is_prime_inv_implies_postcondition) -next - (* The invariant implies the post-condition of the function. *) - assume " n \<le> UINT_MAX" - then show " (n < 2 \<longrightarrow> \<not> prime n) \<and> (\<not> n < 2 \<longrightarrow> is_prime_inv 2 n)" - by (metis le_antisym nat_le_linear nat_less_le prime_ge_2_nat - tp06a.is_prime_precond_implies_inv) -qed - - -end - -end - diff --git a/C11-FrontEnd/examples/tp-preuve-c/tp06b.thy b/C11-FrontEnd/examples/tp-preuve-c/tp06b.thy deleted file mode 100644 index ed0b42c1d0acc13d9e738ce1c37fa607de13e58e..0000000000000000000000000000000000000000 --- a/C11-FrontEnd/examples/tp-preuve-c/tp06b.thy +++ /dev/null @@ -1,259 +0,0 @@ -theory tp06b -imports "AutoCorres.AutoCorres" "~~/src/HOL/Number_Theory/Number_Theory" -begin - -(* Parse the C file into SIMPL. *) -install_C_file "tp06a.c" - -(* Note: The autocorres tool is not applied. - Here we reason on the SIMPL model directly *) - -context tp06a begin - -thm is_prime_impl (* The specification \<Gamma> maps names to program terms. *) -thm is_prime_body_def (* This is the SIMPL model of the imported C function. *) - -term "unat" -(* with associated tactic: apply unat_arith *) - -(* Nat version of is_prime_inv. *) -definition - is_prime_inv' :: "nat \<Rightarrow> nat \<Rightarrow> bool" -where - "is_prime_inv' i n \<equiv> 2 \<le> i \<and> i \<le> n \<and> (\<forall>m < i. 2 \<le> m \<longrightarrow> n mod m \<noteq> 0)" - -(* Loop invariant for "is_prime". *) -definition - is_prime_inv :: "word32 \<Rightarrow> word32 \<Rightarrow> word32 \<Rightarrow> bool" -where - "is_prime_inv i init_n curr_n \<equiv> is_prime_inv' (unat i) (unat init_n) \<and> init_n = curr_n" - -(* Measure function for "is_prime". Must be strictly decreasing - * for each loop iteration. *) -definition - is_prime_measure :: "word32 \<Rightarrow> word32 \<Rightarrow> word32 \<Rightarrow> nat" -where - "is_prime_measure i init_n curr_n \<equiv> unat init_n - unat i" - -declare is_prime_inv_def [simp] - -(* The loop invariant holds coming into the loop. *) -lemma is_prime_precond_implies_inv: - assumes "n \<ge> 2" - shows "is_prime_inv 2 n n" -proof - - have "unat n \<ge> 2" using assms by unat_arith - then show ?thesis by (clarsimp simp: is_prime_inv'_def ) -qed - - -lemma is_prime_body_obeys_inv': - assumes "is_prime_inv' i n" - and "n mod i \<noteq> 0" - shows "is_prime_inv' (i + 1) n" -unfolding is_prime_inv'_def -proof(clarsimp , intro conjI) - show "Suc 0 \<le> i" using assms(1) is_prime_inv'_def by auto -next - show "Suc i \<le> n" by (metis Suc_leI assms(1) assms(2) le_neq_implies_less mod_self - tp06a.is_prime_inv'_def) -next - have * :"\<forall>m<i. 2 \<le> m \<longrightarrow> 0 < n mod m" using assms(1) tp06a.is_prime_inv'_def by blast - show "\<forall>m<Suc i. 2 \<le> m \<longrightarrow> 0 < n mod m" using "*" assms(2) less_antisym by blast -qed - -(* The loop invariant holds for each loop iteration. *) -lemma is_prime_body_obeys_inv: - "\<lbrakk> is_prime_inv i init_n curr_n; curr_n mod i \<noteq> 0 \<rbrakk> \<Longrightarrow> is_prime_inv (i + 1) init_n curr_n" - apply clarsimp - apply (drule is_prime_body_obeys_inv') - apply (metis unat_eq_zero unat_mod) - apply (clarsimp simp: is_prime_inv'_def) -proof - - assume a1: "curr_n mod i \<noteq> 0" - assume a2: "Suc 0 \<le> unat i" - assume a3: "Suc (unat i) \<le> unat curr_n" - assume a4: "\<forall>m<Suc (unat i). 2 \<le> m \<longrightarrow> 0 < unat curr_n mod m" - { fix nn :: nat - have ff1: "\<And>n na. (n::nat) < na \<or> \<not> n + 1 \<le> na" - by presburger - have ff2: "of_nat (unat curr_n mod unat i) \<noteq> (0::32 word)" - using a1 by (metis word_arith_nat_defs(7)) - have ff3: "unat (1::32 word) = 1 \<or> (1::32 word) = 0" - by (metis (no_types) Groups.add_ac(2) Suc_eq_plus1 add.right_neutral unatSuc unat_0) - have ff4: "unat i \<noteq> 0" - using a2 by linarith - have "unat (1 + i) = 1 + unat i \<or> (0::32 word) = 1" - using ff3 a3 by (metis (no_types) Groups.add_ac(2) Suc_eq_plus1 le_simps(2) - less_Suc_unat_less_bound unat_add_lem) - then have "unat i \<noteq> 1 \<and> 1 + i \<noteq> 0" - using ff4 ff2 by (metis Groups.add_ac(2) Suc_eq_plus1 add_0_left mod_less_divisor nat.simps(3) - neq0_conv not_less_eq semiring_1_class.of_nat_simps(1) unat_0) - then have "2 \<le> unat (i + 1) \<and> unat (i + 1) \<le> unat curr_n \<and> - (\<not> nn < unat (i + 1) \<or> \<not> 2 \<le> nn \<or> 0 < unat curr_n mod nn)" - using ff4 ff1 a4 a3 by (metis (no_types) Divides.mod_less Groups.add_ac(2) Suc_eq_plus1 - le_less linorder_not_less mod2_gr_0 neq0_conv unatSuc) } - then show "2 \<le> unat (i + 1) \<and> unat (i + 1) \<le> unat curr_n \<and> - (\<forall>n<unat (i + 1). 2 \<le> n \<longrightarrow> 0 < unat curr_n mod n)" - - by blast - qed - - -lemma unat_plus_one: - "a < (b :: 'a::len word) \<Longrightarrow> unat (a + 1) = unat a + 1" - using less_is_non_zero_p1 word_overflow_unat by blast - -(* The loop measure decrements each loop iteration. *) -lemma is_prime_body_obeys_measure: - "\<lbrakk> is_prime_inv i init_n curr_n; curr_n mod i \<noteq> 0 \<rbrakk> - \<Longrightarrow> is_prime_measure i init_n curr_n > is_prime_measure (i + 1) init_n curr_n" - apply (clarsimp simp: is_prime_inv'_def is_prime_measure_def) - apply (case_tac "curr_n = i") - apply clarsimp - apply (metis mod_self unat_eq_zero unat_mod) - apply (subst unat_plus_one [where b=curr_n]) - apply (metis word_le_less_eq word_le_nat_alt) - apply (metis One_nat_def add.commute add_Suc diff_less_mono2 le_neq_implies_less - lessI monoid_add_class.add.left_neutral word_unat.Rep_inject) - done - -(* The loop invariant implies the post-condition. *) -lemma is_prime_inv_implies_postcondition: - "\<lbrakk> is_prime_inv i init_n curr_n; curr_n mod i = 0 \<rbrakk> - \<Longrightarrow> prime (unat init_n) \<longleftrightarrow> (i = curr_n)" -proof - - have prime_nat_code: "(prime :: nat \<Rightarrow> bool) = (\<lambda>p. p > 1 \<and> (\<forall>n \<in> {1<..<p}. ~ n dvd p))" - apply (rule ext) - using prime_nat_naive by auto -show "\<lbrakk> is_prime_inv i init_n curr_n; curr_n mod i = 0 \<rbrakk> \<Longrightarrow> ?thesis" - apply (clarsimp simp: is_prime_inv'_def) - apply (rule iffI) - apply (clarsimp simp: prime_nat_code) - apply (metis (no_types, hide_lams) greaterThanLessThan_iff le_neq_implies_less less_eq_Suc_le - less_numeral_extra(3) mod_greater_zero_iff_not_dvd numeral_2_eq_2 unat_0 unat_mod - word_unat.Rep_inject) - apply (clarsimp simp: prime_nat_iff') - apply (drule_tac x=n in spec) - apply (metis Suc_1 arith_is_1 dvd_imp_mod_0 eq_iff less_eq_Suc_le not_less_eq_eq ) - done -qed - -(* - * Show that "is_prime' n" is correct. - * - * Note that there are two ways of writing variables: \<acute>n and - * (n_' s). The first fetches the value "n" from an implicitly - * specified state, while the second fetches the value "n" from state - * "s". While less pretty, it is generally easier to use the latter. - *) -lemma is_prime_correct: - "\<Gamma> \<turnstile>\<^sub>t {s. n_' s = n } - \<acute>ret__unsigned :== PROC is_prime(n) - {t. ret__unsigned_' t = (if prime (unat n) then 1 else 0) }" - (* Unfold the program's body. *) - apply (hoare_rule HoareTotal.ProcNoRec1) - apply (unfold creturn_def) - - (* Annotate the loop with an invariant and measure. *) - apply (subst whileAnno_def) - apply (subst whileAnno_def [symmetric, where - I="{s. is_prime_inv (i_' s) n (n_' s) }" and - V="measure (\<lambda>s. is_prime_measure (i_' s) n (n_' s))"]) - - (* - * Run the VCG. - * - * You will need to prove (i) the function's precondition implies your - * loop's invariant; (ii) the loop invariant holds each time the loop - * executes; (iii) the measure decreases each time the loop exceutes; - * and (iv) when the loop has finished, the loop invariant implies the - * functions post-condition. - * - * Spend some time looking at the vcg's output to make sure you know - * what the goals it is leaving you correspond to. - *) - apply vcg - apply (clarsimp simp del: is_prime_inv_def) - apply rule - apply (fastforce dest: x_less_2_0_1) - apply (clarsimp simp del: is_prime_inv_def) - apply (rule is_prime_precond_implies_inv, simp) - apply (clarsimp simp del: is_prime_inv_def) - apply (intro conjI) - apply (clarsimp simp: is_prime_inv'_def) - apply (metis le_eq_less_or_eq less_is_non_zero_p1 mod_self - unat_eq_zero unat_mod word_less_nat_alt word_unat.Rep_inject) - apply (erule (1) is_prime_body_obeys_measure) - apply (erule (1) is_prime_body_obeys_inv) - apply (drule is_prime_inv_implies_postcondition) - apply simp - apply clarsimp - done - - -lemma is_prime_correct_structured: - "\<Gamma> \<turnstile>\<^sub>t {s. n_' s = n } - \<acute>ret__unsigned :== PROC is_prime(n) - {t. ret__unsigned_' t = (if prime (unat n) then 1 else 0) }" - (* Unfold the program's body. *) - apply (hoare_rule HoareTotal.ProcNoRec1,unfold creturn_def) - - (* Annotate the loop with an invariant and measure. *) - apply (subst whileAnno_def) - apply (subst whileAnno_def [symmetric, where - I="{s. is_prime_inv (i_' s) n (n_' s) }" and - V="measure (\<lambda>s. is_prime_measure (i_' s) n (n_' s))"]) - - proof vcg (* run vcg, the verification condition generator *) - text{* prove (i) the function's precondition implies your loop's invariant *} - fix n::"32 word" - show "(n < scast (2::32 signed word) - \<longrightarrow> scast (0::32 signed word) = (if prime (unat n) then 1 else 0)) \<and> - (\<not> n < scast (2::32 signed word) - \<longrightarrow> scast (2::32 signed word) \<noteq> (0::32 word) - \<and> is_prime_inv (scast (2::32 signed word)) n n)" - apply (clarsimp simp del: is_prime_inv_def, rule) - apply (fastforce dest: x_less_2_0_1, rule) - by (rule is_prime_precond_implies_inv, simp) - next - text{* prove loop correctness: *} - fix n' i ::"32 word" - assume *:"is_prime_inv i n n'" - and **:"n' mod i \<noteq> scast (0::32 signed word)" - have ***: "i + 1 \<noteq> 0" apply (insert * **, clarsimp simp del: is_prime_inv_def) - apply (clarsimp simp: is_prime_inv'_def) - by (metis le_eq_less_or_eq less_is_non_zero_p1 mod_self - unat_eq_zero unat_mod word_less_nat_alt word_unat.Rep_inject) - show "i + scast (1::32 signed word) \<noteq> (0::32 word) - \<and> is_prime_measure (i + scast (1::32 signed word)) n n' < is_prime_measure i n n' - \<and> is_prime_inv (i + scast (1::32 signed word)) n n'" - proof(auto simp: *** simp del: is_prime_inv_def) - text{* This breaks down to prove (ii) the loop measure decreases *} - show "is_prime_measure (i + 1) n n' < is_prime_measure i n n'" - using "*" "**" is_prime_body_obeys_measure by auto - next - text{* and to prove (iii) invariant holds each time the loop executes*} - show "is_prime_inv (i + 1) n n'" - using "*" "**" is_prime_body_obeys_inv by auto - qed - next - text{* prove (iv) when the loop has finished, the loop invariant implies the post-condition*} - fix n' i ::"32 word" - assume *:"is_prime_inv i n n'" - and **:"\<not> n' mod i \<noteq> scast (0::32 signed word)" - show "scast (if i = n' then 1 else (0::32 signed word)) = - (if prime (unat n) then 1 else 0)" - by (insert * **,drule is_prime_inv_implies_postcondition) clarsimp+ - qed - -text{* The comparison of these two styles is interesting: one the one hand, the apply style is -much shorter since all the hairy details of typing words and constants 0 and 1's were implicitly -and safely inferred from prior proof states; on the other hand, a fine eye for these gory details -reveals much of the underlying semantic complexity going on in this proof. *} - - -end - -end - diff --git a/C11-FrontEnd/generated/c_grammar_fun.grm.sig b/C11-FrontEnd/generated/c_grammar_fun.grm.sig index 41a69798a612706399880bd0501743d2a103d1bc..15571f1614553a1b9901d516cf062f14d48d7f66 100644 --- a/C11-FrontEnd/generated/c_grammar_fun.grm.sig +++ b/C11-FrontEnd/generated/c_grammar_fun.grm.sig @@ -5,284 +5,980 @@ struct (*#line 8674.1 "c_grammar_fun.grm.sml"*) datatype svalue0 = VOID | ntVOID of unit | clangcversion of (C_Ast.ClangCVersion) | x5f_x5f_builtin_types_compatible_p of (string) | x5f_x5f_builtin_offsetof of (string) | x5f_x5f_builtin_va_arg of (string) | x5f_x5f_imag_x5f_x5f of (string) | x5f_x5f_real_x5f_x5f of (string) | x5f_x5f_extension_x5f_x5f of (string) | x5f_x5f_attribute_x5f_x5f of (string) | tyident of (C_Ast.ident) | ident of (C_Ast.ident) | cstr of (C_Ast.cString) | cfloat of (C_Ast.cFloat) | cint of (C_Ast.cInteger) | cchar of (C_Ast.cChar) | while0 of (string) | volatile of (string) | void of (string) | unsigned of (string) | union of (string) | x5f_x5f_thread of (string) | typeof of (string) | typedef of (string) | switch of (string) | struct0 of (string) | x5f_Static_assert of (string) | static of (string) | sizeof of (string) | signed of (string) | short of (string) | return0 of (string) | restrict of (string) | register of (string) | x5f_Nonnull of (string) | x5f_Nullable of (string) | x5f_Noreturn of (string) | x5f_x5f_label_x5f_x5f of (string) | long of (string) | x5f_x5f_int_x31_x32_x38 of (string) | int of (string) | inline of (string) | if0 of (string) | goto of (string) | x5f_Generic of (string) | for0 of (string) | float of (string) | extern of (string) | enum of (string) | else0 of (string) | double of (string) | do0 of (string) | default of (string) | x5f_Complex of (string) | continue of (string) | const of (string) | char of (string) | case0 of (string) | x5f_Bool of (string) | break of (string) | auto of (string) | asm of (string) | x5f_Atomic of (string) | alignas of (string) | alignof of (string) | x2e_x2e_x2e of (string) | x7d of (string) | x7b of (string) | x3b of (string) | x2c of (string) | x3e_x3e_x3d of (string) | x3c_x3c_x3d of (string) | x7c_x3d of (string) | x5e_x3d of (string) | x26_x3d of (string) | x25_x3d of (string) | x2f_x3d of (string) | x2a_x3d of (string) | x2d_x3d of (string) | x2b_x3d of (string) | x3d of (string) | x3a of (string) | x3f of (string) | x7c_x7c of (string) | x26_x26 of (string) | x7c of (string) | x5e of (string) | x21_x3d of (string) | x3d_x3d of (string) | x3e_x3d of (string) | x3e of (string) | x3c_x3d of (string) | x3c of (string) | x3e_x3e of (string) | x3c_x3c of (string) | x26 of (string) | x25 of (string) | x2f of (string) | x2a of (string) | x2d of (string) | x2b of (string) | x2d_x2d of (string) | x2b_x2b of (string) | x7e of (string) | x21 of (string) | x2e of (string) | x2d_x3e of (string) | x5d of (string) | x5b of (string) | x29 of (string) | x28 of (string) | attribute_params of ( ( CExpr list ) Reversed) | attribute of (CAttr Maybe) | attribute_list of ( ( CAttr list ) Reversed) | attr of (CAttr list) | attrs of (CAttr list) | attrs_opt of (CAttr list) | identifier of (Ident) | clang_version_literal of (ClangCVersion) | string_literal_list of ( ( CString list ) Reversed) | string_literal of (CStrLit) | constant of (CConst) | constant_expression of (CExpr) | assignment_expression_opt of (CExpr Maybe) | expression_opt of (CExpr Maybe) | comma_expression of ( ( CExpr list ) Reversed) | expression of (CExpr) | assignment_operator of (CAssignOp Located) | assignment_expression of (CExpr) | conditional_expression of (CExpr) | logical_or_expression of (CExpr) | logical_and_expression of (CExpr) | inclusive_or_expression of (CExpr) | exclusive_or_expression of (CExpr) | and_expression of (CExpr) | equality_expression of (CExpr) | relational_expression of (CExpr) | shift_expression of (CExpr) | additive_expression of (CExpr) | multiplicative_expression of (CExpr) | cast_expression of (CExpr) | unary_operator of (CUnaryOp Located) | unary_expression of (CExpr) | argument_expression_list of ( ( CExpr list ) Reversed) | postfix_expression of (CExpr) | offsetof_member_designator of ( ( CDesignator list ) Reversed) | generic_assoc of ( ( CDecl Maybe * CExpr ) ) | generic_assoc_list of ( ( ((CDecl Maybe * CExpr)) list ) Reversed) | primary_expression of (CExpr) | array_designator of (CDesignator) | designator of (CDesignator) | designator_list of ( ( CDesignator list ) Reversed) | designation of (CDesignator list) | initializer_list of (CInitList Reversed) | initializer_opt of (CInit Maybe) | initializer of (CInit) | postfix_abstract_declarator of (CDeclrR) | unary_abstract_declarator of (CDeclrR) | postfix_array_abstract_declarator of ( ( CDeclrR -> CDeclrR ) ) | array_abstract_declarator of ( ( CDeclrR -> CDeclrR ) ) | postfixing_abstract_declarator of ( ( CDeclrR -> CDeclrR ) ) | abstract_declarator of (CDeclrR) | type_name of (CDecl) | identifier_list of ( ( Ident list ) Reversed) | parameter_declaration of (CDecl) | parameter_list of ( ( CDecl list ) Reversed) | parameter_type_list of ( ( CDecl list * Bool ) ) | postfix_old_function_declarator of (CDeclrR) | old_function_declarator of (CDeclrR) | function_declarator_old of (CDeclr) | paren_identifier_declarator of (CDeclrR) | postfix_identifier_declarator of (CDeclrR) | unary_identifier_declarator of (CDeclrR) | identifier_declarator of (CDeclrR) | simple_paren_typedef_declarator of (CDeclrR) | paren_postfix_typedef_declarator of (CDeclrR) | paren_typedef_declarator of (CDeclrR) | clean_postfix_typedef_declarator of (CDeclrR) | clean_typedef_declarator of (CDeclrR) | parameter_typedef_declarator of (CDeclrR) | typedef_declarator of (CDeclrR) | asm_opt of (CStrLit Maybe) | declarator of (CDeclrR) | type_qualifier_list of ( ( CTypeQual list ) Reversed) | type_qualifier of (CTypeQual) | enumerator of ( ( Ident * CExpr Maybe ) ) | enumerator_list of ( ( ((Ident * CExpr Maybe)) list ) Reversed) | enum_specifier of (CEnum) | struct_identifier_declarator of ( ( CDeclr Maybe * CExpr Maybe ) ) | struct_declarator of ( ( CDeclr Maybe * CExpr Maybe ) ) | struct_declaring_list of (CDecl) | struct_default_declaring_list of (CDecl) | struct_declaration of (CDecl) | struct_declaration_list of ( ( CDecl list ) Reversed) | struct_or_union of (CStructTag Located) | struct_or_union_specifier of (CStructUnion) | elaborated_type_name of (CTypeSpec) | typedef_type_specifier of ( ( CDeclSpec list ) Reversed) | typedef_declaration_specifier of ( ( CDeclSpec list ) Reversed) | sue_type_specifier of ( ( CDeclSpec list ) Reversed) | sue_declaration_specifier of ( ( CDeclSpec list ) Reversed) | basic_type_specifier of ( ( CDeclSpec list ) Reversed) | basic_declaration_specifier of ( ( CDeclSpec list ) Reversed) | basic_type_name of (CTypeSpec) | type_specifier of (CDeclSpec list) | alignment_specifier of (CAlignSpec) | function_specifier of (CFunSpec) | storage_class of (CStorageSpec) | declaration_qualifier_without_types of (CDeclSpec) | declaration_qualifier of (CDeclSpec) | declaration_qualifier_list of ( ( CDeclSpec list ) Reversed) | declaration_specifier of (CDeclSpec list) | declaring_list of (CDecl) | asm_attrs_opt of ( ( CStrLit Maybe * CAttr list ) ) | default_declaring_list of (CDecl) | declaration_list of ( ( CDecl list ) Reversed) | declaration of (CDecl) | asm_clobbers of ( ( CStrLit list ) Reversed) | asm_operand of (CAsmOperand) | nonnull_asm_operands of ( ( CAsmOperand list ) Reversed) | asm_operands of (CAsmOperand list) | maybe_type_qualifier of (CTypeQual Maybe) | asm_statement of (CAsmStmt) | jump_statement of (CStat) | iteration_statement of (CStat) | selection_statement of (CStat) | expression_statement of (CStat) | label_declarations of ( ( Ident list ) Reversed) | nested_function_definition of (CFunDef) | nested_declaration of (CBlockItem) | block_item of (CBlockItem) | block_item_list of ( ( CBlockItem list ) Reversed) | leave_scope of (unit) | enter_scope of (unit) | compound_statement of (CStat) | labeled_statement of (CStat) | statement of (CStat) | function_declarator of (CDeclr) | function_definition of (CFunDef) | external_declaration of (CExtDecl) | ext_decl_list of ( ( CExtDecl list ) Reversed) | translation_unit of (CTranslUnit) -fun find_list msg mk_name l = - let val tab = - fold (fn (name, occ) => - fold (fn name => fn (tab, nb) => (Inttab.update (nb, name) tab, nb + 1)) - (if occ = 1 then [name] - else map_range (mk_name name) occ)) - l - (Inttab.empty, 0) - |> #1 - in - fn i => case Inttab.lookup tab i of NONE => error msg | SOME name => name - end -val type_reduce = find_list "reduce type not found" K [ - (" (CTranslUnit)", 1), - (" ( ( CExtDecl list ) Reversed)", 3), - (" (CExtDecl)", 4), - (" (CFunDef)", 14), - (" (CDeclr)", 1), - (" (CStat)", 7), - (" (CStat)", 4), - (" (CStat)", 2), - (" (unit)", 1), - (" (unit)", 1), - (" ( ( CBlockItem list ) Reversed)", 2), - (" (CBlockItem)", 2), - (" (CBlockItem)", 3), - (" (CFunDef)", 5), - (" ( ( Ident list ) Reversed)", 2), - (" (CStat)", 2), - (" (CStat)", 3), - (" (CStat)", 4), - (" (CStat)", 5), - (" (CAsmStmt)", 4), - (" (CTypeQual Maybe)", 2), - (" (CAsmOperand list)", 2), - (" ( ( CAsmOperand list ) Reversed)", 2), - (" (CAsmOperand)", 3), - (" ( ( CStrLit list ) Reversed)", 2), - (" (CDecl)", 5), - (" ( ( CDecl list ) Reversed)", 2), - (" (CDecl)", 5), - (" ( ( CStrLit Maybe * CAttr list ) )", 1), - (" (CDecl)", 3), - (" (CDeclSpec list)", 3), - (" ( ( CDeclSpec list ) Reversed)", 6), - (" (CDeclSpec)", 4), - (" (CDeclSpec)", 3), - (" (CStorageSpec)", 6), - (" (CFunSpec)", 2), - (" (CAlignSpec)", 2), - (" (CDeclSpec list)", 3), - (" (CTypeSpec)", 12), - (" ( ( CDeclSpec list ) Reversed)", 5), - (" ( ( CDeclSpec list ) Reversed)", 7), - (" ( ( CDeclSpec list ) Reversed)", 4), - (" ( ( CDeclSpec list ) Reversed)", 6), - (" ( ( CDeclSpec list ) Reversed)", 6), - (" ( ( CDeclSpec list ) Reversed)", 14), - (" (CTypeSpec)", 2), - (" (CStructUnion)", 3), - (" (CStructTag Located)", 2), - (" ( ( CDecl list ) Reversed)", 3), - (" (CDecl)", 3), - (" (CDecl)", 3), - (" (CDecl)", 3), - (" ( ( CDeclr Maybe * CExpr Maybe ) )", 3), - (" ( ( CDeclr Maybe * CExpr Maybe ) )", 4), - (" (CEnum)", 5), - (" ( ( ((Ident * CExpr Maybe)) list ) Reversed)", 2), - (" ( ( Ident * CExpr Maybe ) )", 4), - (" (CTypeQual)", 6), - (" ( ( CTypeQual list ) Reversed)", 3), - (" (CDeclrR)", 2), - (" (CStrLit Maybe)", 2), - (" (CDeclrR)", 2), - (" (CDeclrR)", 3), - (" (CDeclrR)", 5), - (" (CDeclrR)", 4), - (" (CDeclrR)", 7), - (" (CDeclrR)", 3), - (" (CDeclrR)", 2), - (" (CDeclrR)", 2), - (" (CDeclrR)", 5), - (" (CDeclrR)", 5), - (" (CDeclrR)", 3), - (" (CDeclr)", 1), - (" (CDeclrR)", 3), - (" (CDeclrR)", 3), - (" ( ( CDecl list * Bool ) )", 3), - (" ( ( CDecl list ) Reversed)", 2), - (" (CDecl)", 15), - (" ( ( Ident list ) Reversed)", 2), - (" (CDecl)", 4), - (" (CDeclrR)", 3), - (" ( ( CDeclrR -> CDeclrR ) )", 2), - (" ( ( CDeclrR -> CDeclrR ) )", 2), - (" ( ( CDeclrR -> CDeclrR ) )", 11), - (" (CDeclrR)", 6), - (" (CDeclrR)", 9), - (" (CInit)", 3), - (" (CInit Maybe)", 2), - (" (CInitList Reversed)", 5), - (" (CDesignator list)", 3), - (" ( ( CDesignator list ) Reversed)", 2), - (" (CDesignator)", 3), - (" (CDesignator)", 1), - (" (CExpr)", 9), - (" ( ( ((CDecl Maybe * CExpr)) list ) Reversed)", 2), - (" ( ( CDecl Maybe * CExpr ) )", 2), - (" ( ( CDesignator list ) Reversed)", 3), - (" (CExpr)", 10), - (" ( ( CExpr list ) Reversed)", 2), - (" (CExpr)", 12), - (" (CUnaryOp Located)", 6), - (" (CExpr)", 2), - (" (CExpr)", 4), - (" (CExpr)", 3), - (" (CExpr)", 3), - (" (CExpr)", 5), - (" (CExpr)", 3), - (" (CExpr)", 2), - (" (CExpr)", 2), - (" (CExpr)", 2), - (" (CExpr)", 2), - (" (CExpr)", 2), - (" (CExpr)", 3), - (" (CExpr)", 2), - (" (CAssignOp Located)", 11), - (" (CExpr)", 2), - (" ( ( CExpr list ) Reversed)", 2), - (" (CExpr Maybe)", 2), - (" (CExpr Maybe)", 2), - (" (CExpr)", 1), - (" (CConst)", 3), - (" (CStrLit)", 2), - (" ( ( CString list ) Reversed)", 2), - (" (ClangCVersion)", 1), - (" (Ident)", 2), - (" (CAttr list)", 2), - (" (CAttr list)", 2), - (" (CAttr list)", 1), - (" ( ( CAttr list ) Reversed)", 2), - (" (CAttr Maybe)", 5), - (" ( ( CExpr list ) Reversed)", 6), - ("", 0)] -val string_reduce = find_list "reduce type not found" (fn name => fn occ => name ^ Int.toString (occ + 1)) [ - ("translation_unit", 1), - ("ext_decl_list", 3), - ("external_declaration", 4), - ("function_definition", 14), - ("function_declarator", 1), - ("statement", 7), - ("labeled_statement", 4), - ("compound_statement", 2), - ("enter_scope", 1), - ("leave_scope", 1), - ("block_item_list", 2), - ("block_item", 2), - ("nested_declaration", 3), - ("nested_function_definition", 5), - ("label_declarations", 2), - ("expression_statement", 2), - ("selection_statement", 3), - ("iteration_statement", 4), - ("jump_statement", 5), - ("asm_statement", 4), - ("maybe_type_qualifier", 2), - ("asm_operands", 2), - ("nonnull_asm_operands", 2), - ("asm_operand", 3), - ("asm_clobbers", 2), - ("declaration", 5), - ("declaration_list", 2), - ("default_declaring_list", 5), - ("asm_attrs_opt", 1), - ("declaring_list", 3), - ("declaration_specifier", 3), - ("declaration_qualifier_list", 6), - ("declaration_qualifier", 4), - ("declaration_qualifier_without_types", 3), - ("storage_class", 6), - ("function_specifier", 2), - ("alignment_specifier", 2), - ("type_specifier", 3), - ("basic_type_name", 12), - ("basic_declaration_specifier", 5), - ("basic_type_specifier", 7), - ("sue_declaration_specifier", 4), - ("sue_type_specifier", 6), - ("typedef_declaration_specifier", 6), - ("typedef_type_specifier", 14), - ("elaborated_type_name", 2), - ("struct_or_union_specifier", 3), - ("struct_or_union", 2), - ("struct_declaration_list", 3), - ("struct_declaration", 3), - ("struct_default_declaring_list", 3), - ("struct_declaring_list", 3), - ("struct_declarator", 3), - ("struct_identifier_declarator", 4), - ("enum_specifier", 5), - ("enumerator_list", 2), - ("enumerator", 4), - ("type_qualifier", 6), - ("type_qualifier_list", 3), - ("declarator", 2), - ("asm_opt", 2), - ("typedef_declarator", 2), - ("parameter_typedef_declarator", 3), - ("clean_typedef_declarator", 5), - ("clean_postfix_typedef_declarator", 4), - ("paren_typedef_declarator", 7), - ("paren_postfix_typedef_declarator", 3), - ("simple_paren_typedef_declarator", 2), - ("identifier_declarator", 2), - ("unary_identifier_declarator", 5), - ("postfix_identifier_declarator", 5), - ("paren_identifier_declarator", 3), - ("function_declarator_old", 1), - ("old_function_declarator", 3), - ("postfix_old_function_declarator", 3), - ("parameter_type_list", 3), - ("parameter_list", 2), - ("parameter_declaration", 15), - ("identifier_list", 2), - ("type_name", 4), - ("abstract_declarator", 3), - ("postfixing_abstract_declarator", 2), - ("array_abstract_declarator", 2), - ("postfix_array_abstract_declarator", 11), - ("unary_abstract_declarator", 6), - ("postfix_abstract_declarator", 9), - ("initializer", 3), - ("initializer_opt", 2), - ("initializer_list", 5), - ("designation", 3), - ("designator_list", 2), - ("designator", 3), - ("array_designator", 1), - ("primary_expression", 9), - ("generic_assoc_list", 2), - ("generic_assoc", 2), - ("offsetof_member_designator", 3), - ("postfix_expression", 10), - ("argument_expression_list", 2), - ("unary_expression", 12), - ("unary_operator", 6), - ("cast_expression", 2), - ("multiplicative_expression", 4), - ("additive_expression", 3), - ("shift_expression", 3), - ("relational_expression", 5), - ("equality_expression", 3), - ("and_expression", 2), - ("exclusive_or_expression", 2), - ("inclusive_or_expression", 2), - ("logical_and_expression", 2), - ("logical_or_expression", 2), - ("conditional_expression", 3), - ("assignment_expression", 2), - ("assignment_operator", 11), - ("expression", 2), - ("comma_expression", 2), - ("expression_opt", 2), - ("assignment_expression_opt", 2), - ("constant_expression", 1), - ("constant", 3), - ("string_literal", 2), - ("string_literal_list", 2), - ("clang_version_literal", 1), - ("identifier", 2), - ("attrs_opt", 2), - ("attrs", 2), - ("attr", 1), - ("attribute_list", 2), - ("attribute", 5), - ("attribute_params", 6), - ("", 0)] +val type_reduce = fn + 0 => " (CTranslUnit)" | + 1 => " ( ( CExtDecl list ) Reversed)" | + 2 => " ( ( CExtDecl list ) Reversed)" | + 3 => " ( ( CExtDecl list ) Reversed)" | + 4 => " (CExtDecl)" | + 5 => " (CExtDecl)" | + 6 => " (CExtDecl)" | + 7 => " (CExtDecl)" | + 8 => " (CFunDef)" | + 9 => " (CFunDef)" | + 10 => " (CFunDef)" | + 11 => " (CFunDef)" | + 12 => " (CFunDef)" | + 13 => " (CFunDef)" | + 14 => " (CFunDef)" | + 15 => " (CFunDef)" | + 16 => " (CFunDef)" | + 17 => " (CFunDef)" | + 18 => " (CFunDef)" | + 19 => " (CFunDef)" | + 20 => " (CFunDef)" | + 21 => " (CFunDef)" | + 22 => " (CDeclr)" | + 23 => " (CStat)" | + 24 => " (CStat)" | + 25 => " (CStat)" | + 26 => " (CStat)" | + 27 => " (CStat)" | + 28 => " (CStat)" | + 29 => " (CStat)" | + 30 => " (CStat)" | + 31 => " (CStat)" | + 32 => " (CStat)" | + 33 => " (CStat)" | + 34 => " (CStat)" | + 35 => " (CStat)" | + 36 => " (unit)" | + 37 => " (unit)" | + 38 => " ( ( CBlockItem list ) Reversed)" | + 39 => " ( ( CBlockItem list ) Reversed)" | + 40 => " (CBlockItem)" | + 41 => " (CBlockItem)" | + 42 => " (CBlockItem)" | + 43 => " (CBlockItem)" | + 44 => " (CBlockItem)" | + 45 => " (CFunDef)" | + 46 => " (CFunDef)" | + 47 => " (CFunDef)" | + 48 => " (CFunDef)" | + 49 => " (CFunDef)" | + 50 => " ( ( Ident list ) Reversed)" | + 51 => " ( ( Ident list ) Reversed)" | + 52 => " (CStat)" | + 53 => " (CStat)" | + 54 => " (CStat)" | + 55 => " (CStat)" | + 56 => " (CStat)" | + 57 => " (CStat)" | + 58 => " (CStat)" | + 59 => " (CStat)" | + 60 => " (CStat)" | + 61 => " (CStat)" | + 62 => " (CStat)" | + 63 => " (CStat)" | + 64 => " (CStat)" | + 65 => " (CStat)" | + 66 => " (CAsmStmt)" | + 67 => " (CAsmStmt)" | + 68 => " (CAsmStmt)" | + 69 => " (CAsmStmt)" | + 70 => " (CTypeQual Maybe)" | + 71 => " (CTypeQual Maybe)" | + 72 => " (CAsmOperand list)" | + 73 => " (CAsmOperand list)" | + 74 => " ( ( CAsmOperand list ) Reversed)" | + 75 => " ( ( CAsmOperand list ) Reversed)" | + 76 => " (CAsmOperand)" | + 77 => " (CAsmOperand)" | + 78 => " (CAsmOperand)" | + 79 => " ( ( CStrLit list ) Reversed)" | + 80 => " ( ( CStrLit list ) Reversed)" | + 81 => " (CDecl)" | + 82 => " (CDecl)" | + 83 => " (CDecl)" | + 84 => " (CDecl)" | + 85 => " (CDecl)" | + 86 => " ( ( CDecl list ) Reversed)" | + 87 => " ( ( CDecl list ) Reversed)" | + 88 => " (CDecl)" | + 89 => " (CDecl)" | + 90 => " (CDecl)" | + 91 => " (CDecl)" | + 92 => " (CDecl)" | + 93 => " ( ( CStrLit Maybe * CAttr list ) )" | + 94 => " (CDecl)" | + 95 => " (CDecl)" | + 96 => " (CDecl)" | + 97 => " (CDeclSpec list)" | + 98 => " (CDeclSpec list)" | + 99 => " (CDeclSpec list)" | + 100 => " ( ( CDeclSpec list ) Reversed)" | + 101 => " ( ( CDeclSpec list ) Reversed)" | + 102 => " ( ( CDeclSpec list ) Reversed)" | + 103 => " ( ( CDeclSpec list ) Reversed)" | + 104 => " ( ( CDeclSpec list ) Reversed)" | + 105 => " ( ( CDeclSpec list ) Reversed)" | + 106 => " (CDeclSpec)" | + 107 => " (CDeclSpec)" | + 108 => " (CDeclSpec)" | + 109 => " (CDeclSpec)" | + 110 => " (CDeclSpec)" | + 111 => " (CDeclSpec)" | + 112 => " (CDeclSpec)" | + 113 => " (CStorageSpec)" | + 114 => " (CStorageSpec)" | + 115 => " (CStorageSpec)" | + 116 => " (CStorageSpec)" | + 117 => " (CStorageSpec)" | + 118 => " (CStorageSpec)" | + 119 => " (CFunSpec)" | + 120 => " (CFunSpec)" | + 121 => " (CAlignSpec)" | + 122 => " (CAlignSpec)" | + 123 => " (CDeclSpec list)" | + 124 => " (CDeclSpec list)" | + 125 => " (CDeclSpec list)" | + 126 => " (CTypeSpec)" | + 127 => " (CTypeSpec)" | + 128 => " (CTypeSpec)" | + 129 => " (CTypeSpec)" | + 130 => " (CTypeSpec)" | + 131 => " (CTypeSpec)" | + 132 => " (CTypeSpec)" | + 133 => " (CTypeSpec)" | + 134 => " (CTypeSpec)" | + 135 => " (CTypeSpec)" | + 136 => " (CTypeSpec)" | + 137 => " (CTypeSpec)" | + 138 => " ( ( CDeclSpec list ) Reversed)" | + 139 => " ( ( CDeclSpec list ) Reversed)" | + 140 => " ( ( CDeclSpec list ) Reversed)" | + 141 => " ( ( CDeclSpec list ) Reversed)" | + 142 => " ( ( CDeclSpec list ) Reversed)" | + 143 => " ( ( CDeclSpec list ) Reversed)" | + 144 => " ( ( CDeclSpec list ) Reversed)" | + 145 => " ( ( CDeclSpec list ) Reversed)" | + 146 => " ( ( CDeclSpec list ) Reversed)" | + 147 => " ( ( CDeclSpec list ) Reversed)" | + 148 => " ( ( CDeclSpec list ) Reversed)" | + 149 => " ( ( CDeclSpec list ) Reversed)" | + 150 => " ( ( CDeclSpec list ) Reversed)" | + 151 => " ( ( CDeclSpec list ) Reversed)" | + 152 => " ( ( CDeclSpec list ) Reversed)" | + 153 => " ( ( CDeclSpec list ) Reversed)" | + 154 => " ( ( CDeclSpec list ) Reversed)" | + 155 => " ( ( CDeclSpec list ) Reversed)" | + 156 => " ( ( CDeclSpec list ) Reversed)" | + 157 => " ( ( CDeclSpec list ) Reversed)" | + 158 => " ( ( CDeclSpec list ) Reversed)" | + 159 => " ( ( CDeclSpec list ) Reversed)" | + 160 => " ( ( CDeclSpec list ) Reversed)" | + 161 => " ( ( CDeclSpec list ) Reversed)" | + 162 => " ( ( CDeclSpec list ) Reversed)" | + 163 => " ( ( CDeclSpec list ) Reversed)" | + 164 => " ( ( CDeclSpec list ) Reversed)" | + 165 => " ( ( CDeclSpec list ) Reversed)" | + 166 => " ( ( CDeclSpec list ) Reversed)" | + 167 => " ( ( CDeclSpec list ) Reversed)" | + 168 => " ( ( CDeclSpec list ) Reversed)" | + 169 => " ( ( CDeclSpec list ) Reversed)" | + 170 => " ( ( CDeclSpec list ) Reversed)" | + 171 => " ( ( CDeclSpec list ) Reversed)" | + 172 => " ( ( CDeclSpec list ) Reversed)" | + 173 => " ( ( CDeclSpec list ) Reversed)" | + 174 => " ( ( CDeclSpec list ) Reversed)" | + 175 => " ( ( CDeclSpec list ) Reversed)" | + 176 => " ( ( CDeclSpec list ) Reversed)" | + 177 => " ( ( CDeclSpec list ) Reversed)" | + 178 => " ( ( CDeclSpec list ) Reversed)" | + 179 => " ( ( CDeclSpec list ) Reversed)" | + 180 => " (CTypeSpec)" | + 181 => " (CTypeSpec)" | + 182 => " (CStructUnion)" | + 183 => " (CStructUnion)" | + 184 => " (CStructUnion)" | + 185 => " (CStructTag Located)" | + 186 => " (CStructTag Located)" | + 187 => " ( ( CDecl list ) Reversed)" | + 188 => " ( ( CDecl list ) Reversed)" | + 189 => " ( ( CDecl list ) Reversed)" | + 190 => " (CDecl)" | + 191 => " (CDecl)" | + 192 => " (CDecl)" | + 193 => " (CDecl)" | + 194 => " (CDecl)" | + 195 => " (CDecl)" | + 196 => " (CDecl)" | + 197 => " (CDecl)" | + 198 => " (CDecl)" | + 199 => " ( ( CDeclr Maybe * CExpr Maybe ) )" | + 200 => " ( ( CDeclr Maybe * CExpr Maybe ) )" | + 201 => " ( ( CDeclr Maybe * CExpr Maybe ) )" | + 202 => " ( ( CDeclr Maybe * CExpr Maybe ) )" | + 203 => " ( ( CDeclr Maybe * CExpr Maybe ) )" | + 204 => " ( ( CDeclr Maybe * CExpr Maybe ) )" | + 205 => " ( ( CDeclr Maybe * CExpr Maybe ) )" | + 206 => " (CEnum)" | + 207 => " (CEnum)" | + 208 => " (CEnum)" | + 209 => " (CEnum)" | + 210 => " (CEnum)" | + 211 => " ( ( ((Ident * CExpr Maybe)) list ) Reversed)" | + 212 => " ( ( ((Ident * CExpr Maybe)) list ) Reversed)" | + 213 => " ( ( Ident * CExpr Maybe ) )" | + 214 => " ( ( Ident * CExpr Maybe ) )" | + 215 => " ( ( Ident * CExpr Maybe ) )" | + 216 => " ( ( Ident * CExpr Maybe ) )" | + 217 => " (CTypeQual)" | + 218 => " (CTypeQual)" | + 219 => " (CTypeQual)" | + 220 => " (CTypeQual)" | + 221 => " (CTypeQual)" | + 222 => " (CTypeQual)" | + 223 => " ( ( CTypeQual list ) Reversed)" | + 224 => " ( ( CTypeQual list ) Reversed)" | + 225 => " ( ( CTypeQual list ) Reversed)" | + 226 => " (CDeclrR)" | + 227 => " (CDeclrR)" | + 228 => " (CStrLit Maybe)" | + 229 => " (CStrLit Maybe)" | + 230 => " (CDeclrR)" | + 231 => " (CDeclrR)" | + 232 => " (CDeclrR)" | + 233 => " (CDeclrR)" | + 234 => " (CDeclrR)" | + 235 => " (CDeclrR)" | + 236 => " (CDeclrR)" | + 237 => " (CDeclrR)" | + 238 => " (CDeclrR)" | + 239 => " (CDeclrR)" | + 240 => " (CDeclrR)" | + 241 => " (CDeclrR)" | + 242 => " (CDeclrR)" | + 243 => " (CDeclrR)" | + 244 => " (CDeclrR)" | + 245 => " (CDeclrR)" | + 246 => " (CDeclrR)" | + 247 => " (CDeclrR)" | + 248 => " (CDeclrR)" | + 249 => " (CDeclrR)" | + 250 => " (CDeclrR)" | + 251 => " (CDeclrR)" | + 252 => " (CDeclrR)" | + 253 => " (CDeclrR)" | + 254 => " (CDeclrR)" | + 255 => " (CDeclrR)" | + 256 => " (CDeclrR)" | + 257 => " (CDeclrR)" | + 258 => " (CDeclrR)" | + 259 => " (CDeclrR)" | + 260 => " (CDeclrR)" | + 261 => " (CDeclrR)" | + 262 => " (CDeclrR)" | + 263 => " (CDeclrR)" | + 264 => " (CDeclrR)" | + 265 => " (CDeclrR)" | + 266 => " (CDeclrR)" | + 267 => " (CDeclrR)" | + 268 => " (CDeclrR)" | + 269 => " (CDeclrR)" | + 270 => " (CDeclrR)" | + 271 => " (CDeclr)" | + 272 => " (CDeclrR)" | + 273 => " (CDeclrR)" | + 274 => " (CDeclrR)" | + 275 => " (CDeclrR)" | + 276 => " (CDeclrR)" | + 277 => " (CDeclrR)" | + 278 => " ( ( CDecl list * Bool ) )" | + 279 => " ( ( CDecl list * Bool ) )" | + 280 => " ( ( CDecl list * Bool ) )" | + 281 => " ( ( CDecl list ) Reversed)" | + 282 => " ( ( CDecl list ) Reversed)" | + 283 => " (CDecl)" | + 284 => " (CDecl)" | + 285 => " (CDecl)" | + 286 => " (CDecl)" | + 287 => " (CDecl)" | + 288 => " (CDecl)" | + 289 => " (CDecl)" | + 290 => " (CDecl)" | + 291 => " (CDecl)" | + 292 => " (CDecl)" | + 293 => " (CDecl)" | + 294 => " (CDecl)" | + 295 => " (CDecl)" | + 296 => " (CDecl)" | + 297 => " (CDecl)" | + 298 => " ( ( Ident list ) Reversed)" | + 299 => " ( ( Ident list ) Reversed)" | + 300 => " (CDecl)" | + 301 => " (CDecl)" | + 302 => " (CDecl)" | + 303 => " (CDecl)" | + 304 => " (CDeclrR)" | + 305 => " (CDeclrR)" | + 306 => " (CDeclrR)" | + 307 => " ( ( CDeclrR -> CDeclrR ) )" | + 308 => " ( ( CDeclrR -> CDeclrR ) )" | + 309 => " ( ( CDeclrR -> CDeclrR ) )" | + 310 => " ( ( CDeclrR -> CDeclrR ) )" | + 311 => " ( ( CDeclrR -> CDeclrR ) )" | + 312 => " ( ( CDeclrR -> CDeclrR ) )" | + 313 => " ( ( CDeclrR -> CDeclrR ) )" | + 314 => " ( ( CDeclrR -> CDeclrR ) )" | + 315 => " ( ( CDeclrR -> CDeclrR ) )" | + 316 => " ( ( CDeclrR -> CDeclrR ) )" | + 317 => " ( ( CDeclrR -> CDeclrR ) )" | + 318 => " ( ( CDeclrR -> CDeclrR ) )" | + 319 => " ( ( CDeclrR -> CDeclrR ) )" | + 320 => " ( ( CDeclrR -> CDeclrR ) )" | + 321 => " ( ( CDeclrR -> CDeclrR ) )" | + 322 => " (CDeclrR)" | + 323 => " (CDeclrR)" | + 324 => " (CDeclrR)" | + 325 => " (CDeclrR)" | + 326 => " (CDeclrR)" | + 327 => " (CDeclrR)" | + 328 => " (CDeclrR)" | + 329 => " (CDeclrR)" | + 330 => " (CDeclrR)" | + 331 => " (CDeclrR)" | + 332 => " (CDeclrR)" | + 333 => " (CDeclrR)" | + 334 => " (CDeclrR)" | + 335 => " (CDeclrR)" | + 336 => " (CDeclrR)" | + 337 => " (CInit)" | + 338 => " (CInit)" | + 339 => " (CInit)" | + 340 => " (CInit Maybe)" | + 341 => " (CInit Maybe)" | + 342 => " (CInitList Reversed)" | + 343 => " (CInitList Reversed)" | + 344 => " (CInitList Reversed)" | + 345 => " (CInitList Reversed)" | + 346 => " (CInitList Reversed)" | + 347 => " (CDesignator list)" | + 348 => " (CDesignator list)" | + 349 => " (CDesignator list)" | + 350 => " ( ( CDesignator list ) Reversed)" | + 351 => " ( ( CDesignator list ) Reversed)" | + 352 => " (CDesignator)" | + 353 => " (CDesignator)" | + 354 => " (CDesignator)" | + 355 => " (CDesignator)" | + 356 => " (CExpr)" | + 357 => " (CExpr)" | + 358 => " (CExpr)" | + 359 => " (CExpr)" | + 360 => " (CExpr)" | + 361 => " (CExpr)" | + 362 => " (CExpr)" | + 363 => " (CExpr)" | + 364 => " (CExpr)" | + 365 => " ( ( ((CDecl Maybe * CExpr)) list ) Reversed)" | + 366 => " ( ( ((CDecl Maybe * CExpr)) list ) Reversed)" | + 367 => " ( ( CDecl Maybe * CExpr ) )" | + 368 => " ( ( CDecl Maybe * CExpr ) )" | + 369 => " ( ( CDesignator list ) Reversed)" | + 370 => " ( ( CDesignator list ) Reversed)" | + 371 => " ( ( CDesignator list ) Reversed)" | + 372 => " (CExpr)" | + 373 => " (CExpr)" | + 374 => " (CExpr)" | + 375 => " (CExpr)" | + 376 => " (CExpr)" | + 377 => " (CExpr)" | + 378 => " (CExpr)" | + 379 => " (CExpr)" | + 380 => " (CExpr)" | + 381 => " (CExpr)" | + 382 => " ( ( CExpr list ) Reversed)" | + 383 => " ( ( CExpr list ) Reversed)" | + 384 => " (CExpr)" | + 385 => " (CExpr)" | + 386 => " (CExpr)" | + 387 => " (CExpr)" | + 388 => " (CExpr)" | + 389 => " (CExpr)" | + 390 => " (CExpr)" | + 391 => " (CExpr)" | + 392 => " (CExpr)" | + 393 => " (CExpr)" | + 394 => " (CExpr)" | + 395 => " (CExpr)" | + 396 => " (CUnaryOp Located)" | + 397 => " (CUnaryOp Located)" | + 398 => " (CUnaryOp Located)" | + 399 => " (CUnaryOp Located)" | + 400 => " (CUnaryOp Located)" | + 401 => " (CUnaryOp Located)" | + 402 => " (CExpr)" | + 403 => " (CExpr)" | + 404 => " (CExpr)" | + 405 => " (CExpr)" | + 406 => " (CExpr)" | + 407 => " (CExpr)" | + 408 => " (CExpr)" | + 409 => " (CExpr)" | + 410 => " (CExpr)" | + 411 => " (CExpr)" | + 412 => " (CExpr)" | + 413 => " (CExpr)" | + 414 => " (CExpr)" | + 415 => " (CExpr)" | + 416 => " (CExpr)" | + 417 => " (CExpr)" | + 418 => " (CExpr)" | + 419 => " (CExpr)" | + 420 => " (CExpr)" | + 421 => " (CExpr)" | + 422 => " (CExpr)" | + 423 => " (CExpr)" | + 424 => " (CExpr)" | + 425 => " (CExpr)" | + 426 => " (CExpr)" | + 427 => " (CExpr)" | + 428 => " (CExpr)" | + 429 => " (CExpr)" | + 430 => " (CExpr)" | + 431 => " (CExpr)" | + 432 => " (CExpr)" | + 433 => " (CExpr)" | + 434 => " (CExpr)" | + 435 => " (CExpr)" | + 436 => " (CExpr)" | + 437 => " (CAssignOp Located)" | + 438 => " (CAssignOp Located)" | + 439 => " (CAssignOp Located)" | + 440 => " (CAssignOp Located)" | + 441 => " (CAssignOp Located)" | + 442 => " (CAssignOp Located)" | + 443 => " (CAssignOp Located)" | + 444 => " (CAssignOp Located)" | + 445 => " (CAssignOp Located)" | + 446 => " (CAssignOp Located)" | + 447 => " (CAssignOp Located)" | + 448 => " (CExpr)" | + 449 => " (CExpr)" | + 450 => " ( ( CExpr list ) Reversed)" | + 451 => " ( ( CExpr list ) Reversed)" | + 452 => " (CExpr Maybe)" | + 453 => " (CExpr Maybe)" | + 454 => " (CExpr Maybe)" | + 455 => " (CExpr Maybe)" | + 456 => " (CExpr)" | + 457 => " (CConst)" | + 458 => " (CConst)" | + 459 => " (CConst)" | + 460 => " (CStrLit)" | + 461 => " (CStrLit)" | + 462 => " ( ( CString list ) Reversed)" | + 463 => " ( ( CString list ) Reversed)" | + 464 => " (ClangCVersion)" | + 465 => " (Ident)" | + 466 => " (Ident)" | + 467 => " (CAttr list)" | + 468 => " (CAttr list)" | + 469 => " (CAttr list)" | + 470 => " (CAttr list)" | + 471 => " (CAttr list)" | + 472 => " ( ( CAttr list ) Reversed)" | + 473 => " ( ( CAttr list ) Reversed)" | + 474 => " (CAttr Maybe)" | + 475 => " (CAttr Maybe)" | + 476 => " (CAttr Maybe)" | + 477 => " (CAttr Maybe)" | + 478 => " (CAttr Maybe)" | + 479 => " ( ( CExpr list ) Reversed)" | + 480 => " ( ( CExpr list ) Reversed)" | + 481 => " ( ( CExpr list ) Reversed)" | + 482 => " ( ( CExpr list ) Reversed)" | + 483 => " ( ( CExpr list ) Reversed)" | + 484 => " ( ( CExpr list ) Reversed)" | + _ => error "reduce type not found" +val string_reduce = fn + 0 => "translation_unit" | + 1 => "ext_decl_list1" | + 2 => "ext_decl_list2" | + 3 => "ext_decl_list3" | + 4 => "external_declaration1" | + 5 => "external_declaration2" | + 6 => "external_declaration3" | + 7 => "external_declaration4" | + 8 => "function_definition1" | + 9 => "function_definition2" | + 10 => "function_definition3" | + 11 => "function_definition4" | + 12 => "function_definition5" | + 13 => "function_definition6" | + 14 => "function_definition7" | + 15 => "function_definition8" | + 16 => "function_definition9" | + 17 => "function_definition10" | + 18 => "function_definition11" | + 19 => "function_definition12" | + 20 => "function_definition13" | + 21 => "function_definition14" | + 22 => "function_declarator" | + 23 => "statement1" | + 24 => "statement2" | + 25 => "statement3" | + 26 => "statement4" | + 27 => "statement5" | + 28 => "statement6" | + 29 => "statement7" | + 30 => "labeled_statement1" | + 31 => "labeled_statement2" | + 32 => "labeled_statement3" | + 33 => "labeled_statement4" | + 34 => "compound_statement1" | + 35 => "compound_statement2" | + 36 => "enter_scope" | + 37 => "leave_scope" | + 38 => "block_item_list1" | + 39 => "block_item_list2" | + 40 => "block_item1" | + 41 => "block_item2" | + 42 => "nested_declaration1" | + 43 => "nested_declaration2" | + 44 => "nested_declaration3" | + 45 => "nested_function_definition1" | + 46 => "nested_function_definition2" | + 47 => "nested_function_definition3" | + 48 => "nested_function_definition4" | + 49 => "nested_function_definition5" | + 50 => "label_declarations1" | + 51 => "label_declarations2" | + 52 => "expression_statement1" | + 53 => "expression_statement2" | + 54 => "selection_statement1" | + 55 => "selection_statement2" | + 56 => "selection_statement3" | + 57 => "iteration_statement1" | + 58 => "iteration_statement2" | + 59 => "iteration_statement3" | + 60 => "iteration_statement4" | + 61 => "jump_statement1" | + 62 => "jump_statement2" | + 63 => "jump_statement3" | + 64 => "jump_statement4" | + 65 => "jump_statement5" | + 66 => "asm_statement1" | + 67 => "asm_statement2" | + 68 => "asm_statement3" | + 69 => "asm_statement4" | + 70 => "maybe_type_qualifier1" | + 71 => "maybe_type_qualifier2" | + 72 => "asm_operands1" | + 73 => "asm_operands2" | + 74 => "nonnull_asm_operands1" | + 75 => "nonnull_asm_operands2" | + 76 => "asm_operand1" | + 77 => "asm_operand2" | + 78 => "asm_operand3" | + 79 => "asm_clobbers1" | + 80 => "asm_clobbers2" | + 81 => "declaration1" | + 82 => "declaration2" | + 83 => "declaration3" | + 84 => "declaration4" | + 85 => "declaration5" | + 86 => "declaration_list1" | + 87 => "declaration_list2" | + 88 => "default_declaring_list1" | + 89 => "default_declaring_list2" | + 90 => "default_declaring_list3" | + 91 => "default_declaring_list4" | + 92 => "default_declaring_list5" | + 93 => "asm_attrs_opt" | + 94 => "declaring_list1" | + 95 => "declaring_list2" | + 96 => "declaring_list3" | + 97 => "declaration_specifier1" | + 98 => "declaration_specifier2" | + 99 => "declaration_specifier3" | + 100 => "declaration_qualifier_list1" | + 101 => "declaration_qualifier_list2" | + 102 => "declaration_qualifier_list3" | + 103 => "declaration_qualifier_list4" | + 104 => "declaration_qualifier_list5" | + 105 => "declaration_qualifier_list6" | + 106 => "declaration_qualifier1" | + 107 => "declaration_qualifier2" | + 108 => "declaration_qualifier3" | + 109 => "declaration_qualifier4" | + 110 => "declaration_qualifier_without_types1" | + 111 => "declaration_qualifier_without_types2" | + 112 => "declaration_qualifier_without_types3" | + 113 => "storage_class1" | + 114 => "storage_class2" | + 115 => "storage_class3" | + 116 => "storage_class4" | + 117 => "storage_class5" | + 118 => "storage_class6" | + 119 => "function_specifier1" | + 120 => "function_specifier2" | + 121 => "alignment_specifier1" | + 122 => "alignment_specifier2" | + 123 => "type_specifier1" | + 124 => "type_specifier2" | + 125 => "type_specifier3" | + 126 => "basic_type_name1" | + 127 => "basic_type_name2" | + 128 => "basic_type_name3" | + 129 => "basic_type_name4" | + 130 => "basic_type_name5" | + 131 => "basic_type_name6" | + 132 => "basic_type_name7" | + 133 => "basic_type_name8" | + 134 => "basic_type_name9" | + 135 => "basic_type_name10" | + 136 => "basic_type_name11" | + 137 => "basic_type_name12" | + 138 => "basic_declaration_specifier1" | + 139 => "basic_declaration_specifier2" | + 140 => "basic_declaration_specifier3" | + 141 => "basic_declaration_specifier4" | + 142 => "basic_declaration_specifier5" | + 143 => "basic_type_specifier1" | + 144 => "basic_type_specifier2" | + 145 => "basic_type_specifier3" | + 146 => "basic_type_specifier4" | + 147 => "basic_type_specifier5" | + 148 => "basic_type_specifier6" | + 149 => "basic_type_specifier7" | + 150 => "sue_declaration_specifier1" | + 151 => "sue_declaration_specifier2" | + 152 => "sue_declaration_specifier3" | + 153 => "sue_declaration_specifier4" | + 154 => "sue_type_specifier1" | + 155 => "sue_type_specifier2" | + 156 => "sue_type_specifier3" | + 157 => "sue_type_specifier4" | + 158 => "sue_type_specifier5" | + 159 => "sue_type_specifier6" | + 160 => "typedef_declaration_specifier1" | + 161 => "typedef_declaration_specifier2" | + 162 => "typedef_declaration_specifier3" | + 163 => "typedef_declaration_specifier4" | + 164 => "typedef_declaration_specifier5" | + 165 => "typedef_declaration_specifier6" | + 166 => "typedef_type_specifier1" | + 167 => "typedef_type_specifier2" | + 168 => "typedef_type_specifier3" | + 169 => "typedef_type_specifier4" | + 170 => "typedef_type_specifier5" | + 171 => "typedef_type_specifier6" | + 172 => "typedef_type_specifier7" | + 173 => "typedef_type_specifier8" | + 174 => "typedef_type_specifier9" | + 175 => "typedef_type_specifier10" | + 176 => "typedef_type_specifier11" | + 177 => "typedef_type_specifier12" | + 178 => "typedef_type_specifier13" | + 179 => "typedef_type_specifier14" | + 180 => "elaborated_type_name1" | + 181 => "elaborated_type_name2" | + 182 => "struct_or_union_specifier1" | + 183 => "struct_or_union_specifier2" | + 184 => "struct_or_union_specifier3" | + 185 => "struct_or_union1" | + 186 => "struct_or_union2" | + 187 => "struct_declaration_list1" | + 188 => "struct_declaration_list2" | + 189 => "struct_declaration_list3" | + 190 => "struct_declaration1" | + 191 => "struct_declaration2" | + 192 => "struct_declaration3" | + 193 => "struct_default_declaring_list1" | + 194 => "struct_default_declaring_list2" | + 195 => "struct_default_declaring_list3" | + 196 => "struct_declaring_list1" | + 197 => "struct_declaring_list2" | + 198 => "struct_declaring_list3" | + 199 => "struct_declarator1" | + 200 => "struct_declarator2" | + 201 => "struct_declarator3" | + 202 => "struct_identifier_declarator1" | + 203 => "struct_identifier_declarator2" | + 204 => "struct_identifier_declarator3" | + 205 => "struct_identifier_declarator4" | + 206 => "enum_specifier1" | + 207 => "enum_specifier2" | + 208 => "enum_specifier3" | + 209 => "enum_specifier4" | + 210 => "enum_specifier5" | + 211 => "enumerator_list1" | + 212 => "enumerator_list2" | + 213 => "enumerator1" | + 214 => "enumerator2" | + 215 => "enumerator3" | + 216 => "enumerator4" | + 217 => "type_qualifier1" | + 218 => "type_qualifier2" | + 219 => "type_qualifier3" | + 220 => "type_qualifier4" | + 221 => "type_qualifier5" | + 222 => "type_qualifier6" | + 223 => "type_qualifier_list1" | + 224 => "type_qualifier_list2" | + 225 => "type_qualifier_list3" | + 226 => "declarator1" | + 227 => "declarator2" | + 228 => "asm_opt1" | + 229 => "asm_opt2" | + 230 => "typedef_declarator1" | + 231 => "typedef_declarator2" | + 232 => "parameter_typedef_declarator1" | + 233 => "parameter_typedef_declarator2" | + 234 => "parameter_typedef_declarator3" | + 235 => "clean_typedef_declarator1" | + 236 => "clean_typedef_declarator2" | + 237 => "clean_typedef_declarator3" | + 238 => "clean_typedef_declarator4" | + 239 => "clean_typedef_declarator5" | + 240 => "clean_postfix_typedef_declarator1" | + 241 => "clean_postfix_typedef_declarator2" | + 242 => "clean_postfix_typedef_declarator3" | + 243 => "clean_postfix_typedef_declarator4" | + 244 => "paren_typedef_declarator1" | + 245 => "paren_typedef_declarator2" | + 246 => "paren_typedef_declarator3" | + 247 => "paren_typedef_declarator4" | + 248 => "paren_typedef_declarator5" | + 249 => "paren_typedef_declarator6" | + 250 => "paren_typedef_declarator7" | + 251 => "paren_postfix_typedef_declarator1" | + 252 => "paren_postfix_typedef_declarator2" | + 253 => "paren_postfix_typedef_declarator3" | + 254 => "simple_paren_typedef_declarator1" | + 255 => "simple_paren_typedef_declarator2" | + 256 => "identifier_declarator1" | + 257 => "identifier_declarator2" | + 258 => "unary_identifier_declarator1" | + 259 => "unary_identifier_declarator2" | + 260 => "unary_identifier_declarator3" | + 261 => "unary_identifier_declarator4" | + 262 => "unary_identifier_declarator5" | + 263 => "postfix_identifier_declarator1" | + 264 => "postfix_identifier_declarator2" | + 265 => "postfix_identifier_declarator3" | + 266 => "postfix_identifier_declarator4" | + 267 => "postfix_identifier_declarator5" | + 268 => "paren_identifier_declarator1" | + 269 => "paren_identifier_declarator2" | + 270 => "paren_identifier_declarator3" | + 271 => "function_declarator_old" | + 272 => "old_function_declarator1" | + 273 => "old_function_declarator2" | + 274 => "old_function_declarator3" | + 275 => "postfix_old_function_declarator1" | + 276 => "postfix_old_function_declarator2" | + 277 => "postfix_old_function_declarator3" | + 278 => "parameter_type_list1" | + 279 => "parameter_type_list2" | + 280 => "parameter_type_list3" | + 281 => "parameter_list1" | + 282 => "parameter_list2" | + 283 => "parameter_declaration1" | + 284 => "parameter_declaration2" | + 285 => "parameter_declaration3" | + 286 => "parameter_declaration4" | + 287 => "parameter_declaration5" | + 288 => "parameter_declaration6" | + 289 => "parameter_declaration7" | + 290 => "parameter_declaration8" | + 291 => "parameter_declaration9" | + 292 => "parameter_declaration10" | + 293 => "parameter_declaration11" | + 294 => "parameter_declaration12" | + 295 => "parameter_declaration13" | + 296 => "parameter_declaration14" | + 297 => "parameter_declaration15" | + 298 => "identifier_list1" | + 299 => "identifier_list2" | + 300 => "type_name1" | + 301 => "type_name2" | + 302 => "type_name3" | + 303 => "type_name4" | + 304 => "abstract_declarator1" | + 305 => "abstract_declarator2" | + 306 => "abstract_declarator3" | + 307 => "postfixing_abstract_declarator1" | + 308 => "postfixing_abstract_declarator2" | + 309 => "array_abstract_declarator1" | + 310 => "array_abstract_declarator2" | + 311 => "postfix_array_abstract_declarator1" | + 312 => "postfix_array_abstract_declarator2" | + 313 => "postfix_array_abstract_declarator3" | + 314 => "postfix_array_abstract_declarator4" | + 315 => "postfix_array_abstract_declarator5" | + 316 => "postfix_array_abstract_declarator6" | + 317 => "postfix_array_abstract_declarator7" | + 318 => "postfix_array_abstract_declarator8" | + 319 => "postfix_array_abstract_declarator9" | + 320 => "postfix_array_abstract_declarator10" | + 321 => "postfix_array_abstract_declarator11" | + 322 => "unary_abstract_declarator1" | + 323 => "unary_abstract_declarator2" | + 324 => "unary_abstract_declarator3" | + 325 => "unary_abstract_declarator4" | + 326 => "unary_abstract_declarator5" | + 327 => "unary_abstract_declarator6" | + 328 => "postfix_abstract_declarator1" | + 329 => "postfix_abstract_declarator2" | + 330 => "postfix_abstract_declarator3" | + 331 => "postfix_abstract_declarator4" | + 332 => "postfix_abstract_declarator5" | + 333 => "postfix_abstract_declarator6" | + 334 => "postfix_abstract_declarator7" | + 335 => "postfix_abstract_declarator8" | + 336 => "postfix_abstract_declarator9" | + 337 => "initializer1" | + 338 => "initializer2" | + 339 => "initializer3" | + 340 => "initializer_opt1" | + 341 => "initializer_opt2" | + 342 => "initializer_list1" | + 343 => "initializer_list2" | + 344 => "initializer_list3" | + 345 => "initializer_list4" | + 346 => "initializer_list5" | + 347 => "designation1" | + 348 => "designation2" | + 349 => "designation3" | + 350 => "designator_list1" | + 351 => "designator_list2" | + 352 => "designator1" | + 353 => "designator2" | + 354 => "designator3" | + 355 => "array_designator" | + 356 => "primary_expression1" | + 357 => "primary_expression2" | + 358 => "primary_expression3" | + 359 => "primary_expression4" | + 360 => "primary_expression5" | + 361 => "primary_expression6" | + 362 => "primary_expression7" | + 363 => "primary_expression8" | + 364 => "primary_expression9" | + 365 => "generic_assoc_list1" | + 366 => "generic_assoc_list2" | + 367 => "generic_assoc1" | + 368 => "generic_assoc2" | + 369 => "offsetof_member_designator1" | + 370 => "offsetof_member_designator2" | + 371 => "offsetof_member_designator3" | + 372 => "postfix_expression1" | + 373 => "postfix_expression2" | + 374 => "postfix_expression3" | + 375 => "postfix_expression4" | + 376 => "postfix_expression5" | + 377 => "postfix_expression6" | + 378 => "postfix_expression7" | + 379 => "postfix_expression8" | + 380 => "postfix_expression9" | + 381 => "postfix_expression10" | + 382 => "argument_expression_list1" | + 383 => "argument_expression_list2" | + 384 => "unary_expression1" | + 385 => "unary_expression2" | + 386 => "unary_expression3" | + 387 => "unary_expression4" | + 388 => "unary_expression5" | + 389 => "unary_expression6" | + 390 => "unary_expression7" | + 391 => "unary_expression8" | + 392 => "unary_expression9" | + 393 => "unary_expression10" | + 394 => "unary_expression11" | + 395 => "unary_expression12" | + 396 => "unary_operator1" | + 397 => "unary_operator2" | + 398 => "unary_operator3" | + 399 => "unary_operator4" | + 400 => "unary_operator5" | + 401 => "unary_operator6" | + 402 => "cast_expression1" | + 403 => "cast_expression2" | + 404 => "multiplicative_expression1" | + 405 => "multiplicative_expression2" | + 406 => "multiplicative_expression3" | + 407 => "multiplicative_expression4" | + 408 => "additive_expression1" | + 409 => "additive_expression2" | + 410 => "additive_expression3" | + 411 => "shift_expression1" | + 412 => "shift_expression2" | + 413 => "shift_expression3" | + 414 => "relational_expression1" | + 415 => "relational_expression2" | + 416 => "relational_expression3" | + 417 => "relational_expression4" | + 418 => "relational_expression5" | + 419 => "equality_expression1" | + 420 => "equality_expression2" | + 421 => "equality_expression3" | + 422 => "and_expression1" | + 423 => "and_expression2" | + 424 => "exclusive_or_expression1" | + 425 => "exclusive_or_expression2" | + 426 => "inclusive_or_expression1" | + 427 => "inclusive_or_expression2" | + 428 => "logical_and_expression1" | + 429 => "logical_and_expression2" | + 430 => "logical_or_expression1" | + 431 => "logical_or_expression2" | + 432 => "conditional_expression1" | + 433 => "conditional_expression2" | + 434 => "conditional_expression3" | + 435 => "assignment_expression1" | + 436 => "assignment_expression2" | + 437 => "assignment_operator1" | + 438 => "assignment_operator2" | + 439 => "assignment_operator3" | + 440 => "assignment_operator4" | + 441 => "assignment_operator5" | + 442 => "assignment_operator6" | + 443 => "assignment_operator7" | + 444 => "assignment_operator8" | + 445 => "assignment_operator9" | + 446 => "assignment_operator10" | + 447 => "assignment_operator11" | + 448 => "expression1" | + 449 => "expression2" | + 450 => "comma_expression1" | + 451 => "comma_expression2" | + 452 => "expression_opt1" | + 453 => "expression_opt2" | + 454 => "assignment_expression_opt1" | + 455 => "assignment_expression_opt2" | + 456 => "constant_expression" | + 457 => "constant1" | + 458 => "constant2" | + 459 => "constant3" | + 460 => "string_literal1" | + 461 => "string_literal2" | + 462 => "string_literal_list1" | + 463 => "string_literal_list2" | + 464 => "clang_version_literal" | + 465 => "identifier1" | + 466 => "identifier2" | + 467 => "attrs_opt1" | + 468 => "attrs_opt2" | + 469 => "attrs1" | + 470 => "attrs2" | + 471 => "attr" | + 472 => "attribute_list1" | + 473 => "attribute_list2" | + 474 => "attribute1" | + 475 => "attribute2" | + 476 => "attribute3" | + 477 => "attribute4" | + 478 => "attribute5" | + 479 => "attribute_params1" | + 480 => "attribute_params2" | + 481 => "attribute_params3" | + 482 => "attribute_params4" | + 483 => "attribute_params5" | + 484 => "attribute_params6" | + _ => error "reduce type not found" val reduce0 = fn translation_unit x => x | _ => error "Only expecting translation_unit" val reduce1 = fn ext_decl_list x => x | _ => error "Only expecting ext_decl_list" val reduce2 = fn ext_decl_list x => x | _ => error "Only expecting ext_decl_list" diff --git a/C11-FrontEnd/semantic-backends/CLEAN/Clean.thy b/C11-FrontEnd/semantic-backends/CLEAN/Clean.thy deleted file mode 120000 index a688de20b28dc68a36e68b647d4e8ba8d7d1eb2f..0000000000000000000000000000000000000000 --- a/C11-FrontEnd/semantic-backends/CLEAN/Clean.thy +++ /dev/null @@ -1 +0,0 @@ -../../../../src/Clean.thy \ No newline at end of file diff --git a/C11-FrontEnd/semantic-backends/CLEAN/MonadSE.thy b/C11-FrontEnd/semantic-backends/CLEAN/MonadSE.thy deleted file mode 120000 index 8dc5843dc8b085cfc434ca6d489858bc83567e89..0000000000000000000000000000000000000000 --- a/C11-FrontEnd/semantic-backends/CLEAN/MonadSE.thy +++ /dev/null @@ -1 +0,0 @@ -../../../../src/MonadSE.thy \ No newline at end of file diff --git a/C11-FrontEnd/src/C_Ast.thy b/C11-FrontEnd/src/C_Ast.thy index da84e31f45560faf1d67db2c8291570027aa217d..6dd6c4969830ce55de2343ee7be7c1006c80ff10 100644 --- a/C11-FrontEnd/src/C_Ast.thy +++ b/C11-FrontEnd/src/C_Ast.thy @@ -35,7 +35,7 @@ ******************************************************************************) theory C_Ast - imports "../C_Intro" + imports Main begin section \<open>Importing the AST of Haskell Language.C\<close> diff --git a/C11-FrontEnd/src/C_Environment.thy b/C11-FrontEnd/src/C_Environment.thy index 7b838f796b106c12d1e31b53bb18180de7535f64..fb000ffff732329ba177fe4c6f49124926fe39b3 100644 --- a/C11-FrontEnd/src/C_Environment.thy +++ b/C11-FrontEnd/src/C_Environment.thy @@ -90,9 +90,8 @@ type var_table = { tyidents : (Position.T list * serial) Symtab.table type 'antiq_language_list stream = ('antiq_language_list, C_Lex.token) C_Scan.either list -\<comment> \<open>Key entry point environment to the C language\<close> -type env_lang = { var_table : var_table \<comment> \<open>current active table in the scope\<close> - , scopes : (C_Ast.ident option * var_table) list \<comment> \<open>parent scope tables\<close> +type env_lang = { var_table : var_table + , scopes : (C_Ast.ident option * var_table) list , namesupply : int , stream_ignored : C_Antiquote.antiq stream , env_directives : C_Transition.env_directives } diff --git a/C11-FrontEnd/src/C_Parser_Annotation.thy b/C11-FrontEnd/src/C_Parser_Annotation.thy index 681126f51cc6a1e0e810f59f5dbde2f835eefc3c..6d9d784f1f47cdaadcd6a252460438461f5e74d9 100644 --- a/C11-FrontEnd/src/C_Parser_Annotation.thy +++ b/C11-FrontEnd/src/C_Parser_Annotation.thy @@ -520,24 +520,24 @@ fun scan_token keywords = !!! "bad input" scan_comment >> token_range (Token.Comment NONE) || Comment.scan >> (fn (k, ss) => token (Token.Comment (SOME k)) ss) || scan_space >> token Token.Space || - (Scan.repeats1 ($$$ "+") >> pair_t Token.Sym_Ident || - Scan.repeats1 ($$$ "@") >> pair_t Token.Sym_Ident || - Scan.repeats1 ($$$ "&") >> pair_t Token.Sym_Ident || - Scan.max token_leq - (Scan.max token_leq - (Scan.literal (C_Keyword.major_keywords keywords) >> pair_f Token.Command) - ($$$ ":" >> pair_t Token.Keyword || - Scan.literal (C_Keyword.minor_keywords keywords) >> pair_f Token.Keyword)) - (Lexicon.scan_longid >> pair_f Token.Long_Ident || - C_Lex.scan_ident >> pair_f Token.Ident || - Lexicon.scan_id >> pair_f Token.Ident || - Lexicon.scan_var >> pair_f Token.Var || - Lexicon.scan_tid >> pair_f Token.Type_Ident || - Lexicon.scan_tvar >> pair_f Token.Type_Var || - Symbol_Pos.scan_float >> pair_f Token.Float || - Symbol_Pos.scan_nat >> pair_f Token.Nat || - $$$ "[" @@@ $$$ "*" @@@ $$$ "]" >> pair_t Token.Sym_Ident || - scan_symid >> pair_f Token.Sym_Ident)) >> uncurry token'); + (Scan.max token_leq + (Scan.max token_leq + (Scan.literal (C_Keyword.major_keywords keywords) >> pair_f Token.Command) + ($$$ ":" >> pair_t Token.Keyword || + Scan.literal (C_Keyword.minor_keywords keywords) >> pair_f Token.Keyword)) + (Lexicon.scan_longid >> pair_f Token.Long_Ident || + C_Lex.scan_ident >> pair_f Token.Ident || + Lexicon.scan_id >> pair_f Token.Ident || + Lexicon.scan_var >> pair_f Token.Var || + Lexicon.scan_tid >> pair_f Token.Type_Ident || + Lexicon.scan_tvar >> pair_f Token.Type_Var || + Symbol_Pos.scan_float >> pair_f Token.Float || + Symbol_Pos.scan_nat >> pair_f Token.Nat || + Scan.repeats1 ($$$ "+") >> pair_t Token.Sym_Ident || + Scan.repeats1 ($$$ "@") >> pair_t Token.Sym_Ident || + Scan.repeats1 ($$$ "&") >> pair_t Token.Sym_Ident || + $$$ "[" @@@ $$$ "*" @@@ $$$ "]" >> pair_t Token.Sym_Ident || + scan_symid >> pair_f Token.Sym_Ident)) >> uncurry token'); fun recover msg = (Scan.one (Symbol.not_eof o Symbol_Pos.symbol) >> single) @@ -1072,6 +1072,12 @@ fun add_command name cmd thy = (command_pos cmd) (command_markup true (name, cmd)); in Data.map (Symtab.update (name, cmd)) thy end; +fun delete_command (name, pos) thy = + let + val _ = + C_Keyword.is_command (C_Thy_Header.get_keywords thy) name orelse + err_command "Undeclared outer syntax command " name [pos]; + in Data.map (Symtab.delete name) thy end; (* implicit theory setup *) diff --git a/Citadelle/LICENSE b/Citadelle/LICENSE deleted file mode 100644 index 998cca27efb0a4fe3bde5208215910269154f3b8..0000000000000000000000000000000000000000 --- a/Citadelle/LICENSE +++ /dev/null @@ -1,39 +0,0 @@ -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. diff --git a/Citadelle/LICENSE.thy b/Citadelle/LICENSE.thy deleted file mode 100644 index 9812481184bb828996bf90dc86453dd146bc4169..0000000000000000000000000000000000000000 --- a/Citadelle/LICENSE.thy +++ /dev/null @@ -1,152 +0,0 @@ -theory LICENSE imports LICENSE0 begin license "3-Clause BSD" where \<open> - -Copyright (c) 2017-2018 Virginia Tech, USA - 2018-2019 Université Paris-Saclay, Univ. Paris-Sud, France \<close>\<open> - -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. -\<close> - -country ch where \<open>Switzerland\<close> -country de where \<open>Germany\<close> -country fr where \<open>France\<close> -country sg where \<open>Singapore\<close> -country uk where \<open>UK\<close> -country us where \<open>USA\<close> - -holder brucker :: de where \<open>Achim D. Brucker\<close> -holder cam :: uk where \<open>University of Cambridge\<close> -holder contributors where \<open>Contributors (in the changeset history)\<close> -holder ethz :: ch where \<open>ETH Zurich\<close> -holder "irt-systemx" :: fr where \<open>IRT SystemX\<close> -holder ntu :: sg where \<open>Nanyang Technological University\<close> -holder sheffield :: uk where \<open>The University of Sheffield\<close> -holder tum :: de where \<open>Technische Universität München\<close> -holder "u-psud" :: fr where \<open>Université Paris-Saclay\<close>, \<open>Univ. Paris-Sud\<close> -holder vt :: us where \<open>Virginia Tech\<close> -holder wolff :: fr where \<open>B. Wolff\<close>, \<open>Univ. Paris-Saclay\<close>, \<open>Univ. Paris-Sud\<close> - -copyright default where 2011-2019 "u-psud" - 2013-2017 "irt-systemx" - 2011-2015 brucker - 2016-2019 sheffield - 2016-2017 ntu - 2017-2018 vt - -project ROOT :: "3-Clause BSD" where \<open> -http://www.brucker.ch/projects/hol-testgen/ -This file is part of HOL-TestGen. -\<close> imports default - -project LICENSE0 :: "3-Clause BSD" where \<open>LICENSE\<close> defines 2017-2018 vt - 2018-2019 "u-psud" - -project LICENSE :: "3-Clause BSD" where \<open> -theory LICENSE imports LICENSE0 begin license "3-Clause BSD" where -\<close> defines 2017-2018 vt - 2018-2019 "u-psud" - -project "Featherweight OCL" :: "3-Clause BSD" where \<open> -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. -\<close> imports default - -project Citadelle :: "3-Clause BSD" where \<open>Citadelle\<close> imports default - -project Isabelle_Meta_Model :: "3-Clause BSD" where \<open>A Meta-Model for the Isabelle API\<close> imports default - -project Isabelle :: "3-Clause BSD" where \<open> -ISABELLE COPYRIGHT NOTICE, LICENCE AND DISCLAIMER. -\<close> defines 1986-2019 cam - 1986-2019 tum - 1986-2019 contributors - -project Haskabelle_Meta_Model :: "3-Clause BSD" where \<open> -A Meta-Model for the Haskabelle API -\<close> defines 2007-2015 tum - 2017-2018 vt - 2018-2019 "u-psud" - -project "HOL-OCL" :: "3-Clause BSD" where \<open>HOL-OCL\<close> imports default - -project "HOL-TOY" :: "3-Clause BSD" where \<open>HOL-TOY\<close> imports default - -project "HOL-HKB" :: "3-Clause BSD" where \<open>HOL-HKB\<close> defines 2017-2018 vt - 2018-2019 "u-psud" - -project C_Meta_Model :: "3-Clause BSD" where \<open> -A Meta-Model for the Language.C Haskell Library -\<close> defines 2016-2017 ntu - 2017-2018 vt - 2018-2019 "u-psud" - -project C_ML :: "3-Clause BSD" where \<open> -Generation of Language.C Grammar with ML Interface Binding -\<close> defines 2018-2019 "u-psud" - -project Miscellaneous_Monads :: "3-Clause BSD" where \<open> -HOL-TestGen --- theorem-prover based test case generation - http://www.brucker.ch/projects/hol-testgen/ - -Monads.thy --- a base testing theory for sequential computations. -This file is part of HOL-TestGen. -\<close> defines 2005-2007 ethz - 2009 wolff - 2009,2012 brucker - 2013-2016 "u-psud" - 2013-2016 "irt-systemx" - -check_license Miscellaneous_Monads - in file "examples/archive/Monads.thy" -(* -check_license C_ML - in "../C11-FrontEnd" -*)(* -check_license ROOT - LICENSE0 - LICENSE - "Featherweight OCL" - Citadelle - Isabelle_Meta_Model - Isabelle - Haskabelle_Meta_Model - "HOL-OCL" - "HOL-TOY" - "HOL-HKB" - C_Meta_Model - in "." -*)(* -insert_license -map_license -*) -end \ No newline at end of file diff --git a/Citadelle/LICENSE0.thy b/Citadelle/LICENSE0.thy deleted file mode 100644 index 486ebb1c6b9ff1345a7a780075c845cddbba7410..0000000000000000000000000000000000000000 --- a/Citadelle/LICENSE0.thy +++ /dev/null @@ -1,313 +0,0 @@ -(****************************************************************************** - * LICENSE - * - * Copyright (c) 2017-2018 Virginia Tech, USA - * 2018-2019 Université Paris-Saclay, Univ. Paris-Sud, France - * - * 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 LICENSE0 - imports Main - keywords "portions" - and "project" "country" "holder" "copyright" "license" - "check_license" "insert_license" "map_license" :: thy_decl -begin - -ML\<open> -structure Resources' = struct - fun check_path' check_file ctxt dir (name, pos) = - let - fun err msg pos = error (msg ^ Position.here pos) - val _ = Context_Position.report ctxt pos Markup.language_path; - - val path = Path.append dir (Path.explode name) handle ERROR msg => err msg pos; - val path' = Path.expand path handle ERROR msg => err msg pos; - val _ = Context_Position.report ctxt pos (Markup.path (Path.smart_implode path)); - val _ = - (case check_file of - NONE => path - | SOME check => (check path handle ERROR msg => err msg pos)); - in path' end - - fun check_dir thy = check_path' (SOME File.check_dir) - (Proof_Context.init_global thy) - (Resources.master_directory thy) -end - -fun fold_dir f path = - File.fold_dir - (fn s => - let val path = Path.append path (Path.explode s) - in if File.is_dir path then fold_dir f path else f path end) - path -\<close> - -ML\<open> -datatype ('a, 'b) either = Left of 'a | Right of 'b - -fun the_left (Left a) = a - -signature OBJECT = sig - type T - val key : string - val pretty : T -> string -end - -functor Theory_Data' (Obj : OBJECT) : THEORY_DATA = Theory_Data - (type T = Obj.T Name_Space.table - val empty = Name_Space.empty_table Obj.key - val extend = I - val merge = Name_Space.merge_tables) - -val pretty_input = Input.source_content #> split_lines #> trim (fn s => s = "") #> cat_lines - -structure Country0 : OBJECT = struct - type T = Input.source - val key = "country" - val pretty = pretty_input -end - -structure Country = Theory_Data' (Country0) - -structure Holder0 : OBJECT = struct - type T = Input.source list * Country0.T option - val key = "holder" - fun pretty (l, country) = - let val sep = ", " in - String.concatWith sep (map (fn s => s |> Input.source_explode |> trim (Symbol.is_blank o Symbol_Pos.symbol) |> Symbol_Pos.content) l) - ^ (case country of NONE => "" | SOME country => sep ^ Country0.pretty country) - end -end - -structure Holder = Theory_Data' (Holder0) - -datatype date = D_interval of int (*date min*) * int (*date max*) - | D_discrete of int list - -structure Date0 : OBJECT where type T = date = struct - type T = date - val key = "date" - val pretty = fn D_interval (d_min, d_max) => Int.toString d_min ^ "-" ^ Int.toString d_max - | D_discrete l => String.concatWith "," (map Int.toString l) -end - -structure Copyright0 : OBJECT = struct - type T = (bool (*false: portions copyright*) * Date0.T * Holder0.T list) list - val key = "copyright" - fun pretty l = - let - val s_copy = "Copyright (c) " - fun s_portions b = if b then Symbol.spaces (String.size s_copy) else "Portions " ^ s_copy - in - case map (fn (b, date, l) => (b, case l of h :: hs => let val s_date = Date0.pretty date ^ " " - in s_date ^ Holder0.pretty h - :: map (fn h => Symbol.spaces (String.size s_date) ^ Holder0.pretty h) hs end)) l - of (true, l) :: ls => - let fun f s_copy (l :: ls) = - s_copy ^ l ^ String.concat (map (fn s => "\n" ^ Symbol.spaces (String.size s_copy) ^ s) ls) - in f s_copy l ^ String.concat (map (fn (b, l) => "\n" ^ f (s_portions b) l) ls) end - end -end - -structure Copyright = Theory_Data' (Copyright0) - -structure License0 : OBJECT = struct - type T = Input.source - val key = "license" - val pretty = pretty_input -end - -structure License = Theory_Data' (License0) - -type project_head = (Input.source * Copyright0.T) list - -structure Project0 : sig include OBJECT val pretty0 : bool -> project_head * Input.source -> string - end = struct - type T = project_head * License0.T - val key = "project" - fun wrap_stars s = - let val stars = "******************************************************************************" in - cat_lines - ("(" ^ stars - :: map ((fn s => " *" ^ s) o (fn "" => "" | s => " " ^ s)) (split_lines s) - @ [" " ^ stars ^ ")"]) - end - fun pretty0 stars (l, lic) = - let val s_end = case l of [_] => "" | _ => "\n\n * * * * * * * * * * * * * * * * * * * * * * * * *" - in String.concat (map (fn (src, copy) => pretty_input src ^ (if stars then "" else " " ^ Symbol.open_) ^ "\n\n" ^ Copyright0.pretty copy ^ s_end ^ (if stars then "" else " " ^ Symbol.close ^ Symbol.open_) ^ "\n\n") l) - ^ License0.pretty lic - |> (if stars then wrap_stars else fn s => s ^ "\n" ^ Symbol.close) - end - val pretty = pretty0 true -end - -structure Project = Theory_Data' (Project0) - -fun define0 data_map n thy = data_map (#2 o Name_Space.define (Context.Theory thy) true n) thy -fun define key data_map n = - ( key - , Toplevel.theory - (fn thy => data_map (#2 o Name_Space.define (Context.Theory thy) true n) - thy)) - -local - fun check0 f_map key data_get f n f_left = - ( key - , Toplevel.theory - (fn thy => f (f_map (fn (Right a, v) => (Right a, v) - | (Left k, v) => (Left (f_left (Name_Space.check (Context.Theory thy) (data_get thy)) k), v)) n) thy)) -in -fun check key data_get f n = check0 (fn f => Option.map (the_left o #1 o f)) key data_get f (Option.map (fn n => (Left n, ())) n) -fun check' key = check0 map key -end - -structure Parse' = struct - datatype copyright = C_ref of string * Position.T - | C_def of (((string option * int) * (bool * int) option) * (string * Position.T) list) list - val copyright = - Scan.repeat (Scan.option (Parse.$$$ "portions") -- Parse.nat -- Scan.option ((Parse.$$$ "," >> K false || Parse.minus >> K true) -- Parse.nat) -- Parse.list1 (Parse.position Parse.name)) - - fun copyright_check key f = check' key Holder.get f - - fun copyright_check' h ((portions, d0), opt_d) = - ( portions = NONE - , case opt_d of SOME (true, d_max) => D_interval (d0, d_max) - | SOME (false, d1) => D_discrete [d0, d1] - | NONE => D_discrete [d0] - , h) -end - -val _ = - Outer_Syntax.commands @{command_keyword project} "formal comment (primary style)" - (Parse.binding --| Parse.$$$ "::" -- Parse.position Parse.name -- Scan.repeat1 (Parse.where_ |-- Parse.document_source -- - ( Parse.$$$ "imports" |-- Parse.position Parse.name >> Parse'.C_ref - || Parse.$$$ "defines" |-- Parse'.copyright >> Parse'.C_def)) >> - (fn ((n, lic), l_pj) => - [( @{command_keyword project} - , Toplevel.theory - (fn thy => - define0 - Project.map - ( n - , ( map (fn (x, opt_n) => - (x, case opt_n of - Parse'.C_ref n => #2 (Name_Space.check (Context.Theory thy) (Copyright.get thy) n) - | Parse'.C_def l_src => map (fn (v, holder) => Parse'.copyright_check' (map (#2 o Name_Space.check (Context.Theory thy) (Holder.get thy)) holder) v) l_src)) - l_pj - , #2 (Name_Space.check (Context.Theory thy) (License.get thy) lic))) - thy))])); - -val _ = - Outer_Syntax.commands @{command_keyword country} "formal comment (primary style)" - (Parse.binding --| Parse.where_ -- Parse.document_source >> - (fn (n, src) => - [ define @{command_keyword country} Country.map (n, src) - , (@{command_keyword country}, Pure_Syn.document_command {markdown = true} (NONE, src))])); - -val _ = - Outer_Syntax.commands @{command_keyword holder} "formal comment (primary style)" - (Parse.binding -- Scan.option (Parse.$$$ "::" |-- Parse.position Parse.name) --| Parse.where_ -- Parse.list Parse.document_source >> - (fn ((name, country), l_src) => - check - @{command_keyword holder} - Country.get - (fn country => define0 Holder.map (name, (l_src, Option.map #2 country))) - country - I - :: map (fn src => - (@{command_keyword holder}, Pure_Syn.document_command {markdown = true} (NONE, src))) - l_src)); - -val _ = - Outer_Syntax.commands @{command_keyword copyright} "formal comment (primary style)" - (Parse.binding --| Parse.where_ -- Parse'.copyright >> - (fn (n, l_src) => - [Parse'.copyright_check - @{command_keyword copyright} - (fn l => define0 - Copyright.map - (n, map (fn (Left h, d) => Parse'.copyright_check' h d) l)) - (map (fn (a, b) => (Left b, a)) l_src) - (fn f => map (#2 o f))])); - -val _ = - Outer_Syntax.commands @{command_keyword license} "formal comment (primary style)" - (Parse.binding --| Parse.where_ -- Parse.document_source (* ignored for bootstrapping *) - -- Parse.document_source >> - (fn ((n, _), src) => - [ define @{command_keyword license} License.map (n, src) - , (@{command_keyword license}, Pure_Syn.document_command {markdown = true} (NONE, src))])); - -val _ = - Outer_Syntax.commands' @{command_keyword check_license} "formal comment (primary style)" - (Scan.repeat (Parse.position Parse.name) --| Parse.$$$ "in" -- Scan.option (Parse.$$$ "file") -- Parse.position Parse.path >> - (fn ((pj, file), loc) => fn thy => fn _ => - let - fun head stars = map (fn n => Project0.pretty0 stars (#2 (Name_Space.check (Context.Theory thy) (Project.get thy) n))) pj - val l_head = head true - val l_head0 = head false - (*val _ = List.app (fn s => writeln s) l_head0*) - fun f s = - let - fun f_exists f_un s l = fold (fn p => fn b => b orelse try (f_un p) s <> NONE) l false - in - cons ( @{command_keyword check_license} - , Toplevel.keep - (fn _ => - let val base_name = Path.base_name s - in - if f_exists unprefix (File.read s) (if base_name = "LICENSE.thy" then l_head0 else l_head) then - writeln (@{make_string} s) - else if f_exists unsuffix base_name [".thy", ".ml", ".ML", "ROOT"] then - error (@{make_string} s) - else - warning (@{make_string} s) - end)) - end - in - (case file of NONE => fold_dir f (Resources'.check_dir thy loc) - | SOME _ => f (Resources'.check_path' (SOME File.check_file) (Proof_Context.init_global thy) (Resources.master_directory thy) loc)) - [] - end)) - -val _ = - Outer_Syntax.command @{command_keyword insert_license} "formal comment (primary style)" - (Scan.option Parse.binding >> - (fn _ => Toplevel.keep (fn _ => warning "to be implemented"))) - -val _ = - Outer_Syntax.command @{command_keyword map_license} "formal comment (primary style)" - (Scan.option Parse.binding >> - (fn _ => Toplevel.keep (fn _ => warning "to be implemented"))) -\<close> - -end \ No newline at end of file diff --git a/Citadelle/README.md b/Citadelle/README.md deleted file mode 100644 index 742e893f4740708ad2796f6387d37f9bbefedd75..0000000000000000000000000000000000000000 --- a/Citadelle/README.md +++ /dev/null @@ -1,48 +0,0 @@ -# HOL-OCL 2.0 -HOL-OCL 2.0 is a successor of -[HOL-OCL](https://www.brucker.ch/projects/hol-ocl/), an interactive -proof environment for the *Object Constraint Language (OCL)*. HOL-OCL -2.0 as a tool is based on a library defining its core semantic -concepts called [Featherweight -OCL](https://www.isa-afp.org/entries/Featherweight_OCL.shtml), which -also serves as basis for the ongoing OCL 2.5 standardisation at the -OMG. - -HOL-OCL 2.0 addresses the fragment in UML concerned with -object-oriented data modelling. Thus, it comes with a number of -packages related with the semantic constructions and instantiations of -objects, among other the *Class Model Package* to set up the -underlying object-oriented datatype theory, or the *Invariant & -Operation Package* supporting a formal contract language to define -methods issued from a class model. - -## Authors -* [Achim D. Brucker](http://www.brucker.ch/) -* Frédéric Tuong -* [Burkhart Wolff](https://www.lri.fr/~wolff/) - -## License -This project is licensed under a 3-clause BSD-style license. - -## Publications -* Frédéric Tuong. Constructing Semantically Sound Object-Logics for - UML/OCL Based Domain-Specific Languages. Université Paris-Sud, IRT - SystemX, LRI, CNRS, CentraleSupélec, Université Paris-Saclay, 2016. - https://tel.archives-ouvertes.fr/tel-01318156, Formal proof - development. - -* Frédéric Tuong, and Burkhart Wolff. A Meta-Model for the Isabelle API. In - Archive of Formal Proofs, 2015. - http://www.isa-afp.org/entries/Isabelle_Meta_Model.shtml, Formal proof - development. - -* Achim D. Brucker, Frédéric Tuong, and Burkhart Wolff. Featherweight - OCL: A Proposal for a Machine-Checked Formal Semantics for OCL 2.5. In - Archive of Formal Proofs, 2014. - http://www.isa-afp.org/entries/Featherweight_OCL.shtml, Formal proof - development. - -* Achim D. Brucker and Burkhart Wolff. Featherweight OCL: A study for - the consistent semantics of OCL 2.3 in HOL. In Workshop on OCL and - Textual Modelling (OCL 2012), pages 19-24, 2012. - https://www.brucker.ch/bibliography/abstract/brucker.ea-featherweight-2012 diff --git a/Citadelle/README_advanced.txt b/Citadelle/README_advanced.txt deleted file mode 100644 index cb41f3655c164116df7aca4035756993934d66d4..0000000000000000000000000000000000000000 --- a/Citadelle/README_advanced.txt +++ /dev/null @@ -1,91 +0,0 @@ -This directory contains the detailed AFP submission of the -"Featherweight OCL" semantics for OCL as well as our proposal -for Appendix A of the OCL standard. - -Beyond the standard mechanism - -(* < *) -<<skipped isar text, not shown in doc >> -(* > *) - -The two main targets of this Isabelle project are: -- check everything and generate all documents allowing "sorry"'s, i.e., - using Isabelles "quick-and-dirty"-mode: - - isabelle build -c -d . -v -b OCL-dirty - -- check everything and generate all documents, ensuring that - no "sorry"'s are used: - - isabelle build -c -d . -v -b OCL - -In your LaTeX text, you can use the following two PlainTeX -environments for selecting in which version your text should -appear: - -\isatagafp - This text will only be visible in the AFP submission, i.e., - document.pdf and outline.pdf. -\endisatagafp - -\isatagannexa - This text will only be visible in the Annex A, i.e., annex-a.pdf. -\endisatagannexa - - -Note that these tags only work within regular Isabelle/Isar "text" -commands if they are complete, i.e.: - - text {* ... \isatagafp ... \endisatagafp ...*} - -Only opening or closing such a tag in Isabelle/Isar "text" commands -will not work. For this, you need to use the "text_raw" command: - - text_raw {* \isatagafp *} - ... - text_raw {* \endisatagafp *} - - -For working, these tags rely on the file comment.sty, which -is automatically added by Isabelle during the document generation. -However at the time of writing, the current comment.sty included by -Isabelle (version 3.6) mentions: - "The opening and closing commands should appear on a line - of their own. No starting spaces, nothing after it." -In particular, it is not advised to put these tags in a single line: -\isatagafp ... \endisatagafp % wrong -otherwise as side effects some parts occurring after these tags may be -skipped. The recommanded solution is to always write each tag in a -separate line: -\isatagafp - ... -\endisatagafp - - -Warning: -======= -Please check twice that you are using \isatagX and \endisatagX -properly, i.e., -- always pairwise matching -- not separating other envirments. -Not using these PlainTeX environments (which are, generally, -obsolete and discouraged but used by the Isabelle LaTeX setup -anyhow. We only use them to avoid introducing a parallel setup to -the one that we cannot avoid due to design decisions by the -Isabelle maintainer) carefully, will result in LaTeX errors that -are close to not debug-able. - - -List of Isabelle versions to use depending on revisions: -========================================================= -2018/02/05 revision 13265: Isabelle2017 (October 2017) -2018/01/29 revision 13259: Isabelle2016-1 (December 2016) -2016/02/22 revision 12439: Isabelle2016 (February 2016) -2015/06/11 revision 11691: Isabelle2015 (May 2015) -2015/02/02 revision 11283: Isabelle2014 (August 2014) -2013/12/05 revision 10054: Isabelle2013-2 (December 2013) -2013/12/02 revision 10013: Isabelle2013-1 (November 2013) -2013/11/14 revision 9950: Isabelle2013 (February 2013) -2013/05/27 revision 9682: Isabelle2012 (May 2012) -(* 2013/03/27 revision 9616 *) - revision ?: Isabelle2011-1 (October 2011) diff --git a/Citadelle/ROOT b/Citadelle/ROOT deleted file mode 100644 index 1430213e14616341d77fa66154e546ae3937f560..0000000000000000000000000000000000000000 --- a/Citadelle/ROOT +++ /dev/null @@ -1,181 +0,0 @@ -(****************************************************************************** - * 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. - ******************************************************************************) - -session "OCL" in "src" = HOL + - description {* Featherweight OCL *} - options [document=pdf,document_output=document_generated, - document_variants="annex-a=annexa,-theory,-afp,-noexample,-proof,-ML:document=afp,-annexa,-noexample:outline=-annexa,-noexample,afp,/proof,/ML", - show_question_marks = false] - theories - "../src/UML_Main" - "../examples/Employee_Model/Analysis/Analysis_OCL" - "../examples/Employee_Model/Design/Design_OCL" - document_files - "conclusion.tex" - "figures/AbstractSimpleChair.pdf" - "figures/jedit.png" - (*"figures/logo_focl.pdf"*) - "figures/pdf.png" - "figures/person.png" - "figures/pre-post.pdf" - "fixme.sty" - "hol-ocl-isar.sty" - "introduction.tex" - "lstisar.sty" - "omg.sty" - "prooftree.sty" - "root.bib" - "root.tex" - "FOCL_Syntax.tex" - -session "FOCL" in "src" = "HOL-Library" + - description {* Citadelle (Sequential) *} - options [document=pdf,document_output=document_generated, - document_variants="document=noexample,-afp,-annexa", - show_question_marks = false] - theories - UML_OCL - document_files - "conclusion.tex" - "figures/AbstractSimpleChair.pdf" - "figures/jedit.png" - (*"figures/logo_focl.pdf"*) - "figures/pdf.png" - "figures/person.png" - "figures/pre-post.pdf" - "fixme.sty" - "hol-ocl-isar.sty" - "introduction.tex" - "lstisar.sty" - "omg.sty" - "prooftree.sty" - "root.bib" - "root.tex" - "FOCL_Syntax.tex" - -session "Citadelle" in "src" = "FOCL" + - description {* Citadelle (Concurrent) *} - sessions - FOCL - theories - "compiler/Generator_dynamic_concurrent" - "compiler/Generator_dynamic_export_testing" - -session "Citadelle_C_init" in "src" = "Citadelle" + - theories - "../examples/C_Model_init" - -session "Citadelle_C_deep-dirty" in "src" = "Citadelle_C_init" + - options [quick_and_dirty] - theories - "../doc/Meta_C_generated" - -session "Citadelle_C_shallow-dirty" in "src" = "Citadelle_C_init" + - options [quick_and_dirty] - theories - "../examples/C_Model_core" - -session "Citadelle_C_model-dirty" in "src" = "Citadelle_C_shallow-dirty" + - options [quick_and_dirty] - theories - "../examples/C_Model_ml" - -(******************************************************) - -session "Max-dirty" in "src" = "HOL-Library" + - options [quick_and_dirty,document=pdf,document_output=document_generated, - document_variants="document=afp,-annexa,-noexample", - show_question_marks = false] - sessions - OCL - FOCL - theories - "../src/basic_types/UML_UnlimitedNatural" - - "../examples/empirical_evaluation/Class_model" - - "../src/compiler/Generator_static" - - "../doc/Employee_AnalysisModel_UMLPart_generated" - "../doc/Employee_DesignModel_UMLPart_generated" - - "../examples/Bank_Model" - "../examples/Bank_Test_Model" - "../examples/Clocks_Lib_Model" - (*"../examples/Employee_Model/Analysis_deep"*) - "../examples/Employee_Model/Analysis_shallow" - (*"../examples/Employee_Model/Design_deep"*) - "../examples/Employee_Model/Design_shallow" - "../examples/Flight_Model" - "../examples/AbstractList" - "../examples/LinkedList" - (*"../examples/ListRefinement"*) - "../examples/archive/Flight_Model_compact" - "../examples/archive/Simple_Model" - "../examples/archive/Toy_deep" - "../examples/archive/Toy_shallow" - - "../src/compiler/Aux_proof" - "../src/compiler/Aux_tactic" - "../src/compiler/Aux_text" - "../src/compiler/Rail" - - "../examples/archive/OCL_core_experiments" - "../examples/archive/OCL_lib_Gogolla_challenge_naive" - "../examples/archive/OCL_lib_Gogolla_challenge_integer" - document_files - "conclusion.tex" - "figures/AbstractSimpleChair.pdf" - "figures/jedit.png" - (*"figures/logo_focl.pdf"*) - "figures/pdf.png" - "figures/person.png" - "figures/pre-post.pdf" - "fixme.sty" - "hol-ocl-isar.sty" - "introduction.tex" - "lstisar.sty" - "omg.sty" - "prooftree.sty" - "root.bib" - "root.tex" - "FOCL_Syntax.tex" diff --git a/Citadelle/ROOTS b/Citadelle/ROOTS deleted file mode 100644 index cbc782c1e24664fefdfbfadd9dafab94d62d9532..0000000000000000000000000000000000000000 --- a/Citadelle/ROOTS +++ /dev/null @@ -1 +0,0 @@ -src/compiler_generic diff --git a/Citadelle/doc/Employee_AnalysisModel_UMLPart_generated.thy b/Citadelle/doc/Employee_AnalysisModel_UMLPart_generated.thy deleted file mode 100644 index 120b773e863b9216511d7ec7c83dc503f413439a..0000000000000000000000000000000000000000 --- a/Citadelle/doc/Employee_AnalysisModel_UMLPart_generated.thy +++ /dev/null @@ -1,3788 +0,0 @@ -theory Employee_AnalysisModel_UMLPart_generated imports "OCL.UML_Main" "FOCL.Static" "FOCL.Generator_dynamic_sequential" begin - -(* 1 ************************************ 0 + 0 *) (* term Floor1_infra.print_infra_enum_synonym *) - -(* 2 ************************************ 0 + 1 *) -text \<open>\<close> - -(* 3 ************************************ 1 + 1 *) -text \<open> - \label{ex:Employee-AnalysisModel-UMLPart-generatedemployee-analysis:uml} \<close> - -(* 4 ************************************ 2 + 1 *) -section \<open>Class Model: Introduction\<close> - -(* 5 ************************************ 3 + 1 *) -text \<open> - - For certain concepts like classes and class-types, only a generic - definition for its resulting semantics can be given. Generic means, - there is a function outside \HOL that ``compiles'' a concrete, - closed-world class diagram into a ``theory'' of this data model, - consisting of a bunch of definitions for classes, accessors, method, - casts, and tests for actual types, as well as proofs for the - fundamental properties of these operations in this concrete data - model. \<close> - -(* 6 ************************************ 4 + 1 *) -text \<open> - Such generic function or ``compiler'' can be implemented in - Isabelle on the \ML level. This has been done, for a semantics - following the open-world assumption, for \UML 2.0 - in~\cite{brucker.ea:extensible:2008-b, brucker:interactive:2007}. In - this paper, we follow another approach for \UML 2.4: we define the - concepts of the compilation informally, and present a concrete - example which is verified in Isabelle/\HOL. \<close> - -(* 7 ************************************ 5 + 1 *) -subsection \<open>Outlining the Example\<close> - -(* 8 ************************************ 6 + 1 *) -text \<open>\<close> - -(* 9 ************************************ 7 + 1 *) -text \<open> - We are presenting here an ``analysis-model'' of the (slightly -modified) example Figure 7.3, page 20 of -the \OCL standard~\cite{omg:ocl:2012}. -Here, analysis model means that associations -were really represented as relation on objects on the state---as is -intended by the standard---rather by pointers between objects as is -done in our ``design model''. -To be precise, this theory contains the formalization of the data-part -covered by the \UML class model (see \autoref{fig:Employee-AnalysisModel-UMLPart-generatedperson-ana}):\<close> - -(* 10 ************************************ 8 + 1 *) -text_raw \<open>\<close> - -(* 11 ************************************ 9 + 1 *) -text_raw \<open> - -\begin{figure} - \centering\scalebox{.3}{\includegraphics{figures/person.png}}% - \caption{A simple \UML class model drawn from Figure 7.3, - page 20 of~\cite{omg:ocl:2012}. \label{fig:Employee-AnalysisModel-UMLPart-generatedperson-ana}} -\end{figure} -\<close> - -(* 12 ************************************ 10 + 1 *) -text \<open> - This means that the association (attached to the association class -\inlineocl{EmployeeRanking}) with the association ends \inlineocl+boss+ and \inlineocl+employees+ is implemented -by the attribute \inlineocl+boss+ and the operation \inlineocl+employees+ (to be discussed in the \OCL part -captured by the subsequent theory). -\<close> - -(* 13 ************************************ 11 + 1 *) -section \<open>Class Model: The Construction of the Object Universe\<close> - -(* 14 ************************************ 12 + 1 *) -text \<open> - Our data universe consists in the concrete class diagram just of node's, -and implicitly of the class object. Each class implies the existence of a class -type defined for the corresponding object representations as follows: \<close> - -(* 15 ************************************ 13 + 8 *) (* term Floor1_infra.print_infra_datatype_class_1 *) -datatype ty\<E>\<X>\<T>\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n = mk\<E>\<X>\<T>\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n "oid" "nat option" "int option" "unit option" "bool option" "oid list list option" -datatype ty\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n = mk\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n "ty\<E>\<X>\<T>\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n" "int option" -datatype ty\<E>\<X>\<T>\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t = mk\<E>\<X>\<T>\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n "ty\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n" - | mk\<E>\<X>\<T>\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t "oid" "unit option" "bool option" "oid list list option" -datatype ty\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t = mk\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t "ty\<E>\<X>\<T>\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t" "nat option" "int option" -datatype ty\<E>\<X>\<T>\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y = mk\<E>\<X>\<T>\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t "ty\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t" - | mk\<E>\<X>\<T>\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n "ty\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n" - | mk\<E>\<X>\<T>\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y "oid" -datatype ty\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y = mk\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y "ty\<E>\<X>\<T>\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y" "unit option" "bool option" "oid list list option" -datatype ty\<E>\<X>\<T>\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y = mk\<E>\<X>\<T>\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y "ty\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y" - | mk\<E>\<X>\<T>\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t "ty\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t" - | mk\<E>\<X>\<T>\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n "ty\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n" - | mk\<E>\<X>\<T>\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y "oid" -datatype ty\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y = mk\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y "ty\<E>\<X>\<T>\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y" - -(* 16 ************************************ 21 + 11 *) (* term Floor1_infra.print_infra_datatype_class_2 *) -datatype ty2\<E>\<X>\<T>\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n = mk2\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n "int option" -datatype ty2oid\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n = mk2oid\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n "oid" "nat option" "int option" "unit option" "bool option" "oid list list option" "ty2\<E>\<X>\<T>\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n" -datatype ty2\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t = mk2\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n "ty2\<E>\<X>\<T>\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n" -datatype ty2\<E>\<X>\<T>\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t = mk2\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t "nat option" "int option" "ty2\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t option" -datatype ty2oid\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t = mk2oid\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t "oid" "unit option" "bool option" "oid list list option" "ty2\<E>\<X>\<T>\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t" -datatype ty2\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y = mk2\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t "ty2\<E>\<X>\<T>\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t" -datatype ty2\<E>\<X>\<T>\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y = mk2\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y "unit option" "bool option" "oid list list option" "ty2\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y option" -datatype ty2oid\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y = mk2oid\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y "oid" "ty2\<E>\<X>\<T>\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y" -datatype ty2\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y = mk2\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y "ty2\<E>\<X>\<T>\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y" -datatype ty2\<E>\<X>\<T>\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y = mk2\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y "ty2\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y option" -datatype ty2oid\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y = mk2oid\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y "oid" "ty2\<E>\<X>\<T>\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y" - -(* 17 ************************************ 32 + 8 *) (* term Floor1_infra.print_infra_datatype_equiv_2of1 *) -definition "class_ty_ext_equiv_2of1_aux\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n = (\<lambda>oid inh\<^sub>w\<^sub>o\<^sub>r\<^sub>m\<^sub>h\<^sub>o\<^sub>l\<^sub>e inh\<^sub>w\<^sub>e\<^sub>i\<^sub>g\<^sub>h\<^sub>t inh\<^sub>s\<^sub>o\<^sub>u\<^sub>n\<^sub>d inh\<^sub>m\<^sub>o\<^sub>v\<^sub>i\<^sub>n\<^sub>g inh\<^sub>o\<^sub>u\<^sub>t\<^sub>e\<^sub>r\<^sub>_\<^sub>w\<^sub>o\<^sub>r\<^sub>l\<^sub>d. (\<lambda> (mk2\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (own\<^sub>s\<^sub>a\<^sub>l\<^sub>a\<^sub>r\<^sub>y)) \<Rightarrow> (mk\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n ((mk\<E>\<X>\<T>\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (oid) (inh\<^sub>w\<^sub>o\<^sub>r\<^sub>m\<^sub>h\<^sub>o\<^sub>l\<^sub>e) (inh\<^sub>w\<^sub>e\<^sub>i\<^sub>g\<^sub>h\<^sub>t) (inh\<^sub>s\<^sub>o\<^sub>u\<^sub>n\<^sub>d) (inh\<^sub>m\<^sub>o\<^sub>v\<^sub>i\<^sub>n\<^sub>g) (inh\<^sub>o\<^sub>u\<^sub>t\<^sub>e\<^sub>r\<^sub>_\<^sub>w\<^sub>o\<^sub>r\<^sub>l\<^sub>d))) (own\<^sub>s\<^sub>a\<^sub>l\<^sub>a\<^sub>r\<^sub>y))))" -definition "class_ty_ext_equiv_2of1\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n = (\<lambda> (mk2oid\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (oid) (inh\<^sub>w\<^sub>o\<^sub>r\<^sub>m\<^sub>h\<^sub>o\<^sub>l\<^sub>e) (inh\<^sub>w\<^sub>e\<^sub>i\<^sub>g\<^sub>h\<^sub>t) (inh\<^sub>s\<^sub>o\<^sub>u\<^sub>n\<^sub>d) (inh\<^sub>m\<^sub>o\<^sub>v\<^sub>i\<^sub>n\<^sub>g) (inh\<^sub>o\<^sub>u\<^sub>t\<^sub>e\<^sub>r\<^sub>_\<^sub>w\<^sub>o\<^sub>r\<^sub>l\<^sub>d) (t)) \<Rightarrow> (class_ty_ext_equiv_2of1_aux\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (oid) (inh\<^sub>w\<^sub>o\<^sub>r\<^sub>m\<^sub>h\<^sub>o\<^sub>l\<^sub>e) (inh\<^sub>w\<^sub>e\<^sub>i\<^sub>g\<^sub>h\<^sub>t) (inh\<^sub>s\<^sub>o\<^sub>u\<^sub>n\<^sub>d) (inh\<^sub>m\<^sub>o\<^sub>v\<^sub>i\<^sub>n\<^sub>g) (inh\<^sub>o\<^sub>u\<^sub>t\<^sub>e\<^sub>r\<^sub>_\<^sub>w\<^sub>o\<^sub>r\<^sub>l\<^sub>d) (t)))" -definition "class_ty_ext_equiv_2of1_aux\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t = (\<lambda>oid inh\<^sub>s\<^sub>o\<^sub>u\<^sub>n\<^sub>d inh\<^sub>m\<^sub>o\<^sub>v\<^sub>i\<^sub>n\<^sub>g inh\<^sub>o\<^sub>u\<^sub>t\<^sub>e\<^sub>r\<^sub>_\<^sub>w\<^sub>o\<^sub>r\<^sub>l\<^sub>d. (\<lambda> (mk2\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (own\<^sub>w\<^sub>o\<^sub>r\<^sub>m\<^sub>h\<^sub>o\<^sub>l\<^sub>e) (own\<^sub>w\<^sub>e\<^sub>i\<^sub>g\<^sub>h\<^sub>t) (t)) \<Rightarrow> (mk\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t ((case t of None \<Rightarrow> (mk\<E>\<X>\<T>\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (oid) (inh\<^sub>s\<^sub>o\<^sub>u\<^sub>n\<^sub>d) (inh\<^sub>m\<^sub>o\<^sub>v\<^sub>i\<^sub>n\<^sub>g) (inh\<^sub>o\<^sub>u\<^sub>t\<^sub>e\<^sub>r\<^sub>_\<^sub>w\<^sub>o\<^sub>r\<^sub>l\<^sub>d)) - | \<lfloor>(mk2\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (t))\<rfloor> \<Rightarrow> (case (class_ty_ext_equiv_2of1_aux\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (oid) (own\<^sub>w\<^sub>o\<^sub>r\<^sub>m\<^sub>h\<^sub>o\<^sub>l\<^sub>e) (own\<^sub>w\<^sub>e\<^sub>i\<^sub>g\<^sub>h\<^sub>t) (inh\<^sub>s\<^sub>o\<^sub>u\<^sub>n\<^sub>d) (inh\<^sub>m\<^sub>o\<^sub>v\<^sub>i\<^sub>n\<^sub>g) (inh\<^sub>o\<^sub>u\<^sub>t\<^sub>e\<^sub>r\<^sub>_\<^sub>w\<^sub>o\<^sub>r\<^sub>l\<^sub>d) (t)) of (mk\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n ((mk\<E>\<X>\<T>\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (oid) (own\<^sub>w\<^sub>o\<^sub>r\<^sub>m\<^sub>h\<^sub>o\<^sub>l\<^sub>e) (own\<^sub>w\<^sub>e\<^sub>i\<^sub>g\<^sub>h\<^sub>t) (inh\<^sub>s\<^sub>o\<^sub>u\<^sub>n\<^sub>d) (inh\<^sub>m\<^sub>o\<^sub>v\<^sub>i\<^sub>n\<^sub>g) (inh\<^sub>o\<^sub>u\<^sub>t\<^sub>e\<^sub>r\<^sub>_\<^sub>w\<^sub>o\<^sub>r\<^sub>l\<^sub>d))) (own\<^sub>s\<^sub>a\<^sub>l\<^sub>a\<^sub>r\<^sub>y)) \<Rightarrow> (mk\<E>\<X>\<T>\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n ((mk\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n ((mk\<E>\<X>\<T>\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (oid) (own\<^sub>w\<^sub>o\<^sub>r\<^sub>m\<^sub>h\<^sub>o\<^sub>l\<^sub>e) (own\<^sub>w\<^sub>e\<^sub>i\<^sub>g\<^sub>h\<^sub>t) (inh\<^sub>s\<^sub>o\<^sub>u\<^sub>n\<^sub>d) (inh\<^sub>m\<^sub>o\<^sub>v\<^sub>i\<^sub>n\<^sub>g) (inh\<^sub>o\<^sub>u\<^sub>t\<^sub>e\<^sub>r\<^sub>_\<^sub>w\<^sub>o\<^sub>r\<^sub>l\<^sub>d))) (own\<^sub>s\<^sub>a\<^sub>l\<^sub>a\<^sub>r\<^sub>y))))))) (own\<^sub>w\<^sub>o\<^sub>r\<^sub>m\<^sub>h\<^sub>o\<^sub>l\<^sub>e) (own\<^sub>w\<^sub>e\<^sub>i\<^sub>g\<^sub>h\<^sub>t))))" -definition "class_ty_ext_equiv_2of1\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t = (\<lambda> (mk2oid\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (oid) (inh\<^sub>s\<^sub>o\<^sub>u\<^sub>n\<^sub>d) (inh\<^sub>m\<^sub>o\<^sub>v\<^sub>i\<^sub>n\<^sub>g) (inh\<^sub>o\<^sub>u\<^sub>t\<^sub>e\<^sub>r\<^sub>_\<^sub>w\<^sub>o\<^sub>r\<^sub>l\<^sub>d) (t)) \<Rightarrow> (class_ty_ext_equiv_2of1_aux\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (oid) (inh\<^sub>s\<^sub>o\<^sub>u\<^sub>n\<^sub>d) (inh\<^sub>m\<^sub>o\<^sub>v\<^sub>i\<^sub>n\<^sub>g) (inh\<^sub>o\<^sub>u\<^sub>t\<^sub>e\<^sub>r\<^sub>_\<^sub>w\<^sub>o\<^sub>r\<^sub>l\<^sub>d) (t)))" -definition "class_ty_ext_equiv_2of1_aux\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y = (\<lambda>oid. (\<lambda> (mk2\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y (own\<^sub>s\<^sub>o\<^sub>u\<^sub>n\<^sub>d) (own\<^sub>m\<^sub>o\<^sub>v\<^sub>i\<^sub>n\<^sub>g) (own\<^sub>o\<^sub>u\<^sub>t\<^sub>e\<^sub>r\<^sub>_\<^sub>w\<^sub>o\<^sub>r\<^sub>l\<^sub>d) (t)) \<Rightarrow> (mk\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y ((case t of None \<Rightarrow> (mk\<E>\<X>\<T>\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y (oid)) - | \<lfloor>(mk2\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (t))\<rfloor> \<Rightarrow> (case (class_ty_ext_equiv_2of1_aux\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (oid) (own\<^sub>s\<^sub>o\<^sub>u\<^sub>n\<^sub>d) (own\<^sub>m\<^sub>o\<^sub>v\<^sub>i\<^sub>n\<^sub>g) (own\<^sub>o\<^sub>u\<^sub>t\<^sub>e\<^sub>r\<^sub>_\<^sub>w\<^sub>o\<^sub>r\<^sub>l\<^sub>d) (t)) of (mk\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t ((mk\<E>\<X>\<T>\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (oid) (own\<^sub>s\<^sub>o\<^sub>u\<^sub>n\<^sub>d) (own\<^sub>m\<^sub>o\<^sub>v\<^sub>i\<^sub>n\<^sub>g) (own\<^sub>o\<^sub>u\<^sub>t\<^sub>e\<^sub>r\<^sub>_\<^sub>w\<^sub>o\<^sub>r\<^sub>l\<^sub>d))) (own\<^sub>w\<^sub>o\<^sub>r\<^sub>m\<^sub>h\<^sub>o\<^sub>l\<^sub>e) (own\<^sub>w\<^sub>e\<^sub>i\<^sub>g\<^sub>h\<^sub>t)) \<Rightarrow> (mk\<E>\<X>\<T>\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t ((mk\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t ((mk\<E>\<X>\<T>\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (oid) (own\<^sub>s\<^sub>o\<^sub>u\<^sub>n\<^sub>d) (own\<^sub>m\<^sub>o\<^sub>v\<^sub>i\<^sub>n\<^sub>g) (own\<^sub>o\<^sub>u\<^sub>t\<^sub>e\<^sub>r\<^sub>_\<^sub>w\<^sub>o\<^sub>r\<^sub>l\<^sub>d))) (own\<^sub>w\<^sub>o\<^sub>r\<^sub>m\<^sub>h\<^sub>o\<^sub>l\<^sub>e) (own\<^sub>w\<^sub>e\<^sub>i\<^sub>g\<^sub>h\<^sub>t)))) - | (mk\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t ((mk\<E>\<X>\<T>\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (t))) (own\<^sub>w\<^sub>o\<^sub>r\<^sub>m\<^sub>h\<^sub>o\<^sub>l\<^sub>e) (own\<^sub>w\<^sub>e\<^sub>i\<^sub>g\<^sub>h\<^sub>t)) \<Rightarrow> (mk\<E>\<X>\<T>\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (t))))) (own\<^sub>s\<^sub>o\<^sub>u\<^sub>n\<^sub>d) (own\<^sub>m\<^sub>o\<^sub>v\<^sub>i\<^sub>n\<^sub>g) (own\<^sub>o\<^sub>u\<^sub>t\<^sub>e\<^sub>r\<^sub>_\<^sub>w\<^sub>o\<^sub>r\<^sub>l\<^sub>d))))" -definition "class_ty_ext_equiv_2of1\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y = (\<lambda> (mk2oid\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y (oid) (t)) \<Rightarrow> (class_ty_ext_equiv_2of1_aux\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y (oid) (t)))" -definition "class_ty_ext_equiv_2of1_aux\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y = (\<lambda>oid. (\<lambda> (mk2\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y (t)) \<Rightarrow> (mk\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y ((case t of None \<Rightarrow> (mk\<E>\<X>\<T>\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y (oid)) - | \<lfloor>(mk2\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y (t))\<rfloor> \<Rightarrow> (case (class_ty_ext_equiv_2of1_aux\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y (oid) (t)) of (mk\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y ((mk\<E>\<X>\<T>\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y (oid))) (own\<^sub>s\<^sub>o\<^sub>u\<^sub>n\<^sub>d) (own\<^sub>m\<^sub>o\<^sub>v\<^sub>i\<^sub>n\<^sub>g) (own\<^sub>o\<^sub>u\<^sub>t\<^sub>e\<^sub>r\<^sub>_\<^sub>w\<^sub>o\<^sub>r\<^sub>l\<^sub>d)) \<Rightarrow> (mk\<E>\<X>\<T>\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y ((mk\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y ((mk\<E>\<X>\<T>\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y (oid))) (own\<^sub>s\<^sub>o\<^sub>u\<^sub>n\<^sub>d) (own\<^sub>m\<^sub>o\<^sub>v\<^sub>i\<^sub>n\<^sub>g) (own\<^sub>o\<^sub>u\<^sub>t\<^sub>e\<^sub>r\<^sub>_\<^sub>w\<^sub>o\<^sub>r\<^sub>l\<^sub>d)))) - | (mk\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y ((mk\<E>\<X>\<T>\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (t))) (own\<^sub>s\<^sub>o\<^sub>u\<^sub>n\<^sub>d) (own\<^sub>m\<^sub>o\<^sub>v\<^sub>i\<^sub>n\<^sub>g) (own\<^sub>o\<^sub>u\<^sub>t\<^sub>e\<^sub>r\<^sub>_\<^sub>w\<^sub>o\<^sub>r\<^sub>l\<^sub>d)) \<Rightarrow> (mk\<E>\<X>\<T>\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (t)) - | (mk\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y ((mk\<E>\<X>\<T>\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (t))) (own\<^sub>s\<^sub>o\<^sub>u\<^sub>n\<^sub>d) (own\<^sub>m\<^sub>o\<^sub>v\<^sub>i\<^sub>n\<^sub>g) (own\<^sub>o\<^sub>u\<^sub>t\<^sub>e\<^sub>r\<^sub>_\<^sub>w\<^sub>o\<^sub>r\<^sub>l\<^sub>d)) \<Rightarrow> (mk\<E>\<X>\<T>\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (t))))))))" -definition "class_ty_ext_equiv_2of1\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y = (\<lambda> (mk2oid\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y (oid) (t)) \<Rightarrow> (class_ty_ext_equiv_2of1_aux\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y (oid) (t)))" - -(* 18 ************************************ 40 + 12 *) (* term Floor1_infra.print_infra_datatype_equiv_1of2 *) -definition "class_ty_ext_equiv_1of2_get_oid_inh\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n = (\<lambda> (mk\<E>\<X>\<T>\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (oid) (inh\<^sub>w\<^sub>o\<^sub>r\<^sub>m\<^sub>h\<^sub>o\<^sub>l\<^sub>e) (inh\<^sub>w\<^sub>e\<^sub>i\<^sub>g\<^sub>h\<^sub>t) (inh\<^sub>s\<^sub>o\<^sub>u\<^sub>n\<^sub>d) (inh\<^sub>m\<^sub>o\<^sub>v\<^sub>i\<^sub>n\<^sub>g) (inh\<^sub>o\<^sub>u\<^sub>t\<^sub>e\<^sub>r\<^sub>_\<^sub>w\<^sub>o\<^sub>r\<^sub>l\<^sub>d)) \<Rightarrow> (oid , inh\<^sub>w\<^sub>o\<^sub>r\<^sub>m\<^sub>h\<^sub>o\<^sub>l\<^sub>e , inh\<^sub>w\<^sub>e\<^sub>i\<^sub>g\<^sub>h\<^sub>t , inh\<^sub>s\<^sub>o\<^sub>u\<^sub>n\<^sub>d , inh\<^sub>m\<^sub>o\<^sub>v\<^sub>i\<^sub>n\<^sub>g , inh\<^sub>o\<^sub>u\<^sub>t\<^sub>e\<^sub>r\<^sub>_\<^sub>w\<^sub>o\<^sub>r\<^sub>l\<^sub>d))" -definition "class_ty_ext_equiv_1of2_aux\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n = (\<lambda> (mk\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (t) (own\<^sub>s\<^sub>a\<^sub>l\<^sub>a\<^sub>r\<^sub>y)) \<Rightarrow> (mk2\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (own\<^sub>s\<^sub>a\<^sub>l\<^sub>a\<^sub>r\<^sub>y)))" -definition "class_ty_ext_equiv_1of2\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n = (\<lambda> (mk\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (t) (own\<^sub>s\<^sub>a\<^sub>l\<^sub>a\<^sub>r\<^sub>y)) \<Rightarrow> (case (class_ty_ext_equiv_1of2_get_oid_inh\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (t)) of (oid , inh\<^sub>w\<^sub>o\<^sub>r\<^sub>m\<^sub>h\<^sub>o\<^sub>l\<^sub>e , inh\<^sub>w\<^sub>e\<^sub>i\<^sub>g\<^sub>h\<^sub>t , inh\<^sub>s\<^sub>o\<^sub>u\<^sub>n\<^sub>d , inh\<^sub>m\<^sub>o\<^sub>v\<^sub>i\<^sub>n\<^sub>g , inh\<^sub>o\<^sub>u\<^sub>t\<^sub>e\<^sub>r\<^sub>_\<^sub>w\<^sub>o\<^sub>r\<^sub>l\<^sub>d) \<Rightarrow> (mk2oid\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (oid) (inh\<^sub>w\<^sub>o\<^sub>r\<^sub>m\<^sub>h\<^sub>o\<^sub>l\<^sub>e) (inh\<^sub>w\<^sub>e\<^sub>i\<^sub>g\<^sub>h\<^sub>t) (inh\<^sub>s\<^sub>o\<^sub>u\<^sub>n\<^sub>d) (inh\<^sub>m\<^sub>o\<^sub>v\<^sub>i\<^sub>n\<^sub>g) (inh\<^sub>o\<^sub>u\<^sub>t\<^sub>e\<^sub>r\<^sub>_\<^sub>w\<^sub>o\<^sub>r\<^sub>l\<^sub>d) ((class_ty_ext_equiv_1of2_aux\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n ((mk\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (t) (own\<^sub>s\<^sub>a\<^sub>l\<^sub>a\<^sub>r\<^sub>y))))))))" -definition "class_ty_ext_equiv_1of2_get_oid_inh\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t = (\<lambda> (mk\<E>\<X>\<T>\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (oid) (inh\<^sub>s\<^sub>o\<^sub>u\<^sub>n\<^sub>d) (inh\<^sub>m\<^sub>o\<^sub>v\<^sub>i\<^sub>n\<^sub>g) (inh\<^sub>o\<^sub>u\<^sub>t\<^sub>e\<^sub>r\<^sub>_\<^sub>w\<^sub>o\<^sub>r\<^sub>l\<^sub>d)) \<Rightarrow> (oid , inh\<^sub>s\<^sub>o\<^sub>u\<^sub>n\<^sub>d , inh\<^sub>m\<^sub>o\<^sub>v\<^sub>i\<^sub>n\<^sub>g , inh\<^sub>o\<^sub>u\<^sub>t\<^sub>e\<^sub>r\<^sub>_\<^sub>w\<^sub>o\<^sub>r\<^sub>l\<^sub>d) - | (mk\<E>\<X>\<T>\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n ((mk\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (t) (var\<^sub>s\<^sub>a\<^sub>l\<^sub>a\<^sub>r\<^sub>y)))) \<Rightarrow> (case (class_ty_ext_equiv_1of2_get_oid_inh\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (t)) of (oid , var\<^sub>w\<^sub>o\<^sub>r\<^sub>m\<^sub>h\<^sub>o\<^sub>l\<^sub>e , var\<^sub>w\<^sub>e\<^sub>i\<^sub>g\<^sub>h\<^sub>t , var\<^sub>s\<^sub>o\<^sub>u\<^sub>n\<^sub>d , var\<^sub>m\<^sub>o\<^sub>v\<^sub>i\<^sub>n\<^sub>g , var\<^sub>o\<^sub>u\<^sub>t\<^sub>e\<^sub>r\<^sub>_\<^sub>w\<^sub>o\<^sub>r\<^sub>l\<^sub>d) \<Rightarrow> (oid , var\<^sub>s\<^sub>o\<^sub>u\<^sub>n\<^sub>d , var\<^sub>m\<^sub>o\<^sub>v\<^sub>i\<^sub>n\<^sub>g , var\<^sub>o\<^sub>u\<^sub>t\<^sub>e\<^sub>r\<^sub>_\<^sub>w\<^sub>o\<^sub>r\<^sub>l\<^sub>d)))" -definition "class_ty_ext_equiv_1of2_aux\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t = (\<lambda> (mk\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (t) (own\<^sub>w\<^sub>o\<^sub>r\<^sub>m\<^sub>h\<^sub>o\<^sub>l\<^sub>e) (own\<^sub>w\<^sub>e\<^sub>i\<^sub>g\<^sub>h\<^sub>t)) \<Rightarrow> (mk2\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (own\<^sub>w\<^sub>o\<^sub>r\<^sub>m\<^sub>h\<^sub>o\<^sub>l\<^sub>e) (own\<^sub>w\<^sub>e\<^sub>i\<^sub>g\<^sub>h\<^sub>t) ((case t of (mk\<E>\<X>\<T>\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (oid) (inh\<^sub>s\<^sub>o\<^sub>u\<^sub>n\<^sub>d) (inh\<^sub>m\<^sub>o\<^sub>v\<^sub>i\<^sub>n\<^sub>g) (inh\<^sub>o\<^sub>u\<^sub>t\<^sub>e\<^sub>r\<^sub>_\<^sub>w\<^sub>o\<^sub>r\<^sub>l\<^sub>d)) \<Rightarrow> None - | (mk\<E>\<X>\<T>\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (tt)) \<Rightarrow> (case (case tt of (mk\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (t) (var\<^sub>s\<^sub>a\<^sub>l\<^sub>a\<^sub>r\<^sub>y)) \<Rightarrow> (class_ty_ext_equiv_1of2_get_oid_inh\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (t))) of (oid , var\<^sub>w\<^sub>o\<^sub>r\<^sub>m\<^sub>h\<^sub>o\<^sub>l\<^sub>e , var\<^sub>w\<^sub>e\<^sub>i\<^sub>g\<^sub>h\<^sub>t , var\<^sub>s\<^sub>o\<^sub>u\<^sub>n\<^sub>d , var\<^sub>m\<^sub>o\<^sub>v\<^sub>i\<^sub>n\<^sub>g , var\<^sub>o\<^sub>u\<^sub>t\<^sub>e\<^sub>r\<^sub>_\<^sub>w\<^sub>o\<^sub>r\<^sub>l\<^sub>d) \<Rightarrow> \<lfloor>(mk2\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n ((class_ty_ext_equiv_1of2_aux\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (tt))))\<rfloor>)))))" -definition "class_ty_ext_equiv_1of2\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t = (\<lambda> (mk\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (t) (own\<^sub>w\<^sub>o\<^sub>r\<^sub>m\<^sub>h\<^sub>o\<^sub>l\<^sub>e) (own\<^sub>w\<^sub>e\<^sub>i\<^sub>g\<^sub>h\<^sub>t)) \<Rightarrow> (case (class_ty_ext_equiv_1of2_get_oid_inh\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (t)) of (oid , inh\<^sub>s\<^sub>o\<^sub>u\<^sub>n\<^sub>d , inh\<^sub>m\<^sub>o\<^sub>v\<^sub>i\<^sub>n\<^sub>g , inh\<^sub>o\<^sub>u\<^sub>t\<^sub>e\<^sub>r\<^sub>_\<^sub>w\<^sub>o\<^sub>r\<^sub>l\<^sub>d) \<Rightarrow> (mk2oid\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (oid) (inh\<^sub>s\<^sub>o\<^sub>u\<^sub>n\<^sub>d) (inh\<^sub>m\<^sub>o\<^sub>v\<^sub>i\<^sub>n\<^sub>g) (inh\<^sub>o\<^sub>u\<^sub>t\<^sub>e\<^sub>r\<^sub>_\<^sub>w\<^sub>o\<^sub>r\<^sub>l\<^sub>d) ((class_ty_ext_equiv_1of2_aux\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t ((mk\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (t) (own\<^sub>w\<^sub>o\<^sub>r\<^sub>m\<^sub>h\<^sub>o\<^sub>l\<^sub>e) (own\<^sub>w\<^sub>e\<^sub>i\<^sub>g\<^sub>h\<^sub>t))))))))" -definition "class_ty_ext_equiv_1of2_get_oid_inh\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y = (\<lambda> (mk\<E>\<X>\<T>\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y (oid)) \<Rightarrow> (oid) - | (mk\<E>\<X>\<T>\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n ((mk\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (t) (var\<^sub>s\<^sub>a\<^sub>l\<^sub>a\<^sub>r\<^sub>y)))) \<Rightarrow> (case (class_ty_ext_equiv_1of2_get_oid_inh\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (t)) of (oid , var\<^sub>w\<^sub>o\<^sub>r\<^sub>m\<^sub>h\<^sub>o\<^sub>l\<^sub>e , var\<^sub>w\<^sub>e\<^sub>i\<^sub>g\<^sub>h\<^sub>t , var\<^sub>s\<^sub>o\<^sub>u\<^sub>n\<^sub>d , var\<^sub>m\<^sub>o\<^sub>v\<^sub>i\<^sub>n\<^sub>g , var\<^sub>o\<^sub>u\<^sub>t\<^sub>e\<^sub>r\<^sub>_\<^sub>w\<^sub>o\<^sub>r\<^sub>l\<^sub>d) \<Rightarrow> (oid)) - | (mk\<E>\<X>\<T>\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t ((mk\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (t) (var\<^sub>w\<^sub>o\<^sub>r\<^sub>m\<^sub>h\<^sub>o\<^sub>l\<^sub>e) (var\<^sub>w\<^sub>e\<^sub>i\<^sub>g\<^sub>h\<^sub>t)))) \<Rightarrow> (case (class_ty_ext_equiv_1of2_get_oid_inh\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (t)) of (oid , var\<^sub>s\<^sub>o\<^sub>u\<^sub>n\<^sub>d , var\<^sub>m\<^sub>o\<^sub>v\<^sub>i\<^sub>n\<^sub>g , var\<^sub>o\<^sub>u\<^sub>t\<^sub>e\<^sub>r\<^sub>_\<^sub>w\<^sub>o\<^sub>r\<^sub>l\<^sub>d) \<Rightarrow> (oid)))" -definition "class_ty_ext_equiv_1of2_aux\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y = (\<lambda> (mk\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y (t) (own\<^sub>s\<^sub>o\<^sub>u\<^sub>n\<^sub>d) (own\<^sub>m\<^sub>o\<^sub>v\<^sub>i\<^sub>n\<^sub>g) (own\<^sub>o\<^sub>u\<^sub>t\<^sub>e\<^sub>r\<^sub>_\<^sub>w\<^sub>o\<^sub>r\<^sub>l\<^sub>d)) \<Rightarrow> (mk2\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y (own\<^sub>s\<^sub>o\<^sub>u\<^sub>n\<^sub>d) (own\<^sub>m\<^sub>o\<^sub>v\<^sub>i\<^sub>n\<^sub>g) (own\<^sub>o\<^sub>u\<^sub>t\<^sub>e\<^sub>r\<^sub>_\<^sub>w\<^sub>o\<^sub>r\<^sub>l\<^sub>d) ((case t of (mk\<E>\<X>\<T>\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y (oid)) \<Rightarrow> None - | (mk\<E>\<X>\<T>\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (tt)) \<Rightarrow> (case (case tt of (mk\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (t) (var\<^sub>s\<^sub>a\<^sub>l\<^sub>a\<^sub>r\<^sub>y)) \<Rightarrow> (class_ty_ext_equiv_1of2_get_oid_inh\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (t))) of (oid , var\<^sub>w\<^sub>o\<^sub>r\<^sub>m\<^sub>h\<^sub>o\<^sub>l\<^sub>e , var\<^sub>w\<^sub>e\<^sub>i\<^sub>g\<^sub>h\<^sub>t , var\<^sub>s\<^sub>o\<^sub>u\<^sub>n\<^sub>d , var\<^sub>m\<^sub>o\<^sub>v\<^sub>i\<^sub>n\<^sub>g , var\<^sub>o\<^sub>u\<^sub>t\<^sub>e\<^sub>r\<^sub>_\<^sub>w\<^sub>o\<^sub>r\<^sub>l\<^sub>d) \<Rightarrow> \<lfloor>(mk2\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t ((mk2\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (var\<^sub>w\<^sub>o\<^sub>r\<^sub>m\<^sub>h\<^sub>o\<^sub>l\<^sub>e) (var\<^sub>w\<^sub>e\<^sub>i\<^sub>g\<^sub>h\<^sub>t) (\<lfloor>(mk2\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n ((class_ty_ext_equiv_1of2_aux\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (tt))))\<rfloor>))))\<rfloor>) - | (mk\<E>\<X>\<T>\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (tt)) \<Rightarrow> (case (case tt of (mk\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (t) (var\<^sub>w\<^sub>o\<^sub>r\<^sub>m\<^sub>h\<^sub>o\<^sub>l\<^sub>e) (var\<^sub>w\<^sub>e\<^sub>i\<^sub>g\<^sub>h\<^sub>t)) \<Rightarrow> (class_ty_ext_equiv_1of2_get_oid_inh\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (t))) of (oid , var\<^sub>s\<^sub>o\<^sub>u\<^sub>n\<^sub>d , var\<^sub>m\<^sub>o\<^sub>v\<^sub>i\<^sub>n\<^sub>g , var\<^sub>o\<^sub>u\<^sub>t\<^sub>e\<^sub>r\<^sub>_\<^sub>w\<^sub>o\<^sub>r\<^sub>l\<^sub>d) \<Rightarrow> \<lfloor>(mk2\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t ((class_ty_ext_equiv_1of2_aux\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (tt))))\<rfloor>)))))" -definition "class_ty_ext_equiv_1of2\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y = (\<lambda> (mk\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y (t) (own\<^sub>s\<^sub>o\<^sub>u\<^sub>n\<^sub>d) (own\<^sub>m\<^sub>o\<^sub>v\<^sub>i\<^sub>n\<^sub>g) (own\<^sub>o\<^sub>u\<^sub>t\<^sub>e\<^sub>r\<^sub>_\<^sub>w\<^sub>o\<^sub>r\<^sub>l\<^sub>d)) \<Rightarrow> (case (class_ty_ext_equiv_1of2_get_oid_inh\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y (t)) of (oid) \<Rightarrow> (mk2oid\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y (oid) ((class_ty_ext_equiv_1of2_aux\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y ((mk\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y (t) (own\<^sub>s\<^sub>o\<^sub>u\<^sub>n\<^sub>d) (own\<^sub>m\<^sub>o\<^sub>v\<^sub>i\<^sub>n\<^sub>g) (own\<^sub>o\<^sub>u\<^sub>t\<^sub>e\<^sub>r\<^sub>_\<^sub>w\<^sub>o\<^sub>r\<^sub>l\<^sub>d))))))))" -definition "class_ty_ext_equiv_1of2_get_oid_inh\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y = (\<lambda> (mk\<E>\<X>\<T>\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y (oid)) \<Rightarrow> (oid) - | (mk\<E>\<X>\<T>\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n ((mk\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (t) (var\<^sub>s\<^sub>a\<^sub>l\<^sub>a\<^sub>r\<^sub>y)))) \<Rightarrow> (case (class_ty_ext_equiv_1of2_get_oid_inh\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (t)) of (oid , var\<^sub>w\<^sub>o\<^sub>r\<^sub>m\<^sub>h\<^sub>o\<^sub>l\<^sub>e , var\<^sub>w\<^sub>e\<^sub>i\<^sub>g\<^sub>h\<^sub>t , var\<^sub>s\<^sub>o\<^sub>u\<^sub>n\<^sub>d , var\<^sub>m\<^sub>o\<^sub>v\<^sub>i\<^sub>n\<^sub>g , var\<^sub>o\<^sub>u\<^sub>t\<^sub>e\<^sub>r\<^sub>_\<^sub>w\<^sub>o\<^sub>r\<^sub>l\<^sub>d) \<Rightarrow> (oid)) - | (mk\<E>\<X>\<T>\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t ((mk\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (t) (var\<^sub>w\<^sub>o\<^sub>r\<^sub>m\<^sub>h\<^sub>o\<^sub>l\<^sub>e) (var\<^sub>w\<^sub>e\<^sub>i\<^sub>g\<^sub>h\<^sub>t)))) \<Rightarrow> (case (class_ty_ext_equiv_1of2_get_oid_inh\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (t)) of (oid , var\<^sub>s\<^sub>o\<^sub>u\<^sub>n\<^sub>d , var\<^sub>m\<^sub>o\<^sub>v\<^sub>i\<^sub>n\<^sub>g , var\<^sub>o\<^sub>u\<^sub>t\<^sub>e\<^sub>r\<^sub>_\<^sub>w\<^sub>o\<^sub>r\<^sub>l\<^sub>d) \<Rightarrow> (oid)) - | (mk\<E>\<X>\<T>\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y ((mk\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y (t) (var\<^sub>s\<^sub>o\<^sub>u\<^sub>n\<^sub>d) (var\<^sub>m\<^sub>o\<^sub>v\<^sub>i\<^sub>n\<^sub>g) (var\<^sub>o\<^sub>u\<^sub>t\<^sub>e\<^sub>r\<^sub>_\<^sub>w\<^sub>o\<^sub>r\<^sub>l\<^sub>d)))) \<Rightarrow> (case (class_ty_ext_equiv_1of2_get_oid_inh\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y (t)) of (oid) \<Rightarrow> (oid)))" -definition "class_ty_ext_equiv_1of2_aux\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y = (\<lambda> (mk\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y (t)) \<Rightarrow> (mk2\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y ((case t of (mk\<E>\<X>\<T>\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y (oid)) \<Rightarrow> None - | (mk\<E>\<X>\<T>\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (tt)) \<Rightarrow> (case (case tt of (mk\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (t) (var\<^sub>s\<^sub>a\<^sub>l\<^sub>a\<^sub>r\<^sub>y)) \<Rightarrow> (class_ty_ext_equiv_1of2_get_oid_inh\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (t))) of (oid , var\<^sub>w\<^sub>o\<^sub>r\<^sub>m\<^sub>h\<^sub>o\<^sub>l\<^sub>e , var\<^sub>w\<^sub>e\<^sub>i\<^sub>g\<^sub>h\<^sub>t , var\<^sub>s\<^sub>o\<^sub>u\<^sub>n\<^sub>d , var\<^sub>m\<^sub>o\<^sub>v\<^sub>i\<^sub>n\<^sub>g , var\<^sub>o\<^sub>u\<^sub>t\<^sub>e\<^sub>r\<^sub>_\<^sub>w\<^sub>o\<^sub>r\<^sub>l\<^sub>d) \<Rightarrow> \<lfloor>(mk2\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y ((mk2\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y (var\<^sub>s\<^sub>o\<^sub>u\<^sub>n\<^sub>d) (var\<^sub>m\<^sub>o\<^sub>v\<^sub>i\<^sub>n\<^sub>g) (var\<^sub>o\<^sub>u\<^sub>t\<^sub>e\<^sub>r\<^sub>_\<^sub>w\<^sub>o\<^sub>r\<^sub>l\<^sub>d) (\<lfloor>(mk2\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t ((mk2\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (var\<^sub>w\<^sub>o\<^sub>r\<^sub>m\<^sub>h\<^sub>o\<^sub>l\<^sub>e) (var\<^sub>w\<^sub>e\<^sub>i\<^sub>g\<^sub>h\<^sub>t) (\<lfloor>(mk2\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n ((class_ty_ext_equiv_1of2_aux\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (tt))))\<rfloor>))))\<rfloor>))))\<rfloor>) - | (mk\<E>\<X>\<T>\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (tt)) \<Rightarrow> (case (case tt of (mk\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (t) (var\<^sub>w\<^sub>o\<^sub>r\<^sub>m\<^sub>h\<^sub>o\<^sub>l\<^sub>e) (var\<^sub>w\<^sub>e\<^sub>i\<^sub>g\<^sub>h\<^sub>t)) \<Rightarrow> (class_ty_ext_equiv_1of2_get_oid_inh\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (t))) of (oid , var\<^sub>s\<^sub>o\<^sub>u\<^sub>n\<^sub>d , var\<^sub>m\<^sub>o\<^sub>v\<^sub>i\<^sub>n\<^sub>g , var\<^sub>o\<^sub>u\<^sub>t\<^sub>e\<^sub>r\<^sub>_\<^sub>w\<^sub>o\<^sub>r\<^sub>l\<^sub>d) \<Rightarrow> \<lfloor>(mk2\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y ((mk2\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y (var\<^sub>s\<^sub>o\<^sub>u\<^sub>n\<^sub>d) (var\<^sub>m\<^sub>o\<^sub>v\<^sub>i\<^sub>n\<^sub>g) (var\<^sub>o\<^sub>u\<^sub>t\<^sub>e\<^sub>r\<^sub>_\<^sub>w\<^sub>o\<^sub>r\<^sub>l\<^sub>d) (\<lfloor>(mk2\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t ((class_ty_ext_equiv_1of2_aux\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (tt))))\<rfloor>))))\<rfloor>) - | (mk\<E>\<X>\<T>\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y (tt)) \<Rightarrow> (case (case tt of (mk\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y (t) (var\<^sub>s\<^sub>o\<^sub>u\<^sub>n\<^sub>d) (var\<^sub>m\<^sub>o\<^sub>v\<^sub>i\<^sub>n\<^sub>g) (var\<^sub>o\<^sub>u\<^sub>t\<^sub>e\<^sub>r\<^sub>_\<^sub>w\<^sub>o\<^sub>r\<^sub>l\<^sub>d)) \<Rightarrow> (class_ty_ext_equiv_1of2_get_oid_inh\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y (t))) of (oid) \<Rightarrow> \<lfloor>(mk2\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y ((class_ty_ext_equiv_1of2_aux\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y (tt))))\<rfloor>)))))" -definition "class_ty_ext_equiv_1of2\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y = (\<lambda> (mk\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y (t)) \<Rightarrow> (case (class_ty_ext_equiv_1of2_get_oid_inh\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y (t)) of (oid) \<Rightarrow> (mk2oid\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y (oid) ((class_ty_ext_equiv_1of2_aux\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y ((mk\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y (t))))))))" - -(* 19 ************************************ 52 + 1 *) -text \<open> - Now, we construct a concrete ``universe of OclAny types'' by injection into a -sum type containing the class types. This type of OclAny will be used as instance -for all respective type-variables. \<close> - -(* 20 ************************************ 53 + 1 *) (* term Floor1_infra.print_infra_datatype_universe *) -datatype \<AA> = in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n "ty\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n" - | in\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t "ty\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t" - | in\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y "ty\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y" - | in\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y "ty\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y" - -(* 21 ************************************ 54 + 1 *) -text \<open> - Having fixed the object universe, we can introduce type synonyms that exactly correspond -to \OCL types. Again, we exploit that our representation of \OCL is a ``shallow embedding'' with a -one-to-one correspondance of \OCL-types to types of the meta-language \HOL. \<close> - -(* 22 ************************************ 55 + 7 *) (* term Floor1_infra.print_infra_type_synonym_class *) -type_synonym Void = "\<AA> Void" -type_synonym Boolean = "\<AA> Boolean" -type_synonym Integer = "\<AA> Integer" -type_synonym Real = "\<AA> Real" -type_synonym String = "\<AA> String" -type_synonym '\<alpha> val' = "(\<AA>, '\<alpha>) val" -type_notation val' ("\<cdot>(_)") - -(* 23 ************************************ 62 + 4 *) (* term Floor1_infra.print_infra_type_synonym_class_higher *) -type_synonym Person = "\<langle>\<langle>ty\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rangle>\<^sub>\<bottom>\<rangle>\<^sub>\<bottom>" -type_synonym Planet = "\<langle>\<langle>ty\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t\<rangle>\<^sub>\<bottom>\<rangle>\<^sub>\<bottom>" -type_synonym Galaxy = "\<langle>\<langle>ty\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y\<rangle>\<^sub>\<bottom>\<rangle>\<^sub>\<bottom>" -type_synonym OclAny = "\<langle>\<langle>ty\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y\<rangle>\<^sub>\<bottom>\<rangle>\<^sub>\<bottom>" - -(* 24 ************************************ 66 + 3 *) (* term Floor1_infra.print_infra_type_synonym_class_rec *) -type_synonym Sequence_Person = "(\<AA>, ty\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n option option Sequence\<^sub>b\<^sub>a\<^sub>s\<^sub>e) val" -type_synonym Set_Person = "(\<AA>, ty\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n option option Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e) val" -type_synonym Set_Sequence_Planet = "(\<AA>, ty\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t option option Sequence\<^sub>b\<^sub>a\<^sub>s\<^sub>e Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e) val" - -(* 25 ************************************ 69 + 0 *) (* term Floor1_infra.print_infra_enum_syn *) - -(* 26 ************************************ 69 + 1 *) -text \<open> - To reuse key-elements of the library like referential equality, we have -to show that the object universe belongs to the type class ``oclany,'' \ie, - each class type has to provide a function @{term oid_of} yielding the Object ID (oid) of the object. \<close> - -(* 27 ************************************ 70 + 4 *) (* term Floor1_infra.print_infra_instantiation_class *) -instantiation ty\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n :: object -begin - definition oid_of_ty\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_def : "oid_of = (\<lambda> mk\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n t _ \<Rightarrow> (case t of (mk\<E>\<X>\<T>\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (t) (_) (_) (_) (_) (_)) \<Rightarrow> t))" - instance .. -end -instantiation ty\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t :: object -begin - definition oid_of_ty\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_def : "oid_of = (\<lambda> mk\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t t _ _ \<Rightarrow> (case t of (mk\<E>\<X>\<T>\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (t) (_) (_) (_)) \<Rightarrow> t - | (mk\<E>\<X>\<T>\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (t)) \<Rightarrow> (oid_of (t))))" - instance .. -end -instantiation ty\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y :: object -begin - definition oid_of_ty\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_def : "oid_of = (\<lambda> mk\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y t _ _ _ \<Rightarrow> (case t of (mk\<E>\<X>\<T>\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y (t)) \<Rightarrow> t - | (mk\<E>\<X>\<T>\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (t)) \<Rightarrow> (oid_of (t)) - | (mk\<E>\<X>\<T>\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (t)) \<Rightarrow> (oid_of (t))))" - instance .. -end -instantiation ty\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y :: object -begin - definition oid_of_ty\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_def : "oid_of = (\<lambda> mk\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y t \<Rightarrow> (case t of (mk\<E>\<X>\<T>\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y (t)) \<Rightarrow> t - | (mk\<E>\<X>\<T>\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (t)) \<Rightarrow> (oid_of (t)) - | (mk\<E>\<X>\<T>\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (t)) \<Rightarrow> (oid_of (t)) - | (mk\<E>\<X>\<T>\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y (t)) \<Rightarrow> (oid_of (t))))" - instance .. -end - -(* 28 ************************************ 74 + 1 *) (* term Floor1_infra.print_infra_instantiation_universe *) -instantiation \<AA> :: object -begin - definition oid_of_\<AA>_def : "oid_of = (\<lambda> in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n Person \<Rightarrow> oid_of Person - | in\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t Planet \<Rightarrow> oid_of Planet - | in\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y Galaxy \<Rightarrow> oid_of Galaxy - | in\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y OclAny \<Rightarrow> oid_of OclAny)" - instance .. -end - -(* 29 ************************************ 75 + 1 *) -section \<open>Class Model: Instantiation of the Generic Strict Equality\<close> - -(* 30 ************************************ 76 + 1 *) -text \<open> - We instantiate the referential equality -on @{text "Person"} and @{text "OclAny"} \<close> - -(* 31 ************************************ 77 + 4 *) (* term Floor1_infra.print_instantia_def_strictrefeq *) -overloading StrictRefEq \<equiv> "(StrictRefEq::(\<cdot>Person) \<Rightarrow> _ \<Rightarrow> _)" -begin - definition StrictRefEq\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n : "(x::\<cdot>Person) \<doteq> y \<equiv> StrictRefEq\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t x y" -end -overloading StrictRefEq \<equiv> "(StrictRefEq::(\<cdot>Planet) \<Rightarrow> _ \<Rightarrow> _)" -begin - definition StrictRefEq\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t : "(x::\<cdot>Planet) \<doteq> y \<equiv> StrictRefEq\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t x y" -end -overloading StrictRefEq \<equiv> "(StrictRefEq::(\<cdot>Galaxy) \<Rightarrow> _ \<Rightarrow> _)" -begin - definition StrictRefEq\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y : "(x::\<cdot>Galaxy) \<doteq> y \<equiv> StrictRefEq\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t x y" -end -overloading StrictRefEq \<equiv> "(StrictRefEq::(\<cdot>OclAny) \<Rightarrow> _ \<Rightarrow> _)" -begin - definition StrictRefEq\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y : "(x::\<cdot>OclAny) \<doteq> y \<equiv> StrictRefEq\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t x y" -end - -(* 32 ************************************ 81 + 1 *) (* term Floor1_infra.print_instantia_lemmas_strictrefeq *) -lemmas[simp,code_unfold] = StrictRefEq\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n - StrictRefEq\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t - StrictRefEq\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y - StrictRefEq\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y - -(* 33 ************************************ 82 + 1 *) -text \<open> - For each Class \emph{C}, we will have a casting operation \inlineocl{.oclAsType($C$)}, - a test on the actual type \inlineocl{.oclIsTypeOf($C$)} as well as its relaxed form - \inlineocl{.oclIsKindOf($C$)} (corresponding exactly to Java's \verb+instanceof+-operator. -\<close> - -(* 34 ************************************ 83 + 1 *) -text \<open> - Thus, since we have two class-types in our concrete class hierarchy, we have -two operations to declare and to provide two overloading definitions for the two static types. -\<close> - -(* 35 ************************************ 84 + 1 *) -section \<open>Class Model: OclAsType\<close> - -(* 36 ************************************ 85 + 1 *) -subsection \<open>Definition\<close> - -(* 37 ************************************ 86 + 4 *) (* term Floor1_astype.print_astype_consts *) -consts OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n :: "'\<alpha> \<Rightarrow> \<cdot>Person" ("(_) .oclAsType'(Person')") -consts OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t :: "'\<alpha> \<Rightarrow> \<cdot>Planet" ("(_) .oclAsType'(Planet')") -consts OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y :: "'\<alpha> \<Rightarrow> \<cdot>Galaxy" ("(_) .oclAsType'(Galaxy')") -consts OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y :: "'\<alpha> \<Rightarrow> \<cdot>OclAny" ("(_) .oclAsType'(OclAny')") - -(* 38 ************************************ 90 + 16 *) (* term Floor1_astype.print_astype_class *) -overloading OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n \<equiv> "(OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n::(\<cdot>Person) \<Rightarrow> _)" -begin - definition OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person : "(x::\<cdot>Person) .oclAsType(Person) \<equiv> x" -end -overloading OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n \<equiv> "(OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n::(\<cdot>Planet) \<Rightarrow> _)" -begin - definition OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet : "(x::\<cdot>Planet) .oclAsType(Person) \<equiv> (\<lambda>\<tau>. (case (x (\<tau>)) of \<bottom> \<Rightarrow> (invalid (\<tau>)) - | \<lfloor>\<bottom>\<rfloor> \<Rightarrow> (null (\<tau>)) - | \<lfloor>\<lfloor>(mk\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t ((mk\<E>\<X>\<T>\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (Person))) (_) (_))\<rfloor>\<rfloor> \<Rightarrow> \<lfloor>\<lfloor>Person\<rfloor>\<rfloor> - | _ \<Rightarrow> (invalid (\<tau>))))" -end -overloading OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n \<equiv> "(OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n::(\<cdot>Galaxy) \<Rightarrow> _)" -begin - definition OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy : "(x::\<cdot>Galaxy) .oclAsType(Person) \<equiv> (\<lambda>\<tau>. (case (x (\<tau>)) of \<bottom> \<Rightarrow> (invalid (\<tau>)) - | \<lfloor>\<bottom>\<rfloor> \<Rightarrow> (null (\<tau>)) - | \<lfloor>\<lfloor>(mk\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y ((mk\<E>\<X>\<T>\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (Person))) (_) (_) (_))\<rfloor>\<rfloor> \<Rightarrow> \<lfloor>\<lfloor>Person\<rfloor>\<rfloor> - | _ \<Rightarrow> (invalid (\<tau>))))" -end -overloading OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n \<equiv> "(OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n::(\<cdot>OclAny) \<Rightarrow> _)" -begin - definition OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny : "(x::\<cdot>OclAny) .oclAsType(Person) \<equiv> (\<lambda>\<tau>. (case (x (\<tau>)) of \<bottom> \<Rightarrow> (invalid (\<tau>)) - | \<lfloor>\<bottom>\<rfloor> \<Rightarrow> (null (\<tau>)) - | \<lfloor>\<lfloor>(mk\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y ((mk\<E>\<X>\<T>\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (Person))))\<rfloor>\<rfloor> \<Rightarrow> \<lfloor>\<lfloor>Person\<rfloor>\<rfloor> - | _ \<Rightarrow> (invalid (\<tau>))))" -end -overloading OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t \<equiv> "(OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t::(\<cdot>Planet) \<Rightarrow> _)" -begin - definition OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet : "(x::\<cdot>Planet) .oclAsType(Planet) \<equiv> x" -end -overloading OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t \<equiv> "(OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t::(\<cdot>Galaxy) \<Rightarrow> _)" -begin - definition OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy : "(x::\<cdot>Galaxy) .oclAsType(Planet) \<equiv> (\<lambda>\<tau>. (case (x (\<tau>)) of \<bottom> \<Rightarrow> (invalid (\<tau>)) - | \<lfloor>\<bottom>\<rfloor> \<Rightarrow> (null (\<tau>)) - | \<lfloor>\<lfloor>(mk\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y ((mk\<E>\<X>\<T>\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (Planet))) (_) (_) (_))\<rfloor>\<rfloor> \<Rightarrow> \<lfloor>\<lfloor>Planet\<rfloor>\<rfloor> - | _ \<Rightarrow> (invalid (\<tau>))))" -end -overloading OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t \<equiv> "(OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t::(\<cdot>OclAny) \<Rightarrow> _)" -begin - definition OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny : "(x::\<cdot>OclAny) .oclAsType(Planet) \<equiv> (\<lambda>\<tau>. (case (x (\<tau>)) of \<bottom> \<Rightarrow> (invalid (\<tau>)) - | \<lfloor>\<bottom>\<rfloor> \<Rightarrow> (null (\<tau>)) - | \<lfloor>\<lfloor>(mk\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y ((mk\<E>\<X>\<T>\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (Planet))))\<rfloor>\<rfloor> \<Rightarrow> \<lfloor>\<lfloor>Planet\<rfloor>\<rfloor> - | _ \<Rightarrow> (invalid (\<tau>))))" -end -overloading OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t \<equiv> "(OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t::(\<cdot>Person) \<Rightarrow> _)" -begin - definition OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person : "(x::\<cdot>Person) .oclAsType(Planet) \<equiv> (\<lambda>\<tau>. (case (x (\<tau>)) of \<bottom> \<Rightarrow> (invalid (\<tau>)) - | \<lfloor>\<bottom>\<rfloor> \<Rightarrow> (null (\<tau>)) - | \<lfloor>\<lfloor>Person\<rfloor>\<rfloor> \<Rightarrow> \<lfloor>\<lfloor>(mk\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t ((mk\<E>\<X>\<T>\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (Person))) (None) (None))\<rfloor>\<rfloor>))" -end -overloading OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y \<equiv> "(OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y::(\<cdot>Galaxy) \<Rightarrow> _)" -begin - definition OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy : "(x::\<cdot>Galaxy) .oclAsType(Galaxy) \<equiv> x" -end -overloading OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y \<equiv> "(OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y::(\<cdot>OclAny) \<Rightarrow> _)" -begin - definition OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny : "(x::\<cdot>OclAny) .oclAsType(Galaxy) \<equiv> (\<lambda>\<tau>. (case (x (\<tau>)) of \<bottom> \<Rightarrow> (invalid (\<tau>)) - | \<lfloor>\<bottom>\<rfloor> \<Rightarrow> (null (\<tau>)) - | \<lfloor>\<lfloor>(mk\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y ((mk\<E>\<X>\<T>\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y (Galaxy))))\<rfloor>\<rfloor> \<Rightarrow> \<lfloor>\<lfloor>Galaxy\<rfloor>\<rfloor> - | _ \<Rightarrow> (invalid (\<tau>))))" -end -overloading OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y \<equiv> "(OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y::(\<cdot>Person) \<Rightarrow> _)" -begin - definition OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person : "(x::\<cdot>Person) .oclAsType(Galaxy) \<equiv> (\<lambda>\<tau>. (case (x (\<tau>)) of \<bottom> \<Rightarrow> (invalid (\<tau>)) - | \<lfloor>\<bottom>\<rfloor> \<Rightarrow> (null (\<tau>)) - | \<lfloor>\<lfloor>Person\<rfloor>\<rfloor> \<Rightarrow> \<lfloor>\<lfloor>(mk\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y ((mk\<E>\<X>\<T>\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (Person))) (None) (None) (None))\<rfloor>\<rfloor>))" -end -overloading OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y \<equiv> "(OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y::(\<cdot>Planet) \<Rightarrow> _)" -begin - definition OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet : "(x::\<cdot>Planet) .oclAsType(Galaxy) \<equiv> (\<lambda>\<tau>. (case (x (\<tau>)) of \<bottom> \<Rightarrow> (invalid (\<tau>)) - | \<lfloor>\<bottom>\<rfloor> \<Rightarrow> (null (\<tau>)) - | \<lfloor>\<lfloor>Planet\<rfloor>\<rfloor> \<Rightarrow> \<lfloor>\<lfloor>(mk\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y ((mk\<E>\<X>\<T>\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (Planet))) (None) (None) (None))\<rfloor>\<rfloor>))" -end -overloading OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y \<equiv> "(OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y::(\<cdot>OclAny) \<Rightarrow> _)" -begin - definition OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny : "(x::\<cdot>OclAny) .oclAsType(OclAny) \<equiv> x" -end -overloading OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y \<equiv> "(OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y::(\<cdot>Person) \<Rightarrow> _)" -begin - definition OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person : "(x::\<cdot>Person) .oclAsType(OclAny) \<equiv> (\<lambda>\<tau>. (case (x (\<tau>)) of \<bottom> \<Rightarrow> (invalid (\<tau>)) - | \<lfloor>\<bottom>\<rfloor> \<Rightarrow> (null (\<tau>)) - | \<lfloor>\<lfloor>Person\<rfloor>\<rfloor> \<Rightarrow> \<lfloor>\<lfloor>(mk\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y ((mk\<E>\<X>\<T>\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (Person))))\<rfloor>\<rfloor>))" -end -overloading OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y \<equiv> "(OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y::(\<cdot>Planet) \<Rightarrow> _)" -begin - definition OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet : "(x::\<cdot>Planet) .oclAsType(OclAny) \<equiv> (\<lambda>\<tau>. (case (x (\<tau>)) of \<bottom> \<Rightarrow> (invalid (\<tau>)) - | \<lfloor>\<bottom>\<rfloor> \<Rightarrow> (null (\<tau>)) - | \<lfloor>\<lfloor>Planet\<rfloor>\<rfloor> \<Rightarrow> \<lfloor>\<lfloor>(mk\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y ((mk\<E>\<X>\<T>\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (Planet))))\<rfloor>\<rfloor>))" -end -overloading OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y \<equiv> "(OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y::(\<cdot>Galaxy) \<Rightarrow> _)" -begin - definition OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy : "(x::\<cdot>Galaxy) .oclAsType(OclAny) \<equiv> (\<lambda>\<tau>. (case (x (\<tau>)) of \<bottom> \<Rightarrow> (invalid (\<tau>)) - | \<lfloor>\<bottom>\<rfloor> \<Rightarrow> (null (\<tau>)) - | \<lfloor>\<lfloor>Galaxy\<rfloor>\<rfloor> \<Rightarrow> \<lfloor>\<lfloor>(mk\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y ((mk\<E>\<X>\<T>\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y (Galaxy))))\<rfloor>\<rfloor>))" -end - -(* 39 ************************************ 106 + 4 *) (* term Floor1_astype.print_astype_from_universe *) -definition "OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_\<AA> = (\<lambda> (in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (Person)) \<Rightarrow> \<lfloor>Person\<rfloor> - | (in\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t ((mk\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t ((mk\<E>\<X>\<T>\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (Person))) (_) (_)))) \<Rightarrow> \<lfloor>Person\<rfloor> - | (in\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y ((mk\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y ((mk\<E>\<X>\<T>\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (Person))) (_) (_) (_)))) \<Rightarrow> \<lfloor>Person\<rfloor> - | (in\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y ((mk\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y ((mk\<E>\<X>\<T>\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (Person)))))) \<Rightarrow> \<lfloor>Person\<rfloor> - | _ \<Rightarrow> None)" -definition "OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_\<AA> = (\<lambda> (in\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (Planet)) \<Rightarrow> \<lfloor>Planet\<rfloor> - | (in\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y ((mk\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y ((mk\<E>\<X>\<T>\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (Planet))) (_) (_) (_)))) \<Rightarrow> \<lfloor>Planet\<rfloor> - | (in\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y ((mk\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y ((mk\<E>\<X>\<T>\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (Planet)))))) \<Rightarrow> \<lfloor>Planet\<rfloor> - | (in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (Person)) \<Rightarrow> \<lfloor>(mk\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t ((mk\<E>\<X>\<T>\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (Person))) (None) (None))\<rfloor> - | _ \<Rightarrow> None)" -definition "OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_\<AA> = (\<lambda> (in\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y (Galaxy)) \<Rightarrow> \<lfloor>Galaxy\<rfloor> - | (in\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y ((mk\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y ((mk\<E>\<X>\<T>\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y (Galaxy)))))) \<Rightarrow> \<lfloor>Galaxy\<rfloor> - | (in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (Person)) \<Rightarrow> \<lfloor>(mk\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y ((mk\<E>\<X>\<T>\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (Person))) (None) (None) (None))\<rfloor> - | (in\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (Planet)) \<Rightarrow> \<lfloor>(mk\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y ((mk\<E>\<X>\<T>\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (Planet))) (None) (None) (None))\<rfloor> - | _ \<Rightarrow> None)" -definition "OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_\<AA> = Some o (\<lambda> (in\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y (OclAny)) \<Rightarrow> OclAny - | (in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (Person)) \<Rightarrow> (mk\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y ((mk\<E>\<X>\<T>\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (Person)))) - | (in\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (Planet)) \<Rightarrow> (mk\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y ((mk\<E>\<X>\<T>\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (Planet)))) - | (in\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y (Galaxy)) \<Rightarrow> (mk\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y ((mk\<E>\<X>\<T>\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y (Galaxy)))))" - -(* 40 ************************************ 110 + 1 *) (* term Floor1_astype.print_astype_lemmas_id *) -lemmas[simp,code_unfold] = OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person - OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet - OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy - OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny - -(* 41 ************************************ 111 + 1 *) -subsection \<open>Context Passing\<close> - -(* 42 ************************************ 112 + 64 *) (* term Floor1_astype.print_astype_lemma_cp *) -lemma cp_OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_OclAny : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>OclAny)))::\<cdot>OclAny) .oclAsType(OclAny)))))" -by(rule cpI1, simp) -lemma cp_OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy_OclAny : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Galaxy)))::\<cdot>OclAny) .oclAsType(OclAny)))))" -by(rule cpI1, simp) -lemma cp_OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet_OclAny : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Planet)))::\<cdot>OclAny) .oclAsType(OclAny)))))" -by(rule cpI1, simp) -lemma cp_OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_OclAny : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Person)))::\<cdot>OclAny) .oclAsType(OclAny)))))" -by(rule cpI1, simp) -lemma cp_OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_Galaxy : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>OclAny)))::\<cdot>Galaxy) .oclAsType(OclAny)))))" -by(rule cpI1, simp add: OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy) -lemma cp_OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy_Galaxy : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Galaxy)))::\<cdot>Galaxy) .oclAsType(OclAny)))))" -by(rule cpI1, simp add: OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy) -lemma cp_OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet_Galaxy : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Planet)))::\<cdot>Galaxy) .oclAsType(OclAny)))))" -by(rule cpI1, simp add: OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy) -lemma cp_OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_Galaxy : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Person)))::\<cdot>Galaxy) .oclAsType(OclAny)))))" -by(rule cpI1, simp add: OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy) -lemma cp_OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_Planet : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>OclAny)))::\<cdot>Planet) .oclAsType(OclAny)))))" -by(rule cpI1, simp add: OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet) -lemma cp_OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy_Planet : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Galaxy)))::\<cdot>Planet) .oclAsType(OclAny)))))" -by(rule cpI1, simp add: OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet) -lemma cp_OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet_Planet : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Planet)))::\<cdot>Planet) .oclAsType(OclAny)))))" -by(rule cpI1, simp add: OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet) -lemma cp_OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_Planet : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Person)))::\<cdot>Planet) .oclAsType(OclAny)))))" -by(rule cpI1, simp add: OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet) -lemma cp_OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_Person : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>OclAny)))::\<cdot>Person) .oclAsType(OclAny)))))" -by(rule cpI1, simp add: OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person) -lemma cp_OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy_Person : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Galaxy)))::\<cdot>Person) .oclAsType(OclAny)))))" -by(rule cpI1, simp add: OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person) -lemma cp_OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet_Person : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Planet)))::\<cdot>Person) .oclAsType(OclAny)))))" -by(rule cpI1, simp add: OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person) -lemma cp_OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_Person : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Person)))::\<cdot>Person) .oclAsType(OclAny)))))" -by(rule cpI1, simp add: OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person) -lemma cp_OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny_OclAny : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>OclAny)))::\<cdot>OclAny) .oclAsType(Galaxy)))))" -by(rule cpI1, simp add: OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny) -lemma cp_OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy_OclAny : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Galaxy)))::\<cdot>OclAny) .oclAsType(Galaxy)))))" -by(rule cpI1, simp add: OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny) -lemma cp_OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet_OclAny : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Planet)))::\<cdot>OclAny) .oclAsType(Galaxy)))))" -by(rule cpI1, simp add: OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny) -lemma cp_OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person_OclAny : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Person)))::\<cdot>OclAny) .oclAsType(Galaxy)))))" -by(rule cpI1, simp add: OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny) -lemma cp_OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny_Galaxy : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>OclAny)))::\<cdot>Galaxy) .oclAsType(Galaxy)))))" -by(rule cpI1, simp) -lemma cp_OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy_Galaxy : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Galaxy)))::\<cdot>Galaxy) .oclAsType(Galaxy)))))" -by(rule cpI1, simp) -lemma cp_OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet_Galaxy : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Planet)))::\<cdot>Galaxy) .oclAsType(Galaxy)))))" -by(rule cpI1, simp) -lemma cp_OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person_Galaxy : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Person)))::\<cdot>Galaxy) .oclAsType(Galaxy)))))" -by(rule cpI1, simp) -lemma cp_OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny_Planet : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>OclAny)))::\<cdot>Planet) .oclAsType(Galaxy)))))" -by(rule cpI1, simp add: OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet) -lemma cp_OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy_Planet : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Galaxy)))::\<cdot>Planet) .oclAsType(Galaxy)))))" -by(rule cpI1, simp add: OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet) -lemma cp_OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet_Planet : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Planet)))::\<cdot>Planet) .oclAsType(Galaxy)))))" -by(rule cpI1, simp add: OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet) -lemma cp_OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person_Planet : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Person)))::\<cdot>Planet) .oclAsType(Galaxy)))))" -by(rule cpI1, simp add: OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet) -lemma cp_OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny_Person : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>OclAny)))::\<cdot>Person) .oclAsType(Galaxy)))))" -by(rule cpI1, simp add: OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person) -lemma cp_OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy_Person : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Galaxy)))::\<cdot>Person) .oclAsType(Galaxy)))))" -by(rule cpI1, simp add: OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person) -lemma cp_OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet_Person : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Planet)))::\<cdot>Person) .oclAsType(Galaxy)))))" -by(rule cpI1, simp add: OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person) -lemma cp_OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person_Person : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Person)))::\<cdot>Person) .oclAsType(Galaxy)))))" -by(rule cpI1, simp add: OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person) -lemma cp_OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny_OclAny : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>OclAny)))::\<cdot>OclAny) .oclAsType(Planet)))))" -by(rule cpI1, simp add: OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny) -lemma cp_OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy_OclAny : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Galaxy)))::\<cdot>OclAny) .oclAsType(Planet)))))" -by(rule cpI1, simp add: OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny) -lemma cp_OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet_OclAny : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Planet)))::\<cdot>OclAny) .oclAsType(Planet)))))" -by(rule cpI1, simp add: OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny) -lemma cp_OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person_OclAny : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Person)))::\<cdot>OclAny) .oclAsType(Planet)))))" -by(rule cpI1, simp add: OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny) -lemma cp_OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny_Galaxy : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>OclAny)))::\<cdot>Galaxy) .oclAsType(Planet)))))" -by(rule cpI1, simp add: OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy) -lemma cp_OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy_Galaxy : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Galaxy)))::\<cdot>Galaxy) .oclAsType(Planet)))))" -by(rule cpI1, simp add: OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy) -lemma cp_OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet_Galaxy : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Planet)))::\<cdot>Galaxy) .oclAsType(Planet)))))" -by(rule cpI1, simp add: OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy) -lemma cp_OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person_Galaxy : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Person)))::\<cdot>Galaxy) .oclAsType(Planet)))))" -by(rule cpI1, simp add: OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy) -lemma cp_OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny_Planet : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>OclAny)))::\<cdot>Planet) .oclAsType(Planet)))))" -by(rule cpI1, simp) -lemma cp_OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy_Planet : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Galaxy)))::\<cdot>Planet) .oclAsType(Planet)))))" -by(rule cpI1, simp) -lemma cp_OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet_Planet : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Planet)))::\<cdot>Planet) .oclAsType(Planet)))))" -by(rule cpI1, simp) -lemma cp_OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person_Planet : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Person)))::\<cdot>Planet) .oclAsType(Planet)))))" -by(rule cpI1, simp) -lemma cp_OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny_Person : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>OclAny)))::\<cdot>Person) .oclAsType(Planet)))))" -by(rule cpI1, simp add: OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person) -lemma cp_OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy_Person : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Galaxy)))::\<cdot>Person) .oclAsType(Planet)))))" -by(rule cpI1, simp add: OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person) -lemma cp_OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet_Person : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Planet)))::\<cdot>Person) .oclAsType(Planet)))))" -by(rule cpI1, simp add: OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person) -lemma cp_OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person_Person : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Person)))::\<cdot>Person) .oclAsType(Planet)))))" -by(rule cpI1, simp add: OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person) -lemma cp_OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_OclAny : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>OclAny)))::\<cdot>OclAny) .oclAsType(Person)))))" -by(rule cpI1, simp add: OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny) -lemma cp_OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy_OclAny : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Galaxy)))::\<cdot>OclAny) .oclAsType(Person)))))" -by(rule cpI1, simp add: OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny) -lemma cp_OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet_OclAny : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Planet)))::\<cdot>OclAny) .oclAsType(Person)))))" -by(rule cpI1, simp add: OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny) -lemma cp_OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_OclAny : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Person)))::\<cdot>OclAny) .oclAsType(Person)))))" -by(rule cpI1, simp add: OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny) -lemma cp_OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_Galaxy : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>OclAny)))::\<cdot>Galaxy) .oclAsType(Person)))))" -by(rule cpI1, simp add: OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy) -lemma cp_OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy_Galaxy : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Galaxy)))::\<cdot>Galaxy) .oclAsType(Person)))))" -by(rule cpI1, simp add: OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy) -lemma cp_OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet_Galaxy : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Planet)))::\<cdot>Galaxy) .oclAsType(Person)))))" -by(rule cpI1, simp add: OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy) -lemma cp_OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_Galaxy : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Person)))::\<cdot>Galaxy) .oclAsType(Person)))))" -by(rule cpI1, simp add: OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy) -lemma cp_OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_Planet : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>OclAny)))::\<cdot>Planet) .oclAsType(Person)))))" -by(rule cpI1, simp add: OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet) -lemma cp_OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy_Planet : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Galaxy)))::\<cdot>Planet) .oclAsType(Person)))))" -by(rule cpI1, simp add: OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet) -lemma cp_OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet_Planet : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Planet)))::\<cdot>Planet) .oclAsType(Person)))))" -by(rule cpI1, simp add: OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet) -lemma cp_OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_Planet : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Person)))::\<cdot>Planet) .oclAsType(Person)))))" -by(rule cpI1, simp add: OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet) -lemma cp_OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_Person : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>OclAny)))::\<cdot>Person) .oclAsType(Person)))))" -by(rule cpI1, simp) -lemma cp_OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy_Person : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Galaxy)))::\<cdot>Person) .oclAsType(Person)))))" -by(rule cpI1, simp) -lemma cp_OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet_Person : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Planet)))::\<cdot>Person) .oclAsType(Person)))))" -by(rule cpI1, simp) -lemma cp_OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_Person : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Person)))::\<cdot>Person) .oclAsType(Person)))))" -by(rule cpI1, simp) - -(* 43 ************************************ 176 + 1 *) (* term Floor1_astype.print_astype_lemmas_cp *) -lemmas[simp,code_unfold] = cp_OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_OclAny - cp_OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy_OclAny - cp_OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet_OclAny - cp_OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_OclAny - cp_OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_Galaxy - cp_OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy_Galaxy - cp_OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet_Galaxy - cp_OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_Galaxy - cp_OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_Planet - cp_OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy_Planet - cp_OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet_Planet - cp_OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_Planet - cp_OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_Person - cp_OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy_Person - cp_OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet_Person - cp_OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_Person - cp_OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny_OclAny - cp_OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy_OclAny - cp_OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet_OclAny - cp_OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person_OclAny - cp_OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny_Galaxy - cp_OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy_Galaxy - cp_OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet_Galaxy - cp_OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person_Galaxy - cp_OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny_Planet - cp_OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy_Planet - cp_OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet_Planet - cp_OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person_Planet - cp_OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny_Person - cp_OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy_Person - cp_OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet_Person - cp_OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person_Person - cp_OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny_OclAny - cp_OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy_OclAny - cp_OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet_OclAny - cp_OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person_OclAny - cp_OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny_Galaxy - cp_OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy_Galaxy - cp_OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet_Galaxy - cp_OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person_Galaxy - cp_OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny_Planet - cp_OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy_Planet - cp_OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet_Planet - cp_OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person_Planet - cp_OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny_Person - cp_OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy_Person - cp_OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet_Person - cp_OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person_Person - cp_OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_OclAny - cp_OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy_OclAny - cp_OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet_OclAny - cp_OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_OclAny - cp_OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_Galaxy - cp_OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy_Galaxy - cp_OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet_Galaxy - cp_OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_Galaxy - cp_OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_Planet - cp_OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy_Planet - cp_OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet_Planet - cp_OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_Planet - cp_OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_Person - cp_OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy_Person - cp_OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet_Person - cp_OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_Person - -(* 44 ************************************ 177 + 1 *) -subsection \<open>Execution with Invalid or Null as Argument\<close> - -(* 45 ************************************ 178 + 32 *) (* term Floor1_astype.print_astype_lemma_strict *) -lemma OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_invalid : "((invalid::\<cdot>OclAny) .oclAsType(OclAny)) = invalid" -by(simp) -lemma OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy_invalid : "((invalid::\<cdot>Galaxy) .oclAsType(OclAny)) = invalid" -by(rule ext, simp add: OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy bot_option_def invalid_def) -lemma OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet_invalid : "((invalid::\<cdot>Planet) .oclAsType(OclAny)) = invalid" -by(rule ext, simp add: OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet bot_option_def invalid_def) -lemma OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_invalid : "((invalid::\<cdot>Person) .oclAsType(OclAny)) = invalid" -by(rule ext, simp add: OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person bot_option_def invalid_def) -lemma OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_null : "((null::\<cdot>OclAny) .oclAsType(OclAny)) = null" -by(simp) -lemma OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy_null : "((null::\<cdot>Galaxy) .oclAsType(OclAny)) = null" -by(rule ext, simp add: OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy bot_option_def null_fun_def null_option_def) -lemma OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet_null : "((null::\<cdot>Planet) .oclAsType(OclAny)) = null" -by(rule ext, simp add: OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet bot_option_def null_fun_def null_option_def) -lemma OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_null : "((null::\<cdot>Person) .oclAsType(OclAny)) = null" -by(rule ext, simp add: OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person bot_option_def null_fun_def null_option_def) -lemma OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny_invalid : "((invalid::\<cdot>OclAny) .oclAsType(Galaxy)) = invalid" -by(rule ext, simp add: OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny bot_option_def invalid_def) -lemma OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy_invalid : "((invalid::\<cdot>Galaxy) .oclAsType(Galaxy)) = invalid" -by(simp) -lemma OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet_invalid : "((invalid::\<cdot>Planet) .oclAsType(Galaxy)) = invalid" -by(rule ext, simp add: OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet bot_option_def invalid_def) -lemma OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person_invalid : "((invalid::\<cdot>Person) .oclAsType(Galaxy)) = invalid" -by(rule ext, simp add: OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person bot_option_def invalid_def) -lemma OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny_null : "((null::\<cdot>OclAny) .oclAsType(Galaxy)) = null" -by(rule ext, simp add: OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny bot_option_def null_fun_def null_option_def) -lemma OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy_null : "((null::\<cdot>Galaxy) .oclAsType(Galaxy)) = null" -by(simp) -lemma OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet_null : "((null::\<cdot>Planet) .oclAsType(Galaxy)) = null" -by(rule ext, simp add: OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet bot_option_def null_fun_def null_option_def) -lemma OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person_null : "((null::\<cdot>Person) .oclAsType(Galaxy)) = null" -by(rule ext, simp add: OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person bot_option_def null_fun_def null_option_def) -lemma OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny_invalid : "((invalid::\<cdot>OclAny) .oclAsType(Planet)) = invalid" -by(rule ext, simp add: OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny bot_option_def invalid_def) -lemma OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy_invalid : "((invalid::\<cdot>Galaxy) .oclAsType(Planet)) = invalid" -by(rule ext, simp add: OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy bot_option_def invalid_def) -lemma OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet_invalid : "((invalid::\<cdot>Planet) .oclAsType(Planet)) = invalid" -by(simp) -lemma OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person_invalid : "((invalid::\<cdot>Person) .oclAsType(Planet)) = invalid" -by(rule ext, simp add: OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person bot_option_def invalid_def) -lemma OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny_null : "((null::\<cdot>OclAny) .oclAsType(Planet)) = null" -by(rule ext, simp add: OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny bot_option_def null_fun_def null_option_def) -lemma OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy_null : "((null::\<cdot>Galaxy) .oclAsType(Planet)) = null" -by(rule ext, simp add: OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy bot_option_def null_fun_def null_option_def) -lemma OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet_null : "((null::\<cdot>Planet) .oclAsType(Planet)) = null" -by(simp) -lemma OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person_null : "((null::\<cdot>Person) .oclAsType(Planet)) = null" -by(rule ext, simp add: OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person bot_option_def null_fun_def null_option_def) -lemma OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_invalid : "((invalid::\<cdot>OclAny) .oclAsType(Person)) = invalid" -by(rule ext, simp add: OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny bot_option_def invalid_def) -lemma OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy_invalid : "((invalid::\<cdot>Galaxy) .oclAsType(Person)) = invalid" -by(rule ext, simp add: OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy bot_option_def invalid_def) -lemma OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet_invalid : "((invalid::\<cdot>Planet) .oclAsType(Person)) = invalid" -by(rule ext, simp add: OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet bot_option_def invalid_def) -lemma OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_invalid : "((invalid::\<cdot>Person) .oclAsType(Person)) = invalid" -by(simp) -lemma OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_null : "((null::\<cdot>OclAny) .oclAsType(Person)) = null" -by(rule ext, simp add: OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny bot_option_def null_fun_def null_option_def) -lemma OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy_null : "((null::\<cdot>Galaxy) .oclAsType(Person)) = null" -by(rule ext, simp add: OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy bot_option_def null_fun_def null_option_def) -lemma OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet_null : "((null::\<cdot>Planet) .oclAsType(Person)) = null" -by(rule ext, simp add: OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet bot_option_def null_fun_def null_option_def) -lemma OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_null : "((null::\<cdot>Person) .oclAsType(Person)) = null" -by(simp) - -(* 46 ************************************ 210 + 1 *) (* term Floor1_astype.print_astype_lemmas_strict *) -lemmas[simp,code_unfold] = OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_invalid - OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy_invalid - OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet_invalid - OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_invalid - OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_null - OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy_null - OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet_null - OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_null - OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny_invalid - OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy_invalid - OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet_invalid - OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person_invalid - OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny_null - OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy_null - OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet_null - OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person_null - OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny_invalid - OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy_invalid - OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet_invalid - OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person_invalid - OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny_null - OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy_null - OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet_null - OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person_null - OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_invalid - OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy_invalid - OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet_invalid - OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_invalid - OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_null - OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy_null - OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet_null - OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_null - -(* 47 ************************************ 211 + 1 *) -subsection \<open>Validity and Definedness Properties\<close> - -(* 48 ************************************ 212 + 6 *) (* term Floor1_astype.print_astype_defined *) -lemma OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person_defined : -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Person) .oclAsType(Planet)))" - using isdef -by(auto simp: OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person foundation16 null_option_def bot_option_def) -lemma OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person_defined : -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Person) .oclAsType(Galaxy)))" - using isdef -by(auto simp: OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person foundation16 null_option_def bot_option_def) -lemma OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet_defined : -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Planet) .oclAsType(Galaxy)))" - using isdef -by(auto simp: OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet foundation16 null_option_def bot_option_def) -lemma OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_defined : -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Person) .oclAsType(OclAny)))" - using isdef -by(auto simp: OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person foundation16 null_option_def bot_option_def) -lemma OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet_defined : -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Planet) .oclAsType(OclAny)))" - using isdef -by(auto simp: OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet foundation16 null_option_def bot_option_def) -lemma OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy_defined : -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Galaxy) .oclAsType(OclAny)))" - using isdef -by(auto simp: OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy foundation16 null_option_def bot_option_def) - -(* 49 ************************************ 218 + 1 *) -subsection \<open>Up Down Casting\<close> - -(* 50 ************************************ 219 + 6 *) (* term Floor1_astype.print_astype_up_d_cast0 *) -lemma up\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_down\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_cast0 : -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> (((X::\<cdot>Person) .oclAsType(Planet)) .oclAsType(Person)) \<triangleq> X" - using isdef -by(auto simp: OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet foundation22 foundation16 null_option_def bot_option_def split: ty\<E>\<X>\<T>\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n.split ty\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n.split) -lemma up\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_down\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_cast0 : -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> (((X::\<cdot>Person) .oclAsType(Galaxy)) .oclAsType(Person)) \<triangleq> X" - using isdef -by(auto simp: OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy foundation22 foundation16 null_option_def bot_option_def split: ty\<E>\<X>\<T>\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n.split ty\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n.split) -lemma up\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_down\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_cast0 : -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> (((X::\<cdot>Person) .oclAsType(OclAny)) .oclAsType(Person)) \<triangleq> X" - using isdef -by(auto simp: OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny foundation22 foundation16 null_option_def bot_option_def split: ty\<E>\<X>\<T>\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n.split ty\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n.split) -lemma up\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_down\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_cast0 : -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> (((X::\<cdot>Planet) .oclAsType(Galaxy)) .oclAsType(Planet)) \<triangleq> X" - using isdef -by(auto simp: OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy foundation22 foundation16 null_option_def bot_option_def split: ty\<E>\<X>\<T>\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t.split ty\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t.split) -lemma up\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_down\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_cast0 : -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> (((X::\<cdot>Planet) .oclAsType(OclAny)) .oclAsType(Planet)) \<triangleq> X" - using isdef -by(auto simp: OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny foundation22 foundation16 null_option_def bot_option_def split: ty\<E>\<X>\<T>\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t.split ty\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t.split) -lemma up\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_down\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_cast0 : -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> (((X::\<cdot>Galaxy) .oclAsType(OclAny)) .oclAsType(Galaxy)) \<triangleq> X" - using isdef -by(auto simp: OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny foundation22 foundation16 null_option_def bot_option_def split: ty\<E>\<X>\<T>\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y.split ty\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y.split) - -(* 51 ************************************ 225 + 6 *) (* term Floor1_astype.print_astype_up_d_cast *) -lemma up\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_down\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_cast : -shows "(((X::\<cdot>Person) .oclAsType(Planet)) .oclAsType(Person)) = X" - apply(rule ext, rename_tac \<tau>) - apply(rule foundation22[THEN iffD1]) - apply(case_tac "\<tau> \<Turnstile> (\<delta> (X))", simp add: up\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_down\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_cast0) - apply(simp add: defined_split, elim disjE) - apply((erule StrongEq_L_subst2_rev, simp, simp)+) -done -lemma up\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_down\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_cast : -shows "(((X::\<cdot>Person) .oclAsType(Galaxy)) .oclAsType(Person)) = X" - apply(rule ext, rename_tac \<tau>) - apply(rule foundation22[THEN iffD1]) - apply(case_tac "\<tau> \<Turnstile> (\<delta> (X))", simp add: up\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_down\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_cast0) - apply(simp add: defined_split, elim disjE) - apply((erule StrongEq_L_subst2_rev, simp, simp)+) -done -lemma up\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_down\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_cast : -shows "(((X::\<cdot>Person) .oclAsType(OclAny)) .oclAsType(Person)) = X" - apply(rule ext, rename_tac \<tau>) - apply(rule foundation22[THEN iffD1]) - apply(case_tac "\<tau> \<Turnstile> (\<delta> (X))", simp add: up\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_down\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_cast0) - apply(simp add: defined_split, elim disjE) - apply((erule StrongEq_L_subst2_rev, simp, simp)+) -done -lemma up\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_down\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_cast : -shows "(((X::\<cdot>Planet) .oclAsType(Galaxy)) .oclAsType(Planet)) = X" - apply(rule ext, rename_tac \<tau>) - apply(rule foundation22[THEN iffD1]) - apply(case_tac "\<tau> \<Turnstile> (\<delta> (X))", simp add: up\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_down\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_cast0) - apply(simp add: defined_split, elim disjE) - apply((erule StrongEq_L_subst2_rev, simp, simp)+) -done -lemma up\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_down\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_cast : -shows "(((X::\<cdot>Planet) .oclAsType(OclAny)) .oclAsType(Planet)) = X" - apply(rule ext, rename_tac \<tau>) - apply(rule foundation22[THEN iffD1]) - apply(case_tac "\<tau> \<Turnstile> (\<delta> (X))", simp add: up\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_down\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_cast0) - apply(simp add: defined_split, elim disjE) - apply((erule StrongEq_L_subst2_rev, simp, simp)+) -done -lemma up\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_down\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_cast : -shows "(((X::\<cdot>Galaxy) .oclAsType(OclAny)) .oclAsType(Galaxy)) = X" - apply(rule ext, rename_tac \<tau>) - apply(rule foundation22[THEN iffD1]) - apply(case_tac "\<tau> \<Turnstile> (\<delta> (X))", simp add: up\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_down\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_cast0) - apply(simp add: defined_split, elim disjE) - apply((erule StrongEq_L_subst2_rev, simp, simp)+) -done - -(* 52 ************************************ 231 + 6 *) (* term Floor1_astype.print_astype_d_up_cast *) -lemma down\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_up\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_cast : -assumes def_X: "X = ((Y::\<cdot>Person) .oclAsType(Planet))" -shows "(\<tau> \<Turnstile> ((not ((\<upsilon> (X)))) or ((X .oclAsType(Person)) .oclAsType(Planet)) \<doteq> X))" - apply(case_tac "(\<tau> \<Turnstile> ((not ((\<upsilon> (X))))))", rule foundation25, simp) -by(rule foundation25', simp add: def_X up\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_down\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_cast StrictRefEq\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_sym) -lemma down\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_up\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_cast : -assumes def_X: "X = ((Y::\<cdot>Person) .oclAsType(Galaxy))" -shows "(\<tau> \<Turnstile> ((not ((\<upsilon> (X)))) or ((X .oclAsType(Person)) .oclAsType(Galaxy)) \<doteq> X))" - apply(case_tac "(\<tau> \<Turnstile> ((not ((\<upsilon> (X))))))", rule foundation25, simp) -by(rule foundation25', simp add: def_X up\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_down\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_cast StrictRefEq\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_sym) -lemma down\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_up\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_cast : -assumes def_X: "X = ((Y::\<cdot>Person) .oclAsType(OclAny))" -shows "(\<tau> \<Turnstile> ((not ((\<upsilon> (X)))) or ((X .oclAsType(Person)) .oclAsType(OclAny)) \<doteq> X))" - apply(case_tac "(\<tau> \<Turnstile> ((not ((\<upsilon> (X))))))", rule foundation25, simp) -by(rule foundation25', simp add: def_X up\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_down\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_cast StrictRefEq\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_sym) -lemma down\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_up\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_cast : -assumes def_X: "X = ((Y::\<cdot>Planet) .oclAsType(Galaxy))" -shows "(\<tau> \<Turnstile> ((not ((\<upsilon> (X)))) or ((X .oclAsType(Planet)) .oclAsType(Galaxy)) \<doteq> X))" - apply(case_tac "(\<tau> \<Turnstile> ((not ((\<upsilon> (X))))))", rule foundation25, simp) -by(rule foundation25', simp add: def_X up\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_down\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_cast StrictRefEq\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_sym) -lemma down\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_up\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_cast : -assumes def_X: "X = ((Y::\<cdot>Planet) .oclAsType(OclAny))" -shows "(\<tau> \<Turnstile> ((not ((\<upsilon> (X)))) or ((X .oclAsType(Planet)) .oclAsType(OclAny)) \<doteq> X))" - apply(case_tac "(\<tau> \<Turnstile> ((not ((\<upsilon> (X))))))", rule foundation25, simp) -by(rule foundation25', simp add: def_X up\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_down\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_cast StrictRefEq\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_sym) -lemma down\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_up\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_cast : -assumes def_X: "X = ((Y::\<cdot>Galaxy) .oclAsType(OclAny))" -shows "(\<tau> \<Turnstile> ((not ((\<upsilon> (X)))) or ((X .oclAsType(Galaxy)) .oclAsType(OclAny)) \<doteq> X))" - apply(case_tac "(\<tau> \<Turnstile> ((not ((\<upsilon> (X))))))", rule foundation25, simp) -by(rule foundation25', simp add: def_X up\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_down\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_cast StrictRefEq\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_sym) - -(* 53 ************************************ 237 + 1 *) -subsection \<open>Const\<close> - -(* 54 ************************************ 238 + 16 *) (* term Floor1_astype.print_astype_lemma_const *) -lemma OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_const : "(const ((X::\<cdot>OclAny))) \<Longrightarrow> (const (X .oclAsType(OclAny)))" -by(simp add: const_def, (metis (no_types) OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny prod.collapse bot_option_def invalid_def null_fun_def null_option_def)?) -lemma OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy_const : "(const ((X::\<cdot>Galaxy))) \<Longrightarrow> (const (X .oclAsType(OclAny)))" -by(simp add: const_def, (metis (no_types) OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy prod.collapse bot_option_def invalid_def null_fun_def null_option_def)?) -lemma OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet_const : "(const ((X::\<cdot>Planet))) \<Longrightarrow> (const (X .oclAsType(OclAny)))" -by(simp add: const_def, (metis (no_types) OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet prod.collapse bot_option_def invalid_def null_fun_def null_option_def)?) -lemma OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_const : "(const ((X::\<cdot>Person))) \<Longrightarrow> (const (X .oclAsType(OclAny)))" -by(simp add: const_def, (metis (no_types) OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person prod.collapse bot_option_def invalid_def null_fun_def null_option_def)?) -lemma OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny_const : "(const ((X::\<cdot>OclAny))) \<Longrightarrow> (const (X .oclAsType(Galaxy)))" -by(simp add: const_def, (metis (no_types) OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny prod.collapse bot_option_def invalid_def null_fun_def null_option_def)?) -lemma OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy_const : "(const ((X::\<cdot>Galaxy))) \<Longrightarrow> (const (X .oclAsType(Galaxy)))" -by(simp add: const_def, (metis (no_types) OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy prod.collapse bot_option_def invalid_def null_fun_def null_option_def)?) -lemma OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet_const : "(const ((X::\<cdot>Planet))) \<Longrightarrow> (const (X .oclAsType(Galaxy)))" -by(simp add: const_def, (metis (no_types) OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet prod.collapse bot_option_def invalid_def null_fun_def null_option_def)?) -lemma OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person_const : "(const ((X::\<cdot>Person))) \<Longrightarrow> (const (X .oclAsType(Galaxy)))" -by(simp add: const_def, (metis (no_types) OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person prod.collapse bot_option_def invalid_def null_fun_def null_option_def)?) -lemma OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny_const : "(const ((X::\<cdot>OclAny))) \<Longrightarrow> (const (X .oclAsType(Planet)))" -by(simp add: const_def, (metis (no_types) OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny prod.collapse bot_option_def invalid_def null_fun_def null_option_def)?) -lemma OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy_const : "(const ((X::\<cdot>Galaxy))) \<Longrightarrow> (const (X .oclAsType(Planet)))" -by(simp add: const_def, (metis (no_types) OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy prod.collapse bot_option_def invalid_def null_fun_def null_option_def)?) -lemma OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet_const : "(const ((X::\<cdot>Planet))) \<Longrightarrow> (const (X .oclAsType(Planet)))" -by(simp add: const_def, (metis (no_types) OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet prod.collapse bot_option_def invalid_def null_fun_def null_option_def)?) -lemma OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person_const : "(const ((X::\<cdot>Person))) \<Longrightarrow> (const (X .oclAsType(Planet)))" -by(simp add: const_def, (metis (no_types) OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person prod.collapse bot_option_def invalid_def null_fun_def null_option_def)?) -lemma OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_const : "(const ((X::\<cdot>OclAny))) \<Longrightarrow> (const (X .oclAsType(Person)))" -by(simp add: const_def, (metis (no_types) OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny prod.collapse bot_option_def invalid_def null_fun_def null_option_def)?) -lemma OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy_const : "(const ((X::\<cdot>Galaxy))) \<Longrightarrow> (const (X .oclAsType(Person)))" -by(simp add: const_def, (metis (no_types) OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy prod.collapse bot_option_def invalid_def null_fun_def null_option_def)?) -lemma OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet_const : "(const ((X::\<cdot>Planet))) \<Longrightarrow> (const (X .oclAsType(Person)))" -by(simp add: const_def, (metis (no_types) OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet prod.collapse bot_option_def invalid_def null_fun_def null_option_def)?) -lemma OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_const : "(const ((X::\<cdot>Person))) \<Longrightarrow> (const (X .oclAsType(Person)))" -by(simp add: const_def, (metis (no_types) OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person prod.collapse bot_option_def invalid_def null_fun_def null_option_def)?) - -(* 55 ************************************ 254 + 1 *) (* term Floor1_astype.print_astype_lemmas_const *) -lemmas[simp,code_unfold] = OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_const - OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy_const - OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet_const - OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_const - OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny_const - OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy_const - OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet_const - OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person_const - OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny_const - OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy_const - OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet_const - OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person_const - OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_const - OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy_const - OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet_const - OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_const - -(* 56 ************************************ 255 + 1 *) -section \<open>Class Model: OclIsTypeOf\<close> - -(* 57 ************************************ 256 + 1 *) -subsection \<open>Definition\<close> - -(* 58 ************************************ 257 + 4 *) (* term Floor1_istypeof.print_istypeof_consts *) -consts OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n :: "'\<alpha> \<Rightarrow> Boolean" ("(_) .oclIsTypeOf'(Person')") -consts OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t :: "'\<alpha> \<Rightarrow> Boolean" ("(_) .oclIsTypeOf'(Planet')") -consts OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y :: "'\<alpha> \<Rightarrow> Boolean" ("(_) .oclIsTypeOf'(Galaxy')") -consts OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y :: "'\<alpha> \<Rightarrow> Boolean" ("(_) .oclIsTypeOf'(OclAny')") - -(* 59 ************************************ 261 + 16 *) (* term Floor1_istypeof.print_istypeof_class *) -overloading OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n \<equiv> "(OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n::(\<cdot>Person) \<Rightarrow> _)" -begin - definition OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person : "(x::\<cdot>Person) .oclIsTypeOf(Person) \<equiv> (\<lambda>\<tau>. (case (x (\<tau>)) of \<bottom> \<Rightarrow> (invalid (\<tau>)) - | \<lfloor>\<bottom>\<rfloor> \<Rightarrow> (true (\<tau>)) - | \<lfloor>\<lfloor>(mk\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n ((mk\<E>\<X>\<T>\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (_) (_) (_) (_) (_) (_))) (_))\<rfloor>\<rfloor> \<Rightarrow> (true (\<tau>))))" -end -overloading OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n \<equiv> "(OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n::(\<cdot>Planet) \<Rightarrow> _)" -begin - definition OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet : "(x::\<cdot>Planet) .oclIsTypeOf(Person) \<equiv> (\<lambda>\<tau>. (case (x (\<tau>)) of \<bottom> \<Rightarrow> (invalid (\<tau>)) - | \<lfloor>\<bottom>\<rfloor> \<Rightarrow> (true (\<tau>)) - | \<lfloor>\<lfloor>(mk\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t ((mk\<E>\<X>\<T>\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (_))) (_) (_))\<rfloor>\<rfloor> \<Rightarrow> (true (\<tau>)) - | _ \<Rightarrow> (false (\<tau>))))" -end -overloading OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n \<equiv> "(OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n::(\<cdot>Galaxy) \<Rightarrow> _)" -begin - definition OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy : "(x::\<cdot>Galaxy) .oclIsTypeOf(Person) \<equiv> (\<lambda>\<tau>. (case (x (\<tau>)) of \<bottom> \<Rightarrow> (invalid (\<tau>)) - | \<lfloor>\<bottom>\<rfloor> \<Rightarrow> (true (\<tau>)) - | \<lfloor>\<lfloor>(mk\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y ((mk\<E>\<X>\<T>\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (_))) (_) (_) (_))\<rfloor>\<rfloor> \<Rightarrow> (true (\<tau>)) - | _ \<Rightarrow> (false (\<tau>))))" -end -overloading OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n \<equiv> "(OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n::(\<cdot>OclAny) \<Rightarrow> _)" -begin - definition OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny : "(x::\<cdot>OclAny) .oclIsTypeOf(Person) \<equiv> (\<lambda>\<tau>. (case (x (\<tau>)) of \<bottom> \<Rightarrow> (invalid (\<tau>)) - | \<lfloor>\<bottom>\<rfloor> \<Rightarrow> (true (\<tau>)) - | \<lfloor>\<lfloor>(mk\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y ((mk\<E>\<X>\<T>\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (_))))\<rfloor>\<rfloor> \<Rightarrow> (true (\<tau>)) - | _ \<Rightarrow> (false (\<tau>))))" -end -overloading OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t \<equiv> "(OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t::(\<cdot>Planet) \<Rightarrow> _)" -begin - definition OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet : "(x::\<cdot>Planet) .oclIsTypeOf(Planet) \<equiv> (\<lambda>\<tau>. (case (x (\<tau>)) of \<bottom> \<Rightarrow> (invalid (\<tau>)) - | \<lfloor>\<bottom>\<rfloor> \<Rightarrow> (true (\<tau>)) - | \<lfloor>\<lfloor>(mk\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t ((mk\<E>\<X>\<T>\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (_) (_) (_) (_))) (_) (_))\<rfloor>\<rfloor> \<Rightarrow> (true (\<tau>)) - | _ \<Rightarrow> (false (\<tau>))))" -end -overloading OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t \<equiv> "(OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t::(\<cdot>Galaxy) \<Rightarrow> _)" -begin - definition OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy : "(x::\<cdot>Galaxy) .oclIsTypeOf(Planet) \<equiv> (\<lambda>\<tau>. (case (x (\<tau>)) of \<bottom> \<Rightarrow> (invalid (\<tau>)) - | \<lfloor>\<bottom>\<rfloor> \<Rightarrow> (true (\<tau>)) - | \<lfloor>\<lfloor>(mk\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y ((mk\<E>\<X>\<T>\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (_))) (_) (_) (_))\<rfloor>\<rfloor> \<Rightarrow> (true (\<tau>)) - | _ \<Rightarrow> (false (\<tau>))))" -end -overloading OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t \<equiv> "(OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t::(\<cdot>OclAny) \<Rightarrow> _)" -begin - definition OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny : "(x::\<cdot>OclAny) .oclIsTypeOf(Planet) \<equiv> (\<lambda>\<tau>. (case (x (\<tau>)) of \<bottom> \<Rightarrow> (invalid (\<tau>)) - | \<lfloor>\<bottom>\<rfloor> \<Rightarrow> (true (\<tau>)) - | \<lfloor>\<lfloor>(mk\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y ((mk\<E>\<X>\<T>\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (_))))\<rfloor>\<rfloor> \<Rightarrow> (true (\<tau>)) - | _ \<Rightarrow> (false (\<tau>))))" -end -overloading OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t \<equiv> "(OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t::(\<cdot>Person) \<Rightarrow> _)" -begin - definition OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person : "(x::\<cdot>Person) .oclIsTypeOf(Planet) \<equiv> (\<lambda>\<tau>. (case (x (\<tau>)) of \<bottom> \<Rightarrow> (invalid (\<tau>)) - | \<lfloor>\<bottom>\<rfloor> \<Rightarrow> (true (\<tau>)) - | _ \<Rightarrow> (false (\<tau>))))" -end -overloading OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y \<equiv> "(OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y::(\<cdot>Galaxy) \<Rightarrow> _)" -begin - definition OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy : "(x::\<cdot>Galaxy) .oclIsTypeOf(Galaxy) \<equiv> (\<lambda>\<tau>. (case (x (\<tau>)) of \<bottom> \<Rightarrow> (invalid (\<tau>)) - | \<lfloor>\<bottom>\<rfloor> \<Rightarrow> (true (\<tau>)) - | \<lfloor>\<lfloor>(mk\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y ((mk\<E>\<X>\<T>\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y (_))) (_) (_) (_))\<rfloor>\<rfloor> \<Rightarrow> (true (\<tau>)) - | _ \<Rightarrow> (false (\<tau>))))" -end -overloading OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y \<equiv> "(OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y::(\<cdot>OclAny) \<Rightarrow> _)" -begin - definition OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny : "(x::\<cdot>OclAny) .oclIsTypeOf(Galaxy) \<equiv> (\<lambda>\<tau>. (case (x (\<tau>)) of \<bottom> \<Rightarrow> (invalid (\<tau>)) - | \<lfloor>\<bottom>\<rfloor> \<Rightarrow> (true (\<tau>)) - | \<lfloor>\<lfloor>(mk\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y ((mk\<E>\<X>\<T>\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y (_))))\<rfloor>\<rfloor> \<Rightarrow> (true (\<tau>)) - | _ \<Rightarrow> (false (\<tau>))))" -end -overloading OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y \<equiv> "(OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y::(\<cdot>Person) \<Rightarrow> _)" -begin - definition OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person : "(x::\<cdot>Person) .oclIsTypeOf(Galaxy) \<equiv> (\<lambda>\<tau>. (case (x (\<tau>)) of \<bottom> \<Rightarrow> (invalid (\<tau>)) - | \<lfloor>\<bottom>\<rfloor> \<Rightarrow> (true (\<tau>)) - | _ \<Rightarrow> (false (\<tau>))))" -end -overloading OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y \<equiv> "(OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y::(\<cdot>Planet) \<Rightarrow> _)" -begin - definition OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet : "(x::\<cdot>Planet) .oclIsTypeOf(Galaxy) \<equiv> (\<lambda>\<tau>. (case (x (\<tau>)) of \<bottom> \<Rightarrow> (invalid (\<tau>)) - | \<lfloor>\<bottom>\<rfloor> \<Rightarrow> (true (\<tau>)) - | _ \<Rightarrow> (false (\<tau>))))" -end -overloading OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y \<equiv> "(OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y::(\<cdot>OclAny) \<Rightarrow> _)" -begin - definition OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny : "(x::\<cdot>OclAny) .oclIsTypeOf(OclAny) \<equiv> (\<lambda>\<tau>. (case (x (\<tau>)) of \<bottom> \<Rightarrow> (invalid (\<tau>)) - | \<lfloor>\<bottom>\<rfloor> \<Rightarrow> (true (\<tau>)) - | \<lfloor>\<lfloor>(mk\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y ((mk\<E>\<X>\<T>\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y (_))))\<rfloor>\<rfloor> \<Rightarrow> (true (\<tau>)) - | _ \<Rightarrow> (false (\<tau>))))" -end -overloading OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y \<equiv> "(OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y::(\<cdot>Person) \<Rightarrow> _)" -begin - definition OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person : "(x::\<cdot>Person) .oclIsTypeOf(OclAny) \<equiv> (\<lambda>\<tau>. (case (x (\<tau>)) of \<bottom> \<Rightarrow> (invalid (\<tau>)) - | \<lfloor>\<bottom>\<rfloor> \<Rightarrow> (true (\<tau>)) - | _ \<Rightarrow> (false (\<tau>))))" -end -overloading OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y \<equiv> "(OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y::(\<cdot>Planet) \<Rightarrow> _)" -begin - definition OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet : "(x::\<cdot>Planet) .oclIsTypeOf(OclAny) \<equiv> (\<lambda>\<tau>. (case (x (\<tau>)) of \<bottom> \<Rightarrow> (invalid (\<tau>)) - | \<lfloor>\<bottom>\<rfloor> \<Rightarrow> (true (\<tau>)) - | _ \<Rightarrow> (false (\<tau>))))" -end -overloading OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y \<equiv> "(OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y::(\<cdot>Galaxy) \<Rightarrow> _)" -begin - definition OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy : "(x::\<cdot>Galaxy) .oclIsTypeOf(OclAny) \<equiv> (\<lambda>\<tau>. (case (x (\<tau>)) of \<bottom> \<Rightarrow> (invalid (\<tau>)) - | \<lfloor>\<bottom>\<rfloor> \<Rightarrow> (true (\<tau>)) - | _ \<Rightarrow> (false (\<tau>))))" -end - -(* 60 ************************************ 277 + 4 *) (* term Floor1_istypeof.print_istypeof_from_universe *) -definition "OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_\<AA> = (\<lambda> (in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (Person)) \<Rightarrow> (((((\<lambda>x _. \<lfloor>\<lfloor>x\<rfloor>\<rfloor>)) (Person))::\<cdot>Person) .oclIsTypeOf(Person)) - | (in\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (Planet)) \<Rightarrow> (((((\<lambda>x _. \<lfloor>\<lfloor>x\<rfloor>\<rfloor>)) (Planet))::\<cdot>Planet) .oclIsTypeOf(Person)) - | (in\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y (Galaxy)) \<Rightarrow> (((((\<lambda>x _. \<lfloor>\<lfloor>x\<rfloor>\<rfloor>)) (Galaxy))::\<cdot>Galaxy) .oclIsTypeOf(Person)) - | (in\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y (OclAny)) \<Rightarrow> (((((\<lambda>x _. \<lfloor>\<lfloor>x\<rfloor>\<rfloor>)) (OclAny))::\<cdot>OclAny) .oclIsTypeOf(Person)))" -definition "OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_\<AA> = (\<lambda> (in\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (Planet)) \<Rightarrow> (((((\<lambda>x _. \<lfloor>\<lfloor>x\<rfloor>\<rfloor>)) (Planet))::\<cdot>Planet) .oclIsTypeOf(Planet)) - | (in\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y (Galaxy)) \<Rightarrow> (((((\<lambda>x _. \<lfloor>\<lfloor>x\<rfloor>\<rfloor>)) (Galaxy))::\<cdot>Galaxy) .oclIsTypeOf(Planet)) - | (in\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y (OclAny)) \<Rightarrow> (((((\<lambda>x _. \<lfloor>\<lfloor>x\<rfloor>\<rfloor>)) (OclAny))::\<cdot>OclAny) .oclIsTypeOf(Planet)) - | (in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (Person)) \<Rightarrow> (((((\<lambda>x _. \<lfloor>\<lfloor>x\<rfloor>\<rfloor>)) (Person))::\<cdot>Person) .oclIsTypeOf(Planet)))" -definition "OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_\<AA> = (\<lambda> (in\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y (Galaxy)) \<Rightarrow> (((((\<lambda>x _. \<lfloor>\<lfloor>x\<rfloor>\<rfloor>)) (Galaxy))::\<cdot>Galaxy) .oclIsTypeOf(Galaxy)) - | (in\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y (OclAny)) \<Rightarrow> (((((\<lambda>x _. \<lfloor>\<lfloor>x\<rfloor>\<rfloor>)) (OclAny))::\<cdot>OclAny) .oclIsTypeOf(Galaxy)) - | (in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (Person)) \<Rightarrow> (((((\<lambda>x _. \<lfloor>\<lfloor>x\<rfloor>\<rfloor>)) (Person))::\<cdot>Person) .oclIsTypeOf(Galaxy)) - | (in\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (Planet)) \<Rightarrow> (((((\<lambda>x _. \<lfloor>\<lfloor>x\<rfloor>\<rfloor>)) (Planet))::\<cdot>Planet) .oclIsTypeOf(Galaxy)))" -definition "OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_\<AA> = (\<lambda> (in\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y (OclAny)) \<Rightarrow> (((((\<lambda>x _. \<lfloor>\<lfloor>x\<rfloor>\<rfloor>)) (OclAny))::\<cdot>OclAny) .oclIsTypeOf(OclAny)) - | (in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (Person)) \<Rightarrow> (((((\<lambda>x _. \<lfloor>\<lfloor>x\<rfloor>\<rfloor>)) (Person))::\<cdot>Person) .oclIsTypeOf(OclAny)) - | (in\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (Planet)) \<Rightarrow> (((((\<lambda>x _. \<lfloor>\<lfloor>x\<rfloor>\<rfloor>)) (Planet))::\<cdot>Planet) .oclIsTypeOf(OclAny)) - | (in\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y (Galaxy)) \<Rightarrow> (((((\<lambda>x _. \<lfloor>\<lfloor>x\<rfloor>\<rfloor>)) (Galaxy))::\<cdot>Galaxy) .oclIsTypeOf(OclAny)))" - -(* 61 ************************************ 281 + 1 *) (* term Floor1_istypeof.print_istypeof_lemmas_id *) -lemmas[simp,code_unfold] = OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person - OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet - OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy - OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny - -(* 62 ************************************ 282 + 1 *) -subsection \<open>Context Passing\<close> - -(* 63 ************************************ 283 + 64 *) (* term Floor1_istypeof.print_istypeof_lemma_cp *) -lemma cp_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_OclAny : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>OclAny)))::\<cdot>OclAny) .oclIsTypeOf(OclAny)))))" -by(rule cpI1, simp) -lemma cp_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy_OclAny : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Galaxy)))::\<cdot>OclAny) .oclIsTypeOf(OclAny)))))" -by(rule cpI1, simp) -lemma cp_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet_OclAny : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Planet)))::\<cdot>OclAny) .oclIsTypeOf(OclAny)))))" -by(rule cpI1, simp) -lemma cp_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_OclAny : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Person)))::\<cdot>OclAny) .oclIsTypeOf(OclAny)))))" -by(rule cpI1, simp) -lemma cp_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_Galaxy : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>OclAny)))::\<cdot>Galaxy) .oclIsTypeOf(OclAny)))))" -by(rule cpI1, simp add: OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy) -lemma cp_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy_Galaxy : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Galaxy)))::\<cdot>Galaxy) .oclIsTypeOf(OclAny)))))" -by(rule cpI1, simp add: OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy) -lemma cp_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet_Galaxy : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Planet)))::\<cdot>Galaxy) .oclIsTypeOf(OclAny)))))" -by(rule cpI1, simp add: OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy) -lemma cp_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_Galaxy : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Person)))::\<cdot>Galaxy) .oclIsTypeOf(OclAny)))))" -by(rule cpI1, simp add: OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy) -lemma cp_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_Planet : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>OclAny)))::\<cdot>Planet) .oclIsTypeOf(OclAny)))))" -by(rule cpI1, simp add: OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet) -lemma cp_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy_Planet : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Galaxy)))::\<cdot>Planet) .oclIsTypeOf(OclAny)))))" -by(rule cpI1, simp add: OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet) -lemma cp_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet_Planet : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Planet)))::\<cdot>Planet) .oclIsTypeOf(OclAny)))))" -by(rule cpI1, simp add: OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet) -lemma cp_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_Planet : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Person)))::\<cdot>Planet) .oclIsTypeOf(OclAny)))))" -by(rule cpI1, simp add: OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet) -lemma cp_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_Person : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>OclAny)))::\<cdot>Person) .oclIsTypeOf(OclAny)))))" -by(rule cpI1, simp add: OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person) -lemma cp_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy_Person : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Galaxy)))::\<cdot>Person) .oclIsTypeOf(OclAny)))))" -by(rule cpI1, simp add: OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person) -lemma cp_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet_Person : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Planet)))::\<cdot>Person) .oclIsTypeOf(OclAny)))))" -by(rule cpI1, simp add: OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person) -lemma cp_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_Person : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Person)))::\<cdot>Person) .oclIsTypeOf(OclAny)))))" -by(rule cpI1, simp add: OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person) -lemma cp_OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny_OclAny : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>OclAny)))::\<cdot>OclAny) .oclIsTypeOf(Galaxy)))))" -by(rule cpI1, simp add: OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny) -lemma cp_OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy_OclAny : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Galaxy)))::\<cdot>OclAny) .oclIsTypeOf(Galaxy)))))" -by(rule cpI1, simp add: OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny) -lemma cp_OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet_OclAny : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Planet)))::\<cdot>OclAny) .oclIsTypeOf(Galaxy)))))" -by(rule cpI1, simp add: OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny) -lemma cp_OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person_OclAny : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Person)))::\<cdot>OclAny) .oclIsTypeOf(Galaxy)))))" -by(rule cpI1, simp add: OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny) -lemma cp_OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny_Galaxy : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>OclAny)))::\<cdot>Galaxy) .oclIsTypeOf(Galaxy)))))" -by(rule cpI1, simp) -lemma cp_OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy_Galaxy : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Galaxy)))::\<cdot>Galaxy) .oclIsTypeOf(Galaxy)))))" -by(rule cpI1, simp) -lemma cp_OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet_Galaxy : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Planet)))::\<cdot>Galaxy) .oclIsTypeOf(Galaxy)))))" -by(rule cpI1, simp) -lemma cp_OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person_Galaxy : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Person)))::\<cdot>Galaxy) .oclIsTypeOf(Galaxy)))))" -by(rule cpI1, simp) -lemma cp_OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny_Planet : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>OclAny)))::\<cdot>Planet) .oclIsTypeOf(Galaxy)))))" -by(rule cpI1, simp add: OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet) -lemma cp_OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy_Planet : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Galaxy)))::\<cdot>Planet) .oclIsTypeOf(Galaxy)))))" -by(rule cpI1, simp add: OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet) -lemma cp_OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet_Planet : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Planet)))::\<cdot>Planet) .oclIsTypeOf(Galaxy)))))" -by(rule cpI1, simp add: OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet) -lemma cp_OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person_Planet : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Person)))::\<cdot>Planet) .oclIsTypeOf(Galaxy)))))" -by(rule cpI1, simp add: OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet) -lemma cp_OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny_Person : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>OclAny)))::\<cdot>Person) .oclIsTypeOf(Galaxy)))))" -by(rule cpI1, simp add: OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person) -lemma cp_OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy_Person : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Galaxy)))::\<cdot>Person) .oclIsTypeOf(Galaxy)))))" -by(rule cpI1, simp add: OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person) -lemma cp_OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet_Person : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Planet)))::\<cdot>Person) .oclIsTypeOf(Galaxy)))))" -by(rule cpI1, simp add: OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person) -lemma cp_OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person_Person : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Person)))::\<cdot>Person) .oclIsTypeOf(Galaxy)))))" -by(rule cpI1, simp add: OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person) -lemma cp_OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny_OclAny : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>OclAny)))::\<cdot>OclAny) .oclIsTypeOf(Planet)))))" -by(rule cpI1, simp add: OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny) -lemma cp_OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy_OclAny : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Galaxy)))::\<cdot>OclAny) .oclIsTypeOf(Planet)))))" -by(rule cpI1, simp add: OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny) -lemma cp_OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet_OclAny : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Planet)))::\<cdot>OclAny) .oclIsTypeOf(Planet)))))" -by(rule cpI1, simp add: OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny) -lemma cp_OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person_OclAny : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Person)))::\<cdot>OclAny) .oclIsTypeOf(Planet)))))" -by(rule cpI1, simp add: OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny) -lemma cp_OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny_Galaxy : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>OclAny)))::\<cdot>Galaxy) .oclIsTypeOf(Planet)))))" -by(rule cpI1, simp add: OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy) -lemma cp_OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy_Galaxy : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Galaxy)))::\<cdot>Galaxy) .oclIsTypeOf(Planet)))))" -by(rule cpI1, simp add: OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy) -lemma cp_OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet_Galaxy : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Planet)))::\<cdot>Galaxy) .oclIsTypeOf(Planet)))))" -by(rule cpI1, simp add: OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy) -lemma cp_OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person_Galaxy : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Person)))::\<cdot>Galaxy) .oclIsTypeOf(Planet)))))" -by(rule cpI1, simp add: OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy) -lemma cp_OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny_Planet : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>OclAny)))::\<cdot>Planet) .oclIsTypeOf(Planet)))))" -by(rule cpI1, simp) -lemma cp_OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy_Planet : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Galaxy)))::\<cdot>Planet) .oclIsTypeOf(Planet)))))" -by(rule cpI1, simp) -lemma cp_OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet_Planet : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Planet)))::\<cdot>Planet) .oclIsTypeOf(Planet)))))" -by(rule cpI1, simp) -lemma cp_OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person_Planet : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Person)))::\<cdot>Planet) .oclIsTypeOf(Planet)))))" -by(rule cpI1, simp) -lemma cp_OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny_Person : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>OclAny)))::\<cdot>Person) .oclIsTypeOf(Planet)))))" -by(rule cpI1, simp add: OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person) -lemma cp_OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy_Person : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Galaxy)))::\<cdot>Person) .oclIsTypeOf(Planet)))))" -by(rule cpI1, simp add: OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person) -lemma cp_OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet_Person : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Planet)))::\<cdot>Person) .oclIsTypeOf(Planet)))))" -by(rule cpI1, simp add: OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person) -lemma cp_OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person_Person : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Person)))::\<cdot>Person) .oclIsTypeOf(Planet)))))" -by(rule cpI1, simp add: OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person) -lemma cp_OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_OclAny : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>OclAny)))::\<cdot>OclAny) .oclIsTypeOf(Person)))))" -by(rule cpI1, simp add: OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny) -lemma cp_OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy_OclAny : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Galaxy)))::\<cdot>OclAny) .oclIsTypeOf(Person)))))" -by(rule cpI1, simp add: OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny) -lemma cp_OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet_OclAny : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Planet)))::\<cdot>OclAny) .oclIsTypeOf(Person)))))" -by(rule cpI1, simp add: OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny) -lemma cp_OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_OclAny : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Person)))::\<cdot>OclAny) .oclIsTypeOf(Person)))))" -by(rule cpI1, simp add: OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny) -lemma cp_OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_Galaxy : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>OclAny)))::\<cdot>Galaxy) .oclIsTypeOf(Person)))))" -by(rule cpI1, simp add: OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy) -lemma cp_OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy_Galaxy : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Galaxy)))::\<cdot>Galaxy) .oclIsTypeOf(Person)))))" -by(rule cpI1, simp add: OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy) -lemma cp_OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet_Galaxy : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Planet)))::\<cdot>Galaxy) .oclIsTypeOf(Person)))))" -by(rule cpI1, simp add: OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy) -lemma cp_OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_Galaxy : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Person)))::\<cdot>Galaxy) .oclIsTypeOf(Person)))))" -by(rule cpI1, simp add: OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy) -lemma cp_OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_Planet : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>OclAny)))::\<cdot>Planet) .oclIsTypeOf(Person)))))" -by(rule cpI1, simp add: OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet) -lemma cp_OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy_Planet : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Galaxy)))::\<cdot>Planet) .oclIsTypeOf(Person)))))" -by(rule cpI1, simp add: OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet) -lemma cp_OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet_Planet : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Planet)))::\<cdot>Planet) .oclIsTypeOf(Person)))))" -by(rule cpI1, simp add: OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet) -lemma cp_OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_Planet : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Person)))::\<cdot>Planet) .oclIsTypeOf(Person)))))" -by(rule cpI1, simp add: OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet) -lemma cp_OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_Person : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>OclAny)))::\<cdot>Person) .oclIsTypeOf(Person)))))" -by(rule cpI1, simp) -lemma cp_OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy_Person : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Galaxy)))::\<cdot>Person) .oclIsTypeOf(Person)))))" -by(rule cpI1, simp) -lemma cp_OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet_Person : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Planet)))::\<cdot>Person) .oclIsTypeOf(Person)))))" -by(rule cpI1, simp) -lemma cp_OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_Person : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Person)))::\<cdot>Person) .oclIsTypeOf(Person)))))" -by(rule cpI1, simp) - -(* 64 ************************************ 347 + 1 *) (* term Floor1_istypeof.print_istypeof_lemmas_cp *) -lemmas[simp,code_unfold] = cp_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_OclAny - cp_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy_OclAny - cp_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet_OclAny - cp_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_OclAny - cp_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_Galaxy - cp_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy_Galaxy - cp_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet_Galaxy - cp_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_Galaxy - cp_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_Planet - cp_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy_Planet - cp_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet_Planet - cp_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_Planet - cp_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_Person - cp_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy_Person - cp_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet_Person - cp_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_Person - cp_OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny_OclAny - cp_OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy_OclAny - cp_OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet_OclAny - cp_OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person_OclAny - cp_OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny_Galaxy - cp_OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy_Galaxy - cp_OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet_Galaxy - cp_OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person_Galaxy - cp_OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny_Planet - cp_OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy_Planet - cp_OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet_Planet - cp_OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person_Planet - cp_OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny_Person - cp_OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy_Person - cp_OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet_Person - cp_OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person_Person - cp_OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny_OclAny - cp_OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy_OclAny - cp_OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet_OclAny - cp_OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person_OclAny - cp_OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny_Galaxy - cp_OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy_Galaxy - cp_OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet_Galaxy - cp_OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person_Galaxy - cp_OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny_Planet - cp_OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy_Planet - cp_OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet_Planet - cp_OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person_Planet - cp_OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny_Person - cp_OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy_Person - cp_OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet_Person - cp_OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person_Person - cp_OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_OclAny - cp_OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy_OclAny - cp_OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet_OclAny - cp_OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_OclAny - cp_OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_Galaxy - cp_OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy_Galaxy - cp_OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet_Galaxy - cp_OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_Galaxy - cp_OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_Planet - cp_OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy_Planet - cp_OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet_Planet - cp_OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_Planet - cp_OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_Person - cp_OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy_Person - cp_OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet_Person - cp_OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_Person - -(* 65 ************************************ 348 + 1 *) -subsection \<open>Execution with Invalid or Null as Argument\<close> - -(* 66 ************************************ 349 + 32 *) (* term Floor1_istypeof.print_istypeof_lemma_strict *) -lemma OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_invalid : "((invalid::\<cdot>OclAny) .oclIsTypeOf(OclAny)) = invalid" -by(rule ext, simp add: bot_option_def invalid_def) -lemma OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy_invalid : "((invalid::\<cdot>Galaxy) .oclIsTypeOf(OclAny)) = invalid" -by(rule ext, simp add: OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy bot_option_def invalid_def) -lemma OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet_invalid : "((invalid::\<cdot>Planet) .oclIsTypeOf(OclAny)) = invalid" -by(rule ext, simp add: OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet bot_option_def invalid_def) -lemma OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_invalid : "((invalid::\<cdot>Person) .oclIsTypeOf(OclAny)) = invalid" -by(rule ext, simp add: OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person bot_option_def invalid_def) -lemma OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_null : "((null::\<cdot>OclAny) .oclIsTypeOf(OclAny)) = true" -by(rule ext, simp add: bot_option_def null_fun_def null_option_def) -lemma OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy_null : "((null::\<cdot>Galaxy) .oclIsTypeOf(OclAny)) = true" -by(rule ext, simp add: OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy bot_option_def null_fun_def null_option_def) -lemma OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet_null : "((null::\<cdot>Planet) .oclIsTypeOf(OclAny)) = true" -by(rule ext, simp add: OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet bot_option_def null_fun_def null_option_def) -lemma OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_null : "((null::\<cdot>Person) .oclIsTypeOf(OclAny)) = true" -by(rule ext, simp add: OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person bot_option_def null_fun_def null_option_def) -lemma OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny_invalid : "((invalid::\<cdot>OclAny) .oclIsTypeOf(Galaxy)) = invalid" -by(rule ext, simp add: OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny bot_option_def invalid_def) -lemma OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy_invalid : "((invalid::\<cdot>Galaxy) .oclIsTypeOf(Galaxy)) = invalid" -by(rule ext, simp add: bot_option_def invalid_def) -lemma OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet_invalid : "((invalid::\<cdot>Planet) .oclIsTypeOf(Galaxy)) = invalid" -by(rule ext, simp add: OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet bot_option_def invalid_def) -lemma OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person_invalid : "((invalid::\<cdot>Person) .oclIsTypeOf(Galaxy)) = invalid" -by(rule ext, simp add: OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person bot_option_def invalid_def) -lemma OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny_null : "((null::\<cdot>OclAny) .oclIsTypeOf(Galaxy)) = true" -by(rule ext, simp add: OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny bot_option_def null_fun_def null_option_def) -lemma OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy_null : "((null::\<cdot>Galaxy) .oclIsTypeOf(Galaxy)) = true" -by(rule ext, simp add: bot_option_def null_fun_def null_option_def) -lemma OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet_null : "((null::\<cdot>Planet) .oclIsTypeOf(Galaxy)) = true" -by(rule ext, simp add: OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet bot_option_def null_fun_def null_option_def) -lemma OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person_null : "((null::\<cdot>Person) .oclIsTypeOf(Galaxy)) = true" -by(rule ext, simp add: OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person bot_option_def null_fun_def null_option_def) -lemma OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny_invalid : "((invalid::\<cdot>OclAny) .oclIsTypeOf(Planet)) = invalid" -by(rule ext, simp add: OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny bot_option_def invalid_def) -lemma OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy_invalid : "((invalid::\<cdot>Galaxy) .oclIsTypeOf(Planet)) = invalid" -by(rule ext, simp add: OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy bot_option_def invalid_def) -lemma OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet_invalid : "((invalid::\<cdot>Planet) .oclIsTypeOf(Planet)) = invalid" -by(rule ext, simp add: bot_option_def invalid_def) -lemma OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person_invalid : "((invalid::\<cdot>Person) .oclIsTypeOf(Planet)) = invalid" -by(rule ext, simp add: OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person bot_option_def invalid_def) -lemma OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny_null : "((null::\<cdot>OclAny) .oclIsTypeOf(Planet)) = true" -by(rule ext, simp add: OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny bot_option_def null_fun_def null_option_def) -lemma OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy_null : "((null::\<cdot>Galaxy) .oclIsTypeOf(Planet)) = true" -by(rule ext, simp add: OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy bot_option_def null_fun_def null_option_def) -lemma OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet_null : "((null::\<cdot>Planet) .oclIsTypeOf(Planet)) = true" -by(rule ext, simp add: bot_option_def null_fun_def null_option_def) -lemma OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person_null : "((null::\<cdot>Person) .oclIsTypeOf(Planet)) = true" -by(rule ext, simp add: OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person bot_option_def null_fun_def null_option_def) -lemma OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_invalid : "((invalid::\<cdot>OclAny) .oclIsTypeOf(Person)) = invalid" -by(rule ext, simp add: OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny bot_option_def invalid_def) -lemma OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy_invalid : "((invalid::\<cdot>Galaxy) .oclIsTypeOf(Person)) = invalid" -by(rule ext, simp add: OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy bot_option_def invalid_def) -lemma OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet_invalid : "((invalid::\<cdot>Planet) .oclIsTypeOf(Person)) = invalid" -by(rule ext, simp add: OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet bot_option_def invalid_def) -lemma OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_invalid : "((invalid::\<cdot>Person) .oclIsTypeOf(Person)) = invalid" -by(rule ext, simp add: bot_option_def invalid_def) -lemma OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_null : "((null::\<cdot>OclAny) .oclIsTypeOf(Person)) = true" -by(rule ext, simp add: OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny bot_option_def null_fun_def null_option_def) -lemma OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy_null : "((null::\<cdot>Galaxy) .oclIsTypeOf(Person)) = true" -by(rule ext, simp add: OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy bot_option_def null_fun_def null_option_def) -lemma OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet_null : "((null::\<cdot>Planet) .oclIsTypeOf(Person)) = true" -by(rule ext, simp add: OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet bot_option_def null_fun_def null_option_def) -lemma OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_null : "((null::\<cdot>Person) .oclIsTypeOf(Person)) = true" -by(rule ext, simp add: bot_option_def null_fun_def null_option_def) - -(* 67 ************************************ 381 + 1 *) (* term Floor1_istypeof.print_istypeof_lemmas_strict *) -lemmas[simp,code_unfold] = OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_invalid - OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy_invalid - OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet_invalid - OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_invalid - OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_null - OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy_null - OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet_null - OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_null - OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny_invalid - OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy_invalid - OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet_invalid - OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person_invalid - OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny_null - OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy_null - OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet_null - OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person_null - OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny_invalid - OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy_invalid - OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet_invalid - OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person_invalid - OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny_null - OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy_null - OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet_null - OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person_null - OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_invalid - OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy_invalid - OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet_invalid - OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_invalid - OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_null - OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy_null - OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet_null - OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_null - -(* 68 ************************************ 382 + 1 *) -subsection \<open>Validity and Definedness Properties\<close> - -(* 69 ************************************ 383 + 16 *) (* term Floor1_istypeof.print_istypeof_defined *) -lemma OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_defined : -assumes isdef: "\<tau> \<Turnstile> (\<upsilon> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Person) .oclIsTypeOf(Person)))" - apply(insert isdef[simplified foundation18'], simp only: OclValid_def, subst cp_defined) -by(auto simp: cp_defined[symmetric ] bot_option_def OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person split: option.split ty\<E>\<X>\<T>\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n.split ty\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n.split) -lemma OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet_defined : -assumes isdef: "\<tau> \<Turnstile> (\<upsilon> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Planet) .oclIsTypeOf(Person)))" - apply(insert isdef[simplified foundation18'], simp only: OclValid_def, subst cp_defined) -by(auto simp: cp_defined[symmetric ] bot_option_def OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet split: option.split ty\<E>\<X>\<T>\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t.split ty\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t.split) -lemma OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy_defined : -assumes isdef: "\<tau> \<Turnstile> (\<upsilon> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Galaxy) .oclIsTypeOf(Person)))" - apply(insert isdef[simplified foundation18'], simp only: OclValid_def, subst cp_defined) -by(auto simp: cp_defined[symmetric ] bot_option_def OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy split: option.split ty\<E>\<X>\<T>\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y.split ty\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y.split) -lemma OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_defined : -assumes isdef: "\<tau> \<Turnstile> (\<upsilon> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>OclAny) .oclIsTypeOf(Person)))" - apply(insert isdef[simplified foundation18'], simp only: OclValid_def, subst cp_defined) -by(auto simp: cp_defined[symmetric ] bot_option_def OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny split: option.split ty\<E>\<X>\<T>\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y.split ty\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y.split) -lemma OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet_defined : -assumes isdef: "\<tau> \<Turnstile> (\<upsilon> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Planet) .oclIsTypeOf(Planet)))" - apply(insert isdef[simplified foundation18'], simp only: OclValid_def, subst cp_defined) -by(auto simp: cp_defined[symmetric ] bot_option_def OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet split: option.split ty\<E>\<X>\<T>\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t.split ty\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t.split) -lemma OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy_defined : -assumes isdef: "\<tau> \<Turnstile> (\<upsilon> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Galaxy) .oclIsTypeOf(Planet)))" - apply(insert isdef[simplified foundation18'], simp only: OclValid_def, subst cp_defined) -by(auto simp: cp_defined[symmetric ] bot_option_def OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy split: option.split ty\<E>\<X>\<T>\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y.split ty\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y.split) -lemma OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny_defined : -assumes isdef: "\<tau> \<Turnstile> (\<upsilon> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>OclAny) .oclIsTypeOf(Planet)))" - apply(insert isdef[simplified foundation18'], simp only: OclValid_def, subst cp_defined) -by(auto simp: cp_defined[symmetric ] bot_option_def OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny split: option.split ty\<E>\<X>\<T>\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y.split ty\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y.split) -lemma OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person_defined : -assumes isdef: "\<tau> \<Turnstile> (\<upsilon> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Person) .oclIsTypeOf(Planet)))" - apply(insert isdef[simplified foundation18'], simp only: OclValid_def, subst cp_defined) -by(auto simp: cp_defined[symmetric ] bot_option_def OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person split: option.split ty\<E>\<X>\<T>\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n.split ty\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n.split) -lemma OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy_defined : -assumes isdef: "\<tau> \<Turnstile> (\<upsilon> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Galaxy) .oclIsTypeOf(Galaxy)))" - apply(insert isdef[simplified foundation18'], simp only: OclValid_def, subst cp_defined) -by(auto simp: cp_defined[symmetric ] bot_option_def OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy split: option.split ty\<E>\<X>\<T>\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y.split ty\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y.split) -lemma OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny_defined : -assumes isdef: "\<tau> \<Turnstile> (\<upsilon> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>OclAny) .oclIsTypeOf(Galaxy)))" - apply(insert isdef[simplified foundation18'], simp only: OclValid_def, subst cp_defined) -by(auto simp: cp_defined[symmetric ] bot_option_def OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny split: option.split ty\<E>\<X>\<T>\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y.split ty\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y.split) -lemma OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person_defined : -assumes isdef: "\<tau> \<Turnstile> (\<upsilon> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Person) .oclIsTypeOf(Galaxy)))" - apply(insert isdef[simplified foundation18'], simp only: OclValid_def, subst cp_defined) -by(auto simp: cp_defined[symmetric ] bot_option_def OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person split: option.split ty\<E>\<X>\<T>\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n.split ty\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n.split) -lemma OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet_defined : -assumes isdef: "\<tau> \<Turnstile> (\<upsilon> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Planet) .oclIsTypeOf(Galaxy)))" - apply(insert isdef[simplified foundation18'], simp only: OclValid_def, subst cp_defined) -by(auto simp: cp_defined[symmetric ] bot_option_def OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet split: option.split ty\<E>\<X>\<T>\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t.split ty\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t.split) -lemma OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_defined : -assumes isdef: "\<tau> \<Turnstile> (\<upsilon> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>OclAny) .oclIsTypeOf(OclAny)))" - apply(insert isdef[simplified foundation18'], simp only: OclValid_def, subst cp_defined) -by(auto simp: cp_defined[symmetric ] bot_option_def OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny split: option.split ty\<E>\<X>\<T>\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y.split ty\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y.split) -lemma OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_defined : -assumes isdef: "\<tau> \<Turnstile> (\<upsilon> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Person) .oclIsTypeOf(OclAny)))" - apply(insert isdef[simplified foundation18'], simp only: OclValid_def, subst cp_defined) -by(auto simp: cp_defined[symmetric ] bot_option_def OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person split: option.split ty\<E>\<X>\<T>\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n.split ty\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n.split) -lemma OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet_defined : -assumes isdef: "\<tau> \<Turnstile> (\<upsilon> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Planet) .oclIsTypeOf(OclAny)))" - apply(insert isdef[simplified foundation18'], simp only: OclValid_def, subst cp_defined) -by(auto simp: cp_defined[symmetric ] bot_option_def OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet split: option.split ty\<E>\<X>\<T>\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t.split ty\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t.split) -lemma OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy_defined : -assumes isdef: "\<tau> \<Turnstile> (\<upsilon> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Galaxy) .oclIsTypeOf(OclAny)))" - apply(insert isdef[simplified foundation18'], simp only: OclValid_def, subst cp_defined) -by(auto simp: cp_defined[symmetric ] bot_option_def OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy split: option.split ty\<E>\<X>\<T>\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y.split ty\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y.split) - -(* 70 ************************************ 399 + 16 *) (* term Floor1_istypeof.print_istypeof_defined' *) -lemma OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_defined' : -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Person) .oclIsTypeOf(Person)))" -by(rule OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_defined[OF isdef[THEN foundation20]]) -lemma OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet_defined' : -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Planet) .oclIsTypeOf(Person)))" -by(rule OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet_defined[OF isdef[THEN foundation20]]) -lemma OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy_defined' : -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Galaxy) .oclIsTypeOf(Person)))" -by(rule OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy_defined[OF isdef[THEN foundation20]]) -lemma OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_defined' : -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>OclAny) .oclIsTypeOf(Person)))" -by(rule OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_defined[OF isdef[THEN foundation20]]) -lemma OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet_defined' : -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Planet) .oclIsTypeOf(Planet)))" -by(rule OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet_defined[OF isdef[THEN foundation20]]) -lemma OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy_defined' : -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Galaxy) .oclIsTypeOf(Planet)))" -by(rule OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy_defined[OF isdef[THEN foundation20]]) -lemma OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny_defined' : -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>OclAny) .oclIsTypeOf(Planet)))" -by(rule OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny_defined[OF isdef[THEN foundation20]]) -lemma OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person_defined' : -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Person) .oclIsTypeOf(Planet)))" -by(rule OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person_defined[OF isdef[THEN foundation20]]) -lemma OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy_defined' : -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Galaxy) .oclIsTypeOf(Galaxy)))" -by(rule OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy_defined[OF isdef[THEN foundation20]]) -lemma OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny_defined' : -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>OclAny) .oclIsTypeOf(Galaxy)))" -by(rule OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny_defined[OF isdef[THEN foundation20]]) -lemma OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person_defined' : -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Person) .oclIsTypeOf(Galaxy)))" -by(rule OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person_defined[OF isdef[THEN foundation20]]) -lemma OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet_defined' : -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Planet) .oclIsTypeOf(Galaxy)))" -by(rule OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet_defined[OF isdef[THEN foundation20]]) -lemma OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_defined' : -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>OclAny) .oclIsTypeOf(OclAny)))" -by(rule OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_defined[OF isdef[THEN foundation20]]) -lemma OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_defined' : -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Person) .oclIsTypeOf(OclAny)))" -by(rule OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_defined[OF isdef[THEN foundation20]]) -lemma OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet_defined' : -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Planet) .oclIsTypeOf(OclAny)))" -by(rule OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet_defined[OF isdef[THEN foundation20]]) -lemma OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy_defined' : -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Galaxy) .oclIsTypeOf(OclAny)))" -by(rule OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy_defined[OF isdef[THEN foundation20]]) - -(* 71 ************************************ 415 + 1 *) -subsection \<open>Up Down Casting\<close> - -(* 72 ************************************ 416 + 6 *) (* term Floor1_istypeof.print_istypeof_up_larger *) -lemma actualType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_larger_staticType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t : -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> ((X::\<cdot>Person) .oclIsTypeOf(Planet)) \<triangleq> false" - using isdef -by(auto simp: OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person foundation22 foundation16 null_option_def bot_option_def) -lemma actualType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_larger_staticType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y : -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> ((X::\<cdot>Person) .oclIsTypeOf(Galaxy)) \<triangleq> false" - using isdef -by(auto simp: OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person foundation22 foundation16 null_option_def bot_option_def) -lemma actualType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_larger_staticType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y : -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> ((X::\<cdot>Person) .oclIsTypeOf(OclAny)) \<triangleq> false" - using isdef -by(auto simp: OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person foundation22 foundation16 null_option_def bot_option_def) -lemma actualType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_larger_staticType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y : -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> ((X::\<cdot>Planet) .oclIsTypeOf(Galaxy)) \<triangleq> false" - using isdef -by(auto simp: OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet foundation22 foundation16 null_option_def bot_option_def) -lemma actualType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_larger_staticType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y : -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> ((X::\<cdot>Planet) .oclIsTypeOf(OclAny)) \<triangleq> false" - using isdef -by(auto simp: OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet foundation22 foundation16 null_option_def bot_option_def) -lemma actualType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_larger_staticType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y : -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> ((X::\<cdot>Galaxy) .oclIsTypeOf(OclAny)) \<triangleq> false" - using isdef -by(auto simp: OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy foundation22 foundation16 null_option_def bot_option_def) - -(* 73 ************************************ 422 + 10 *) (* term Floor1_istypeof.print_istypeof_up_d_cast *) -lemma down_cast_type\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_from_Planet_to_Person : -assumes istyp: "\<tau> \<Turnstile> ((X::\<cdot>Planet) .oclIsTypeOf(Planet))" -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> (X .oclAsType(Person)) \<triangleq> invalid" - using istyp isdef - apply(auto simp: OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet foundation22 foundation16 null_option_def bot_option_def split: ty\<E>\<X>\<T>\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t.split ty\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t.split) -by(simp add: OclValid_def false_def true_def) -lemma down_cast_type\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_from_Galaxy_to_Person : -assumes istyp: "\<tau> \<Turnstile> ((X::\<cdot>Galaxy) .oclIsTypeOf(Galaxy))" -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> (X .oclAsType(Person)) \<triangleq> invalid" - using istyp isdef - apply(auto simp: OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy foundation22 foundation16 null_option_def bot_option_def split: ty\<E>\<X>\<T>\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y.split ty\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y.split) -by(simp add: OclValid_def false_def true_def) -lemma down_cast_type\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_from_OclAny_to_Person : -assumes istyp: "\<tau> \<Turnstile> ((X::\<cdot>OclAny) .oclIsTypeOf(OclAny))" -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> (X .oclAsType(Person)) \<triangleq> invalid" - using istyp isdef - apply(auto simp: OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny foundation22 foundation16 null_option_def bot_option_def split: ty\<E>\<X>\<T>\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y.split ty\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y.split) -by(simp add: OclValid_def false_def true_def) -lemma down_cast_type\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_from_Galaxy_to_Person : -assumes istyp: "\<tau> \<Turnstile> ((X::\<cdot>Galaxy) .oclIsTypeOf(Planet))" -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> (X .oclAsType(Person)) \<triangleq> invalid" - using istyp isdef - apply(auto simp: OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy foundation22 foundation16 null_option_def bot_option_def split: ty\<E>\<X>\<T>\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y.split ty\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y.split) -by(simp add: OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy OclValid_def false_def true_def) -lemma down_cast_type\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_from_OclAny_to_Person : -assumes istyp: "\<tau> \<Turnstile> ((X::\<cdot>OclAny) .oclIsTypeOf(Planet))" -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> (X .oclAsType(Person)) \<triangleq> invalid" - using istyp isdef - apply(auto simp: OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny foundation22 foundation16 null_option_def bot_option_def split: ty\<E>\<X>\<T>\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y.split ty\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y.split) -by(simp add: OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny OclValid_def false_def true_def) -lemma down_cast_type\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_from_OclAny_to_Person : -assumes istyp: "\<tau> \<Turnstile> ((X::\<cdot>OclAny) .oclIsTypeOf(Galaxy))" -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> (X .oclAsType(Person)) \<triangleq> invalid" - using istyp isdef - apply(auto simp: OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny foundation22 foundation16 null_option_def bot_option_def split: ty\<E>\<X>\<T>\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y.split ty\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y.split) -by(simp add: OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny OclValid_def false_def true_def) -lemma down_cast_type\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_from_Galaxy_to_Planet : -assumes istyp: "\<tau> \<Turnstile> ((X::\<cdot>Galaxy) .oclIsTypeOf(Galaxy))" -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> (X .oclAsType(Planet)) \<triangleq> invalid" - using istyp isdef - apply(auto simp: OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy foundation22 foundation16 null_option_def bot_option_def split: ty\<E>\<X>\<T>\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y.split ty\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y.split) -by(simp add: OclValid_def false_def true_def) -lemma down_cast_type\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_from_OclAny_to_Planet : -assumes istyp: "\<tau> \<Turnstile> ((X::\<cdot>OclAny) .oclIsTypeOf(OclAny))" -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> (X .oclAsType(Planet)) \<triangleq> invalid" - using istyp isdef - apply(auto simp: OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny foundation22 foundation16 null_option_def bot_option_def split: ty\<E>\<X>\<T>\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y.split ty\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y.split) -by(simp add: OclValid_def false_def true_def) -lemma down_cast_type\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_from_OclAny_to_Planet : -assumes istyp: "\<tau> \<Turnstile> ((X::\<cdot>OclAny) .oclIsTypeOf(Galaxy))" -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> (X .oclAsType(Planet)) \<triangleq> invalid" - using istyp isdef - apply(auto simp: OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny foundation22 foundation16 null_option_def bot_option_def split: ty\<E>\<X>\<T>\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y.split ty\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y.split) -by(simp add: OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny OclValid_def false_def true_def) -lemma down_cast_type\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_from_OclAny_to_Galaxy : -assumes istyp: "\<tau> \<Turnstile> ((X::\<cdot>OclAny) .oclIsTypeOf(OclAny))" -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> (X .oclAsType(Galaxy)) \<triangleq> invalid" - using istyp isdef - apply(auto simp: OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny foundation22 foundation16 null_option_def bot_option_def split: ty\<E>\<X>\<T>\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y.split ty\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y.split) -by(simp add: OclValid_def false_def true_def) - -(* 74 ************************************ 432 + 1 *) -subsection \<open>Const\<close> - -(* 75 ************************************ 433 + 1 *) -section \<open>Class Model: OclIsKindOf\<close> - -(* 76 ************************************ 434 + 1 *) -subsection \<open>Definition\<close> - -(* 77 ************************************ 435 + 4 *) (* term Floor1_iskindof.print_iskindof_consts *) -consts OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n :: "'\<alpha> \<Rightarrow> Boolean" ("(_) .oclIsKindOf'(Person')") -consts OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t :: "'\<alpha> \<Rightarrow> Boolean" ("(_) .oclIsKindOf'(Planet')") -consts OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y :: "'\<alpha> \<Rightarrow> Boolean" ("(_) .oclIsKindOf'(Galaxy')") -consts OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y :: "'\<alpha> \<Rightarrow> Boolean" ("(_) .oclIsKindOf'(OclAny')") - -(* 78 ************************************ 439 + 16 *) (* term Floor1_iskindof.print_iskindof_class *) -overloading OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n \<equiv> "(OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n::(\<cdot>Person) \<Rightarrow> _)" -begin - definition OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person : "(x::\<cdot>Person) .oclIsKindOf(Person) \<equiv> (x .oclIsTypeOf(Person))" -end -overloading OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n \<equiv> "(OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n::(\<cdot>Planet) \<Rightarrow> _)" -begin - definition OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet : "(x::\<cdot>Planet) .oclIsKindOf(Person) \<equiv> (x .oclIsTypeOf(Person))" -end -overloading OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n \<equiv> "(OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n::(\<cdot>Galaxy) \<Rightarrow> _)" -begin - definition OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy : "(x::\<cdot>Galaxy) .oclIsKindOf(Person) \<equiv> (x .oclIsTypeOf(Person))" -end -overloading OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n \<equiv> "(OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n::(\<cdot>OclAny) \<Rightarrow> _)" -begin - definition OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny : "(x::\<cdot>OclAny) .oclIsKindOf(Person) \<equiv> (x .oclIsTypeOf(Person))" -end -overloading OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t \<equiv> "(OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t::(\<cdot>Planet) \<Rightarrow> _)" -begin - definition OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet : "(x::\<cdot>Planet) .oclIsKindOf(Planet) \<equiv> (x .oclIsTypeOf(Planet)) or (x .oclIsKindOf(Person))" -end -overloading OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t \<equiv> "(OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t::(\<cdot>Galaxy) \<Rightarrow> _)" -begin - definition OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy : "(x::\<cdot>Galaxy) .oclIsKindOf(Planet) \<equiv> (x .oclIsTypeOf(Planet)) or (x .oclIsKindOf(Person))" -end -overloading OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t \<equiv> "(OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t::(\<cdot>OclAny) \<Rightarrow> _)" -begin - definition OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny : "(x::\<cdot>OclAny) .oclIsKindOf(Planet) \<equiv> (x .oclIsTypeOf(Planet)) or (x .oclIsKindOf(Person))" -end -overloading OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t \<equiv> "(OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t::(\<cdot>Person) \<Rightarrow> _)" -begin - definition OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person : "(x::\<cdot>Person) .oclIsKindOf(Planet) \<equiv> (x .oclIsTypeOf(Planet)) or (x .oclIsKindOf(Person))" -end -overloading OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y \<equiv> "(OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y::(\<cdot>Galaxy) \<Rightarrow> _)" -begin - definition OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy : "(x::\<cdot>Galaxy) .oclIsKindOf(Galaxy) \<equiv> (x .oclIsTypeOf(Galaxy)) or (x .oclIsKindOf(Planet))" -end -overloading OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y \<equiv> "(OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y::(\<cdot>OclAny) \<Rightarrow> _)" -begin - definition OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny : "(x::\<cdot>OclAny) .oclIsKindOf(Galaxy) \<equiv> (x .oclIsTypeOf(Galaxy)) or (x .oclIsKindOf(Planet))" -end -overloading OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y \<equiv> "(OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y::(\<cdot>Person) \<Rightarrow> _)" -begin - definition OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person : "(x::\<cdot>Person) .oclIsKindOf(Galaxy) \<equiv> (x .oclIsTypeOf(Galaxy)) or (x .oclIsKindOf(Planet))" -end -overloading OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y \<equiv> "(OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y::(\<cdot>Planet) \<Rightarrow> _)" -begin - definition OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet : "(x::\<cdot>Planet) .oclIsKindOf(Galaxy) \<equiv> (x .oclIsTypeOf(Galaxy)) or (x .oclIsKindOf(Planet))" -end -overloading OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y \<equiv> "(OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y::(\<cdot>OclAny) \<Rightarrow> _)" -begin - definition OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny : "(x::\<cdot>OclAny) .oclIsKindOf(OclAny) \<equiv> (x .oclIsTypeOf(OclAny)) or (x .oclIsKindOf(Galaxy))" -end -overloading OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y \<equiv> "(OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y::(\<cdot>Person) \<Rightarrow> _)" -begin - definition OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person : "(x::\<cdot>Person) .oclIsKindOf(OclAny) \<equiv> (x .oclIsTypeOf(OclAny)) or (x .oclIsKindOf(Galaxy))" -end -overloading OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y \<equiv> "(OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y::(\<cdot>Planet) \<Rightarrow> _)" -begin - definition OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet : "(x::\<cdot>Planet) .oclIsKindOf(OclAny) \<equiv> (x .oclIsTypeOf(OclAny)) or (x .oclIsKindOf(Galaxy))" -end -overloading OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y \<equiv> "(OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y::(\<cdot>Galaxy) \<Rightarrow> _)" -begin - definition OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy : "(x::\<cdot>Galaxy) .oclIsKindOf(OclAny) \<equiv> (x .oclIsTypeOf(OclAny)) or (x .oclIsKindOf(Galaxy))" -end - -(* 79 ************************************ 455 + 4 *) (* term Floor1_iskindof.print_iskindof_from_universe *) -definition "OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_\<AA> = (\<lambda> (in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (Person)) \<Rightarrow> (((((\<lambda>x _. \<lfloor>\<lfloor>x\<rfloor>\<rfloor>)) (Person))::\<cdot>Person) .oclIsKindOf(Person)) - | (in\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (Planet)) \<Rightarrow> (((((\<lambda>x _. \<lfloor>\<lfloor>x\<rfloor>\<rfloor>)) (Planet))::\<cdot>Planet) .oclIsKindOf(Person)) - | (in\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y (Galaxy)) \<Rightarrow> (((((\<lambda>x _. \<lfloor>\<lfloor>x\<rfloor>\<rfloor>)) (Galaxy))::\<cdot>Galaxy) .oclIsKindOf(Person)) - | (in\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y (OclAny)) \<Rightarrow> (((((\<lambda>x _. \<lfloor>\<lfloor>x\<rfloor>\<rfloor>)) (OclAny))::\<cdot>OclAny) .oclIsKindOf(Person)))" -definition "OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_\<AA> = (\<lambda> (in\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (Planet)) \<Rightarrow> (((((\<lambda>x _. \<lfloor>\<lfloor>x\<rfloor>\<rfloor>)) (Planet))::\<cdot>Planet) .oclIsKindOf(Planet)) - | (in\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y (Galaxy)) \<Rightarrow> (((((\<lambda>x _. \<lfloor>\<lfloor>x\<rfloor>\<rfloor>)) (Galaxy))::\<cdot>Galaxy) .oclIsKindOf(Planet)) - | (in\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y (OclAny)) \<Rightarrow> (((((\<lambda>x _. \<lfloor>\<lfloor>x\<rfloor>\<rfloor>)) (OclAny))::\<cdot>OclAny) .oclIsKindOf(Planet)) - | (in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (Person)) \<Rightarrow> (((((\<lambda>x _. \<lfloor>\<lfloor>x\<rfloor>\<rfloor>)) (Person))::\<cdot>Person) .oclIsKindOf(Planet)))" -definition "OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_\<AA> = (\<lambda> (in\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y (Galaxy)) \<Rightarrow> (((((\<lambda>x _. \<lfloor>\<lfloor>x\<rfloor>\<rfloor>)) (Galaxy))::\<cdot>Galaxy) .oclIsKindOf(Galaxy)) - | (in\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y (OclAny)) \<Rightarrow> (((((\<lambda>x _. \<lfloor>\<lfloor>x\<rfloor>\<rfloor>)) (OclAny))::\<cdot>OclAny) .oclIsKindOf(Galaxy)) - | (in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (Person)) \<Rightarrow> (((((\<lambda>x _. \<lfloor>\<lfloor>x\<rfloor>\<rfloor>)) (Person))::\<cdot>Person) .oclIsKindOf(Galaxy)) - | (in\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (Planet)) \<Rightarrow> (((((\<lambda>x _. \<lfloor>\<lfloor>x\<rfloor>\<rfloor>)) (Planet))::\<cdot>Planet) .oclIsKindOf(Galaxy)))" -definition "OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_\<AA> = (\<lambda> (in\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y (OclAny)) \<Rightarrow> (((((\<lambda>x _. \<lfloor>\<lfloor>x\<rfloor>\<rfloor>)) (OclAny))::\<cdot>OclAny) .oclIsKindOf(OclAny)) - | (in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (Person)) \<Rightarrow> (((((\<lambda>x _. \<lfloor>\<lfloor>x\<rfloor>\<rfloor>)) (Person))::\<cdot>Person) .oclIsKindOf(OclAny)) - | (in\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (Planet)) \<Rightarrow> (((((\<lambda>x _. \<lfloor>\<lfloor>x\<rfloor>\<rfloor>)) (Planet))::\<cdot>Planet) .oclIsKindOf(OclAny)) - | (in\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y (Galaxy)) \<Rightarrow> (((((\<lambda>x _. \<lfloor>\<lfloor>x\<rfloor>\<rfloor>)) (Galaxy))::\<cdot>Galaxy) .oclIsKindOf(OclAny)))" - -(* 80 ************************************ 459 + 1 *) (* term Floor1_iskindof.print_iskindof_lemmas_id *) -lemmas[simp,code_unfold] = OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person - OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet - OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy - OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny - -(* 81 ************************************ 460 + 1 *) -subsection \<open>Context Passing\<close> - -(* 82 ************************************ 461 + 64 *) (* term Floor1_iskindof.print_iskindof_lemma_cp *) -lemma cp_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_Person : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Person)))::\<cdot>Person) .oclIsKindOf(Person)))))" -by(simp only: OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person, simp only: cp_OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_Person) -lemma cp_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet_Person : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Planet)))::\<cdot>Person) .oclIsKindOf(Person)))))" -by(simp only: OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person, simp only: cp_OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet_Person) -lemma cp_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy_Person : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Galaxy)))::\<cdot>Person) .oclIsKindOf(Person)))))" -by(simp only: OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person, simp only: cp_OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy_Person) -lemma cp_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_Person : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>OclAny)))::\<cdot>Person) .oclIsKindOf(Person)))))" -by(simp only: OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person, simp only: cp_OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_Person) -lemma cp_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_Planet : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Person)))::\<cdot>Planet) .oclIsKindOf(Person)))))" -by(simp only: OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet, simp only: cp_OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_Planet) -lemma cp_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet_Planet : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Planet)))::\<cdot>Planet) .oclIsKindOf(Person)))))" -by(simp only: OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet, simp only: cp_OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet_Planet) -lemma cp_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy_Planet : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Galaxy)))::\<cdot>Planet) .oclIsKindOf(Person)))))" -by(simp only: OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet, simp only: cp_OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy_Planet) -lemma cp_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_Planet : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>OclAny)))::\<cdot>Planet) .oclIsKindOf(Person)))))" -by(simp only: OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet, simp only: cp_OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_Planet) -lemma cp_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_Galaxy : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Person)))::\<cdot>Galaxy) .oclIsKindOf(Person)))))" -by(simp only: OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy, simp only: cp_OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_Galaxy) -lemma cp_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet_Galaxy : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Planet)))::\<cdot>Galaxy) .oclIsKindOf(Person)))))" -by(simp only: OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy, simp only: cp_OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet_Galaxy) -lemma cp_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy_Galaxy : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Galaxy)))::\<cdot>Galaxy) .oclIsKindOf(Person)))))" -by(simp only: OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy, simp only: cp_OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy_Galaxy) -lemma cp_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_Galaxy : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>OclAny)))::\<cdot>Galaxy) .oclIsKindOf(Person)))))" -by(simp only: OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy, simp only: cp_OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_Galaxy) -lemma cp_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_OclAny : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Person)))::\<cdot>OclAny) .oclIsKindOf(Person)))))" -by(simp only: OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny, simp only: cp_OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_OclAny) -lemma cp_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet_OclAny : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Planet)))::\<cdot>OclAny) .oclIsKindOf(Person)))))" -by(simp only: OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny, simp only: cp_OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet_OclAny) -lemma cp_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy_OclAny : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Galaxy)))::\<cdot>OclAny) .oclIsKindOf(Person)))))" -by(simp only: OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny, simp only: cp_OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy_OclAny) -lemma cp_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_OclAny : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>OclAny)))::\<cdot>OclAny) .oclIsKindOf(Person)))))" -by(simp only: OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny, simp only: cp_OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_OclAny) -lemma cp_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet_Planet : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Planet)))::\<cdot>Planet) .oclIsKindOf(Planet)))))" - apply(simp only: OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet) - apply((rule cpI2[where f = "(or)"], (rule allI)+, rule cp_OclOr)+) - apply(simp only: cp_OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet_Planet) -by(simp only: cp_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet_Planet) -lemma cp_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy_Planet : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Galaxy)))::\<cdot>Planet) .oclIsKindOf(Planet)))))" - apply(simp only: OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet) - apply((rule cpI2[where f = "(or)"], (rule allI)+, rule cp_OclOr)+) - apply(simp only: cp_OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy_Planet) -by(simp only: cp_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy_Planet) -lemma cp_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny_Planet : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>OclAny)))::\<cdot>Planet) .oclIsKindOf(Planet)))))" - apply(simp only: OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet) - apply((rule cpI2[where f = "(or)"], (rule allI)+, rule cp_OclOr)+) - apply(simp only: cp_OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny_Planet) -by(simp only: cp_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_Planet) -lemma cp_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person_Planet : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Person)))::\<cdot>Planet) .oclIsKindOf(Planet)))))" - apply(simp only: OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet) - apply((rule cpI2[where f = "(or)"], (rule allI)+, rule cp_OclOr)+) - apply(simp only: cp_OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person_Planet) -by(simp only: cp_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_Planet) -lemma cp_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet_Galaxy : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Planet)))::\<cdot>Galaxy) .oclIsKindOf(Planet)))))" - apply(simp only: OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy) - apply((rule cpI2[where f = "(or)"], (rule allI)+, rule cp_OclOr)+) - apply(simp only: cp_OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet_Galaxy) -by(simp only: cp_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet_Galaxy) -lemma cp_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy_Galaxy : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Galaxy)))::\<cdot>Galaxy) .oclIsKindOf(Planet)))))" - apply(simp only: OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy) - apply((rule cpI2[where f = "(or)"], (rule allI)+, rule cp_OclOr)+) - apply(simp only: cp_OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy_Galaxy) -by(simp only: cp_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy_Galaxy) -lemma cp_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny_Galaxy : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>OclAny)))::\<cdot>Galaxy) .oclIsKindOf(Planet)))))" - apply(simp only: OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy) - apply((rule cpI2[where f = "(or)"], (rule allI)+, rule cp_OclOr)+) - apply(simp only: cp_OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny_Galaxy) -by(simp only: cp_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_Galaxy) -lemma cp_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person_Galaxy : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Person)))::\<cdot>Galaxy) .oclIsKindOf(Planet)))))" - apply(simp only: OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy) - apply((rule cpI2[where f = "(or)"], (rule allI)+, rule cp_OclOr)+) - apply(simp only: cp_OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person_Galaxy) -by(simp only: cp_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_Galaxy) -lemma cp_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet_OclAny : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Planet)))::\<cdot>OclAny) .oclIsKindOf(Planet)))))" - apply(simp only: OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny) - apply((rule cpI2[where f = "(or)"], (rule allI)+, rule cp_OclOr)+) - apply(simp only: cp_OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet_OclAny) -by(simp only: cp_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet_OclAny) -lemma cp_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy_OclAny : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Galaxy)))::\<cdot>OclAny) .oclIsKindOf(Planet)))))" - apply(simp only: OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny) - apply((rule cpI2[where f = "(or)"], (rule allI)+, rule cp_OclOr)+) - apply(simp only: cp_OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy_OclAny) -by(simp only: cp_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy_OclAny) -lemma cp_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny_OclAny : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>OclAny)))::\<cdot>OclAny) .oclIsKindOf(Planet)))))" - apply(simp only: OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny) - apply((rule cpI2[where f = "(or)"], (rule allI)+, rule cp_OclOr)+) - apply(simp only: cp_OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny_OclAny) -by(simp only: cp_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_OclAny) -lemma cp_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person_OclAny : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Person)))::\<cdot>OclAny) .oclIsKindOf(Planet)))))" - apply(simp only: OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny) - apply((rule cpI2[where f = "(or)"], (rule allI)+, rule cp_OclOr)+) - apply(simp only: cp_OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person_OclAny) -by(simp only: cp_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_OclAny) -lemma cp_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet_Person : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Planet)))::\<cdot>Person) .oclIsKindOf(Planet)))))" - apply(simp only: OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person) - apply((rule cpI2[where f = "(or)"], (rule allI)+, rule cp_OclOr)+) - apply(simp only: cp_OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet_Person) -by(simp only: cp_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet_Person) -lemma cp_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy_Person : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Galaxy)))::\<cdot>Person) .oclIsKindOf(Planet)))))" - apply(simp only: OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person) - apply((rule cpI2[where f = "(or)"], (rule allI)+, rule cp_OclOr)+) - apply(simp only: cp_OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy_Person) -by(simp only: cp_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy_Person) -lemma cp_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny_Person : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>OclAny)))::\<cdot>Person) .oclIsKindOf(Planet)))))" - apply(simp only: OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person) - apply((rule cpI2[where f = "(or)"], (rule allI)+, rule cp_OclOr)+) - apply(simp only: cp_OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny_Person) -by(simp only: cp_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_Person) -lemma cp_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person_Person : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Person)))::\<cdot>Person) .oclIsKindOf(Planet)))))" - apply(simp only: OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person) - apply((rule cpI2[where f = "(or)"], (rule allI)+, rule cp_OclOr)+) - apply(simp only: cp_OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person_Person) -by(simp only: cp_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_Person) -lemma cp_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy_Galaxy : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Galaxy)))::\<cdot>Galaxy) .oclIsKindOf(Galaxy)))))" - apply(simp only: OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy) - apply((rule cpI2[where f = "(or)"], (rule allI)+, rule cp_OclOr)+) - apply(simp only: cp_OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy_Galaxy) -by(simp only: cp_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy_Galaxy) -lemma cp_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny_Galaxy : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>OclAny)))::\<cdot>Galaxy) .oclIsKindOf(Galaxy)))))" - apply(simp only: OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy) - apply((rule cpI2[where f = "(or)"], (rule allI)+, rule cp_OclOr)+) - apply(simp only: cp_OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny_Galaxy) -by(simp only: cp_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny_Galaxy) -lemma cp_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person_Galaxy : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Person)))::\<cdot>Galaxy) .oclIsKindOf(Galaxy)))))" - apply(simp only: OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy) - apply((rule cpI2[where f = "(or)"], (rule allI)+, rule cp_OclOr)+) - apply(simp only: cp_OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person_Galaxy) -by(simp only: cp_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person_Galaxy) -lemma cp_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet_Galaxy : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Planet)))::\<cdot>Galaxy) .oclIsKindOf(Galaxy)))))" - apply(simp only: OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy) - apply((rule cpI2[where f = "(or)"], (rule allI)+, rule cp_OclOr)+) - apply(simp only: cp_OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet_Galaxy) -by(simp only: cp_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet_Galaxy) -lemma cp_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy_OclAny : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Galaxy)))::\<cdot>OclAny) .oclIsKindOf(Galaxy)))))" - apply(simp only: OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny) - apply((rule cpI2[where f = "(or)"], (rule allI)+, rule cp_OclOr)+) - apply(simp only: cp_OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy_OclAny) -by(simp only: cp_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy_OclAny) -lemma cp_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny_OclAny : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>OclAny)))::\<cdot>OclAny) .oclIsKindOf(Galaxy)))))" - apply(simp only: OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny) - apply((rule cpI2[where f = "(or)"], (rule allI)+, rule cp_OclOr)+) - apply(simp only: cp_OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny_OclAny) -by(simp only: cp_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny_OclAny) -lemma cp_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person_OclAny : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Person)))::\<cdot>OclAny) .oclIsKindOf(Galaxy)))))" - apply(simp only: OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny) - apply((rule cpI2[where f = "(or)"], (rule allI)+, rule cp_OclOr)+) - apply(simp only: cp_OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person_OclAny) -by(simp only: cp_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person_OclAny) -lemma cp_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet_OclAny : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Planet)))::\<cdot>OclAny) .oclIsKindOf(Galaxy)))))" - apply(simp only: OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny) - apply((rule cpI2[where f = "(or)"], (rule allI)+, rule cp_OclOr)+) - apply(simp only: cp_OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet_OclAny) -by(simp only: cp_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet_OclAny) -lemma cp_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy_Person : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Galaxy)))::\<cdot>Person) .oclIsKindOf(Galaxy)))))" - apply(simp only: OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person) - apply((rule cpI2[where f = "(or)"], (rule allI)+, rule cp_OclOr)+) - apply(simp only: cp_OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy_Person) -by(simp only: cp_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy_Person) -lemma cp_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny_Person : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>OclAny)))::\<cdot>Person) .oclIsKindOf(Galaxy)))))" - apply(simp only: OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person) - apply((rule cpI2[where f = "(or)"], (rule allI)+, rule cp_OclOr)+) - apply(simp only: cp_OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny_Person) -by(simp only: cp_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny_Person) -lemma cp_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person_Person : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Person)))::\<cdot>Person) .oclIsKindOf(Galaxy)))))" - apply(simp only: OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person) - apply((rule cpI2[where f = "(or)"], (rule allI)+, rule cp_OclOr)+) - apply(simp only: cp_OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person_Person) -by(simp only: cp_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person_Person) -lemma cp_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet_Person : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Planet)))::\<cdot>Person) .oclIsKindOf(Galaxy)))))" - apply(simp only: OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person) - apply((rule cpI2[where f = "(or)"], (rule allI)+, rule cp_OclOr)+) - apply(simp only: cp_OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet_Person) -by(simp only: cp_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet_Person) -lemma cp_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy_Planet : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Galaxy)))::\<cdot>Planet) .oclIsKindOf(Galaxy)))))" - apply(simp only: OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet) - apply((rule cpI2[where f = "(or)"], (rule allI)+, rule cp_OclOr)+) - apply(simp only: cp_OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy_Planet) -by(simp only: cp_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy_Planet) -lemma cp_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny_Planet : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>OclAny)))::\<cdot>Planet) .oclIsKindOf(Galaxy)))))" - apply(simp only: OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet) - apply((rule cpI2[where f = "(or)"], (rule allI)+, rule cp_OclOr)+) - apply(simp only: cp_OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny_Planet) -by(simp only: cp_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny_Planet) -lemma cp_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person_Planet : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Person)))::\<cdot>Planet) .oclIsKindOf(Galaxy)))))" - apply(simp only: OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet) - apply((rule cpI2[where f = "(or)"], (rule allI)+, rule cp_OclOr)+) - apply(simp only: cp_OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person_Planet) -by(simp only: cp_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person_Planet) -lemma cp_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet_Planet : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Planet)))::\<cdot>Planet) .oclIsKindOf(Galaxy)))))" - apply(simp only: OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet) - apply((rule cpI2[where f = "(or)"], (rule allI)+, rule cp_OclOr)+) - apply(simp only: cp_OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet_Planet) -by(simp only: cp_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet_Planet) -lemma cp_OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_OclAny : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>OclAny)))::\<cdot>OclAny) .oclIsKindOf(OclAny)))))" - apply(simp only: OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny) - apply((rule cpI2[where f = "(or)"], (rule allI)+, rule cp_OclOr)+) - apply(simp only: cp_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_OclAny) -by(simp only: cp_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny_OclAny) -lemma cp_OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_OclAny : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Person)))::\<cdot>OclAny) .oclIsKindOf(OclAny)))))" - apply(simp only: OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny) - apply((rule cpI2[where f = "(or)"], (rule allI)+, rule cp_OclOr)+) - apply(simp only: cp_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_OclAny) -by(simp only: cp_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person_OclAny) -lemma cp_OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet_OclAny : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Planet)))::\<cdot>OclAny) .oclIsKindOf(OclAny)))))" - apply(simp only: OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny) - apply((rule cpI2[where f = "(or)"], (rule allI)+, rule cp_OclOr)+) - apply(simp only: cp_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet_OclAny) -by(simp only: cp_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet_OclAny) -lemma cp_OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy_OclAny : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Galaxy)))::\<cdot>OclAny) .oclIsKindOf(OclAny)))))" - apply(simp only: OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny) - apply((rule cpI2[where f = "(or)"], (rule allI)+, rule cp_OclOr)+) - apply(simp only: cp_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy_OclAny) -by(simp only: cp_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy_OclAny) -lemma cp_OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_Person : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>OclAny)))::\<cdot>Person) .oclIsKindOf(OclAny)))))" - apply(simp only: OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person) - apply((rule cpI2[where f = "(or)"], (rule allI)+, rule cp_OclOr)+) - apply(simp only: cp_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_Person) -by(simp only: cp_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny_Person) -lemma cp_OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_Person : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Person)))::\<cdot>Person) .oclIsKindOf(OclAny)))))" - apply(simp only: OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person) - apply((rule cpI2[where f = "(or)"], (rule allI)+, rule cp_OclOr)+) - apply(simp only: cp_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_Person) -by(simp only: cp_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person_Person) -lemma cp_OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet_Person : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Planet)))::\<cdot>Person) .oclIsKindOf(OclAny)))))" - apply(simp only: OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person) - apply((rule cpI2[where f = "(or)"], (rule allI)+, rule cp_OclOr)+) - apply(simp only: cp_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet_Person) -by(simp only: cp_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet_Person) -lemma cp_OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy_Person : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Galaxy)))::\<cdot>Person) .oclIsKindOf(OclAny)))))" - apply(simp only: OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person) - apply((rule cpI2[where f = "(or)"], (rule allI)+, rule cp_OclOr)+) - apply(simp only: cp_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy_Person) -by(simp only: cp_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy_Person) -lemma cp_OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_Planet : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>OclAny)))::\<cdot>Planet) .oclIsKindOf(OclAny)))))" - apply(simp only: OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet) - apply((rule cpI2[where f = "(or)"], (rule allI)+, rule cp_OclOr)+) - apply(simp only: cp_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_Planet) -by(simp only: cp_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny_Planet) -lemma cp_OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_Planet : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Person)))::\<cdot>Planet) .oclIsKindOf(OclAny)))))" - apply(simp only: OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet) - apply((rule cpI2[where f = "(or)"], (rule allI)+, rule cp_OclOr)+) - apply(simp only: cp_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_Planet) -by(simp only: cp_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person_Planet) -lemma cp_OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet_Planet : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Planet)))::\<cdot>Planet) .oclIsKindOf(OclAny)))))" - apply(simp only: OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet) - apply((rule cpI2[where f = "(or)"], (rule allI)+, rule cp_OclOr)+) - apply(simp only: cp_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet_Planet) -by(simp only: cp_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet_Planet) -lemma cp_OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy_Planet : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Galaxy)))::\<cdot>Planet) .oclIsKindOf(OclAny)))))" - apply(simp only: OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet) - apply((rule cpI2[where f = "(or)"], (rule allI)+, rule cp_OclOr)+) - apply(simp only: cp_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy_Planet) -by(simp only: cp_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy_Planet) -lemma cp_OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_Galaxy : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>OclAny)))::\<cdot>Galaxy) .oclIsKindOf(OclAny)))))" - apply(simp only: OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy) - apply((rule cpI2[where f = "(or)"], (rule allI)+, rule cp_OclOr)+) - apply(simp only: cp_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_Galaxy) -by(simp only: cp_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny_Galaxy) -lemma cp_OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_Galaxy : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Person)))::\<cdot>Galaxy) .oclIsKindOf(OclAny)))))" - apply(simp only: OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy) - apply((rule cpI2[where f = "(or)"], (rule allI)+, rule cp_OclOr)+) - apply(simp only: cp_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_Galaxy) -by(simp only: cp_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person_Galaxy) -lemma cp_OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet_Galaxy : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Planet)))::\<cdot>Galaxy) .oclIsKindOf(OclAny)))))" - apply(simp only: OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy) - apply((rule cpI2[where f = "(or)"], (rule allI)+, rule cp_OclOr)+) - apply(simp only: cp_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet_Galaxy) -by(simp only: cp_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet_Galaxy) -lemma cp_OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy_Galaxy : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Galaxy)))::\<cdot>Galaxy) .oclIsKindOf(OclAny)))))" - apply(simp only: OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy) - apply((rule cpI2[where f = "(or)"], (rule allI)+, rule cp_OclOr)+) - apply(simp only: cp_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy_Galaxy) -by(simp only: cp_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy_Galaxy) - -(* 83 ************************************ 525 + 1 *) (* term Floor1_iskindof.print_iskindof_lemmas_cp *) -lemmas[simp,code_unfold] = cp_OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_OclAny - cp_OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy_OclAny - cp_OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet_OclAny - cp_OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_OclAny - cp_OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_Galaxy - cp_OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy_Galaxy - cp_OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet_Galaxy - cp_OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_Galaxy - cp_OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_Planet - cp_OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy_Planet - cp_OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet_Planet - cp_OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_Planet - cp_OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_Person - cp_OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy_Person - cp_OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet_Person - cp_OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_Person - cp_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny_OclAny - cp_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy_OclAny - cp_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet_OclAny - cp_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person_OclAny - cp_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny_Galaxy - cp_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy_Galaxy - cp_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet_Galaxy - cp_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person_Galaxy - cp_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny_Planet - cp_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy_Planet - cp_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet_Planet - cp_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person_Planet - cp_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny_Person - cp_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy_Person - cp_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet_Person - cp_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person_Person - cp_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny_OclAny - cp_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy_OclAny - cp_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet_OclAny - cp_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person_OclAny - cp_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny_Galaxy - cp_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy_Galaxy - cp_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet_Galaxy - cp_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person_Galaxy - cp_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny_Planet - cp_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy_Planet - cp_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet_Planet - cp_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person_Planet - cp_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny_Person - cp_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy_Person - cp_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet_Person - cp_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person_Person - cp_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_OclAny - cp_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy_OclAny - cp_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet_OclAny - cp_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_OclAny - cp_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_Galaxy - cp_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy_Galaxy - cp_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet_Galaxy - cp_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_Galaxy - cp_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_Planet - cp_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy_Planet - cp_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet_Planet - cp_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_Planet - cp_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_Person - cp_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy_Person - cp_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet_Person - cp_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_Person - -(* 84 ************************************ 526 + 1 *) -subsection \<open>Execution with Invalid or Null as Argument\<close> - -(* 85 ************************************ 527 + 32 *) (* term Floor1_iskindof.print_iskindof_lemma_strict *) -lemma OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_invalid : "((invalid::\<cdot>Person) .oclIsKindOf(Person)) = invalid" -by(simp only: OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_invalid) -lemma OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_null : "((null::\<cdot>Person) .oclIsKindOf(Person)) = true" -by(simp only: OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_null) -lemma OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet_invalid : "((invalid::\<cdot>Planet) .oclIsKindOf(Person)) = invalid" -by(simp only: OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet_invalid) -lemma OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet_null : "((null::\<cdot>Planet) .oclIsKindOf(Person)) = true" -by(simp only: OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet_null) -lemma OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy_invalid : "((invalid::\<cdot>Galaxy) .oclIsKindOf(Person)) = invalid" -by(simp only: OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy_invalid) -lemma OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy_null : "((null::\<cdot>Galaxy) .oclIsKindOf(Person)) = true" -by(simp only: OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy_null) -lemma OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_invalid : "((invalid::\<cdot>OclAny) .oclIsKindOf(Person)) = invalid" -by(simp only: OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_invalid) -lemma OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_null : "((null::\<cdot>OclAny) .oclIsKindOf(Person)) = true" -by(simp only: OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_null) -lemma OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet_invalid : "((invalid::\<cdot>Planet) .oclIsKindOf(Planet)) = invalid" -by(simp only: OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet_invalid OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet_invalid, simp) -lemma OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet_null : "((null::\<cdot>Planet) .oclIsKindOf(Planet)) = true" -by(simp only: OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet_null OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet_null, simp) -lemma OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy_invalid : "((invalid::\<cdot>Galaxy) .oclIsKindOf(Planet)) = invalid" -by(simp only: OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy_invalid OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy_invalid, simp) -lemma OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy_null : "((null::\<cdot>Galaxy) .oclIsKindOf(Planet)) = true" -by(simp only: OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy_null OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy_null, simp) -lemma OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny_invalid : "((invalid::\<cdot>OclAny) .oclIsKindOf(Planet)) = invalid" -by(simp only: OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny_invalid OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_invalid, simp) -lemma OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny_null : "((null::\<cdot>OclAny) .oclIsKindOf(Planet)) = true" -by(simp only: OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny_null OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_null, simp) -lemma OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person_invalid : "((invalid::\<cdot>Person) .oclIsKindOf(Planet)) = invalid" -by(simp only: OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person_invalid OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_invalid, simp) -lemma OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person_null : "((null::\<cdot>Person) .oclIsKindOf(Planet)) = true" -by(simp only: OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person_null OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_null, simp) -lemma OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy_invalid : "((invalid::\<cdot>Galaxy) .oclIsKindOf(Galaxy)) = invalid" -by(simp only: OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy_invalid OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy_invalid, simp) -lemma OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy_null : "((null::\<cdot>Galaxy) .oclIsKindOf(Galaxy)) = true" -by(simp only: OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy_null OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy_null, simp) -lemma OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny_invalid : "((invalid::\<cdot>OclAny) .oclIsKindOf(Galaxy)) = invalid" -by(simp only: OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny_invalid OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny_invalid, simp) -lemma OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny_null : "((null::\<cdot>OclAny) .oclIsKindOf(Galaxy)) = true" -by(simp only: OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny_null OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny_null, simp) -lemma OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person_invalid : "((invalid::\<cdot>Person) .oclIsKindOf(Galaxy)) = invalid" -by(simp only: OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person_invalid OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person_invalid, simp) -lemma OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person_null : "((null::\<cdot>Person) .oclIsKindOf(Galaxy)) = true" -by(simp only: OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person_null OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person_null, simp) -lemma OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet_invalid : "((invalid::\<cdot>Planet) .oclIsKindOf(Galaxy)) = invalid" -by(simp only: OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet_invalid OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet_invalid, simp) -lemma OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet_null : "((null::\<cdot>Planet) .oclIsKindOf(Galaxy)) = true" -by(simp only: OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet_null OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet_null, simp) -lemma OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_invalid : "((invalid::\<cdot>OclAny) .oclIsKindOf(OclAny)) = invalid" -by(simp only: OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_invalid OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny_invalid, simp) -lemma OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_null : "((null::\<cdot>OclAny) .oclIsKindOf(OclAny)) = true" -by(simp only: OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_null OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny_null, simp) -lemma OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_invalid : "((invalid::\<cdot>Person) .oclIsKindOf(OclAny)) = invalid" -by(simp only: OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_invalid OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person_invalid, simp) -lemma OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_null : "((null::\<cdot>Person) .oclIsKindOf(OclAny)) = true" -by(simp only: OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_null OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person_null, simp) -lemma OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet_invalid : "((invalid::\<cdot>Planet) .oclIsKindOf(OclAny)) = invalid" -by(simp only: OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet_invalid OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet_invalid, simp) -lemma OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet_null : "((null::\<cdot>Planet) .oclIsKindOf(OclAny)) = true" -by(simp only: OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet_null OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet_null, simp) -lemma OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy_invalid : "((invalid::\<cdot>Galaxy) .oclIsKindOf(OclAny)) = invalid" -by(simp only: OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy_invalid OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy_invalid, simp) -lemma OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy_null : "((null::\<cdot>Galaxy) .oclIsKindOf(OclAny)) = true" -by(simp only: OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy_null OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy_null, simp) - -(* 86 ************************************ 559 + 1 *) (* term Floor1_iskindof.print_iskindof_lemmas_strict *) -lemmas[simp,code_unfold] = OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_invalid - OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy_invalid - OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet_invalid - OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_invalid - OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_null - OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy_null - OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet_null - OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_null - OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny_invalid - OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy_invalid - OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet_invalid - OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person_invalid - OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny_null - OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy_null - OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet_null - OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person_null - OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny_invalid - OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy_invalid - OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet_invalid - OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person_invalid - OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny_null - OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy_null - OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet_null - OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person_null - OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_invalid - OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy_invalid - OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet_invalid - OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_invalid - OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_null - OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy_null - OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet_null - OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_null - -(* 87 ************************************ 560 + 1 *) -subsection \<open>Validity and Definedness Properties\<close> - -(* 88 ************************************ 561 + 16 *) (* term Floor1_iskindof.print_iskindof_defined *) -lemma OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_defined : -assumes isdef: "\<tau> \<Turnstile> (\<upsilon> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Person) .oclIsKindOf(Person)))" -by(simp only: OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person, rule OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_defined[OF isdef]) -lemma OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet_defined : -assumes isdef: "\<tau> \<Turnstile> (\<upsilon> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Planet) .oclIsKindOf(Person)))" -by(simp only: OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet, rule OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet_defined[OF isdef]) -lemma OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy_defined : -assumes isdef: "\<tau> \<Turnstile> (\<upsilon> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Galaxy) .oclIsKindOf(Person)))" -by(simp only: OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy, rule OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy_defined[OF isdef]) -lemma OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_defined : -assumes isdef: "\<tau> \<Turnstile> (\<upsilon> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>OclAny) .oclIsKindOf(Person)))" -by(simp only: OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny, rule OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_defined[OF isdef]) -lemma OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet_defined : -assumes isdef: "\<tau> \<Turnstile> (\<upsilon> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Planet) .oclIsKindOf(Planet)))" -by(simp only: OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet, rule defined_or_I[OF OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet_defined[OF isdef], OF OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet_defined[OF isdef]]) -lemma OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy_defined : -assumes isdef: "\<tau> \<Turnstile> (\<upsilon> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Galaxy) .oclIsKindOf(Planet)))" -by(simp only: OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy, rule defined_or_I[OF OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy_defined[OF isdef], OF OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy_defined[OF isdef]]) -lemma OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny_defined : -assumes isdef: "\<tau> \<Turnstile> (\<upsilon> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>OclAny) .oclIsKindOf(Planet)))" -by(simp only: OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny, rule defined_or_I[OF OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny_defined[OF isdef], OF OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_defined[OF isdef]]) -lemma OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person_defined : -assumes isdef: "\<tau> \<Turnstile> (\<upsilon> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Person) .oclIsKindOf(Planet)))" -by(simp only: OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person, rule defined_or_I[OF OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person_defined[OF isdef], OF OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_defined[OF isdef]]) -lemma OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy_defined : -assumes isdef: "\<tau> \<Turnstile> (\<upsilon> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Galaxy) .oclIsKindOf(Galaxy)))" -by(simp only: OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy, rule defined_or_I[OF OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy_defined[OF isdef], OF OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy_defined[OF isdef]]) -lemma OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny_defined : -assumes isdef: "\<tau> \<Turnstile> (\<upsilon> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>OclAny) .oclIsKindOf(Galaxy)))" -by(simp only: OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny, rule defined_or_I[OF OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny_defined[OF isdef], OF OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny_defined[OF isdef]]) -lemma OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person_defined : -assumes isdef: "\<tau> \<Turnstile> (\<upsilon> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Person) .oclIsKindOf(Galaxy)))" -by(simp only: OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person, rule defined_or_I[OF OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person_defined[OF isdef], OF OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person_defined[OF isdef]]) -lemma OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet_defined : -assumes isdef: "\<tau> \<Turnstile> (\<upsilon> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Planet) .oclIsKindOf(Galaxy)))" -by(simp only: OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet, rule defined_or_I[OF OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet_defined[OF isdef], OF OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet_defined[OF isdef]]) -lemma OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_defined : -assumes isdef: "\<tau> \<Turnstile> (\<upsilon> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>OclAny) .oclIsKindOf(OclAny)))" -by(simp only: OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny, rule defined_or_I[OF OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_defined[OF isdef], OF OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny_defined[OF isdef]]) -lemma OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_defined : -assumes isdef: "\<tau> \<Turnstile> (\<upsilon> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Person) .oclIsKindOf(OclAny)))" -by(simp only: OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person, rule defined_or_I[OF OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_defined[OF isdef], OF OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person_defined[OF isdef]]) -lemma OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet_defined : -assumes isdef: "\<tau> \<Turnstile> (\<upsilon> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Planet) .oclIsKindOf(OclAny)))" -by(simp only: OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet, rule defined_or_I[OF OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet_defined[OF isdef], OF OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet_defined[OF isdef]]) -lemma OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy_defined : -assumes isdef: "\<tau> \<Turnstile> (\<upsilon> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Galaxy) .oclIsKindOf(OclAny)))" -by(simp only: OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy, rule defined_or_I[OF OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy_defined[OF isdef], OF OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy_defined[OF isdef]]) - -(* 89 ************************************ 577 + 16 *) (* term Floor1_iskindof.print_iskindof_defined' *) -lemma OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_defined' : -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Person) .oclIsKindOf(Person)))" -by(rule OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_defined[OF isdef[THEN foundation20]]) -lemma OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet_defined' : -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Planet) .oclIsKindOf(Person)))" -by(rule OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet_defined[OF isdef[THEN foundation20]]) -lemma OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy_defined' : -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Galaxy) .oclIsKindOf(Person)))" -by(rule OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy_defined[OF isdef[THEN foundation20]]) -lemma OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_defined' : -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>OclAny) .oclIsKindOf(Person)))" -by(rule OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_defined[OF isdef[THEN foundation20]]) -lemma OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet_defined' : -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Planet) .oclIsKindOf(Planet)))" -by(rule OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet_defined[OF isdef[THEN foundation20]]) -lemma OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy_defined' : -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Galaxy) .oclIsKindOf(Planet)))" -by(rule OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy_defined[OF isdef[THEN foundation20]]) -lemma OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny_defined' : -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>OclAny) .oclIsKindOf(Planet)))" -by(rule OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny_defined[OF isdef[THEN foundation20]]) -lemma OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person_defined' : -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Person) .oclIsKindOf(Planet)))" -by(rule OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person_defined[OF isdef[THEN foundation20]]) -lemma OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy_defined' : -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Galaxy) .oclIsKindOf(Galaxy)))" -by(rule OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy_defined[OF isdef[THEN foundation20]]) -lemma OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny_defined' : -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>OclAny) .oclIsKindOf(Galaxy)))" -by(rule OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny_defined[OF isdef[THEN foundation20]]) -lemma OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person_defined' : -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Person) .oclIsKindOf(Galaxy)))" -by(rule OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person_defined[OF isdef[THEN foundation20]]) -lemma OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet_defined' : -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Planet) .oclIsKindOf(Galaxy)))" -by(rule OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet_defined[OF isdef[THEN foundation20]]) -lemma OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_defined' : -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>OclAny) .oclIsKindOf(OclAny)))" -by(rule OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_defined[OF isdef[THEN foundation20]]) -lemma OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_defined' : -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Person) .oclIsKindOf(OclAny)))" -by(rule OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_defined[OF isdef[THEN foundation20]]) -lemma OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet_defined' : -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Planet) .oclIsKindOf(OclAny)))" -by(rule OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet_defined[OF isdef[THEN foundation20]]) -lemma OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy_defined' : -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Galaxy) .oclIsKindOf(OclAny)))" -by(rule OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy_defined[OF isdef[THEN foundation20]]) - -(* 90 ************************************ 593 + 1 *) -subsection \<open>Up Down Casting\<close> - -(* 91 ************************************ 594 + 4 *) (* term Floor1_iskindof.print_iskindof_up_eq_asty *) -lemma actual_eq_static\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n : -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> ((X::\<cdot>Person) .oclIsKindOf(Person))" - apply(simp only: OclValid_def, insert isdef) - apply(simp only: OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person) - apply(auto simp: foundation16 bot_option_def split: option.split ty\<E>\<X>\<T>\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n.split ty\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n.split) -by((simp_all add: false_def true_def OclOr_def OclAnd_def OclNot_def)?) -lemma actual_eq_static\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t : -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> ((X::\<cdot>Planet) .oclIsKindOf(Planet))" - apply(simp only: OclValid_def, insert isdef) - apply(simp only: OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet, subst (1) cp_OclOr, simp only: OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet) - apply(auto simp: cp_OclOr[symmetric ] foundation16 bot_option_def OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet split: option.split ty\<E>\<X>\<T>\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t.split ty\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t.split ty\<E>\<X>\<T>\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n.split ty\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n.split) -by((simp_all add: false_def true_def OclOr_def OclAnd_def OclNot_def)?) -lemma actual_eq_static\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y : -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> ((X::\<cdot>Galaxy) .oclIsKindOf(Galaxy))" - apply(simp only: OclValid_def, insert isdef) - apply(simp only: OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy, subst (1) cp_OclOr, simp only: OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy, subst (2 1) cp_OclOr, simp only: OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy) - apply(auto simp: cp_OclOr[symmetric ] foundation16 bot_option_def OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy split: option.split ty\<E>\<X>\<T>\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y.split ty\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y.split ty\<E>\<X>\<T>\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n.split ty\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n.split ty\<E>\<X>\<T>\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t.split ty\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t.split) -by((simp_all add: false_def true_def OclOr_def OclAnd_def OclNot_def)?) -lemma actual_eq_static\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y : -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> ((X::\<cdot>OclAny) .oclIsKindOf(OclAny))" - apply(simp only: OclValid_def, insert isdef) - apply(simp only: OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny, subst (1) cp_OclOr, simp only: OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny, subst (2 1) cp_OclOr, simp only: OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny, subst (3 2 1) cp_OclOr, simp only: OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny) - apply(auto simp: cp_OclOr[symmetric ] foundation16 bot_option_def OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny split: option.split ty\<E>\<X>\<T>\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y.split ty\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y.split ty\<E>\<X>\<T>\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n.split ty\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n.split ty\<E>\<X>\<T>\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t.split ty\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t.split ty\<E>\<X>\<T>\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y.split ty\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y.split) -by((simp_all add: false_def true_def OclOr_def OclAnd_def OclNot_def)?) - -(* 92 ************************************ 598 + 6 *) (* term Floor1_iskindof.print_iskindof_up_larger *) -lemma actualKind\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_larger_staticKind\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t : -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> ((X::\<cdot>Person) .oclIsKindOf(Planet))" - apply(simp only: OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person) -by(rule foundation25', rule actual_eq_static\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n[OF isdef]) -lemma actualKind\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_larger_staticKind\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y : -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> ((X::\<cdot>Person) .oclIsKindOf(Galaxy))" - apply(simp only: OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person) -by(rule foundation25', rule actualKind\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_larger_staticKind\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t[OF isdef]) -lemma actualKind\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_larger_staticKind\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y : -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> ((X::\<cdot>Person) .oclIsKindOf(OclAny))" - apply(simp only: OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person) -by(rule foundation25', rule actualKind\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_larger_staticKind\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y[OF isdef]) -lemma actualKind\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_larger_staticKind\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y : -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> ((X::\<cdot>Planet) .oclIsKindOf(Galaxy))" - apply(simp only: OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet) -by(rule foundation25', rule actual_eq_static\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t[OF isdef]) -lemma actualKind\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_larger_staticKind\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y : -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> ((X::\<cdot>Planet) .oclIsKindOf(OclAny))" - apply(simp only: OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet) -by(rule foundation25', rule actualKind\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_larger_staticKind\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y[OF isdef]) -lemma actualKind\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_larger_staticKind\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y : -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> ((X::\<cdot>Galaxy) .oclIsKindOf(OclAny))" - apply(simp only: OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy) -by(rule foundation25', rule actual_eq_static\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y[OF isdef]) - -(* 93 ************************************ 604 + 6 *) (* term Floor1_iskindof.print_iskindof_up_istypeof_unfold *) -lemma not_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_then_Planet_OclIsTypeOf_others_unfold : -assumes isdef: "(\<tau> \<Turnstile> (\<delta> (X)))" -assumes iskin: "(\<tau> \<Turnstile> ((X::\<cdot>Planet) .oclIsKindOf(Person)))" -shows "(\<tau> \<Turnstile> ((X::\<cdot>Planet) .oclIsTypeOf(Person)))" - using iskin - apply(simp only: OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet) -done -lemma not_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_then_Galaxy_OclIsTypeOf_others_unfold : -assumes isdef: "(\<tau> \<Turnstile> (\<delta> (X)))" -assumes iskin: "(\<tau> \<Turnstile> ((X::\<cdot>Galaxy) .oclIsKindOf(Person)))" -shows "(\<tau> \<Turnstile> ((X::\<cdot>Galaxy) .oclIsTypeOf(Person)))" - using iskin - apply(simp only: OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy) -done -lemma not_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_then_OclAny_OclIsTypeOf_others_unfold : -assumes isdef: "(\<tau> \<Turnstile> (\<delta> (X)))" -assumes iskin: "(\<tau> \<Turnstile> ((X::\<cdot>OclAny) .oclIsKindOf(Person)))" -shows "(\<tau> \<Turnstile> ((X::\<cdot>OclAny) .oclIsTypeOf(Person)))" - using iskin - apply(simp only: OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny) -done -lemma not_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_then_Galaxy_OclIsTypeOf_others_unfold : -assumes isdef: "(\<tau> \<Turnstile> (\<delta> (X)))" -assumes iskin: "(\<tau> \<Turnstile> ((X::\<cdot>Galaxy) .oclIsKindOf(Planet)))" -shows "((\<tau> \<Turnstile> ((X::\<cdot>Galaxy) .oclIsTypeOf(Planet))) \<or> (\<tau> \<Turnstile> ((X::\<cdot>Galaxy) .oclIsTypeOf(Person))))" - using iskin - apply(simp only: OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy) - apply(erule foundation26[OF OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy_defined'[OF isdef], OF OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy_defined'[OF isdef]]) - apply(simp) - apply(drule not_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_then_Galaxy_OclIsTypeOf_others_unfold[OF isdef], blast) -done -lemma not_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_then_OclAny_OclIsTypeOf_others_unfold : -assumes isdef: "(\<tau> \<Turnstile> (\<delta> (X)))" -assumes iskin: "(\<tau> \<Turnstile> ((X::\<cdot>OclAny) .oclIsKindOf(Planet)))" -shows "((\<tau> \<Turnstile> ((X::\<cdot>OclAny) .oclIsTypeOf(Planet))) \<or> (\<tau> \<Turnstile> ((X::\<cdot>OclAny) .oclIsTypeOf(Person))))" - using iskin - apply(simp only: OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny) - apply(erule foundation26[OF OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny_defined'[OF isdef], OF OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_defined'[OF isdef]]) - apply(simp) - apply(drule not_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_then_OclAny_OclIsTypeOf_others_unfold[OF isdef], blast) -done -lemma not_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_then_OclAny_OclIsTypeOf_others_unfold : -assumes isdef: "(\<tau> \<Turnstile> (\<delta> (X)))" -assumes iskin: "(\<tau> \<Turnstile> ((X::\<cdot>OclAny) .oclIsKindOf(Galaxy)))" -shows "((\<tau> \<Turnstile> ((X::\<cdot>OclAny) .oclIsTypeOf(Galaxy))) \<or> ((\<tau> \<Turnstile> ((X::\<cdot>OclAny) .oclIsTypeOf(Person))) \<or> (\<tau> \<Turnstile> ((X::\<cdot>OclAny) .oclIsTypeOf(Planet)))))" - using iskin - apply(simp only: OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny) - apply(erule foundation26[OF OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny_defined'[OF isdef], OF OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny_defined'[OF isdef]]) - apply(simp) - apply(drule not_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_then_OclAny_OclIsTypeOf_others_unfold[OF isdef], blast) -done - -(* 94 ************************************ 610 + 6 *) (* term Floor1_iskindof.print_iskindof_up_istypeof *) -lemma not_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_then_Planet_OclIsTypeOf_others : -assumes iskin: "\<not> \<tau> \<Turnstile> ((X::\<cdot>Planet) .oclIsKindOf(Person))" -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> ((X::\<cdot>Planet) .oclIsTypeOf(Planet))" - using actual_eq_static\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t[OF isdef] - apply(simp only: OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet) - apply(erule foundation26[OF OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet_defined'[OF isdef], OF OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet_defined'[OF isdef]]) - apply(simp) - apply(simp add: iskin) -done -lemma not_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_then_Galaxy_OclIsTypeOf_others : -assumes iskin: "\<not> \<tau> \<Turnstile> ((X::\<cdot>Galaxy) .oclIsKindOf(Person))" -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "(\<tau> \<Turnstile> ((X::\<cdot>Galaxy) .oclIsTypeOf(Galaxy)) \<or> \<tau> \<Turnstile> ((X::\<cdot>Galaxy) .oclIsTypeOf(Planet)))" - using actual_eq_static\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y[OF isdef] - apply(simp only: OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy) - apply(erule foundation26[OF OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy_defined'[OF isdef], OF OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy_defined'[OF isdef]]) - apply(simp) - apply(simp only: OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy) - apply(erule foundation26[OF OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy_defined'[OF isdef], OF OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy_defined'[OF isdef]]) - apply(simp) - apply(simp add: iskin) -done -lemma not_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_then_OclAny_OclIsTypeOf_others : -assumes iskin: "\<not> \<tau> \<Turnstile> ((X::\<cdot>OclAny) .oclIsKindOf(Person))" -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "(\<tau> \<Turnstile> ((X::\<cdot>OclAny) .oclIsTypeOf(OclAny)) \<or> (\<tau> \<Turnstile> ((X::\<cdot>OclAny) .oclIsTypeOf(Galaxy)) \<or> \<tau> \<Turnstile> ((X::\<cdot>OclAny) .oclIsTypeOf(Planet))))" - using actual_eq_static\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y[OF isdef] - apply(simp only: OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny) - apply(erule foundation26[OF OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_defined'[OF isdef], OF OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny_defined'[OF isdef]]) - apply(simp) - apply(simp only: OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny) - apply(erule foundation26[OF OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny_defined'[OF isdef], OF OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny_defined'[OF isdef]]) - apply(simp) - apply(simp only: OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny) - apply(erule foundation26[OF OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny_defined'[OF isdef], OF OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_defined'[OF isdef]]) - apply(simp) - apply(simp add: iskin) -done -lemma not_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_then_Galaxy_OclIsTypeOf_others : -assumes iskin: "\<not> \<tau> \<Turnstile> ((X::\<cdot>Galaxy) .oclIsKindOf(Planet))" -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> ((X::\<cdot>Galaxy) .oclIsTypeOf(Galaxy))" - using actual_eq_static\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y[OF isdef] - apply(simp only: OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy) - apply(erule foundation26[OF OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy_defined'[OF isdef], OF OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy_defined'[OF isdef]]) - apply(simp) - apply(simp add: iskin) -done -lemma not_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_then_OclAny_OclIsTypeOf_others : -assumes iskin: "\<not> \<tau> \<Turnstile> ((X::\<cdot>OclAny) .oclIsKindOf(Planet))" -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "(\<tau> \<Turnstile> ((X::\<cdot>OclAny) .oclIsTypeOf(OclAny)) \<or> \<tau> \<Turnstile> ((X::\<cdot>OclAny) .oclIsTypeOf(Galaxy)))" - using actual_eq_static\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y[OF isdef] - apply(simp only: OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny) - apply(erule foundation26[OF OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_defined'[OF isdef], OF OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny_defined'[OF isdef]]) - apply(simp) - apply(simp only: OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny) - apply(erule foundation26[OF OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny_defined'[OF isdef], OF OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny_defined'[OF isdef]]) - apply(simp) - apply(simp add: iskin) -done -lemma not_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_then_OclAny_OclIsTypeOf_others : -assumes iskin: "\<not> \<tau> \<Turnstile> ((X::\<cdot>OclAny) .oclIsKindOf(Galaxy))" -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> ((X::\<cdot>OclAny) .oclIsTypeOf(OclAny))" - using actual_eq_static\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y[OF isdef] - apply(simp only: OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny) - apply(erule foundation26[OF OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_defined'[OF isdef], OF OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny_defined'[OF isdef]]) - apply(simp) - apply(simp add: iskin) -done - -(* 95 ************************************ 616 + 10 *) (* term Floor1_iskindof.print_iskindof_up_d_cast *) -lemma down_cast_kind\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_from_Planet_to_Person : -assumes iskin: "\<not> \<tau> \<Turnstile> ((X::\<cdot>Planet) .oclIsKindOf(Person))" -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> (X .oclAsType(Person)) \<triangleq> invalid" - apply(insert not_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_then_Planet_OclIsTypeOf_others[OF iskin, OF isdef]) - apply(rule down_cast_type\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_from_Planet_to_Person, simp only: , simp only: isdef) -done -lemma down_cast_kind\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_from_Galaxy_to_Person : -assumes iskin: "\<not> \<tau> \<Turnstile> ((X::\<cdot>Galaxy) .oclIsKindOf(Person))" -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> (X .oclAsType(Person)) \<triangleq> invalid" - apply(insert not_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_then_Galaxy_OclIsTypeOf_others[OF iskin, OF isdef], elim disjE) - apply(rule down_cast_type\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_from_Galaxy_to_Person, simp only: , simp only: isdef) - apply(rule down_cast_type\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_from_Galaxy_to_Person, simp only: , simp only: isdef) -done -lemma down_cast_kind\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_from_OclAny_to_Person : -assumes iskin: "\<not> \<tau> \<Turnstile> ((X::\<cdot>OclAny) .oclIsKindOf(Person))" -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> (X .oclAsType(Person)) \<triangleq> invalid" - apply(insert not_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_then_OclAny_OclIsTypeOf_others[OF iskin, OF isdef], elim disjE) - apply(rule down_cast_type\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_from_OclAny_to_Person, simp only: , simp only: isdef) - apply(rule down_cast_type\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_from_OclAny_to_Person, simp only: , simp only: isdef) - apply(rule down_cast_type\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_from_OclAny_to_Person, simp only: , simp only: isdef) -done -lemma down_cast_kind\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_from_Galaxy_to_Planet : -assumes iskin: "\<not> \<tau> \<Turnstile> ((X::\<cdot>Galaxy) .oclIsKindOf(Planet))" -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> (X .oclAsType(Planet)) \<triangleq> invalid" - apply(insert not_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_then_Galaxy_OclIsTypeOf_others[OF iskin, OF isdef]) - apply(rule down_cast_type\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_from_Galaxy_to_Planet, simp only: , simp only: isdef) -done -lemma down_cast_kind\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_from_Galaxy_to_Person : -assumes iskin: "\<not> \<tau> \<Turnstile> ((X::\<cdot>Galaxy) .oclIsKindOf(Planet))" -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> (X .oclAsType(Person)) \<triangleq> invalid" - apply(insert not_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_then_Galaxy_OclIsTypeOf_others[OF iskin, OF isdef]) - apply(rule down_cast_type\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_from_Galaxy_to_Person, simp only: , simp only: isdef) -done -lemma down_cast_kind\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_from_OclAny_to_Planet : -assumes iskin: "\<not> \<tau> \<Turnstile> ((X::\<cdot>OclAny) .oclIsKindOf(Planet))" -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> (X .oclAsType(Planet)) \<triangleq> invalid" - apply(insert not_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_then_OclAny_OclIsTypeOf_others[OF iskin, OF isdef], elim disjE) - apply(rule down_cast_type\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_from_OclAny_to_Planet, simp only: , simp only: isdef) - apply(rule down_cast_type\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_from_OclAny_to_Planet, simp only: , simp only: isdef) -done -lemma down_cast_kind\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_from_OclAny_to_Person : -assumes iskin: "\<not> \<tau> \<Turnstile> ((X::\<cdot>OclAny) .oclIsKindOf(Planet))" -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> (X .oclAsType(Person)) \<triangleq> invalid" - apply(insert not_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_then_OclAny_OclIsTypeOf_others[OF iskin, OF isdef], elim disjE) - apply(rule down_cast_type\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_from_OclAny_to_Person, simp only: , simp only: isdef) - apply(rule down_cast_type\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_from_OclAny_to_Person, simp only: , simp only: isdef) -done -lemma down_cast_kind\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_from_OclAny_to_Galaxy : -assumes iskin: "\<not> \<tau> \<Turnstile> ((X::\<cdot>OclAny) .oclIsKindOf(Galaxy))" -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> (X .oclAsType(Galaxy)) \<triangleq> invalid" - apply(insert not_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_then_OclAny_OclIsTypeOf_others[OF iskin, OF isdef]) - apply(rule down_cast_type\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_from_OclAny_to_Galaxy, simp only: , simp only: isdef) -done -lemma down_cast_kind\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_from_OclAny_to_Person : -assumes iskin: "\<not> \<tau> \<Turnstile> ((X::\<cdot>OclAny) .oclIsKindOf(Galaxy))" -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> (X .oclAsType(Person)) \<triangleq> invalid" - apply(insert not_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_then_OclAny_OclIsTypeOf_others[OF iskin, OF isdef]) - apply(rule down_cast_type\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_from_OclAny_to_Person, simp only: , simp only: isdef) -done -lemma down_cast_kind\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_from_OclAny_to_Planet : -assumes iskin: "\<not> \<tau> \<Turnstile> ((X::\<cdot>OclAny) .oclIsKindOf(Galaxy))" -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> (X .oclAsType(Planet)) \<triangleq> invalid" - apply(insert not_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_then_OclAny_OclIsTypeOf_others[OF iskin, OF isdef]) - apply(rule down_cast_type\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_from_OclAny_to_Planet, simp only: , simp only: isdef) -done - -(* 96 ************************************ 626 + 1 *) -subsection \<open>Const\<close> - -(* 97 ************************************ 627 + 1 *) -section \<open>Class Model: OclAllInstances\<close> - -(* 98 ************************************ 628 + 1 *) -text \<open> - To denote \OCL-types occurring in \OCL expressions syntactically---as, for example, as -``argument'' of \inlineisar{oclAllInstances()}---we use the inverses of the injection -functions into the object universes; we show that this is sufficient ``characterization.'' \<close> - -(* 99 ************************************ 629 + 4 *) (* term Floor1_allinst.print_allinst_def_id *) -definition "Person = OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_\<AA>" -definition "Planet = OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_\<AA>" -definition "Galaxy = OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_\<AA>" -definition "OclAny = OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_\<AA>" - -(* 100 ************************************ 633 + 1 *) (* term Floor1_allinst.print_allinst_lemmas_id *) -lemmas[simp,code_unfold] = Person_def - Planet_def - Galaxy_def - OclAny_def - -(* 101 ************************************ 634 + 1 *) (* term Floor1_allinst.print_allinst_astype *) -lemma OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_\<AA>_some : "(OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_\<AA> (x)) \<noteq> None" -by(simp add: OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_\<AA>_def) - -(* 102 ************************************ 635 + 3 *) (* term Floor1_allinst.print_allinst_exec *) -lemma OclAllInstances_generic\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_exec : -shows "(OclAllInstances_generic (pre_post) (OclAny)) = (\<lambda>\<tau>. (Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (\<lfloor>\<lfloor>Some ` OclAny ` (ran ((heap ((pre_post (\<tau>))))))\<rfloor>\<rfloor>)))" - proof - let ?S1 = "(\<lambda>\<tau>. OclAny ` (ran ((heap ((pre_post (\<tau>)))))))" show ?thesis - proof - let ?S2 = "(\<lambda>\<tau>. ((?S1) (\<tau>)) - {None})" show ?thesis - proof - have B: "(\<And>\<tau>. ((?S2) (\<tau>)) \<subseteq> ((?S1) (\<tau>)))" by(auto) show ?thesis - proof - have C: "(\<And>\<tau>. ((?S1) (\<tau>)) \<subseteq> ((?S2) (\<tau>)))" by(auto simp: OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_\<AA>_some) show ?thesis - apply(simp add: OclValid_def del: OclAllInstances_generic_def OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny) -by(insert equalityI[OF B, OF C], simp) qed qed qed qed -lemma OclAllInstances_at_post\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_exec : -shows "(OclAllInstances_at_post (OclAny)) = (\<lambda>\<tau>. (Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (\<lfloor>\<lfloor>Some ` OclAny ` (ran ((heap ((snd (\<tau>))))))\<rfloor>\<rfloor>)))" - unfolding OclAllInstances_at_post_def -by(rule OclAllInstances_generic\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_exec) -lemma OclAllInstances_at_pre\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_exec : -shows "(OclAllInstances_at_pre (OclAny)) = (\<lambda>\<tau>. (Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (\<lfloor>\<lfloor>Some ` OclAny ` (ran ((heap ((fst (\<tau>))))))\<rfloor>\<rfloor>)))" - unfolding OclAllInstances_at_pre_def -by(rule OclAllInstances_generic\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_exec) - -(* 103 ************************************ 638 + 1 *) -subsection \<open>OclIsTypeOf\<close> - -(* 104 ************************************ 639 + 2 *) (* term Floor1_allinst.print_allinst_istypeof_pre *) -lemma ex_ssubst : "(\<forall>x \<in> B. (s (x)) = (t (x))) \<Longrightarrow> (\<exists>x \<in> B. (P ((s (x))))) = (\<exists>x \<in> B. (P ((t (x)))))" -by(simp) -lemma ex_def : "x \<in> \<lceil>\<lceil>\<lfloor>\<lfloor>Some ` (X - {None})\<rfloor>\<rfloor>\<rceil>\<rceil> \<Longrightarrow> (\<exists>y. x = \<lfloor>\<lfloor>y\<rfloor>\<rfloor>)" -by(auto) - -(* 105 ************************************ 641 + 21 *) (* term Floor1_allinst.print_allinst_istypeof *) -lemma Person_OclAllInstances_generic_OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n : "\<tau> \<Turnstile> (UML_Set.OclForall ((OclAllInstances_generic (pre_post) (Person))) (OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))" - apply(simp add: OclValid_def del: OclAllInstances_generic_def) - apply(simp only: UML_Set.OclForall_def refl if_True OclAllInstances_generic_defined[simplified OclValid_def]) - apply(simp only: OclAllInstances_generic_def) - apply(subst (1 2 3) Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inverse, simp add: bot_option_def) - apply(subst (1 2 3) ex_ssubst[where s = "(\<lambda>x. (((\<lambda>_. x) .oclIsTypeOf(Person)) (\<tau>)))" and t = "(\<lambda>_. (true (\<tau>)))"]) - apply(intro ballI actual_eq_static\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n[simplified OclValid_def, simplified OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person]) - apply(drule ex_def, erule exE, simp) -by(simp) -lemma Person_OclAllInstances_at_post_OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n : -shows "\<tau> \<Turnstile> (UML_Set.OclForall ((OclAllInstances_at_post (Person))) (OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))" - unfolding OclAllInstances_at_post_def -by(rule Person_OclAllInstances_generic_OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n) -lemma Person_OclAllInstances_at_pre_OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n : -shows "\<tau> \<Turnstile> (UML_Set.OclForall ((OclAllInstances_at_pre (Person))) (OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))" - unfolding OclAllInstances_at_pre_def -by(rule Person_OclAllInstances_generic_OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n) -lemma Planet_OclAllInstances_generic_OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t1 : -assumes [simp]: "(\<And>x. (pre_post ((x , x))) = x)" -shows "(\<exists>\<tau>. \<tau> \<Turnstile> (UML_Set.OclForall ((OclAllInstances_generic (pre_post) (Planet))) (OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t)))" - apply(rule exI[where x = "\<tau>\<^sub>0"], simp add: \<tau>\<^sub>0_def OclValid_def del: OclAllInstances_generic_def) - apply(simp only: UML_Set.OclForall_def refl if_True OclAllInstances_generic_defined[simplified OclValid_def]) - apply(simp only: OclAllInstances_generic_def) - apply(subst (1 2 3) Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inverse, simp add: bot_option_def) -by(simp) -lemma Planet_OclAllInstances_at_post_OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t1 : -shows "(\<exists>\<tau>. \<tau> \<Turnstile> (UML_Set.OclForall ((OclAllInstances_at_post (Planet))) (OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t)))" - unfolding OclAllInstances_at_post_def -by(rule Planet_OclAllInstances_generic_OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t1, simp) -lemma Planet_OclAllInstances_at_pre_OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t1 : -shows "(\<exists>\<tau>. \<tau> \<Turnstile> (UML_Set.OclForall ((OclAllInstances_at_pre (Planet))) (OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t)))" - unfolding OclAllInstances_at_pre_def -by(rule Planet_OclAllInstances_generic_OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t1, simp) -lemma Planet_OclAllInstances_generic_OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t2 : -assumes [simp]: "(\<And>x. (pre_post ((x , x))) = x)" -shows "(\<exists>\<tau>. \<tau> \<Turnstile> (not ((UML_Set.OclForall ((OclAllInstances_generic (pre_post) (Planet))) (OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t)))))" - proof - fix oid a show ?thesis - proof - let ?t0 = "(state.make ((Map.empty (oid \<mapsto> (in\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t ((mk\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t ((mk\<E>\<X>\<T>\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (a))) (None) (None))))))) (Map.empty))" show ?thesis - apply(rule exI[where x = "(?t0 , ?t0)"], simp add: OclValid_def del: OclAllInstances_generic_def) - apply(simp only: UML_Set.OclForall_def refl if_True OclAllInstances_generic_defined[simplified OclValid_def]) - apply(simp only: OclAllInstances_generic_def OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_\<AA>_def) - apply(subst (1 2 3) Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inverse, simp add: bot_option_def) -by(simp add: state.make_def OclNot_def) qed qed -lemma Planet_OclAllInstances_at_post_OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t2 : -shows "(\<exists>\<tau>. \<tau> \<Turnstile> (not ((UML_Set.OclForall ((OclAllInstances_at_post (Planet))) (OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t)))))" - unfolding OclAllInstances_at_post_def -by(rule Planet_OclAllInstances_generic_OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t2, simp) -lemma Planet_OclAllInstances_at_pre_OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t2 : -shows "(\<exists>\<tau>. \<tau> \<Turnstile> (not ((UML_Set.OclForall ((OclAllInstances_at_pre (Planet))) (OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t)))))" - unfolding OclAllInstances_at_pre_def -by(rule Planet_OclAllInstances_generic_OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t2, simp) -lemma Galaxy_OclAllInstances_generic_OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y1 : -assumes [simp]: "(\<And>x. (pre_post ((x , x))) = x)" -shows "(\<exists>\<tau>. \<tau> \<Turnstile> (UML_Set.OclForall ((OclAllInstances_generic (pre_post) (Galaxy))) (OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y)))" - apply(rule exI[where x = "\<tau>\<^sub>0"], simp add: \<tau>\<^sub>0_def OclValid_def del: OclAllInstances_generic_def) - apply(simp only: UML_Set.OclForall_def refl if_True OclAllInstances_generic_defined[simplified OclValid_def]) - apply(simp only: OclAllInstances_generic_def) - apply(subst (1 2 3) Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inverse, simp add: bot_option_def) -by(simp) -lemma Galaxy_OclAllInstances_at_post_OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y1 : -shows "(\<exists>\<tau>. \<tau> \<Turnstile> (UML_Set.OclForall ((OclAllInstances_at_post (Galaxy))) (OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y)))" - unfolding OclAllInstances_at_post_def -by(rule Galaxy_OclAllInstances_generic_OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y1, simp) -lemma Galaxy_OclAllInstances_at_pre_OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y1 : -shows "(\<exists>\<tau>. \<tau> \<Turnstile> (UML_Set.OclForall ((OclAllInstances_at_pre (Galaxy))) (OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y)))" - unfolding OclAllInstances_at_pre_def -by(rule Galaxy_OclAllInstances_generic_OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y1, simp) -lemma Galaxy_OclAllInstances_generic_OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y2 : -assumes [simp]: "(\<And>x. (pre_post ((x , x))) = x)" -shows "(\<exists>\<tau>. \<tau> \<Turnstile> (not ((UML_Set.OclForall ((OclAllInstances_generic (pre_post) (Galaxy))) (OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y)))))" - proof - fix oid a show ?thesis - proof - let ?t0 = "(state.make ((Map.empty (oid \<mapsto> (in\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y ((mk\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y ((mk\<E>\<X>\<T>\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (a))) (None) (None) (None))))))) (Map.empty))" show ?thesis - apply(rule exI[where x = "(?t0 , ?t0)"], simp add: OclValid_def del: OclAllInstances_generic_def) - apply(simp only: UML_Set.OclForall_def refl if_True OclAllInstances_generic_defined[simplified OclValid_def]) - apply(simp only: OclAllInstances_generic_def OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_\<AA>_def) - apply(subst (1 2 3) Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inverse, simp add: bot_option_def) -by(simp add: state.make_def OclNot_def) qed qed -lemma Galaxy_OclAllInstances_at_post_OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y2 : -shows "(\<exists>\<tau>. \<tau> \<Turnstile> (not ((UML_Set.OclForall ((OclAllInstances_at_post (Galaxy))) (OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y)))))" - unfolding OclAllInstances_at_post_def -by(rule Galaxy_OclAllInstances_generic_OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y2, simp) -lemma Galaxy_OclAllInstances_at_pre_OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y2 : -shows "(\<exists>\<tau>. \<tau> \<Turnstile> (not ((UML_Set.OclForall ((OclAllInstances_at_pre (Galaxy))) (OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y)))))" - unfolding OclAllInstances_at_pre_def -by(rule Galaxy_OclAllInstances_generic_OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y2, simp) -lemma OclAny_OclAllInstances_generic_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y1 : -assumes [simp]: "(\<And>x. (pre_post ((x , x))) = x)" -shows "(\<exists>\<tau>. \<tau> \<Turnstile> (UML_Set.OclForall ((OclAllInstances_generic (pre_post) (OclAny))) (OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y)))" - apply(rule exI[where x = "\<tau>\<^sub>0"], simp add: \<tau>\<^sub>0_def OclValid_def del: OclAllInstances_generic_def) - apply(simp only: UML_Set.OclForall_def refl if_True OclAllInstances_generic_defined[simplified OclValid_def]) - apply(simp only: OclAllInstances_generic_def) - apply(subst (1 2 3) Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inverse, simp add: bot_option_def) -by(simp) -lemma OclAny_OclAllInstances_at_post_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y1 : -shows "(\<exists>\<tau>. \<tau> \<Turnstile> (UML_Set.OclForall ((OclAllInstances_at_post (OclAny))) (OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y)))" - unfolding OclAllInstances_at_post_def -by(rule OclAny_OclAllInstances_generic_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y1, simp) -lemma OclAny_OclAllInstances_at_pre_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y1 : -shows "(\<exists>\<tau>. \<tau> \<Turnstile> (UML_Set.OclForall ((OclAllInstances_at_pre (OclAny))) (OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y)))" - unfolding OclAllInstances_at_pre_def -by(rule OclAny_OclAllInstances_generic_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y1, simp) -lemma OclAny_OclAllInstances_generic_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y2 : -assumes [simp]: "(\<And>x. (pre_post ((x , x))) = x)" -shows "(\<exists>\<tau>. \<tau> \<Turnstile> (not ((UML_Set.OclForall ((OclAllInstances_generic (pre_post) (OclAny))) (OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y)))))" - proof - fix oid a show ?thesis - proof - let ?t0 = "(state.make ((Map.empty (oid \<mapsto> (in\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y ((mk\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y ((mk\<E>\<X>\<T>\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y (a))))))))) (Map.empty))" show ?thesis - apply(rule exI[where x = "(?t0 , ?t0)"], simp add: OclValid_def del: OclAllInstances_generic_def) - apply(simp only: UML_Set.OclForall_def refl if_True OclAllInstances_generic_defined[simplified OclValid_def]) - apply(simp only: OclAllInstances_generic_def OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_\<AA>_def) - apply(subst (1 2 3) Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inverse, simp add: bot_option_def) -by(simp add: state.make_def OclNot_def) qed qed -lemma OclAny_OclAllInstances_at_post_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y2 : -shows "(\<exists>\<tau>. \<tau> \<Turnstile> (not ((UML_Set.OclForall ((OclAllInstances_at_post (OclAny))) (OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y)))))" - unfolding OclAllInstances_at_post_def -by(rule OclAny_OclAllInstances_generic_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y2, simp) -lemma OclAny_OclAllInstances_at_pre_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y2 : -shows "(\<exists>\<tau>. \<tau> \<Turnstile> (not ((UML_Set.OclForall ((OclAllInstances_at_pre (OclAny))) (OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y)))))" - unfolding OclAllInstances_at_pre_def -by(rule OclAny_OclAllInstances_generic_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y2, simp) - -(* 106 ************************************ 662 + 1 *) -subsection \<open>OclIsKindOf\<close> - -(* 107 ************************************ 663 + 12 *) (* term Floor1_allinst.print_allinst_iskindof_eq *) -lemma Person_OclAllInstances_generic_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n : "\<tau> \<Turnstile> (UML_Set.OclForall ((OclAllInstances_generic (pre_post) (Person))) (OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))" - apply(simp add: OclValid_def del: OclAllInstances_generic_def OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person) - apply(simp only: UML_Set.OclForall_def refl if_True OclAllInstances_generic_defined[simplified OclValid_def]) - apply(simp only: OclAllInstances_generic_def) - apply(subst (1 2 3) Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inverse, simp add: bot_option_def) - apply(subst (1 2 3) ex_ssubst[where s = "(\<lambda>x. (((\<lambda>_. x) .oclIsKindOf(Person)) (\<tau>)))" and t = "(\<lambda>_. (true (\<tau>)))"]) - apply(intro ballI actual_eq_static\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n[simplified OclValid_def]) - apply(drule ex_def, erule exE, simp) -by(simp) -lemma Person_OclAllInstances_at_post_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n : -shows "\<tau> \<Turnstile> (UML_Set.OclForall ((OclAllInstances_at_post (Person))) (OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))" - unfolding OclAllInstances_at_post_def -by(rule Person_OclAllInstances_generic_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n) -lemma Person_OclAllInstances_at_pre_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n : -shows "\<tau> \<Turnstile> (UML_Set.OclForall ((OclAllInstances_at_pre (Person))) (OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))" - unfolding OclAllInstances_at_pre_def -by(rule Person_OclAllInstances_generic_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n) -lemma Planet_OclAllInstances_generic_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t : "\<tau> \<Turnstile> (UML_Set.OclForall ((OclAllInstances_generic (pre_post) (Planet))) (OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t))" - apply(simp add: OclValid_def del: OclAllInstances_generic_def OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet) - apply(simp only: UML_Set.OclForall_def refl if_True OclAllInstances_generic_defined[simplified OclValid_def]) - apply(simp only: OclAllInstances_generic_def) - apply(subst (1 2 3) Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inverse, simp add: bot_option_def) - apply(subst (1 2 3) ex_ssubst[where s = "(\<lambda>x. (((\<lambda>_. x) .oclIsKindOf(Planet)) (\<tau>)))" and t = "(\<lambda>_. (true (\<tau>)))"]) - apply(intro ballI actual_eq_static\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t[simplified OclValid_def]) - apply(drule ex_def, erule exE, simp) -by(simp) -lemma Planet_OclAllInstances_at_post_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t : -shows "\<tau> \<Turnstile> (UML_Set.OclForall ((OclAllInstances_at_post (Planet))) (OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t))" - unfolding OclAllInstances_at_post_def -by(rule Planet_OclAllInstances_generic_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t) -lemma Planet_OclAllInstances_at_pre_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t : -shows "\<tau> \<Turnstile> (UML_Set.OclForall ((OclAllInstances_at_pre (Planet))) (OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t))" - unfolding OclAllInstances_at_pre_def -by(rule Planet_OclAllInstances_generic_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t) -lemma Galaxy_OclAllInstances_generic_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y : "\<tau> \<Turnstile> (UML_Set.OclForall ((OclAllInstances_generic (pre_post) (Galaxy))) (OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y))" - apply(simp add: OclValid_def del: OclAllInstances_generic_def OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy) - apply(simp only: UML_Set.OclForall_def refl if_True OclAllInstances_generic_defined[simplified OclValid_def]) - apply(simp only: OclAllInstances_generic_def) - apply(subst (1 2 3) Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inverse, simp add: bot_option_def) - apply(subst (1 2 3) ex_ssubst[where s = "(\<lambda>x. (((\<lambda>_. x) .oclIsKindOf(Galaxy)) (\<tau>)))" and t = "(\<lambda>_. (true (\<tau>)))"]) - apply(intro ballI actual_eq_static\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y[simplified OclValid_def]) - apply(drule ex_def, erule exE, simp) -by(simp) -lemma Galaxy_OclAllInstances_at_post_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y : -shows "\<tau> \<Turnstile> (UML_Set.OclForall ((OclAllInstances_at_post (Galaxy))) (OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y))" - unfolding OclAllInstances_at_post_def -by(rule Galaxy_OclAllInstances_generic_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y) -lemma Galaxy_OclAllInstances_at_pre_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y : -shows "\<tau> \<Turnstile> (UML_Set.OclForall ((OclAllInstances_at_pre (Galaxy))) (OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y))" - unfolding OclAllInstances_at_pre_def -by(rule Galaxy_OclAllInstances_generic_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y) -lemma OclAny_OclAllInstances_generic_OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y : "\<tau> \<Turnstile> (UML_Set.OclForall ((OclAllInstances_generic (pre_post) (OclAny))) (OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y))" - apply(simp add: OclValid_def del: OclAllInstances_generic_def OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny) - apply(simp only: UML_Set.OclForall_def refl if_True OclAllInstances_generic_defined[simplified OclValid_def]) - apply(simp only: OclAllInstances_generic_def) - apply(subst (1 2 3) Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inverse, simp add: bot_option_def) - apply(subst (1 2 3) ex_ssubst[where s = "(\<lambda>x. (((\<lambda>_. x) .oclIsKindOf(OclAny)) (\<tau>)))" and t = "(\<lambda>_. (true (\<tau>)))"]) - apply(intro ballI actual_eq_static\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y[simplified OclValid_def]) - apply(drule ex_def, erule exE, simp) -by(simp) -lemma OclAny_OclAllInstances_at_post_OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y : -shows "\<tau> \<Turnstile> (UML_Set.OclForall ((OclAllInstances_at_post (OclAny))) (OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y))" - unfolding OclAllInstances_at_post_def -by(rule OclAny_OclAllInstances_generic_OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y) -lemma OclAny_OclAllInstances_at_pre_OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y : -shows "\<tau> \<Turnstile> (UML_Set.OclForall ((OclAllInstances_at_pre (OclAny))) (OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y))" - unfolding OclAllInstances_at_pre_def -by(rule OclAny_OclAllInstances_generic_OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y) - -(* 108 ************************************ 675 + 18 *) (* term Floor1_allinst.print_allinst_iskindof_larger *) -lemma Person_OclAllInstances_generic_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t : "\<tau> \<Turnstile> (UML_Set.OclForall ((OclAllInstances_generic (pre_post) (Person))) (OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t))" - apply(simp add: OclValid_def del: OclAllInstances_generic_def OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person) - apply(simp only: UML_Set.OclForall_def refl if_True OclAllInstances_generic_defined[simplified OclValid_def]) - apply(simp only: OclAllInstances_generic_def) - apply(subst (1 2 3) Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inverse, simp add: bot_option_def) - apply(subst (1 2 3) ex_ssubst[where s = "(\<lambda>x. (((\<lambda>_. x) .oclIsKindOf(Planet)) (\<tau>)))" and t = "(\<lambda>_. (true (\<tau>)))"]) - apply(intro ballI actualKind\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_larger_staticKind\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t[simplified OclValid_def]) - apply(drule ex_def, erule exE, simp) -by(simp) -lemma Person_OclAllInstances_at_post_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t : -shows "\<tau> \<Turnstile> (UML_Set.OclForall ((OclAllInstances_at_post (Person))) (OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t))" - unfolding OclAllInstances_at_post_def -by(rule Person_OclAllInstances_generic_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t) -lemma Person_OclAllInstances_at_pre_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t : -shows "\<tau> \<Turnstile> (UML_Set.OclForall ((OclAllInstances_at_pre (Person))) (OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t))" - unfolding OclAllInstances_at_pre_def -by(rule Person_OclAllInstances_generic_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t) -lemma Person_OclAllInstances_generic_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y : "\<tau> \<Turnstile> (UML_Set.OclForall ((OclAllInstances_generic (pre_post) (Person))) (OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y))" - apply(simp add: OclValid_def del: OclAllInstances_generic_def OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person) - apply(simp only: UML_Set.OclForall_def refl if_True OclAllInstances_generic_defined[simplified OclValid_def]) - apply(simp only: OclAllInstances_generic_def) - apply(subst (1 2 3) Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inverse, simp add: bot_option_def) - apply(subst (1 2 3) ex_ssubst[where s = "(\<lambda>x. (((\<lambda>_. x) .oclIsKindOf(Galaxy)) (\<tau>)))" and t = "(\<lambda>_. (true (\<tau>)))"]) - apply(intro ballI actualKind\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_larger_staticKind\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y[simplified OclValid_def]) - apply(drule ex_def, erule exE, simp) -by(simp) -lemma Person_OclAllInstances_at_post_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y : -shows "\<tau> \<Turnstile> (UML_Set.OclForall ((OclAllInstances_at_post (Person))) (OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y))" - unfolding OclAllInstances_at_post_def -by(rule Person_OclAllInstances_generic_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y) -lemma Person_OclAllInstances_at_pre_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y : -shows "\<tau> \<Turnstile> (UML_Set.OclForall ((OclAllInstances_at_pre (Person))) (OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y))" - unfolding OclAllInstances_at_pre_def -by(rule Person_OclAllInstances_generic_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y) -lemma Person_OclAllInstances_generic_OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y : "\<tau> \<Turnstile> (UML_Set.OclForall ((OclAllInstances_generic (pre_post) (Person))) (OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y))" - apply(simp add: OclValid_def del: OclAllInstances_generic_def OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person) - apply(simp only: UML_Set.OclForall_def refl if_True OclAllInstances_generic_defined[simplified OclValid_def]) - apply(simp only: OclAllInstances_generic_def) - apply(subst (1 2 3) Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inverse, simp add: bot_option_def) - apply(subst (1 2 3) ex_ssubst[where s = "(\<lambda>x. (((\<lambda>_. x) .oclIsKindOf(OclAny)) (\<tau>)))" and t = "(\<lambda>_. (true (\<tau>)))"]) - apply(intro ballI actualKind\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_larger_staticKind\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y[simplified OclValid_def]) - apply(drule ex_def, erule exE, simp) -by(simp) -lemma Person_OclAllInstances_at_post_OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y : -shows "\<tau> \<Turnstile> (UML_Set.OclForall ((OclAllInstances_at_post (Person))) (OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y))" - unfolding OclAllInstances_at_post_def -by(rule Person_OclAllInstances_generic_OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y) -lemma Person_OclAllInstances_at_pre_OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y : -shows "\<tau> \<Turnstile> (UML_Set.OclForall ((OclAllInstances_at_pre (Person))) (OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y))" - unfolding OclAllInstances_at_pre_def -by(rule Person_OclAllInstances_generic_OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y) -lemma Planet_OclAllInstances_generic_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y : "\<tau> \<Turnstile> (UML_Set.OclForall ((OclAllInstances_generic (pre_post) (Planet))) (OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y))" - apply(simp add: OclValid_def del: OclAllInstances_generic_def OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet) - apply(simp only: UML_Set.OclForall_def refl if_True OclAllInstances_generic_defined[simplified OclValid_def]) - apply(simp only: OclAllInstances_generic_def) - apply(subst (1 2 3) Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inverse, simp add: bot_option_def) - apply(subst (1 2 3) ex_ssubst[where s = "(\<lambda>x. (((\<lambda>_. x) .oclIsKindOf(Galaxy)) (\<tau>)))" and t = "(\<lambda>_. (true (\<tau>)))"]) - apply(intro ballI actualKind\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_larger_staticKind\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y[simplified OclValid_def]) - apply(drule ex_def, erule exE, simp) -by(simp) -lemma Planet_OclAllInstances_at_post_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y : -shows "\<tau> \<Turnstile> (UML_Set.OclForall ((OclAllInstances_at_post (Planet))) (OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y))" - unfolding OclAllInstances_at_post_def -by(rule Planet_OclAllInstances_generic_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y) -lemma Planet_OclAllInstances_at_pre_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y : -shows "\<tau> \<Turnstile> (UML_Set.OclForall ((OclAllInstances_at_pre (Planet))) (OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y))" - unfolding OclAllInstances_at_pre_def -by(rule Planet_OclAllInstances_generic_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y) -lemma Planet_OclAllInstances_generic_OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y : "\<tau> \<Turnstile> (UML_Set.OclForall ((OclAllInstances_generic (pre_post) (Planet))) (OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y))" - apply(simp add: OclValid_def del: OclAllInstances_generic_def OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet) - apply(simp only: UML_Set.OclForall_def refl if_True OclAllInstances_generic_defined[simplified OclValid_def]) - apply(simp only: OclAllInstances_generic_def) - apply(subst (1 2 3) Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inverse, simp add: bot_option_def) - apply(subst (1 2 3) ex_ssubst[where s = "(\<lambda>x. (((\<lambda>_. x) .oclIsKindOf(OclAny)) (\<tau>)))" and t = "(\<lambda>_. (true (\<tau>)))"]) - apply(intro ballI actualKind\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_larger_staticKind\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y[simplified OclValid_def]) - apply(drule ex_def, erule exE, simp) -by(simp) -lemma Planet_OclAllInstances_at_post_OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y : -shows "\<tau> \<Turnstile> (UML_Set.OclForall ((OclAllInstances_at_post (Planet))) (OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y))" - unfolding OclAllInstances_at_post_def -by(rule Planet_OclAllInstances_generic_OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y) -lemma Planet_OclAllInstances_at_pre_OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y : -shows "\<tau> \<Turnstile> (UML_Set.OclForall ((OclAllInstances_at_pre (Planet))) (OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y))" - unfolding OclAllInstances_at_pre_def -by(rule Planet_OclAllInstances_generic_OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y) -lemma Galaxy_OclAllInstances_generic_OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y : "\<tau> \<Turnstile> (UML_Set.OclForall ((OclAllInstances_generic (pre_post) (Galaxy))) (OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y))" - apply(simp add: OclValid_def del: OclAllInstances_generic_def OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy) - apply(simp only: UML_Set.OclForall_def refl if_True OclAllInstances_generic_defined[simplified OclValid_def]) - apply(simp only: OclAllInstances_generic_def) - apply(subst (1 2 3) Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inverse, simp add: bot_option_def) - apply(subst (1 2 3) ex_ssubst[where s = "(\<lambda>x. (((\<lambda>_. x) .oclIsKindOf(OclAny)) (\<tau>)))" and t = "(\<lambda>_. (true (\<tau>)))"]) - apply(intro ballI actualKind\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_larger_staticKind\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y[simplified OclValid_def]) - apply(drule ex_def, erule exE, simp) -by(simp) -lemma Galaxy_OclAllInstances_at_post_OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y : -shows "\<tau> \<Turnstile> (UML_Set.OclForall ((OclAllInstances_at_post (Galaxy))) (OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y))" - unfolding OclAllInstances_at_post_def -by(rule Galaxy_OclAllInstances_generic_OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y) -lemma Galaxy_OclAllInstances_at_pre_OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y : -shows "\<tau> \<Turnstile> (UML_Set.OclForall ((OclAllInstances_at_pre (Galaxy))) (OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y))" - unfolding OclAllInstances_at_pre_def -by(rule Galaxy_OclAllInstances_generic_OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y) - -(* 109 ************************************ 693 + 1 *) -section \<open>Class Model: The Accessors\<close> - -(* 110 ************************************ 694 + 1 *) -text \<open>\<close> - -(* 111 ************************************ 695 + 1 *) -text \<open> - \label{sec:Employee-AnalysisModel-UMLPart-generatedeam-accessors}\<close> - -(* 112 ************************************ 696 + 1 *) -subsection \<open>Definition\<close> - -(* 113 ************************************ 697 + 1 *) -text \<open> - We start with a oid for the association; this oid can be used -in presence of association classes to represent the association inside an object, -pretty much similar to the \inlineisar+Employee_DesignModel_UMLPart+, where we stored -an \verb+oid+ inside the class as ``pointer.'' \<close> - -(* 114 ************************************ 698 + 1 *) (* term Floor1_access.print_access_oid_uniq_ml *) -ML \<open>val oidPerson_0_boss = 0\<close> - -(* 115 ************************************ 699 + 1 *) (* term Floor1_access.print_access_oid_uniq *) -definition "oid\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_0___boss = 0" - -(* 116 ************************************ 700 + 1 *) -text \<open> - From there on, we can already define an empty state which must contain -for $\mathit{oid}_{Person}\mathcal{BOSS}$ the empty relation (encoded as association list, since there are -associations with a Sequence-like structure).\<close> - -(* 117 ************************************ 701 + 5 *) (* term Floor1_access.print_access_eval_extract *) -definition "eval_extract x f = (\<lambda>\<tau>. (case x \<tau> of \<lfloor>\<lfloor>obj\<rfloor>\<rfloor> \<Rightarrow> (f ((oid_of (obj))) (\<tau>)) - | _ \<Rightarrow> invalid \<tau>))" -definition "in_pre_state = fst" -definition "in_post_state = snd" -definition "reconst_basetype = (\<lambda>x _. \<lfloor>\<lfloor>x\<rfloor>\<rfloor>)" -definition "reconst_basetype\<^sub>V\<^sub>o\<^sub>i\<^sub>d x = Abs_Void\<^sub>b\<^sub>a\<^sub>s\<^sub>e o (reconst_basetype (x))" - -(* 118 ************************************ 706 + 1 *) -text \<open> - The @{text pre_post}-parameter is configured with @{text fst} or -@{text snd}, the @{text to_from}-parameter either with the identity @{term id} or -the following combinator @{text switch}: \<close> - -(* 119 ************************************ 707 + 2 *) (* term Floor1_access.print_access_choose_ml *) -ML \<open>val switch2_01 = (fn [x0 , x1] => (x0 , x1))\<close> -ML \<open>val switch2_10 = (fn [x0 , x1] => (x1 , x0))\<close> - -(* 120 ************************************ 709 + 3 *) (* term Floor1_access.print_access_choose *) -definition "switch\<^sub>2_01 = (\<lambda> [x0 , x1] \<Rightarrow> (x0 , x1))" -definition "switch\<^sub>2_10 = (\<lambda> [x0 , x1] \<Rightarrow> (x1 , x0))" -definition "deref_assocs pre_post to_from assoc_oid f oid = (\<lambda>\<tau>. (case (assocs ((pre_post (\<tau>))) (assoc_oid)) of \<lfloor>S\<rfloor> \<Rightarrow> (f ((deref_assocs_list (to_from) (oid) (S))) (\<tau>)) - | _ \<Rightarrow> (invalid (\<tau>))))" - -(* 121 ************************************ 712 + 4 *) (* term Floor1_access.print_access_deref_oid *) -definition "deref_oid\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n fst_snd f oid = (\<lambda>\<tau>. (case (heap (fst_snd \<tau>) (oid)) of \<lfloor>in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n obj\<rfloor> \<Rightarrow> f obj \<tau> - | _ \<Rightarrow> invalid \<tau>))" -definition "deref_oid\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t fst_snd f oid = (\<lambda>\<tau>. (case (heap (fst_snd \<tau>) (oid)) of \<lfloor>in\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t obj\<rfloor> \<Rightarrow> f obj \<tau> - | _ \<Rightarrow> invalid \<tau>))" -definition "deref_oid\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y fst_snd f oid = (\<lambda>\<tau>. (case (heap (fst_snd \<tau>) (oid)) of \<lfloor>in\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y obj\<rfloor> \<Rightarrow> f obj \<tau> - | _ \<Rightarrow> invalid \<tau>))" -definition "deref_oid\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y fst_snd f oid = (\<lambda>\<tau>. (case (heap (fst_snd \<tau>) (oid)) of \<lfloor>in\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y obj\<rfloor> \<Rightarrow> f obj \<tau> - | _ \<Rightarrow> invalid \<tau>))" - -(* 122 ************************************ 716 + 1 *) (* term Floor1_access.print_access_deref_assocs *) -definition "deref_assocs\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_0___boss fst_snd f = (deref_assocs (fst_snd) (switch\<^sub>2_01) (oid\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_0___boss) (f)) \<circ> oid_of" - -(* 123 ************************************ 717 + 1 *) -text \<open> - pointer undefined in state or not referencing a type conform object representation \<close> - -(* 124 ************************************ 718 + 14 *) (* term Floor1_access.print_access_select *) -definition "select\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__salary f = (\<lambda> (mk\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (_) (\<bottom>)) \<Rightarrow> null - | (mk\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (_) (\<lfloor>x___salary\<rfloor>)) \<Rightarrow> (f (x___salary)))" -definition "select\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__wormhole f = (\<lambda> (mk\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (_) (\<bottom>) (_)) \<Rightarrow> null - | (mk\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (_) (\<lfloor>x___wormhole\<rfloor>) (_)) \<Rightarrow> (f (x___wormhole)))" -definition "select\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__weight f = (\<lambda> (mk\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (_) (_) (\<bottom>)) \<Rightarrow> null - | (mk\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (_) (_) (\<lfloor>x___weight\<rfloor>)) \<Rightarrow> (f (x___weight)))" -definition "select\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y__sound f = (\<lambda> (mk\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y (_) (\<bottom>) (_) (_)) \<Rightarrow> null - | (mk\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y (_) (\<lfloor>x___sound\<rfloor>) (_) (_)) \<Rightarrow> (f (x___sound)))" -definition "select\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y__moving f = (\<lambda> (mk\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y (_) (_) (\<bottom>) (_)) \<Rightarrow> null - | (mk\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y (_) (_) (\<lfloor>x___moving\<rfloor>) (_)) \<Rightarrow> (f (x___moving)))" -definition "select\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y__outer_world f = (\<lambda> (mk\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y (_) (_) (_) (\<bottom>)) \<Rightarrow> null - | (mk\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y (_) (_) (_) (\<lfloor>x___outer_world\<rfloor>)) \<Rightarrow> (f (x___outer_world)))" -definition "select\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__wormhole f = (\<lambda> (mk\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n ((mk\<E>\<X>\<T>\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (_) (\<bottom>) (_) (_) (_) (_))) (_)) \<Rightarrow> null - | (mk\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n ((mk\<E>\<X>\<T>\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (_) (\<lfloor>x___wormhole\<rfloor>) (_) (_) (_) (_))) (_)) \<Rightarrow> (f (x___wormhole)))" -definition "select\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__weight f = (\<lambda> (mk\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n ((mk\<E>\<X>\<T>\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (_) (_) (\<bottom>) (_) (_) (_))) (_)) \<Rightarrow> null - | (mk\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n ((mk\<E>\<X>\<T>\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (_) (_) (\<lfloor>x___weight\<rfloor>) (_) (_) (_))) (_)) \<Rightarrow> (f (x___weight)))" -definition "select\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__sound f = (\<lambda> (mk\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n ((mk\<E>\<X>\<T>\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (_) (_) (_) (\<bottom>) (_) (_))) (_)) \<Rightarrow> null - | (mk\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n ((mk\<E>\<X>\<T>\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (_) (_) (_) (\<lfloor>x___sound\<rfloor>) (_) (_))) (_)) \<Rightarrow> (f (x___sound)))" -definition "select\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__moving f = (\<lambda> (mk\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n ((mk\<E>\<X>\<T>\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (_) (_) (_) (_) (\<bottom>) (_))) (_)) \<Rightarrow> null - | (mk\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n ((mk\<E>\<X>\<T>\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (_) (_) (_) (_) (\<lfloor>x___moving\<rfloor>) (_))) (_)) \<Rightarrow> (f (x___moving)))" -definition "select\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__outer_world f = (\<lambda> (mk\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n ((mk\<E>\<X>\<T>\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (_) (_) (_) (_) (_) (\<bottom>))) (_)) \<Rightarrow> null - | (mk\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n ((mk\<E>\<X>\<T>\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (_) (_) (_) (_) (_) (\<lfloor>x___outer_world\<rfloor>))) (_)) \<Rightarrow> (f (x___outer_world)))" -definition "select\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__sound f = (\<lambda> (mk\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t ((mk\<E>\<X>\<T>\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (_) (\<bottom>) (_) (_))) (_) (_)) \<Rightarrow> null - | (mk\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t ((mk\<E>\<X>\<T>\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (_) (\<lfloor>x___sound\<rfloor>) (_) (_))) (_) (_)) \<Rightarrow> (f (x___sound)) - | (mk\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t ((mk\<E>\<X>\<T>\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (person))) (_) (_)) \<Rightarrow> (select\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__sound (f) (person)))" -definition "select\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__moving f = (\<lambda> (mk\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t ((mk\<E>\<X>\<T>\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (_) (_) (\<bottom>) (_))) (_) (_)) \<Rightarrow> null - | (mk\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t ((mk\<E>\<X>\<T>\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (_) (_) (\<lfloor>x___moving\<rfloor>) (_))) (_) (_)) \<Rightarrow> (f (x___moving)) - | (mk\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t ((mk\<E>\<X>\<T>\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (person))) (_) (_)) \<Rightarrow> (select\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__moving (f) (person)))" -definition "select\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__outer_world f = (\<lambda> (mk\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t ((mk\<E>\<X>\<T>\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (_) (_) (_) (\<bottom>))) (_) (_)) \<Rightarrow> null - | (mk\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t ((mk\<E>\<X>\<T>\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (_) (_) (_) (\<lfloor>x___outer_world\<rfloor>))) (_) (_)) \<Rightarrow> (f (x___outer_world)) - | (mk\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t ((mk\<E>\<X>\<T>\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (person))) (_) (_)) \<Rightarrow> (select\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__outer_world (f) (person)))" - -(* 125 ************************************ 732 + 1 *) (* term Floor1_access.print_access_select_obj *) -definition "select\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__boss = select_object_any\<^sub>S\<^sub>e\<^sub>t" - -(* 126 ************************************ 733 + 14 *) (* term Floor1_access.print_access_dot_consts *) -consts dot_0___boss :: "(\<AA>, '\<alpha>) val \<Rightarrow> \<cdot>Person" ("(_) .boss") -consts dot_0___bossat_pre :: "(\<AA>, '\<alpha>) val \<Rightarrow> \<cdot>Person" ("(_) .boss@pre") -consts dot__salary :: "(\<AA>, '\<alpha>) val \<Rightarrow> Integer" ("(_) .salary") -consts dot__salaryat_pre :: "(\<AA>, '\<alpha>) val \<Rightarrow> Integer" ("(_) .salary@pre") -consts dot__wormhole :: "(\<AA>, '\<alpha>) val \<Rightarrow> (\<AA>, nat option option) val" ("(_) .wormhole") -consts dot__wormholeat_pre :: "(\<AA>, '\<alpha>) val \<Rightarrow> (\<AA>, nat option option) val" ("(_) .wormhole@pre") -consts dot__weight :: "(\<AA>, '\<alpha>) val \<Rightarrow> Integer" ("(_) .weight") -consts dot__weightat_pre :: "(\<AA>, '\<alpha>) val \<Rightarrow> Integer" ("(_) .weight@pre") -consts dot__sound :: "(\<AA>, '\<alpha>) val \<Rightarrow> Void" ("(_) .sound") -consts dot__soundat_pre :: "(\<AA>, '\<alpha>) val \<Rightarrow> Void" ("(_) .sound@pre") -consts dot__moving :: "(\<AA>, '\<alpha>) val \<Rightarrow> Boolean" ("(_) .moving") -consts dot__movingat_pre :: "(\<AA>, '\<alpha>) val \<Rightarrow> Boolean" ("(_) .moving@pre") -consts dot__outer_world :: "(\<AA>, '\<alpha>) val \<Rightarrow> Set_Sequence_Planet" ("(_) .outer'_world") -consts dot__outer_worldat_pre :: "(\<AA>, '\<alpha>) val \<Rightarrow> Set_Sequence_Planet" ("(_) .outer'_world@pre") - -(* 127 ************************************ 747 + 30 *) (* term Floor1_access.print_access_dot *) -overloading dot_0___boss \<equiv> "(dot_0___boss::(\<cdot>Person) \<Rightarrow> _)" -begin - definition dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_0___boss : "(x::\<cdot>Person) .boss \<equiv> (eval_extract (x) ((deref_oid\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (in_post_state) ((deref_assocs\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_0___boss (in_post_state) ((select\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__boss ((deref_oid\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (in_post_state) (reconst_basetype))))))))))" -end -overloading dot__salary \<equiv> "(dot__salary::(\<cdot>Person) \<Rightarrow> _)" -begin - definition dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__salary : "(x::\<cdot>Person) .salary \<equiv> (eval_extract (x) ((deref_oid\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (in_post_state) ((select\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__salary (reconst_basetype))))))" -end -overloading dot_0___bossat_pre \<equiv> "(dot_0___bossat_pre::(\<cdot>Person) \<Rightarrow> _)" -begin - definition dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_0___bossat_pre : "(x::\<cdot>Person) .boss@pre \<equiv> (eval_extract (x) ((deref_oid\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (in_pre_state) ((deref_assocs\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_0___boss (in_pre_state) ((select\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__boss ((deref_oid\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (in_pre_state) (reconst_basetype))))))))))" -end -overloading dot__salaryat_pre \<equiv> "(dot__salaryat_pre::(\<cdot>Person) \<Rightarrow> _)" -begin - definition dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__salaryat_pre : "(x::\<cdot>Person) .salary@pre \<equiv> (eval_extract (x) ((deref_oid\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (in_pre_state) ((select\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__salary (reconst_basetype))))))" -end -overloading dot__wormhole \<equiv> "(dot__wormhole::(\<cdot>Planet) \<Rightarrow> _)" -begin - definition dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__wormhole : "(x::\<cdot>Planet) .wormhole \<equiv> (eval_extract (x) ((deref_oid\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (in_post_state) ((select\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__wormhole (reconst_basetype))))))" -end -overloading dot__weight \<equiv> "(dot__weight::(\<cdot>Planet) \<Rightarrow> _)" -begin - definition dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__weight : "(x::\<cdot>Planet) .weight \<equiv> (eval_extract (x) ((deref_oid\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (in_post_state) ((select\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__weight (reconst_basetype))))))" -end -overloading dot__wormholeat_pre \<equiv> "(dot__wormholeat_pre::(\<cdot>Planet) \<Rightarrow> _)" -begin - definition dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__wormholeat_pre : "(x::\<cdot>Planet) .wormhole@pre \<equiv> (eval_extract (x) ((deref_oid\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (in_pre_state) ((select\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__wormhole (reconst_basetype))))))" -end -overloading dot__weightat_pre \<equiv> "(dot__weightat_pre::(\<cdot>Planet) \<Rightarrow> _)" -begin - definition dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__weightat_pre : "(x::\<cdot>Planet) .weight@pre \<equiv> (eval_extract (x) ((deref_oid\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (in_pre_state) ((select\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__weight (reconst_basetype))))))" -end -overloading dot__sound \<equiv> "(dot__sound::(\<cdot>Galaxy) \<Rightarrow> _)" -begin - definition dot\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y__sound : "(x::\<cdot>Galaxy) .sound \<equiv> (eval_extract (x) ((deref_oid\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y (in_post_state) ((select\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y__sound (reconst_basetype\<^sub>V\<^sub>o\<^sub>i\<^sub>d))))))" -end -overloading dot__moving \<equiv> "(dot__moving::(\<cdot>Galaxy) \<Rightarrow> _)" -begin - definition dot\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y__moving : "(x::\<cdot>Galaxy) .moving \<equiv> (eval_extract (x) ((deref_oid\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y (in_post_state) ((select\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y__moving (reconst_basetype))))))" -end -overloading dot__outer_world \<equiv> "(dot__outer_world::(\<cdot>Galaxy) \<Rightarrow> _)" -begin - definition dot\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y__outer_world : "(x::\<cdot>Galaxy) .outer_world \<equiv> (eval_extract (x) ((deref_oid\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y (in_post_state) ((select\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y__outer_world ((select_object\<^sub>S\<^sub>e\<^sub>t ((select_object\<^sub>S\<^sub>e\<^sub>q ((deref_oid\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (in_post_state) (reconst_basetype))))))))))))" -end -overloading dot__soundat_pre \<equiv> "(dot__soundat_pre::(\<cdot>Galaxy) \<Rightarrow> _)" -begin - definition dot\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y__soundat_pre : "(x::\<cdot>Galaxy) .sound@pre \<equiv> (eval_extract (x) ((deref_oid\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y (in_pre_state) ((select\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y__sound (reconst_basetype\<^sub>V\<^sub>o\<^sub>i\<^sub>d))))))" -end -overloading dot__movingat_pre \<equiv> "(dot__movingat_pre::(\<cdot>Galaxy) \<Rightarrow> _)" -begin - definition dot\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y__movingat_pre : "(x::\<cdot>Galaxy) .moving@pre \<equiv> (eval_extract (x) ((deref_oid\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y (in_pre_state) ((select\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y__moving (reconst_basetype))))))" -end -overloading dot__outer_worldat_pre \<equiv> "(dot__outer_worldat_pre::(\<cdot>Galaxy) \<Rightarrow> _)" -begin - definition dot\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y__outer_worldat_pre : "(x::\<cdot>Galaxy) .outer_world@pre \<equiv> (eval_extract (x) ((deref_oid\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y (in_pre_state) ((select\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y__outer_world ((select_object\<^sub>S\<^sub>e\<^sub>t ((select_object\<^sub>S\<^sub>e\<^sub>q ((deref_oid\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (in_pre_state) (reconst_basetype))))))))))))" -end -overloading dot__wormhole \<equiv> "(dot__wormhole::(\<cdot>Person) \<Rightarrow> _)" -begin - definition dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__wormhole : "(x::\<cdot>Person) .wormhole \<equiv> (eval_extract (x) ((deref_oid\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (in_post_state) ((select\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__wormhole (reconst_basetype))))))" -end -overloading dot__weight \<equiv> "(dot__weight::(\<cdot>Person) \<Rightarrow> _)" -begin - definition dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__weight : "(x::\<cdot>Person) .weight \<equiv> (eval_extract (x) ((deref_oid\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (in_post_state) ((select\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__weight (reconst_basetype))))))" -end -overloading dot__sound \<equiv> "(dot__sound::(\<cdot>Person) \<Rightarrow> _)" -begin - definition dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__sound : "(x::\<cdot>Person) .sound \<equiv> (eval_extract (x) ((deref_oid\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (in_post_state) ((select\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__sound (reconst_basetype\<^sub>V\<^sub>o\<^sub>i\<^sub>d))))))" -end -overloading dot__moving \<equiv> "(dot__moving::(\<cdot>Person) \<Rightarrow> _)" -begin - definition dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__moving : "(x::\<cdot>Person) .moving \<equiv> (eval_extract (x) ((deref_oid\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (in_post_state) ((select\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__moving (reconst_basetype))))))" -end -overloading dot__outer_world \<equiv> "(dot__outer_world::(\<cdot>Person) \<Rightarrow> _)" -begin - definition dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__outer_world : "(x::\<cdot>Person) .outer_world \<equiv> (eval_extract (x) ((deref_oid\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (in_post_state) ((select\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__outer_world ((select_object\<^sub>S\<^sub>e\<^sub>t ((select_object\<^sub>S\<^sub>e\<^sub>q ((deref_oid\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (in_post_state) (reconst_basetype))))))))))))" -end -overloading dot__wormholeat_pre \<equiv> "(dot__wormholeat_pre::(\<cdot>Person) \<Rightarrow> _)" -begin - definition dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__wormholeat_pre : "(x::\<cdot>Person) .wormhole@pre \<equiv> (eval_extract (x) ((deref_oid\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (in_pre_state) ((select\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__wormhole (reconst_basetype))))))" -end -overloading dot__weightat_pre \<equiv> "(dot__weightat_pre::(\<cdot>Person) \<Rightarrow> _)" -begin - definition dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__weightat_pre : "(x::\<cdot>Person) .weight@pre \<equiv> (eval_extract (x) ((deref_oid\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (in_pre_state) ((select\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__weight (reconst_basetype))))))" -end -overloading dot__soundat_pre \<equiv> "(dot__soundat_pre::(\<cdot>Person) \<Rightarrow> _)" -begin - definition dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__soundat_pre : "(x::\<cdot>Person) .sound@pre \<equiv> (eval_extract (x) ((deref_oid\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (in_pre_state) ((select\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__sound (reconst_basetype\<^sub>V\<^sub>o\<^sub>i\<^sub>d))))))" -end -overloading dot__movingat_pre \<equiv> "(dot__movingat_pre::(\<cdot>Person) \<Rightarrow> _)" -begin - definition dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__movingat_pre : "(x::\<cdot>Person) .moving@pre \<equiv> (eval_extract (x) ((deref_oid\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (in_pre_state) ((select\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__moving (reconst_basetype))))))" -end -overloading dot__outer_worldat_pre \<equiv> "(dot__outer_worldat_pre::(\<cdot>Person) \<Rightarrow> _)" -begin - definition dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__outer_worldat_pre : "(x::\<cdot>Person) .outer_world@pre \<equiv> (eval_extract (x) ((deref_oid\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (in_pre_state) ((select\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__outer_world ((select_object\<^sub>S\<^sub>e\<^sub>t ((select_object\<^sub>S\<^sub>e\<^sub>q ((deref_oid\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (in_pre_state) (reconst_basetype))))))))))))" -end -overloading dot__sound \<equiv> "(dot__sound::(\<cdot>Planet) \<Rightarrow> _)" -begin - definition dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__sound : "(x::\<cdot>Planet) .sound \<equiv> (eval_extract (x) ((deref_oid\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (in_post_state) ((select\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__sound (reconst_basetype\<^sub>V\<^sub>o\<^sub>i\<^sub>d))))))" -end -overloading dot__moving \<equiv> "(dot__moving::(\<cdot>Planet) \<Rightarrow> _)" -begin - definition dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__moving : "(x::\<cdot>Planet) .moving \<equiv> (eval_extract (x) ((deref_oid\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (in_post_state) ((select\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__moving (reconst_basetype))))))" -end -overloading dot__outer_world \<equiv> "(dot__outer_world::(\<cdot>Planet) \<Rightarrow> _)" -begin - definition dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__outer_world : "(x::\<cdot>Planet) .outer_world \<equiv> (eval_extract (x) ((deref_oid\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (in_post_state) ((select\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__outer_world ((select_object\<^sub>S\<^sub>e\<^sub>t ((select_object\<^sub>S\<^sub>e\<^sub>q ((deref_oid\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (in_post_state) (reconst_basetype))))))))))))" -end -overloading dot__soundat_pre \<equiv> "(dot__soundat_pre::(\<cdot>Planet) \<Rightarrow> _)" -begin - definition dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__soundat_pre : "(x::\<cdot>Planet) .sound@pre \<equiv> (eval_extract (x) ((deref_oid\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (in_pre_state) ((select\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__sound (reconst_basetype\<^sub>V\<^sub>o\<^sub>i\<^sub>d))))))" -end -overloading dot__movingat_pre \<equiv> "(dot__movingat_pre::(\<cdot>Planet) \<Rightarrow> _)" -begin - definition dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__movingat_pre : "(x::\<cdot>Planet) .moving@pre \<equiv> (eval_extract (x) ((deref_oid\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (in_pre_state) ((select\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__moving (reconst_basetype))))))" -end -overloading dot__outer_worldat_pre \<equiv> "(dot__outer_worldat_pre::(\<cdot>Planet) \<Rightarrow> _)" -begin - definition dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__outer_worldat_pre : "(x::\<cdot>Planet) .outer_world@pre \<equiv> (eval_extract (x) ((deref_oid\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (in_pre_state) ((select\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__outer_world ((select_object\<^sub>S\<^sub>e\<^sub>t ((select_object\<^sub>S\<^sub>e\<^sub>q ((deref_oid\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (in_pre_state) (reconst_basetype))))))))))))" -end - -(* 128 ************************************ 777 + 1 *) (* term Floor1_access.print_access_dot_lemmas_id *) -lemmas dot_accessor = dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_0___boss - dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__salary - dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_0___bossat_pre - dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__salaryat_pre - dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__wormhole - dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__weight - dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__wormholeat_pre - dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__weightat_pre - dot\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y__sound - dot\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y__moving - dot\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y__outer_world - dot\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y__soundat_pre - dot\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y__movingat_pre - dot\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y__outer_worldat_pre - dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__wormhole - dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__weight - dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__sound - dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__moving - dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__outer_world - dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__wormholeat_pre - dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__weightat_pre - dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__soundat_pre - dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__movingat_pre - dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__outer_worldat_pre - dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__sound - dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__moving - dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__outer_world - dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__soundat_pre - dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__movingat_pre - dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__outer_worldat_pre - -(* 129 ************************************ 778 + 1 *) -subsection \<open>Context Passing\<close> - -(* 130 ************************************ 779 + 1 *) (* term Floor1_access.print_access_dot_cp_lemmas *) -lemmas[simp,code_unfold] = eval_extract_def - -(* 131 ************************************ 780 + 30 *) (* term Floor1_access.print_access_dot_lemma_cp *) -lemma cp_dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_0___boss : "(cp ((\<lambda>X. (X::\<cdot>Person) .boss)))" -by(auto simp: dot_accessor cp_def) -lemma cp_dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__salary : "(cp ((\<lambda>X. (X::\<cdot>Person) .salary)))" -by(auto simp: dot_accessor cp_def) -lemma cp_dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_0___bossat_pre : "(cp ((\<lambda>X. (X::\<cdot>Person) .boss@pre)))" -by(auto simp: dot_accessor cp_def) -lemma cp_dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__salaryat_pre : "(cp ((\<lambda>X. (X::\<cdot>Person) .salary@pre)))" -by(auto simp: dot_accessor cp_def) -lemma cp_dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__wormhole : "(cp ((\<lambda>X. (X::\<cdot>Planet) .wormhole)))" -by(auto simp: dot_accessor cp_def) -lemma cp_dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__weight : "(cp ((\<lambda>X. (X::\<cdot>Planet) .weight)))" -by(auto simp: dot_accessor cp_def) -lemma cp_dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__wormholeat_pre : "(cp ((\<lambda>X. (X::\<cdot>Planet) .wormhole@pre)))" -by(auto simp: dot_accessor cp_def) -lemma cp_dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__weightat_pre : "(cp ((\<lambda>X. (X::\<cdot>Planet) .weight@pre)))" -by(auto simp: dot_accessor cp_def) -lemma cp_dot\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y__sound : "(cp ((\<lambda>X. (X::\<cdot>Galaxy) .sound)))" -by(auto simp: dot_accessor cp_def) -lemma cp_dot\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y__moving : "(cp ((\<lambda>X. (X::\<cdot>Galaxy) .moving)))" -by(auto simp: dot_accessor cp_def) -lemma cp_dot\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y__outer_world : "(cp ((\<lambda>X. (X::\<cdot>Galaxy) .outer_world)))" -by(auto simp: dot_accessor cp_def) -lemma cp_dot\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y__soundat_pre : "(cp ((\<lambda>X. (X::\<cdot>Galaxy) .sound@pre)))" -by(auto simp: dot_accessor cp_def) -lemma cp_dot\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y__movingat_pre : "(cp ((\<lambda>X. (X::\<cdot>Galaxy) .moving@pre)))" -by(auto simp: dot_accessor cp_def) -lemma cp_dot\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y__outer_worldat_pre : "(cp ((\<lambda>X. (X::\<cdot>Galaxy) .outer_world@pre)))" -by(auto simp: dot_accessor cp_def) -lemma cp_dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__wormhole : "(cp ((\<lambda>X. (X::\<cdot>Person) .wormhole)))" -by(auto simp: dot_accessor cp_def) -lemma cp_dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__weight : "(cp ((\<lambda>X. (X::\<cdot>Person) .weight)))" -by(auto simp: dot_accessor cp_def) -lemma cp_dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__sound : "(cp ((\<lambda>X. (X::\<cdot>Person) .sound)))" -by(auto simp: dot_accessor cp_def) -lemma cp_dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__moving : "(cp ((\<lambda>X. (X::\<cdot>Person) .moving)))" -by(auto simp: dot_accessor cp_def) -lemma cp_dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__outer_world : "(cp ((\<lambda>X. (X::\<cdot>Person) .outer_world)))" -by(auto simp: dot_accessor cp_def) -lemma cp_dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__wormholeat_pre : "(cp ((\<lambda>X. (X::\<cdot>Person) .wormhole@pre)))" -by(auto simp: dot_accessor cp_def) -lemma cp_dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__weightat_pre : "(cp ((\<lambda>X. (X::\<cdot>Person) .weight@pre)))" -by(auto simp: dot_accessor cp_def) -lemma cp_dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__soundat_pre : "(cp ((\<lambda>X. (X::\<cdot>Person) .sound@pre)))" -by(auto simp: dot_accessor cp_def) -lemma cp_dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__movingat_pre : "(cp ((\<lambda>X. (X::\<cdot>Person) .moving@pre)))" -by(auto simp: dot_accessor cp_def) -lemma cp_dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__outer_worldat_pre : "(cp ((\<lambda>X. (X::\<cdot>Person) .outer_world@pre)))" -by(auto simp: dot_accessor cp_def) -lemma cp_dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__sound : "(cp ((\<lambda>X. (X::\<cdot>Planet) .sound)))" -by(auto simp: dot_accessor cp_def) -lemma cp_dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__moving : "(cp ((\<lambda>X. (X::\<cdot>Planet) .moving)))" -by(auto simp: dot_accessor cp_def) -lemma cp_dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__outer_world : "(cp ((\<lambda>X. (X::\<cdot>Planet) .outer_world)))" -by(auto simp: dot_accessor cp_def) -lemma cp_dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__soundat_pre : "(cp ((\<lambda>X. (X::\<cdot>Planet) .sound@pre)))" -by(auto simp: dot_accessor cp_def) -lemma cp_dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__movingat_pre : "(cp ((\<lambda>X. (X::\<cdot>Planet) .moving@pre)))" -by(auto simp: dot_accessor cp_def) -lemma cp_dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__outer_worldat_pre : "(cp ((\<lambda>X. (X::\<cdot>Planet) .outer_world@pre)))" -by(auto simp: dot_accessor cp_def) - -(* 132 ************************************ 810 + 1 *) (* term Floor1_access.print_access_dot_lemmas_cp *) -lemmas[simp,code_unfold] = cp_dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_0___boss - cp_dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__salary - cp_dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_0___bossat_pre - cp_dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__salaryat_pre - cp_dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__wormhole - cp_dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__weight - cp_dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__wormholeat_pre - cp_dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__weightat_pre - cp_dot\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y__sound - cp_dot\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y__moving - cp_dot\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y__outer_world - cp_dot\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y__soundat_pre - cp_dot\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y__movingat_pre - cp_dot\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y__outer_worldat_pre - cp_dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__wormhole - cp_dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__weight - cp_dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__sound - cp_dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__moving - cp_dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__outer_world - cp_dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__wormholeat_pre - cp_dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__weightat_pre - cp_dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__soundat_pre - cp_dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__movingat_pre - cp_dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__outer_worldat_pre - cp_dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__sound - cp_dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__moving - cp_dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__outer_world - cp_dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__soundat_pre - cp_dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__movingat_pre - cp_dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__outer_worldat_pre - -(* 133 ************************************ 811 + 1 *) -subsection \<open>Execution with Invalid or Null as Argument\<close> - -(* 134 ************************************ 812 + 60 *) (* term Floor1_access.print_access_lemma_strict *) -lemma dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_0___boss_invalid : "(invalid::\<cdot>Person) .boss = invalid" -by(rule ext, simp add: dot_accessor bot_option_def invalid_def) -lemma dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_0___boss_null : "(null::\<cdot>Person) .boss = invalid" -by(rule ext, simp add: dot_accessor bot_option_def null_fun_def null_option_def) -lemma dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__salary_invalid : "(invalid::\<cdot>Person) .salary = invalid" -by(rule ext, simp add: dot_accessor bot_option_def invalid_def) -lemma dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__salary_null : "(null::\<cdot>Person) .salary = invalid" -by(rule ext, simp add: dot_accessor bot_option_def null_fun_def null_option_def) -lemma dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_0___bossat_pre_invalid : "(invalid::\<cdot>Person) .boss@pre = invalid" -by(rule ext, simp add: dot_accessor bot_option_def invalid_def) -lemma dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_0___bossat_pre_null : "(null::\<cdot>Person) .boss@pre = invalid" -by(rule ext, simp add: dot_accessor bot_option_def null_fun_def null_option_def) -lemma dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__salaryat_pre_invalid : "(invalid::\<cdot>Person) .salary@pre = invalid" -by(rule ext, simp add: dot_accessor bot_option_def invalid_def) -lemma dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__salaryat_pre_null : "(null::\<cdot>Person) .salary@pre = invalid" -by(rule ext, simp add: dot_accessor bot_option_def null_fun_def null_option_def) -lemma dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__wormhole_invalid : "(invalid::\<cdot>Planet) .wormhole = invalid" -by(rule ext, simp add: dot_accessor bot_option_def invalid_def) -lemma dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__wormhole_null : "(null::\<cdot>Planet) .wormhole = invalid" -by(rule ext, simp add: dot_accessor bot_option_def null_fun_def null_option_def) -lemma dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__weight_invalid : "(invalid::\<cdot>Planet) .weight = invalid" -by(rule ext, simp add: dot_accessor bot_option_def invalid_def) -lemma dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__weight_null : "(null::\<cdot>Planet) .weight = invalid" -by(rule ext, simp add: dot_accessor bot_option_def null_fun_def null_option_def) -lemma dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__wormholeat_pre_invalid : "(invalid::\<cdot>Planet) .wormhole@pre = invalid" -by(rule ext, simp add: dot_accessor bot_option_def invalid_def) -lemma dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__wormholeat_pre_null : "(null::\<cdot>Planet) .wormhole@pre = invalid" -by(rule ext, simp add: dot_accessor bot_option_def null_fun_def null_option_def) -lemma dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__weightat_pre_invalid : "(invalid::\<cdot>Planet) .weight@pre = invalid" -by(rule ext, simp add: dot_accessor bot_option_def invalid_def) -lemma dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__weightat_pre_null : "(null::\<cdot>Planet) .weight@pre = invalid" -by(rule ext, simp add: dot_accessor bot_option_def null_fun_def null_option_def) -lemma dot\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y__sound_invalid : "(invalid::\<cdot>Galaxy) .sound = invalid" -by(rule ext, simp add: dot_accessor bot_option_def invalid_def) -lemma dot\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y__sound_null : "(null::\<cdot>Galaxy) .sound = invalid" -by(rule ext, simp add: dot_accessor bot_option_def null_fun_def null_option_def) -lemma dot\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y__moving_invalid : "(invalid::\<cdot>Galaxy) .moving = invalid" -by(rule ext, simp add: dot_accessor bot_option_def invalid_def) -lemma dot\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y__moving_null : "(null::\<cdot>Galaxy) .moving = invalid" -by(rule ext, simp add: dot_accessor bot_option_def null_fun_def null_option_def) -lemma dot\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y__outer_world_invalid : "(invalid::\<cdot>Galaxy) .outer_world = invalid" -by(rule ext, simp add: dot_accessor bot_option_def invalid_def) -lemma dot\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y__outer_world_null : "(null::\<cdot>Galaxy) .outer_world = invalid" -by(rule ext, simp add: dot_accessor bot_option_def null_fun_def null_option_def) -lemma dot\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y__soundat_pre_invalid : "(invalid::\<cdot>Galaxy) .sound@pre = invalid" -by(rule ext, simp add: dot_accessor bot_option_def invalid_def) -lemma dot\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y__soundat_pre_null : "(null::\<cdot>Galaxy) .sound@pre = invalid" -by(rule ext, simp add: dot_accessor bot_option_def null_fun_def null_option_def) -lemma dot\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y__movingat_pre_invalid : "(invalid::\<cdot>Galaxy) .moving@pre = invalid" -by(rule ext, simp add: dot_accessor bot_option_def invalid_def) -lemma dot\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y__movingat_pre_null : "(null::\<cdot>Galaxy) .moving@pre = invalid" -by(rule ext, simp add: dot_accessor bot_option_def null_fun_def null_option_def) -lemma dot\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y__outer_worldat_pre_invalid : "(invalid::\<cdot>Galaxy) .outer_world@pre = invalid" -by(rule ext, simp add: dot_accessor bot_option_def invalid_def) -lemma dot\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y__outer_worldat_pre_null : "(null::\<cdot>Galaxy) .outer_world@pre = invalid" -by(rule ext, simp add: dot_accessor bot_option_def null_fun_def null_option_def) -lemma dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__wormhole_invalid : "(invalid::\<cdot>Person) .wormhole = invalid" -by(rule ext, simp add: dot_accessor bot_option_def invalid_def) -lemma dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__wormhole_null : "(null::\<cdot>Person) .wormhole = invalid" -by(rule ext, simp add: dot_accessor bot_option_def null_fun_def null_option_def) -lemma dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__weight_invalid : "(invalid::\<cdot>Person) .weight = invalid" -by(rule ext, simp add: dot_accessor bot_option_def invalid_def) -lemma dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__weight_null : "(null::\<cdot>Person) .weight = invalid" -by(rule ext, simp add: dot_accessor bot_option_def null_fun_def null_option_def) -lemma dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__sound_invalid : "(invalid::\<cdot>Person) .sound = invalid" -by(rule ext, simp add: dot_accessor bot_option_def invalid_def) -lemma dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__sound_null : "(null::\<cdot>Person) .sound = invalid" -by(rule ext, simp add: dot_accessor bot_option_def null_fun_def null_option_def) -lemma dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__moving_invalid : "(invalid::\<cdot>Person) .moving = invalid" -by(rule ext, simp add: dot_accessor bot_option_def invalid_def) -lemma dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__moving_null : "(null::\<cdot>Person) .moving = invalid" -by(rule ext, simp add: dot_accessor bot_option_def null_fun_def null_option_def) -lemma dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__outer_world_invalid : "(invalid::\<cdot>Person) .outer_world = invalid" -by(rule ext, simp add: dot_accessor bot_option_def invalid_def) -lemma dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__outer_world_null : "(null::\<cdot>Person) .outer_world = invalid" -by(rule ext, simp add: dot_accessor bot_option_def null_fun_def null_option_def) -lemma dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__wormholeat_pre_invalid : "(invalid::\<cdot>Person) .wormhole@pre = invalid" -by(rule ext, simp add: dot_accessor bot_option_def invalid_def) -lemma dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__wormholeat_pre_null : "(null::\<cdot>Person) .wormhole@pre = invalid" -by(rule ext, simp add: dot_accessor bot_option_def null_fun_def null_option_def) -lemma dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__weightat_pre_invalid : "(invalid::\<cdot>Person) .weight@pre = invalid" -by(rule ext, simp add: dot_accessor bot_option_def invalid_def) -lemma dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__weightat_pre_null : "(null::\<cdot>Person) .weight@pre = invalid" -by(rule ext, simp add: dot_accessor bot_option_def null_fun_def null_option_def) -lemma dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__soundat_pre_invalid : "(invalid::\<cdot>Person) .sound@pre = invalid" -by(rule ext, simp add: dot_accessor bot_option_def invalid_def) -lemma dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__soundat_pre_null : "(null::\<cdot>Person) .sound@pre = invalid" -by(rule ext, simp add: dot_accessor bot_option_def null_fun_def null_option_def) -lemma dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__movingat_pre_invalid : "(invalid::\<cdot>Person) .moving@pre = invalid" -by(rule ext, simp add: dot_accessor bot_option_def invalid_def) -lemma dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__movingat_pre_null : "(null::\<cdot>Person) .moving@pre = invalid" -by(rule ext, simp add: dot_accessor bot_option_def null_fun_def null_option_def) -lemma dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__outer_worldat_pre_invalid : "(invalid::\<cdot>Person) .outer_world@pre = invalid" -by(rule ext, simp add: dot_accessor bot_option_def invalid_def) -lemma dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__outer_worldat_pre_null : "(null::\<cdot>Person) .outer_world@pre = invalid" -by(rule ext, simp add: dot_accessor bot_option_def null_fun_def null_option_def) -lemma dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__sound_invalid : "(invalid::\<cdot>Planet) .sound = invalid" -by(rule ext, simp add: dot_accessor bot_option_def invalid_def) -lemma dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__sound_null : "(null::\<cdot>Planet) .sound = invalid" -by(rule ext, simp add: dot_accessor bot_option_def null_fun_def null_option_def) -lemma dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__moving_invalid : "(invalid::\<cdot>Planet) .moving = invalid" -by(rule ext, simp add: dot_accessor bot_option_def invalid_def) -lemma dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__moving_null : "(null::\<cdot>Planet) .moving = invalid" -by(rule ext, simp add: dot_accessor bot_option_def null_fun_def null_option_def) -lemma dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__outer_world_invalid : "(invalid::\<cdot>Planet) .outer_world = invalid" -by(rule ext, simp add: dot_accessor bot_option_def invalid_def) -lemma dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__outer_world_null : "(null::\<cdot>Planet) .outer_world = invalid" -by(rule ext, simp add: dot_accessor bot_option_def null_fun_def null_option_def) -lemma dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__soundat_pre_invalid : "(invalid::\<cdot>Planet) .sound@pre = invalid" -by(rule ext, simp add: dot_accessor bot_option_def invalid_def) -lemma dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__soundat_pre_null : "(null::\<cdot>Planet) .sound@pre = invalid" -by(rule ext, simp add: dot_accessor bot_option_def null_fun_def null_option_def) -lemma dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__movingat_pre_invalid : "(invalid::\<cdot>Planet) .moving@pre = invalid" -by(rule ext, simp add: dot_accessor bot_option_def invalid_def) -lemma dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__movingat_pre_null : "(null::\<cdot>Planet) .moving@pre = invalid" -by(rule ext, simp add: dot_accessor bot_option_def null_fun_def null_option_def) -lemma dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__outer_worldat_pre_invalid : "(invalid::\<cdot>Planet) .outer_world@pre = invalid" -by(rule ext, simp add: dot_accessor bot_option_def invalid_def) -lemma dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__outer_worldat_pre_null : "(null::\<cdot>Planet) .outer_world@pre = invalid" -by(rule ext, simp add: dot_accessor bot_option_def null_fun_def null_option_def) - -(* 135 ************************************ 872 + 1 *) -subsection \<open>Representation in States\<close> - -(* 136 ************************************ 873 + 30 *) (* term Floor1_access.print_access_def_mono *) -lemma defined_mono_dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_0___boss : "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Person) .boss)) \<Longrightarrow> \<tau> \<Turnstile> (\<delta> (X))" - apply(case_tac "\<tau> \<Turnstile> (X \<triangleq> invalid)", insert StrongEq_L_subst2[where P = "(\<lambda>x. (\<delta> (x .boss)))" and \<tau> = "\<tau>" and x = "X" and y = "invalid"], simp add: foundation16' dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_0___boss_invalid) - apply(case_tac "\<tau> \<Turnstile> (X \<triangleq> null)", insert StrongEq_L_subst2[where P = "(\<lambda>x. (\<delta> (x .boss)))" and \<tau> = "\<tau>" and x = "X" and y = "null"], simp add: foundation16' dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_0___boss_null) -by(simp add: defined_split) -lemma defined_mono_dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__salary : "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Person) .salary)) \<Longrightarrow> \<tau> \<Turnstile> (\<delta> (X))" - apply(case_tac "\<tau> \<Turnstile> (X \<triangleq> invalid)", insert StrongEq_L_subst2[where P = "(\<lambda>x. (\<delta> (x .salary)))" and \<tau> = "\<tau>" and x = "X" and y = "invalid"], simp add: foundation16' dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__salary_invalid) - apply(case_tac "\<tau> \<Turnstile> (X \<triangleq> null)", insert StrongEq_L_subst2[where P = "(\<lambda>x. (\<delta> (x .salary)))" and \<tau> = "\<tau>" and x = "X" and y = "null"], simp add: foundation16' dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__salary_null) -by(simp add: defined_split) -lemma defined_mono_dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_0___bossat_pre : "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Person) .boss@pre)) \<Longrightarrow> \<tau> \<Turnstile> (\<delta> (X))" - apply(case_tac "\<tau> \<Turnstile> (X \<triangleq> invalid)", insert StrongEq_L_subst2[where P = "(\<lambda>x. (\<delta> (x .boss@pre)))" and \<tau> = "\<tau>" and x = "X" and y = "invalid"], simp add: foundation16' dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_0___bossat_pre_invalid) - apply(case_tac "\<tau> \<Turnstile> (X \<triangleq> null)", insert StrongEq_L_subst2[where P = "(\<lambda>x. (\<delta> (x .boss@pre)))" and \<tau> = "\<tau>" and x = "X" and y = "null"], simp add: foundation16' dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_0___bossat_pre_null) -by(simp add: defined_split) -lemma defined_mono_dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__salaryat_pre : "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Person) .salary@pre)) \<Longrightarrow> \<tau> \<Turnstile> (\<delta> (X))" - apply(case_tac "\<tau> \<Turnstile> (X \<triangleq> invalid)", insert StrongEq_L_subst2[where P = "(\<lambda>x. (\<delta> (x .salary@pre)))" and \<tau> = "\<tau>" and x = "X" and y = "invalid"], simp add: foundation16' dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__salaryat_pre_invalid) - apply(case_tac "\<tau> \<Turnstile> (X \<triangleq> null)", insert StrongEq_L_subst2[where P = "(\<lambda>x. (\<delta> (x .salary@pre)))" and \<tau> = "\<tau>" and x = "X" and y = "null"], simp add: foundation16' dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__salaryat_pre_null) -by(simp add: defined_split) -lemma defined_mono_dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__wormhole : "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Planet) .wormhole)) \<Longrightarrow> \<tau> \<Turnstile> (\<delta> (X))" - apply(case_tac "\<tau> \<Turnstile> (X \<triangleq> invalid)", insert StrongEq_L_subst2[where P = "(\<lambda>x. (\<delta> (x .wormhole)))" and \<tau> = "\<tau>" and x = "X" and y = "invalid"], simp add: foundation16' dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__wormhole_invalid) - apply(case_tac "\<tau> \<Turnstile> (X \<triangleq> null)", insert StrongEq_L_subst2[where P = "(\<lambda>x. (\<delta> (x .wormhole)))" and \<tau> = "\<tau>" and x = "X" and y = "null"], simp add: foundation16' dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__wormhole_null) -by(simp add: defined_split) -lemma defined_mono_dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__weight : "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Planet) .weight)) \<Longrightarrow> \<tau> \<Turnstile> (\<delta> (X))" - apply(case_tac "\<tau> \<Turnstile> (X \<triangleq> invalid)", insert StrongEq_L_subst2[where P = "(\<lambda>x. (\<delta> (x .weight)))" and \<tau> = "\<tau>" and x = "X" and y = "invalid"], simp add: foundation16' dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__weight_invalid) - apply(case_tac "\<tau> \<Turnstile> (X \<triangleq> null)", insert StrongEq_L_subst2[where P = "(\<lambda>x. (\<delta> (x .weight)))" and \<tau> = "\<tau>" and x = "X" and y = "null"], simp add: foundation16' dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__weight_null) -by(simp add: defined_split) -lemma defined_mono_dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__wormholeat_pre : "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Planet) .wormhole@pre)) \<Longrightarrow> \<tau> \<Turnstile> (\<delta> (X))" - apply(case_tac "\<tau> \<Turnstile> (X \<triangleq> invalid)", insert StrongEq_L_subst2[where P = "(\<lambda>x. (\<delta> (x .wormhole@pre)))" and \<tau> = "\<tau>" and x = "X" and y = "invalid"], simp add: foundation16' dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__wormholeat_pre_invalid) - apply(case_tac "\<tau> \<Turnstile> (X \<triangleq> null)", insert StrongEq_L_subst2[where P = "(\<lambda>x. (\<delta> (x .wormhole@pre)))" and \<tau> = "\<tau>" and x = "X" and y = "null"], simp add: foundation16' dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__wormholeat_pre_null) -by(simp add: defined_split) -lemma defined_mono_dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__weightat_pre : "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Planet) .weight@pre)) \<Longrightarrow> \<tau> \<Turnstile> (\<delta> (X))" - apply(case_tac "\<tau> \<Turnstile> (X \<triangleq> invalid)", insert StrongEq_L_subst2[where P = "(\<lambda>x. (\<delta> (x .weight@pre)))" and \<tau> = "\<tau>" and x = "X" and y = "invalid"], simp add: foundation16' dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__weightat_pre_invalid) - apply(case_tac "\<tau> \<Turnstile> (X \<triangleq> null)", insert StrongEq_L_subst2[where P = "(\<lambda>x. (\<delta> (x .weight@pre)))" and \<tau> = "\<tau>" and x = "X" and y = "null"], simp add: foundation16' dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__weightat_pre_null) -by(simp add: defined_split) -lemma defined_mono_dot\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y__sound : "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Galaxy) .sound)) \<Longrightarrow> \<tau> \<Turnstile> (\<delta> (X))" - apply(case_tac "\<tau> \<Turnstile> (X \<triangleq> invalid)", insert StrongEq_L_subst2[where P = "(\<lambda>x. (\<delta> (x .sound)))" and \<tau> = "\<tau>" and x = "X" and y = "invalid"], simp add: foundation16' dot\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y__sound_invalid) - apply(case_tac "\<tau> \<Turnstile> (X \<triangleq> null)", insert StrongEq_L_subst2[where P = "(\<lambda>x. (\<delta> (x .sound)))" and \<tau> = "\<tau>" and x = "X" and y = "null"], simp add: foundation16' dot\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y__sound_null) -by(simp add: defined_split) -lemma defined_mono_dot\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y__moving : "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Galaxy) .moving)) \<Longrightarrow> \<tau> \<Turnstile> (\<delta> (X))" - apply(case_tac "\<tau> \<Turnstile> (X \<triangleq> invalid)", insert StrongEq_L_subst2[where P = "(\<lambda>x. (\<delta> (x .moving)))" and \<tau> = "\<tau>" and x = "X" and y = "invalid"], simp add: foundation16' dot\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y__moving_invalid) - apply(case_tac "\<tau> \<Turnstile> (X \<triangleq> null)", insert StrongEq_L_subst2[where P = "(\<lambda>x. (\<delta> (x .moving)))" and \<tau> = "\<tau>" and x = "X" and y = "null"], simp add: foundation16' dot\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y__moving_null) -by(simp add: defined_split) -lemma defined_mono_dot\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y__outer_world : "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Galaxy) .outer_world)) \<Longrightarrow> \<tau> \<Turnstile> (\<delta> (X))" - apply(case_tac "\<tau> \<Turnstile> (X \<triangleq> invalid)", insert StrongEq_L_subst2[where P = "(\<lambda>x. (\<delta> (x .outer_world)))" and \<tau> = "\<tau>" and x = "X" and y = "invalid"], simp add: foundation16' dot\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y__outer_world_invalid) - apply(case_tac "\<tau> \<Turnstile> (X \<triangleq> null)", insert StrongEq_L_subst2[where P = "(\<lambda>x. (\<delta> (x .outer_world)))" and \<tau> = "\<tau>" and x = "X" and y = "null"], simp add: foundation16' dot\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y__outer_world_null) -by(simp add: defined_split) -lemma defined_mono_dot\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y__soundat_pre : "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Galaxy) .sound@pre)) \<Longrightarrow> \<tau> \<Turnstile> (\<delta> (X))" - apply(case_tac "\<tau> \<Turnstile> (X \<triangleq> invalid)", insert StrongEq_L_subst2[where P = "(\<lambda>x. (\<delta> (x .sound@pre)))" and \<tau> = "\<tau>" and x = "X" and y = "invalid"], simp add: foundation16' dot\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y__soundat_pre_invalid) - apply(case_tac "\<tau> \<Turnstile> (X \<triangleq> null)", insert StrongEq_L_subst2[where P = "(\<lambda>x. (\<delta> (x .sound@pre)))" and \<tau> = "\<tau>" and x = "X" and y = "null"], simp add: foundation16' dot\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y__soundat_pre_null) -by(simp add: defined_split) -lemma defined_mono_dot\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y__movingat_pre : "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Galaxy) .moving@pre)) \<Longrightarrow> \<tau> \<Turnstile> (\<delta> (X))" - apply(case_tac "\<tau> \<Turnstile> (X \<triangleq> invalid)", insert StrongEq_L_subst2[where P = "(\<lambda>x. (\<delta> (x .moving@pre)))" and \<tau> = "\<tau>" and x = "X" and y = "invalid"], simp add: foundation16' dot\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y__movingat_pre_invalid) - apply(case_tac "\<tau> \<Turnstile> (X \<triangleq> null)", insert StrongEq_L_subst2[where P = "(\<lambda>x. (\<delta> (x .moving@pre)))" and \<tau> = "\<tau>" and x = "X" and y = "null"], simp add: foundation16' dot\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y__movingat_pre_null) -by(simp add: defined_split) -lemma defined_mono_dot\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y__outer_worldat_pre : "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Galaxy) .outer_world@pre)) \<Longrightarrow> \<tau> \<Turnstile> (\<delta> (X))" - apply(case_tac "\<tau> \<Turnstile> (X \<triangleq> invalid)", insert StrongEq_L_subst2[where P = "(\<lambda>x. (\<delta> (x .outer_world@pre)))" and \<tau> = "\<tau>" and x = "X" and y = "invalid"], simp add: foundation16' dot\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y__outer_worldat_pre_invalid) - apply(case_tac "\<tau> \<Turnstile> (X \<triangleq> null)", insert StrongEq_L_subst2[where P = "(\<lambda>x. (\<delta> (x .outer_world@pre)))" and \<tau> = "\<tau>" and x = "X" and y = "null"], simp add: foundation16' dot\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y__outer_worldat_pre_null) -by(simp add: defined_split) -lemma defined_mono_dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__wormhole : "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Person) .wormhole)) \<Longrightarrow> \<tau> \<Turnstile> (\<delta> (X))" - apply(case_tac "\<tau> \<Turnstile> (X \<triangleq> invalid)", insert StrongEq_L_subst2[where P = "(\<lambda>x. (\<delta> (x .wormhole)))" and \<tau> = "\<tau>" and x = "X" and y = "invalid"], simp add: foundation16' dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__wormhole_invalid) - apply(case_tac "\<tau> \<Turnstile> (X \<triangleq> null)", insert StrongEq_L_subst2[where P = "(\<lambda>x. (\<delta> (x .wormhole)))" and \<tau> = "\<tau>" and x = "X" and y = "null"], simp add: foundation16' dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__wormhole_null) -by(simp add: defined_split) -lemma defined_mono_dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__weight : "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Person) .weight)) \<Longrightarrow> \<tau> \<Turnstile> (\<delta> (X))" - apply(case_tac "\<tau> \<Turnstile> (X \<triangleq> invalid)", insert StrongEq_L_subst2[where P = "(\<lambda>x. (\<delta> (x .weight)))" and \<tau> = "\<tau>" and x = "X" and y = "invalid"], simp add: foundation16' dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__weight_invalid) - apply(case_tac "\<tau> \<Turnstile> (X \<triangleq> null)", insert StrongEq_L_subst2[where P = "(\<lambda>x. (\<delta> (x .weight)))" and \<tau> = "\<tau>" and x = "X" and y = "null"], simp add: foundation16' dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__weight_null) -by(simp add: defined_split) -lemma defined_mono_dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__sound : "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Person) .sound)) \<Longrightarrow> \<tau> \<Turnstile> (\<delta> (X))" - apply(case_tac "\<tau> \<Turnstile> (X \<triangleq> invalid)", insert StrongEq_L_subst2[where P = "(\<lambda>x. (\<delta> (x .sound)))" and \<tau> = "\<tau>" and x = "X" and y = "invalid"], simp add: foundation16' dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__sound_invalid) - apply(case_tac "\<tau> \<Turnstile> (X \<triangleq> null)", insert StrongEq_L_subst2[where P = "(\<lambda>x. (\<delta> (x .sound)))" and \<tau> = "\<tau>" and x = "X" and y = "null"], simp add: foundation16' dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__sound_null) -by(simp add: defined_split) -lemma defined_mono_dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__moving : "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Person) .moving)) \<Longrightarrow> \<tau> \<Turnstile> (\<delta> (X))" - apply(case_tac "\<tau> \<Turnstile> (X \<triangleq> invalid)", insert StrongEq_L_subst2[where P = "(\<lambda>x. (\<delta> (x .moving)))" and \<tau> = "\<tau>" and x = "X" and y = "invalid"], simp add: foundation16' dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__moving_invalid) - apply(case_tac "\<tau> \<Turnstile> (X \<triangleq> null)", insert StrongEq_L_subst2[where P = "(\<lambda>x. (\<delta> (x .moving)))" and \<tau> = "\<tau>" and x = "X" and y = "null"], simp add: foundation16' dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__moving_null) -by(simp add: defined_split) -lemma defined_mono_dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__outer_world : "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Person) .outer_world)) \<Longrightarrow> \<tau> \<Turnstile> (\<delta> (X))" - apply(case_tac "\<tau> \<Turnstile> (X \<triangleq> invalid)", insert StrongEq_L_subst2[where P = "(\<lambda>x. (\<delta> (x .outer_world)))" and \<tau> = "\<tau>" and x = "X" and y = "invalid"], simp add: foundation16' dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__outer_world_invalid) - apply(case_tac "\<tau> \<Turnstile> (X \<triangleq> null)", insert StrongEq_L_subst2[where P = "(\<lambda>x. (\<delta> (x .outer_world)))" and \<tau> = "\<tau>" and x = "X" and y = "null"], simp add: foundation16' dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__outer_world_null) -by(simp add: defined_split) -lemma defined_mono_dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__wormholeat_pre : "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Person) .wormhole@pre)) \<Longrightarrow> \<tau> \<Turnstile> (\<delta> (X))" - apply(case_tac "\<tau> \<Turnstile> (X \<triangleq> invalid)", insert StrongEq_L_subst2[where P = "(\<lambda>x. (\<delta> (x .wormhole@pre)))" and \<tau> = "\<tau>" and x = "X" and y = "invalid"], simp add: foundation16' dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__wormholeat_pre_invalid) - apply(case_tac "\<tau> \<Turnstile> (X \<triangleq> null)", insert StrongEq_L_subst2[where P = "(\<lambda>x. (\<delta> (x .wormhole@pre)))" and \<tau> = "\<tau>" and x = "X" and y = "null"], simp add: foundation16' dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__wormholeat_pre_null) -by(simp add: defined_split) -lemma defined_mono_dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__weightat_pre : "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Person) .weight@pre)) \<Longrightarrow> \<tau> \<Turnstile> (\<delta> (X))" - apply(case_tac "\<tau> \<Turnstile> (X \<triangleq> invalid)", insert StrongEq_L_subst2[where P = "(\<lambda>x. (\<delta> (x .weight@pre)))" and \<tau> = "\<tau>" and x = "X" and y = "invalid"], simp add: foundation16' dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__weightat_pre_invalid) - apply(case_tac "\<tau> \<Turnstile> (X \<triangleq> null)", insert StrongEq_L_subst2[where P = "(\<lambda>x. (\<delta> (x .weight@pre)))" and \<tau> = "\<tau>" and x = "X" and y = "null"], simp add: foundation16' dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__weightat_pre_null) -by(simp add: defined_split) -lemma defined_mono_dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__soundat_pre : "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Person) .sound@pre)) \<Longrightarrow> \<tau> \<Turnstile> (\<delta> (X))" - apply(case_tac "\<tau> \<Turnstile> (X \<triangleq> invalid)", insert StrongEq_L_subst2[where P = "(\<lambda>x. (\<delta> (x .sound@pre)))" and \<tau> = "\<tau>" and x = "X" and y = "invalid"], simp add: foundation16' dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__soundat_pre_invalid) - apply(case_tac "\<tau> \<Turnstile> (X \<triangleq> null)", insert StrongEq_L_subst2[where P = "(\<lambda>x. (\<delta> (x .sound@pre)))" and \<tau> = "\<tau>" and x = "X" and y = "null"], simp add: foundation16' dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__soundat_pre_null) -by(simp add: defined_split) -lemma defined_mono_dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__movingat_pre : "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Person) .moving@pre)) \<Longrightarrow> \<tau> \<Turnstile> (\<delta> (X))" - apply(case_tac "\<tau> \<Turnstile> (X \<triangleq> invalid)", insert StrongEq_L_subst2[where P = "(\<lambda>x. (\<delta> (x .moving@pre)))" and \<tau> = "\<tau>" and x = "X" and y = "invalid"], simp add: foundation16' dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__movingat_pre_invalid) - apply(case_tac "\<tau> \<Turnstile> (X \<triangleq> null)", insert StrongEq_L_subst2[where P = "(\<lambda>x. (\<delta> (x .moving@pre)))" and \<tau> = "\<tau>" and x = "X" and y = "null"], simp add: foundation16' dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__movingat_pre_null) -by(simp add: defined_split) -lemma defined_mono_dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__outer_worldat_pre : "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Person) .outer_world@pre)) \<Longrightarrow> \<tau> \<Turnstile> (\<delta> (X))" - apply(case_tac "\<tau> \<Turnstile> (X \<triangleq> invalid)", insert StrongEq_L_subst2[where P = "(\<lambda>x. (\<delta> (x .outer_world@pre)))" and \<tau> = "\<tau>" and x = "X" and y = "invalid"], simp add: foundation16' dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__outer_worldat_pre_invalid) - apply(case_tac "\<tau> \<Turnstile> (X \<triangleq> null)", insert StrongEq_L_subst2[where P = "(\<lambda>x. (\<delta> (x .outer_world@pre)))" and \<tau> = "\<tau>" and x = "X" and y = "null"], simp add: foundation16' dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__outer_worldat_pre_null) -by(simp add: defined_split) -lemma defined_mono_dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__sound : "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Planet) .sound)) \<Longrightarrow> \<tau> \<Turnstile> (\<delta> (X))" - apply(case_tac "\<tau> \<Turnstile> (X \<triangleq> invalid)", insert StrongEq_L_subst2[where P = "(\<lambda>x. (\<delta> (x .sound)))" and \<tau> = "\<tau>" and x = "X" and y = "invalid"], simp add: foundation16' dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__sound_invalid) - apply(case_tac "\<tau> \<Turnstile> (X \<triangleq> null)", insert StrongEq_L_subst2[where P = "(\<lambda>x. (\<delta> (x .sound)))" and \<tau> = "\<tau>" and x = "X" and y = "null"], simp add: foundation16' dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__sound_null) -by(simp add: defined_split) -lemma defined_mono_dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__moving : "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Planet) .moving)) \<Longrightarrow> \<tau> \<Turnstile> (\<delta> (X))" - apply(case_tac "\<tau> \<Turnstile> (X \<triangleq> invalid)", insert StrongEq_L_subst2[where P = "(\<lambda>x. (\<delta> (x .moving)))" and \<tau> = "\<tau>" and x = "X" and y = "invalid"], simp add: foundation16' dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__moving_invalid) - apply(case_tac "\<tau> \<Turnstile> (X \<triangleq> null)", insert StrongEq_L_subst2[where P = "(\<lambda>x. (\<delta> (x .moving)))" and \<tau> = "\<tau>" and x = "X" and y = "null"], simp add: foundation16' dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__moving_null) -by(simp add: defined_split) -lemma defined_mono_dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__outer_world : "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Planet) .outer_world)) \<Longrightarrow> \<tau> \<Turnstile> (\<delta> (X))" - apply(case_tac "\<tau> \<Turnstile> (X \<triangleq> invalid)", insert StrongEq_L_subst2[where P = "(\<lambda>x. (\<delta> (x .outer_world)))" and \<tau> = "\<tau>" and x = "X" and y = "invalid"], simp add: foundation16' dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__outer_world_invalid) - apply(case_tac "\<tau> \<Turnstile> (X \<triangleq> null)", insert StrongEq_L_subst2[where P = "(\<lambda>x. (\<delta> (x .outer_world)))" and \<tau> = "\<tau>" and x = "X" and y = "null"], simp add: foundation16' dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__outer_world_null) -by(simp add: defined_split) -lemma defined_mono_dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__soundat_pre : "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Planet) .sound@pre)) \<Longrightarrow> \<tau> \<Turnstile> (\<delta> (X))" - apply(case_tac "\<tau> \<Turnstile> (X \<triangleq> invalid)", insert StrongEq_L_subst2[where P = "(\<lambda>x. (\<delta> (x .sound@pre)))" and \<tau> = "\<tau>" and x = "X" and y = "invalid"], simp add: foundation16' dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__soundat_pre_invalid) - apply(case_tac "\<tau> \<Turnstile> (X \<triangleq> null)", insert StrongEq_L_subst2[where P = "(\<lambda>x. (\<delta> (x .sound@pre)))" and \<tau> = "\<tau>" and x = "X" and y = "null"], simp add: foundation16' dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__soundat_pre_null) -by(simp add: defined_split) -lemma defined_mono_dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__movingat_pre : "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Planet) .moving@pre)) \<Longrightarrow> \<tau> \<Turnstile> (\<delta> (X))" - apply(case_tac "\<tau> \<Turnstile> (X \<triangleq> invalid)", insert StrongEq_L_subst2[where P = "(\<lambda>x. (\<delta> (x .moving@pre)))" and \<tau> = "\<tau>" and x = "X" and y = "invalid"], simp add: foundation16' dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__movingat_pre_invalid) - apply(case_tac "\<tau> \<Turnstile> (X \<triangleq> null)", insert StrongEq_L_subst2[where P = "(\<lambda>x. (\<delta> (x .moving@pre)))" and \<tau> = "\<tau>" and x = "X" and y = "null"], simp add: foundation16' dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__movingat_pre_null) -by(simp add: defined_split) -lemma defined_mono_dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__outer_worldat_pre : "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Planet) .outer_world@pre)) \<Longrightarrow> \<tau> \<Turnstile> (\<delta> (X))" - apply(case_tac "\<tau> \<Turnstile> (X \<triangleq> invalid)", insert StrongEq_L_subst2[where P = "(\<lambda>x. (\<delta> (x .outer_world@pre)))" and \<tau> = "\<tau>" and x = "X" and y = "invalid"], simp add: foundation16' dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__outer_worldat_pre_invalid) - apply(case_tac "\<tau> \<Turnstile> (X \<triangleq> null)", insert StrongEq_L_subst2[where P = "(\<lambda>x. (\<delta> (x .outer_world@pre)))" and \<tau> = "\<tau>" and x = "X" and y = "null"], simp add: foundation16' dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__outer_worldat_pre_null) -by(simp add: defined_split) - -(* 137 ************************************ 903 + 2 *) (* term Floor1_access.print_access_is_repr *) -lemma is_repr_dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_0___boss : -assumes def_dot: "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Person) .boss))" -shows "(is_represented_in_state (in_post_state) (X .boss) (Person) (\<tau>))" - apply(insert defined_mono_dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_0___boss[OF def_dot, simplified foundation16]) - apply(case_tac "(X (\<tau>))", simp add: bot_option_def) - proof - fix a0 show "(X (\<tau>)) = (Some (a0)) \<Longrightarrow> ?thesis" when "(X (\<tau>)) \<noteq> null" - apply(insert that, case_tac "a0", simp add: null_option_def bot_option_def, clarify) - proof - fix a show "(X (\<tau>)) = (Some ((Some (a)))) \<Longrightarrow> ?thesis" - apply(case_tac "(heap ((in_post_state (\<tau>))) ((oid_of (a))))", simp add: invalid_def bot_option_def) - apply(insert def_dot, simp add: dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_0___boss is_represented_in_state_def select\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__boss_def deref_oid\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_def in_post_state_def defined_def OclValid_def false_def true_def invalid_def bot_fun_def split: if_split_asm) - proof - fix b show "(X (\<tau>)) = (Some ((Some (a)))) \<Longrightarrow> (heap ((in_post_state (\<tau>))) ((oid_of (a)))) = (Some (b)) \<Longrightarrow> ?thesis" - apply(insert def_dot[simplified foundation16], auto simp: dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_0___boss is_represented_in_state_def deref_oid\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_def bot_option_def null_option_def) - apply(case_tac "b", simp_all add: invalid_def bot_option_def) - apply(simp add: deref_assocs\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_0___boss_def deref_assocs_def) - apply(case_tac "(assocs ((in_post_state (\<tau>))) (oid\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_0___boss))", simp add: invalid_def bot_option_def, simp add: select\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__boss_def) - proof - fix r typeoid let ?t = "(Some ((Some (r)))) \<in> (Some o OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_\<AA>) ` (ran ((heap ((in_post_state (\<tau>))))))" - let ?sel_any = "(select_object_any\<^sub>S\<^sub>e\<^sub>t ((deref_oid\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (in_post_state) (reconst_basetype))))" show "((?sel_any) (typeoid) (\<tau>)) = (Some ((Some (r)))) \<Longrightarrow> ?t" - proof - fix aa show "((?sel_any) (aa) (\<tau>)) = (Some ((Some (r)))) \<Longrightarrow> ?t" when "\<tau> \<Turnstile> (\<delta> (((?sel_any) (aa))))" - apply(insert that, drule select_object_any_exec\<^sub>S\<^sub>e\<^sub>t[simplified foundation22], erule exE) - proof - fix e show "?t" when "((?sel_any) (aa) (\<tau>)) = (Some ((Some (r))))" "((?sel_any) (aa) (\<tau>)) = (deref_oid\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (in_post_state) (reconst_basetype) (e) (\<tau>))" - apply(insert that, simp add: deref_oid\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_def) - apply(case_tac "(heap ((in_post_state (\<tau>))) (e))", simp add: invalid_def bot_option_def, simp) - proof - fix aaa show "(case aaa of (in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (obj)) \<Rightarrow> (reconst_basetype (obj) (\<tau>)) - | _ \<Rightarrow> (invalid (\<tau>))) = (Some ((Some (r)))) \<Longrightarrow> (heap ((in_post_state (\<tau>))) (e)) = (Some (aaa)) \<Longrightarrow> ?t" - apply(case_tac "aaa", auto simp: invalid_def bot_option_def image_def ran_def) - apply(rule exI[where x = "(in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (r))"], simp add: OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_\<AA>_def Let_def reconst_basetype_def split: if_split_asm) -by(rule) qed - apply_end((blast)+) - qed - apply_end(simp add: foundation16 bot_option_def null_option_def) - qed qed qed qed - apply_end(simp_all) - qed -lemma is_repr_dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_0___bossat_pre : -assumes def_dot: "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Person) .boss@pre))" -shows "(is_represented_in_state (in_pre_state) (X .boss@pre) (Person) (\<tau>))" - apply(insert defined_mono_dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_0___bossat_pre[OF def_dot, simplified foundation16]) - apply(case_tac "(X (\<tau>))", simp add: bot_option_def) - proof - fix a0 show "(X (\<tau>)) = (Some (a0)) \<Longrightarrow> ?thesis" when "(X (\<tau>)) \<noteq> null" - apply(insert that, case_tac "a0", simp add: null_option_def bot_option_def, clarify) - proof - fix a show "(X (\<tau>)) = (Some ((Some (a)))) \<Longrightarrow> ?thesis" - apply(case_tac "(heap ((in_pre_state (\<tau>))) ((oid_of (a))))", simp add: invalid_def bot_option_def) - apply(insert def_dot, simp add: dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_0___bossat_pre is_represented_in_state_def select\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__boss_def deref_oid\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_def in_pre_state_def defined_def OclValid_def false_def true_def invalid_def bot_fun_def split: if_split_asm) - proof - fix b show "(X (\<tau>)) = (Some ((Some (a)))) \<Longrightarrow> (heap ((in_pre_state (\<tau>))) ((oid_of (a)))) = (Some (b)) \<Longrightarrow> ?thesis" - apply(insert def_dot[simplified foundation16], auto simp: dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_0___bossat_pre is_represented_in_state_def deref_oid\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_def bot_option_def null_option_def) - apply(case_tac "b", simp_all add: invalid_def bot_option_def) - apply(simp add: deref_assocs\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_0___boss_def deref_assocs_def) - apply(case_tac "(assocs ((in_pre_state (\<tau>))) (oid\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_0___boss))", simp add: invalid_def bot_option_def, simp add: select\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__boss_def) - proof - fix r typeoid let ?t = "(Some ((Some (r)))) \<in> (Some o OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_\<AA>) ` (ran ((heap ((in_pre_state (\<tau>))))))" - let ?sel_any = "(select_object_any\<^sub>S\<^sub>e\<^sub>t ((deref_oid\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (in_pre_state) (reconst_basetype))))" show "((?sel_any) (typeoid) (\<tau>)) = (Some ((Some (r)))) \<Longrightarrow> ?t" - proof - fix aa show "((?sel_any) (aa) (\<tau>)) = (Some ((Some (r)))) \<Longrightarrow> ?t" when "\<tau> \<Turnstile> (\<delta> (((?sel_any) (aa))))" - apply(insert that, drule select_object_any_exec\<^sub>S\<^sub>e\<^sub>t[simplified foundation22], erule exE) - proof - fix e show "?t" when "((?sel_any) (aa) (\<tau>)) = (Some ((Some (r))))" "((?sel_any) (aa) (\<tau>)) = (deref_oid\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (in_pre_state) (reconst_basetype) (e) (\<tau>))" - apply(insert that, simp add: deref_oid\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_def) - apply(case_tac "(heap ((in_pre_state (\<tau>))) (e))", simp add: invalid_def bot_option_def, simp) - proof - fix aaa show "(case aaa of (in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (obj)) \<Rightarrow> (reconst_basetype (obj) (\<tau>)) - | _ \<Rightarrow> (invalid (\<tau>))) = (Some ((Some (r)))) \<Longrightarrow> (heap ((in_pre_state (\<tau>))) (e)) = (Some (aaa)) \<Longrightarrow> ?t" - apply(case_tac "aaa", auto simp: invalid_def bot_option_def image_def ran_def) - apply(rule exI[where x = "(in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (r))"], simp add: OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_\<AA>_def Let_def reconst_basetype_def split: if_split_asm) -by(rule) qed - apply_end((blast)+) - qed - apply_end(simp add: foundation16 bot_option_def null_option_def) - qed qed qed qed - apply_end(simp_all) - qed - -(* 138 ************************************ 905 + 0 *) (* term Floor1_access.print_access_repr_allinst *) - -(* 139 ************************************ 905 + 1 *) -section \<open>Class Model: Towards the Object Instances\<close> - -(* 140 ************************************ 906 + 1 *) -text \<open>\<close> - -(* 141 ************************************ 907 + 1 *) -text_raw \<open>\<close> - -(* 142 ************************************ 908 + 1 *) -text \<open> - -The example we are defining in this section comes from the \autoref{fig:Employee-AnalysisModel-UMLPart-generatedeam1_system-states}. -\<close> - -(* 143 ************************************ 909 + 1 *) -text_raw \<open> -\begin{figure} -\includegraphics[width=\textwidth]{figures/pre-post.pdf} -\caption{(a) pre-state $\sigma_1$ and - (b) post-state $\sigma_1'$.} -\label{fig:Employee-AnalysisModel-UMLPart-generatedeam1_system-states} -\end{figure} -\<close> - -(* 144 ************************************ 910 + 1 *) (* term Floor1_examp.print_examp_def_st_defs *) -lemmas [simp,code_unfold] = state.defs - const_ss - -(* 145 ************************************ 911 + 1 *) (* term Floor1_astype.print_astype_lemmas_id2 *) -lemmas[simp,code_unfold] = OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet - OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy - OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny - OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy - OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny - OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person - OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny - OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person - OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet - OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person - OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet - OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy - -(* 146 ************************************ 912 + 1 *) -section \<open>Instance\<close> - -(* 147 ************************************ 913 + 2 *) (* term Floor1_examp.print_examp_instance_defassoc_typecheck_var *) -definition "(typecheck_instance_bad_head_on_lhs_P1_X0_X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9_X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n8_X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7_X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6_X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5_X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4_X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3_X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2_X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1 (P1) (X0) (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9) (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n8) (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7) (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6) (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5) (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4) (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3) (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2) (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1)) = ()" -definition "typecheck_instance_extra_variables_on_rhs_P1_X0_X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9_X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n8_X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7_X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6_X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5_X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4_X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3_X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2_X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1 = (\<lambda>P1 X0 X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9 X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n8 X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7 X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6 X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5 X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4 X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3 X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2 X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1. (P1 , P1 , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7 , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7 , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2 , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2))" - -(* 148 ************************************ 915 + 11 *) (* term Floor1_examp.print_examp_instance_defassoc *) -definition "oid1 = 1" -definition "oid2 = 2" -definition "oid3 = 3" -definition "oid4 = 4" -definition "oid5 = 5" -definition "oid6 = 6" -definition "oid7 = 7" -definition "oid8 = 8" -definition "oid9 = 9" -definition "oid10 = 10" -definition "oid11 = 11" - -(* 149 ************************************ 926 + 22 *) (* term Floor1_examp.print_examp_instance *) -definition "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n = (mk\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n ((mk\<E>\<X>\<T>\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (oid1) (None) (None) (None) (None) (None))) (\<lfloor>1300\<rfloor>))" -definition "(X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1::\<cdot>Person) = ((\<lambda>_. \<lfloor>\<lfloor>X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>))" -definition "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n = (mk\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n ((mk\<E>\<X>\<T>\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (oid2) (None) (None) (None) (None) (None))) (\<lfloor>1800\<rfloor>))" -definition "(X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2::\<cdot>Person) = ((\<lambda>_. \<lfloor>\<lfloor>X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>))" -definition "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n = (mk\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n ((mk\<E>\<X>\<T>\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (oid3) (None) (None) (None) (None) (None))) (None))" -definition "(X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3::\<cdot>Person) = ((\<lambda>_. \<lfloor>\<lfloor>X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>))" -definition "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n = (mk\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n ((mk\<E>\<X>\<T>\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (oid4) (None) (None) (None) (None) (None))) (\<lfloor>2900\<rfloor>))" -definition "(X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4::\<cdot>Person) = ((\<lambda>_. \<lfloor>\<lfloor>X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>))" -definition "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n = (mk\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n ((mk\<E>\<X>\<T>\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (oid5) (None) (None) (None) (None) (None))) (\<lfloor>3500\<rfloor>))" -definition "(X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5::\<cdot>Person) = ((\<lambda>_. \<lfloor>\<lfloor>X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>))" -definition "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n = (mk\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n ((mk\<E>\<X>\<T>\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (oid6) (None) (None) (None) (None) (None))) (\<lfloor>2500\<rfloor>))" -definition "(X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6::\<cdot>Person) = ((\<lambda>_. \<lfloor>\<lfloor>X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>))" -definition "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y = (mk\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n ((mk\<E>\<X>\<T>\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (oid7) (None) (None) (None) (None) (None))) (\<lfloor>3200\<rfloor>))" -definition "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7 = ((((\<lambda>_. \<lfloor>\<lfloor>X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y\<rfloor>\<rfloor>)::\<cdot>Person)) .oclAsType(OclAny))" -definition "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n8\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y = (mk\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y ((mk\<E>\<X>\<T>\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y (oid8))))" -definition "(X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n8::\<cdot>OclAny) = ((\<lambda>_. \<lfloor>\<lfloor>X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n8\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y\<rfloor>\<rfloor>))" -definition "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n = (mk\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n ((mk\<E>\<X>\<T>\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (oid9) (None) (None) (None) (None) (None))) (\<lfloor>0\<rfloor>))" -definition "(X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9::\<cdot>Person) = ((\<lambda>_. \<lfloor>\<lfloor>X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>))" -definition "X0\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n = (mk\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n ((mk\<E>\<X>\<T>\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (oid10) (None) (None) (None) (None) (\<lfloor>[[oid11]]\<rfloor>))) (None))" -definition "(X0::\<cdot>Person) = ((\<lambda>_. \<lfloor>\<lfloor>X0\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>))" -definition "P1\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t = (mk\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t ((mk\<E>\<X>\<T>\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (oid11) (None) (None) (\<lfloor>[[oid11] , [oid11]]\<rfloor>))) (None) (None))" -definition "(P1::\<cdot>Planet) = ((\<lambda>_. \<lfloor>\<lfloor>P1\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t\<rfloor>\<rfloor>))" - -(* 150 ************************************ 948 + 1 *) (* term Floor1_examp.print_examp_instance_defassoc_typecheck *) -ML \<open>(Ty'.check ([(META.Writeln , "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1 .boss \<cong> Set{ X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2 }") , (META.Writeln , "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1 /* unnamed attribute */ \<cong> Set{}") , (META.Writeln , "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2 .boss \<cong> Set{ X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2 }") , (META.Writeln , "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2 /* unnamed attribute */ \<cong> Set{ X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1 , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2 }") , (META.Writeln , "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3 .boss \<cong> Set{}") , (META.Writeln , "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3 /* unnamed attribute */ \<cong> Set{}") , (META.Writeln , "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4 .boss \<cong> Set{}") , (META.Writeln , "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4 /* unnamed attribute */ \<cong> Set{}") , (META.Writeln , "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5 .boss \<cong> Set{}") , (META.Writeln , "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5 /* unnamed attribute */ \<cong> Set{}") , (META.Writeln , "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6 .boss \<cong> Set{ X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7 }") , (META.Writeln , "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6 /* unnamed attribute */ \<cong> Set{}") , (META.Writeln , "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7 .boss \<cong> Set{ X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7 }") , (META.Writeln , "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7 /* unnamed attribute */ \<cong> Set{ X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6 , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7 }") , (META.Writeln , "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9 .boss \<cong> Set{}") , (META.Writeln , "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9 /* unnamed attribute */ \<cong> Set{}") , (META.Writeln , "X0 .boss \<cong> Set{}") , (META.Writeln , "X0 /* unnamed attribute */ \<cong> Set{}")]) (" error(s)"))\<close> - -(* 151 ************************************ 949 + 1 *) -section \<open>State (Floor 1)\<close> - -(* 152 ************************************ 950 + 2 *) (* term Floor1_examp.print_examp_def_st_typecheck_var *) -definition "(typecheck_state_bad_head_on_lhs_\<sigma>\<^sub>1 (\<sigma>\<^sub>1)) = ()" -definition "typecheck_state_extra_variables_on_rhs_\<sigma>\<^sub>1 = (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9 , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6 , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5 , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4 , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2 , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1)" - -(* 153 ************************************ 952 + 4 *) (* term Floor1_examp.print_examp_def_st1 *) -generation_syntax [ shallow (generation_semantics [ analysis ]) ] -setup \<open>(Generation_mode.update_compiler_config ((K (let open META in Compiler_env_config_ext (true, NONE, Oids ((Code_Numeral.natural_of_integer 0), (Code_Numeral.natural_of_integer 1), (Code_Numeral.natural_of_integer 12)), I ((Code_Numeral.natural_of_integer 0), (Code_Numeral.natural_of_integer 0)), Gen_only_analysis, SOME (OclClass ((META.SS_base (META.ST "OclAny")), nil, uncurry cons (OclClass ((META.SS_base (META.ST "Galaxy")), uncurry cons (I ((META.SS_base (META.ST "sound")), OclTy_base_void), uncurry cons (I ((META.SS_base (META.ST "moving")), OclTy_base_boolean), uncurry cons (I ((META.SS_base (META.ST "outer_world")), OclTy_collection (Ocl_multiplicity_ext (nil, NONE, uncurry cons (Set, nil), ()), OclTy_collection (Ocl_multiplicity_ext (nil, NONE, uncurry cons (Sequence, nil), ()), OclTy_object (OclTyObj (OclTyCore_pre ((META.SS_base (META.ST "Planet"))), nil))))), nil))), uncurry cons (OclClass ((META.SS_base (META.ST "Planet")), uncurry cons (I ((META.SS_base (META.ST "wormhole")), OclTy_base_unlimitednatural), uncurry cons (I ((META.SS_base (META.ST "weight")), OclTy_base_integer), nil)), uncurry cons (OclClass ((META.SS_base (META.ST "Person")), uncurry cons (I ((META.SS_base (META.ST "boss")), OclTy_object (OclTyObj (OclTyCore (Ocl_ty_class_ext ((META.SS_base (META.ST "oid")), (Code_Numeral.natural_of_integer 0), (Code_Numeral.natural_of_integer 2), Ocl_ty_class_node_ext ((Code_Numeral.natural_of_integer 0), Ocl_multiplicity_ext (uncurry cons (I (Mult_star, NONE), nil), NONE, nil, ()), (META.SS_base (META.ST "Person")), ()), Ocl_ty_class_node_ext ((Code_Numeral.natural_of_integer 1), Ocl_multiplicity_ext (uncurry cons (I (Mult_nat ((Code_Numeral.natural_of_integer 0)), SOME (Mult_nat ((Code_Numeral.natural_of_integer 1)))), nil), SOME ((META.SS_base (META.ST "boss"))), nil, ()), (META.SS_base (META.ST "Person")), ()), ())), nil))), uncurry cons (I ((META.SS_base (META.ST "salary")), OclTy_base_integer), nil)), nil), nil)), nil)), nil))), uncurry cons (META_instance (OclInstance (uncurry cons (Ocl_instance_single_ext (SOME ((META.SS_base (META.ST "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1"))), SOME ((META.SS_base (META.ST "Person"))), NONE, OclAttrNoCast (uncurry cons (I (NONE, I ((META.SS_base (META.ST "salary")), ShallB_term (OclDefInteger ((META.SS_base (META.ST "1300")))))), uncurry cons (I (NONE, I ((META.SS_base (META.ST "boss")), ShallB_str ((META.SS_base (META.ST "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2"))))), nil))), ()), uncurry cons (Ocl_instance_single_ext (SOME ((META.SS_base (META.ST "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2"))), SOME ((META.SS_base (META.ST "Person"))), NONE, OclAttrNoCast (uncurry cons (I (NONE, I ((META.SS_base (META.ST "salary")), ShallB_term (OclDefInteger ((META.SS_base (META.ST "1800")))))), uncurry cons (I (NONE, I ((META.SS_base (META.ST "boss")), ShallB_str ((META.SS_base (META.ST "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2"))))), nil))), ()), uncurry cons (Ocl_instance_single_ext (SOME ((META.SS_base (META.ST "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3"))), SOME ((META.SS_base (META.ST "Person"))), NONE, OclAttrNoCast (nil), ()), uncurry cons (Ocl_instance_single_ext (SOME ((META.SS_base (META.ST "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4"))), SOME ((META.SS_base (META.ST "Person"))), NONE, OclAttrNoCast (uncurry cons (I (NONE, I ((META.SS_base (META.ST "salary")), ShallB_term (OclDefInteger ((META.SS_base (META.ST "2900")))))), nil)), ()), uncurry cons (Ocl_instance_single_ext (SOME ((META.SS_base (META.ST "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5"))), SOME ((META.SS_base (META.ST "Person"))), NONE, OclAttrNoCast (uncurry cons (I (NONE, I ((META.SS_base (META.ST "salary")), ShallB_term (OclDefInteger ((META.SS_base (META.ST "3500")))))), nil)), ()), uncurry cons (Ocl_instance_single_ext (SOME ((META.SS_base (META.ST "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6"))), SOME ((META.SS_base (META.ST "Person"))), NONE, OclAttrNoCast (uncurry cons (I (NONE, I ((META.SS_base (META.ST "salary")), ShallB_term (OclDefInteger ((META.SS_base (META.ST "2500")))))), uncurry cons (I (NONE, I ((META.SS_base (META.ST "boss")), ShallB_str ((META.SS_base (META.ST "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7"))))), nil))), ()), uncurry cons (Ocl_instance_single_ext (SOME ((META.SS_base (META.ST "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7"))), NONE, NONE, OclAttrCast ((META.SS_base (META.ST "OclAny")), OclAttrCast ((META.SS_base (META.ST "Person")), OclAttrNoCast (uncurry cons (I (NONE, I ((META.SS_base (META.ST "salary")), ShallB_term (OclDefInteger ((META.SS_base (META.ST "3200")))))), uncurry cons (I (NONE, I ((META.SS_base (META.ST "boss")), ShallB_str ((META.SS_base (META.ST "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7"))))), nil))), nil), nil), ()), uncurry cons (Ocl_instance_single_ext (SOME ((META.SS_base (META.ST "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n8"))), SOME ((META.SS_base (META.ST "OclAny"))), NONE, OclAttrNoCast (nil), ()), uncurry cons (Ocl_instance_single_ext (SOME ((META.SS_base (META.ST "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9"))), SOME ((META.SS_base (META.ST "Person"))), NONE, OclAttrNoCast (uncurry cons (I (NONE, I ((META.SS_base (META.ST "salary")), ShallB_term (OclDefInteger ((META.SS_base (META.ST "0")))))), nil)), ()), uncurry cons (Ocl_instance_single_ext (SOME ((META.SS_base (META.ST "X0"))), SOME ((META.SS_base (META.ST "Person"))), NONE, OclAttrNoCast (uncurry cons (I (NONE, I ((META.SS_base (META.ST "outer_world")), ShallB_list (uncurry cons (ShallB_list (uncurry cons (ShallB_str ((META.SS_base (META.ST "P1"))), nil)), nil)))), nil)), ()), uncurry cons (Ocl_instance_single_ext (SOME ((META.SS_base (META.ST "P1"))), SOME ((META.SS_base (META.ST "Planet"))), NONE, OclAttrNoCast (uncurry cons (I (NONE, I ((META.SS_base (META.ST "outer_world")), ShallB_list (uncurry cons (ShallB_list (uncurry cons (ShallB_str ((META.SS_base (META.ST "P1"))), nil)), uncurry cons (ShallB_list (uncurry cons (ShallB_self (Oid ((Code_Numeral.natural_of_integer 10))), nil)), nil))))), nil)), ()), nil))))))))))))), uncurry cons (META_class_raw (Floor1, Ocl_class_raw_ext (OclTyObj (OclTyCore_pre ((META.SS_base (META.ST "Galaxy"))), nil), uncurry cons (I ((META.SS_base (META.ST "sound")), OclTy_base_void), uncurry cons (I ((META.SS_base (META.ST "moving")), OclTy_base_boolean), uncurry cons (I ((META.SS_base (META.ST "outer_world")), OclTy_collection (Ocl_multiplicity_ext (nil, NONE, uncurry cons (Set, nil), ()), OclTy_binding (I (NONE, OclTy_collection (Ocl_multiplicity_ext (nil, NONE, uncurry cons (Sequence, nil), ()), OclTy_binding (I (NONE, OclTy_object (OclTyObj (OclTyCore_pre ((META.SS_base (META.ST "Planet"))), nil))))))))), nil))), nil, false, ())), uncurry cons (META_class_raw (Floor1, Ocl_class_raw_ext (OclTyObj (OclTyCore_pre ((META.SS_base (META.ST "Planet"))), uncurry cons (uncurry cons (OclTyCore_pre ((META.SS_base (META.ST "Galaxy"))), nil), nil)), uncurry cons (I ((META.SS_base (META.ST "wormhole")), OclTy_base_unlimitednatural), uncurry cons (I ((META.SS_base (META.ST "weight")), OclTy_base_integer), nil)), nil, false, ())), uncurry cons (META_association (Ocl_association_ext (OclAssTy_association, OclAssRel (uncurry cons (I (OclTyObj (OclTyCore_pre ((META.SS_base (META.ST "Person"))), nil), Ocl_multiplicity_ext (uncurry cons (I (Mult_star, NONE), nil), NONE, nil, ())), uncurry cons (I (OclTyObj (OclTyCore_pre ((META.SS_base (META.ST "Person"))), nil), Ocl_multiplicity_ext (uncurry cons (I (Mult_nat ((Code_Numeral.natural_of_integer 0)), SOME (Mult_nat ((Code_Numeral.natural_of_integer 1)))), nil), SOME ((META.SS_base (META.ST "boss"))), nil, ())), nil))), ())), uncurry cons (META_class_raw (Floor1, Ocl_class_raw_ext (OclTyObj (OclTyCore_pre ((META.SS_base (META.ST "Person"))), uncurry cons (uncurry cons (OclTyCore_pre ((META.SS_base (META.ST "Planet"))), nil), nil)), uncurry cons (I ((META.SS_base (META.ST "salary")), OclTy_base_integer), nil), nil, false, ())), nil))))), uncurry cons (I ((META.ST "P1"), I (Ocl_instance_single_ext (SOME ((META.SS_base (META.ST "P1"))), SOME ((META.SS_base (META.ST "Planet"))), NONE, OclAttrNoCast (uncurry cons (I (NONE, I ((META.SS_base (META.ST "outer_world")), ShallB_list (uncurry cons (ShallB_list (uncurry cons (ShallB_str ((META.SS_base (META.ST "P1"))), nil)), uncurry cons (ShallB_list (uncurry cons (ShallB_str ((META.SS_base (META.ST "P1"))), nil)), nil))))), nil)), ()), Oids ((Code_Numeral.natural_of_integer 0), (Code_Numeral.natural_of_integer 1), (Code_Numeral.natural_of_integer 11)))), uncurry cons (I ((META.ST "X0"), I (Ocl_instance_single_ext (SOME ((META.SS_base (META.ST "X0"))), SOME ((META.SS_base (META.ST "Person"))), NONE, OclAttrNoCast (uncurry cons (I (NONE, I ((META.SS_base (META.ST "outer_world")), ShallB_list (uncurry cons (ShallB_list (uncurry cons (ShallB_str ((META.SS_base (META.ST "P1"))), nil)), nil)))), nil)), ()), Oids ((Code_Numeral.natural_of_integer 0), (Code_Numeral.natural_of_integer 1), (Code_Numeral.natural_of_integer 10)))), uncurry cons (I ((META.ST "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9"), I (Ocl_instance_single_ext (SOME ((META.SS_base (META.ST "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9"))), SOME ((META.SS_base (META.ST "Person"))), NONE, OclAttrNoCast (uncurry cons (I (NONE, I ((META.SS_base (META.ST "salary")), ShallB_term (OclDefInteger ((META.SS_base (META.ST "0")))))), nil)), ()), Oids ((Code_Numeral.natural_of_integer 0), (Code_Numeral.natural_of_integer 1), (Code_Numeral.natural_of_integer 9)))), uncurry cons (I ((META.ST "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n8"), I (Ocl_instance_single_ext (SOME ((META.SS_base (META.ST "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n8"))), SOME ((META.SS_base (META.ST "OclAny"))), NONE, OclAttrNoCast (nil), ()), Oids ((Code_Numeral.natural_of_integer 0), (Code_Numeral.natural_of_integer 1), (Code_Numeral.natural_of_integer 8)))), uncurry cons (I ((META.ST "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7"), I (Ocl_instance_single_ext (SOME ((META.SS_base (META.ST "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7"))), NONE, NONE, OclAttrCast ((META.SS_base (META.ST "OclAny")), OclAttrCast ((META.SS_base (META.ST "Person")), OclAttrNoCast (uncurry cons (I (NONE, I ((META.SS_base (META.ST "salary")), ShallB_term (OclDefInteger ((META.SS_base (META.ST "3200")))))), uncurry cons (I (NONE, I ((META.SS_base (META.ST "boss")), ShallB_str ((META.SS_base (META.ST "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7"))))), nil))), nil), nil), ()), Oids ((Code_Numeral.natural_of_integer 0), (Code_Numeral.natural_of_integer 1), (Code_Numeral.natural_of_integer 7)))), uncurry cons (I ((META.ST "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6"), I (Ocl_instance_single_ext (SOME ((META.SS_base (META.ST "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6"))), SOME ((META.SS_base (META.ST "Person"))), NONE, OclAttrNoCast (uncurry cons (I (NONE, I ((META.SS_base (META.ST "salary")), ShallB_term (OclDefInteger ((META.SS_base (META.ST "2500")))))), uncurry cons (I (NONE, I ((META.SS_base (META.ST "boss")), ShallB_str ((META.SS_base (META.ST "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7"))))), nil))), ()), Oids ((Code_Numeral.natural_of_integer 0), (Code_Numeral.natural_of_integer 1), (Code_Numeral.natural_of_integer 6)))), uncurry cons (I ((META.ST "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5"), I (Ocl_instance_single_ext (SOME ((META.SS_base (META.ST "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5"))), SOME ((META.SS_base (META.ST "Person"))), NONE, OclAttrNoCast (uncurry cons (I (NONE, I ((META.SS_base (META.ST "salary")), ShallB_term (OclDefInteger ((META.SS_base (META.ST "3500")))))), nil)), ()), Oids ((Code_Numeral.natural_of_integer 0), (Code_Numeral.natural_of_integer 1), (Code_Numeral.natural_of_integer 5)))), uncurry cons (I ((META.ST "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4"), I (Ocl_instance_single_ext (SOME ((META.SS_base (META.ST "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4"))), SOME ((META.SS_base (META.ST "Person"))), NONE, OclAttrNoCast (uncurry cons (I (NONE, I ((META.SS_base (META.ST "salary")), ShallB_term (OclDefInteger ((META.SS_base (META.ST "2900")))))), nil)), ()), Oids ((Code_Numeral.natural_of_integer 0), (Code_Numeral.natural_of_integer 1), (Code_Numeral.natural_of_integer 4)))), uncurry cons (I ((META.ST "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3"), I (Ocl_instance_single_ext (SOME ((META.SS_base (META.ST "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3"))), SOME ((META.SS_base (META.ST "Person"))), NONE, OclAttrNoCast (nil), ()), Oids ((Code_Numeral.natural_of_integer 0), (Code_Numeral.natural_of_integer 1), (Code_Numeral.natural_of_integer 3)))), uncurry cons (I ((META.ST "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2"), I (Ocl_instance_single_ext (SOME ((META.SS_base (META.ST "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2"))), SOME ((META.SS_base (META.ST "Person"))), NONE, OclAttrNoCast (uncurry cons (I (NONE, I ((META.SS_base (META.ST "salary")), ShallB_term (OclDefInteger ((META.SS_base (META.ST "1800")))))), uncurry cons (I (NONE, I ((META.SS_base (META.ST "boss")), ShallB_str ((META.SS_base (META.ST "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2"))))), nil))), ()), Oids ((Code_Numeral.natural_of_integer 0), (Code_Numeral.natural_of_integer 1), (Code_Numeral.natural_of_integer 2)))), uncurry cons (I ((META.ST "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1"), I (Ocl_instance_single_ext (SOME ((META.SS_base (META.ST "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1"))), SOME ((META.SS_base (META.ST "Person"))), NONE, OclAttrNoCast (uncurry cons (I (NONE, I ((META.SS_base (META.ST "salary")), ShallB_term (OclDefInteger ((META.SS_base (META.ST "1300")))))), uncurry cons (I (NONE, I ((META.SS_base (META.ST "boss")), ShallB_str ((META.SS_base (META.ST "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2"))))), nil))), ()), Oids ((Code_Numeral.natural_of_integer 0), (Code_Numeral.natural_of_integer 1), (Code_Numeral.natural_of_integer 1)))), nil))))))))))), nil, true, false, I (uncurry cons ((META.ST "dot__outer_worldat_pre"), uncurry cons ((META.ST "dot__movingat_pre"), uncurry cons ((META.ST "dot__soundat_pre"), uncurry cons ((META.ST "dot__weightat_pre"), uncurry cons ((META.ST "dot__wormholeat_pre"), uncurry cons ((META.ST "dot__salaryat_pre"), uncurry cons ((META.ST "dot_0___bossat_pre"), nil))))))), uncurry cons ((META.ST "dot__outer_world"), uncurry cons ((META.ST "dot__moving"), uncurry cons ((META.ST "dot__sound"), uncurry cons ((META.ST "dot__weight"), uncurry cons ((META.ST "dot__wormhole"), uncurry cons ((META.ST "dot__salary"), uncurry cons ((META.ST "dot_0___boss"), nil)))))))), uncurry cons ((META.ST "Sequence_Person"), uncurry cons ((META.ST "Set_Person"), uncurry cons ((META.ST "Set_Sequence_Planet"), nil))), nil, I (NONE, false), ()) end))))\<close> -Instance \<sigma>\<^sub>1_object0 :: Person = [ X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1 with_only "salary" = 1000, "boss" = self 1 ] - and \<sigma>\<^sub>1_object1 :: Person = [ X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2 with_only "salary" = 1200 ] - and \<sigma>\<^sub>1_object2 :: Person = [ X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4 with_only "salary" = 2600, "boss" = X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5 ] - and \<sigma>\<^sub>1_object4 :: Person = [ X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6 with_only "salary" = 2300, "boss" = self 2 ] -State[shallow] \<sigma>\<^sub>1 = [ \<sigma>\<^sub>1_object0, \<sigma>\<^sub>1_object1, \<sigma>\<^sub>1_object2, X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5, \<sigma>\<^sub>1_object4, X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9 ] - -(* 154 ************************************ 956 + 1 *) -section \<open>State (Floor 1)\<close> - -(* 155 ************************************ 957 + 2 *) (* term Floor1_examp.print_examp_def_st_typecheck_var *) -definition "(typecheck_state_bad_head_on_lhs_\<sigma>\<^sub>1' (\<sigma>\<^sub>1')) = ()" -definition "typecheck_state_extra_variables_on_rhs_\<sigma>\<^sub>1' = (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9 , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n8 , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7 , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6 , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4 , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3 , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2 , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1)" - -(* 156 ************************************ 959 + 1 *) (* term Floor1_examp.print_examp_def_st1 *) -State[shallow] \<sigma>\<^sub>1' = [ X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1, X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2, X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3, X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4, X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6, X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7, X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n8, X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9 ] - -(* 157 ************************************ 960 + 1 *) -section \<open>Transition (Floor 1)\<close> - -(* 158 ************************************ 961 + 1 *) (* term Floor1_examp.print_transition *) -Transition[shallow] \<sigma>\<^sub>1 \<sigma>\<^sub>1' - -(* 159 ************************************ 962 + 1 *) -section \<open>Context (Floor 1)\<close> - -(* 160 ************************************ 963 + 4 *) (* term Floor1_ctxt.print_ctxt *) -type_synonym Set_Integer = "(\<AA>, Integer\<^sub>b\<^sub>a\<^sub>s\<^sub>e Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e) val" -consts dot__contents :: "(\<AA>, '\<alpha>) val \<Rightarrow> (Set_Integer)" ("(_) .contents'(')") -consts dot__contentsat_pre :: "(\<AA>, '\<alpha>) val \<Rightarrow> (Set_Integer)" ("(_) .contents@pre'(')") -Context[shallow] Person :: contents () : Set(Integer) - Post : "(\<lambda> result self. (result \<triangleq> if (self .boss \<doteq> null) - then (Set{}->including\<^sub>S\<^sub>e\<^sub>t(self .salary)) - else (self .boss .contents()->including\<^sub>S\<^sub>e\<^sub>t(self .salary)) - endif))" - Post : "(\<lambda> result self. (true))" - Pre : "(\<lambda> self. (false))" - -(* 161 ************************************ 967 + 1 *) -section \<open>Context (Floor 1)\<close> - -(* 162 ************************************ 968 + 1 *) (* term Floor1_ctxt.print_ctxt *) -Context[shallow] Person Inv a : "(\<lambda> self. (self .boss <> null implies (self .salary \<triangleq> ((self .boss) .salary))))" - -(* 163 ************************************ 969 + 1 *) -section \<open>Context (Floor 1)\<close> - -(* 164 ************************************ 970 + 1 *) (* term Floor1_ctxt.print_ctxt *) -Context[shallow] Planet Inv A : "(\<lambda> self. (true and (self .weight \<le>\<^sub>i\<^sub>n\<^sub>t \<zero>)))" - -end diff --git a/Citadelle/doc/Employee_AnalysisModel_UMLPart_generated_generated.thy b/Citadelle/doc/Employee_AnalysisModel_UMLPart_generated_generated.thy deleted file mode 100644 index cea6b714d971b3d86238e241fc6d51e2f32961d7..0000000000000000000000000000000000000000 --- a/Citadelle/doc/Employee_AnalysisModel_UMLPart_generated_generated.thy +++ /dev/null @@ -1,4711 +0,0 @@ -theory Employee_AnalysisModel_UMLPart_generated_generated imports "OCL.UML_Main" "FOCL.Static" "FOCL.Generator_dynamic_sequential" begin - -(* 1 ************************************ 0 + 0 *) (* term Floor1_infra.print_infra_enum_synonym *) - -(* 2 ************************************ 0 + 1 *) -text \<open>\<close> - -(* 3 ************************************ 1 + 1 *) -text \<open> - \label{ex:Employee-AnalysisModel-UMLPart-generated-generatedemployee-analysis:uml} \<close> - -(* 4 ************************************ 2 + 1 *) -section \<open>Class Model: Introduction\<close> - -(* 5 ************************************ 3 + 1 *) -text \<open> - - For certain concepts like classes and class-types, only a generic - definition for its resulting semantics can be given. Generic means, - there is a function outside \HOL that ``compiles'' a concrete, - closed-world class diagram into a ``theory'' of this data model, - consisting of a bunch of definitions for classes, accessors, method, - casts, and tests for actual types, as well as proofs for the - fundamental properties of these operations in this concrete data - model. \<close> - -(* 6 ************************************ 4 + 1 *) -text \<open> - Such generic function or ``compiler'' can be implemented in - Isabelle on the \ML level. This has been done, for a semantics - following the open-world assumption, for \UML 2.0 - in~\cite{brucker.ea:extensible:2008-b, brucker:interactive:2007}. In - this paper, we follow another approach for \UML 2.4: we define the - concepts of the compilation informally, and present a concrete - example which is verified in Isabelle/\HOL. \<close> - -(* 7 ************************************ 5 + 1 *) -subsection \<open>Outlining the Example\<close> - -(* 8 ************************************ 6 + 1 *) -text \<open>\<close> - -(* 9 ************************************ 7 + 1 *) -text \<open> - We are presenting here an ``analysis-model'' of the (slightly -modified) example Figure 7.3, page 20 of -the \OCL standard~\cite{omg:ocl:2012}. -Here, analysis model means that associations -were really represented as relation on objects on the state---as is -intended by the standard---rather by pointers between objects as is -done in our ``design model''. -To be precise, this theory contains the formalization of the data-part -covered by the \UML class model (see \autoref{fig:Employee-AnalysisModel-UMLPart-generated-generatedperson-ana}):\<close> - -(* 10 ************************************ 8 + 1 *) -text_raw \<open>\<close> - -(* 11 ************************************ 9 + 1 *) -text_raw \<open> - -\begin{figure} - \centering\scalebox{.3}{\includegraphics{figures/person.png}}% - \caption{A simple \UML class model drawn from Figure 7.3, - page 20 of~\cite{omg:ocl:2012}. \label{fig:Employee-AnalysisModel-UMLPart-generated-generatedperson-ana}} -\end{figure} -\<close> - -(* 12 ************************************ 10 + 1 *) -text \<open> - This means that the association (attached to the association class -\inlineocl{EmployeeRanking}) with the association ends \inlineocl+boss+ and \inlineocl+employees+ is implemented -by the attribute \inlineocl+boss+ and the operation \inlineocl+employees+ (to be discussed in the \OCL part -captured by the subsequent theory). -\<close> - -(* 13 ************************************ 11 + 1 *) -section \<open>Class Model: The Construction of the Object Universe\<close> - -(* 14 ************************************ 12 + 1 *) -text \<open> - Our data universe consists in the concrete class diagram just of node's, -and implicitly of the class object. Each class implies the existence of a class -type defined for the corresponding object representations as follows: \<close> - -(* 15 ************************************ 13 + 8 *) (* term Floor1_infra.print_infra_datatype_class_1 *) -datatype ty\<E>\<X>\<T>\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n = mk\<E>\<X>\<T>\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n "oid" "nat option" "int option" "unit option" "bool option" "oid list list option" -datatype ty\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n = mk\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n "ty\<E>\<X>\<T>\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n" "int option" -datatype ty\<E>\<X>\<T>\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t = mk\<E>\<X>\<T>\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n "ty\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n" - | mk\<E>\<X>\<T>\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t "oid" "unit option" "bool option" "oid list list option" -datatype ty\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t = mk\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t "ty\<E>\<X>\<T>\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t" "nat option" "int option" -datatype ty\<E>\<X>\<T>\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y = mk\<E>\<X>\<T>\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t "ty\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t" - | mk\<E>\<X>\<T>\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n "ty\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n" - | mk\<E>\<X>\<T>\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y "oid" -datatype ty\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y = mk\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y "ty\<E>\<X>\<T>\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y" "unit option" "bool option" "oid list list option" -datatype ty\<E>\<X>\<T>\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y = mk\<E>\<X>\<T>\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y "ty\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y" - | mk\<E>\<X>\<T>\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t "ty\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t" - | mk\<E>\<X>\<T>\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n "ty\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n" - | mk\<E>\<X>\<T>\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y "oid" -datatype ty\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y = mk\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y "ty\<E>\<X>\<T>\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y" - -(* 16 ************************************ 21 + 11 *) (* term Floor1_infra.print_infra_datatype_class_2 *) -datatype ty2\<E>\<X>\<T>\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n = mk2\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n "int option" -datatype ty2oid\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n = mk2oid\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n "oid" "nat option" "int option" "unit option" "bool option" "oid list list option" "ty2\<E>\<X>\<T>\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n" -datatype ty2\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t = mk2\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n "ty2\<E>\<X>\<T>\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n" -datatype ty2\<E>\<X>\<T>\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t = mk2\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t "nat option" "int option" "ty2\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t option" -datatype ty2oid\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t = mk2oid\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t "oid" "unit option" "bool option" "oid list list option" "ty2\<E>\<X>\<T>\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t" -datatype ty2\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y = mk2\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t "ty2\<E>\<X>\<T>\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t" -datatype ty2\<E>\<X>\<T>\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y = mk2\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y "unit option" "bool option" "oid list list option" "ty2\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y option" -datatype ty2oid\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y = mk2oid\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y "oid" "ty2\<E>\<X>\<T>\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y" -datatype ty2\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y = mk2\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y "ty2\<E>\<X>\<T>\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y" -datatype ty2\<E>\<X>\<T>\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y = mk2\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y "ty2\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y option" -datatype ty2oid\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y = mk2oid\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y "oid" "ty2\<E>\<X>\<T>\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y" - -(* 17 ************************************ 32 + 8 *) (* term Floor1_infra.print_infra_datatype_equiv_2of1 *) -definition "class_ty_ext_equiv_2of1_aux\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n = (\<lambda>oid inh\<^sub>w\<^sub>o\<^sub>r\<^sub>m\<^sub>h\<^sub>o\<^sub>l\<^sub>e inh\<^sub>w\<^sub>e\<^sub>i\<^sub>g\<^sub>h\<^sub>t inh\<^sub>s\<^sub>o\<^sub>u\<^sub>n\<^sub>d inh\<^sub>m\<^sub>o\<^sub>v\<^sub>i\<^sub>n\<^sub>g inh\<^sub>o\<^sub>u\<^sub>t\<^sub>e\<^sub>r\<^sub>_\<^sub>w\<^sub>o\<^sub>r\<^sub>l\<^sub>d. (\<lambda> (mk2\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (own\<^sub>s\<^sub>a\<^sub>l\<^sub>a\<^sub>r\<^sub>y)) \<Rightarrow> (mk\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n ((mk\<E>\<X>\<T>\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (oid) (inh\<^sub>w\<^sub>o\<^sub>r\<^sub>m\<^sub>h\<^sub>o\<^sub>l\<^sub>e) (inh\<^sub>w\<^sub>e\<^sub>i\<^sub>g\<^sub>h\<^sub>t) (inh\<^sub>s\<^sub>o\<^sub>u\<^sub>n\<^sub>d) (inh\<^sub>m\<^sub>o\<^sub>v\<^sub>i\<^sub>n\<^sub>g) (inh\<^sub>o\<^sub>u\<^sub>t\<^sub>e\<^sub>r\<^sub>_\<^sub>w\<^sub>o\<^sub>r\<^sub>l\<^sub>d))) (own\<^sub>s\<^sub>a\<^sub>l\<^sub>a\<^sub>r\<^sub>y))))" -definition "class_ty_ext_equiv_2of1\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n = (\<lambda> (mk2oid\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (oid) (inh\<^sub>w\<^sub>o\<^sub>r\<^sub>m\<^sub>h\<^sub>o\<^sub>l\<^sub>e) (inh\<^sub>w\<^sub>e\<^sub>i\<^sub>g\<^sub>h\<^sub>t) (inh\<^sub>s\<^sub>o\<^sub>u\<^sub>n\<^sub>d) (inh\<^sub>m\<^sub>o\<^sub>v\<^sub>i\<^sub>n\<^sub>g) (inh\<^sub>o\<^sub>u\<^sub>t\<^sub>e\<^sub>r\<^sub>_\<^sub>w\<^sub>o\<^sub>r\<^sub>l\<^sub>d) (t)) \<Rightarrow> (class_ty_ext_equiv_2of1_aux\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (oid) (inh\<^sub>w\<^sub>o\<^sub>r\<^sub>m\<^sub>h\<^sub>o\<^sub>l\<^sub>e) (inh\<^sub>w\<^sub>e\<^sub>i\<^sub>g\<^sub>h\<^sub>t) (inh\<^sub>s\<^sub>o\<^sub>u\<^sub>n\<^sub>d) (inh\<^sub>m\<^sub>o\<^sub>v\<^sub>i\<^sub>n\<^sub>g) (inh\<^sub>o\<^sub>u\<^sub>t\<^sub>e\<^sub>r\<^sub>_\<^sub>w\<^sub>o\<^sub>r\<^sub>l\<^sub>d) (t)))" -definition "class_ty_ext_equiv_2of1_aux\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t = (\<lambda>oid inh\<^sub>s\<^sub>o\<^sub>u\<^sub>n\<^sub>d inh\<^sub>m\<^sub>o\<^sub>v\<^sub>i\<^sub>n\<^sub>g inh\<^sub>o\<^sub>u\<^sub>t\<^sub>e\<^sub>r\<^sub>_\<^sub>w\<^sub>o\<^sub>r\<^sub>l\<^sub>d. (\<lambda> (mk2\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (own\<^sub>w\<^sub>o\<^sub>r\<^sub>m\<^sub>h\<^sub>o\<^sub>l\<^sub>e) (own\<^sub>w\<^sub>e\<^sub>i\<^sub>g\<^sub>h\<^sub>t) (t)) \<Rightarrow> (mk\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t ((case t of None \<Rightarrow> (mk\<E>\<X>\<T>\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (oid) (inh\<^sub>s\<^sub>o\<^sub>u\<^sub>n\<^sub>d) (inh\<^sub>m\<^sub>o\<^sub>v\<^sub>i\<^sub>n\<^sub>g) (inh\<^sub>o\<^sub>u\<^sub>t\<^sub>e\<^sub>r\<^sub>_\<^sub>w\<^sub>o\<^sub>r\<^sub>l\<^sub>d)) - | \<lfloor>(mk2\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (t))\<rfloor> \<Rightarrow> (case (class_ty_ext_equiv_2of1_aux\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (oid) (own\<^sub>w\<^sub>o\<^sub>r\<^sub>m\<^sub>h\<^sub>o\<^sub>l\<^sub>e) (own\<^sub>w\<^sub>e\<^sub>i\<^sub>g\<^sub>h\<^sub>t) (inh\<^sub>s\<^sub>o\<^sub>u\<^sub>n\<^sub>d) (inh\<^sub>m\<^sub>o\<^sub>v\<^sub>i\<^sub>n\<^sub>g) (inh\<^sub>o\<^sub>u\<^sub>t\<^sub>e\<^sub>r\<^sub>_\<^sub>w\<^sub>o\<^sub>r\<^sub>l\<^sub>d) (t)) of (mk\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n ((mk\<E>\<X>\<T>\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (oid) (own\<^sub>w\<^sub>o\<^sub>r\<^sub>m\<^sub>h\<^sub>o\<^sub>l\<^sub>e) (own\<^sub>w\<^sub>e\<^sub>i\<^sub>g\<^sub>h\<^sub>t) (inh\<^sub>s\<^sub>o\<^sub>u\<^sub>n\<^sub>d) (inh\<^sub>m\<^sub>o\<^sub>v\<^sub>i\<^sub>n\<^sub>g) (inh\<^sub>o\<^sub>u\<^sub>t\<^sub>e\<^sub>r\<^sub>_\<^sub>w\<^sub>o\<^sub>r\<^sub>l\<^sub>d))) (own\<^sub>s\<^sub>a\<^sub>l\<^sub>a\<^sub>r\<^sub>y)) \<Rightarrow> (mk\<E>\<X>\<T>\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n ((mk\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n ((mk\<E>\<X>\<T>\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (oid) (own\<^sub>w\<^sub>o\<^sub>r\<^sub>m\<^sub>h\<^sub>o\<^sub>l\<^sub>e) (own\<^sub>w\<^sub>e\<^sub>i\<^sub>g\<^sub>h\<^sub>t) (inh\<^sub>s\<^sub>o\<^sub>u\<^sub>n\<^sub>d) (inh\<^sub>m\<^sub>o\<^sub>v\<^sub>i\<^sub>n\<^sub>g) (inh\<^sub>o\<^sub>u\<^sub>t\<^sub>e\<^sub>r\<^sub>_\<^sub>w\<^sub>o\<^sub>r\<^sub>l\<^sub>d))) (own\<^sub>s\<^sub>a\<^sub>l\<^sub>a\<^sub>r\<^sub>y))))))) (own\<^sub>w\<^sub>o\<^sub>r\<^sub>m\<^sub>h\<^sub>o\<^sub>l\<^sub>e) (own\<^sub>w\<^sub>e\<^sub>i\<^sub>g\<^sub>h\<^sub>t))))" -definition "class_ty_ext_equiv_2of1\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t = (\<lambda> (mk2oid\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (oid) (inh\<^sub>s\<^sub>o\<^sub>u\<^sub>n\<^sub>d) (inh\<^sub>m\<^sub>o\<^sub>v\<^sub>i\<^sub>n\<^sub>g) (inh\<^sub>o\<^sub>u\<^sub>t\<^sub>e\<^sub>r\<^sub>_\<^sub>w\<^sub>o\<^sub>r\<^sub>l\<^sub>d) (t)) \<Rightarrow> (class_ty_ext_equiv_2of1_aux\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (oid) (inh\<^sub>s\<^sub>o\<^sub>u\<^sub>n\<^sub>d) (inh\<^sub>m\<^sub>o\<^sub>v\<^sub>i\<^sub>n\<^sub>g) (inh\<^sub>o\<^sub>u\<^sub>t\<^sub>e\<^sub>r\<^sub>_\<^sub>w\<^sub>o\<^sub>r\<^sub>l\<^sub>d) (t)))" -definition "class_ty_ext_equiv_2of1_aux\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y = (\<lambda>oid. (\<lambda> (mk2\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y (own\<^sub>s\<^sub>o\<^sub>u\<^sub>n\<^sub>d) (own\<^sub>m\<^sub>o\<^sub>v\<^sub>i\<^sub>n\<^sub>g) (own\<^sub>o\<^sub>u\<^sub>t\<^sub>e\<^sub>r\<^sub>_\<^sub>w\<^sub>o\<^sub>r\<^sub>l\<^sub>d) (t)) \<Rightarrow> (mk\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y ((case t of None \<Rightarrow> (mk\<E>\<X>\<T>\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y (oid)) - | \<lfloor>(mk2\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (t))\<rfloor> \<Rightarrow> (case (class_ty_ext_equiv_2of1_aux\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (oid) (own\<^sub>s\<^sub>o\<^sub>u\<^sub>n\<^sub>d) (own\<^sub>m\<^sub>o\<^sub>v\<^sub>i\<^sub>n\<^sub>g) (own\<^sub>o\<^sub>u\<^sub>t\<^sub>e\<^sub>r\<^sub>_\<^sub>w\<^sub>o\<^sub>r\<^sub>l\<^sub>d) (t)) of (mk\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t ((mk\<E>\<X>\<T>\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (oid) (own\<^sub>s\<^sub>o\<^sub>u\<^sub>n\<^sub>d) (own\<^sub>m\<^sub>o\<^sub>v\<^sub>i\<^sub>n\<^sub>g) (own\<^sub>o\<^sub>u\<^sub>t\<^sub>e\<^sub>r\<^sub>_\<^sub>w\<^sub>o\<^sub>r\<^sub>l\<^sub>d))) (own\<^sub>w\<^sub>o\<^sub>r\<^sub>m\<^sub>h\<^sub>o\<^sub>l\<^sub>e) (own\<^sub>w\<^sub>e\<^sub>i\<^sub>g\<^sub>h\<^sub>t)) \<Rightarrow> (mk\<E>\<X>\<T>\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t ((mk\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t ((mk\<E>\<X>\<T>\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (oid) (own\<^sub>s\<^sub>o\<^sub>u\<^sub>n\<^sub>d) (own\<^sub>m\<^sub>o\<^sub>v\<^sub>i\<^sub>n\<^sub>g) (own\<^sub>o\<^sub>u\<^sub>t\<^sub>e\<^sub>r\<^sub>_\<^sub>w\<^sub>o\<^sub>r\<^sub>l\<^sub>d))) (own\<^sub>w\<^sub>o\<^sub>r\<^sub>m\<^sub>h\<^sub>o\<^sub>l\<^sub>e) (own\<^sub>w\<^sub>e\<^sub>i\<^sub>g\<^sub>h\<^sub>t)))) - | (mk\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t ((mk\<E>\<X>\<T>\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (t))) (own\<^sub>w\<^sub>o\<^sub>r\<^sub>m\<^sub>h\<^sub>o\<^sub>l\<^sub>e) (own\<^sub>w\<^sub>e\<^sub>i\<^sub>g\<^sub>h\<^sub>t)) \<Rightarrow> (mk\<E>\<X>\<T>\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (t))))) (own\<^sub>s\<^sub>o\<^sub>u\<^sub>n\<^sub>d) (own\<^sub>m\<^sub>o\<^sub>v\<^sub>i\<^sub>n\<^sub>g) (own\<^sub>o\<^sub>u\<^sub>t\<^sub>e\<^sub>r\<^sub>_\<^sub>w\<^sub>o\<^sub>r\<^sub>l\<^sub>d))))" -definition "class_ty_ext_equiv_2of1\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y = (\<lambda> (mk2oid\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y (oid) (t)) \<Rightarrow> (class_ty_ext_equiv_2of1_aux\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y (oid) (t)))" -definition "class_ty_ext_equiv_2of1_aux\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y = (\<lambda>oid. (\<lambda> (mk2\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y (t)) \<Rightarrow> (mk\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y ((case t of None \<Rightarrow> (mk\<E>\<X>\<T>\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y (oid)) - | \<lfloor>(mk2\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y (t))\<rfloor> \<Rightarrow> (case (class_ty_ext_equiv_2of1_aux\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y (oid) (t)) of (mk\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y ((mk\<E>\<X>\<T>\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y (oid))) (own\<^sub>s\<^sub>o\<^sub>u\<^sub>n\<^sub>d) (own\<^sub>m\<^sub>o\<^sub>v\<^sub>i\<^sub>n\<^sub>g) (own\<^sub>o\<^sub>u\<^sub>t\<^sub>e\<^sub>r\<^sub>_\<^sub>w\<^sub>o\<^sub>r\<^sub>l\<^sub>d)) \<Rightarrow> (mk\<E>\<X>\<T>\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y ((mk\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y ((mk\<E>\<X>\<T>\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y (oid))) (own\<^sub>s\<^sub>o\<^sub>u\<^sub>n\<^sub>d) (own\<^sub>m\<^sub>o\<^sub>v\<^sub>i\<^sub>n\<^sub>g) (own\<^sub>o\<^sub>u\<^sub>t\<^sub>e\<^sub>r\<^sub>_\<^sub>w\<^sub>o\<^sub>r\<^sub>l\<^sub>d)))) - | (mk\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y ((mk\<E>\<X>\<T>\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (t))) (own\<^sub>s\<^sub>o\<^sub>u\<^sub>n\<^sub>d) (own\<^sub>m\<^sub>o\<^sub>v\<^sub>i\<^sub>n\<^sub>g) (own\<^sub>o\<^sub>u\<^sub>t\<^sub>e\<^sub>r\<^sub>_\<^sub>w\<^sub>o\<^sub>r\<^sub>l\<^sub>d)) \<Rightarrow> (mk\<E>\<X>\<T>\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (t)) - | (mk\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y ((mk\<E>\<X>\<T>\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (t))) (own\<^sub>s\<^sub>o\<^sub>u\<^sub>n\<^sub>d) (own\<^sub>m\<^sub>o\<^sub>v\<^sub>i\<^sub>n\<^sub>g) (own\<^sub>o\<^sub>u\<^sub>t\<^sub>e\<^sub>r\<^sub>_\<^sub>w\<^sub>o\<^sub>r\<^sub>l\<^sub>d)) \<Rightarrow> (mk\<E>\<X>\<T>\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (t))))))))" -definition "class_ty_ext_equiv_2of1\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y = (\<lambda> (mk2oid\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y (oid) (t)) \<Rightarrow> (class_ty_ext_equiv_2of1_aux\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y (oid) (t)))" - -(* 18 ************************************ 40 + 12 *) (* term Floor1_infra.print_infra_datatype_equiv_1of2 *) -definition "class_ty_ext_equiv_1of2_get_oid_inh\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n = (\<lambda> (mk\<E>\<X>\<T>\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (oid) (inh\<^sub>w\<^sub>o\<^sub>r\<^sub>m\<^sub>h\<^sub>o\<^sub>l\<^sub>e) (inh\<^sub>w\<^sub>e\<^sub>i\<^sub>g\<^sub>h\<^sub>t) (inh\<^sub>s\<^sub>o\<^sub>u\<^sub>n\<^sub>d) (inh\<^sub>m\<^sub>o\<^sub>v\<^sub>i\<^sub>n\<^sub>g) (inh\<^sub>o\<^sub>u\<^sub>t\<^sub>e\<^sub>r\<^sub>_\<^sub>w\<^sub>o\<^sub>r\<^sub>l\<^sub>d)) \<Rightarrow> (oid , inh\<^sub>w\<^sub>o\<^sub>r\<^sub>m\<^sub>h\<^sub>o\<^sub>l\<^sub>e , inh\<^sub>w\<^sub>e\<^sub>i\<^sub>g\<^sub>h\<^sub>t , inh\<^sub>s\<^sub>o\<^sub>u\<^sub>n\<^sub>d , inh\<^sub>m\<^sub>o\<^sub>v\<^sub>i\<^sub>n\<^sub>g , inh\<^sub>o\<^sub>u\<^sub>t\<^sub>e\<^sub>r\<^sub>_\<^sub>w\<^sub>o\<^sub>r\<^sub>l\<^sub>d))" -definition "class_ty_ext_equiv_1of2_aux\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n = (\<lambda> (mk\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (t) (own\<^sub>s\<^sub>a\<^sub>l\<^sub>a\<^sub>r\<^sub>y)) \<Rightarrow> (mk2\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (own\<^sub>s\<^sub>a\<^sub>l\<^sub>a\<^sub>r\<^sub>y)))" -definition "class_ty_ext_equiv_1of2\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n = (\<lambda> (mk\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (t) (own\<^sub>s\<^sub>a\<^sub>l\<^sub>a\<^sub>r\<^sub>y)) \<Rightarrow> (case (class_ty_ext_equiv_1of2_get_oid_inh\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (t)) of (oid , inh\<^sub>w\<^sub>o\<^sub>r\<^sub>m\<^sub>h\<^sub>o\<^sub>l\<^sub>e , inh\<^sub>w\<^sub>e\<^sub>i\<^sub>g\<^sub>h\<^sub>t , inh\<^sub>s\<^sub>o\<^sub>u\<^sub>n\<^sub>d , inh\<^sub>m\<^sub>o\<^sub>v\<^sub>i\<^sub>n\<^sub>g , inh\<^sub>o\<^sub>u\<^sub>t\<^sub>e\<^sub>r\<^sub>_\<^sub>w\<^sub>o\<^sub>r\<^sub>l\<^sub>d) \<Rightarrow> (mk2oid\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (oid) (inh\<^sub>w\<^sub>o\<^sub>r\<^sub>m\<^sub>h\<^sub>o\<^sub>l\<^sub>e) (inh\<^sub>w\<^sub>e\<^sub>i\<^sub>g\<^sub>h\<^sub>t) (inh\<^sub>s\<^sub>o\<^sub>u\<^sub>n\<^sub>d) (inh\<^sub>m\<^sub>o\<^sub>v\<^sub>i\<^sub>n\<^sub>g) (inh\<^sub>o\<^sub>u\<^sub>t\<^sub>e\<^sub>r\<^sub>_\<^sub>w\<^sub>o\<^sub>r\<^sub>l\<^sub>d) ((class_ty_ext_equiv_1of2_aux\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n ((mk\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (t) (own\<^sub>s\<^sub>a\<^sub>l\<^sub>a\<^sub>r\<^sub>y))))))))" -definition "class_ty_ext_equiv_1of2_get_oid_inh\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t = (\<lambda> (mk\<E>\<X>\<T>\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (oid) (inh\<^sub>s\<^sub>o\<^sub>u\<^sub>n\<^sub>d) (inh\<^sub>m\<^sub>o\<^sub>v\<^sub>i\<^sub>n\<^sub>g) (inh\<^sub>o\<^sub>u\<^sub>t\<^sub>e\<^sub>r\<^sub>_\<^sub>w\<^sub>o\<^sub>r\<^sub>l\<^sub>d)) \<Rightarrow> (oid , inh\<^sub>s\<^sub>o\<^sub>u\<^sub>n\<^sub>d , inh\<^sub>m\<^sub>o\<^sub>v\<^sub>i\<^sub>n\<^sub>g , inh\<^sub>o\<^sub>u\<^sub>t\<^sub>e\<^sub>r\<^sub>_\<^sub>w\<^sub>o\<^sub>r\<^sub>l\<^sub>d) - | (mk\<E>\<X>\<T>\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n ((mk\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (t) (var\<^sub>s\<^sub>a\<^sub>l\<^sub>a\<^sub>r\<^sub>y)))) \<Rightarrow> (case (class_ty_ext_equiv_1of2_get_oid_inh\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (t)) of (oid , var\<^sub>w\<^sub>o\<^sub>r\<^sub>m\<^sub>h\<^sub>o\<^sub>l\<^sub>e , var\<^sub>w\<^sub>e\<^sub>i\<^sub>g\<^sub>h\<^sub>t , var\<^sub>s\<^sub>o\<^sub>u\<^sub>n\<^sub>d , var\<^sub>m\<^sub>o\<^sub>v\<^sub>i\<^sub>n\<^sub>g , var\<^sub>o\<^sub>u\<^sub>t\<^sub>e\<^sub>r\<^sub>_\<^sub>w\<^sub>o\<^sub>r\<^sub>l\<^sub>d) \<Rightarrow> (oid , var\<^sub>s\<^sub>o\<^sub>u\<^sub>n\<^sub>d , var\<^sub>m\<^sub>o\<^sub>v\<^sub>i\<^sub>n\<^sub>g , var\<^sub>o\<^sub>u\<^sub>t\<^sub>e\<^sub>r\<^sub>_\<^sub>w\<^sub>o\<^sub>r\<^sub>l\<^sub>d)))" -definition "class_ty_ext_equiv_1of2_aux\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t = (\<lambda> (mk\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (t) (own\<^sub>w\<^sub>o\<^sub>r\<^sub>m\<^sub>h\<^sub>o\<^sub>l\<^sub>e) (own\<^sub>w\<^sub>e\<^sub>i\<^sub>g\<^sub>h\<^sub>t)) \<Rightarrow> (mk2\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (own\<^sub>w\<^sub>o\<^sub>r\<^sub>m\<^sub>h\<^sub>o\<^sub>l\<^sub>e) (own\<^sub>w\<^sub>e\<^sub>i\<^sub>g\<^sub>h\<^sub>t) ((case t of (mk\<E>\<X>\<T>\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (oid) (inh\<^sub>s\<^sub>o\<^sub>u\<^sub>n\<^sub>d) (inh\<^sub>m\<^sub>o\<^sub>v\<^sub>i\<^sub>n\<^sub>g) (inh\<^sub>o\<^sub>u\<^sub>t\<^sub>e\<^sub>r\<^sub>_\<^sub>w\<^sub>o\<^sub>r\<^sub>l\<^sub>d)) \<Rightarrow> None - | (mk\<E>\<X>\<T>\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (tt)) \<Rightarrow> (case (case tt of (mk\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (t) (var\<^sub>s\<^sub>a\<^sub>l\<^sub>a\<^sub>r\<^sub>y)) \<Rightarrow> (class_ty_ext_equiv_1of2_get_oid_inh\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (t))) of (oid , var\<^sub>w\<^sub>o\<^sub>r\<^sub>m\<^sub>h\<^sub>o\<^sub>l\<^sub>e , var\<^sub>w\<^sub>e\<^sub>i\<^sub>g\<^sub>h\<^sub>t , var\<^sub>s\<^sub>o\<^sub>u\<^sub>n\<^sub>d , var\<^sub>m\<^sub>o\<^sub>v\<^sub>i\<^sub>n\<^sub>g , var\<^sub>o\<^sub>u\<^sub>t\<^sub>e\<^sub>r\<^sub>_\<^sub>w\<^sub>o\<^sub>r\<^sub>l\<^sub>d) \<Rightarrow> \<lfloor>(mk2\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n ((class_ty_ext_equiv_1of2_aux\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (tt))))\<rfloor>)))))" -definition "class_ty_ext_equiv_1of2\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t = (\<lambda> (mk\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (t) (own\<^sub>w\<^sub>o\<^sub>r\<^sub>m\<^sub>h\<^sub>o\<^sub>l\<^sub>e) (own\<^sub>w\<^sub>e\<^sub>i\<^sub>g\<^sub>h\<^sub>t)) \<Rightarrow> (case (class_ty_ext_equiv_1of2_get_oid_inh\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (t)) of (oid , inh\<^sub>s\<^sub>o\<^sub>u\<^sub>n\<^sub>d , inh\<^sub>m\<^sub>o\<^sub>v\<^sub>i\<^sub>n\<^sub>g , inh\<^sub>o\<^sub>u\<^sub>t\<^sub>e\<^sub>r\<^sub>_\<^sub>w\<^sub>o\<^sub>r\<^sub>l\<^sub>d) \<Rightarrow> (mk2oid\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (oid) (inh\<^sub>s\<^sub>o\<^sub>u\<^sub>n\<^sub>d) (inh\<^sub>m\<^sub>o\<^sub>v\<^sub>i\<^sub>n\<^sub>g) (inh\<^sub>o\<^sub>u\<^sub>t\<^sub>e\<^sub>r\<^sub>_\<^sub>w\<^sub>o\<^sub>r\<^sub>l\<^sub>d) ((class_ty_ext_equiv_1of2_aux\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t ((mk\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (t) (own\<^sub>w\<^sub>o\<^sub>r\<^sub>m\<^sub>h\<^sub>o\<^sub>l\<^sub>e) (own\<^sub>w\<^sub>e\<^sub>i\<^sub>g\<^sub>h\<^sub>t))))))))" -definition "class_ty_ext_equiv_1of2_get_oid_inh\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y = (\<lambda> (mk\<E>\<X>\<T>\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y (oid)) \<Rightarrow> (oid) - | (mk\<E>\<X>\<T>\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n ((mk\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (t) (var\<^sub>s\<^sub>a\<^sub>l\<^sub>a\<^sub>r\<^sub>y)))) \<Rightarrow> (case (class_ty_ext_equiv_1of2_get_oid_inh\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (t)) of (oid , var\<^sub>w\<^sub>o\<^sub>r\<^sub>m\<^sub>h\<^sub>o\<^sub>l\<^sub>e , var\<^sub>w\<^sub>e\<^sub>i\<^sub>g\<^sub>h\<^sub>t , var\<^sub>s\<^sub>o\<^sub>u\<^sub>n\<^sub>d , var\<^sub>m\<^sub>o\<^sub>v\<^sub>i\<^sub>n\<^sub>g , var\<^sub>o\<^sub>u\<^sub>t\<^sub>e\<^sub>r\<^sub>_\<^sub>w\<^sub>o\<^sub>r\<^sub>l\<^sub>d) \<Rightarrow> (oid)) - | (mk\<E>\<X>\<T>\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t ((mk\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (t) (var\<^sub>w\<^sub>o\<^sub>r\<^sub>m\<^sub>h\<^sub>o\<^sub>l\<^sub>e) (var\<^sub>w\<^sub>e\<^sub>i\<^sub>g\<^sub>h\<^sub>t)))) \<Rightarrow> (case (class_ty_ext_equiv_1of2_get_oid_inh\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (t)) of (oid , var\<^sub>s\<^sub>o\<^sub>u\<^sub>n\<^sub>d , var\<^sub>m\<^sub>o\<^sub>v\<^sub>i\<^sub>n\<^sub>g , var\<^sub>o\<^sub>u\<^sub>t\<^sub>e\<^sub>r\<^sub>_\<^sub>w\<^sub>o\<^sub>r\<^sub>l\<^sub>d) \<Rightarrow> (oid)))" -definition "class_ty_ext_equiv_1of2_aux\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y = (\<lambda> (mk\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y (t) (own\<^sub>s\<^sub>o\<^sub>u\<^sub>n\<^sub>d) (own\<^sub>m\<^sub>o\<^sub>v\<^sub>i\<^sub>n\<^sub>g) (own\<^sub>o\<^sub>u\<^sub>t\<^sub>e\<^sub>r\<^sub>_\<^sub>w\<^sub>o\<^sub>r\<^sub>l\<^sub>d)) \<Rightarrow> (mk2\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y (own\<^sub>s\<^sub>o\<^sub>u\<^sub>n\<^sub>d) (own\<^sub>m\<^sub>o\<^sub>v\<^sub>i\<^sub>n\<^sub>g) (own\<^sub>o\<^sub>u\<^sub>t\<^sub>e\<^sub>r\<^sub>_\<^sub>w\<^sub>o\<^sub>r\<^sub>l\<^sub>d) ((case t of (mk\<E>\<X>\<T>\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y (oid)) \<Rightarrow> None - | (mk\<E>\<X>\<T>\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (tt)) \<Rightarrow> (case (case tt of (mk\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (t) (var\<^sub>s\<^sub>a\<^sub>l\<^sub>a\<^sub>r\<^sub>y)) \<Rightarrow> (class_ty_ext_equiv_1of2_get_oid_inh\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (t))) of (oid , var\<^sub>w\<^sub>o\<^sub>r\<^sub>m\<^sub>h\<^sub>o\<^sub>l\<^sub>e , var\<^sub>w\<^sub>e\<^sub>i\<^sub>g\<^sub>h\<^sub>t , var\<^sub>s\<^sub>o\<^sub>u\<^sub>n\<^sub>d , var\<^sub>m\<^sub>o\<^sub>v\<^sub>i\<^sub>n\<^sub>g , var\<^sub>o\<^sub>u\<^sub>t\<^sub>e\<^sub>r\<^sub>_\<^sub>w\<^sub>o\<^sub>r\<^sub>l\<^sub>d) \<Rightarrow> \<lfloor>(mk2\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t ((mk2\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (var\<^sub>w\<^sub>o\<^sub>r\<^sub>m\<^sub>h\<^sub>o\<^sub>l\<^sub>e) (var\<^sub>w\<^sub>e\<^sub>i\<^sub>g\<^sub>h\<^sub>t) (\<lfloor>(mk2\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n ((class_ty_ext_equiv_1of2_aux\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (tt))))\<rfloor>))))\<rfloor>) - | (mk\<E>\<X>\<T>\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (tt)) \<Rightarrow> (case (case tt of (mk\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (t) (var\<^sub>w\<^sub>o\<^sub>r\<^sub>m\<^sub>h\<^sub>o\<^sub>l\<^sub>e) (var\<^sub>w\<^sub>e\<^sub>i\<^sub>g\<^sub>h\<^sub>t)) \<Rightarrow> (class_ty_ext_equiv_1of2_get_oid_inh\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (t))) of (oid , var\<^sub>s\<^sub>o\<^sub>u\<^sub>n\<^sub>d , var\<^sub>m\<^sub>o\<^sub>v\<^sub>i\<^sub>n\<^sub>g , var\<^sub>o\<^sub>u\<^sub>t\<^sub>e\<^sub>r\<^sub>_\<^sub>w\<^sub>o\<^sub>r\<^sub>l\<^sub>d) \<Rightarrow> \<lfloor>(mk2\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t ((class_ty_ext_equiv_1of2_aux\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (tt))))\<rfloor>)))))" -definition "class_ty_ext_equiv_1of2\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y = (\<lambda> (mk\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y (t) (own\<^sub>s\<^sub>o\<^sub>u\<^sub>n\<^sub>d) (own\<^sub>m\<^sub>o\<^sub>v\<^sub>i\<^sub>n\<^sub>g) (own\<^sub>o\<^sub>u\<^sub>t\<^sub>e\<^sub>r\<^sub>_\<^sub>w\<^sub>o\<^sub>r\<^sub>l\<^sub>d)) \<Rightarrow> (case (class_ty_ext_equiv_1of2_get_oid_inh\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y (t)) of (oid) \<Rightarrow> (mk2oid\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y (oid) ((class_ty_ext_equiv_1of2_aux\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y ((mk\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y (t) (own\<^sub>s\<^sub>o\<^sub>u\<^sub>n\<^sub>d) (own\<^sub>m\<^sub>o\<^sub>v\<^sub>i\<^sub>n\<^sub>g) (own\<^sub>o\<^sub>u\<^sub>t\<^sub>e\<^sub>r\<^sub>_\<^sub>w\<^sub>o\<^sub>r\<^sub>l\<^sub>d))))))))" -definition "class_ty_ext_equiv_1of2_get_oid_inh\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y = (\<lambda> (mk\<E>\<X>\<T>\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y (oid)) \<Rightarrow> (oid) - | (mk\<E>\<X>\<T>\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n ((mk\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (t) (var\<^sub>s\<^sub>a\<^sub>l\<^sub>a\<^sub>r\<^sub>y)))) \<Rightarrow> (case (class_ty_ext_equiv_1of2_get_oid_inh\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (t)) of (oid , var\<^sub>w\<^sub>o\<^sub>r\<^sub>m\<^sub>h\<^sub>o\<^sub>l\<^sub>e , var\<^sub>w\<^sub>e\<^sub>i\<^sub>g\<^sub>h\<^sub>t , var\<^sub>s\<^sub>o\<^sub>u\<^sub>n\<^sub>d , var\<^sub>m\<^sub>o\<^sub>v\<^sub>i\<^sub>n\<^sub>g , var\<^sub>o\<^sub>u\<^sub>t\<^sub>e\<^sub>r\<^sub>_\<^sub>w\<^sub>o\<^sub>r\<^sub>l\<^sub>d) \<Rightarrow> (oid)) - | (mk\<E>\<X>\<T>\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t ((mk\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (t) (var\<^sub>w\<^sub>o\<^sub>r\<^sub>m\<^sub>h\<^sub>o\<^sub>l\<^sub>e) (var\<^sub>w\<^sub>e\<^sub>i\<^sub>g\<^sub>h\<^sub>t)))) \<Rightarrow> (case (class_ty_ext_equiv_1of2_get_oid_inh\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (t)) of (oid , var\<^sub>s\<^sub>o\<^sub>u\<^sub>n\<^sub>d , var\<^sub>m\<^sub>o\<^sub>v\<^sub>i\<^sub>n\<^sub>g , var\<^sub>o\<^sub>u\<^sub>t\<^sub>e\<^sub>r\<^sub>_\<^sub>w\<^sub>o\<^sub>r\<^sub>l\<^sub>d) \<Rightarrow> (oid)) - | (mk\<E>\<X>\<T>\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y ((mk\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y (t) (var\<^sub>s\<^sub>o\<^sub>u\<^sub>n\<^sub>d) (var\<^sub>m\<^sub>o\<^sub>v\<^sub>i\<^sub>n\<^sub>g) (var\<^sub>o\<^sub>u\<^sub>t\<^sub>e\<^sub>r\<^sub>_\<^sub>w\<^sub>o\<^sub>r\<^sub>l\<^sub>d)))) \<Rightarrow> (case (class_ty_ext_equiv_1of2_get_oid_inh\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y (t)) of (oid) \<Rightarrow> (oid)))" -definition "class_ty_ext_equiv_1of2_aux\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y = (\<lambda> (mk\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y (t)) \<Rightarrow> (mk2\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y ((case t of (mk\<E>\<X>\<T>\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y (oid)) \<Rightarrow> None - | (mk\<E>\<X>\<T>\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (tt)) \<Rightarrow> (case (case tt of (mk\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (t) (var\<^sub>s\<^sub>a\<^sub>l\<^sub>a\<^sub>r\<^sub>y)) \<Rightarrow> (class_ty_ext_equiv_1of2_get_oid_inh\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (t))) of (oid , var\<^sub>w\<^sub>o\<^sub>r\<^sub>m\<^sub>h\<^sub>o\<^sub>l\<^sub>e , var\<^sub>w\<^sub>e\<^sub>i\<^sub>g\<^sub>h\<^sub>t , var\<^sub>s\<^sub>o\<^sub>u\<^sub>n\<^sub>d , var\<^sub>m\<^sub>o\<^sub>v\<^sub>i\<^sub>n\<^sub>g , var\<^sub>o\<^sub>u\<^sub>t\<^sub>e\<^sub>r\<^sub>_\<^sub>w\<^sub>o\<^sub>r\<^sub>l\<^sub>d) \<Rightarrow> \<lfloor>(mk2\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y ((mk2\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y (var\<^sub>s\<^sub>o\<^sub>u\<^sub>n\<^sub>d) (var\<^sub>m\<^sub>o\<^sub>v\<^sub>i\<^sub>n\<^sub>g) (var\<^sub>o\<^sub>u\<^sub>t\<^sub>e\<^sub>r\<^sub>_\<^sub>w\<^sub>o\<^sub>r\<^sub>l\<^sub>d) (\<lfloor>(mk2\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t ((mk2\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (var\<^sub>w\<^sub>o\<^sub>r\<^sub>m\<^sub>h\<^sub>o\<^sub>l\<^sub>e) (var\<^sub>w\<^sub>e\<^sub>i\<^sub>g\<^sub>h\<^sub>t) (\<lfloor>(mk2\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n ((class_ty_ext_equiv_1of2_aux\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (tt))))\<rfloor>))))\<rfloor>))))\<rfloor>) - | (mk\<E>\<X>\<T>\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (tt)) \<Rightarrow> (case (case tt of (mk\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (t) (var\<^sub>w\<^sub>o\<^sub>r\<^sub>m\<^sub>h\<^sub>o\<^sub>l\<^sub>e) (var\<^sub>w\<^sub>e\<^sub>i\<^sub>g\<^sub>h\<^sub>t)) \<Rightarrow> (class_ty_ext_equiv_1of2_get_oid_inh\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (t))) of (oid , var\<^sub>s\<^sub>o\<^sub>u\<^sub>n\<^sub>d , var\<^sub>m\<^sub>o\<^sub>v\<^sub>i\<^sub>n\<^sub>g , var\<^sub>o\<^sub>u\<^sub>t\<^sub>e\<^sub>r\<^sub>_\<^sub>w\<^sub>o\<^sub>r\<^sub>l\<^sub>d) \<Rightarrow> \<lfloor>(mk2\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y ((mk2\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y (var\<^sub>s\<^sub>o\<^sub>u\<^sub>n\<^sub>d) (var\<^sub>m\<^sub>o\<^sub>v\<^sub>i\<^sub>n\<^sub>g) (var\<^sub>o\<^sub>u\<^sub>t\<^sub>e\<^sub>r\<^sub>_\<^sub>w\<^sub>o\<^sub>r\<^sub>l\<^sub>d) (\<lfloor>(mk2\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t ((class_ty_ext_equiv_1of2_aux\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (tt))))\<rfloor>))))\<rfloor>) - | (mk\<E>\<X>\<T>\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y (tt)) \<Rightarrow> (case (case tt of (mk\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y (t) (var\<^sub>s\<^sub>o\<^sub>u\<^sub>n\<^sub>d) (var\<^sub>m\<^sub>o\<^sub>v\<^sub>i\<^sub>n\<^sub>g) (var\<^sub>o\<^sub>u\<^sub>t\<^sub>e\<^sub>r\<^sub>_\<^sub>w\<^sub>o\<^sub>r\<^sub>l\<^sub>d)) \<Rightarrow> (class_ty_ext_equiv_1of2_get_oid_inh\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y (t))) of (oid) \<Rightarrow> \<lfloor>(mk2\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y ((class_ty_ext_equiv_1of2_aux\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y (tt))))\<rfloor>)))))" -definition "class_ty_ext_equiv_1of2\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y = (\<lambda> (mk\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y (t)) \<Rightarrow> (case (class_ty_ext_equiv_1of2_get_oid_inh\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y (t)) of (oid) \<Rightarrow> (mk2oid\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y (oid) ((class_ty_ext_equiv_1of2_aux\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y ((mk\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y (t))))))))" - -(* 19 ************************************ 52 + 1 *) -text \<open> - Now, we construct a concrete ``universe of OclAny types'' by injection into a -sum type containing the class types. This type of OclAny will be used as instance -for all respective type-variables. \<close> - -(* 20 ************************************ 53 + 1 *) (* term Floor1_infra.print_infra_datatype_universe *) -datatype \<AA> = in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n "ty\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n" - | in\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t "ty\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t" - | in\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y "ty\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y" - | in\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y "ty\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y" - -(* 21 ************************************ 54 + 1 *) -text \<open> - Having fixed the object universe, we can introduce type synonyms that exactly correspond -to \OCL types. Again, we exploit that our representation of \OCL is a ``shallow embedding'' with a -one-to-one correspondance of \OCL-types to types of the meta-language \HOL. \<close> - -(* 22 ************************************ 55 + 7 *) (* term Floor1_infra.print_infra_type_synonym_class *) -type_synonym Void = "\<AA> Void" -type_synonym Boolean = "\<AA> Boolean" -type_synonym Integer = "\<AA> Integer" -type_synonym Real = "\<AA> Real" -type_synonym String = "\<AA> String" -type_synonym '\<alpha> val' = "(\<AA>, '\<alpha>) val" -type_notation val' ("\<cdot>(_)") - -(* 23 ************************************ 62 + 4 *) (* term Floor1_infra.print_infra_type_synonym_class_higher *) -type_synonym Person = "\<langle>\<langle>ty\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rangle>\<^sub>\<bottom>\<rangle>\<^sub>\<bottom>" -type_synonym Planet = "\<langle>\<langle>ty\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t\<rangle>\<^sub>\<bottom>\<rangle>\<^sub>\<bottom>" -type_synonym Galaxy = "\<langle>\<langle>ty\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y\<rangle>\<^sub>\<bottom>\<rangle>\<^sub>\<bottom>" -type_synonym OclAny = "\<langle>\<langle>ty\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y\<rangle>\<^sub>\<bottom>\<rangle>\<^sub>\<bottom>" - -(* 24 ************************************ 66 + 3 *) (* term Floor1_infra.print_infra_type_synonym_class_rec *) -type_synonym Sequence_Person = "(\<AA>, ty\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n option option Sequence\<^sub>b\<^sub>a\<^sub>s\<^sub>e) val" -type_synonym Set_Person = "(\<AA>, ty\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n option option Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e) val" -type_synonym Set_Sequence_Planet = "(\<AA>, ty\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t option option Sequence\<^sub>b\<^sub>a\<^sub>s\<^sub>e Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e) val" - -(* 25 ************************************ 69 + 0 *) (* term Floor1_infra.print_infra_enum_syn *) - -(* 26 ************************************ 69 + 1 *) -text \<open> - To reuse key-elements of the library like referential equality, we have -to show that the object universe belongs to the type class ``oclany,'' \ie, - each class type has to provide a function @{term oid_of} yielding the Object ID (oid) of the object. \<close> - -(* 27 ************************************ 70 + 4 *) (* term Floor1_infra.print_infra_instantiation_class *) -instantiation ty\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n :: object -begin - definition oid_of_ty\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_def : "oid_of = (\<lambda> mk\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n t _ \<Rightarrow> (case t of (mk\<E>\<X>\<T>\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (t) (_) (_) (_) (_) (_)) \<Rightarrow> t))" - instance .. -end -instantiation ty\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t :: object -begin - definition oid_of_ty\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_def : "oid_of = (\<lambda> mk\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t t _ _ \<Rightarrow> (case t of (mk\<E>\<X>\<T>\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (t) (_) (_) (_)) \<Rightarrow> t - | (mk\<E>\<X>\<T>\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (t)) \<Rightarrow> (oid_of (t))))" - instance .. -end -instantiation ty\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y :: object -begin - definition oid_of_ty\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_def : "oid_of = (\<lambda> mk\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y t _ _ _ \<Rightarrow> (case t of (mk\<E>\<X>\<T>\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y (t)) \<Rightarrow> t - | (mk\<E>\<X>\<T>\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (t)) \<Rightarrow> (oid_of (t)) - | (mk\<E>\<X>\<T>\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (t)) \<Rightarrow> (oid_of (t))))" - instance .. -end -instantiation ty\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y :: object -begin - definition oid_of_ty\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_def : "oid_of = (\<lambda> mk\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y t \<Rightarrow> (case t of (mk\<E>\<X>\<T>\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y (t)) \<Rightarrow> t - | (mk\<E>\<X>\<T>\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (t)) \<Rightarrow> (oid_of (t)) - | (mk\<E>\<X>\<T>\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (t)) \<Rightarrow> (oid_of (t)) - | (mk\<E>\<X>\<T>\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y (t)) \<Rightarrow> (oid_of (t))))" - instance .. -end - -(* 28 ************************************ 74 + 1 *) (* term Floor1_infra.print_infra_instantiation_universe *) -instantiation \<AA> :: object -begin - definition oid_of_\<AA>_def : "oid_of = (\<lambda> in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n Person \<Rightarrow> oid_of Person - | in\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t Planet \<Rightarrow> oid_of Planet - | in\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y Galaxy \<Rightarrow> oid_of Galaxy - | in\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y OclAny \<Rightarrow> oid_of OclAny)" - instance .. -end - -(* 29 ************************************ 75 + 1 *) -section \<open>Class Model: Instantiation of the Generic Strict Equality\<close> - -(* 30 ************************************ 76 + 1 *) -text \<open> - We instantiate the referential equality -on @{text "Person"} and @{text "OclAny"} \<close> - -(* 31 ************************************ 77 + 4 *) (* term Floor1_infra.print_instantia_def_strictrefeq *) -overloading StrictRefEq \<equiv> "(StrictRefEq::(\<cdot>Person) \<Rightarrow> _ \<Rightarrow> _)" -begin - definition StrictRefEq\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n : "(x::\<cdot>Person) \<doteq> y \<equiv> StrictRefEq\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t x y" -end -overloading StrictRefEq \<equiv> "(StrictRefEq::(\<cdot>Planet) \<Rightarrow> _ \<Rightarrow> _)" -begin - definition StrictRefEq\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t : "(x::\<cdot>Planet) \<doteq> y \<equiv> StrictRefEq\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t x y" -end -overloading StrictRefEq \<equiv> "(StrictRefEq::(\<cdot>Galaxy) \<Rightarrow> _ \<Rightarrow> _)" -begin - definition StrictRefEq\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y : "(x::\<cdot>Galaxy) \<doteq> y \<equiv> StrictRefEq\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t x y" -end -overloading StrictRefEq \<equiv> "(StrictRefEq::(\<cdot>OclAny) \<Rightarrow> _ \<Rightarrow> _)" -begin - definition StrictRefEq\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y : "(x::\<cdot>OclAny) \<doteq> y \<equiv> StrictRefEq\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t x y" -end - -(* 32 ************************************ 81 + 1 *) (* term Floor1_infra.print_instantia_lemmas_strictrefeq *) -lemmas[simp,code_unfold] = StrictRefEq\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n - StrictRefEq\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t - StrictRefEq\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y - StrictRefEq\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y - -(* 33 ************************************ 82 + 1 *) -text \<open> - For each Class \emph{C}, we will have a casting operation \inlineocl{.oclAsType($C$)}, - a test on the actual type \inlineocl{.oclIsTypeOf($C$)} as well as its relaxed form - \inlineocl{.oclIsKindOf($C$)} (corresponding exactly to Java's \verb+instanceof+-operator. -\<close> - -(* 34 ************************************ 83 + 1 *) -text \<open> - Thus, since we have two class-types in our concrete class hierarchy, we have -two operations to declare and to provide two overloading definitions for the two static types. -\<close> - -(* 35 ************************************ 84 + 1 *) -section \<open>Class Model: OclAsType\<close> - -(* 36 ************************************ 85 + 1 *) -subsection \<open>Definition\<close> - -(* 37 ************************************ 86 + 4 *) (* term Floor1_astype.print_astype_consts *) -consts OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n :: "'\<alpha> \<Rightarrow> \<cdot>Person" ("(_) .oclAsType'(Person')") -consts OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t :: "'\<alpha> \<Rightarrow> \<cdot>Planet" ("(_) .oclAsType'(Planet')") -consts OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y :: "'\<alpha> \<Rightarrow> \<cdot>Galaxy" ("(_) .oclAsType'(Galaxy')") -consts OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y :: "'\<alpha> \<Rightarrow> \<cdot>OclAny" ("(_) .oclAsType'(OclAny')") - -(* 38 ************************************ 90 + 16 *) (* term Floor1_astype.print_astype_class *) -overloading OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n \<equiv> "(OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n::(\<cdot>Person) \<Rightarrow> _)" -begin - definition OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person : "(x::\<cdot>Person) .oclAsType(Person) \<equiv> x" -end -overloading OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n \<equiv> "(OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n::(\<cdot>Planet) \<Rightarrow> _)" -begin - definition OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet : "(x::\<cdot>Planet) .oclAsType(Person) \<equiv> (\<lambda>\<tau>. (case (x (\<tau>)) of \<bottom> \<Rightarrow> (invalid (\<tau>)) - | \<lfloor>\<bottom>\<rfloor> \<Rightarrow> (null (\<tau>)) - | \<lfloor>\<lfloor>(mk\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t ((mk\<E>\<X>\<T>\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (Person))) (_) (_))\<rfloor>\<rfloor> \<Rightarrow> \<lfloor>\<lfloor>Person\<rfloor>\<rfloor> - | _ \<Rightarrow> (invalid (\<tau>))))" -end -overloading OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n \<equiv> "(OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n::(\<cdot>Galaxy) \<Rightarrow> _)" -begin - definition OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy : "(x::\<cdot>Galaxy) .oclAsType(Person) \<equiv> (\<lambda>\<tau>. (case (x (\<tau>)) of \<bottom> \<Rightarrow> (invalid (\<tau>)) - | \<lfloor>\<bottom>\<rfloor> \<Rightarrow> (null (\<tau>)) - | \<lfloor>\<lfloor>(mk\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y ((mk\<E>\<X>\<T>\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (Person))) (_) (_) (_))\<rfloor>\<rfloor> \<Rightarrow> \<lfloor>\<lfloor>Person\<rfloor>\<rfloor> - | _ \<Rightarrow> (invalid (\<tau>))))" -end -overloading OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n \<equiv> "(OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n::(\<cdot>OclAny) \<Rightarrow> _)" -begin - definition OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny : "(x::\<cdot>OclAny) .oclAsType(Person) \<equiv> (\<lambda>\<tau>. (case (x (\<tau>)) of \<bottom> \<Rightarrow> (invalid (\<tau>)) - | \<lfloor>\<bottom>\<rfloor> \<Rightarrow> (null (\<tau>)) - | \<lfloor>\<lfloor>(mk\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y ((mk\<E>\<X>\<T>\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (Person))))\<rfloor>\<rfloor> \<Rightarrow> \<lfloor>\<lfloor>Person\<rfloor>\<rfloor> - | _ \<Rightarrow> (invalid (\<tau>))))" -end -overloading OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t \<equiv> "(OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t::(\<cdot>Planet) \<Rightarrow> _)" -begin - definition OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet : "(x::\<cdot>Planet) .oclAsType(Planet) \<equiv> x" -end -overloading OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t \<equiv> "(OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t::(\<cdot>Galaxy) \<Rightarrow> _)" -begin - definition OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy : "(x::\<cdot>Galaxy) .oclAsType(Planet) \<equiv> (\<lambda>\<tau>. (case (x (\<tau>)) of \<bottom> \<Rightarrow> (invalid (\<tau>)) - | \<lfloor>\<bottom>\<rfloor> \<Rightarrow> (null (\<tau>)) - | \<lfloor>\<lfloor>(mk\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y ((mk\<E>\<X>\<T>\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (Planet))) (_) (_) (_))\<rfloor>\<rfloor> \<Rightarrow> \<lfloor>\<lfloor>Planet\<rfloor>\<rfloor> - | _ \<Rightarrow> (invalid (\<tau>))))" -end -overloading OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t \<equiv> "(OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t::(\<cdot>OclAny) \<Rightarrow> _)" -begin - definition OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny : "(x::\<cdot>OclAny) .oclAsType(Planet) \<equiv> (\<lambda>\<tau>. (case (x (\<tau>)) of \<bottom> \<Rightarrow> (invalid (\<tau>)) - | \<lfloor>\<bottom>\<rfloor> \<Rightarrow> (null (\<tau>)) - | \<lfloor>\<lfloor>(mk\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y ((mk\<E>\<X>\<T>\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (Planet))))\<rfloor>\<rfloor> \<Rightarrow> \<lfloor>\<lfloor>Planet\<rfloor>\<rfloor> - | _ \<Rightarrow> (invalid (\<tau>))))" -end -overloading OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t \<equiv> "(OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t::(\<cdot>Person) \<Rightarrow> _)" -begin - definition OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person : "(x::\<cdot>Person) .oclAsType(Planet) \<equiv> (\<lambda>\<tau>. (case (x (\<tau>)) of \<bottom> \<Rightarrow> (invalid (\<tau>)) - | \<lfloor>\<bottom>\<rfloor> \<Rightarrow> (null (\<tau>)) - | \<lfloor>\<lfloor>Person\<rfloor>\<rfloor> \<Rightarrow> \<lfloor>\<lfloor>(mk\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t ((mk\<E>\<X>\<T>\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (Person))) (None) (None))\<rfloor>\<rfloor>))" -end -overloading OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y \<equiv> "(OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y::(\<cdot>Galaxy) \<Rightarrow> _)" -begin - definition OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy : "(x::\<cdot>Galaxy) .oclAsType(Galaxy) \<equiv> x" -end -overloading OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y \<equiv> "(OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y::(\<cdot>OclAny) \<Rightarrow> _)" -begin - definition OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny : "(x::\<cdot>OclAny) .oclAsType(Galaxy) \<equiv> (\<lambda>\<tau>. (case (x (\<tau>)) of \<bottom> \<Rightarrow> (invalid (\<tau>)) - | \<lfloor>\<bottom>\<rfloor> \<Rightarrow> (null (\<tau>)) - | \<lfloor>\<lfloor>(mk\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y ((mk\<E>\<X>\<T>\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y (Galaxy))))\<rfloor>\<rfloor> \<Rightarrow> \<lfloor>\<lfloor>Galaxy\<rfloor>\<rfloor> - | _ \<Rightarrow> (invalid (\<tau>))))" -end -overloading OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y \<equiv> "(OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y::(\<cdot>Person) \<Rightarrow> _)" -begin - definition OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person : "(x::\<cdot>Person) .oclAsType(Galaxy) \<equiv> (\<lambda>\<tau>. (case (x (\<tau>)) of \<bottom> \<Rightarrow> (invalid (\<tau>)) - | \<lfloor>\<bottom>\<rfloor> \<Rightarrow> (null (\<tau>)) - | \<lfloor>\<lfloor>Person\<rfloor>\<rfloor> \<Rightarrow> \<lfloor>\<lfloor>(mk\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y ((mk\<E>\<X>\<T>\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (Person))) (None) (None) (None))\<rfloor>\<rfloor>))" -end -overloading OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y \<equiv> "(OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y::(\<cdot>Planet) \<Rightarrow> _)" -begin - definition OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet : "(x::\<cdot>Planet) .oclAsType(Galaxy) \<equiv> (\<lambda>\<tau>. (case (x (\<tau>)) of \<bottom> \<Rightarrow> (invalid (\<tau>)) - | \<lfloor>\<bottom>\<rfloor> \<Rightarrow> (null (\<tau>)) - | \<lfloor>\<lfloor>Planet\<rfloor>\<rfloor> \<Rightarrow> \<lfloor>\<lfloor>(mk\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y ((mk\<E>\<X>\<T>\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (Planet))) (None) (None) (None))\<rfloor>\<rfloor>))" -end -overloading OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y \<equiv> "(OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y::(\<cdot>OclAny) \<Rightarrow> _)" -begin - definition OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny : "(x::\<cdot>OclAny) .oclAsType(OclAny) \<equiv> x" -end -overloading OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y \<equiv> "(OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y::(\<cdot>Person) \<Rightarrow> _)" -begin - definition OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person : "(x::\<cdot>Person) .oclAsType(OclAny) \<equiv> (\<lambda>\<tau>. (case (x (\<tau>)) of \<bottom> \<Rightarrow> (invalid (\<tau>)) - | \<lfloor>\<bottom>\<rfloor> \<Rightarrow> (null (\<tau>)) - | \<lfloor>\<lfloor>Person\<rfloor>\<rfloor> \<Rightarrow> \<lfloor>\<lfloor>(mk\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y ((mk\<E>\<X>\<T>\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (Person))))\<rfloor>\<rfloor>))" -end -overloading OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y \<equiv> "(OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y::(\<cdot>Planet) \<Rightarrow> _)" -begin - definition OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet : "(x::\<cdot>Planet) .oclAsType(OclAny) \<equiv> (\<lambda>\<tau>. (case (x (\<tau>)) of \<bottom> \<Rightarrow> (invalid (\<tau>)) - | \<lfloor>\<bottom>\<rfloor> \<Rightarrow> (null (\<tau>)) - | \<lfloor>\<lfloor>Planet\<rfloor>\<rfloor> \<Rightarrow> \<lfloor>\<lfloor>(mk\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y ((mk\<E>\<X>\<T>\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (Planet))))\<rfloor>\<rfloor>))" -end -overloading OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y \<equiv> "(OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y::(\<cdot>Galaxy) \<Rightarrow> _)" -begin - definition OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy : "(x::\<cdot>Galaxy) .oclAsType(OclAny) \<equiv> (\<lambda>\<tau>. (case (x (\<tau>)) of \<bottom> \<Rightarrow> (invalid (\<tau>)) - | \<lfloor>\<bottom>\<rfloor> \<Rightarrow> (null (\<tau>)) - | \<lfloor>\<lfloor>Galaxy\<rfloor>\<rfloor> \<Rightarrow> \<lfloor>\<lfloor>(mk\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y ((mk\<E>\<X>\<T>\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y (Galaxy))))\<rfloor>\<rfloor>))" -end - -(* 39 ************************************ 106 + 4 *) (* term Floor1_astype.print_astype_from_universe *) -definition "OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_\<AA> = (\<lambda> (in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (Person)) \<Rightarrow> \<lfloor>Person\<rfloor> - | (in\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t ((mk\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t ((mk\<E>\<X>\<T>\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (Person))) (_) (_)))) \<Rightarrow> \<lfloor>Person\<rfloor> - | (in\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y ((mk\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y ((mk\<E>\<X>\<T>\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (Person))) (_) (_) (_)))) \<Rightarrow> \<lfloor>Person\<rfloor> - | (in\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y ((mk\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y ((mk\<E>\<X>\<T>\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (Person)))))) \<Rightarrow> \<lfloor>Person\<rfloor> - | _ \<Rightarrow> None)" -definition "OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_\<AA> = (\<lambda> (in\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (Planet)) \<Rightarrow> \<lfloor>Planet\<rfloor> - | (in\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y ((mk\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y ((mk\<E>\<X>\<T>\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (Planet))) (_) (_) (_)))) \<Rightarrow> \<lfloor>Planet\<rfloor> - | (in\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y ((mk\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y ((mk\<E>\<X>\<T>\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (Planet)))))) \<Rightarrow> \<lfloor>Planet\<rfloor> - | (in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (Person)) \<Rightarrow> \<lfloor>(mk\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t ((mk\<E>\<X>\<T>\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (Person))) (None) (None))\<rfloor> - | _ \<Rightarrow> None)" -definition "OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_\<AA> = (\<lambda> (in\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y (Galaxy)) \<Rightarrow> \<lfloor>Galaxy\<rfloor> - | (in\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y ((mk\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y ((mk\<E>\<X>\<T>\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y (Galaxy)))))) \<Rightarrow> \<lfloor>Galaxy\<rfloor> - | (in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (Person)) \<Rightarrow> \<lfloor>(mk\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y ((mk\<E>\<X>\<T>\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (Person))) (None) (None) (None))\<rfloor> - | (in\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (Planet)) \<Rightarrow> \<lfloor>(mk\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y ((mk\<E>\<X>\<T>\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (Planet))) (None) (None) (None))\<rfloor> - | _ \<Rightarrow> None)" -definition "OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_\<AA> = Some o (\<lambda> (in\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y (OclAny)) \<Rightarrow> OclAny - | (in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (Person)) \<Rightarrow> (mk\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y ((mk\<E>\<X>\<T>\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (Person)))) - | (in\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (Planet)) \<Rightarrow> (mk\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y ((mk\<E>\<X>\<T>\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (Planet)))) - | (in\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y (Galaxy)) \<Rightarrow> (mk\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y ((mk\<E>\<X>\<T>\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y (Galaxy)))))" - -(* 40 ************************************ 110 + 1 *) (* term Floor1_astype.print_astype_lemmas_id *) -lemmas[simp,code_unfold] = OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person - OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet - OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy - OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny - -(* 41 ************************************ 111 + 1 *) -subsection \<open>Context Passing\<close> - -(* 42 ************************************ 112 + 64 *) (* term Floor1_astype.print_astype_lemma_cp *) -lemma cp_OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_OclAny : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>OclAny)))::\<cdot>OclAny) .oclAsType(OclAny)))))" -by(rule cpI1, simp) -lemma cp_OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy_OclAny : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Galaxy)))::\<cdot>OclAny) .oclAsType(OclAny)))))" -by(rule cpI1, simp) -lemma cp_OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet_OclAny : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Planet)))::\<cdot>OclAny) .oclAsType(OclAny)))))" -by(rule cpI1, simp) -lemma cp_OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_OclAny : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Person)))::\<cdot>OclAny) .oclAsType(OclAny)))))" -by(rule cpI1, simp) -lemma cp_OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_Galaxy : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>OclAny)))::\<cdot>Galaxy) .oclAsType(OclAny)))))" -by(rule cpI1, simp add: OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy) -lemma cp_OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy_Galaxy : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Galaxy)))::\<cdot>Galaxy) .oclAsType(OclAny)))))" -by(rule cpI1, simp add: OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy) -lemma cp_OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet_Galaxy : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Planet)))::\<cdot>Galaxy) .oclAsType(OclAny)))))" -by(rule cpI1, simp add: OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy) -lemma cp_OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_Galaxy : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Person)))::\<cdot>Galaxy) .oclAsType(OclAny)))))" -by(rule cpI1, simp add: OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy) -lemma cp_OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_Planet : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>OclAny)))::\<cdot>Planet) .oclAsType(OclAny)))))" -by(rule cpI1, simp add: OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet) -lemma cp_OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy_Planet : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Galaxy)))::\<cdot>Planet) .oclAsType(OclAny)))))" -by(rule cpI1, simp add: OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet) -lemma cp_OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet_Planet : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Planet)))::\<cdot>Planet) .oclAsType(OclAny)))))" -by(rule cpI1, simp add: OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet) -lemma cp_OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_Planet : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Person)))::\<cdot>Planet) .oclAsType(OclAny)))))" -by(rule cpI1, simp add: OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet) -lemma cp_OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_Person : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>OclAny)))::\<cdot>Person) .oclAsType(OclAny)))))" -by(rule cpI1, simp add: OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person) -lemma cp_OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy_Person : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Galaxy)))::\<cdot>Person) .oclAsType(OclAny)))))" -by(rule cpI1, simp add: OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person) -lemma cp_OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet_Person : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Planet)))::\<cdot>Person) .oclAsType(OclAny)))))" -by(rule cpI1, simp add: OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person) -lemma cp_OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_Person : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Person)))::\<cdot>Person) .oclAsType(OclAny)))))" -by(rule cpI1, simp add: OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person) -lemma cp_OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny_OclAny : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>OclAny)))::\<cdot>OclAny) .oclAsType(Galaxy)))))" -by(rule cpI1, simp add: OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny) -lemma cp_OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy_OclAny : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Galaxy)))::\<cdot>OclAny) .oclAsType(Galaxy)))))" -by(rule cpI1, simp add: OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny) -lemma cp_OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet_OclAny : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Planet)))::\<cdot>OclAny) .oclAsType(Galaxy)))))" -by(rule cpI1, simp add: OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny) -lemma cp_OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person_OclAny : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Person)))::\<cdot>OclAny) .oclAsType(Galaxy)))))" -by(rule cpI1, simp add: OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny) -lemma cp_OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny_Galaxy : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>OclAny)))::\<cdot>Galaxy) .oclAsType(Galaxy)))))" -by(rule cpI1, simp) -lemma cp_OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy_Galaxy : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Galaxy)))::\<cdot>Galaxy) .oclAsType(Galaxy)))))" -by(rule cpI1, simp) -lemma cp_OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet_Galaxy : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Planet)))::\<cdot>Galaxy) .oclAsType(Galaxy)))))" -by(rule cpI1, simp) -lemma cp_OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person_Galaxy : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Person)))::\<cdot>Galaxy) .oclAsType(Galaxy)))))" -by(rule cpI1, simp) -lemma cp_OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny_Planet : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>OclAny)))::\<cdot>Planet) .oclAsType(Galaxy)))))" -by(rule cpI1, simp add: OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet) -lemma cp_OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy_Planet : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Galaxy)))::\<cdot>Planet) .oclAsType(Galaxy)))))" -by(rule cpI1, simp add: OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet) -lemma cp_OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet_Planet : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Planet)))::\<cdot>Planet) .oclAsType(Galaxy)))))" -by(rule cpI1, simp add: OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet) -lemma cp_OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person_Planet : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Person)))::\<cdot>Planet) .oclAsType(Galaxy)))))" -by(rule cpI1, simp add: OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet) -lemma cp_OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny_Person : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>OclAny)))::\<cdot>Person) .oclAsType(Galaxy)))))" -by(rule cpI1, simp add: OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person) -lemma cp_OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy_Person : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Galaxy)))::\<cdot>Person) .oclAsType(Galaxy)))))" -by(rule cpI1, simp add: OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person) -lemma cp_OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet_Person : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Planet)))::\<cdot>Person) .oclAsType(Galaxy)))))" -by(rule cpI1, simp add: OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person) -lemma cp_OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person_Person : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Person)))::\<cdot>Person) .oclAsType(Galaxy)))))" -by(rule cpI1, simp add: OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person) -lemma cp_OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny_OclAny : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>OclAny)))::\<cdot>OclAny) .oclAsType(Planet)))))" -by(rule cpI1, simp add: OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny) -lemma cp_OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy_OclAny : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Galaxy)))::\<cdot>OclAny) .oclAsType(Planet)))))" -by(rule cpI1, simp add: OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny) -lemma cp_OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet_OclAny : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Planet)))::\<cdot>OclAny) .oclAsType(Planet)))))" -by(rule cpI1, simp add: OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny) -lemma cp_OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person_OclAny : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Person)))::\<cdot>OclAny) .oclAsType(Planet)))))" -by(rule cpI1, simp add: OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny) -lemma cp_OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny_Galaxy : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>OclAny)))::\<cdot>Galaxy) .oclAsType(Planet)))))" -by(rule cpI1, simp add: OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy) -lemma cp_OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy_Galaxy : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Galaxy)))::\<cdot>Galaxy) .oclAsType(Planet)))))" -by(rule cpI1, simp add: OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy) -lemma cp_OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet_Galaxy : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Planet)))::\<cdot>Galaxy) .oclAsType(Planet)))))" -by(rule cpI1, simp add: OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy) -lemma cp_OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person_Galaxy : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Person)))::\<cdot>Galaxy) .oclAsType(Planet)))))" -by(rule cpI1, simp add: OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy) -lemma cp_OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny_Planet : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>OclAny)))::\<cdot>Planet) .oclAsType(Planet)))))" -by(rule cpI1, simp) -lemma cp_OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy_Planet : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Galaxy)))::\<cdot>Planet) .oclAsType(Planet)))))" -by(rule cpI1, simp) -lemma cp_OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet_Planet : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Planet)))::\<cdot>Planet) .oclAsType(Planet)))))" -by(rule cpI1, simp) -lemma cp_OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person_Planet : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Person)))::\<cdot>Planet) .oclAsType(Planet)))))" -by(rule cpI1, simp) -lemma cp_OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny_Person : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>OclAny)))::\<cdot>Person) .oclAsType(Planet)))))" -by(rule cpI1, simp add: OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person) -lemma cp_OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy_Person : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Galaxy)))::\<cdot>Person) .oclAsType(Planet)))))" -by(rule cpI1, simp add: OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person) -lemma cp_OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet_Person : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Planet)))::\<cdot>Person) .oclAsType(Planet)))))" -by(rule cpI1, simp add: OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person) -lemma cp_OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person_Person : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Person)))::\<cdot>Person) .oclAsType(Planet)))))" -by(rule cpI1, simp add: OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person) -lemma cp_OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_OclAny : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>OclAny)))::\<cdot>OclAny) .oclAsType(Person)))))" -by(rule cpI1, simp add: OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny) -lemma cp_OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy_OclAny : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Galaxy)))::\<cdot>OclAny) .oclAsType(Person)))))" -by(rule cpI1, simp add: OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny) -lemma cp_OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet_OclAny : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Planet)))::\<cdot>OclAny) .oclAsType(Person)))))" -by(rule cpI1, simp add: OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny) -lemma cp_OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_OclAny : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Person)))::\<cdot>OclAny) .oclAsType(Person)))))" -by(rule cpI1, simp add: OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny) -lemma cp_OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_Galaxy : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>OclAny)))::\<cdot>Galaxy) .oclAsType(Person)))))" -by(rule cpI1, simp add: OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy) -lemma cp_OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy_Galaxy : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Galaxy)))::\<cdot>Galaxy) .oclAsType(Person)))))" -by(rule cpI1, simp add: OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy) -lemma cp_OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet_Galaxy : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Planet)))::\<cdot>Galaxy) .oclAsType(Person)))))" -by(rule cpI1, simp add: OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy) -lemma cp_OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_Galaxy : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Person)))::\<cdot>Galaxy) .oclAsType(Person)))))" -by(rule cpI1, simp add: OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy) -lemma cp_OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_Planet : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>OclAny)))::\<cdot>Planet) .oclAsType(Person)))))" -by(rule cpI1, simp add: OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet) -lemma cp_OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy_Planet : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Galaxy)))::\<cdot>Planet) .oclAsType(Person)))))" -by(rule cpI1, simp add: OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet) -lemma cp_OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet_Planet : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Planet)))::\<cdot>Planet) .oclAsType(Person)))))" -by(rule cpI1, simp add: OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet) -lemma cp_OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_Planet : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Person)))::\<cdot>Planet) .oclAsType(Person)))))" -by(rule cpI1, simp add: OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet) -lemma cp_OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_Person : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>OclAny)))::\<cdot>Person) .oclAsType(Person)))))" -by(rule cpI1, simp) -lemma cp_OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy_Person : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Galaxy)))::\<cdot>Person) .oclAsType(Person)))))" -by(rule cpI1, simp) -lemma cp_OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet_Person : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Planet)))::\<cdot>Person) .oclAsType(Person)))))" -by(rule cpI1, simp) -lemma cp_OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_Person : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Person)))::\<cdot>Person) .oclAsType(Person)))))" -by(rule cpI1, simp) - -(* 43 ************************************ 176 + 1 *) (* term Floor1_astype.print_astype_lemmas_cp *) -lemmas[simp,code_unfold] = cp_OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_OclAny - cp_OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy_OclAny - cp_OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet_OclAny - cp_OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_OclAny - cp_OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_Galaxy - cp_OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy_Galaxy - cp_OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet_Galaxy - cp_OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_Galaxy - cp_OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_Planet - cp_OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy_Planet - cp_OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet_Planet - cp_OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_Planet - cp_OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_Person - cp_OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy_Person - cp_OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet_Person - cp_OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_Person - cp_OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny_OclAny - cp_OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy_OclAny - cp_OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet_OclAny - cp_OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person_OclAny - cp_OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny_Galaxy - cp_OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy_Galaxy - cp_OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet_Galaxy - cp_OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person_Galaxy - cp_OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny_Planet - cp_OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy_Planet - cp_OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet_Planet - cp_OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person_Planet - cp_OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny_Person - cp_OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy_Person - cp_OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet_Person - cp_OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person_Person - cp_OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny_OclAny - cp_OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy_OclAny - cp_OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet_OclAny - cp_OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person_OclAny - cp_OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny_Galaxy - cp_OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy_Galaxy - cp_OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet_Galaxy - cp_OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person_Galaxy - cp_OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny_Planet - cp_OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy_Planet - cp_OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet_Planet - cp_OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person_Planet - cp_OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny_Person - cp_OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy_Person - cp_OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet_Person - cp_OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person_Person - cp_OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_OclAny - cp_OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy_OclAny - cp_OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet_OclAny - cp_OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_OclAny - cp_OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_Galaxy - cp_OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy_Galaxy - cp_OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet_Galaxy - cp_OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_Galaxy - cp_OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_Planet - cp_OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy_Planet - cp_OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet_Planet - cp_OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_Planet - cp_OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_Person - cp_OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy_Person - cp_OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet_Person - cp_OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_Person - -(* 44 ************************************ 177 + 1 *) -subsection \<open>Execution with Invalid or Null as Argument\<close> - -(* 45 ************************************ 178 + 32 *) (* term Floor1_astype.print_astype_lemma_strict *) -lemma OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_invalid : "((invalid::\<cdot>OclAny) .oclAsType(OclAny)) = invalid" -by(simp) -lemma OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy_invalid : "((invalid::\<cdot>Galaxy) .oclAsType(OclAny)) = invalid" -by(rule ext, simp add: OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy bot_option_def invalid_def) -lemma OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet_invalid : "((invalid::\<cdot>Planet) .oclAsType(OclAny)) = invalid" -by(rule ext, simp add: OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet bot_option_def invalid_def) -lemma OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_invalid : "((invalid::\<cdot>Person) .oclAsType(OclAny)) = invalid" -by(rule ext, simp add: OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person bot_option_def invalid_def) -lemma OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_null : "((null::\<cdot>OclAny) .oclAsType(OclAny)) = null" -by(simp) -lemma OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy_null : "((null::\<cdot>Galaxy) .oclAsType(OclAny)) = null" -by(rule ext, simp add: OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy bot_option_def null_fun_def null_option_def) -lemma OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet_null : "((null::\<cdot>Planet) .oclAsType(OclAny)) = null" -by(rule ext, simp add: OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet bot_option_def null_fun_def null_option_def) -lemma OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_null : "((null::\<cdot>Person) .oclAsType(OclAny)) = null" -by(rule ext, simp add: OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person bot_option_def null_fun_def null_option_def) -lemma OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny_invalid : "((invalid::\<cdot>OclAny) .oclAsType(Galaxy)) = invalid" -by(rule ext, simp add: OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny bot_option_def invalid_def) -lemma OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy_invalid : "((invalid::\<cdot>Galaxy) .oclAsType(Galaxy)) = invalid" -by(simp) -lemma OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet_invalid : "((invalid::\<cdot>Planet) .oclAsType(Galaxy)) = invalid" -by(rule ext, simp add: OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet bot_option_def invalid_def) -lemma OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person_invalid : "((invalid::\<cdot>Person) .oclAsType(Galaxy)) = invalid" -by(rule ext, simp add: OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person bot_option_def invalid_def) -lemma OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny_null : "((null::\<cdot>OclAny) .oclAsType(Galaxy)) = null" -by(rule ext, simp add: OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny bot_option_def null_fun_def null_option_def) -lemma OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy_null : "((null::\<cdot>Galaxy) .oclAsType(Galaxy)) = null" -by(simp) -lemma OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet_null : "((null::\<cdot>Planet) .oclAsType(Galaxy)) = null" -by(rule ext, simp add: OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet bot_option_def null_fun_def null_option_def) -lemma OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person_null : "((null::\<cdot>Person) .oclAsType(Galaxy)) = null" -by(rule ext, simp add: OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person bot_option_def null_fun_def null_option_def) -lemma OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny_invalid : "((invalid::\<cdot>OclAny) .oclAsType(Planet)) = invalid" -by(rule ext, simp add: OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny bot_option_def invalid_def) -lemma OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy_invalid : "((invalid::\<cdot>Galaxy) .oclAsType(Planet)) = invalid" -by(rule ext, simp add: OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy bot_option_def invalid_def) -lemma OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet_invalid : "((invalid::\<cdot>Planet) .oclAsType(Planet)) = invalid" -by(simp) -lemma OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person_invalid : "((invalid::\<cdot>Person) .oclAsType(Planet)) = invalid" -by(rule ext, simp add: OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person bot_option_def invalid_def) -lemma OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny_null : "((null::\<cdot>OclAny) .oclAsType(Planet)) = null" -by(rule ext, simp add: OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny bot_option_def null_fun_def null_option_def) -lemma OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy_null : "((null::\<cdot>Galaxy) .oclAsType(Planet)) = null" -by(rule ext, simp add: OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy bot_option_def null_fun_def null_option_def) -lemma OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet_null : "((null::\<cdot>Planet) .oclAsType(Planet)) = null" -by(simp) -lemma OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person_null : "((null::\<cdot>Person) .oclAsType(Planet)) = null" -by(rule ext, simp add: OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person bot_option_def null_fun_def null_option_def) -lemma OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_invalid : "((invalid::\<cdot>OclAny) .oclAsType(Person)) = invalid" -by(rule ext, simp add: OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny bot_option_def invalid_def) -lemma OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy_invalid : "((invalid::\<cdot>Galaxy) .oclAsType(Person)) = invalid" -by(rule ext, simp add: OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy bot_option_def invalid_def) -lemma OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet_invalid : "((invalid::\<cdot>Planet) .oclAsType(Person)) = invalid" -by(rule ext, simp add: OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet bot_option_def invalid_def) -lemma OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_invalid : "((invalid::\<cdot>Person) .oclAsType(Person)) = invalid" -by(simp) -lemma OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_null : "((null::\<cdot>OclAny) .oclAsType(Person)) = null" -by(rule ext, simp add: OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny bot_option_def null_fun_def null_option_def) -lemma OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy_null : "((null::\<cdot>Galaxy) .oclAsType(Person)) = null" -by(rule ext, simp add: OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy bot_option_def null_fun_def null_option_def) -lemma OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet_null : "((null::\<cdot>Planet) .oclAsType(Person)) = null" -by(rule ext, simp add: OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet bot_option_def null_fun_def null_option_def) -lemma OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_null : "((null::\<cdot>Person) .oclAsType(Person)) = null" -by(simp) - -(* 46 ************************************ 210 + 1 *) (* term Floor1_astype.print_astype_lemmas_strict *) -lemmas[simp,code_unfold] = OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_invalid - OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy_invalid - OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet_invalid - OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_invalid - OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_null - OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy_null - OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet_null - OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_null - OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny_invalid - OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy_invalid - OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet_invalid - OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person_invalid - OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny_null - OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy_null - OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet_null - OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person_null - OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny_invalid - OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy_invalid - OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet_invalid - OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person_invalid - OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny_null - OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy_null - OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet_null - OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person_null - OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_invalid - OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy_invalid - OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet_invalid - OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_invalid - OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_null - OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy_null - OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet_null - OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_null - -(* 47 ************************************ 211 + 1 *) -subsection \<open>Validity and Definedness Properties\<close> - -(* 48 ************************************ 212 + 6 *) (* term Floor1_astype.print_astype_defined *) -lemma OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person_defined : -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Person) .oclAsType(Planet)))" - using isdef -by(auto simp: OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person foundation16 null_option_def bot_option_def) -lemma OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person_defined : -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Person) .oclAsType(Galaxy)))" - using isdef -by(auto simp: OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person foundation16 null_option_def bot_option_def) -lemma OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet_defined : -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Planet) .oclAsType(Galaxy)))" - using isdef -by(auto simp: OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet foundation16 null_option_def bot_option_def) -lemma OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_defined : -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Person) .oclAsType(OclAny)))" - using isdef -by(auto simp: OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person foundation16 null_option_def bot_option_def) -lemma OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet_defined : -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Planet) .oclAsType(OclAny)))" - using isdef -by(auto simp: OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet foundation16 null_option_def bot_option_def) -lemma OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy_defined : -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Galaxy) .oclAsType(OclAny)))" - using isdef -by(auto simp: OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy foundation16 null_option_def bot_option_def) - -(* 49 ************************************ 218 + 1 *) -subsection \<open>Up Down Casting\<close> - -(* 50 ************************************ 219 + 6 *) (* term Floor1_astype.print_astype_up_d_cast0 *) -lemma up\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_down\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_cast0 : -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> (((X::\<cdot>Person) .oclAsType(Planet)) .oclAsType(Person)) \<triangleq> X" - using isdef -by(auto simp: OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet foundation22 foundation16 null_option_def bot_option_def split: ty\<E>\<X>\<T>\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n.split ty\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n.split) -lemma up\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_down\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_cast0 : -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> (((X::\<cdot>Person) .oclAsType(Galaxy)) .oclAsType(Person)) \<triangleq> X" - using isdef -by(auto simp: OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy foundation22 foundation16 null_option_def bot_option_def split: ty\<E>\<X>\<T>\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n.split ty\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n.split) -lemma up\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_down\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_cast0 : -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> (((X::\<cdot>Person) .oclAsType(OclAny)) .oclAsType(Person)) \<triangleq> X" - using isdef -by(auto simp: OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny foundation22 foundation16 null_option_def bot_option_def split: ty\<E>\<X>\<T>\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n.split ty\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n.split) -lemma up\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_down\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_cast0 : -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> (((X::\<cdot>Planet) .oclAsType(Galaxy)) .oclAsType(Planet)) \<triangleq> X" - using isdef -by(auto simp: OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy foundation22 foundation16 null_option_def bot_option_def split: ty\<E>\<X>\<T>\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t.split ty\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t.split) -lemma up\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_down\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_cast0 : -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> (((X::\<cdot>Planet) .oclAsType(OclAny)) .oclAsType(Planet)) \<triangleq> X" - using isdef -by(auto simp: OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny foundation22 foundation16 null_option_def bot_option_def split: ty\<E>\<X>\<T>\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t.split ty\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t.split) -lemma up\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_down\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_cast0 : -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> (((X::\<cdot>Galaxy) .oclAsType(OclAny)) .oclAsType(Galaxy)) \<triangleq> X" - using isdef -by(auto simp: OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny foundation22 foundation16 null_option_def bot_option_def split: ty\<E>\<X>\<T>\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y.split ty\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y.split) - -(* 51 ************************************ 225 + 6 *) (* term Floor1_astype.print_astype_up_d_cast *) -lemma up\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_down\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_cast : -shows "(((X::\<cdot>Person) .oclAsType(Planet)) .oclAsType(Person)) = X" - apply(rule ext, rename_tac \<tau>) - apply(rule foundation22[THEN iffD1]) - apply(case_tac "\<tau> \<Turnstile> (\<delta> (X))", simp add: up\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_down\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_cast0) - apply(simp add: defined_split, elim disjE) - apply((erule StrongEq_L_subst2_rev, simp, simp)+) -done -lemma up\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_down\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_cast : -shows "(((X::\<cdot>Person) .oclAsType(Galaxy)) .oclAsType(Person)) = X" - apply(rule ext, rename_tac \<tau>) - apply(rule foundation22[THEN iffD1]) - apply(case_tac "\<tau> \<Turnstile> (\<delta> (X))", simp add: up\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_down\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_cast0) - apply(simp add: defined_split, elim disjE) - apply((erule StrongEq_L_subst2_rev, simp, simp)+) -done -lemma up\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_down\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_cast : -shows "(((X::\<cdot>Person) .oclAsType(OclAny)) .oclAsType(Person)) = X" - apply(rule ext, rename_tac \<tau>) - apply(rule foundation22[THEN iffD1]) - apply(case_tac "\<tau> \<Turnstile> (\<delta> (X))", simp add: up\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_down\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_cast0) - apply(simp add: defined_split, elim disjE) - apply((erule StrongEq_L_subst2_rev, simp, simp)+) -done -lemma up\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_down\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_cast : -shows "(((X::\<cdot>Planet) .oclAsType(Galaxy)) .oclAsType(Planet)) = X" - apply(rule ext, rename_tac \<tau>) - apply(rule foundation22[THEN iffD1]) - apply(case_tac "\<tau> \<Turnstile> (\<delta> (X))", simp add: up\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_down\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_cast0) - apply(simp add: defined_split, elim disjE) - apply((erule StrongEq_L_subst2_rev, simp, simp)+) -done -lemma up\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_down\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_cast : -shows "(((X::\<cdot>Planet) .oclAsType(OclAny)) .oclAsType(Planet)) = X" - apply(rule ext, rename_tac \<tau>) - apply(rule foundation22[THEN iffD1]) - apply(case_tac "\<tau> \<Turnstile> (\<delta> (X))", simp add: up\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_down\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_cast0) - apply(simp add: defined_split, elim disjE) - apply((erule StrongEq_L_subst2_rev, simp, simp)+) -done -lemma up\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_down\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_cast : -shows "(((X::\<cdot>Galaxy) .oclAsType(OclAny)) .oclAsType(Galaxy)) = X" - apply(rule ext, rename_tac \<tau>) - apply(rule foundation22[THEN iffD1]) - apply(case_tac "\<tau> \<Turnstile> (\<delta> (X))", simp add: up\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_down\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_cast0) - apply(simp add: defined_split, elim disjE) - apply((erule StrongEq_L_subst2_rev, simp, simp)+) -done - -(* 52 ************************************ 231 + 6 *) (* term Floor1_astype.print_astype_d_up_cast *) -lemma down\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_up\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_cast : -assumes def_X: "X = ((Y::\<cdot>Person) .oclAsType(Planet))" -shows "(\<tau> \<Turnstile> ((not ((\<upsilon> (X)))) or ((X .oclAsType(Person)) .oclAsType(Planet)) \<doteq> X))" - apply(case_tac "(\<tau> \<Turnstile> ((not ((\<upsilon> (X))))))", rule foundation25, simp) -by(rule foundation25', simp add: def_X up\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_down\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_cast StrictRefEq\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_sym) -lemma down\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_up\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_cast : -assumes def_X: "X = ((Y::\<cdot>Person) .oclAsType(Galaxy))" -shows "(\<tau> \<Turnstile> ((not ((\<upsilon> (X)))) or ((X .oclAsType(Person)) .oclAsType(Galaxy)) \<doteq> X))" - apply(case_tac "(\<tau> \<Turnstile> ((not ((\<upsilon> (X))))))", rule foundation25, simp) -by(rule foundation25', simp add: def_X up\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_down\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_cast StrictRefEq\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_sym) -lemma down\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_up\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_cast : -assumes def_X: "X = ((Y::\<cdot>Person) .oclAsType(OclAny))" -shows "(\<tau> \<Turnstile> ((not ((\<upsilon> (X)))) or ((X .oclAsType(Person)) .oclAsType(OclAny)) \<doteq> X))" - apply(case_tac "(\<tau> \<Turnstile> ((not ((\<upsilon> (X))))))", rule foundation25, simp) -by(rule foundation25', simp add: def_X up\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_down\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_cast StrictRefEq\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_sym) -lemma down\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_up\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_cast : -assumes def_X: "X = ((Y::\<cdot>Planet) .oclAsType(Galaxy))" -shows "(\<tau> \<Turnstile> ((not ((\<upsilon> (X)))) or ((X .oclAsType(Planet)) .oclAsType(Galaxy)) \<doteq> X))" - apply(case_tac "(\<tau> \<Turnstile> ((not ((\<upsilon> (X))))))", rule foundation25, simp) -by(rule foundation25', simp add: def_X up\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_down\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_cast StrictRefEq\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_sym) -lemma down\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_up\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_cast : -assumes def_X: "X = ((Y::\<cdot>Planet) .oclAsType(OclAny))" -shows "(\<tau> \<Turnstile> ((not ((\<upsilon> (X)))) or ((X .oclAsType(Planet)) .oclAsType(OclAny)) \<doteq> X))" - apply(case_tac "(\<tau> \<Turnstile> ((not ((\<upsilon> (X))))))", rule foundation25, simp) -by(rule foundation25', simp add: def_X up\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_down\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_cast StrictRefEq\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_sym) -lemma down\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_up\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_cast : -assumes def_X: "X = ((Y::\<cdot>Galaxy) .oclAsType(OclAny))" -shows "(\<tau> \<Turnstile> ((not ((\<upsilon> (X)))) or ((X .oclAsType(Galaxy)) .oclAsType(OclAny)) \<doteq> X))" - apply(case_tac "(\<tau> \<Turnstile> ((not ((\<upsilon> (X))))))", rule foundation25, simp) -by(rule foundation25', simp add: def_X up\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_down\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_cast StrictRefEq\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_sym) - -(* 53 ************************************ 237 + 1 *) -subsection \<open>Const\<close> - -(* 54 ************************************ 238 + 16 *) (* term Floor1_astype.print_astype_lemma_const *) -lemma OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_const : "(const ((X::\<cdot>OclAny))) \<Longrightarrow> (const (X .oclAsType(OclAny)))" -by(simp add: const_def, (metis (no_types) OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny prod.collapse bot_option_def invalid_def null_fun_def null_option_def)?) -lemma OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy_const : "(const ((X::\<cdot>Galaxy))) \<Longrightarrow> (const (X .oclAsType(OclAny)))" -by(simp add: const_def, (metis (no_types) OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy prod.collapse bot_option_def invalid_def null_fun_def null_option_def)?) -lemma OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet_const : "(const ((X::\<cdot>Planet))) \<Longrightarrow> (const (X .oclAsType(OclAny)))" -by(simp add: const_def, (metis (no_types) OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet prod.collapse bot_option_def invalid_def null_fun_def null_option_def)?) -lemma OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_const : "(const ((X::\<cdot>Person))) \<Longrightarrow> (const (X .oclAsType(OclAny)))" -by(simp add: const_def, (metis (no_types) OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person prod.collapse bot_option_def invalid_def null_fun_def null_option_def)?) -lemma OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny_const : "(const ((X::\<cdot>OclAny))) \<Longrightarrow> (const (X .oclAsType(Galaxy)))" -by(simp add: const_def, (metis (no_types) OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny prod.collapse bot_option_def invalid_def null_fun_def null_option_def)?) -lemma OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy_const : "(const ((X::\<cdot>Galaxy))) \<Longrightarrow> (const (X .oclAsType(Galaxy)))" -by(simp add: const_def, (metis (no_types) OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy prod.collapse bot_option_def invalid_def null_fun_def null_option_def)?) -lemma OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet_const : "(const ((X::\<cdot>Planet))) \<Longrightarrow> (const (X .oclAsType(Galaxy)))" -by(simp add: const_def, (metis (no_types) OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet prod.collapse bot_option_def invalid_def null_fun_def null_option_def)?) -lemma OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person_const : "(const ((X::\<cdot>Person))) \<Longrightarrow> (const (X .oclAsType(Galaxy)))" -by(simp add: const_def, (metis (no_types) OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person prod.collapse bot_option_def invalid_def null_fun_def null_option_def)?) -lemma OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny_const : "(const ((X::\<cdot>OclAny))) \<Longrightarrow> (const (X .oclAsType(Planet)))" -by(simp add: const_def, (metis (no_types) OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny prod.collapse bot_option_def invalid_def null_fun_def null_option_def)?) -lemma OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy_const : "(const ((X::\<cdot>Galaxy))) \<Longrightarrow> (const (X .oclAsType(Planet)))" -by(simp add: const_def, (metis (no_types) OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy prod.collapse bot_option_def invalid_def null_fun_def null_option_def)?) -lemma OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet_const : "(const ((X::\<cdot>Planet))) \<Longrightarrow> (const (X .oclAsType(Planet)))" -by(simp add: const_def, (metis (no_types) OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet prod.collapse bot_option_def invalid_def null_fun_def null_option_def)?) -lemma OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person_const : "(const ((X::\<cdot>Person))) \<Longrightarrow> (const (X .oclAsType(Planet)))" -by(simp add: const_def, (metis (no_types) OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person prod.collapse bot_option_def invalid_def null_fun_def null_option_def)?) -lemma OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_const : "(const ((X::\<cdot>OclAny))) \<Longrightarrow> (const (X .oclAsType(Person)))" -by(simp add: const_def, (metis (no_types) OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny prod.collapse bot_option_def invalid_def null_fun_def null_option_def)?) -lemma OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy_const : "(const ((X::\<cdot>Galaxy))) \<Longrightarrow> (const (X .oclAsType(Person)))" -by(simp add: const_def, (metis (no_types) OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy prod.collapse bot_option_def invalid_def null_fun_def null_option_def)?) -lemma OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet_const : "(const ((X::\<cdot>Planet))) \<Longrightarrow> (const (X .oclAsType(Person)))" -by(simp add: const_def, (metis (no_types) OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet prod.collapse bot_option_def invalid_def null_fun_def null_option_def)?) -lemma OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_const : "(const ((X::\<cdot>Person))) \<Longrightarrow> (const (X .oclAsType(Person)))" -by(simp add: const_def, (metis (no_types) OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person prod.collapse bot_option_def invalid_def null_fun_def null_option_def)?) - -(* 55 ************************************ 254 + 1 *) (* term Floor1_astype.print_astype_lemmas_const *) -lemmas[simp,code_unfold] = OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_const - OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy_const - OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet_const - OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_const - OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny_const - OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy_const - OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet_const - OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person_const - OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny_const - OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy_const - OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet_const - OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person_const - OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_const - OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy_const - OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet_const - OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_const - -(* 56 ************************************ 255 + 1 *) -section \<open>Class Model: OclIsTypeOf\<close> - -(* 57 ************************************ 256 + 1 *) -subsection \<open>Definition\<close> - -(* 58 ************************************ 257 + 4 *) (* term Floor1_istypeof.print_istypeof_consts *) -consts OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n :: "'\<alpha> \<Rightarrow> Boolean" ("(_) .oclIsTypeOf'(Person')") -consts OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t :: "'\<alpha> \<Rightarrow> Boolean" ("(_) .oclIsTypeOf'(Planet')") -consts OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y :: "'\<alpha> \<Rightarrow> Boolean" ("(_) .oclIsTypeOf'(Galaxy')") -consts OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y :: "'\<alpha> \<Rightarrow> Boolean" ("(_) .oclIsTypeOf'(OclAny')") - -(* 59 ************************************ 261 + 16 *) (* term Floor1_istypeof.print_istypeof_class *) -overloading OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n \<equiv> "(OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n::(\<cdot>Person) \<Rightarrow> _)" -begin - definition OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person : "(x::\<cdot>Person) .oclIsTypeOf(Person) \<equiv> (\<lambda>\<tau>. (case (x (\<tau>)) of \<bottom> \<Rightarrow> (invalid (\<tau>)) - | \<lfloor>\<bottom>\<rfloor> \<Rightarrow> (true (\<tau>)) - | \<lfloor>\<lfloor>(mk\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n ((mk\<E>\<X>\<T>\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (_) (_) (_) (_) (_) (_))) (_))\<rfloor>\<rfloor> \<Rightarrow> (true (\<tau>))))" -end -overloading OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n \<equiv> "(OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n::(\<cdot>Planet) \<Rightarrow> _)" -begin - definition OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet : "(x::\<cdot>Planet) .oclIsTypeOf(Person) \<equiv> (\<lambda>\<tau>. (case (x (\<tau>)) of \<bottom> \<Rightarrow> (invalid (\<tau>)) - | \<lfloor>\<bottom>\<rfloor> \<Rightarrow> (true (\<tau>)) - | \<lfloor>\<lfloor>(mk\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t ((mk\<E>\<X>\<T>\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (_))) (_) (_))\<rfloor>\<rfloor> \<Rightarrow> (true (\<tau>)) - | _ \<Rightarrow> (false (\<tau>))))" -end -overloading OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n \<equiv> "(OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n::(\<cdot>Galaxy) \<Rightarrow> _)" -begin - definition OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy : "(x::\<cdot>Galaxy) .oclIsTypeOf(Person) \<equiv> (\<lambda>\<tau>. (case (x (\<tau>)) of \<bottom> \<Rightarrow> (invalid (\<tau>)) - | \<lfloor>\<bottom>\<rfloor> \<Rightarrow> (true (\<tau>)) - | \<lfloor>\<lfloor>(mk\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y ((mk\<E>\<X>\<T>\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (_))) (_) (_) (_))\<rfloor>\<rfloor> \<Rightarrow> (true (\<tau>)) - | _ \<Rightarrow> (false (\<tau>))))" -end -overloading OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n \<equiv> "(OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n::(\<cdot>OclAny) \<Rightarrow> _)" -begin - definition OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny : "(x::\<cdot>OclAny) .oclIsTypeOf(Person) \<equiv> (\<lambda>\<tau>. (case (x (\<tau>)) of \<bottom> \<Rightarrow> (invalid (\<tau>)) - | \<lfloor>\<bottom>\<rfloor> \<Rightarrow> (true (\<tau>)) - | \<lfloor>\<lfloor>(mk\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y ((mk\<E>\<X>\<T>\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (_))))\<rfloor>\<rfloor> \<Rightarrow> (true (\<tau>)) - | _ \<Rightarrow> (false (\<tau>))))" -end -overloading OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t \<equiv> "(OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t::(\<cdot>Planet) \<Rightarrow> _)" -begin - definition OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet : "(x::\<cdot>Planet) .oclIsTypeOf(Planet) \<equiv> (\<lambda>\<tau>. (case (x (\<tau>)) of \<bottom> \<Rightarrow> (invalid (\<tau>)) - | \<lfloor>\<bottom>\<rfloor> \<Rightarrow> (true (\<tau>)) - | \<lfloor>\<lfloor>(mk\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t ((mk\<E>\<X>\<T>\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (_) (_) (_) (_))) (_) (_))\<rfloor>\<rfloor> \<Rightarrow> (true (\<tau>)) - | _ \<Rightarrow> (false (\<tau>))))" -end -overloading OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t \<equiv> "(OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t::(\<cdot>Galaxy) \<Rightarrow> _)" -begin - definition OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy : "(x::\<cdot>Galaxy) .oclIsTypeOf(Planet) \<equiv> (\<lambda>\<tau>. (case (x (\<tau>)) of \<bottom> \<Rightarrow> (invalid (\<tau>)) - | \<lfloor>\<bottom>\<rfloor> \<Rightarrow> (true (\<tau>)) - | \<lfloor>\<lfloor>(mk\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y ((mk\<E>\<X>\<T>\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (_))) (_) (_) (_))\<rfloor>\<rfloor> \<Rightarrow> (true (\<tau>)) - | _ \<Rightarrow> (false (\<tau>))))" -end -overloading OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t \<equiv> "(OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t::(\<cdot>OclAny) \<Rightarrow> _)" -begin - definition OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny : "(x::\<cdot>OclAny) .oclIsTypeOf(Planet) \<equiv> (\<lambda>\<tau>. (case (x (\<tau>)) of \<bottom> \<Rightarrow> (invalid (\<tau>)) - | \<lfloor>\<bottom>\<rfloor> \<Rightarrow> (true (\<tau>)) - | \<lfloor>\<lfloor>(mk\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y ((mk\<E>\<X>\<T>\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (_))))\<rfloor>\<rfloor> \<Rightarrow> (true (\<tau>)) - | _ \<Rightarrow> (false (\<tau>))))" -end -overloading OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t \<equiv> "(OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t::(\<cdot>Person) \<Rightarrow> _)" -begin - definition OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person : "(x::\<cdot>Person) .oclIsTypeOf(Planet) \<equiv> (\<lambda>\<tau>. (case (x (\<tau>)) of \<bottom> \<Rightarrow> (invalid (\<tau>)) - | \<lfloor>\<bottom>\<rfloor> \<Rightarrow> (true (\<tau>)) - | _ \<Rightarrow> (false (\<tau>))))" -end -overloading OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y \<equiv> "(OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y::(\<cdot>Galaxy) \<Rightarrow> _)" -begin - definition OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy : "(x::\<cdot>Galaxy) .oclIsTypeOf(Galaxy) \<equiv> (\<lambda>\<tau>. (case (x (\<tau>)) of \<bottom> \<Rightarrow> (invalid (\<tau>)) - | \<lfloor>\<bottom>\<rfloor> \<Rightarrow> (true (\<tau>)) - | \<lfloor>\<lfloor>(mk\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y ((mk\<E>\<X>\<T>\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y (_))) (_) (_) (_))\<rfloor>\<rfloor> \<Rightarrow> (true (\<tau>)) - | _ \<Rightarrow> (false (\<tau>))))" -end -overloading OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y \<equiv> "(OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y::(\<cdot>OclAny) \<Rightarrow> _)" -begin - definition OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny : "(x::\<cdot>OclAny) .oclIsTypeOf(Galaxy) \<equiv> (\<lambda>\<tau>. (case (x (\<tau>)) of \<bottom> \<Rightarrow> (invalid (\<tau>)) - | \<lfloor>\<bottom>\<rfloor> \<Rightarrow> (true (\<tau>)) - | \<lfloor>\<lfloor>(mk\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y ((mk\<E>\<X>\<T>\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y (_))))\<rfloor>\<rfloor> \<Rightarrow> (true (\<tau>)) - | _ \<Rightarrow> (false (\<tau>))))" -end -overloading OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y \<equiv> "(OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y::(\<cdot>Person) \<Rightarrow> _)" -begin - definition OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person : "(x::\<cdot>Person) .oclIsTypeOf(Galaxy) \<equiv> (\<lambda>\<tau>. (case (x (\<tau>)) of \<bottom> \<Rightarrow> (invalid (\<tau>)) - | \<lfloor>\<bottom>\<rfloor> \<Rightarrow> (true (\<tau>)) - | _ \<Rightarrow> (false (\<tau>))))" -end -overloading OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y \<equiv> "(OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y::(\<cdot>Planet) \<Rightarrow> _)" -begin - definition OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet : "(x::\<cdot>Planet) .oclIsTypeOf(Galaxy) \<equiv> (\<lambda>\<tau>. (case (x (\<tau>)) of \<bottom> \<Rightarrow> (invalid (\<tau>)) - | \<lfloor>\<bottom>\<rfloor> \<Rightarrow> (true (\<tau>)) - | _ \<Rightarrow> (false (\<tau>))))" -end -overloading OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y \<equiv> "(OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y::(\<cdot>OclAny) \<Rightarrow> _)" -begin - definition OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny : "(x::\<cdot>OclAny) .oclIsTypeOf(OclAny) \<equiv> (\<lambda>\<tau>. (case (x (\<tau>)) of \<bottom> \<Rightarrow> (invalid (\<tau>)) - | \<lfloor>\<bottom>\<rfloor> \<Rightarrow> (true (\<tau>)) - | \<lfloor>\<lfloor>(mk\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y ((mk\<E>\<X>\<T>\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y (_))))\<rfloor>\<rfloor> \<Rightarrow> (true (\<tau>)) - | _ \<Rightarrow> (false (\<tau>))))" -end -overloading OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y \<equiv> "(OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y::(\<cdot>Person) \<Rightarrow> _)" -begin - definition OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person : "(x::\<cdot>Person) .oclIsTypeOf(OclAny) \<equiv> (\<lambda>\<tau>. (case (x (\<tau>)) of \<bottom> \<Rightarrow> (invalid (\<tau>)) - | \<lfloor>\<bottom>\<rfloor> \<Rightarrow> (true (\<tau>)) - | _ \<Rightarrow> (false (\<tau>))))" -end -overloading OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y \<equiv> "(OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y::(\<cdot>Planet) \<Rightarrow> _)" -begin - definition OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet : "(x::\<cdot>Planet) .oclIsTypeOf(OclAny) \<equiv> (\<lambda>\<tau>. (case (x (\<tau>)) of \<bottom> \<Rightarrow> (invalid (\<tau>)) - | \<lfloor>\<bottom>\<rfloor> \<Rightarrow> (true (\<tau>)) - | _ \<Rightarrow> (false (\<tau>))))" -end -overloading OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y \<equiv> "(OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y::(\<cdot>Galaxy) \<Rightarrow> _)" -begin - definition OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy : "(x::\<cdot>Galaxy) .oclIsTypeOf(OclAny) \<equiv> (\<lambda>\<tau>. (case (x (\<tau>)) of \<bottom> \<Rightarrow> (invalid (\<tau>)) - | \<lfloor>\<bottom>\<rfloor> \<Rightarrow> (true (\<tau>)) - | _ \<Rightarrow> (false (\<tau>))))" -end - -(* 60 ************************************ 277 + 4 *) (* term Floor1_istypeof.print_istypeof_from_universe *) -definition "OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_\<AA> = (\<lambda> (in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (Person)) \<Rightarrow> (((((\<lambda>x _. \<lfloor>\<lfloor>x\<rfloor>\<rfloor>)) (Person))::\<cdot>Person) .oclIsTypeOf(Person)) - | (in\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (Planet)) \<Rightarrow> (((((\<lambda>x _. \<lfloor>\<lfloor>x\<rfloor>\<rfloor>)) (Planet))::\<cdot>Planet) .oclIsTypeOf(Person)) - | (in\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y (Galaxy)) \<Rightarrow> (((((\<lambda>x _. \<lfloor>\<lfloor>x\<rfloor>\<rfloor>)) (Galaxy))::\<cdot>Galaxy) .oclIsTypeOf(Person)) - | (in\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y (OclAny)) \<Rightarrow> (((((\<lambda>x _. \<lfloor>\<lfloor>x\<rfloor>\<rfloor>)) (OclAny))::\<cdot>OclAny) .oclIsTypeOf(Person)))" -definition "OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_\<AA> = (\<lambda> (in\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (Planet)) \<Rightarrow> (((((\<lambda>x _. \<lfloor>\<lfloor>x\<rfloor>\<rfloor>)) (Planet))::\<cdot>Planet) .oclIsTypeOf(Planet)) - | (in\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y (Galaxy)) \<Rightarrow> (((((\<lambda>x _. \<lfloor>\<lfloor>x\<rfloor>\<rfloor>)) (Galaxy))::\<cdot>Galaxy) .oclIsTypeOf(Planet)) - | (in\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y (OclAny)) \<Rightarrow> (((((\<lambda>x _. \<lfloor>\<lfloor>x\<rfloor>\<rfloor>)) (OclAny))::\<cdot>OclAny) .oclIsTypeOf(Planet)) - | (in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (Person)) \<Rightarrow> (((((\<lambda>x _. \<lfloor>\<lfloor>x\<rfloor>\<rfloor>)) (Person))::\<cdot>Person) .oclIsTypeOf(Planet)))" -definition "OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_\<AA> = (\<lambda> (in\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y (Galaxy)) \<Rightarrow> (((((\<lambda>x _. \<lfloor>\<lfloor>x\<rfloor>\<rfloor>)) (Galaxy))::\<cdot>Galaxy) .oclIsTypeOf(Galaxy)) - | (in\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y (OclAny)) \<Rightarrow> (((((\<lambda>x _. \<lfloor>\<lfloor>x\<rfloor>\<rfloor>)) (OclAny))::\<cdot>OclAny) .oclIsTypeOf(Galaxy)) - | (in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (Person)) \<Rightarrow> (((((\<lambda>x _. \<lfloor>\<lfloor>x\<rfloor>\<rfloor>)) (Person))::\<cdot>Person) .oclIsTypeOf(Galaxy)) - | (in\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (Planet)) \<Rightarrow> (((((\<lambda>x _. \<lfloor>\<lfloor>x\<rfloor>\<rfloor>)) (Planet))::\<cdot>Planet) .oclIsTypeOf(Galaxy)))" -definition "OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_\<AA> = (\<lambda> (in\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y (OclAny)) \<Rightarrow> (((((\<lambda>x _. \<lfloor>\<lfloor>x\<rfloor>\<rfloor>)) (OclAny))::\<cdot>OclAny) .oclIsTypeOf(OclAny)) - | (in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (Person)) \<Rightarrow> (((((\<lambda>x _. \<lfloor>\<lfloor>x\<rfloor>\<rfloor>)) (Person))::\<cdot>Person) .oclIsTypeOf(OclAny)) - | (in\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (Planet)) \<Rightarrow> (((((\<lambda>x _. \<lfloor>\<lfloor>x\<rfloor>\<rfloor>)) (Planet))::\<cdot>Planet) .oclIsTypeOf(OclAny)) - | (in\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y (Galaxy)) \<Rightarrow> (((((\<lambda>x _. \<lfloor>\<lfloor>x\<rfloor>\<rfloor>)) (Galaxy))::\<cdot>Galaxy) .oclIsTypeOf(OclAny)))" - -(* 61 ************************************ 281 + 1 *) (* term Floor1_istypeof.print_istypeof_lemmas_id *) -lemmas[simp,code_unfold] = OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person - OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet - OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy - OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny - -(* 62 ************************************ 282 + 1 *) -subsection \<open>Context Passing\<close> - -(* 63 ************************************ 283 + 64 *) (* term Floor1_istypeof.print_istypeof_lemma_cp *) -lemma cp_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_OclAny : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>OclAny)))::\<cdot>OclAny) .oclIsTypeOf(OclAny)))))" -by(rule cpI1, simp) -lemma cp_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy_OclAny : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Galaxy)))::\<cdot>OclAny) .oclIsTypeOf(OclAny)))))" -by(rule cpI1, simp) -lemma cp_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet_OclAny : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Planet)))::\<cdot>OclAny) .oclIsTypeOf(OclAny)))))" -by(rule cpI1, simp) -lemma cp_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_OclAny : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Person)))::\<cdot>OclAny) .oclIsTypeOf(OclAny)))))" -by(rule cpI1, simp) -lemma cp_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_Galaxy : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>OclAny)))::\<cdot>Galaxy) .oclIsTypeOf(OclAny)))))" -by(rule cpI1, simp add: OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy) -lemma cp_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy_Galaxy : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Galaxy)))::\<cdot>Galaxy) .oclIsTypeOf(OclAny)))))" -by(rule cpI1, simp add: OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy) -lemma cp_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet_Galaxy : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Planet)))::\<cdot>Galaxy) .oclIsTypeOf(OclAny)))))" -by(rule cpI1, simp add: OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy) -lemma cp_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_Galaxy : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Person)))::\<cdot>Galaxy) .oclIsTypeOf(OclAny)))))" -by(rule cpI1, simp add: OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy) -lemma cp_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_Planet : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>OclAny)))::\<cdot>Planet) .oclIsTypeOf(OclAny)))))" -by(rule cpI1, simp add: OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet) -lemma cp_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy_Planet : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Galaxy)))::\<cdot>Planet) .oclIsTypeOf(OclAny)))))" -by(rule cpI1, simp add: OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet) -lemma cp_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet_Planet : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Planet)))::\<cdot>Planet) .oclIsTypeOf(OclAny)))))" -by(rule cpI1, simp add: OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet) -lemma cp_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_Planet : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Person)))::\<cdot>Planet) .oclIsTypeOf(OclAny)))))" -by(rule cpI1, simp add: OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet) -lemma cp_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_Person : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>OclAny)))::\<cdot>Person) .oclIsTypeOf(OclAny)))))" -by(rule cpI1, simp add: OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person) -lemma cp_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy_Person : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Galaxy)))::\<cdot>Person) .oclIsTypeOf(OclAny)))))" -by(rule cpI1, simp add: OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person) -lemma cp_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet_Person : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Planet)))::\<cdot>Person) .oclIsTypeOf(OclAny)))))" -by(rule cpI1, simp add: OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person) -lemma cp_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_Person : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Person)))::\<cdot>Person) .oclIsTypeOf(OclAny)))))" -by(rule cpI1, simp add: OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person) -lemma cp_OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny_OclAny : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>OclAny)))::\<cdot>OclAny) .oclIsTypeOf(Galaxy)))))" -by(rule cpI1, simp add: OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny) -lemma cp_OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy_OclAny : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Galaxy)))::\<cdot>OclAny) .oclIsTypeOf(Galaxy)))))" -by(rule cpI1, simp add: OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny) -lemma cp_OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet_OclAny : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Planet)))::\<cdot>OclAny) .oclIsTypeOf(Galaxy)))))" -by(rule cpI1, simp add: OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny) -lemma cp_OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person_OclAny : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Person)))::\<cdot>OclAny) .oclIsTypeOf(Galaxy)))))" -by(rule cpI1, simp add: OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny) -lemma cp_OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny_Galaxy : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>OclAny)))::\<cdot>Galaxy) .oclIsTypeOf(Galaxy)))))" -by(rule cpI1, simp) -lemma cp_OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy_Galaxy : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Galaxy)))::\<cdot>Galaxy) .oclIsTypeOf(Galaxy)))))" -by(rule cpI1, simp) -lemma cp_OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet_Galaxy : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Planet)))::\<cdot>Galaxy) .oclIsTypeOf(Galaxy)))))" -by(rule cpI1, simp) -lemma cp_OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person_Galaxy : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Person)))::\<cdot>Galaxy) .oclIsTypeOf(Galaxy)))))" -by(rule cpI1, simp) -lemma cp_OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny_Planet : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>OclAny)))::\<cdot>Planet) .oclIsTypeOf(Galaxy)))))" -by(rule cpI1, simp add: OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet) -lemma cp_OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy_Planet : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Galaxy)))::\<cdot>Planet) .oclIsTypeOf(Galaxy)))))" -by(rule cpI1, simp add: OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet) -lemma cp_OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet_Planet : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Planet)))::\<cdot>Planet) .oclIsTypeOf(Galaxy)))))" -by(rule cpI1, simp add: OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet) -lemma cp_OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person_Planet : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Person)))::\<cdot>Planet) .oclIsTypeOf(Galaxy)))))" -by(rule cpI1, simp add: OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet) -lemma cp_OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny_Person : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>OclAny)))::\<cdot>Person) .oclIsTypeOf(Galaxy)))))" -by(rule cpI1, simp add: OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person) -lemma cp_OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy_Person : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Galaxy)))::\<cdot>Person) .oclIsTypeOf(Galaxy)))))" -by(rule cpI1, simp add: OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person) -lemma cp_OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet_Person : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Planet)))::\<cdot>Person) .oclIsTypeOf(Galaxy)))))" -by(rule cpI1, simp add: OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person) -lemma cp_OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person_Person : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Person)))::\<cdot>Person) .oclIsTypeOf(Galaxy)))))" -by(rule cpI1, simp add: OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person) -lemma cp_OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny_OclAny : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>OclAny)))::\<cdot>OclAny) .oclIsTypeOf(Planet)))))" -by(rule cpI1, simp add: OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny) -lemma cp_OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy_OclAny : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Galaxy)))::\<cdot>OclAny) .oclIsTypeOf(Planet)))))" -by(rule cpI1, simp add: OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny) -lemma cp_OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet_OclAny : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Planet)))::\<cdot>OclAny) .oclIsTypeOf(Planet)))))" -by(rule cpI1, simp add: OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny) -lemma cp_OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person_OclAny : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Person)))::\<cdot>OclAny) .oclIsTypeOf(Planet)))))" -by(rule cpI1, simp add: OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny) -lemma cp_OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny_Galaxy : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>OclAny)))::\<cdot>Galaxy) .oclIsTypeOf(Planet)))))" -by(rule cpI1, simp add: OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy) -lemma cp_OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy_Galaxy : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Galaxy)))::\<cdot>Galaxy) .oclIsTypeOf(Planet)))))" -by(rule cpI1, simp add: OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy) -lemma cp_OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet_Galaxy : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Planet)))::\<cdot>Galaxy) .oclIsTypeOf(Planet)))))" -by(rule cpI1, simp add: OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy) -lemma cp_OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person_Galaxy : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Person)))::\<cdot>Galaxy) .oclIsTypeOf(Planet)))))" -by(rule cpI1, simp add: OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy) -lemma cp_OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny_Planet : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>OclAny)))::\<cdot>Planet) .oclIsTypeOf(Planet)))))" -by(rule cpI1, simp) -lemma cp_OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy_Planet : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Galaxy)))::\<cdot>Planet) .oclIsTypeOf(Planet)))))" -by(rule cpI1, simp) -lemma cp_OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet_Planet : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Planet)))::\<cdot>Planet) .oclIsTypeOf(Planet)))))" -by(rule cpI1, simp) -lemma cp_OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person_Planet : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Person)))::\<cdot>Planet) .oclIsTypeOf(Planet)))))" -by(rule cpI1, simp) -lemma cp_OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny_Person : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>OclAny)))::\<cdot>Person) .oclIsTypeOf(Planet)))))" -by(rule cpI1, simp add: OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person) -lemma cp_OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy_Person : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Galaxy)))::\<cdot>Person) .oclIsTypeOf(Planet)))))" -by(rule cpI1, simp add: OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person) -lemma cp_OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet_Person : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Planet)))::\<cdot>Person) .oclIsTypeOf(Planet)))))" -by(rule cpI1, simp add: OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person) -lemma cp_OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person_Person : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Person)))::\<cdot>Person) .oclIsTypeOf(Planet)))))" -by(rule cpI1, simp add: OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person) -lemma cp_OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_OclAny : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>OclAny)))::\<cdot>OclAny) .oclIsTypeOf(Person)))))" -by(rule cpI1, simp add: OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny) -lemma cp_OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy_OclAny : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Galaxy)))::\<cdot>OclAny) .oclIsTypeOf(Person)))))" -by(rule cpI1, simp add: OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny) -lemma cp_OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet_OclAny : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Planet)))::\<cdot>OclAny) .oclIsTypeOf(Person)))))" -by(rule cpI1, simp add: OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny) -lemma cp_OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_OclAny : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Person)))::\<cdot>OclAny) .oclIsTypeOf(Person)))))" -by(rule cpI1, simp add: OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny) -lemma cp_OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_Galaxy : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>OclAny)))::\<cdot>Galaxy) .oclIsTypeOf(Person)))))" -by(rule cpI1, simp add: OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy) -lemma cp_OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy_Galaxy : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Galaxy)))::\<cdot>Galaxy) .oclIsTypeOf(Person)))))" -by(rule cpI1, simp add: OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy) -lemma cp_OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet_Galaxy : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Planet)))::\<cdot>Galaxy) .oclIsTypeOf(Person)))))" -by(rule cpI1, simp add: OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy) -lemma cp_OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_Galaxy : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Person)))::\<cdot>Galaxy) .oclIsTypeOf(Person)))))" -by(rule cpI1, simp add: OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy) -lemma cp_OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_Planet : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>OclAny)))::\<cdot>Planet) .oclIsTypeOf(Person)))))" -by(rule cpI1, simp add: OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet) -lemma cp_OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy_Planet : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Galaxy)))::\<cdot>Planet) .oclIsTypeOf(Person)))))" -by(rule cpI1, simp add: OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet) -lemma cp_OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet_Planet : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Planet)))::\<cdot>Planet) .oclIsTypeOf(Person)))))" -by(rule cpI1, simp add: OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet) -lemma cp_OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_Planet : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Person)))::\<cdot>Planet) .oclIsTypeOf(Person)))))" -by(rule cpI1, simp add: OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet) -lemma cp_OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_Person : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>OclAny)))::\<cdot>Person) .oclIsTypeOf(Person)))))" -by(rule cpI1, simp) -lemma cp_OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy_Person : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Galaxy)))::\<cdot>Person) .oclIsTypeOf(Person)))))" -by(rule cpI1, simp) -lemma cp_OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet_Person : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Planet)))::\<cdot>Person) .oclIsTypeOf(Person)))))" -by(rule cpI1, simp) -lemma cp_OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_Person : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Person)))::\<cdot>Person) .oclIsTypeOf(Person)))))" -by(rule cpI1, simp) - -(* 64 ************************************ 347 + 1 *) (* term Floor1_istypeof.print_istypeof_lemmas_cp *) -lemmas[simp,code_unfold] = cp_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_OclAny - cp_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy_OclAny - cp_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet_OclAny - cp_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_OclAny - cp_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_Galaxy - cp_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy_Galaxy - cp_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet_Galaxy - cp_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_Galaxy - cp_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_Planet - cp_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy_Planet - cp_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet_Planet - cp_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_Planet - cp_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_Person - cp_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy_Person - cp_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet_Person - cp_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_Person - cp_OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny_OclAny - cp_OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy_OclAny - cp_OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet_OclAny - cp_OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person_OclAny - cp_OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny_Galaxy - cp_OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy_Galaxy - cp_OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet_Galaxy - cp_OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person_Galaxy - cp_OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny_Planet - cp_OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy_Planet - cp_OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet_Planet - cp_OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person_Planet - cp_OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny_Person - cp_OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy_Person - cp_OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet_Person - cp_OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person_Person - cp_OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny_OclAny - cp_OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy_OclAny - cp_OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet_OclAny - cp_OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person_OclAny - cp_OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny_Galaxy - cp_OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy_Galaxy - cp_OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet_Galaxy - cp_OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person_Galaxy - cp_OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny_Planet - cp_OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy_Planet - cp_OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet_Planet - cp_OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person_Planet - cp_OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny_Person - cp_OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy_Person - cp_OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet_Person - cp_OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person_Person - cp_OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_OclAny - cp_OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy_OclAny - cp_OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet_OclAny - cp_OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_OclAny - cp_OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_Galaxy - cp_OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy_Galaxy - cp_OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet_Galaxy - cp_OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_Galaxy - cp_OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_Planet - cp_OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy_Planet - cp_OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet_Planet - cp_OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_Planet - cp_OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_Person - cp_OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy_Person - cp_OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet_Person - cp_OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_Person - -(* 65 ************************************ 348 + 1 *) -subsection \<open>Execution with Invalid or Null as Argument\<close> - -(* 66 ************************************ 349 + 32 *) (* term Floor1_istypeof.print_istypeof_lemma_strict *) -lemma OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_invalid : "((invalid::\<cdot>OclAny) .oclIsTypeOf(OclAny)) = invalid" -by(rule ext, simp add: bot_option_def invalid_def) -lemma OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy_invalid : "((invalid::\<cdot>Galaxy) .oclIsTypeOf(OclAny)) = invalid" -by(rule ext, simp add: OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy bot_option_def invalid_def) -lemma OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet_invalid : "((invalid::\<cdot>Planet) .oclIsTypeOf(OclAny)) = invalid" -by(rule ext, simp add: OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet bot_option_def invalid_def) -lemma OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_invalid : "((invalid::\<cdot>Person) .oclIsTypeOf(OclAny)) = invalid" -by(rule ext, simp add: OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person bot_option_def invalid_def) -lemma OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_null : "((null::\<cdot>OclAny) .oclIsTypeOf(OclAny)) = true" -by(rule ext, simp add: bot_option_def null_fun_def null_option_def) -lemma OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy_null : "((null::\<cdot>Galaxy) .oclIsTypeOf(OclAny)) = true" -by(rule ext, simp add: OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy bot_option_def null_fun_def null_option_def) -lemma OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet_null : "((null::\<cdot>Planet) .oclIsTypeOf(OclAny)) = true" -by(rule ext, simp add: OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet bot_option_def null_fun_def null_option_def) -lemma OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_null : "((null::\<cdot>Person) .oclIsTypeOf(OclAny)) = true" -by(rule ext, simp add: OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person bot_option_def null_fun_def null_option_def) -lemma OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny_invalid : "((invalid::\<cdot>OclAny) .oclIsTypeOf(Galaxy)) = invalid" -by(rule ext, simp add: OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny bot_option_def invalid_def) -lemma OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy_invalid : "((invalid::\<cdot>Galaxy) .oclIsTypeOf(Galaxy)) = invalid" -by(rule ext, simp add: bot_option_def invalid_def) -lemma OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet_invalid : "((invalid::\<cdot>Planet) .oclIsTypeOf(Galaxy)) = invalid" -by(rule ext, simp add: OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet bot_option_def invalid_def) -lemma OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person_invalid : "((invalid::\<cdot>Person) .oclIsTypeOf(Galaxy)) = invalid" -by(rule ext, simp add: OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person bot_option_def invalid_def) -lemma OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny_null : "((null::\<cdot>OclAny) .oclIsTypeOf(Galaxy)) = true" -by(rule ext, simp add: OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny bot_option_def null_fun_def null_option_def) -lemma OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy_null : "((null::\<cdot>Galaxy) .oclIsTypeOf(Galaxy)) = true" -by(rule ext, simp add: bot_option_def null_fun_def null_option_def) -lemma OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet_null : "((null::\<cdot>Planet) .oclIsTypeOf(Galaxy)) = true" -by(rule ext, simp add: OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet bot_option_def null_fun_def null_option_def) -lemma OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person_null : "((null::\<cdot>Person) .oclIsTypeOf(Galaxy)) = true" -by(rule ext, simp add: OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person bot_option_def null_fun_def null_option_def) -lemma OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny_invalid : "((invalid::\<cdot>OclAny) .oclIsTypeOf(Planet)) = invalid" -by(rule ext, simp add: OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny bot_option_def invalid_def) -lemma OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy_invalid : "((invalid::\<cdot>Galaxy) .oclIsTypeOf(Planet)) = invalid" -by(rule ext, simp add: OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy bot_option_def invalid_def) -lemma OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet_invalid : "((invalid::\<cdot>Planet) .oclIsTypeOf(Planet)) = invalid" -by(rule ext, simp add: bot_option_def invalid_def) -lemma OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person_invalid : "((invalid::\<cdot>Person) .oclIsTypeOf(Planet)) = invalid" -by(rule ext, simp add: OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person bot_option_def invalid_def) -lemma OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny_null : "((null::\<cdot>OclAny) .oclIsTypeOf(Planet)) = true" -by(rule ext, simp add: OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny bot_option_def null_fun_def null_option_def) -lemma OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy_null : "((null::\<cdot>Galaxy) .oclIsTypeOf(Planet)) = true" -by(rule ext, simp add: OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy bot_option_def null_fun_def null_option_def) -lemma OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet_null : "((null::\<cdot>Planet) .oclIsTypeOf(Planet)) = true" -by(rule ext, simp add: bot_option_def null_fun_def null_option_def) -lemma OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person_null : "((null::\<cdot>Person) .oclIsTypeOf(Planet)) = true" -by(rule ext, simp add: OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person bot_option_def null_fun_def null_option_def) -lemma OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_invalid : "((invalid::\<cdot>OclAny) .oclIsTypeOf(Person)) = invalid" -by(rule ext, simp add: OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny bot_option_def invalid_def) -lemma OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy_invalid : "((invalid::\<cdot>Galaxy) .oclIsTypeOf(Person)) = invalid" -by(rule ext, simp add: OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy bot_option_def invalid_def) -lemma OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet_invalid : "((invalid::\<cdot>Planet) .oclIsTypeOf(Person)) = invalid" -by(rule ext, simp add: OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet bot_option_def invalid_def) -lemma OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_invalid : "((invalid::\<cdot>Person) .oclIsTypeOf(Person)) = invalid" -by(rule ext, simp add: bot_option_def invalid_def) -lemma OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_null : "((null::\<cdot>OclAny) .oclIsTypeOf(Person)) = true" -by(rule ext, simp add: OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny bot_option_def null_fun_def null_option_def) -lemma OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy_null : "((null::\<cdot>Galaxy) .oclIsTypeOf(Person)) = true" -by(rule ext, simp add: OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy bot_option_def null_fun_def null_option_def) -lemma OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet_null : "((null::\<cdot>Planet) .oclIsTypeOf(Person)) = true" -by(rule ext, simp add: OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet bot_option_def null_fun_def null_option_def) -lemma OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_null : "((null::\<cdot>Person) .oclIsTypeOf(Person)) = true" -by(rule ext, simp add: bot_option_def null_fun_def null_option_def) - -(* 67 ************************************ 381 + 1 *) (* term Floor1_istypeof.print_istypeof_lemmas_strict *) -lemmas[simp,code_unfold] = OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_invalid - OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy_invalid - OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet_invalid - OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_invalid - OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_null - OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy_null - OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet_null - OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_null - OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny_invalid - OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy_invalid - OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet_invalid - OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person_invalid - OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny_null - OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy_null - OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet_null - OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person_null - OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny_invalid - OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy_invalid - OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet_invalid - OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person_invalid - OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny_null - OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy_null - OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet_null - OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person_null - OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_invalid - OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy_invalid - OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet_invalid - OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_invalid - OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_null - OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy_null - OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet_null - OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_null - -(* 68 ************************************ 382 + 1 *) -subsection \<open>Validity and Definedness Properties\<close> - -(* 69 ************************************ 383 + 16 *) (* term Floor1_istypeof.print_istypeof_defined *) -lemma OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_defined : -assumes isdef: "\<tau> \<Turnstile> (\<upsilon> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Person) .oclIsTypeOf(Person)))" - apply(insert isdef[simplified foundation18'], simp only: OclValid_def, subst cp_defined) -by(auto simp: cp_defined[symmetric ] bot_option_def OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person split: option.split ty\<E>\<X>\<T>\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n.split ty\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n.split) -lemma OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet_defined : -assumes isdef: "\<tau> \<Turnstile> (\<upsilon> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Planet) .oclIsTypeOf(Person)))" - apply(insert isdef[simplified foundation18'], simp only: OclValid_def, subst cp_defined) -by(auto simp: cp_defined[symmetric ] bot_option_def OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet split: option.split ty\<E>\<X>\<T>\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t.split ty\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t.split) -lemma OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy_defined : -assumes isdef: "\<tau> \<Turnstile> (\<upsilon> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Galaxy) .oclIsTypeOf(Person)))" - apply(insert isdef[simplified foundation18'], simp only: OclValid_def, subst cp_defined) -by(auto simp: cp_defined[symmetric ] bot_option_def OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy split: option.split ty\<E>\<X>\<T>\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y.split ty\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y.split) -lemma OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_defined : -assumes isdef: "\<tau> \<Turnstile> (\<upsilon> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>OclAny) .oclIsTypeOf(Person)))" - apply(insert isdef[simplified foundation18'], simp only: OclValid_def, subst cp_defined) -by(auto simp: cp_defined[symmetric ] bot_option_def OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny split: option.split ty\<E>\<X>\<T>\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y.split ty\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y.split) -lemma OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet_defined : -assumes isdef: "\<tau> \<Turnstile> (\<upsilon> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Planet) .oclIsTypeOf(Planet)))" - apply(insert isdef[simplified foundation18'], simp only: OclValid_def, subst cp_defined) -by(auto simp: cp_defined[symmetric ] bot_option_def OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet split: option.split ty\<E>\<X>\<T>\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t.split ty\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t.split) -lemma OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy_defined : -assumes isdef: "\<tau> \<Turnstile> (\<upsilon> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Galaxy) .oclIsTypeOf(Planet)))" - apply(insert isdef[simplified foundation18'], simp only: OclValid_def, subst cp_defined) -by(auto simp: cp_defined[symmetric ] bot_option_def OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy split: option.split ty\<E>\<X>\<T>\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y.split ty\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y.split) -lemma OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny_defined : -assumes isdef: "\<tau> \<Turnstile> (\<upsilon> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>OclAny) .oclIsTypeOf(Planet)))" - apply(insert isdef[simplified foundation18'], simp only: OclValid_def, subst cp_defined) -by(auto simp: cp_defined[symmetric ] bot_option_def OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny split: option.split ty\<E>\<X>\<T>\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y.split ty\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y.split) -lemma OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person_defined : -assumes isdef: "\<tau> \<Turnstile> (\<upsilon> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Person) .oclIsTypeOf(Planet)))" - apply(insert isdef[simplified foundation18'], simp only: OclValid_def, subst cp_defined) -by(auto simp: cp_defined[symmetric ] bot_option_def OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person split: option.split ty\<E>\<X>\<T>\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n.split ty\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n.split) -lemma OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy_defined : -assumes isdef: "\<tau> \<Turnstile> (\<upsilon> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Galaxy) .oclIsTypeOf(Galaxy)))" - apply(insert isdef[simplified foundation18'], simp only: OclValid_def, subst cp_defined) -by(auto simp: cp_defined[symmetric ] bot_option_def OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy split: option.split ty\<E>\<X>\<T>\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y.split ty\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y.split) -lemma OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny_defined : -assumes isdef: "\<tau> \<Turnstile> (\<upsilon> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>OclAny) .oclIsTypeOf(Galaxy)))" - apply(insert isdef[simplified foundation18'], simp only: OclValid_def, subst cp_defined) -by(auto simp: cp_defined[symmetric ] bot_option_def OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny split: option.split ty\<E>\<X>\<T>\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y.split ty\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y.split) -lemma OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person_defined : -assumes isdef: "\<tau> \<Turnstile> (\<upsilon> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Person) .oclIsTypeOf(Galaxy)))" - apply(insert isdef[simplified foundation18'], simp only: OclValid_def, subst cp_defined) -by(auto simp: cp_defined[symmetric ] bot_option_def OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person split: option.split ty\<E>\<X>\<T>\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n.split ty\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n.split) -lemma OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet_defined : -assumes isdef: "\<tau> \<Turnstile> (\<upsilon> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Planet) .oclIsTypeOf(Galaxy)))" - apply(insert isdef[simplified foundation18'], simp only: OclValid_def, subst cp_defined) -by(auto simp: cp_defined[symmetric ] bot_option_def OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet split: option.split ty\<E>\<X>\<T>\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t.split ty\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t.split) -lemma OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_defined : -assumes isdef: "\<tau> \<Turnstile> (\<upsilon> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>OclAny) .oclIsTypeOf(OclAny)))" - apply(insert isdef[simplified foundation18'], simp only: OclValid_def, subst cp_defined) -by(auto simp: cp_defined[symmetric ] bot_option_def OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny split: option.split ty\<E>\<X>\<T>\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y.split ty\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y.split) -lemma OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_defined : -assumes isdef: "\<tau> \<Turnstile> (\<upsilon> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Person) .oclIsTypeOf(OclAny)))" - apply(insert isdef[simplified foundation18'], simp only: OclValid_def, subst cp_defined) -by(auto simp: cp_defined[symmetric ] bot_option_def OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person split: option.split ty\<E>\<X>\<T>\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n.split ty\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n.split) -lemma OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet_defined : -assumes isdef: "\<tau> \<Turnstile> (\<upsilon> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Planet) .oclIsTypeOf(OclAny)))" - apply(insert isdef[simplified foundation18'], simp only: OclValid_def, subst cp_defined) -by(auto simp: cp_defined[symmetric ] bot_option_def OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet split: option.split ty\<E>\<X>\<T>\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t.split ty\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t.split) -lemma OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy_defined : -assumes isdef: "\<tau> \<Turnstile> (\<upsilon> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Galaxy) .oclIsTypeOf(OclAny)))" - apply(insert isdef[simplified foundation18'], simp only: OclValid_def, subst cp_defined) -by(auto simp: cp_defined[symmetric ] bot_option_def OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy split: option.split ty\<E>\<X>\<T>\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y.split ty\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y.split) - -(* 70 ************************************ 399 + 16 *) (* term Floor1_istypeof.print_istypeof_defined' *) -lemma OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_defined' : -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Person) .oclIsTypeOf(Person)))" -by(rule OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_defined[OF isdef[THEN foundation20]]) -lemma OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet_defined' : -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Planet) .oclIsTypeOf(Person)))" -by(rule OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet_defined[OF isdef[THEN foundation20]]) -lemma OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy_defined' : -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Galaxy) .oclIsTypeOf(Person)))" -by(rule OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy_defined[OF isdef[THEN foundation20]]) -lemma OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_defined' : -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>OclAny) .oclIsTypeOf(Person)))" -by(rule OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_defined[OF isdef[THEN foundation20]]) -lemma OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet_defined' : -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Planet) .oclIsTypeOf(Planet)))" -by(rule OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet_defined[OF isdef[THEN foundation20]]) -lemma OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy_defined' : -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Galaxy) .oclIsTypeOf(Planet)))" -by(rule OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy_defined[OF isdef[THEN foundation20]]) -lemma OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny_defined' : -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>OclAny) .oclIsTypeOf(Planet)))" -by(rule OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny_defined[OF isdef[THEN foundation20]]) -lemma OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person_defined' : -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Person) .oclIsTypeOf(Planet)))" -by(rule OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person_defined[OF isdef[THEN foundation20]]) -lemma OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy_defined' : -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Galaxy) .oclIsTypeOf(Galaxy)))" -by(rule OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy_defined[OF isdef[THEN foundation20]]) -lemma OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny_defined' : -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>OclAny) .oclIsTypeOf(Galaxy)))" -by(rule OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny_defined[OF isdef[THEN foundation20]]) -lemma OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person_defined' : -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Person) .oclIsTypeOf(Galaxy)))" -by(rule OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person_defined[OF isdef[THEN foundation20]]) -lemma OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet_defined' : -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Planet) .oclIsTypeOf(Galaxy)))" -by(rule OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet_defined[OF isdef[THEN foundation20]]) -lemma OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_defined' : -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>OclAny) .oclIsTypeOf(OclAny)))" -by(rule OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_defined[OF isdef[THEN foundation20]]) -lemma OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_defined' : -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Person) .oclIsTypeOf(OclAny)))" -by(rule OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_defined[OF isdef[THEN foundation20]]) -lemma OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet_defined' : -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Planet) .oclIsTypeOf(OclAny)))" -by(rule OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet_defined[OF isdef[THEN foundation20]]) -lemma OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy_defined' : -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Galaxy) .oclIsTypeOf(OclAny)))" -by(rule OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy_defined[OF isdef[THEN foundation20]]) - -(* 71 ************************************ 415 + 1 *) -subsection \<open>Up Down Casting\<close> - -(* 72 ************************************ 416 + 6 *) (* term Floor1_istypeof.print_istypeof_up_larger *) -lemma actualType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_larger_staticType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t : -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> ((X::\<cdot>Person) .oclIsTypeOf(Planet)) \<triangleq> false" - using isdef -by(auto simp: OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person foundation22 foundation16 null_option_def bot_option_def) -lemma actualType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_larger_staticType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y : -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> ((X::\<cdot>Person) .oclIsTypeOf(Galaxy)) \<triangleq> false" - using isdef -by(auto simp: OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person foundation22 foundation16 null_option_def bot_option_def) -lemma actualType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_larger_staticType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y : -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> ((X::\<cdot>Person) .oclIsTypeOf(OclAny)) \<triangleq> false" - using isdef -by(auto simp: OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person foundation22 foundation16 null_option_def bot_option_def) -lemma actualType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_larger_staticType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y : -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> ((X::\<cdot>Planet) .oclIsTypeOf(Galaxy)) \<triangleq> false" - using isdef -by(auto simp: OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet foundation22 foundation16 null_option_def bot_option_def) -lemma actualType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_larger_staticType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y : -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> ((X::\<cdot>Planet) .oclIsTypeOf(OclAny)) \<triangleq> false" - using isdef -by(auto simp: OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet foundation22 foundation16 null_option_def bot_option_def) -lemma actualType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_larger_staticType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y : -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> ((X::\<cdot>Galaxy) .oclIsTypeOf(OclAny)) \<triangleq> false" - using isdef -by(auto simp: OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy foundation22 foundation16 null_option_def bot_option_def) - -(* 73 ************************************ 422 + 10 *) (* term Floor1_istypeof.print_istypeof_up_d_cast *) -lemma down_cast_type\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_from_Planet_to_Person : -assumes istyp: "\<tau> \<Turnstile> ((X::\<cdot>Planet) .oclIsTypeOf(Planet))" -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> (X .oclAsType(Person)) \<triangleq> invalid" - using istyp isdef - apply(auto simp: OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet foundation22 foundation16 null_option_def bot_option_def split: ty\<E>\<X>\<T>\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t.split ty\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t.split) -by(simp add: OclValid_def false_def true_def) -lemma down_cast_type\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_from_Galaxy_to_Person : -assumes istyp: "\<tau> \<Turnstile> ((X::\<cdot>Galaxy) .oclIsTypeOf(Galaxy))" -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> (X .oclAsType(Person)) \<triangleq> invalid" - using istyp isdef - apply(auto simp: OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy foundation22 foundation16 null_option_def bot_option_def split: ty\<E>\<X>\<T>\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y.split ty\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y.split) -by(simp add: OclValid_def false_def true_def) -lemma down_cast_type\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_from_OclAny_to_Person : -assumes istyp: "\<tau> \<Turnstile> ((X::\<cdot>OclAny) .oclIsTypeOf(OclAny))" -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> (X .oclAsType(Person)) \<triangleq> invalid" - using istyp isdef - apply(auto simp: OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny foundation22 foundation16 null_option_def bot_option_def split: ty\<E>\<X>\<T>\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y.split ty\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y.split) -by(simp add: OclValid_def false_def true_def) -lemma down_cast_type\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_from_Galaxy_to_Person : -assumes istyp: "\<tau> \<Turnstile> ((X::\<cdot>Galaxy) .oclIsTypeOf(Planet))" -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> (X .oclAsType(Person)) \<triangleq> invalid" - using istyp isdef - apply(auto simp: OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy foundation22 foundation16 null_option_def bot_option_def split: ty\<E>\<X>\<T>\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y.split ty\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y.split) -by(simp add: OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy OclValid_def false_def true_def) -lemma down_cast_type\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_from_OclAny_to_Person : -assumes istyp: "\<tau> \<Turnstile> ((X::\<cdot>OclAny) .oclIsTypeOf(Planet))" -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> (X .oclAsType(Person)) \<triangleq> invalid" - using istyp isdef - apply(auto simp: OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny foundation22 foundation16 null_option_def bot_option_def split: ty\<E>\<X>\<T>\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y.split ty\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y.split) -by(simp add: OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny OclValid_def false_def true_def) -lemma down_cast_type\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_from_OclAny_to_Person : -assumes istyp: "\<tau> \<Turnstile> ((X::\<cdot>OclAny) .oclIsTypeOf(Galaxy))" -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> (X .oclAsType(Person)) \<triangleq> invalid" - using istyp isdef - apply(auto simp: OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny foundation22 foundation16 null_option_def bot_option_def split: ty\<E>\<X>\<T>\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y.split ty\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y.split) -by(simp add: OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny OclValid_def false_def true_def) -lemma down_cast_type\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_from_Galaxy_to_Planet : -assumes istyp: "\<tau> \<Turnstile> ((X::\<cdot>Galaxy) .oclIsTypeOf(Galaxy))" -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> (X .oclAsType(Planet)) \<triangleq> invalid" - using istyp isdef - apply(auto simp: OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy foundation22 foundation16 null_option_def bot_option_def split: ty\<E>\<X>\<T>\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y.split ty\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y.split) -by(simp add: OclValid_def false_def true_def) -lemma down_cast_type\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_from_OclAny_to_Planet : -assumes istyp: "\<tau> \<Turnstile> ((X::\<cdot>OclAny) .oclIsTypeOf(OclAny))" -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> (X .oclAsType(Planet)) \<triangleq> invalid" - using istyp isdef - apply(auto simp: OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny foundation22 foundation16 null_option_def bot_option_def split: ty\<E>\<X>\<T>\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y.split ty\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y.split) -by(simp add: OclValid_def false_def true_def) -lemma down_cast_type\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_from_OclAny_to_Planet : -assumes istyp: "\<tau> \<Turnstile> ((X::\<cdot>OclAny) .oclIsTypeOf(Galaxy))" -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> (X .oclAsType(Planet)) \<triangleq> invalid" - using istyp isdef - apply(auto simp: OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny foundation22 foundation16 null_option_def bot_option_def split: ty\<E>\<X>\<T>\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y.split ty\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y.split) -by(simp add: OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny OclValid_def false_def true_def) -lemma down_cast_type\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_from_OclAny_to_Galaxy : -assumes istyp: "\<tau> \<Turnstile> ((X::\<cdot>OclAny) .oclIsTypeOf(OclAny))" -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> (X .oclAsType(Galaxy)) \<triangleq> invalid" - using istyp isdef - apply(auto simp: OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny foundation22 foundation16 null_option_def bot_option_def split: ty\<E>\<X>\<T>\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y.split ty\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y.split) -by(simp add: OclValid_def false_def true_def) - -(* 74 ************************************ 432 + 1 *) -subsection \<open>Const\<close> - -(* 75 ************************************ 433 + 1 *) -section \<open>Class Model: OclIsKindOf\<close> - -(* 76 ************************************ 434 + 1 *) -subsection \<open>Definition\<close> - -(* 77 ************************************ 435 + 4 *) (* term Floor1_iskindof.print_iskindof_consts *) -consts OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n :: "'\<alpha> \<Rightarrow> Boolean" ("(_) .oclIsKindOf'(Person')") -consts OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t :: "'\<alpha> \<Rightarrow> Boolean" ("(_) .oclIsKindOf'(Planet')") -consts OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y :: "'\<alpha> \<Rightarrow> Boolean" ("(_) .oclIsKindOf'(Galaxy')") -consts OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y :: "'\<alpha> \<Rightarrow> Boolean" ("(_) .oclIsKindOf'(OclAny')") - -(* 78 ************************************ 439 + 16 *) (* term Floor1_iskindof.print_iskindof_class *) -overloading OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n \<equiv> "(OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n::(\<cdot>Person) \<Rightarrow> _)" -begin - definition OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person : "(x::\<cdot>Person) .oclIsKindOf(Person) \<equiv> (x .oclIsTypeOf(Person))" -end -overloading OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n \<equiv> "(OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n::(\<cdot>Planet) \<Rightarrow> _)" -begin - definition OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet : "(x::\<cdot>Planet) .oclIsKindOf(Person) \<equiv> (x .oclIsTypeOf(Person))" -end -overloading OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n \<equiv> "(OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n::(\<cdot>Galaxy) \<Rightarrow> _)" -begin - definition OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy : "(x::\<cdot>Galaxy) .oclIsKindOf(Person) \<equiv> (x .oclIsTypeOf(Person))" -end -overloading OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n \<equiv> "(OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n::(\<cdot>OclAny) \<Rightarrow> _)" -begin - definition OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny : "(x::\<cdot>OclAny) .oclIsKindOf(Person) \<equiv> (x .oclIsTypeOf(Person))" -end -overloading OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t \<equiv> "(OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t::(\<cdot>Planet) \<Rightarrow> _)" -begin - definition OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet : "(x::\<cdot>Planet) .oclIsKindOf(Planet) \<equiv> (x .oclIsTypeOf(Planet)) or (x .oclIsKindOf(Person))" -end -overloading OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t \<equiv> "(OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t::(\<cdot>Galaxy) \<Rightarrow> _)" -begin - definition OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy : "(x::\<cdot>Galaxy) .oclIsKindOf(Planet) \<equiv> (x .oclIsTypeOf(Planet)) or (x .oclIsKindOf(Person))" -end -overloading OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t \<equiv> "(OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t::(\<cdot>OclAny) \<Rightarrow> _)" -begin - definition OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny : "(x::\<cdot>OclAny) .oclIsKindOf(Planet) \<equiv> (x .oclIsTypeOf(Planet)) or (x .oclIsKindOf(Person))" -end -overloading OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t \<equiv> "(OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t::(\<cdot>Person) \<Rightarrow> _)" -begin - definition OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person : "(x::\<cdot>Person) .oclIsKindOf(Planet) \<equiv> (x .oclIsTypeOf(Planet)) or (x .oclIsKindOf(Person))" -end -overloading OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y \<equiv> "(OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y::(\<cdot>Galaxy) \<Rightarrow> _)" -begin - definition OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy : "(x::\<cdot>Galaxy) .oclIsKindOf(Galaxy) \<equiv> (x .oclIsTypeOf(Galaxy)) or (x .oclIsKindOf(Planet))" -end -overloading OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y \<equiv> "(OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y::(\<cdot>OclAny) \<Rightarrow> _)" -begin - definition OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny : "(x::\<cdot>OclAny) .oclIsKindOf(Galaxy) \<equiv> (x .oclIsTypeOf(Galaxy)) or (x .oclIsKindOf(Planet))" -end -overloading OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y \<equiv> "(OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y::(\<cdot>Person) \<Rightarrow> _)" -begin - definition OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person : "(x::\<cdot>Person) .oclIsKindOf(Galaxy) \<equiv> (x .oclIsTypeOf(Galaxy)) or (x .oclIsKindOf(Planet))" -end -overloading OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y \<equiv> "(OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y::(\<cdot>Planet) \<Rightarrow> _)" -begin - definition OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet : "(x::\<cdot>Planet) .oclIsKindOf(Galaxy) \<equiv> (x .oclIsTypeOf(Galaxy)) or (x .oclIsKindOf(Planet))" -end -overloading OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y \<equiv> "(OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y::(\<cdot>OclAny) \<Rightarrow> _)" -begin - definition OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny : "(x::\<cdot>OclAny) .oclIsKindOf(OclAny) \<equiv> (x .oclIsTypeOf(OclAny)) or (x .oclIsKindOf(Galaxy))" -end -overloading OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y \<equiv> "(OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y::(\<cdot>Person) \<Rightarrow> _)" -begin - definition OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person : "(x::\<cdot>Person) .oclIsKindOf(OclAny) \<equiv> (x .oclIsTypeOf(OclAny)) or (x .oclIsKindOf(Galaxy))" -end -overloading OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y \<equiv> "(OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y::(\<cdot>Planet) \<Rightarrow> _)" -begin - definition OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet : "(x::\<cdot>Planet) .oclIsKindOf(OclAny) \<equiv> (x .oclIsTypeOf(OclAny)) or (x .oclIsKindOf(Galaxy))" -end -overloading OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y \<equiv> "(OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y::(\<cdot>Galaxy) \<Rightarrow> _)" -begin - definition OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy : "(x::\<cdot>Galaxy) .oclIsKindOf(OclAny) \<equiv> (x .oclIsTypeOf(OclAny)) or (x .oclIsKindOf(Galaxy))" -end - -(* 79 ************************************ 455 + 4 *) (* term Floor1_iskindof.print_iskindof_from_universe *) -definition "OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_\<AA> = (\<lambda> (in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (Person)) \<Rightarrow> (((((\<lambda>x _. \<lfloor>\<lfloor>x\<rfloor>\<rfloor>)) (Person))::\<cdot>Person) .oclIsKindOf(Person)) - | (in\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (Planet)) \<Rightarrow> (((((\<lambda>x _. \<lfloor>\<lfloor>x\<rfloor>\<rfloor>)) (Planet))::\<cdot>Planet) .oclIsKindOf(Person)) - | (in\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y (Galaxy)) \<Rightarrow> (((((\<lambda>x _. \<lfloor>\<lfloor>x\<rfloor>\<rfloor>)) (Galaxy))::\<cdot>Galaxy) .oclIsKindOf(Person)) - | (in\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y (OclAny)) \<Rightarrow> (((((\<lambda>x _. \<lfloor>\<lfloor>x\<rfloor>\<rfloor>)) (OclAny))::\<cdot>OclAny) .oclIsKindOf(Person)))" -definition "OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_\<AA> = (\<lambda> (in\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (Planet)) \<Rightarrow> (((((\<lambda>x _. \<lfloor>\<lfloor>x\<rfloor>\<rfloor>)) (Planet))::\<cdot>Planet) .oclIsKindOf(Planet)) - | (in\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y (Galaxy)) \<Rightarrow> (((((\<lambda>x _. \<lfloor>\<lfloor>x\<rfloor>\<rfloor>)) (Galaxy))::\<cdot>Galaxy) .oclIsKindOf(Planet)) - | (in\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y (OclAny)) \<Rightarrow> (((((\<lambda>x _. \<lfloor>\<lfloor>x\<rfloor>\<rfloor>)) (OclAny))::\<cdot>OclAny) .oclIsKindOf(Planet)) - | (in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (Person)) \<Rightarrow> (((((\<lambda>x _. \<lfloor>\<lfloor>x\<rfloor>\<rfloor>)) (Person))::\<cdot>Person) .oclIsKindOf(Planet)))" -definition "OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_\<AA> = (\<lambda> (in\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y (Galaxy)) \<Rightarrow> (((((\<lambda>x _. \<lfloor>\<lfloor>x\<rfloor>\<rfloor>)) (Galaxy))::\<cdot>Galaxy) .oclIsKindOf(Galaxy)) - | (in\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y (OclAny)) \<Rightarrow> (((((\<lambda>x _. \<lfloor>\<lfloor>x\<rfloor>\<rfloor>)) (OclAny))::\<cdot>OclAny) .oclIsKindOf(Galaxy)) - | (in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (Person)) \<Rightarrow> (((((\<lambda>x _. \<lfloor>\<lfloor>x\<rfloor>\<rfloor>)) (Person))::\<cdot>Person) .oclIsKindOf(Galaxy)) - | (in\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (Planet)) \<Rightarrow> (((((\<lambda>x _. \<lfloor>\<lfloor>x\<rfloor>\<rfloor>)) (Planet))::\<cdot>Planet) .oclIsKindOf(Galaxy)))" -definition "OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_\<AA> = (\<lambda> (in\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y (OclAny)) \<Rightarrow> (((((\<lambda>x _. \<lfloor>\<lfloor>x\<rfloor>\<rfloor>)) (OclAny))::\<cdot>OclAny) .oclIsKindOf(OclAny)) - | (in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (Person)) \<Rightarrow> (((((\<lambda>x _. \<lfloor>\<lfloor>x\<rfloor>\<rfloor>)) (Person))::\<cdot>Person) .oclIsKindOf(OclAny)) - | (in\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (Planet)) \<Rightarrow> (((((\<lambda>x _. \<lfloor>\<lfloor>x\<rfloor>\<rfloor>)) (Planet))::\<cdot>Planet) .oclIsKindOf(OclAny)) - | (in\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y (Galaxy)) \<Rightarrow> (((((\<lambda>x _. \<lfloor>\<lfloor>x\<rfloor>\<rfloor>)) (Galaxy))::\<cdot>Galaxy) .oclIsKindOf(OclAny)))" - -(* 80 ************************************ 459 + 1 *) (* term Floor1_iskindof.print_iskindof_lemmas_id *) -lemmas[simp,code_unfold] = OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person - OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet - OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy - OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny - -(* 81 ************************************ 460 + 1 *) -subsection \<open>Context Passing\<close> - -(* 82 ************************************ 461 + 64 *) (* term Floor1_iskindof.print_iskindof_lemma_cp *) -lemma cp_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_Person : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Person)))::\<cdot>Person) .oclIsKindOf(Person)))))" -by(simp only: OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person, simp only: cp_OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_Person) -lemma cp_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet_Person : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Planet)))::\<cdot>Person) .oclIsKindOf(Person)))))" -by(simp only: OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person, simp only: cp_OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet_Person) -lemma cp_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy_Person : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Galaxy)))::\<cdot>Person) .oclIsKindOf(Person)))))" -by(simp only: OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person, simp only: cp_OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy_Person) -lemma cp_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_Person : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>OclAny)))::\<cdot>Person) .oclIsKindOf(Person)))))" -by(simp only: OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person, simp only: cp_OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_Person) -lemma cp_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_Planet : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Person)))::\<cdot>Planet) .oclIsKindOf(Person)))))" -by(simp only: OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet, simp only: cp_OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_Planet) -lemma cp_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet_Planet : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Planet)))::\<cdot>Planet) .oclIsKindOf(Person)))))" -by(simp only: OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet, simp only: cp_OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet_Planet) -lemma cp_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy_Planet : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Galaxy)))::\<cdot>Planet) .oclIsKindOf(Person)))))" -by(simp only: OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet, simp only: cp_OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy_Planet) -lemma cp_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_Planet : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>OclAny)))::\<cdot>Planet) .oclIsKindOf(Person)))))" -by(simp only: OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet, simp only: cp_OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_Planet) -lemma cp_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_Galaxy : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Person)))::\<cdot>Galaxy) .oclIsKindOf(Person)))))" -by(simp only: OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy, simp only: cp_OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_Galaxy) -lemma cp_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet_Galaxy : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Planet)))::\<cdot>Galaxy) .oclIsKindOf(Person)))))" -by(simp only: OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy, simp only: cp_OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet_Galaxy) -lemma cp_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy_Galaxy : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Galaxy)))::\<cdot>Galaxy) .oclIsKindOf(Person)))))" -by(simp only: OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy, simp only: cp_OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy_Galaxy) -lemma cp_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_Galaxy : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>OclAny)))::\<cdot>Galaxy) .oclIsKindOf(Person)))))" -by(simp only: OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy, simp only: cp_OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_Galaxy) -lemma cp_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_OclAny : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Person)))::\<cdot>OclAny) .oclIsKindOf(Person)))))" -by(simp only: OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny, simp only: cp_OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_OclAny) -lemma cp_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet_OclAny : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Planet)))::\<cdot>OclAny) .oclIsKindOf(Person)))))" -by(simp only: OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny, simp only: cp_OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet_OclAny) -lemma cp_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy_OclAny : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Galaxy)))::\<cdot>OclAny) .oclIsKindOf(Person)))))" -by(simp only: OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny, simp only: cp_OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy_OclAny) -lemma cp_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_OclAny : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>OclAny)))::\<cdot>OclAny) .oclIsKindOf(Person)))))" -by(simp only: OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny, simp only: cp_OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_OclAny) -lemma cp_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet_Planet : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Planet)))::\<cdot>Planet) .oclIsKindOf(Planet)))))" - apply(simp only: OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet) - apply((rule cpI2[where f = "(or)"], (rule allI)+, rule cp_OclOr)+) - apply(simp only: cp_OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet_Planet) -by(simp only: cp_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet_Planet) -lemma cp_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy_Planet : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Galaxy)))::\<cdot>Planet) .oclIsKindOf(Planet)))))" - apply(simp only: OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet) - apply((rule cpI2[where f = "(or)"], (rule allI)+, rule cp_OclOr)+) - apply(simp only: cp_OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy_Planet) -by(simp only: cp_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy_Planet) -lemma cp_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny_Planet : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>OclAny)))::\<cdot>Planet) .oclIsKindOf(Planet)))))" - apply(simp only: OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet) - apply((rule cpI2[where f = "(or)"], (rule allI)+, rule cp_OclOr)+) - apply(simp only: cp_OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny_Planet) -by(simp only: cp_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_Planet) -lemma cp_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person_Planet : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Person)))::\<cdot>Planet) .oclIsKindOf(Planet)))))" - apply(simp only: OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet) - apply((rule cpI2[where f = "(or)"], (rule allI)+, rule cp_OclOr)+) - apply(simp only: cp_OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person_Planet) -by(simp only: cp_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_Planet) -lemma cp_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet_Galaxy : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Planet)))::\<cdot>Galaxy) .oclIsKindOf(Planet)))))" - apply(simp only: OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy) - apply((rule cpI2[where f = "(or)"], (rule allI)+, rule cp_OclOr)+) - apply(simp only: cp_OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet_Galaxy) -by(simp only: cp_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet_Galaxy) -lemma cp_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy_Galaxy : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Galaxy)))::\<cdot>Galaxy) .oclIsKindOf(Planet)))))" - apply(simp only: OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy) - apply((rule cpI2[where f = "(or)"], (rule allI)+, rule cp_OclOr)+) - apply(simp only: cp_OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy_Galaxy) -by(simp only: cp_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy_Galaxy) -lemma cp_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny_Galaxy : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>OclAny)))::\<cdot>Galaxy) .oclIsKindOf(Planet)))))" - apply(simp only: OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy) - apply((rule cpI2[where f = "(or)"], (rule allI)+, rule cp_OclOr)+) - apply(simp only: cp_OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny_Galaxy) -by(simp only: cp_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_Galaxy) -lemma cp_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person_Galaxy : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Person)))::\<cdot>Galaxy) .oclIsKindOf(Planet)))))" - apply(simp only: OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy) - apply((rule cpI2[where f = "(or)"], (rule allI)+, rule cp_OclOr)+) - apply(simp only: cp_OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person_Galaxy) -by(simp only: cp_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_Galaxy) -lemma cp_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet_OclAny : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Planet)))::\<cdot>OclAny) .oclIsKindOf(Planet)))))" - apply(simp only: OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny) - apply((rule cpI2[where f = "(or)"], (rule allI)+, rule cp_OclOr)+) - apply(simp only: cp_OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet_OclAny) -by(simp only: cp_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet_OclAny) -lemma cp_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy_OclAny : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Galaxy)))::\<cdot>OclAny) .oclIsKindOf(Planet)))))" - apply(simp only: OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny) - apply((rule cpI2[where f = "(or)"], (rule allI)+, rule cp_OclOr)+) - apply(simp only: cp_OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy_OclAny) -by(simp only: cp_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy_OclAny) -lemma cp_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny_OclAny : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>OclAny)))::\<cdot>OclAny) .oclIsKindOf(Planet)))))" - apply(simp only: OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny) - apply((rule cpI2[where f = "(or)"], (rule allI)+, rule cp_OclOr)+) - apply(simp only: cp_OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny_OclAny) -by(simp only: cp_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_OclAny) -lemma cp_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person_OclAny : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Person)))::\<cdot>OclAny) .oclIsKindOf(Planet)))))" - apply(simp only: OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny) - apply((rule cpI2[where f = "(or)"], (rule allI)+, rule cp_OclOr)+) - apply(simp only: cp_OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person_OclAny) -by(simp only: cp_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_OclAny) -lemma cp_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet_Person : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Planet)))::\<cdot>Person) .oclIsKindOf(Planet)))))" - apply(simp only: OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person) - apply((rule cpI2[where f = "(or)"], (rule allI)+, rule cp_OclOr)+) - apply(simp only: cp_OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet_Person) -by(simp only: cp_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet_Person) -lemma cp_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy_Person : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Galaxy)))::\<cdot>Person) .oclIsKindOf(Planet)))))" - apply(simp only: OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person) - apply((rule cpI2[where f = "(or)"], (rule allI)+, rule cp_OclOr)+) - apply(simp only: cp_OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy_Person) -by(simp only: cp_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy_Person) -lemma cp_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny_Person : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>OclAny)))::\<cdot>Person) .oclIsKindOf(Planet)))))" - apply(simp only: OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person) - apply((rule cpI2[where f = "(or)"], (rule allI)+, rule cp_OclOr)+) - apply(simp only: cp_OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny_Person) -by(simp only: cp_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_Person) -lemma cp_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person_Person : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Person)))::\<cdot>Person) .oclIsKindOf(Planet)))))" - apply(simp only: OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person) - apply((rule cpI2[where f = "(or)"], (rule allI)+, rule cp_OclOr)+) - apply(simp only: cp_OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person_Person) -by(simp only: cp_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_Person) -lemma cp_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy_Galaxy : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Galaxy)))::\<cdot>Galaxy) .oclIsKindOf(Galaxy)))))" - apply(simp only: OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy) - apply((rule cpI2[where f = "(or)"], (rule allI)+, rule cp_OclOr)+) - apply(simp only: cp_OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy_Galaxy) -by(simp only: cp_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy_Galaxy) -lemma cp_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny_Galaxy : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>OclAny)))::\<cdot>Galaxy) .oclIsKindOf(Galaxy)))))" - apply(simp only: OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy) - apply((rule cpI2[where f = "(or)"], (rule allI)+, rule cp_OclOr)+) - apply(simp only: cp_OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny_Galaxy) -by(simp only: cp_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny_Galaxy) -lemma cp_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person_Galaxy : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Person)))::\<cdot>Galaxy) .oclIsKindOf(Galaxy)))))" - apply(simp only: OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy) - apply((rule cpI2[where f = "(or)"], (rule allI)+, rule cp_OclOr)+) - apply(simp only: cp_OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person_Galaxy) -by(simp only: cp_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person_Galaxy) -lemma cp_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet_Galaxy : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Planet)))::\<cdot>Galaxy) .oclIsKindOf(Galaxy)))))" - apply(simp only: OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy) - apply((rule cpI2[where f = "(or)"], (rule allI)+, rule cp_OclOr)+) - apply(simp only: cp_OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet_Galaxy) -by(simp only: cp_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet_Galaxy) -lemma cp_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy_OclAny : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Galaxy)))::\<cdot>OclAny) .oclIsKindOf(Galaxy)))))" - apply(simp only: OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny) - apply((rule cpI2[where f = "(or)"], (rule allI)+, rule cp_OclOr)+) - apply(simp only: cp_OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy_OclAny) -by(simp only: cp_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy_OclAny) -lemma cp_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny_OclAny : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>OclAny)))::\<cdot>OclAny) .oclIsKindOf(Galaxy)))))" - apply(simp only: OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny) - apply((rule cpI2[where f = "(or)"], (rule allI)+, rule cp_OclOr)+) - apply(simp only: cp_OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny_OclAny) -by(simp only: cp_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny_OclAny) -lemma cp_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person_OclAny : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Person)))::\<cdot>OclAny) .oclIsKindOf(Galaxy)))))" - apply(simp only: OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny) - apply((rule cpI2[where f = "(or)"], (rule allI)+, rule cp_OclOr)+) - apply(simp only: cp_OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person_OclAny) -by(simp only: cp_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person_OclAny) -lemma cp_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet_OclAny : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Planet)))::\<cdot>OclAny) .oclIsKindOf(Galaxy)))))" - apply(simp only: OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny) - apply((rule cpI2[where f = "(or)"], (rule allI)+, rule cp_OclOr)+) - apply(simp only: cp_OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet_OclAny) -by(simp only: cp_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet_OclAny) -lemma cp_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy_Person : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Galaxy)))::\<cdot>Person) .oclIsKindOf(Galaxy)))))" - apply(simp only: OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person) - apply((rule cpI2[where f = "(or)"], (rule allI)+, rule cp_OclOr)+) - apply(simp only: cp_OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy_Person) -by(simp only: cp_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy_Person) -lemma cp_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny_Person : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>OclAny)))::\<cdot>Person) .oclIsKindOf(Galaxy)))))" - apply(simp only: OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person) - apply((rule cpI2[where f = "(or)"], (rule allI)+, rule cp_OclOr)+) - apply(simp only: cp_OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny_Person) -by(simp only: cp_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny_Person) -lemma cp_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person_Person : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Person)))::\<cdot>Person) .oclIsKindOf(Galaxy)))))" - apply(simp only: OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person) - apply((rule cpI2[where f = "(or)"], (rule allI)+, rule cp_OclOr)+) - apply(simp only: cp_OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person_Person) -by(simp only: cp_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person_Person) -lemma cp_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet_Person : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Planet)))::\<cdot>Person) .oclIsKindOf(Galaxy)))))" - apply(simp only: OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person) - apply((rule cpI2[where f = "(or)"], (rule allI)+, rule cp_OclOr)+) - apply(simp only: cp_OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet_Person) -by(simp only: cp_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet_Person) -lemma cp_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy_Planet : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Galaxy)))::\<cdot>Planet) .oclIsKindOf(Galaxy)))))" - apply(simp only: OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet) - apply((rule cpI2[where f = "(or)"], (rule allI)+, rule cp_OclOr)+) - apply(simp only: cp_OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy_Planet) -by(simp only: cp_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy_Planet) -lemma cp_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny_Planet : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>OclAny)))::\<cdot>Planet) .oclIsKindOf(Galaxy)))))" - apply(simp only: OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet) - apply((rule cpI2[where f = "(or)"], (rule allI)+, rule cp_OclOr)+) - apply(simp only: cp_OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny_Planet) -by(simp only: cp_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny_Planet) -lemma cp_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person_Planet : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Person)))::\<cdot>Planet) .oclIsKindOf(Galaxy)))))" - apply(simp only: OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet) - apply((rule cpI2[where f = "(or)"], (rule allI)+, rule cp_OclOr)+) - apply(simp only: cp_OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person_Planet) -by(simp only: cp_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person_Planet) -lemma cp_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet_Planet : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Planet)))::\<cdot>Planet) .oclIsKindOf(Galaxy)))))" - apply(simp only: OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet) - apply((rule cpI2[where f = "(or)"], (rule allI)+, rule cp_OclOr)+) - apply(simp only: cp_OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet_Planet) -by(simp only: cp_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet_Planet) -lemma cp_OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_OclAny : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>OclAny)))::\<cdot>OclAny) .oclIsKindOf(OclAny)))))" - apply(simp only: OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny) - apply((rule cpI2[where f = "(or)"], (rule allI)+, rule cp_OclOr)+) - apply(simp only: cp_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_OclAny) -by(simp only: cp_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny_OclAny) -lemma cp_OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_OclAny : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Person)))::\<cdot>OclAny) .oclIsKindOf(OclAny)))))" - apply(simp only: OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny) - apply((rule cpI2[where f = "(or)"], (rule allI)+, rule cp_OclOr)+) - apply(simp only: cp_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_OclAny) -by(simp only: cp_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person_OclAny) -lemma cp_OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet_OclAny : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Planet)))::\<cdot>OclAny) .oclIsKindOf(OclAny)))))" - apply(simp only: OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny) - apply((rule cpI2[where f = "(or)"], (rule allI)+, rule cp_OclOr)+) - apply(simp only: cp_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet_OclAny) -by(simp only: cp_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet_OclAny) -lemma cp_OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy_OclAny : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Galaxy)))::\<cdot>OclAny) .oclIsKindOf(OclAny)))))" - apply(simp only: OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny) - apply((rule cpI2[where f = "(or)"], (rule allI)+, rule cp_OclOr)+) - apply(simp only: cp_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy_OclAny) -by(simp only: cp_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy_OclAny) -lemma cp_OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_Person : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>OclAny)))::\<cdot>Person) .oclIsKindOf(OclAny)))))" - apply(simp only: OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person) - apply((rule cpI2[where f = "(or)"], (rule allI)+, rule cp_OclOr)+) - apply(simp only: cp_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_Person) -by(simp only: cp_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny_Person) -lemma cp_OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_Person : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Person)))::\<cdot>Person) .oclIsKindOf(OclAny)))))" - apply(simp only: OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person) - apply((rule cpI2[where f = "(or)"], (rule allI)+, rule cp_OclOr)+) - apply(simp only: cp_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_Person) -by(simp only: cp_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person_Person) -lemma cp_OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet_Person : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Planet)))::\<cdot>Person) .oclIsKindOf(OclAny)))))" - apply(simp only: OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person) - apply((rule cpI2[where f = "(or)"], (rule allI)+, rule cp_OclOr)+) - apply(simp only: cp_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet_Person) -by(simp only: cp_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet_Person) -lemma cp_OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy_Person : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Galaxy)))::\<cdot>Person) .oclIsKindOf(OclAny)))))" - apply(simp only: OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person) - apply((rule cpI2[where f = "(or)"], (rule allI)+, rule cp_OclOr)+) - apply(simp only: cp_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy_Person) -by(simp only: cp_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy_Person) -lemma cp_OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_Planet : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>OclAny)))::\<cdot>Planet) .oclIsKindOf(OclAny)))))" - apply(simp only: OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet) - apply((rule cpI2[where f = "(or)"], (rule allI)+, rule cp_OclOr)+) - apply(simp only: cp_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_Planet) -by(simp only: cp_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny_Planet) -lemma cp_OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_Planet : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Person)))::\<cdot>Planet) .oclIsKindOf(OclAny)))))" - apply(simp only: OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet) - apply((rule cpI2[where f = "(or)"], (rule allI)+, rule cp_OclOr)+) - apply(simp only: cp_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_Planet) -by(simp only: cp_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person_Planet) -lemma cp_OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet_Planet : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Planet)))::\<cdot>Planet) .oclIsKindOf(OclAny)))))" - apply(simp only: OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet) - apply((rule cpI2[where f = "(or)"], (rule allI)+, rule cp_OclOr)+) - apply(simp only: cp_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet_Planet) -by(simp only: cp_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet_Planet) -lemma cp_OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy_Planet : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Galaxy)))::\<cdot>Planet) .oclIsKindOf(OclAny)))))" - apply(simp only: OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet) - apply((rule cpI2[where f = "(or)"], (rule allI)+, rule cp_OclOr)+) - apply(simp only: cp_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy_Planet) -by(simp only: cp_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy_Planet) -lemma cp_OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_Galaxy : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>OclAny)))::\<cdot>Galaxy) .oclIsKindOf(OclAny)))))" - apply(simp only: OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy) - apply((rule cpI2[where f = "(or)"], (rule allI)+, rule cp_OclOr)+) - apply(simp only: cp_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_Galaxy) -by(simp only: cp_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny_Galaxy) -lemma cp_OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_Galaxy : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Person)))::\<cdot>Galaxy) .oclIsKindOf(OclAny)))))" - apply(simp only: OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy) - apply((rule cpI2[where f = "(or)"], (rule allI)+, rule cp_OclOr)+) - apply(simp only: cp_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_Galaxy) -by(simp only: cp_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person_Galaxy) -lemma cp_OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet_Galaxy : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Planet)))::\<cdot>Galaxy) .oclIsKindOf(OclAny)))))" - apply(simp only: OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy) - apply((rule cpI2[where f = "(or)"], (rule allI)+, rule cp_OclOr)+) - apply(simp only: cp_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet_Galaxy) -by(simp only: cp_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet_Galaxy) -lemma cp_OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy_Galaxy : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Galaxy)))::\<cdot>Galaxy) .oclIsKindOf(OclAny)))))" - apply(simp only: OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy) - apply((rule cpI2[where f = "(or)"], (rule allI)+, rule cp_OclOr)+) - apply(simp only: cp_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy_Galaxy) -by(simp only: cp_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy_Galaxy) - -(* 83 ************************************ 525 + 1 *) (* term Floor1_iskindof.print_iskindof_lemmas_cp *) -lemmas[simp,code_unfold] = cp_OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_OclAny - cp_OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy_OclAny - cp_OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet_OclAny - cp_OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_OclAny - cp_OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_Galaxy - cp_OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy_Galaxy - cp_OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet_Galaxy - cp_OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_Galaxy - cp_OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_Planet - cp_OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy_Planet - cp_OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet_Planet - cp_OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_Planet - cp_OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_Person - cp_OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy_Person - cp_OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet_Person - cp_OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_Person - cp_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny_OclAny - cp_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy_OclAny - cp_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet_OclAny - cp_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person_OclAny - cp_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny_Galaxy - cp_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy_Galaxy - cp_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet_Galaxy - cp_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person_Galaxy - cp_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny_Planet - cp_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy_Planet - cp_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet_Planet - cp_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person_Planet - cp_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny_Person - cp_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy_Person - cp_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet_Person - cp_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person_Person - cp_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny_OclAny - cp_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy_OclAny - cp_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet_OclAny - cp_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person_OclAny - cp_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny_Galaxy - cp_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy_Galaxy - cp_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet_Galaxy - cp_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person_Galaxy - cp_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny_Planet - cp_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy_Planet - cp_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet_Planet - cp_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person_Planet - cp_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny_Person - cp_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy_Person - cp_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet_Person - cp_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person_Person - cp_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_OclAny - cp_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy_OclAny - cp_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet_OclAny - cp_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_OclAny - cp_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_Galaxy - cp_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy_Galaxy - cp_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet_Galaxy - cp_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_Galaxy - cp_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_Planet - cp_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy_Planet - cp_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet_Planet - cp_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_Planet - cp_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_Person - cp_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy_Person - cp_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet_Person - cp_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_Person - -(* 84 ************************************ 526 + 1 *) -subsection \<open>Execution with Invalid or Null as Argument\<close> - -(* 85 ************************************ 527 + 32 *) (* term Floor1_iskindof.print_iskindof_lemma_strict *) -lemma OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_invalid : "((invalid::\<cdot>Person) .oclIsKindOf(Person)) = invalid" -by(simp only: OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_invalid) -lemma OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_null : "((null::\<cdot>Person) .oclIsKindOf(Person)) = true" -by(simp only: OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_null) -lemma OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet_invalid : "((invalid::\<cdot>Planet) .oclIsKindOf(Person)) = invalid" -by(simp only: OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet_invalid) -lemma OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet_null : "((null::\<cdot>Planet) .oclIsKindOf(Person)) = true" -by(simp only: OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet_null) -lemma OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy_invalid : "((invalid::\<cdot>Galaxy) .oclIsKindOf(Person)) = invalid" -by(simp only: OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy_invalid) -lemma OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy_null : "((null::\<cdot>Galaxy) .oclIsKindOf(Person)) = true" -by(simp only: OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy_null) -lemma OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_invalid : "((invalid::\<cdot>OclAny) .oclIsKindOf(Person)) = invalid" -by(simp only: OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_invalid) -lemma OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_null : "((null::\<cdot>OclAny) .oclIsKindOf(Person)) = true" -by(simp only: OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_null) -lemma OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet_invalid : "((invalid::\<cdot>Planet) .oclIsKindOf(Planet)) = invalid" -by(simp only: OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet_invalid OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet_invalid, simp) -lemma OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet_null : "((null::\<cdot>Planet) .oclIsKindOf(Planet)) = true" -by(simp only: OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet_null OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet_null, simp) -lemma OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy_invalid : "((invalid::\<cdot>Galaxy) .oclIsKindOf(Planet)) = invalid" -by(simp only: OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy_invalid OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy_invalid, simp) -lemma OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy_null : "((null::\<cdot>Galaxy) .oclIsKindOf(Planet)) = true" -by(simp only: OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy_null OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy_null, simp) -lemma OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny_invalid : "((invalid::\<cdot>OclAny) .oclIsKindOf(Planet)) = invalid" -by(simp only: OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny_invalid OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_invalid, simp) -lemma OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny_null : "((null::\<cdot>OclAny) .oclIsKindOf(Planet)) = true" -by(simp only: OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny_null OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_null, simp) -lemma OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person_invalid : "((invalid::\<cdot>Person) .oclIsKindOf(Planet)) = invalid" -by(simp only: OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person_invalid OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_invalid, simp) -lemma OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person_null : "((null::\<cdot>Person) .oclIsKindOf(Planet)) = true" -by(simp only: OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person_null OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_null, simp) -lemma OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy_invalid : "((invalid::\<cdot>Galaxy) .oclIsKindOf(Galaxy)) = invalid" -by(simp only: OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy_invalid OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy_invalid, simp) -lemma OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy_null : "((null::\<cdot>Galaxy) .oclIsKindOf(Galaxy)) = true" -by(simp only: OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy_null OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy_null, simp) -lemma OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny_invalid : "((invalid::\<cdot>OclAny) .oclIsKindOf(Galaxy)) = invalid" -by(simp only: OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny_invalid OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny_invalid, simp) -lemma OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny_null : "((null::\<cdot>OclAny) .oclIsKindOf(Galaxy)) = true" -by(simp only: OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny_null OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny_null, simp) -lemma OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person_invalid : "((invalid::\<cdot>Person) .oclIsKindOf(Galaxy)) = invalid" -by(simp only: OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person_invalid OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person_invalid, simp) -lemma OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person_null : "((null::\<cdot>Person) .oclIsKindOf(Galaxy)) = true" -by(simp only: OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person_null OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person_null, simp) -lemma OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet_invalid : "((invalid::\<cdot>Planet) .oclIsKindOf(Galaxy)) = invalid" -by(simp only: OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet_invalid OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet_invalid, simp) -lemma OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet_null : "((null::\<cdot>Planet) .oclIsKindOf(Galaxy)) = true" -by(simp only: OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet_null OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet_null, simp) -lemma OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_invalid : "((invalid::\<cdot>OclAny) .oclIsKindOf(OclAny)) = invalid" -by(simp only: OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_invalid OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny_invalid, simp) -lemma OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_null : "((null::\<cdot>OclAny) .oclIsKindOf(OclAny)) = true" -by(simp only: OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_null OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny_null, simp) -lemma OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_invalid : "((invalid::\<cdot>Person) .oclIsKindOf(OclAny)) = invalid" -by(simp only: OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_invalid OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person_invalid, simp) -lemma OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_null : "((null::\<cdot>Person) .oclIsKindOf(OclAny)) = true" -by(simp only: OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_null OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person_null, simp) -lemma OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet_invalid : "((invalid::\<cdot>Planet) .oclIsKindOf(OclAny)) = invalid" -by(simp only: OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet_invalid OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet_invalid, simp) -lemma OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet_null : "((null::\<cdot>Planet) .oclIsKindOf(OclAny)) = true" -by(simp only: OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet_null OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet_null, simp) -lemma OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy_invalid : "((invalid::\<cdot>Galaxy) .oclIsKindOf(OclAny)) = invalid" -by(simp only: OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy_invalid OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy_invalid, simp) -lemma OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy_null : "((null::\<cdot>Galaxy) .oclIsKindOf(OclAny)) = true" -by(simp only: OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy_null OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy_null, simp) - -(* 86 ************************************ 559 + 1 *) (* term Floor1_iskindof.print_iskindof_lemmas_strict *) -lemmas[simp,code_unfold] = OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_invalid - OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy_invalid - OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet_invalid - OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_invalid - OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_null - OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy_null - OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet_null - OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_null - OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny_invalid - OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy_invalid - OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet_invalid - OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person_invalid - OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny_null - OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy_null - OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet_null - OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person_null - OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny_invalid - OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy_invalid - OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet_invalid - OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person_invalid - OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny_null - OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy_null - OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet_null - OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person_null - OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_invalid - OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy_invalid - OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet_invalid - OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_invalid - OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_null - OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy_null - OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet_null - OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_null - -(* 87 ************************************ 560 + 1 *) -subsection \<open>Validity and Definedness Properties\<close> - -(* 88 ************************************ 561 + 16 *) (* term Floor1_iskindof.print_iskindof_defined *) -lemma OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_defined : -assumes isdef: "\<tau> \<Turnstile> (\<upsilon> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Person) .oclIsKindOf(Person)))" -by(simp only: OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person, rule OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_defined[OF isdef]) -lemma OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet_defined : -assumes isdef: "\<tau> \<Turnstile> (\<upsilon> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Planet) .oclIsKindOf(Person)))" -by(simp only: OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet, rule OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet_defined[OF isdef]) -lemma OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy_defined : -assumes isdef: "\<tau> \<Turnstile> (\<upsilon> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Galaxy) .oclIsKindOf(Person)))" -by(simp only: OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy, rule OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy_defined[OF isdef]) -lemma OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_defined : -assumes isdef: "\<tau> \<Turnstile> (\<upsilon> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>OclAny) .oclIsKindOf(Person)))" -by(simp only: OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny, rule OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_defined[OF isdef]) -lemma OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet_defined : -assumes isdef: "\<tau> \<Turnstile> (\<upsilon> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Planet) .oclIsKindOf(Planet)))" -by(simp only: OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet, rule defined_or_I[OF OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet_defined[OF isdef], OF OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet_defined[OF isdef]]) -lemma OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy_defined : -assumes isdef: "\<tau> \<Turnstile> (\<upsilon> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Galaxy) .oclIsKindOf(Planet)))" -by(simp only: OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy, rule defined_or_I[OF OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy_defined[OF isdef], OF OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy_defined[OF isdef]]) -lemma OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny_defined : -assumes isdef: "\<tau> \<Turnstile> (\<upsilon> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>OclAny) .oclIsKindOf(Planet)))" -by(simp only: OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny, rule defined_or_I[OF OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny_defined[OF isdef], OF OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_defined[OF isdef]]) -lemma OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person_defined : -assumes isdef: "\<tau> \<Turnstile> (\<upsilon> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Person) .oclIsKindOf(Planet)))" -by(simp only: OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person, rule defined_or_I[OF OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person_defined[OF isdef], OF OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_defined[OF isdef]]) -lemma OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy_defined : -assumes isdef: "\<tau> \<Turnstile> (\<upsilon> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Galaxy) .oclIsKindOf(Galaxy)))" -by(simp only: OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy, rule defined_or_I[OF OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy_defined[OF isdef], OF OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy_defined[OF isdef]]) -lemma OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny_defined : -assumes isdef: "\<tau> \<Turnstile> (\<upsilon> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>OclAny) .oclIsKindOf(Galaxy)))" -by(simp only: OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny, rule defined_or_I[OF OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny_defined[OF isdef], OF OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny_defined[OF isdef]]) -lemma OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person_defined : -assumes isdef: "\<tau> \<Turnstile> (\<upsilon> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Person) .oclIsKindOf(Galaxy)))" -by(simp only: OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person, rule defined_or_I[OF OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person_defined[OF isdef], OF OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person_defined[OF isdef]]) -lemma OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet_defined : -assumes isdef: "\<tau> \<Turnstile> (\<upsilon> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Planet) .oclIsKindOf(Galaxy)))" -by(simp only: OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet, rule defined_or_I[OF OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet_defined[OF isdef], OF OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet_defined[OF isdef]]) -lemma OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_defined : -assumes isdef: "\<tau> \<Turnstile> (\<upsilon> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>OclAny) .oclIsKindOf(OclAny)))" -by(simp only: OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny, rule defined_or_I[OF OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_defined[OF isdef], OF OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny_defined[OF isdef]]) -lemma OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_defined : -assumes isdef: "\<tau> \<Turnstile> (\<upsilon> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Person) .oclIsKindOf(OclAny)))" -by(simp only: OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person, rule defined_or_I[OF OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_defined[OF isdef], OF OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person_defined[OF isdef]]) -lemma OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet_defined : -assumes isdef: "\<tau> \<Turnstile> (\<upsilon> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Planet) .oclIsKindOf(OclAny)))" -by(simp only: OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet, rule defined_or_I[OF OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet_defined[OF isdef], OF OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet_defined[OF isdef]]) -lemma OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy_defined : -assumes isdef: "\<tau> \<Turnstile> (\<upsilon> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Galaxy) .oclIsKindOf(OclAny)))" -by(simp only: OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy, rule defined_or_I[OF OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy_defined[OF isdef], OF OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy_defined[OF isdef]]) - -(* 89 ************************************ 577 + 16 *) (* term Floor1_iskindof.print_iskindof_defined' *) -lemma OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_defined' : -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Person) .oclIsKindOf(Person)))" -by(rule OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_defined[OF isdef[THEN foundation20]]) -lemma OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet_defined' : -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Planet) .oclIsKindOf(Person)))" -by(rule OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet_defined[OF isdef[THEN foundation20]]) -lemma OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy_defined' : -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Galaxy) .oclIsKindOf(Person)))" -by(rule OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy_defined[OF isdef[THEN foundation20]]) -lemma OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_defined' : -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>OclAny) .oclIsKindOf(Person)))" -by(rule OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_defined[OF isdef[THEN foundation20]]) -lemma OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet_defined' : -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Planet) .oclIsKindOf(Planet)))" -by(rule OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet_defined[OF isdef[THEN foundation20]]) -lemma OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy_defined' : -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Galaxy) .oclIsKindOf(Planet)))" -by(rule OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy_defined[OF isdef[THEN foundation20]]) -lemma OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny_defined' : -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>OclAny) .oclIsKindOf(Planet)))" -by(rule OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny_defined[OF isdef[THEN foundation20]]) -lemma OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person_defined' : -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Person) .oclIsKindOf(Planet)))" -by(rule OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person_defined[OF isdef[THEN foundation20]]) -lemma OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy_defined' : -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Galaxy) .oclIsKindOf(Galaxy)))" -by(rule OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy_defined[OF isdef[THEN foundation20]]) -lemma OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny_defined' : -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>OclAny) .oclIsKindOf(Galaxy)))" -by(rule OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny_defined[OF isdef[THEN foundation20]]) -lemma OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person_defined' : -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Person) .oclIsKindOf(Galaxy)))" -by(rule OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person_defined[OF isdef[THEN foundation20]]) -lemma OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet_defined' : -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Planet) .oclIsKindOf(Galaxy)))" -by(rule OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet_defined[OF isdef[THEN foundation20]]) -lemma OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_defined' : -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>OclAny) .oclIsKindOf(OclAny)))" -by(rule OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_defined[OF isdef[THEN foundation20]]) -lemma OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_defined' : -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Person) .oclIsKindOf(OclAny)))" -by(rule OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_defined[OF isdef[THEN foundation20]]) -lemma OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet_defined' : -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Planet) .oclIsKindOf(OclAny)))" -by(rule OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet_defined[OF isdef[THEN foundation20]]) -lemma OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy_defined' : -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Galaxy) .oclIsKindOf(OclAny)))" -by(rule OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy_defined[OF isdef[THEN foundation20]]) - -(* 90 ************************************ 593 + 1 *) -subsection \<open>Up Down Casting\<close> - -(* 91 ************************************ 594 + 4 *) (* term Floor1_iskindof.print_iskindof_up_eq_asty *) -lemma actual_eq_static\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n : -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> ((X::\<cdot>Person) .oclIsKindOf(Person))" - apply(simp only: OclValid_def, insert isdef) - apply(simp only: OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person) - apply(auto simp: foundation16 bot_option_def split: option.split ty\<E>\<X>\<T>\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n.split ty\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n.split) -by((simp_all add: false_def true_def OclOr_def OclAnd_def OclNot_def)?) -lemma actual_eq_static\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t : -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> ((X::\<cdot>Planet) .oclIsKindOf(Planet))" - apply(simp only: OclValid_def, insert isdef) - apply(simp only: OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet, subst (1) cp_OclOr, simp only: OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet) - apply(auto simp: cp_OclOr[symmetric ] foundation16 bot_option_def OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet split: option.split ty\<E>\<X>\<T>\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t.split ty\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t.split ty\<E>\<X>\<T>\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n.split ty\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n.split) -by((simp_all add: false_def true_def OclOr_def OclAnd_def OclNot_def)?) -lemma actual_eq_static\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y : -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> ((X::\<cdot>Galaxy) .oclIsKindOf(Galaxy))" - apply(simp only: OclValid_def, insert isdef) - apply(simp only: OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy, subst (1) cp_OclOr, simp only: OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy, subst (2 1) cp_OclOr, simp only: OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy) - apply(auto simp: cp_OclOr[symmetric ] foundation16 bot_option_def OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy split: option.split ty\<E>\<X>\<T>\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y.split ty\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y.split ty\<E>\<X>\<T>\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n.split ty\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n.split ty\<E>\<X>\<T>\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t.split ty\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t.split) -by((simp_all add: false_def true_def OclOr_def OclAnd_def OclNot_def)?) -lemma actual_eq_static\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y : -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> ((X::\<cdot>OclAny) .oclIsKindOf(OclAny))" - apply(simp only: OclValid_def, insert isdef) - apply(simp only: OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny, subst (1) cp_OclOr, simp only: OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny, subst (2 1) cp_OclOr, simp only: OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny, subst (3 2 1) cp_OclOr, simp only: OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny) - apply(auto simp: cp_OclOr[symmetric ] foundation16 bot_option_def OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny split: option.split ty\<E>\<X>\<T>\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y.split ty\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y.split ty\<E>\<X>\<T>\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n.split ty\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n.split ty\<E>\<X>\<T>\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t.split ty\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t.split ty\<E>\<X>\<T>\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y.split ty\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y.split) -by((simp_all add: false_def true_def OclOr_def OclAnd_def OclNot_def)?) - -(* 92 ************************************ 598 + 6 *) (* term Floor1_iskindof.print_iskindof_up_larger *) -lemma actualKind\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_larger_staticKind\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t : -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> ((X::\<cdot>Person) .oclIsKindOf(Planet))" - apply(simp only: OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person) -by(rule foundation25', rule actual_eq_static\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n[OF isdef]) -lemma actualKind\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_larger_staticKind\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y : -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> ((X::\<cdot>Person) .oclIsKindOf(Galaxy))" - apply(simp only: OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person) -by(rule foundation25', rule actualKind\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_larger_staticKind\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t[OF isdef]) -lemma actualKind\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_larger_staticKind\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y : -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> ((X::\<cdot>Person) .oclIsKindOf(OclAny))" - apply(simp only: OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person) -by(rule foundation25', rule actualKind\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_larger_staticKind\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y[OF isdef]) -lemma actualKind\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_larger_staticKind\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y : -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> ((X::\<cdot>Planet) .oclIsKindOf(Galaxy))" - apply(simp only: OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet) -by(rule foundation25', rule actual_eq_static\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t[OF isdef]) -lemma actualKind\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_larger_staticKind\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y : -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> ((X::\<cdot>Planet) .oclIsKindOf(OclAny))" - apply(simp only: OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet) -by(rule foundation25', rule actualKind\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_larger_staticKind\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y[OF isdef]) -lemma actualKind\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_larger_staticKind\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y : -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> ((X::\<cdot>Galaxy) .oclIsKindOf(OclAny))" - apply(simp only: OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy) -by(rule foundation25', rule actual_eq_static\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y[OF isdef]) - -(* 93 ************************************ 604 + 6 *) (* term Floor1_iskindof.print_iskindof_up_istypeof_unfold *) -lemma not_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_then_Planet_OclIsTypeOf_others_unfold : -assumes isdef: "(\<tau> \<Turnstile> (\<delta> (X)))" -assumes iskin: "(\<tau> \<Turnstile> ((X::\<cdot>Planet) .oclIsKindOf(Person)))" -shows "(\<tau> \<Turnstile> ((X::\<cdot>Planet) .oclIsTypeOf(Person)))" - using iskin - apply(simp only: OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet) -done -lemma not_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_then_Galaxy_OclIsTypeOf_others_unfold : -assumes isdef: "(\<tau> \<Turnstile> (\<delta> (X)))" -assumes iskin: "(\<tau> \<Turnstile> ((X::\<cdot>Galaxy) .oclIsKindOf(Person)))" -shows "(\<tau> \<Turnstile> ((X::\<cdot>Galaxy) .oclIsTypeOf(Person)))" - using iskin - apply(simp only: OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy) -done -lemma not_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_then_OclAny_OclIsTypeOf_others_unfold : -assumes isdef: "(\<tau> \<Turnstile> (\<delta> (X)))" -assumes iskin: "(\<tau> \<Turnstile> ((X::\<cdot>OclAny) .oclIsKindOf(Person)))" -shows "(\<tau> \<Turnstile> ((X::\<cdot>OclAny) .oclIsTypeOf(Person)))" - using iskin - apply(simp only: OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny) -done -lemma not_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_then_Galaxy_OclIsTypeOf_others_unfold : -assumes isdef: "(\<tau> \<Turnstile> (\<delta> (X)))" -assumes iskin: "(\<tau> \<Turnstile> ((X::\<cdot>Galaxy) .oclIsKindOf(Planet)))" -shows "((\<tau> \<Turnstile> ((X::\<cdot>Galaxy) .oclIsTypeOf(Planet))) \<or> (\<tau> \<Turnstile> ((X::\<cdot>Galaxy) .oclIsTypeOf(Person))))" - using iskin - apply(simp only: OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy) - apply(erule foundation26[OF OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy_defined'[OF isdef], OF OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy_defined'[OF isdef]]) - apply(simp) - apply(drule not_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_then_Galaxy_OclIsTypeOf_others_unfold[OF isdef], blast) -done -lemma not_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_then_OclAny_OclIsTypeOf_others_unfold : -assumes isdef: "(\<tau> \<Turnstile> (\<delta> (X)))" -assumes iskin: "(\<tau> \<Turnstile> ((X::\<cdot>OclAny) .oclIsKindOf(Planet)))" -shows "((\<tau> \<Turnstile> ((X::\<cdot>OclAny) .oclIsTypeOf(Planet))) \<or> (\<tau> \<Turnstile> ((X::\<cdot>OclAny) .oclIsTypeOf(Person))))" - using iskin - apply(simp only: OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny) - apply(erule foundation26[OF OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny_defined'[OF isdef], OF OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_defined'[OF isdef]]) - apply(simp) - apply(drule not_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_then_OclAny_OclIsTypeOf_others_unfold[OF isdef], blast) -done -lemma not_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_then_OclAny_OclIsTypeOf_others_unfold : -assumes isdef: "(\<tau> \<Turnstile> (\<delta> (X)))" -assumes iskin: "(\<tau> \<Turnstile> ((X::\<cdot>OclAny) .oclIsKindOf(Galaxy)))" -shows "((\<tau> \<Turnstile> ((X::\<cdot>OclAny) .oclIsTypeOf(Galaxy))) \<or> ((\<tau> \<Turnstile> ((X::\<cdot>OclAny) .oclIsTypeOf(Person))) \<or> (\<tau> \<Turnstile> ((X::\<cdot>OclAny) .oclIsTypeOf(Planet)))))" - using iskin - apply(simp only: OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny) - apply(erule foundation26[OF OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny_defined'[OF isdef], OF OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny_defined'[OF isdef]]) - apply(simp) - apply(drule not_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_then_OclAny_OclIsTypeOf_others_unfold[OF isdef], blast) -done - -(* 94 ************************************ 610 + 6 *) (* term Floor1_iskindof.print_iskindof_up_istypeof *) -lemma not_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_then_Planet_OclIsTypeOf_others : -assumes iskin: "\<not> \<tau> \<Turnstile> ((X::\<cdot>Planet) .oclIsKindOf(Person))" -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> ((X::\<cdot>Planet) .oclIsTypeOf(Planet))" - using actual_eq_static\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t[OF isdef] - apply(simp only: OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet) - apply(erule foundation26[OF OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet_defined'[OF isdef], OF OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet_defined'[OF isdef]]) - apply(simp) - apply(simp add: iskin) -done -lemma not_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_then_Galaxy_OclIsTypeOf_others : -assumes iskin: "\<not> \<tau> \<Turnstile> ((X::\<cdot>Galaxy) .oclIsKindOf(Person))" -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "(\<tau> \<Turnstile> ((X::\<cdot>Galaxy) .oclIsTypeOf(Galaxy)) \<or> \<tau> \<Turnstile> ((X::\<cdot>Galaxy) .oclIsTypeOf(Planet)))" - using actual_eq_static\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y[OF isdef] - apply(simp only: OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy) - apply(erule foundation26[OF OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy_defined'[OF isdef], OF OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy_defined'[OF isdef]]) - apply(simp) - apply(simp only: OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy) - apply(erule foundation26[OF OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy_defined'[OF isdef], OF OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy_defined'[OF isdef]]) - apply(simp) - apply(simp add: iskin) -done -lemma not_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_then_OclAny_OclIsTypeOf_others : -assumes iskin: "\<not> \<tau> \<Turnstile> ((X::\<cdot>OclAny) .oclIsKindOf(Person))" -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "(\<tau> \<Turnstile> ((X::\<cdot>OclAny) .oclIsTypeOf(OclAny)) \<or> (\<tau> \<Turnstile> ((X::\<cdot>OclAny) .oclIsTypeOf(Galaxy)) \<or> \<tau> \<Turnstile> ((X::\<cdot>OclAny) .oclIsTypeOf(Planet))))" - using actual_eq_static\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y[OF isdef] - apply(simp only: OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny) - apply(erule foundation26[OF OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_defined'[OF isdef], OF OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny_defined'[OF isdef]]) - apply(simp) - apply(simp only: OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny) - apply(erule foundation26[OF OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny_defined'[OF isdef], OF OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny_defined'[OF isdef]]) - apply(simp) - apply(simp only: OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny) - apply(erule foundation26[OF OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny_defined'[OF isdef], OF OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_defined'[OF isdef]]) - apply(simp) - apply(simp add: iskin) -done -lemma not_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_then_Galaxy_OclIsTypeOf_others : -assumes iskin: "\<not> \<tau> \<Turnstile> ((X::\<cdot>Galaxy) .oclIsKindOf(Planet))" -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> ((X::\<cdot>Galaxy) .oclIsTypeOf(Galaxy))" - using actual_eq_static\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y[OF isdef] - apply(simp only: OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy) - apply(erule foundation26[OF OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy_defined'[OF isdef], OF OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy_defined'[OF isdef]]) - apply(simp) - apply(simp add: iskin) -done -lemma not_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_then_OclAny_OclIsTypeOf_others : -assumes iskin: "\<not> \<tau> \<Turnstile> ((X::\<cdot>OclAny) .oclIsKindOf(Planet))" -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "(\<tau> \<Turnstile> ((X::\<cdot>OclAny) .oclIsTypeOf(OclAny)) \<or> \<tau> \<Turnstile> ((X::\<cdot>OclAny) .oclIsTypeOf(Galaxy)))" - using actual_eq_static\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y[OF isdef] - apply(simp only: OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny) - apply(erule foundation26[OF OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_defined'[OF isdef], OF OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny_defined'[OF isdef]]) - apply(simp) - apply(simp only: OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny) - apply(erule foundation26[OF OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny_defined'[OF isdef], OF OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny_defined'[OF isdef]]) - apply(simp) - apply(simp add: iskin) -done -lemma not_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_then_OclAny_OclIsTypeOf_others : -assumes iskin: "\<not> \<tau> \<Turnstile> ((X::\<cdot>OclAny) .oclIsKindOf(Galaxy))" -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> ((X::\<cdot>OclAny) .oclIsTypeOf(OclAny))" - using actual_eq_static\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y[OF isdef] - apply(simp only: OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny) - apply(erule foundation26[OF OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_defined'[OF isdef], OF OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny_defined'[OF isdef]]) - apply(simp) - apply(simp add: iskin) -done - -(* 95 ************************************ 616 + 10 *) (* term Floor1_iskindof.print_iskindof_up_d_cast *) -lemma down_cast_kind\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_from_Planet_to_Person : -assumes iskin: "\<not> \<tau> \<Turnstile> ((X::\<cdot>Planet) .oclIsKindOf(Person))" -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> (X .oclAsType(Person)) \<triangleq> invalid" - apply(insert not_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_then_Planet_OclIsTypeOf_others[OF iskin, OF isdef]) - apply(rule down_cast_type\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_from_Planet_to_Person, simp only: , simp only: isdef) -done -lemma down_cast_kind\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_from_Galaxy_to_Person : -assumes iskin: "\<not> \<tau> \<Turnstile> ((X::\<cdot>Galaxy) .oclIsKindOf(Person))" -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> (X .oclAsType(Person)) \<triangleq> invalid" - apply(insert not_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_then_Galaxy_OclIsTypeOf_others[OF iskin, OF isdef], elim disjE) - apply(rule down_cast_type\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_from_Galaxy_to_Person, simp only: , simp only: isdef) - apply(rule down_cast_type\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_from_Galaxy_to_Person, simp only: , simp only: isdef) -done -lemma down_cast_kind\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_from_OclAny_to_Person : -assumes iskin: "\<not> \<tau> \<Turnstile> ((X::\<cdot>OclAny) .oclIsKindOf(Person))" -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> (X .oclAsType(Person)) \<triangleq> invalid" - apply(insert not_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_then_OclAny_OclIsTypeOf_others[OF iskin, OF isdef], elim disjE) - apply(rule down_cast_type\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_from_OclAny_to_Person, simp only: , simp only: isdef) - apply(rule down_cast_type\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_from_OclAny_to_Person, simp only: , simp only: isdef) - apply(rule down_cast_type\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_from_OclAny_to_Person, simp only: , simp only: isdef) -done -lemma down_cast_kind\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_from_Galaxy_to_Planet : -assumes iskin: "\<not> \<tau> \<Turnstile> ((X::\<cdot>Galaxy) .oclIsKindOf(Planet))" -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> (X .oclAsType(Planet)) \<triangleq> invalid" - apply(insert not_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_then_Galaxy_OclIsTypeOf_others[OF iskin, OF isdef]) - apply(rule down_cast_type\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_from_Galaxy_to_Planet, simp only: , simp only: isdef) -done -lemma down_cast_kind\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_from_Galaxy_to_Person : -assumes iskin: "\<not> \<tau> \<Turnstile> ((X::\<cdot>Galaxy) .oclIsKindOf(Planet))" -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> (X .oclAsType(Person)) \<triangleq> invalid" - apply(insert not_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_then_Galaxy_OclIsTypeOf_others[OF iskin, OF isdef]) - apply(rule down_cast_type\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_from_Galaxy_to_Person, simp only: , simp only: isdef) -done -lemma down_cast_kind\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_from_OclAny_to_Planet : -assumes iskin: "\<not> \<tau> \<Turnstile> ((X::\<cdot>OclAny) .oclIsKindOf(Planet))" -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> (X .oclAsType(Planet)) \<triangleq> invalid" - apply(insert not_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_then_OclAny_OclIsTypeOf_others[OF iskin, OF isdef], elim disjE) - apply(rule down_cast_type\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_from_OclAny_to_Planet, simp only: , simp only: isdef) - apply(rule down_cast_type\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_from_OclAny_to_Planet, simp only: , simp only: isdef) -done -lemma down_cast_kind\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_from_OclAny_to_Person : -assumes iskin: "\<not> \<tau> \<Turnstile> ((X::\<cdot>OclAny) .oclIsKindOf(Planet))" -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> (X .oclAsType(Person)) \<triangleq> invalid" - apply(insert not_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_then_OclAny_OclIsTypeOf_others[OF iskin, OF isdef], elim disjE) - apply(rule down_cast_type\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_from_OclAny_to_Person, simp only: , simp only: isdef) - apply(rule down_cast_type\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_from_OclAny_to_Person, simp only: , simp only: isdef) -done -lemma down_cast_kind\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_from_OclAny_to_Galaxy : -assumes iskin: "\<not> \<tau> \<Turnstile> ((X::\<cdot>OclAny) .oclIsKindOf(Galaxy))" -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> (X .oclAsType(Galaxy)) \<triangleq> invalid" - apply(insert not_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_then_OclAny_OclIsTypeOf_others[OF iskin, OF isdef]) - apply(rule down_cast_type\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_from_OclAny_to_Galaxy, simp only: , simp only: isdef) -done -lemma down_cast_kind\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_from_OclAny_to_Person : -assumes iskin: "\<not> \<tau> \<Turnstile> ((X::\<cdot>OclAny) .oclIsKindOf(Galaxy))" -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> (X .oclAsType(Person)) \<triangleq> invalid" - apply(insert not_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_then_OclAny_OclIsTypeOf_others[OF iskin, OF isdef]) - apply(rule down_cast_type\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_from_OclAny_to_Person, simp only: , simp only: isdef) -done -lemma down_cast_kind\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_from_OclAny_to_Planet : -assumes iskin: "\<not> \<tau> \<Turnstile> ((X::\<cdot>OclAny) .oclIsKindOf(Galaxy))" -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> (X .oclAsType(Planet)) \<triangleq> invalid" - apply(insert not_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_then_OclAny_OclIsTypeOf_others[OF iskin, OF isdef]) - apply(rule down_cast_type\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_from_OclAny_to_Planet, simp only: , simp only: isdef) -done - -(* 96 ************************************ 626 + 1 *) -subsection \<open>Const\<close> - -(* 97 ************************************ 627 + 1 *) -section \<open>Class Model: OclAllInstances\<close> - -(* 98 ************************************ 628 + 1 *) -text \<open> - To denote \OCL-types occurring in \OCL expressions syntactically---as, for example, as -``argument'' of \inlineisar{oclAllInstances()}---we use the inverses of the injection -functions into the object universes; we show that this is sufficient ``characterization.'' \<close> - -(* 99 ************************************ 629 + 4 *) (* term Floor1_allinst.print_allinst_def_id *) -definition "Person = OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_\<AA>" -definition "Planet = OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_\<AA>" -definition "Galaxy = OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_\<AA>" -definition "OclAny = OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_\<AA>" - -(* 100 ************************************ 633 + 1 *) (* term Floor1_allinst.print_allinst_lemmas_id *) -lemmas[simp,code_unfold] = Person_def - Planet_def - Galaxy_def - OclAny_def - -(* 101 ************************************ 634 + 1 *) (* term Floor1_allinst.print_allinst_astype *) -lemma OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_\<AA>_some : "(OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_\<AA> (x)) \<noteq> None" -by(simp add: OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_\<AA>_def) - -(* 102 ************************************ 635 + 3 *) (* term Floor1_allinst.print_allinst_exec *) -lemma OclAllInstances_generic\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_exec : -shows "(OclAllInstances_generic (pre_post) (OclAny)) = (\<lambda>\<tau>. (Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (\<lfloor>\<lfloor>Some ` OclAny ` (ran ((heap ((pre_post (\<tau>))))))\<rfloor>\<rfloor>)))" - proof - let ?S1 = "(\<lambda>\<tau>. OclAny ` (ran ((heap ((pre_post (\<tau>)))))))" show ?thesis - proof - let ?S2 = "(\<lambda>\<tau>. ((?S1) (\<tau>)) - {None})" show ?thesis - proof - have B: "(\<And>\<tau>. ((?S2) (\<tau>)) \<subseteq> ((?S1) (\<tau>)))" by(auto) show ?thesis - proof - have C: "(\<And>\<tau>. ((?S1) (\<tau>)) \<subseteq> ((?S2) (\<tau>)))" by(auto simp: OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_\<AA>_some) show ?thesis - apply(simp add: OclValid_def del: OclAllInstances_generic_def OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny) -by(insert equalityI[OF B, OF C], simp) qed qed qed qed -lemma OclAllInstances_at_post\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_exec : -shows "(OclAllInstances_at_post (OclAny)) = (\<lambda>\<tau>. (Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (\<lfloor>\<lfloor>Some ` OclAny ` (ran ((heap ((snd (\<tau>))))))\<rfloor>\<rfloor>)))" - unfolding OclAllInstances_at_post_def -by(rule OclAllInstances_generic\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_exec) -lemma OclAllInstances_at_pre\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_exec : -shows "(OclAllInstances_at_pre (OclAny)) = (\<lambda>\<tau>. (Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (\<lfloor>\<lfloor>Some ` OclAny ` (ran ((heap ((fst (\<tau>))))))\<rfloor>\<rfloor>)))" - unfolding OclAllInstances_at_pre_def -by(rule OclAllInstances_generic\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_exec) - -(* 103 ************************************ 638 + 1 *) -subsection \<open>OclIsTypeOf\<close> - -(* 104 ************************************ 639 + 2 *) (* term Floor1_allinst.print_allinst_istypeof_pre *) -lemma ex_ssubst : "(\<forall>x \<in> B. (s (x)) = (t (x))) \<Longrightarrow> (\<exists>x \<in> B. (P ((s (x))))) = (\<exists>x \<in> B. (P ((t (x)))))" -by(simp) -lemma ex_def : "x \<in> \<lceil>\<lceil>\<lfloor>\<lfloor>Some ` (X - {None})\<rfloor>\<rfloor>\<rceil>\<rceil> \<Longrightarrow> (\<exists>y. x = \<lfloor>\<lfloor>y\<rfloor>\<rfloor>)" -by(auto) - -(* 105 ************************************ 641 + 21 *) (* term Floor1_allinst.print_allinst_istypeof *) -lemma Person_OclAllInstances_generic_OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n : "\<tau> \<Turnstile> (UML_Set.OclForall ((OclAllInstances_generic (pre_post) (Person))) (OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))" - apply(simp add: OclValid_def del: OclAllInstances_generic_def) - apply(simp only: UML_Set.OclForall_def refl if_True OclAllInstances_generic_defined[simplified OclValid_def]) - apply(simp only: OclAllInstances_generic_def) - apply(subst (1 2 3) Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inverse, simp add: bot_option_def) - apply(subst (1 2 3) ex_ssubst[where s = "(\<lambda>x. (((\<lambda>_. x) .oclIsTypeOf(Person)) (\<tau>)))" and t = "(\<lambda>_. (true (\<tau>)))"]) - apply(intro ballI actual_eq_static\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n[simplified OclValid_def, simplified OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person]) - apply(drule ex_def, erule exE, simp) -by(simp) -lemma Person_OclAllInstances_at_post_OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n : -shows "\<tau> \<Turnstile> (UML_Set.OclForall ((OclAllInstances_at_post (Person))) (OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))" - unfolding OclAllInstances_at_post_def -by(rule Person_OclAllInstances_generic_OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n) -lemma Person_OclAllInstances_at_pre_OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n : -shows "\<tau> \<Turnstile> (UML_Set.OclForall ((OclAllInstances_at_pre (Person))) (OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))" - unfolding OclAllInstances_at_pre_def -by(rule Person_OclAllInstances_generic_OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n) -lemma Planet_OclAllInstances_generic_OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t1 : -assumes [simp]: "(\<And>x. (pre_post ((x , x))) = x)" -shows "(\<exists>\<tau>. \<tau> \<Turnstile> (UML_Set.OclForall ((OclAllInstances_generic (pre_post) (Planet))) (OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t)))" - apply(rule exI[where x = "\<tau>\<^sub>0"], simp add: \<tau>\<^sub>0_def OclValid_def del: OclAllInstances_generic_def) - apply(simp only: UML_Set.OclForall_def refl if_True OclAllInstances_generic_defined[simplified OclValid_def]) - apply(simp only: OclAllInstances_generic_def) - apply(subst (1 2 3) Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inverse, simp add: bot_option_def) -by(simp) -lemma Planet_OclAllInstances_at_post_OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t1 : -shows "(\<exists>\<tau>. \<tau> \<Turnstile> (UML_Set.OclForall ((OclAllInstances_at_post (Planet))) (OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t)))" - unfolding OclAllInstances_at_post_def -by(rule Planet_OclAllInstances_generic_OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t1, simp) -lemma Planet_OclAllInstances_at_pre_OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t1 : -shows "(\<exists>\<tau>. \<tau> \<Turnstile> (UML_Set.OclForall ((OclAllInstances_at_pre (Planet))) (OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t)))" - unfolding OclAllInstances_at_pre_def -by(rule Planet_OclAllInstances_generic_OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t1, simp) -lemma Planet_OclAllInstances_generic_OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t2 : -assumes [simp]: "(\<And>x. (pre_post ((x , x))) = x)" -shows "(\<exists>\<tau>. \<tau> \<Turnstile> (not ((UML_Set.OclForall ((OclAllInstances_generic (pre_post) (Planet))) (OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t)))))" - proof - fix oid a show ?thesis - proof - let ?t0 = "(state.make ((Map.empty (oid \<mapsto> (in\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t ((mk\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t ((mk\<E>\<X>\<T>\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (a))) (None) (None))))))) (Map.empty))" show ?thesis - apply(rule exI[where x = "(?t0 , ?t0)"], simp add: OclValid_def del: OclAllInstances_generic_def) - apply(simp only: UML_Set.OclForall_def refl if_True OclAllInstances_generic_defined[simplified OclValid_def]) - apply(simp only: OclAllInstances_generic_def OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_\<AA>_def) - apply(subst (1 2 3) Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inverse, simp add: bot_option_def) -by(simp add: state.make_def OclNot_def) qed qed -lemma Planet_OclAllInstances_at_post_OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t2 : -shows "(\<exists>\<tau>. \<tau> \<Turnstile> (not ((UML_Set.OclForall ((OclAllInstances_at_post (Planet))) (OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t)))))" - unfolding OclAllInstances_at_post_def -by(rule Planet_OclAllInstances_generic_OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t2, simp) -lemma Planet_OclAllInstances_at_pre_OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t2 : -shows "(\<exists>\<tau>. \<tau> \<Turnstile> (not ((UML_Set.OclForall ((OclAllInstances_at_pre (Planet))) (OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t)))))" - unfolding OclAllInstances_at_pre_def -by(rule Planet_OclAllInstances_generic_OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t2, simp) -lemma Galaxy_OclAllInstances_generic_OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y1 : -assumes [simp]: "(\<And>x. (pre_post ((x , x))) = x)" -shows "(\<exists>\<tau>. \<tau> \<Turnstile> (UML_Set.OclForall ((OclAllInstances_generic (pre_post) (Galaxy))) (OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y)))" - apply(rule exI[where x = "\<tau>\<^sub>0"], simp add: \<tau>\<^sub>0_def OclValid_def del: OclAllInstances_generic_def) - apply(simp only: UML_Set.OclForall_def refl if_True OclAllInstances_generic_defined[simplified OclValid_def]) - apply(simp only: OclAllInstances_generic_def) - apply(subst (1 2 3) Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inverse, simp add: bot_option_def) -by(simp) -lemma Galaxy_OclAllInstances_at_post_OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y1 : -shows "(\<exists>\<tau>. \<tau> \<Turnstile> (UML_Set.OclForall ((OclAllInstances_at_post (Galaxy))) (OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y)))" - unfolding OclAllInstances_at_post_def -by(rule Galaxy_OclAllInstances_generic_OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y1, simp) -lemma Galaxy_OclAllInstances_at_pre_OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y1 : -shows "(\<exists>\<tau>. \<tau> \<Turnstile> (UML_Set.OclForall ((OclAllInstances_at_pre (Galaxy))) (OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y)))" - unfolding OclAllInstances_at_pre_def -by(rule Galaxy_OclAllInstances_generic_OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y1, simp) -lemma Galaxy_OclAllInstances_generic_OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y2 : -assumes [simp]: "(\<And>x. (pre_post ((x , x))) = x)" -shows "(\<exists>\<tau>. \<tau> \<Turnstile> (not ((UML_Set.OclForall ((OclAllInstances_generic (pre_post) (Galaxy))) (OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y)))))" - proof - fix oid a show ?thesis - proof - let ?t0 = "(state.make ((Map.empty (oid \<mapsto> (in\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y ((mk\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y ((mk\<E>\<X>\<T>\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (a))) (None) (None) (None))))))) (Map.empty))" show ?thesis - apply(rule exI[where x = "(?t0 , ?t0)"], simp add: OclValid_def del: OclAllInstances_generic_def) - apply(simp only: UML_Set.OclForall_def refl if_True OclAllInstances_generic_defined[simplified OclValid_def]) - apply(simp only: OclAllInstances_generic_def OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_\<AA>_def) - apply(subst (1 2 3) Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inverse, simp add: bot_option_def) -by(simp add: state.make_def OclNot_def) qed qed -lemma Galaxy_OclAllInstances_at_post_OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y2 : -shows "(\<exists>\<tau>. \<tau> \<Turnstile> (not ((UML_Set.OclForall ((OclAllInstances_at_post (Galaxy))) (OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y)))))" - unfolding OclAllInstances_at_post_def -by(rule Galaxy_OclAllInstances_generic_OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y2, simp) -lemma Galaxy_OclAllInstances_at_pre_OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y2 : -shows "(\<exists>\<tau>. \<tau> \<Turnstile> (not ((UML_Set.OclForall ((OclAllInstances_at_pre (Galaxy))) (OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y)))))" - unfolding OclAllInstances_at_pre_def -by(rule Galaxy_OclAllInstances_generic_OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y2, simp) -lemma OclAny_OclAllInstances_generic_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y1 : -assumes [simp]: "(\<And>x. (pre_post ((x , x))) = x)" -shows "(\<exists>\<tau>. \<tau> \<Turnstile> (UML_Set.OclForall ((OclAllInstances_generic (pre_post) (OclAny))) (OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y)))" - apply(rule exI[where x = "\<tau>\<^sub>0"], simp add: \<tau>\<^sub>0_def OclValid_def del: OclAllInstances_generic_def) - apply(simp only: UML_Set.OclForall_def refl if_True OclAllInstances_generic_defined[simplified OclValid_def]) - apply(simp only: OclAllInstances_generic_def) - apply(subst (1 2 3) Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inverse, simp add: bot_option_def) -by(simp) -lemma OclAny_OclAllInstances_at_post_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y1 : -shows "(\<exists>\<tau>. \<tau> \<Turnstile> (UML_Set.OclForall ((OclAllInstances_at_post (OclAny))) (OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y)))" - unfolding OclAllInstances_at_post_def -by(rule OclAny_OclAllInstances_generic_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y1, simp) -lemma OclAny_OclAllInstances_at_pre_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y1 : -shows "(\<exists>\<tau>. \<tau> \<Turnstile> (UML_Set.OclForall ((OclAllInstances_at_pre (OclAny))) (OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y)))" - unfolding OclAllInstances_at_pre_def -by(rule OclAny_OclAllInstances_generic_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y1, simp) -lemma OclAny_OclAllInstances_generic_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y2 : -assumes [simp]: "(\<And>x. (pre_post ((x , x))) = x)" -shows "(\<exists>\<tau>. \<tau> \<Turnstile> (not ((UML_Set.OclForall ((OclAllInstances_generic (pre_post) (OclAny))) (OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y)))))" - proof - fix oid a show ?thesis - proof - let ?t0 = "(state.make ((Map.empty (oid \<mapsto> (in\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y ((mk\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y ((mk\<E>\<X>\<T>\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y (a))))))))) (Map.empty))" show ?thesis - apply(rule exI[where x = "(?t0 , ?t0)"], simp add: OclValid_def del: OclAllInstances_generic_def) - apply(simp only: UML_Set.OclForall_def refl if_True OclAllInstances_generic_defined[simplified OclValid_def]) - apply(simp only: OclAllInstances_generic_def OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_\<AA>_def) - apply(subst (1 2 3) Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inverse, simp add: bot_option_def) -by(simp add: state.make_def OclNot_def) qed qed -lemma OclAny_OclAllInstances_at_post_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y2 : -shows "(\<exists>\<tau>. \<tau> \<Turnstile> (not ((UML_Set.OclForall ((OclAllInstances_at_post (OclAny))) (OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y)))))" - unfolding OclAllInstances_at_post_def -by(rule OclAny_OclAllInstances_generic_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y2, simp) -lemma OclAny_OclAllInstances_at_pre_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y2 : -shows "(\<exists>\<tau>. \<tau> \<Turnstile> (not ((UML_Set.OclForall ((OclAllInstances_at_pre (OclAny))) (OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y)))))" - unfolding OclAllInstances_at_pre_def -by(rule OclAny_OclAllInstances_generic_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y2, simp) - -(* 106 ************************************ 662 + 1 *) -subsection \<open>OclIsKindOf\<close> - -(* 107 ************************************ 663 + 12 *) (* term Floor1_allinst.print_allinst_iskindof_eq *) -lemma Person_OclAllInstances_generic_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n : "\<tau> \<Turnstile> (UML_Set.OclForall ((OclAllInstances_generic (pre_post) (Person))) (OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))" - apply(simp add: OclValid_def del: OclAllInstances_generic_def OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person) - apply(simp only: UML_Set.OclForall_def refl if_True OclAllInstances_generic_defined[simplified OclValid_def]) - apply(simp only: OclAllInstances_generic_def) - apply(subst (1 2 3) Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inverse, simp add: bot_option_def) - apply(subst (1 2 3) ex_ssubst[where s = "(\<lambda>x. (((\<lambda>_. x) .oclIsKindOf(Person)) (\<tau>)))" and t = "(\<lambda>_. (true (\<tau>)))"]) - apply(intro ballI actual_eq_static\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n[simplified OclValid_def]) - apply(drule ex_def, erule exE, simp) -by(simp) -lemma Person_OclAllInstances_at_post_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n : -shows "\<tau> \<Turnstile> (UML_Set.OclForall ((OclAllInstances_at_post (Person))) (OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))" - unfolding OclAllInstances_at_post_def -by(rule Person_OclAllInstances_generic_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n) -lemma Person_OclAllInstances_at_pre_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n : -shows "\<tau> \<Turnstile> (UML_Set.OclForall ((OclAllInstances_at_pre (Person))) (OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))" - unfolding OclAllInstances_at_pre_def -by(rule Person_OclAllInstances_generic_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n) -lemma Planet_OclAllInstances_generic_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t : "\<tau> \<Turnstile> (UML_Set.OclForall ((OclAllInstances_generic (pre_post) (Planet))) (OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t))" - apply(simp add: OclValid_def del: OclAllInstances_generic_def OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet) - apply(simp only: UML_Set.OclForall_def refl if_True OclAllInstances_generic_defined[simplified OclValid_def]) - apply(simp only: OclAllInstances_generic_def) - apply(subst (1 2 3) Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inverse, simp add: bot_option_def) - apply(subst (1 2 3) ex_ssubst[where s = "(\<lambda>x. (((\<lambda>_. x) .oclIsKindOf(Planet)) (\<tau>)))" and t = "(\<lambda>_. (true (\<tau>)))"]) - apply(intro ballI actual_eq_static\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t[simplified OclValid_def]) - apply(drule ex_def, erule exE, simp) -by(simp) -lemma Planet_OclAllInstances_at_post_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t : -shows "\<tau> \<Turnstile> (UML_Set.OclForall ((OclAllInstances_at_post (Planet))) (OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t))" - unfolding OclAllInstances_at_post_def -by(rule Planet_OclAllInstances_generic_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t) -lemma Planet_OclAllInstances_at_pre_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t : -shows "\<tau> \<Turnstile> (UML_Set.OclForall ((OclAllInstances_at_pre (Planet))) (OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t))" - unfolding OclAllInstances_at_pre_def -by(rule Planet_OclAllInstances_generic_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t) -lemma Galaxy_OclAllInstances_generic_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y : "\<tau> \<Turnstile> (UML_Set.OclForall ((OclAllInstances_generic (pre_post) (Galaxy))) (OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y))" - apply(simp add: OclValid_def del: OclAllInstances_generic_def OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy) - apply(simp only: UML_Set.OclForall_def refl if_True OclAllInstances_generic_defined[simplified OclValid_def]) - apply(simp only: OclAllInstances_generic_def) - apply(subst (1 2 3) Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inverse, simp add: bot_option_def) - apply(subst (1 2 3) ex_ssubst[where s = "(\<lambda>x. (((\<lambda>_. x) .oclIsKindOf(Galaxy)) (\<tau>)))" and t = "(\<lambda>_. (true (\<tau>)))"]) - apply(intro ballI actual_eq_static\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y[simplified OclValid_def]) - apply(drule ex_def, erule exE, simp) -by(simp) -lemma Galaxy_OclAllInstances_at_post_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y : -shows "\<tau> \<Turnstile> (UML_Set.OclForall ((OclAllInstances_at_post (Galaxy))) (OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y))" - unfolding OclAllInstances_at_post_def -by(rule Galaxy_OclAllInstances_generic_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y) -lemma Galaxy_OclAllInstances_at_pre_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y : -shows "\<tau> \<Turnstile> (UML_Set.OclForall ((OclAllInstances_at_pre (Galaxy))) (OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y))" - unfolding OclAllInstances_at_pre_def -by(rule Galaxy_OclAllInstances_generic_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y) -lemma OclAny_OclAllInstances_generic_OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y : "\<tau> \<Turnstile> (UML_Set.OclForall ((OclAllInstances_generic (pre_post) (OclAny))) (OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y))" - apply(simp add: OclValid_def del: OclAllInstances_generic_def OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny) - apply(simp only: UML_Set.OclForall_def refl if_True OclAllInstances_generic_defined[simplified OclValid_def]) - apply(simp only: OclAllInstances_generic_def) - apply(subst (1 2 3) Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inverse, simp add: bot_option_def) - apply(subst (1 2 3) ex_ssubst[where s = "(\<lambda>x. (((\<lambda>_. x) .oclIsKindOf(OclAny)) (\<tau>)))" and t = "(\<lambda>_. (true (\<tau>)))"]) - apply(intro ballI actual_eq_static\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y[simplified OclValid_def]) - apply(drule ex_def, erule exE, simp) -by(simp) -lemma OclAny_OclAllInstances_at_post_OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y : -shows "\<tau> \<Turnstile> (UML_Set.OclForall ((OclAllInstances_at_post (OclAny))) (OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y))" - unfolding OclAllInstances_at_post_def -by(rule OclAny_OclAllInstances_generic_OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y) -lemma OclAny_OclAllInstances_at_pre_OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y : -shows "\<tau> \<Turnstile> (UML_Set.OclForall ((OclAllInstances_at_pre (OclAny))) (OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y))" - unfolding OclAllInstances_at_pre_def -by(rule OclAny_OclAllInstances_generic_OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y) - -(* 108 ************************************ 675 + 18 *) (* term Floor1_allinst.print_allinst_iskindof_larger *) -lemma Person_OclAllInstances_generic_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t : "\<tau> \<Turnstile> (UML_Set.OclForall ((OclAllInstances_generic (pre_post) (Person))) (OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t))" - apply(simp add: OclValid_def del: OclAllInstances_generic_def OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person) - apply(simp only: UML_Set.OclForall_def refl if_True OclAllInstances_generic_defined[simplified OclValid_def]) - apply(simp only: OclAllInstances_generic_def) - apply(subst (1 2 3) Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inverse, simp add: bot_option_def) - apply(subst (1 2 3) ex_ssubst[where s = "(\<lambda>x. (((\<lambda>_. x) .oclIsKindOf(Planet)) (\<tau>)))" and t = "(\<lambda>_. (true (\<tau>)))"]) - apply(intro ballI actualKind\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_larger_staticKind\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t[simplified OclValid_def]) - apply(drule ex_def, erule exE, simp) -by(simp) -lemma Person_OclAllInstances_at_post_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t : -shows "\<tau> \<Turnstile> (UML_Set.OclForall ((OclAllInstances_at_post (Person))) (OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t))" - unfolding OclAllInstances_at_post_def -by(rule Person_OclAllInstances_generic_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t) -lemma Person_OclAllInstances_at_pre_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t : -shows "\<tau> \<Turnstile> (UML_Set.OclForall ((OclAllInstances_at_pre (Person))) (OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t))" - unfolding OclAllInstances_at_pre_def -by(rule Person_OclAllInstances_generic_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t) -lemma Person_OclAllInstances_generic_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y : "\<tau> \<Turnstile> (UML_Set.OclForall ((OclAllInstances_generic (pre_post) (Person))) (OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y))" - apply(simp add: OclValid_def del: OclAllInstances_generic_def OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person) - apply(simp only: UML_Set.OclForall_def refl if_True OclAllInstances_generic_defined[simplified OclValid_def]) - apply(simp only: OclAllInstances_generic_def) - apply(subst (1 2 3) Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inverse, simp add: bot_option_def) - apply(subst (1 2 3) ex_ssubst[where s = "(\<lambda>x. (((\<lambda>_. x) .oclIsKindOf(Galaxy)) (\<tau>)))" and t = "(\<lambda>_. (true (\<tau>)))"]) - apply(intro ballI actualKind\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_larger_staticKind\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y[simplified OclValid_def]) - apply(drule ex_def, erule exE, simp) -by(simp) -lemma Person_OclAllInstances_at_post_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y : -shows "\<tau> \<Turnstile> (UML_Set.OclForall ((OclAllInstances_at_post (Person))) (OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y))" - unfolding OclAllInstances_at_post_def -by(rule Person_OclAllInstances_generic_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y) -lemma Person_OclAllInstances_at_pre_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y : -shows "\<tau> \<Turnstile> (UML_Set.OclForall ((OclAllInstances_at_pre (Person))) (OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y))" - unfolding OclAllInstances_at_pre_def -by(rule Person_OclAllInstances_generic_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y) -lemma Person_OclAllInstances_generic_OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y : "\<tau> \<Turnstile> (UML_Set.OclForall ((OclAllInstances_generic (pre_post) (Person))) (OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y))" - apply(simp add: OclValid_def del: OclAllInstances_generic_def OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person) - apply(simp only: UML_Set.OclForall_def refl if_True OclAllInstances_generic_defined[simplified OclValid_def]) - apply(simp only: OclAllInstances_generic_def) - apply(subst (1 2 3) Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inverse, simp add: bot_option_def) - apply(subst (1 2 3) ex_ssubst[where s = "(\<lambda>x. (((\<lambda>_. x) .oclIsKindOf(OclAny)) (\<tau>)))" and t = "(\<lambda>_. (true (\<tau>)))"]) - apply(intro ballI actualKind\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_larger_staticKind\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y[simplified OclValid_def]) - apply(drule ex_def, erule exE, simp) -by(simp) -lemma Person_OclAllInstances_at_post_OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y : -shows "\<tau> \<Turnstile> (UML_Set.OclForall ((OclAllInstances_at_post (Person))) (OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y))" - unfolding OclAllInstances_at_post_def -by(rule Person_OclAllInstances_generic_OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y) -lemma Person_OclAllInstances_at_pre_OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y : -shows "\<tau> \<Turnstile> (UML_Set.OclForall ((OclAllInstances_at_pre (Person))) (OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y))" - unfolding OclAllInstances_at_pre_def -by(rule Person_OclAllInstances_generic_OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y) -lemma Planet_OclAllInstances_generic_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y : "\<tau> \<Turnstile> (UML_Set.OclForall ((OclAllInstances_generic (pre_post) (Planet))) (OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y))" - apply(simp add: OclValid_def del: OclAllInstances_generic_def OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet) - apply(simp only: UML_Set.OclForall_def refl if_True OclAllInstances_generic_defined[simplified OclValid_def]) - apply(simp only: OclAllInstances_generic_def) - apply(subst (1 2 3) Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inverse, simp add: bot_option_def) - apply(subst (1 2 3) ex_ssubst[where s = "(\<lambda>x. (((\<lambda>_. x) .oclIsKindOf(Galaxy)) (\<tau>)))" and t = "(\<lambda>_. (true (\<tau>)))"]) - apply(intro ballI actualKind\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_larger_staticKind\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y[simplified OclValid_def]) - apply(drule ex_def, erule exE, simp) -by(simp) -lemma Planet_OclAllInstances_at_post_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y : -shows "\<tau> \<Turnstile> (UML_Set.OclForall ((OclAllInstances_at_post (Planet))) (OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y))" - unfolding OclAllInstances_at_post_def -by(rule Planet_OclAllInstances_generic_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y) -lemma Planet_OclAllInstances_at_pre_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y : -shows "\<tau> \<Turnstile> (UML_Set.OclForall ((OclAllInstances_at_pre (Planet))) (OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y))" - unfolding OclAllInstances_at_pre_def -by(rule Planet_OclAllInstances_generic_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y) -lemma Planet_OclAllInstances_generic_OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y : "\<tau> \<Turnstile> (UML_Set.OclForall ((OclAllInstances_generic (pre_post) (Planet))) (OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y))" - apply(simp add: OclValid_def del: OclAllInstances_generic_def OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet) - apply(simp only: UML_Set.OclForall_def refl if_True OclAllInstances_generic_defined[simplified OclValid_def]) - apply(simp only: OclAllInstances_generic_def) - apply(subst (1 2 3) Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inverse, simp add: bot_option_def) - apply(subst (1 2 3) ex_ssubst[where s = "(\<lambda>x. (((\<lambda>_. x) .oclIsKindOf(OclAny)) (\<tau>)))" and t = "(\<lambda>_. (true (\<tau>)))"]) - apply(intro ballI actualKind\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_larger_staticKind\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y[simplified OclValid_def]) - apply(drule ex_def, erule exE, simp) -by(simp) -lemma Planet_OclAllInstances_at_post_OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y : -shows "\<tau> \<Turnstile> (UML_Set.OclForall ((OclAllInstances_at_post (Planet))) (OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y))" - unfolding OclAllInstances_at_post_def -by(rule Planet_OclAllInstances_generic_OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y) -lemma Planet_OclAllInstances_at_pre_OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y : -shows "\<tau> \<Turnstile> (UML_Set.OclForall ((OclAllInstances_at_pre (Planet))) (OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y))" - unfolding OclAllInstances_at_pre_def -by(rule Planet_OclAllInstances_generic_OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y) -lemma Galaxy_OclAllInstances_generic_OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y : "\<tau> \<Turnstile> (UML_Set.OclForall ((OclAllInstances_generic (pre_post) (Galaxy))) (OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y))" - apply(simp add: OclValid_def del: OclAllInstances_generic_def OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy) - apply(simp only: UML_Set.OclForall_def refl if_True OclAllInstances_generic_defined[simplified OclValid_def]) - apply(simp only: OclAllInstances_generic_def) - apply(subst (1 2 3) Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inverse, simp add: bot_option_def) - apply(subst (1 2 3) ex_ssubst[where s = "(\<lambda>x. (((\<lambda>_. x) .oclIsKindOf(OclAny)) (\<tau>)))" and t = "(\<lambda>_. (true (\<tau>)))"]) - apply(intro ballI actualKind\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_larger_staticKind\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y[simplified OclValid_def]) - apply(drule ex_def, erule exE, simp) -by(simp) -lemma Galaxy_OclAllInstances_at_post_OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y : -shows "\<tau> \<Turnstile> (UML_Set.OclForall ((OclAllInstances_at_post (Galaxy))) (OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y))" - unfolding OclAllInstances_at_post_def -by(rule Galaxy_OclAllInstances_generic_OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y) -lemma Galaxy_OclAllInstances_at_pre_OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y : -shows "\<tau> \<Turnstile> (UML_Set.OclForall ((OclAllInstances_at_pre (Galaxy))) (OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y))" - unfolding OclAllInstances_at_pre_def -by(rule Galaxy_OclAllInstances_generic_OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y) - -(* 109 ************************************ 693 + 1 *) -section \<open>Class Model: The Accessors\<close> - -(* 110 ************************************ 694 + 1 *) -text \<open>\<close> - -(* 111 ************************************ 695 + 1 *) -text \<open> - \label{sec:Employee-AnalysisModel-UMLPart-generated-generatedeam-accessors}\<close> - -(* 112 ************************************ 696 + 1 *) -subsection \<open>Definition\<close> - -(* 113 ************************************ 697 + 1 *) -text \<open> - We start with a oid for the association; this oid can be used -in presence of association classes to represent the association inside an object, -pretty much similar to the \inlineisar+Employee_DesignModel_UMLPart+, where we stored -an \verb+oid+ inside the class as ``pointer.'' \<close> - -(* 114 ************************************ 698 + 1 *) (* term Floor1_access.print_access_oid_uniq_ml *) -ML \<open>val oidPerson_0_boss = 0\<close> - -(* 115 ************************************ 699 + 1 *) (* term Floor1_access.print_access_oid_uniq *) -definition "oid\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_0___boss = 0" - -(* 116 ************************************ 700 + 1 *) -text \<open> - From there on, we can already define an empty state which must contain -for $\mathit{oid}_{Person}\mathcal{BOSS}$ the empty relation (encoded as association list, since there are -associations with a Sequence-like structure).\<close> - -(* 117 ************************************ 701 + 5 *) (* term Floor1_access.print_access_eval_extract *) -definition "eval_extract x f = (\<lambda>\<tau>. (case x \<tau> of \<lfloor>\<lfloor>obj\<rfloor>\<rfloor> \<Rightarrow> (f ((oid_of (obj))) (\<tau>)) - | _ \<Rightarrow> invalid \<tau>))" -definition "in_pre_state = fst" -definition "in_post_state = snd" -definition "reconst_basetype = (\<lambda>x _. \<lfloor>\<lfloor>x\<rfloor>\<rfloor>)" -definition "reconst_basetype\<^sub>V\<^sub>o\<^sub>i\<^sub>d x = Abs_Void\<^sub>b\<^sub>a\<^sub>s\<^sub>e o (reconst_basetype (x))" - -(* 118 ************************************ 706 + 1 *) -text \<open> - The @{text pre_post}-parameter is configured with @{text fst} or -@{text snd}, the @{text to_from}-parameter either with the identity @{term id} or -the following combinator @{text switch}: \<close> - -(* 119 ************************************ 707 + 2 *) (* term Floor1_access.print_access_choose_ml *) -ML \<open>val switch2_01 = (fn [x0 , x1] => (x0 , x1))\<close> -ML \<open>val switch2_10 = (fn [x0 , x1] => (x1 , x0))\<close> - -(* 120 ************************************ 709 + 3 *) (* term Floor1_access.print_access_choose *) -definition "switch\<^sub>2_01 = (\<lambda> [x0 , x1] \<Rightarrow> (x0 , x1))" -definition "switch\<^sub>2_10 = (\<lambda> [x0 , x1] \<Rightarrow> (x1 , x0))" -definition "deref_assocs pre_post to_from assoc_oid f oid = (\<lambda>\<tau>. (case (assocs ((pre_post (\<tau>))) (assoc_oid)) of \<lfloor>S\<rfloor> \<Rightarrow> (f ((deref_assocs_list (to_from) (oid) (S))) (\<tau>)) - | _ \<Rightarrow> (invalid (\<tau>))))" - -(* 121 ************************************ 712 + 4 *) (* term Floor1_access.print_access_deref_oid *) -definition "deref_oid\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n fst_snd f oid = (\<lambda>\<tau>. (case (heap (fst_snd \<tau>) (oid)) of \<lfloor>in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n obj\<rfloor> \<Rightarrow> f obj \<tau> - | _ \<Rightarrow> invalid \<tau>))" -definition "deref_oid\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t fst_snd f oid = (\<lambda>\<tau>. (case (heap (fst_snd \<tau>) (oid)) of \<lfloor>in\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t obj\<rfloor> \<Rightarrow> f obj \<tau> - | _ \<Rightarrow> invalid \<tau>))" -definition "deref_oid\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y fst_snd f oid = (\<lambda>\<tau>. (case (heap (fst_snd \<tau>) (oid)) of \<lfloor>in\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y obj\<rfloor> \<Rightarrow> f obj \<tau> - | _ \<Rightarrow> invalid \<tau>))" -definition "deref_oid\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y fst_snd f oid = (\<lambda>\<tau>. (case (heap (fst_snd \<tau>) (oid)) of \<lfloor>in\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y obj\<rfloor> \<Rightarrow> f obj \<tau> - | _ \<Rightarrow> invalid \<tau>))" - -(* 122 ************************************ 716 + 1 *) (* term Floor1_access.print_access_deref_assocs *) -definition "deref_assocs\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_0___boss fst_snd f = (deref_assocs (fst_snd) (switch\<^sub>2_01) (oid\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_0___boss) (f)) \<circ> oid_of" - -(* 123 ************************************ 717 + 1 *) -text \<open> - pointer undefined in state or not referencing a type conform object representation \<close> - -(* 124 ************************************ 718 + 14 *) (* term Floor1_access.print_access_select *) -definition "select\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__salary f = (\<lambda> (mk\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (_) (\<bottom>)) \<Rightarrow> null - | (mk\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (_) (\<lfloor>x___salary\<rfloor>)) \<Rightarrow> (f (x___salary)))" -definition "select\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__wormhole f = (\<lambda> (mk\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (_) (\<bottom>) (_)) \<Rightarrow> null - | (mk\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (_) (\<lfloor>x___wormhole\<rfloor>) (_)) \<Rightarrow> (f (x___wormhole)))" -definition "select\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__weight f = (\<lambda> (mk\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (_) (_) (\<bottom>)) \<Rightarrow> null - | (mk\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (_) (_) (\<lfloor>x___weight\<rfloor>)) \<Rightarrow> (f (x___weight)))" -definition "select\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y__sound f = (\<lambda> (mk\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y (_) (\<bottom>) (_) (_)) \<Rightarrow> null - | (mk\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y (_) (\<lfloor>x___sound\<rfloor>) (_) (_)) \<Rightarrow> (f (x___sound)))" -definition "select\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y__moving f = (\<lambda> (mk\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y (_) (_) (\<bottom>) (_)) \<Rightarrow> null - | (mk\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y (_) (_) (\<lfloor>x___moving\<rfloor>) (_)) \<Rightarrow> (f (x___moving)))" -definition "select\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y__outer_world f = (\<lambda> (mk\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y (_) (_) (_) (\<bottom>)) \<Rightarrow> null - | (mk\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y (_) (_) (_) (\<lfloor>x___outer_world\<rfloor>)) \<Rightarrow> (f (x___outer_world)))" -definition "select\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__wormhole f = (\<lambda> (mk\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n ((mk\<E>\<X>\<T>\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (_) (\<bottom>) (_) (_) (_) (_))) (_)) \<Rightarrow> null - | (mk\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n ((mk\<E>\<X>\<T>\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (_) (\<lfloor>x___wormhole\<rfloor>) (_) (_) (_) (_))) (_)) \<Rightarrow> (f (x___wormhole)))" -definition "select\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__weight f = (\<lambda> (mk\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n ((mk\<E>\<X>\<T>\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (_) (_) (\<bottom>) (_) (_) (_))) (_)) \<Rightarrow> null - | (mk\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n ((mk\<E>\<X>\<T>\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (_) (_) (\<lfloor>x___weight\<rfloor>) (_) (_) (_))) (_)) \<Rightarrow> (f (x___weight)))" -definition "select\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__sound f = (\<lambda> (mk\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n ((mk\<E>\<X>\<T>\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (_) (_) (_) (\<bottom>) (_) (_))) (_)) \<Rightarrow> null - | (mk\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n ((mk\<E>\<X>\<T>\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (_) (_) (_) (\<lfloor>x___sound\<rfloor>) (_) (_))) (_)) \<Rightarrow> (f (x___sound)))" -definition "select\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__moving f = (\<lambda> (mk\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n ((mk\<E>\<X>\<T>\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (_) (_) (_) (_) (\<bottom>) (_))) (_)) \<Rightarrow> null - | (mk\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n ((mk\<E>\<X>\<T>\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (_) (_) (_) (_) (\<lfloor>x___moving\<rfloor>) (_))) (_)) \<Rightarrow> (f (x___moving)))" -definition "select\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__outer_world f = (\<lambda> (mk\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n ((mk\<E>\<X>\<T>\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (_) (_) (_) (_) (_) (\<bottom>))) (_)) \<Rightarrow> null - | (mk\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n ((mk\<E>\<X>\<T>\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (_) (_) (_) (_) (_) (\<lfloor>x___outer_world\<rfloor>))) (_)) \<Rightarrow> (f (x___outer_world)))" -definition "select\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__sound f = (\<lambda> (mk\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t ((mk\<E>\<X>\<T>\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (_) (\<bottom>) (_) (_))) (_) (_)) \<Rightarrow> null - | (mk\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t ((mk\<E>\<X>\<T>\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (_) (\<lfloor>x___sound\<rfloor>) (_) (_))) (_) (_)) \<Rightarrow> (f (x___sound)) - | (mk\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t ((mk\<E>\<X>\<T>\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (person))) (_) (_)) \<Rightarrow> (select\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__sound (f) (person)))" -definition "select\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__moving f = (\<lambda> (mk\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t ((mk\<E>\<X>\<T>\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (_) (_) (\<bottom>) (_))) (_) (_)) \<Rightarrow> null - | (mk\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t ((mk\<E>\<X>\<T>\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (_) (_) (\<lfloor>x___moving\<rfloor>) (_))) (_) (_)) \<Rightarrow> (f (x___moving)) - | (mk\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t ((mk\<E>\<X>\<T>\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (person))) (_) (_)) \<Rightarrow> (select\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__moving (f) (person)))" -definition "select\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__outer_world f = (\<lambda> (mk\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t ((mk\<E>\<X>\<T>\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (_) (_) (_) (\<bottom>))) (_) (_)) \<Rightarrow> null - | (mk\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t ((mk\<E>\<X>\<T>\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (_) (_) (_) (\<lfloor>x___outer_world\<rfloor>))) (_) (_)) \<Rightarrow> (f (x___outer_world)) - | (mk\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t ((mk\<E>\<X>\<T>\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (person))) (_) (_)) \<Rightarrow> (select\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__outer_world (f) (person)))" - -(* 125 ************************************ 732 + 1 *) (* term Floor1_access.print_access_select_obj *) -definition "select\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__boss = select_object_any\<^sub>S\<^sub>e\<^sub>t" - -(* 126 ************************************ 733 + 14 *) (* term Floor1_access.print_access_dot_consts *) -consts dot_0___boss :: "(\<AA>, '\<alpha>) val \<Rightarrow> \<cdot>Person" ("(_) .boss") -consts dot_0___bossat_pre :: "(\<AA>, '\<alpha>) val \<Rightarrow> \<cdot>Person" ("(_) .boss@pre") -consts dot__salary :: "(\<AA>, '\<alpha>) val \<Rightarrow> Integer" ("(_) .salary") -consts dot__salaryat_pre :: "(\<AA>, '\<alpha>) val \<Rightarrow> Integer" ("(_) .salary@pre") -consts dot__wormhole :: "(\<AA>, '\<alpha>) val \<Rightarrow> (\<AA>, nat option option) val" ("(_) .wormhole") -consts dot__wormholeat_pre :: "(\<AA>, '\<alpha>) val \<Rightarrow> (\<AA>, nat option option) val" ("(_) .wormhole@pre") -consts dot__weight :: "(\<AA>, '\<alpha>) val \<Rightarrow> Integer" ("(_) .weight") -consts dot__weightat_pre :: "(\<AA>, '\<alpha>) val \<Rightarrow> Integer" ("(_) .weight@pre") -consts dot__sound :: "(\<AA>, '\<alpha>) val \<Rightarrow> Void" ("(_) .sound") -consts dot__soundat_pre :: "(\<AA>, '\<alpha>) val \<Rightarrow> Void" ("(_) .sound@pre") -consts dot__moving :: "(\<AA>, '\<alpha>) val \<Rightarrow> Boolean" ("(_) .moving") -consts dot__movingat_pre :: "(\<AA>, '\<alpha>) val \<Rightarrow> Boolean" ("(_) .moving@pre") -consts dot__outer_world :: "(\<AA>, '\<alpha>) val \<Rightarrow> Set_Sequence_Planet" ("(_) .outer'_world") -consts dot__outer_worldat_pre :: "(\<AA>, '\<alpha>) val \<Rightarrow> Set_Sequence_Planet" ("(_) .outer'_world@pre") - -(* 127 ************************************ 747 + 30 *) (* term Floor1_access.print_access_dot *) -overloading dot_0___boss \<equiv> "(dot_0___boss::(\<cdot>Person) \<Rightarrow> _)" -begin - definition dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_0___boss : "(x::\<cdot>Person) .boss \<equiv> (eval_extract (x) ((deref_oid\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (in_post_state) ((deref_assocs\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_0___boss (in_post_state) ((select\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__boss ((deref_oid\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (in_post_state) (reconst_basetype))))))))))" -end -overloading dot__salary \<equiv> "(dot__salary::(\<cdot>Person) \<Rightarrow> _)" -begin - definition dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__salary : "(x::\<cdot>Person) .salary \<equiv> (eval_extract (x) ((deref_oid\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (in_post_state) ((select\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__salary (reconst_basetype))))))" -end -overloading dot_0___bossat_pre \<equiv> "(dot_0___bossat_pre::(\<cdot>Person) \<Rightarrow> _)" -begin - definition dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_0___bossat_pre : "(x::\<cdot>Person) .boss@pre \<equiv> (eval_extract (x) ((deref_oid\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (in_pre_state) ((deref_assocs\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_0___boss (in_pre_state) ((select\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__boss ((deref_oid\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (in_pre_state) (reconst_basetype))))))))))" -end -overloading dot__salaryat_pre \<equiv> "(dot__salaryat_pre::(\<cdot>Person) \<Rightarrow> _)" -begin - definition dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__salaryat_pre : "(x::\<cdot>Person) .salary@pre \<equiv> (eval_extract (x) ((deref_oid\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (in_pre_state) ((select\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__salary (reconst_basetype))))))" -end -overloading dot__wormhole \<equiv> "(dot__wormhole::(\<cdot>Planet) \<Rightarrow> _)" -begin - definition dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__wormhole : "(x::\<cdot>Planet) .wormhole \<equiv> (eval_extract (x) ((deref_oid\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (in_post_state) ((select\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__wormhole (reconst_basetype))))))" -end -overloading dot__weight \<equiv> "(dot__weight::(\<cdot>Planet) \<Rightarrow> _)" -begin - definition dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__weight : "(x::\<cdot>Planet) .weight \<equiv> (eval_extract (x) ((deref_oid\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (in_post_state) ((select\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__weight (reconst_basetype))))))" -end -overloading dot__wormholeat_pre \<equiv> "(dot__wormholeat_pre::(\<cdot>Planet) \<Rightarrow> _)" -begin - definition dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__wormholeat_pre : "(x::\<cdot>Planet) .wormhole@pre \<equiv> (eval_extract (x) ((deref_oid\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (in_pre_state) ((select\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__wormhole (reconst_basetype))))))" -end -overloading dot__weightat_pre \<equiv> "(dot__weightat_pre::(\<cdot>Planet) \<Rightarrow> _)" -begin - definition dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__weightat_pre : "(x::\<cdot>Planet) .weight@pre \<equiv> (eval_extract (x) ((deref_oid\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (in_pre_state) ((select\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__weight (reconst_basetype))))))" -end -overloading dot__sound \<equiv> "(dot__sound::(\<cdot>Galaxy) \<Rightarrow> _)" -begin - definition dot\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y__sound : "(x::\<cdot>Galaxy) .sound \<equiv> (eval_extract (x) ((deref_oid\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y (in_post_state) ((select\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y__sound (reconst_basetype\<^sub>V\<^sub>o\<^sub>i\<^sub>d))))))" -end -overloading dot__moving \<equiv> "(dot__moving::(\<cdot>Galaxy) \<Rightarrow> _)" -begin - definition dot\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y__moving : "(x::\<cdot>Galaxy) .moving \<equiv> (eval_extract (x) ((deref_oid\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y (in_post_state) ((select\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y__moving (reconst_basetype))))))" -end -overloading dot__outer_world \<equiv> "(dot__outer_world::(\<cdot>Galaxy) \<Rightarrow> _)" -begin - definition dot\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y__outer_world : "(x::\<cdot>Galaxy) .outer_world \<equiv> (eval_extract (x) ((deref_oid\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y (in_post_state) ((select\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y__outer_world ((select_object\<^sub>S\<^sub>e\<^sub>t ((select_object\<^sub>S\<^sub>e\<^sub>q ((deref_oid\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (in_post_state) (reconst_basetype))))))))))))" -end -overloading dot__soundat_pre \<equiv> "(dot__soundat_pre::(\<cdot>Galaxy) \<Rightarrow> _)" -begin - definition dot\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y__soundat_pre : "(x::\<cdot>Galaxy) .sound@pre \<equiv> (eval_extract (x) ((deref_oid\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y (in_pre_state) ((select\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y__sound (reconst_basetype\<^sub>V\<^sub>o\<^sub>i\<^sub>d))))))" -end -overloading dot__movingat_pre \<equiv> "(dot__movingat_pre::(\<cdot>Galaxy) \<Rightarrow> _)" -begin - definition dot\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y__movingat_pre : "(x::\<cdot>Galaxy) .moving@pre \<equiv> (eval_extract (x) ((deref_oid\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y (in_pre_state) ((select\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y__moving (reconst_basetype))))))" -end -overloading dot__outer_worldat_pre \<equiv> "(dot__outer_worldat_pre::(\<cdot>Galaxy) \<Rightarrow> _)" -begin - definition dot\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y__outer_worldat_pre : "(x::\<cdot>Galaxy) .outer_world@pre \<equiv> (eval_extract (x) ((deref_oid\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y (in_pre_state) ((select\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y__outer_world ((select_object\<^sub>S\<^sub>e\<^sub>t ((select_object\<^sub>S\<^sub>e\<^sub>q ((deref_oid\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (in_pre_state) (reconst_basetype))))))))))))" -end -overloading dot__wormhole \<equiv> "(dot__wormhole::(\<cdot>Person) \<Rightarrow> _)" -begin - definition dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__wormhole : "(x::\<cdot>Person) .wormhole \<equiv> (eval_extract (x) ((deref_oid\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (in_post_state) ((select\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__wormhole (reconst_basetype))))))" -end -overloading dot__weight \<equiv> "(dot__weight::(\<cdot>Person) \<Rightarrow> _)" -begin - definition dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__weight : "(x::\<cdot>Person) .weight \<equiv> (eval_extract (x) ((deref_oid\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (in_post_state) ((select\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__weight (reconst_basetype))))))" -end -overloading dot__sound \<equiv> "(dot__sound::(\<cdot>Person) \<Rightarrow> _)" -begin - definition dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__sound : "(x::\<cdot>Person) .sound \<equiv> (eval_extract (x) ((deref_oid\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (in_post_state) ((select\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__sound (reconst_basetype\<^sub>V\<^sub>o\<^sub>i\<^sub>d))))))" -end -overloading dot__moving \<equiv> "(dot__moving::(\<cdot>Person) \<Rightarrow> _)" -begin - definition dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__moving : "(x::\<cdot>Person) .moving \<equiv> (eval_extract (x) ((deref_oid\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (in_post_state) ((select\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__moving (reconst_basetype))))))" -end -overloading dot__outer_world \<equiv> "(dot__outer_world::(\<cdot>Person) \<Rightarrow> _)" -begin - definition dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__outer_world : "(x::\<cdot>Person) .outer_world \<equiv> (eval_extract (x) ((deref_oid\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (in_post_state) ((select\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__outer_world ((select_object\<^sub>S\<^sub>e\<^sub>t ((select_object\<^sub>S\<^sub>e\<^sub>q ((deref_oid\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (in_post_state) (reconst_basetype))))))))))))" -end -overloading dot__wormholeat_pre \<equiv> "(dot__wormholeat_pre::(\<cdot>Person) \<Rightarrow> _)" -begin - definition dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__wormholeat_pre : "(x::\<cdot>Person) .wormhole@pre \<equiv> (eval_extract (x) ((deref_oid\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (in_pre_state) ((select\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__wormhole (reconst_basetype))))))" -end -overloading dot__weightat_pre \<equiv> "(dot__weightat_pre::(\<cdot>Person) \<Rightarrow> _)" -begin - definition dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__weightat_pre : "(x::\<cdot>Person) .weight@pre \<equiv> (eval_extract (x) ((deref_oid\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (in_pre_state) ((select\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__weight (reconst_basetype))))))" -end -overloading dot__soundat_pre \<equiv> "(dot__soundat_pre::(\<cdot>Person) \<Rightarrow> _)" -begin - definition dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__soundat_pre : "(x::\<cdot>Person) .sound@pre \<equiv> (eval_extract (x) ((deref_oid\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (in_pre_state) ((select\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__sound (reconst_basetype\<^sub>V\<^sub>o\<^sub>i\<^sub>d))))))" -end -overloading dot__movingat_pre \<equiv> "(dot__movingat_pre::(\<cdot>Person) \<Rightarrow> _)" -begin - definition dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__movingat_pre : "(x::\<cdot>Person) .moving@pre \<equiv> (eval_extract (x) ((deref_oid\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (in_pre_state) ((select\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__moving (reconst_basetype))))))" -end -overloading dot__outer_worldat_pre \<equiv> "(dot__outer_worldat_pre::(\<cdot>Person) \<Rightarrow> _)" -begin - definition dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__outer_worldat_pre : "(x::\<cdot>Person) .outer_world@pre \<equiv> (eval_extract (x) ((deref_oid\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (in_pre_state) ((select\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__outer_world ((select_object\<^sub>S\<^sub>e\<^sub>t ((select_object\<^sub>S\<^sub>e\<^sub>q ((deref_oid\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (in_pre_state) (reconst_basetype))))))))))))" -end -overloading dot__sound \<equiv> "(dot__sound::(\<cdot>Planet) \<Rightarrow> _)" -begin - definition dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__sound : "(x::\<cdot>Planet) .sound \<equiv> (eval_extract (x) ((deref_oid\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (in_post_state) ((select\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__sound (reconst_basetype\<^sub>V\<^sub>o\<^sub>i\<^sub>d))))))" -end -overloading dot__moving \<equiv> "(dot__moving::(\<cdot>Planet) \<Rightarrow> _)" -begin - definition dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__moving : "(x::\<cdot>Planet) .moving \<equiv> (eval_extract (x) ((deref_oid\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (in_post_state) ((select\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__moving (reconst_basetype))))))" -end -overloading dot__outer_world \<equiv> "(dot__outer_world::(\<cdot>Planet) \<Rightarrow> _)" -begin - definition dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__outer_world : "(x::\<cdot>Planet) .outer_world \<equiv> (eval_extract (x) ((deref_oid\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (in_post_state) ((select\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__outer_world ((select_object\<^sub>S\<^sub>e\<^sub>t ((select_object\<^sub>S\<^sub>e\<^sub>q ((deref_oid\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (in_post_state) (reconst_basetype))))))))))))" -end -overloading dot__soundat_pre \<equiv> "(dot__soundat_pre::(\<cdot>Planet) \<Rightarrow> _)" -begin - definition dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__soundat_pre : "(x::\<cdot>Planet) .sound@pre \<equiv> (eval_extract (x) ((deref_oid\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (in_pre_state) ((select\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__sound (reconst_basetype\<^sub>V\<^sub>o\<^sub>i\<^sub>d))))))" -end -overloading dot__movingat_pre \<equiv> "(dot__movingat_pre::(\<cdot>Planet) \<Rightarrow> _)" -begin - definition dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__movingat_pre : "(x::\<cdot>Planet) .moving@pre \<equiv> (eval_extract (x) ((deref_oid\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (in_pre_state) ((select\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__moving (reconst_basetype))))))" -end -overloading dot__outer_worldat_pre \<equiv> "(dot__outer_worldat_pre::(\<cdot>Planet) \<Rightarrow> _)" -begin - definition dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__outer_worldat_pre : "(x::\<cdot>Planet) .outer_world@pre \<equiv> (eval_extract (x) ((deref_oid\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (in_pre_state) ((select\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__outer_world ((select_object\<^sub>S\<^sub>e\<^sub>t ((select_object\<^sub>S\<^sub>e\<^sub>q ((deref_oid\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (in_pre_state) (reconst_basetype))))))))))))" -end - -(* 128 ************************************ 777 + 1 *) (* term Floor1_access.print_access_dot_lemmas_id *) -lemmas dot_accessor = dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_0___boss - dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__salary - dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_0___bossat_pre - dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__salaryat_pre - dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__wormhole - dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__weight - dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__wormholeat_pre - dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__weightat_pre - dot\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y__sound - dot\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y__moving - dot\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y__outer_world - dot\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y__soundat_pre - dot\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y__movingat_pre - dot\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y__outer_worldat_pre - dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__wormhole - dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__weight - dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__sound - dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__moving - dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__outer_world - dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__wormholeat_pre - dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__weightat_pre - dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__soundat_pre - dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__movingat_pre - dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__outer_worldat_pre - dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__sound - dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__moving - dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__outer_world - dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__soundat_pre - dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__movingat_pre - dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__outer_worldat_pre - -(* 129 ************************************ 778 + 1 *) -subsection \<open>Context Passing\<close> - -(* 130 ************************************ 779 + 1 *) (* term Floor1_access.print_access_dot_cp_lemmas *) -lemmas[simp,code_unfold] = eval_extract_def - -(* 131 ************************************ 780 + 30 *) (* term Floor1_access.print_access_dot_lemma_cp *) -lemma cp_dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_0___boss : "(cp ((\<lambda>X. (X::\<cdot>Person) .boss)))" -by(auto simp: dot_accessor cp_def) -lemma cp_dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__salary : "(cp ((\<lambda>X. (X::\<cdot>Person) .salary)))" -by(auto simp: dot_accessor cp_def) -lemma cp_dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_0___bossat_pre : "(cp ((\<lambda>X. (X::\<cdot>Person) .boss@pre)))" -by(auto simp: dot_accessor cp_def) -lemma cp_dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__salaryat_pre : "(cp ((\<lambda>X. (X::\<cdot>Person) .salary@pre)))" -by(auto simp: dot_accessor cp_def) -lemma cp_dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__wormhole : "(cp ((\<lambda>X. (X::\<cdot>Planet) .wormhole)))" -by(auto simp: dot_accessor cp_def) -lemma cp_dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__weight : "(cp ((\<lambda>X. (X::\<cdot>Planet) .weight)))" -by(auto simp: dot_accessor cp_def) -lemma cp_dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__wormholeat_pre : "(cp ((\<lambda>X. (X::\<cdot>Planet) .wormhole@pre)))" -by(auto simp: dot_accessor cp_def) -lemma cp_dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__weightat_pre : "(cp ((\<lambda>X. (X::\<cdot>Planet) .weight@pre)))" -by(auto simp: dot_accessor cp_def) -lemma cp_dot\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y__sound : "(cp ((\<lambda>X. (X::\<cdot>Galaxy) .sound)))" -by(auto simp: dot_accessor cp_def) -lemma cp_dot\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y__moving : "(cp ((\<lambda>X. (X::\<cdot>Galaxy) .moving)))" -by(auto simp: dot_accessor cp_def) -lemma cp_dot\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y__outer_world : "(cp ((\<lambda>X. (X::\<cdot>Galaxy) .outer_world)))" -by(auto simp: dot_accessor cp_def) -lemma cp_dot\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y__soundat_pre : "(cp ((\<lambda>X. (X::\<cdot>Galaxy) .sound@pre)))" -by(auto simp: dot_accessor cp_def) -lemma cp_dot\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y__movingat_pre : "(cp ((\<lambda>X. (X::\<cdot>Galaxy) .moving@pre)))" -by(auto simp: dot_accessor cp_def) -lemma cp_dot\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y__outer_worldat_pre : "(cp ((\<lambda>X. (X::\<cdot>Galaxy) .outer_world@pre)))" -by(auto simp: dot_accessor cp_def) -lemma cp_dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__wormhole : "(cp ((\<lambda>X. (X::\<cdot>Person) .wormhole)))" -by(auto simp: dot_accessor cp_def) -lemma cp_dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__weight : "(cp ((\<lambda>X. (X::\<cdot>Person) .weight)))" -by(auto simp: dot_accessor cp_def) -lemma cp_dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__sound : "(cp ((\<lambda>X. (X::\<cdot>Person) .sound)))" -by(auto simp: dot_accessor cp_def) -lemma cp_dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__moving : "(cp ((\<lambda>X. (X::\<cdot>Person) .moving)))" -by(auto simp: dot_accessor cp_def) -lemma cp_dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__outer_world : "(cp ((\<lambda>X. (X::\<cdot>Person) .outer_world)))" -by(auto simp: dot_accessor cp_def) -lemma cp_dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__wormholeat_pre : "(cp ((\<lambda>X. (X::\<cdot>Person) .wormhole@pre)))" -by(auto simp: dot_accessor cp_def) -lemma cp_dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__weightat_pre : "(cp ((\<lambda>X. (X::\<cdot>Person) .weight@pre)))" -by(auto simp: dot_accessor cp_def) -lemma cp_dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__soundat_pre : "(cp ((\<lambda>X. (X::\<cdot>Person) .sound@pre)))" -by(auto simp: dot_accessor cp_def) -lemma cp_dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__movingat_pre : "(cp ((\<lambda>X. (X::\<cdot>Person) .moving@pre)))" -by(auto simp: dot_accessor cp_def) -lemma cp_dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__outer_worldat_pre : "(cp ((\<lambda>X. (X::\<cdot>Person) .outer_world@pre)))" -by(auto simp: dot_accessor cp_def) -lemma cp_dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__sound : "(cp ((\<lambda>X. (X::\<cdot>Planet) .sound)))" -by(auto simp: dot_accessor cp_def) -lemma cp_dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__moving : "(cp ((\<lambda>X. (X::\<cdot>Planet) .moving)))" -by(auto simp: dot_accessor cp_def) -lemma cp_dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__outer_world : "(cp ((\<lambda>X. (X::\<cdot>Planet) .outer_world)))" -by(auto simp: dot_accessor cp_def) -lemma cp_dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__soundat_pre : "(cp ((\<lambda>X. (X::\<cdot>Planet) .sound@pre)))" -by(auto simp: dot_accessor cp_def) -lemma cp_dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__movingat_pre : "(cp ((\<lambda>X. (X::\<cdot>Planet) .moving@pre)))" -by(auto simp: dot_accessor cp_def) -lemma cp_dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__outer_worldat_pre : "(cp ((\<lambda>X. (X::\<cdot>Planet) .outer_world@pre)))" -by(auto simp: dot_accessor cp_def) - -(* 132 ************************************ 810 + 1 *) (* term Floor1_access.print_access_dot_lemmas_cp *) -lemmas[simp,code_unfold] = cp_dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_0___boss - cp_dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__salary - cp_dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_0___bossat_pre - cp_dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__salaryat_pre - cp_dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__wormhole - cp_dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__weight - cp_dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__wormholeat_pre - cp_dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__weightat_pre - cp_dot\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y__sound - cp_dot\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y__moving - cp_dot\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y__outer_world - cp_dot\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y__soundat_pre - cp_dot\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y__movingat_pre - cp_dot\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y__outer_worldat_pre - cp_dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__wormhole - cp_dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__weight - cp_dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__sound - cp_dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__moving - cp_dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__outer_world - cp_dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__wormholeat_pre - cp_dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__weightat_pre - cp_dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__soundat_pre - cp_dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__movingat_pre - cp_dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__outer_worldat_pre - cp_dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__sound - cp_dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__moving - cp_dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__outer_world - cp_dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__soundat_pre - cp_dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__movingat_pre - cp_dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__outer_worldat_pre - -(* 133 ************************************ 811 + 1 *) -subsection \<open>Execution with Invalid or Null as Argument\<close> - -(* 134 ************************************ 812 + 60 *) (* term Floor1_access.print_access_lemma_strict *) -lemma dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_0___boss_invalid : "(invalid::\<cdot>Person) .boss = invalid" -by(rule ext, simp add: dot_accessor bot_option_def invalid_def) -lemma dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_0___boss_null : "(null::\<cdot>Person) .boss = invalid" -by(rule ext, simp add: dot_accessor bot_option_def null_fun_def null_option_def) -lemma dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__salary_invalid : "(invalid::\<cdot>Person) .salary = invalid" -by(rule ext, simp add: dot_accessor bot_option_def invalid_def) -lemma dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__salary_null : "(null::\<cdot>Person) .salary = invalid" -by(rule ext, simp add: dot_accessor bot_option_def null_fun_def null_option_def) -lemma dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_0___bossat_pre_invalid : "(invalid::\<cdot>Person) .boss@pre = invalid" -by(rule ext, simp add: dot_accessor bot_option_def invalid_def) -lemma dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_0___bossat_pre_null : "(null::\<cdot>Person) .boss@pre = invalid" -by(rule ext, simp add: dot_accessor bot_option_def null_fun_def null_option_def) -lemma dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__salaryat_pre_invalid : "(invalid::\<cdot>Person) .salary@pre = invalid" -by(rule ext, simp add: dot_accessor bot_option_def invalid_def) -lemma dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__salaryat_pre_null : "(null::\<cdot>Person) .salary@pre = invalid" -by(rule ext, simp add: dot_accessor bot_option_def null_fun_def null_option_def) -lemma dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__wormhole_invalid : "(invalid::\<cdot>Planet) .wormhole = invalid" -by(rule ext, simp add: dot_accessor bot_option_def invalid_def) -lemma dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__wormhole_null : "(null::\<cdot>Planet) .wormhole = invalid" -by(rule ext, simp add: dot_accessor bot_option_def null_fun_def null_option_def) -lemma dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__weight_invalid : "(invalid::\<cdot>Planet) .weight = invalid" -by(rule ext, simp add: dot_accessor bot_option_def invalid_def) -lemma dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__weight_null : "(null::\<cdot>Planet) .weight = invalid" -by(rule ext, simp add: dot_accessor bot_option_def null_fun_def null_option_def) -lemma dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__wormholeat_pre_invalid : "(invalid::\<cdot>Planet) .wormhole@pre = invalid" -by(rule ext, simp add: dot_accessor bot_option_def invalid_def) -lemma dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__wormholeat_pre_null : "(null::\<cdot>Planet) .wormhole@pre = invalid" -by(rule ext, simp add: dot_accessor bot_option_def null_fun_def null_option_def) -lemma dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__weightat_pre_invalid : "(invalid::\<cdot>Planet) .weight@pre = invalid" -by(rule ext, simp add: dot_accessor bot_option_def invalid_def) -lemma dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__weightat_pre_null : "(null::\<cdot>Planet) .weight@pre = invalid" -by(rule ext, simp add: dot_accessor bot_option_def null_fun_def null_option_def) -lemma dot\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y__sound_invalid : "(invalid::\<cdot>Galaxy) .sound = invalid" -by(rule ext, simp add: dot_accessor bot_option_def invalid_def) -lemma dot\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y__sound_null : "(null::\<cdot>Galaxy) .sound = invalid" -by(rule ext, simp add: dot_accessor bot_option_def null_fun_def null_option_def) -lemma dot\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y__moving_invalid : "(invalid::\<cdot>Galaxy) .moving = invalid" -by(rule ext, simp add: dot_accessor bot_option_def invalid_def) -lemma dot\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y__moving_null : "(null::\<cdot>Galaxy) .moving = invalid" -by(rule ext, simp add: dot_accessor bot_option_def null_fun_def null_option_def) -lemma dot\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y__outer_world_invalid : "(invalid::\<cdot>Galaxy) .outer_world = invalid" -by(rule ext, simp add: dot_accessor bot_option_def invalid_def) -lemma dot\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y__outer_world_null : "(null::\<cdot>Galaxy) .outer_world = invalid" -by(rule ext, simp add: dot_accessor bot_option_def null_fun_def null_option_def) -lemma dot\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y__soundat_pre_invalid : "(invalid::\<cdot>Galaxy) .sound@pre = invalid" -by(rule ext, simp add: dot_accessor bot_option_def invalid_def) -lemma dot\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y__soundat_pre_null : "(null::\<cdot>Galaxy) .sound@pre = invalid" -by(rule ext, simp add: dot_accessor bot_option_def null_fun_def null_option_def) -lemma dot\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y__movingat_pre_invalid : "(invalid::\<cdot>Galaxy) .moving@pre = invalid" -by(rule ext, simp add: dot_accessor bot_option_def invalid_def) -lemma dot\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y__movingat_pre_null : "(null::\<cdot>Galaxy) .moving@pre = invalid" -by(rule ext, simp add: dot_accessor bot_option_def null_fun_def null_option_def) -lemma dot\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y__outer_worldat_pre_invalid : "(invalid::\<cdot>Galaxy) .outer_world@pre = invalid" -by(rule ext, simp add: dot_accessor bot_option_def invalid_def) -lemma dot\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y__outer_worldat_pre_null : "(null::\<cdot>Galaxy) .outer_world@pre = invalid" -by(rule ext, simp add: dot_accessor bot_option_def null_fun_def null_option_def) -lemma dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__wormhole_invalid : "(invalid::\<cdot>Person) .wormhole = invalid" -by(rule ext, simp add: dot_accessor bot_option_def invalid_def) -lemma dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__wormhole_null : "(null::\<cdot>Person) .wormhole = invalid" -by(rule ext, simp add: dot_accessor bot_option_def null_fun_def null_option_def) -lemma dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__weight_invalid : "(invalid::\<cdot>Person) .weight = invalid" -by(rule ext, simp add: dot_accessor bot_option_def invalid_def) -lemma dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__weight_null : "(null::\<cdot>Person) .weight = invalid" -by(rule ext, simp add: dot_accessor bot_option_def null_fun_def null_option_def) -lemma dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__sound_invalid : "(invalid::\<cdot>Person) .sound = invalid" -by(rule ext, simp add: dot_accessor bot_option_def invalid_def) -lemma dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__sound_null : "(null::\<cdot>Person) .sound = invalid" -by(rule ext, simp add: dot_accessor bot_option_def null_fun_def null_option_def) -lemma dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__moving_invalid : "(invalid::\<cdot>Person) .moving = invalid" -by(rule ext, simp add: dot_accessor bot_option_def invalid_def) -lemma dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__moving_null : "(null::\<cdot>Person) .moving = invalid" -by(rule ext, simp add: dot_accessor bot_option_def null_fun_def null_option_def) -lemma dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__outer_world_invalid : "(invalid::\<cdot>Person) .outer_world = invalid" -by(rule ext, simp add: dot_accessor bot_option_def invalid_def) -lemma dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__outer_world_null : "(null::\<cdot>Person) .outer_world = invalid" -by(rule ext, simp add: dot_accessor bot_option_def null_fun_def null_option_def) -lemma dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__wormholeat_pre_invalid : "(invalid::\<cdot>Person) .wormhole@pre = invalid" -by(rule ext, simp add: dot_accessor bot_option_def invalid_def) -lemma dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__wormholeat_pre_null : "(null::\<cdot>Person) .wormhole@pre = invalid" -by(rule ext, simp add: dot_accessor bot_option_def null_fun_def null_option_def) -lemma dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__weightat_pre_invalid : "(invalid::\<cdot>Person) .weight@pre = invalid" -by(rule ext, simp add: dot_accessor bot_option_def invalid_def) -lemma dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__weightat_pre_null : "(null::\<cdot>Person) .weight@pre = invalid" -by(rule ext, simp add: dot_accessor bot_option_def null_fun_def null_option_def) -lemma dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__soundat_pre_invalid : "(invalid::\<cdot>Person) .sound@pre = invalid" -by(rule ext, simp add: dot_accessor bot_option_def invalid_def) -lemma dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__soundat_pre_null : "(null::\<cdot>Person) .sound@pre = invalid" -by(rule ext, simp add: dot_accessor bot_option_def null_fun_def null_option_def) -lemma dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__movingat_pre_invalid : "(invalid::\<cdot>Person) .moving@pre = invalid" -by(rule ext, simp add: dot_accessor bot_option_def invalid_def) -lemma dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__movingat_pre_null : "(null::\<cdot>Person) .moving@pre = invalid" -by(rule ext, simp add: dot_accessor bot_option_def null_fun_def null_option_def) -lemma dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__outer_worldat_pre_invalid : "(invalid::\<cdot>Person) .outer_world@pre = invalid" -by(rule ext, simp add: dot_accessor bot_option_def invalid_def) -lemma dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__outer_worldat_pre_null : "(null::\<cdot>Person) .outer_world@pre = invalid" -by(rule ext, simp add: dot_accessor bot_option_def null_fun_def null_option_def) -lemma dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__sound_invalid : "(invalid::\<cdot>Planet) .sound = invalid" -by(rule ext, simp add: dot_accessor bot_option_def invalid_def) -lemma dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__sound_null : "(null::\<cdot>Planet) .sound = invalid" -by(rule ext, simp add: dot_accessor bot_option_def null_fun_def null_option_def) -lemma dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__moving_invalid : "(invalid::\<cdot>Planet) .moving = invalid" -by(rule ext, simp add: dot_accessor bot_option_def invalid_def) -lemma dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__moving_null : "(null::\<cdot>Planet) .moving = invalid" -by(rule ext, simp add: dot_accessor bot_option_def null_fun_def null_option_def) -lemma dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__outer_world_invalid : "(invalid::\<cdot>Planet) .outer_world = invalid" -by(rule ext, simp add: dot_accessor bot_option_def invalid_def) -lemma dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__outer_world_null : "(null::\<cdot>Planet) .outer_world = invalid" -by(rule ext, simp add: dot_accessor bot_option_def null_fun_def null_option_def) -lemma dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__soundat_pre_invalid : "(invalid::\<cdot>Planet) .sound@pre = invalid" -by(rule ext, simp add: dot_accessor bot_option_def invalid_def) -lemma dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__soundat_pre_null : "(null::\<cdot>Planet) .sound@pre = invalid" -by(rule ext, simp add: dot_accessor bot_option_def null_fun_def null_option_def) -lemma dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__movingat_pre_invalid : "(invalid::\<cdot>Planet) .moving@pre = invalid" -by(rule ext, simp add: dot_accessor bot_option_def invalid_def) -lemma dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__movingat_pre_null : "(null::\<cdot>Planet) .moving@pre = invalid" -by(rule ext, simp add: dot_accessor bot_option_def null_fun_def null_option_def) -lemma dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__outer_worldat_pre_invalid : "(invalid::\<cdot>Planet) .outer_world@pre = invalid" -by(rule ext, simp add: dot_accessor bot_option_def invalid_def) -lemma dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__outer_worldat_pre_null : "(null::\<cdot>Planet) .outer_world@pre = invalid" -by(rule ext, simp add: dot_accessor bot_option_def null_fun_def null_option_def) - -(* 135 ************************************ 872 + 1 *) -subsection \<open>Representation in States\<close> - -(* 136 ************************************ 873 + 30 *) (* term Floor1_access.print_access_def_mono *) -lemma defined_mono_dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_0___boss : "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Person) .boss)) \<Longrightarrow> \<tau> \<Turnstile> (\<delta> (X))" - apply(case_tac "\<tau> \<Turnstile> (X \<triangleq> invalid)", insert StrongEq_L_subst2[where P = "(\<lambda>x. (\<delta> (x .boss)))" and \<tau> = "\<tau>" and x = "X" and y = "invalid"], simp add: foundation16' dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_0___boss_invalid) - apply(case_tac "\<tau> \<Turnstile> (X \<triangleq> null)", insert StrongEq_L_subst2[where P = "(\<lambda>x. (\<delta> (x .boss)))" and \<tau> = "\<tau>" and x = "X" and y = "null"], simp add: foundation16' dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_0___boss_null) -by(simp add: defined_split) -lemma defined_mono_dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__salary : "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Person) .salary)) \<Longrightarrow> \<tau> \<Turnstile> (\<delta> (X))" - apply(case_tac "\<tau> \<Turnstile> (X \<triangleq> invalid)", insert StrongEq_L_subst2[where P = "(\<lambda>x. (\<delta> (x .salary)))" and \<tau> = "\<tau>" and x = "X" and y = "invalid"], simp add: foundation16' dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__salary_invalid) - apply(case_tac "\<tau> \<Turnstile> (X \<triangleq> null)", insert StrongEq_L_subst2[where P = "(\<lambda>x. (\<delta> (x .salary)))" and \<tau> = "\<tau>" and x = "X" and y = "null"], simp add: foundation16' dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__salary_null) -by(simp add: defined_split) -lemma defined_mono_dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_0___bossat_pre : "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Person) .boss@pre)) \<Longrightarrow> \<tau> \<Turnstile> (\<delta> (X))" - apply(case_tac "\<tau> \<Turnstile> (X \<triangleq> invalid)", insert StrongEq_L_subst2[where P = "(\<lambda>x. (\<delta> (x .boss@pre)))" and \<tau> = "\<tau>" and x = "X" and y = "invalid"], simp add: foundation16' dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_0___bossat_pre_invalid) - apply(case_tac "\<tau> \<Turnstile> (X \<triangleq> null)", insert StrongEq_L_subst2[where P = "(\<lambda>x. (\<delta> (x .boss@pre)))" and \<tau> = "\<tau>" and x = "X" and y = "null"], simp add: foundation16' dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_0___bossat_pre_null) -by(simp add: defined_split) -lemma defined_mono_dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__salaryat_pre : "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Person) .salary@pre)) \<Longrightarrow> \<tau> \<Turnstile> (\<delta> (X))" - apply(case_tac "\<tau> \<Turnstile> (X \<triangleq> invalid)", insert StrongEq_L_subst2[where P = "(\<lambda>x. (\<delta> (x .salary@pre)))" and \<tau> = "\<tau>" and x = "X" and y = "invalid"], simp add: foundation16' dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__salaryat_pre_invalid) - apply(case_tac "\<tau> \<Turnstile> (X \<triangleq> null)", insert StrongEq_L_subst2[where P = "(\<lambda>x. (\<delta> (x .salary@pre)))" and \<tau> = "\<tau>" and x = "X" and y = "null"], simp add: foundation16' dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__salaryat_pre_null) -by(simp add: defined_split) -lemma defined_mono_dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__wormhole : "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Planet) .wormhole)) \<Longrightarrow> \<tau> \<Turnstile> (\<delta> (X))" - apply(case_tac "\<tau> \<Turnstile> (X \<triangleq> invalid)", insert StrongEq_L_subst2[where P = "(\<lambda>x. (\<delta> (x .wormhole)))" and \<tau> = "\<tau>" and x = "X" and y = "invalid"], simp add: foundation16' dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__wormhole_invalid) - apply(case_tac "\<tau> \<Turnstile> (X \<triangleq> null)", insert StrongEq_L_subst2[where P = "(\<lambda>x. (\<delta> (x .wormhole)))" and \<tau> = "\<tau>" and x = "X" and y = "null"], simp add: foundation16' dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__wormhole_null) -by(simp add: defined_split) -lemma defined_mono_dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__weight : "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Planet) .weight)) \<Longrightarrow> \<tau> \<Turnstile> (\<delta> (X))" - apply(case_tac "\<tau> \<Turnstile> (X \<triangleq> invalid)", insert StrongEq_L_subst2[where P = "(\<lambda>x. (\<delta> (x .weight)))" and \<tau> = "\<tau>" and x = "X" and y = "invalid"], simp add: foundation16' dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__weight_invalid) - apply(case_tac "\<tau> \<Turnstile> (X \<triangleq> null)", insert StrongEq_L_subst2[where P = "(\<lambda>x. (\<delta> (x .weight)))" and \<tau> = "\<tau>" and x = "X" and y = "null"], simp add: foundation16' dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__weight_null) -by(simp add: defined_split) -lemma defined_mono_dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__wormholeat_pre : "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Planet) .wormhole@pre)) \<Longrightarrow> \<tau> \<Turnstile> (\<delta> (X))" - apply(case_tac "\<tau> \<Turnstile> (X \<triangleq> invalid)", insert StrongEq_L_subst2[where P = "(\<lambda>x. (\<delta> (x .wormhole@pre)))" and \<tau> = "\<tau>" and x = "X" and y = "invalid"], simp add: foundation16' dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__wormholeat_pre_invalid) - apply(case_tac "\<tau> \<Turnstile> (X \<triangleq> null)", insert StrongEq_L_subst2[where P = "(\<lambda>x. (\<delta> (x .wormhole@pre)))" and \<tau> = "\<tau>" and x = "X" and y = "null"], simp add: foundation16' dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__wormholeat_pre_null) -by(simp add: defined_split) -lemma defined_mono_dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__weightat_pre : "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Planet) .weight@pre)) \<Longrightarrow> \<tau> \<Turnstile> (\<delta> (X))" - apply(case_tac "\<tau> \<Turnstile> (X \<triangleq> invalid)", insert StrongEq_L_subst2[where P = "(\<lambda>x. (\<delta> (x .weight@pre)))" and \<tau> = "\<tau>" and x = "X" and y = "invalid"], simp add: foundation16' dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__weightat_pre_invalid) - apply(case_tac "\<tau> \<Turnstile> (X \<triangleq> null)", insert StrongEq_L_subst2[where P = "(\<lambda>x. (\<delta> (x .weight@pre)))" and \<tau> = "\<tau>" and x = "X" and y = "null"], simp add: foundation16' dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__weightat_pre_null) -by(simp add: defined_split) -lemma defined_mono_dot\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y__sound : "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Galaxy) .sound)) \<Longrightarrow> \<tau> \<Turnstile> (\<delta> (X))" - apply(case_tac "\<tau> \<Turnstile> (X \<triangleq> invalid)", insert StrongEq_L_subst2[where P = "(\<lambda>x. (\<delta> (x .sound)))" and \<tau> = "\<tau>" and x = "X" and y = "invalid"], simp add: foundation16' dot\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y__sound_invalid) - apply(case_tac "\<tau> \<Turnstile> (X \<triangleq> null)", insert StrongEq_L_subst2[where P = "(\<lambda>x. (\<delta> (x .sound)))" and \<tau> = "\<tau>" and x = "X" and y = "null"], simp add: foundation16' dot\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y__sound_null) -by(simp add: defined_split) -lemma defined_mono_dot\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y__moving : "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Galaxy) .moving)) \<Longrightarrow> \<tau> \<Turnstile> (\<delta> (X))" - apply(case_tac "\<tau> \<Turnstile> (X \<triangleq> invalid)", insert StrongEq_L_subst2[where P = "(\<lambda>x. (\<delta> (x .moving)))" and \<tau> = "\<tau>" and x = "X" and y = "invalid"], simp add: foundation16' dot\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y__moving_invalid) - apply(case_tac "\<tau> \<Turnstile> (X \<triangleq> null)", insert StrongEq_L_subst2[where P = "(\<lambda>x. (\<delta> (x .moving)))" and \<tau> = "\<tau>" and x = "X" and y = "null"], simp add: foundation16' dot\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y__moving_null) -by(simp add: defined_split) -lemma defined_mono_dot\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y__outer_world : "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Galaxy) .outer_world)) \<Longrightarrow> \<tau> \<Turnstile> (\<delta> (X))" - apply(case_tac "\<tau> \<Turnstile> (X \<triangleq> invalid)", insert StrongEq_L_subst2[where P = "(\<lambda>x. (\<delta> (x .outer_world)))" and \<tau> = "\<tau>" and x = "X" and y = "invalid"], simp add: foundation16' dot\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y__outer_world_invalid) - apply(case_tac "\<tau> \<Turnstile> (X \<triangleq> null)", insert StrongEq_L_subst2[where P = "(\<lambda>x. (\<delta> (x .outer_world)))" and \<tau> = "\<tau>" and x = "X" and y = "null"], simp add: foundation16' dot\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y__outer_world_null) -by(simp add: defined_split) -lemma defined_mono_dot\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y__soundat_pre : "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Galaxy) .sound@pre)) \<Longrightarrow> \<tau> \<Turnstile> (\<delta> (X))" - apply(case_tac "\<tau> \<Turnstile> (X \<triangleq> invalid)", insert StrongEq_L_subst2[where P = "(\<lambda>x. (\<delta> (x .sound@pre)))" and \<tau> = "\<tau>" and x = "X" and y = "invalid"], simp add: foundation16' dot\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y__soundat_pre_invalid) - apply(case_tac "\<tau> \<Turnstile> (X \<triangleq> null)", insert StrongEq_L_subst2[where P = "(\<lambda>x. (\<delta> (x .sound@pre)))" and \<tau> = "\<tau>" and x = "X" and y = "null"], simp add: foundation16' dot\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y__soundat_pre_null) -by(simp add: defined_split) -lemma defined_mono_dot\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y__movingat_pre : "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Galaxy) .moving@pre)) \<Longrightarrow> \<tau> \<Turnstile> (\<delta> (X))" - apply(case_tac "\<tau> \<Turnstile> (X \<triangleq> invalid)", insert StrongEq_L_subst2[where P = "(\<lambda>x. (\<delta> (x .moving@pre)))" and \<tau> = "\<tau>" and x = "X" and y = "invalid"], simp add: foundation16' dot\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y__movingat_pre_invalid) - apply(case_tac "\<tau> \<Turnstile> (X \<triangleq> null)", insert StrongEq_L_subst2[where P = "(\<lambda>x. (\<delta> (x .moving@pre)))" and \<tau> = "\<tau>" and x = "X" and y = "null"], simp add: foundation16' dot\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y__movingat_pre_null) -by(simp add: defined_split) -lemma defined_mono_dot\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y__outer_worldat_pre : "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Galaxy) .outer_world@pre)) \<Longrightarrow> \<tau> \<Turnstile> (\<delta> (X))" - apply(case_tac "\<tau> \<Turnstile> (X \<triangleq> invalid)", insert StrongEq_L_subst2[where P = "(\<lambda>x. (\<delta> (x .outer_world@pre)))" and \<tau> = "\<tau>" and x = "X" and y = "invalid"], simp add: foundation16' dot\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y__outer_worldat_pre_invalid) - apply(case_tac "\<tau> \<Turnstile> (X \<triangleq> null)", insert StrongEq_L_subst2[where P = "(\<lambda>x. (\<delta> (x .outer_world@pre)))" and \<tau> = "\<tau>" and x = "X" and y = "null"], simp add: foundation16' dot\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y__outer_worldat_pre_null) -by(simp add: defined_split) -lemma defined_mono_dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__wormhole : "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Person) .wormhole)) \<Longrightarrow> \<tau> \<Turnstile> (\<delta> (X))" - apply(case_tac "\<tau> \<Turnstile> (X \<triangleq> invalid)", insert StrongEq_L_subst2[where P = "(\<lambda>x. (\<delta> (x .wormhole)))" and \<tau> = "\<tau>" and x = "X" and y = "invalid"], simp add: foundation16' dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__wormhole_invalid) - apply(case_tac "\<tau> \<Turnstile> (X \<triangleq> null)", insert StrongEq_L_subst2[where P = "(\<lambda>x. (\<delta> (x .wormhole)))" and \<tau> = "\<tau>" and x = "X" and y = "null"], simp add: foundation16' dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__wormhole_null) -by(simp add: defined_split) -lemma defined_mono_dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__weight : "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Person) .weight)) \<Longrightarrow> \<tau> \<Turnstile> (\<delta> (X))" - apply(case_tac "\<tau> \<Turnstile> (X \<triangleq> invalid)", insert StrongEq_L_subst2[where P = "(\<lambda>x. (\<delta> (x .weight)))" and \<tau> = "\<tau>" and x = "X" and y = "invalid"], simp add: foundation16' dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__weight_invalid) - apply(case_tac "\<tau> \<Turnstile> (X \<triangleq> null)", insert StrongEq_L_subst2[where P = "(\<lambda>x. (\<delta> (x .weight)))" and \<tau> = "\<tau>" and x = "X" and y = "null"], simp add: foundation16' dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__weight_null) -by(simp add: defined_split) -lemma defined_mono_dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__sound : "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Person) .sound)) \<Longrightarrow> \<tau> \<Turnstile> (\<delta> (X))" - apply(case_tac "\<tau> \<Turnstile> (X \<triangleq> invalid)", insert StrongEq_L_subst2[where P = "(\<lambda>x. (\<delta> (x .sound)))" and \<tau> = "\<tau>" and x = "X" and y = "invalid"], simp add: foundation16' dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__sound_invalid) - apply(case_tac "\<tau> \<Turnstile> (X \<triangleq> null)", insert StrongEq_L_subst2[where P = "(\<lambda>x. (\<delta> (x .sound)))" and \<tau> = "\<tau>" and x = "X" and y = "null"], simp add: foundation16' dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__sound_null) -by(simp add: defined_split) -lemma defined_mono_dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__moving : "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Person) .moving)) \<Longrightarrow> \<tau> \<Turnstile> (\<delta> (X))" - apply(case_tac "\<tau> \<Turnstile> (X \<triangleq> invalid)", insert StrongEq_L_subst2[where P = "(\<lambda>x. (\<delta> (x .moving)))" and \<tau> = "\<tau>" and x = "X" and y = "invalid"], simp add: foundation16' dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__moving_invalid) - apply(case_tac "\<tau> \<Turnstile> (X \<triangleq> null)", insert StrongEq_L_subst2[where P = "(\<lambda>x. (\<delta> (x .moving)))" and \<tau> = "\<tau>" and x = "X" and y = "null"], simp add: foundation16' dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__moving_null) -by(simp add: defined_split) -lemma defined_mono_dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__outer_world : "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Person) .outer_world)) \<Longrightarrow> \<tau> \<Turnstile> (\<delta> (X))" - apply(case_tac "\<tau> \<Turnstile> (X \<triangleq> invalid)", insert StrongEq_L_subst2[where P = "(\<lambda>x. (\<delta> (x .outer_world)))" and \<tau> = "\<tau>" and x = "X" and y = "invalid"], simp add: foundation16' dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__outer_world_invalid) - apply(case_tac "\<tau> \<Turnstile> (X \<triangleq> null)", insert StrongEq_L_subst2[where P = "(\<lambda>x. (\<delta> (x .outer_world)))" and \<tau> = "\<tau>" and x = "X" and y = "null"], simp add: foundation16' dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__outer_world_null) -by(simp add: defined_split) -lemma defined_mono_dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__wormholeat_pre : "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Person) .wormhole@pre)) \<Longrightarrow> \<tau> \<Turnstile> (\<delta> (X))" - apply(case_tac "\<tau> \<Turnstile> (X \<triangleq> invalid)", insert StrongEq_L_subst2[where P = "(\<lambda>x. (\<delta> (x .wormhole@pre)))" and \<tau> = "\<tau>" and x = "X" and y = "invalid"], simp add: foundation16' dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__wormholeat_pre_invalid) - apply(case_tac "\<tau> \<Turnstile> (X \<triangleq> null)", insert StrongEq_L_subst2[where P = "(\<lambda>x. (\<delta> (x .wormhole@pre)))" and \<tau> = "\<tau>" and x = "X" and y = "null"], simp add: foundation16' dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__wormholeat_pre_null) -by(simp add: defined_split) -lemma defined_mono_dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__weightat_pre : "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Person) .weight@pre)) \<Longrightarrow> \<tau> \<Turnstile> (\<delta> (X))" - apply(case_tac "\<tau> \<Turnstile> (X \<triangleq> invalid)", insert StrongEq_L_subst2[where P = "(\<lambda>x. (\<delta> (x .weight@pre)))" and \<tau> = "\<tau>" and x = "X" and y = "invalid"], simp add: foundation16' dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__weightat_pre_invalid) - apply(case_tac "\<tau> \<Turnstile> (X \<triangleq> null)", insert StrongEq_L_subst2[where P = "(\<lambda>x. (\<delta> (x .weight@pre)))" and \<tau> = "\<tau>" and x = "X" and y = "null"], simp add: foundation16' dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__weightat_pre_null) -by(simp add: defined_split) -lemma defined_mono_dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__soundat_pre : "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Person) .sound@pre)) \<Longrightarrow> \<tau> \<Turnstile> (\<delta> (X))" - apply(case_tac "\<tau> \<Turnstile> (X \<triangleq> invalid)", insert StrongEq_L_subst2[where P = "(\<lambda>x. (\<delta> (x .sound@pre)))" and \<tau> = "\<tau>" and x = "X" and y = "invalid"], simp add: foundation16' dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__soundat_pre_invalid) - apply(case_tac "\<tau> \<Turnstile> (X \<triangleq> null)", insert StrongEq_L_subst2[where P = "(\<lambda>x. (\<delta> (x .sound@pre)))" and \<tau> = "\<tau>" and x = "X" and y = "null"], simp add: foundation16' dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__soundat_pre_null) -by(simp add: defined_split) -lemma defined_mono_dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__movingat_pre : "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Person) .moving@pre)) \<Longrightarrow> \<tau> \<Turnstile> (\<delta> (X))" - apply(case_tac "\<tau> \<Turnstile> (X \<triangleq> invalid)", insert StrongEq_L_subst2[where P = "(\<lambda>x. (\<delta> (x .moving@pre)))" and \<tau> = "\<tau>" and x = "X" and y = "invalid"], simp add: foundation16' dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__movingat_pre_invalid) - apply(case_tac "\<tau> \<Turnstile> (X \<triangleq> null)", insert StrongEq_L_subst2[where P = "(\<lambda>x. (\<delta> (x .moving@pre)))" and \<tau> = "\<tau>" and x = "X" and y = "null"], simp add: foundation16' dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__movingat_pre_null) -by(simp add: defined_split) -lemma defined_mono_dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__outer_worldat_pre : "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Person) .outer_world@pre)) \<Longrightarrow> \<tau> \<Turnstile> (\<delta> (X))" - apply(case_tac "\<tau> \<Turnstile> (X \<triangleq> invalid)", insert StrongEq_L_subst2[where P = "(\<lambda>x. (\<delta> (x .outer_world@pre)))" and \<tau> = "\<tau>" and x = "X" and y = "invalid"], simp add: foundation16' dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__outer_worldat_pre_invalid) - apply(case_tac "\<tau> \<Turnstile> (X \<triangleq> null)", insert StrongEq_L_subst2[where P = "(\<lambda>x. (\<delta> (x .outer_world@pre)))" and \<tau> = "\<tau>" and x = "X" and y = "null"], simp add: foundation16' dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__outer_worldat_pre_null) -by(simp add: defined_split) -lemma defined_mono_dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__sound : "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Planet) .sound)) \<Longrightarrow> \<tau> \<Turnstile> (\<delta> (X))" - apply(case_tac "\<tau> \<Turnstile> (X \<triangleq> invalid)", insert StrongEq_L_subst2[where P = "(\<lambda>x. (\<delta> (x .sound)))" and \<tau> = "\<tau>" and x = "X" and y = "invalid"], simp add: foundation16' dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__sound_invalid) - apply(case_tac "\<tau> \<Turnstile> (X \<triangleq> null)", insert StrongEq_L_subst2[where P = "(\<lambda>x. (\<delta> (x .sound)))" and \<tau> = "\<tau>" and x = "X" and y = "null"], simp add: foundation16' dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__sound_null) -by(simp add: defined_split) -lemma defined_mono_dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__moving : "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Planet) .moving)) \<Longrightarrow> \<tau> \<Turnstile> (\<delta> (X))" - apply(case_tac "\<tau> \<Turnstile> (X \<triangleq> invalid)", insert StrongEq_L_subst2[where P = "(\<lambda>x. (\<delta> (x .moving)))" and \<tau> = "\<tau>" and x = "X" and y = "invalid"], simp add: foundation16' dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__moving_invalid) - apply(case_tac "\<tau> \<Turnstile> (X \<triangleq> null)", insert StrongEq_L_subst2[where P = "(\<lambda>x. (\<delta> (x .moving)))" and \<tau> = "\<tau>" and x = "X" and y = "null"], simp add: foundation16' dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__moving_null) -by(simp add: defined_split) -lemma defined_mono_dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__outer_world : "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Planet) .outer_world)) \<Longrightarrow> \<tau> \<Turnstile> (\<delta> (X))" - apply(case_tac "\<tau> \<Turnstile> (X \<triangleq> invalid)", insert StrongEq_L_subst2[where P = "(\<lambda>x. (\<delta> (x .outer_world)))" and \<tau> = "\<tau>" and x = "X" and y = "invalid"], simp add: foundation16' dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__outer_world_invalid) - apply(case_tac "\<tau> \<Turnstile> (X \<triangleq> null)", insert StrongEq_L_subst2[where P = "(\<lambda>x. (\<delta> (x .outer_world)))" and \<tau> = "\<tau>" and x = "X" and y = "null"], simp add: foundation16' dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__outer_world_null) -by(simp add: defined_split) -lemma defined_mono_dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__soundat_pre : "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Planet) .sound@pre)) \<Longrightarrow> \<tau> \<Turnstile> (\<delta> (X))" - apply(case_tac "\<tau> \<Turnstile> (X \<triangleq> invalid)", insert StrongEq_L_subst2[where P = "(\<lambda>x. (\<delta> (x .sound@pre)))" and \<tau> = "\<tau>" and x = "X" and y = "invalid"], simp add: foundation16' dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__soundat_pre_invalid) - apply(case_tac "\<tau> \<Turnstile> (X \<triangleq> null)", insert StrongEq_L_subst2[where P = "(\<lambda>x. (\<delta> (x .sound@pre)))" and \<tau> = "\<tau>" and x = "X" and y = "null"], simp add: foundation16' dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__soundat_pre_null) -by(simp add: defined_split) -lemma defined_mono_dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__movingat_pre : "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Planet) .moving@pre)) \<Longrightarrow> \<tau> \<Turnstile> (\<delta> (X))" - apply(case_tac "\<tau> \<Turnstile> (X \<triangleq> invalid)", insert StrongEq_L_subst2[where P = "(\<lambda>x. (\<delta> (x .moving@pre)))" and \<tau> = "\<tau>" and x = "X" and y = "invalid"], simp add: foundation16' dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__movingat_pre_invalid) - apply(case_tac "\<tau> \<Turnstile> (X \<triangleq> null)", insert StrongEq_L_subst2[where P = "(\<lambda>x. (\<delta> (x .moving@pre)))" and \<tau> = "\<tau>" and x = "X" and y = "null"], simp add: foundation16' dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__movingat_pre_null) -by(simp add: defined_split) -lemma defined_mono_dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__outer_worldat_pre : "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Planet) .outer_world@pre)) \<Longrightarrow> \<tau> \<Turnstile> (\<delta> (X))" - apply(case_tac "\<tau> \<Turnstile> (X \<triangleq> invalid)", insert StrongEq_L_subst2[where P = "(\<lambda>x. (\<delta> (x .outer_world@pre)))" and \<tau> = "\<tau>" and x = "X" and y = "invalid"], simp add: foundation16' dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__outer_worldat_pre_invalid) - apply(case_tac "\<tau> \<Turnstile> (X \<triangleq> null)", insert StrongEq_L_subst2[where P = "(\<lambda>x. (\<delta> (x .outer_world@pre)))" and \<tau> = "\<tau>" and x = "X" and y = "null"], simp add: foundation16' dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__outer_worldat_pre_null) -by(simp add: defined_split) - -(* 137 ************************************ 903 + 2 *) (* term Floor1_access.print_access_is_repr *) -lemma is_repr_dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_0___boss : -assumes def_dot: "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Person) .boss))" -shows "(is_represented_in_state (in_post_state) (X .boss) (Person) (\<tau>))" - apply(insert defined_mono_dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_0___boss[OF def_dot, simplified foundation16]) - apply(case_tac "(X (\<tau>))", simp add: bot_option_def) - proof - fix a0 show "(X (\<tau>)) = (Some (a0)) \<Longrightarrow> ?thesis" when "(X (\<tau>)) \<noteq> null" - apply(insert that, case_tac "a0", simp add: null_option_def bot_option_def, clarify) - proof - fix a show "(X (\<tau>)) = (Some ((Some (a)))) \<Longrightarrow> ?thesis" - apply(case_tac "(heap ((in_post_state (\<tau>))) ((oid_of (a))))", simp add: invalid_def bot_option_def) - apply(insert def_dot, simp add: dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_0___boss is_represented_in_state_def select\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__boss_def deref_oid\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_def in_post_state_def defined_def OclValid_def false_def true_def invalid_def bot_fun_def split: if_split_asm) - proof - fix b show "(X (\<tau>)) = (Some ((Some (a)))) \<Longrightarrow> (heap ((in_post_state (\<tau>))) ((oid_of (a)))) = (Some (b)) \<Longrightarrow> ?thesis" - apply(insert def_dot[simplified foundation16], auto simp: dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_0___boss is_represented_in_state_def deref_oid\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_def bot_option_def null_option_def) - apply(case_tac "b", simp_all add: invalid_def bot_option_def) - apply(simp add: deref_assocs\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_0___boss_def deref_assocs_def) - apply(case_tac "(assocs ((in_post_state (\<tau>))) (oid\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_0___boss))", simp add: invalid_def bot_option_def, simp add: select\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__boss_def) - proof - fix r typeoid let ?t = "(Some ((Some (r)))) \<in> (Some o OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_\<AA>) ` (ran ((heap ((in_post_state (\<tau>))))))" - let ?sel_any = "(select_object_any\<^sub>S\<^sub>e\<^sub>t ((deref_oid\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (in_post_state) (reconst_basetype))))" show "((?sel_any) (typeoid) (\<tau>)) = (Some ((Some (r)))) \<Longrightarrow> ?t" - proof - fix aa show "((?sel_any) (aa) (\<tau>)) = (Some ((Some (r)))) \<Longrightarrow> ?t" when "\<tau> \<Turnstile> (\<delta> (((?sel_any) (aa))))" - apply(insert that, drule select_object_any_exec\<^sub>S\<^sub>e\<^sub>t[simplified foundation22], erule exE) - proof - fix e show "?t" when "((?sel_any) (aa) (\<tau>)) = (Some ((Some (r))))" "((?sel_any) (aa) (\<tau>)) = (deref_oid\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (in_post_state) (reconst_basetype) (e) (\<tau>))" - apply(insert that, simp add: deref_oid\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_def) - apply(case_tac "(heap ((in_post_state (\<tau>))) (e))", simp add: invalid_def bot_option_def, simp) - proof - fix aaa show "(case aaa of (in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (obj)) \<Rightarrow> (reconst_basetype (obj) (\<tau>)) - | _ \<Rightarrow> (invalid (\<tau>))) = (Some ((Some (r)))) \<Longrightarrow> (heap ((in_post_state (\<tau>))) (e)) = (Some (aaa)) \<Longrightarrow> ?t" - apply(case_tac "aaa", auto simp: invalid_def bot_option_def image_def ran_def) - apply(rule exI[where x = "(in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (r))"], simp add: OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_\<AA>_def Let_def reconst_basetype_def split: if_split_asm) -by(rule) qed - apply_end((blast)+) - qed - apply_end(simp add: foundation16 bot_option_def null_option_def) - qed qed qed qed - apply_end(simp_all) - qed -lemma is_repr_dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_0___bossat_pre : -assumes def_dot: "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Person) .boss@pre))" -shows "(is_represented_in_state (in_pre_state) (X .boss@pre) (Person) (\<tau>))" - apply(insert defined_mono_dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_0___bossat_pre[OF def_dot, simplified foundation16]) - apply(case_tac "(X (\<tau>))", simp add: bot_option_def) - proof - fix a0 show "(X (\<tau>)) = (Some (a0)) \<Longrightarrow> ?thesis" when "(X (\<tau>)) \<noteq> null" - apply(insert that, case_tac "a0", simp add: null_option_def bot_option_def, clarify) - proof - fix a show "(X (\<tau>)) = (Some ((Some (a)))) \<Longrightarrow> ?thesis" - apply(case_tac "(heap ((in_pre_state (\<tau>))) ((oid_of (a))))", simp add: invalid_def bot_option_def) - apply(insert def_dot, simp add: dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_0___bossat_pre is_represented_in_state_def select\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__boss_def deref_oid\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_def in_pre_state_def defined_def OclValid_def false_def true_def invalid_def bot_fun_def split: if_split_asm) - proof - fix b show "(X (\<tau>)) = (Some ((Some (a)))) \<Longrightarrow> (heap ((in_pre_state (\<tau>))) ((oid_of (a)))) = (Some (b)) \<Longrightarrow> ?thesis" - apply(insert def_dot[simplified foundation16], auto simp: dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_0___bossat_pre is_represented_in_state_def deref_oid\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_def bot_option_def null_option_def) - apply(case_tac "b", simp_all add: invalid_def bot_option_def) - apply(simp add: deref_assocs\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_0___boss_def deref_assocs_def) - apply(case_tac "(assocs ((in_pre_state (\<tau>))) (oid\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_0___boss))", simp add: invalid_def bot_option_def, simp add: select\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__boss_def) - proof - fix r typeoid let ?t = "(Some ((Some (r)))) \<in> (Some o OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_\<AA>) ` (ran ((heap ((in_pre_state (\<tau>))))))" - let ?sel_any = "(select_object_any\<^sub>S\<^sub>e\<^sub>t ((deref_oid\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (in_pre_state) (reconst_basetype))))" show "((?sel_any) (typeoid) (\<tau>)) = (Some ((Some (r)))) \<Longrightarrow> ?t" - proof - fix aa show "((?sel_any) (aa) (\<tau>)) = (Some ((Some (r)))) \<Longrightarrow> ?t" when "\<tau> \<Turnstile> (\<delta> (((?sel_any) (aa))))" - apply(insert that, drule select_object_any_exec\<^sub>S\<^sub>e\<^sub>t[simplified foundation22], erule exE) - proof - fix e show "?t" when "((?sel_any) (aa) (\<tau>)) = (Some ((Some (r))))" "((?sel_any) (aa) (\<tau>)) = (deref_oid\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (in_pre_state) (reconst_basetype) (e) (\<tau>))" - apply(insert that, simp add: deref_oid\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_def) - apply(case_tac "(heap ((in_pre_state (\<tau>))) (e))", simp add: invalid_def bot_option_def, simp) - proof - fix aaa show "(case aaa of (in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (obj)) \<Rightarrow> (reconst_basetype (obj) (\<tau>)) - | _ \<Rightarrow> (invalid (\<tau>))) = (Some ((Some (r)))) \<Longrightarrow> (heap ((in_pre_state (\<tau>))) (e)) = (Some (aaa)) \<Longrightarrow> ?t" - apply(case_tac "aaa", auto simp: invalid_def bot_option_def image_def ran_def) - apply(rule exI[where x = "(in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (r))"], simp add: OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_\<AA>_def Let_def reconst_basetype_def split: if_split_asm) -by(rule) qed - apply_end((blast)+) - qed - apply_end(simp add: foundation16 bot_option_def null_option_def) - qed qed qed qed - apply_end(simp_all) - qed - -(* 138 ************************************ 905 + 0 *) (* term Floor1_access.print_access_repr_allinst *) - -(* 139 ************************************ 905 + 1 *) -section \<open>Class Model: Towards the Object Instances\<close> - -(* 140 ************************************ 906 + 1 *) -text \<open>\<close> - -(* 141 ************************************ 907 + 1 *) -text_raw \<open>\<close> - -(* 142 ************************************ 908 + 1 *) -text \<open> - -The example we are defining in this section comes from the \autoref{fig:Employee-AnalysisModel-UMLPart-generated-generatedeam1_system-states}. -\<close> - -(* 143 ************************************ 909 + 1 *) -text_raw \<open> -\begin{figure} -\includegraphics[width=\textwidth]{figures/pre-post.pdf} -\caption{(a) pre-state $\sigma_1$ and - (b) post-state $\sigma_1'$.} -\label{fig:Employee-AnalysisModel-UMLPart-generated-generatedeam1_system-states} -\end{figure} -\<close> - -(* 144 ************************************ 910 + 1 *) (* term Floor1_examp.print_examp_def_st_defs *) -lemmas [simp,code_unfold] = state.defs - const_ss - -(* 145 ************************************ 911 + 1 *) (* term Floor1_astype.print_astype_lemmas_id2 *) -lemmas[simp,code_unfold] = OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet - OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy - OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny - OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy - OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny - OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person - OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny - OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person - OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet - OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person - OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet - OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy - -(* 146 ************************************ 912 + 1 *) -section \<open>Instance\<close> - -(* 147 ************************************ 913 + 2 *) (* term Floor1_examp.print_examp_instance_defassoc_typecheck_var *) -definition "(typecheck_instance_bad_head_on_lhs_P1_X0_X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9_X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n8_X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7_X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6_X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5_X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4_X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3_X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2_X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1 (P1) (X0) (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9) (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n8) (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7) (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6) (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5) (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4) (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3) (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2) (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1)) = ()" -definition "typecheck_instance_extra_variables_on_rhs_P1_X0_X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9_X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n8_X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7_X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6_X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5_X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4_X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3_X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2_X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1 = (\<lambda>P1 X0 X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9 X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n8 X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7 X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6 X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5 X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4 X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3 X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2 X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1. (P1 , P1 , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7 , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7 , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2 , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2))" - -(* 148 ************************************ 915 + 11 *) (* term Floor1_examp.print_examp_instance_defassoc *) -definition "oid1 = 1" -definition "oid2 = 2" -definition "oid3 = 3" -definition "oid4 = 4" -definition "oid5 = 5" -definition "oid6 = 6" -definition "oid7 = 7" -definition "oid8 = 8" -definition "oid9 = 9" -definition "oid10 = 10" -definition "oid11 = 11" - -(* 149 ************************************ 926 + 22 *) (* term Floor1_examp.print_examp_instance *) -definition "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n = (mk\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n ((mk\<E>\<X>\<T>\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (oid1) (None) (None) (None) (None) (None))) (\<lfloor>1300\<rfloor>))" -definition "(X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1::\<cdot>Person) = ((\<lambda>_. \<lfloor>\<lfloor>X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>))" -definition "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n = (mk\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n ((mk\<E>\<X>\<T>\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (oid2) (None) (None) (None) (None) (None))) (\<lfloor>1800\<rfloor>))" -definition "(X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2::\<cdot>Person) = ((\<lambda>_. \<lfloor>\<lfloor>X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>))" -definition "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n = (mk\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n ((mk\<E>\<X>\<T>\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (oid3) (None) (None) (None) (None) (None))) (None))" -definition "(X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3::\<cdot>Person) = ((\<lambda>_. \<lfloor>\<lfloor>X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>))" -definition "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n = (mk\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n ((mk\<E>\<X>\<T>\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (oid4) (None) (None) (None) (None) (None))) (\<lfloor>2900\<rfloor>))" -definition "(X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4::\<cdot>Person) = ((\<lambda>_. \<lfloor>\<lfloor>X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>))" -definition "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n = (mk\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n ((mk\<E>\<X>\<T>\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (oid5) (None) (None) (None) (None) (None))) (\<lfloor>3500\<rfloor>))" -definition "(X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5::\<cdot>Person) = ((\<lambda>_. \<lfloor>\<lfloor>X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>))" -definition "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n = (mk\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n ((mk\<E>\<X>\<T>\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (oid6) (None) (None) (None) (None) (None))) (\<lfloor>2500\<rfloor>))" -definition "(X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6::\<cdot>Person) = ((\<lambda>_. \<lfloor>\<lfloor>X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>))" -definition "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y = (mk\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n ((mk\<E>\<X>\<T>\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (oid7) (None) (None) (None) (None) (None))) (\<lfloor>3200\<rfloor>))" -definition "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7 = ((((\<lambda>_. \<lfloor>\<lfloor>X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y\<rfloor>\<rfloor>)::\<cdot>Person)) .oclAsType(OclAny))" -definition "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n8\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y = (mk\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y ((mk\<E>\<X>\<T>\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y (oid8))))" -definition "(X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n8::\<cdot>OclAny) = ((\<lambda>_. \<lfloor>\<lfloor>X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n8\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y\<rfloor>\<rfloor>))" -definition "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n = (mk\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n ((mk\<E>\<X>\<T>\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (oid9) (None) (None) (None) (None) (None))) (\<lfloor>0\<rfloor>))" -definition "(X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9::\<cdot>Person) = ((\<lambda>_. \<lfloor>\<lfloor>X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>))" -definition "X0\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n = (mk\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n ((mk\<E>\<X>\<T>\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (oid10) (None) (None) (None) (None) (\<lfloor>[[oid11]]\<rfloor>))) (None))" -definition "(X0::\<cdot>Person) = ((\<lambda>_. \<lfloor>\<lfloor>X0\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>))" -definition "P1\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t = (mk\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t ((mk\<E>\<X>\<T>\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (oid11) (None) (None) (\<lfloor>[[oid11] , [oid11]]\<rfloor>))) (None) (None))" -definition "(P1::\<cdot>Planet) = ((\<lambda>_. \<lfloor>\<lfloor>P1\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t\<rfloor>\<rfloor>))" - -(* 150 ************************************ 948 + 1 *) (* term Floor1_examp.print_examp_instance_defassoc_typecheck *) -ML \<open>(Ty'.check ([(META.Writeln , "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1 .boss \<cong> Set{ X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2 }") , (META.Writeln , "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1 /* unnamed attribute */ \<cong> Set{}") , (META.Writeln , "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2 .boss \<cong> Set{ X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2 }") , (META.Writeln , "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2 /* unnamed attribute */ \<cong> Set{ X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1 , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2 }") , (META.Writeln , "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3 .boss \<cong> Set{}") , (META.Writeln , "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3 /* unnamed attribute */ \<cong> Set{}") , (META.Writeln , "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4 .boss \<cong> Set{}") , (META.Writeln , "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4 /* unnamed attribute */ \<cong> Set{}") , (META.Writeln , "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5 .boss \<cong> Set{}") , (META.Writeln , "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5 /* unnamed attribute */ \<cong> Set{}") , (META.Writeln , "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6 .boss \<cong> Set{ X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7 }") , (META.Writeln , "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6 /* unnamed attribute */ \<cong> Set{}") , (META.Writeln , "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7 .boss \<cong> Set{ X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7 }") , (META.Writeln , "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7 /* unnamed attribute */ \<cong> Set{ X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6 , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7 }") , (META.Writeln , "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9 .boss \<cong> Set{}") , (META.Writeln , "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9 /* unnamed attribute */ \<cong> Set{}") , (META.Writeln , "X0 .boss \<cong> Set{}") , (META.Writeln , "X0 /* unnamed attribute */ \<cong> Set{}")]) (" error(s)"))\<close> - -(* 151 ************************************ 949 + 1 *) -section \<open>Instance\<close> - -(* 152 ************************************ 950 + 2 *) (* term Floor1_examp.print_examp_instance_defassoc_typecheck_var *) -definition "(typecheck_instance_bad_head_on_lhs_\<sigma>\<^sub>1_object4_\<sigma>\<^sub>1_object2_\<sigma>\<^sub>1_object1_\<sigma>\<^sub>1_object0 (\<sigma>\<^sub>1_object4) (\<sigma>\<^sub>1_object2) (\<sigma>\<^sub>1_object1) (\<sigma>\<^sub>1_object0)) = ()" -definition "typecheck_instance_extra_variables_on_rhs_\<sigma>\<^sub>1_object4_\<sigma>\<^sub>1_object2_\<sigma>\<^sub>1_object1_\<sigma>\<^sub>1_object0 = (\<lambda>\<sigma>\<^sub>1_object4 \<sigma>\<^sub>1_object2 \<sigma>\<^sub>1_object1 \<sigma>\<^sub>1_object0. (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6 , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4 , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5 , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2 , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1))" - -(* 153 ************************************ 952 + 0 *) (* term Floor1_examp.print_examp_instance_defassoc *) - -(* 154 ************************************ 952 + 8 *) (* term Floor1_examp.print_examp_instance *) -definition "\<sigma>\<^sub>1_object0\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n = (mk\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n ((mk\<E>\<X>\<T>\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (oid1) (None) (None) (None) (None) (None))) (\<lfloor>1000\<rfloor>))" -definition "(\<sigma>\<^sub>1_object0::\<cdot>Person) = ((\<lambda>_. \<lfloor>\<lfloor>\<sigma>\<^sub>1_object0\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>))" -definition "\<sigma>\<^sub>1_object1\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n = (mk\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n ((mk\<E>\<X>\<T>\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (oid2) (None) (None) (None) (None) (None))) (\<lfloor>1200\<rfloor>))" -definition "(\<sigma>\<^sub>1_object1::\<cdot>Person) = ((\<lambda>_. \<lfloor>\<lfloor>\<sigma>\<^sub>1_object1\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>))" -definition "\<sigma>\<^sub>1_object2\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n = (mk\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n ((mk\<E>\<X>\<T>\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (oid4) (None) (None) (None) (None) (None))) (\<lfloor>2600\<rfloor>))" -definition "(\<sigma>\<^sub>1_object2::\<cdot>Person) = ((\<lambda>_. \<lfloor>\<lfloor>\<sigma>\<^sub>1_object2\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>))" -definition "\<sigma>\<^sub>1_object4\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n = (mk\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n ((mk\<E>\<X>\<T>\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (oid6) (None) (None) (None) (None) (None))) (\<lfloor>2300\<rfloor>))" -definition "(\<sigma>\<^sub>1_object4::\<cdot>Person) = ((\<lambda>_. \<lfloor>\<lfloor>\<sigma>\<^sub>1_object4\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>))" - -(* 155 ************************************ 960 + 1 *) (* term Floor1_examp.print_examp_instance_defassoc_typecheck *) -ML \<open>(Ty'.check ([(META.Writeln , "\<sigma>\<^sub>1_object0 .boss \<cong> Set{ \<sigma>\<^sub>1_object1 }") , (META.Writeln , "\<sigma>\<^sub>1_object0 /* unnamed attribute */ \<cong> Set{}") , (META.Writeln , "\<sigma>\<^sub>1_object1 .boss \<cong> Set{}") , (META.Writeln , "\<sigma>\<^sub>1_object1 /* unnamed attribute */ \<cong> Set{ \<sigma>\<^sub>1_object0 }") , (META.Writeln , "\<sigma>\<^sub>1_object2 .boss \<cong> Set{ /*5*/ }") , (META.Writeln , "\<sigma>\<^sub>1_object2 /* unnamed attribute */ \<cong> Set{ \<sigma>\<^sub>1_object4 }") , (META.Writeln , "\<sigma>\<^sub>1_object4 .boss \<cong> Set{ \<sigma>\<^sub>1_object2 }") , (META.Writeln , "\<sigma>\<^sub>1_object4 /* unnamed attribute */ \<cong> Set{}")]) (" error(s)"))\<close> - -(* 156 ************************************ 961 + 1 *) -section \<open>State (Floor 2)\<close> - -(* 157 ************************************ 962 + 1 *) -locale state_\<sigma>\<^sub>1 = -fixes "oid1" :: "nat" -fixes "oid2" :: "nat" -fixes "oid4" :: "nat" -fixes "oid5" :: "nat" -fixes "oid6" :: "nat" -fixes "oid9" :: "nat" -assumes distinct_oid: "(distinct ([oid1 , oid2 , oid4 , oid5 , oid6 , oid9]))" -fixes "\<sigma>\<^sub>1_object0\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n" :: "ty\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n" -fixes "\<sigma>\<^sub>1_object0" :: "\<cdot>Person" -assumes \<sigma>\<^sub>1_object0_def: "\<sigma>\<^sub>1_object0 = (\<lambda>_. \<lfloor>\<lfloor>\<sigma>\<^sub>1_object0\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)" -fixes "\<sigma>\<^sub>1_object1\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n" :: "ty\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n" -fixes "\<sigma>\<^sub>1_object1" :: "\<cdot>Person" -assumes \<sigma>\<^sub>1_object1_def: "\<sigma>\<^sub>1_object1 = (\<lambda>_. \<lfloor>\<lfloor>\<sigma>\<^sub>1_object1\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)" -fixes "\<sigma>\<^sub>1_object2\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n" :: "ty\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n" -fixes "\<sigma>\<^sub>1_object2" :: "\<cdot>Person" -assumes \<sigma>\<^sub>1_object2_def: "\<sigma>\<^sub>1_object2 = (\<lambda>_. \<lfloor>\<lfloor>\<sigma>\<^sub>1_object2\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)" -fixes "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n" :: "ty\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n" -fixes "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5" :: "\<cdot>Person" -assumes X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5_def: "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5 = (\<lambda>_. \<lfloor>\<lfloor>X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)" -fixes "\<sigma>\<^sub>1_object4\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n" :: "ty\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n" -fixes "\<sigma>\<^sub>1_object4" :: "\<cdot>Person" -assumes \<sigma>\<^sub>1_object4_def: "\<sigma>\<^sub>1_object4 = (\<lambda>_. \<lfloor>\<lfloor>\<sigma>\<^sub>1_object4\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)" -fixes "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n" :: "ty\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n" -fixes "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9" :: "\<cdot>Person" -assumes X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9_def: "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9 = (\<lambda>_. \<lfloor>\<lfloor>X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)" -begin -definition "\<sigma>\<^sub>1 = (state.make ((Map.empty (oid1 \<mapsto> (in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (\<sigma>\<^sub>1_object0\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))) (oid2 \<mapsto> (in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (\<sigma>\<^sub>1_object1\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))) (oid4 \<mapsto> (in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (\<sigma>\<^sub>1_object2\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))) (oid5 \<mapsto> (in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))) (oid6 \<mapsto> (in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (\<sigma>\<^sub>1_object4\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))) (oid9 \<mapsto> (in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))))) ((map_of_list ([(oid\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_0___boss , (List.map ((\<lambda>(x , y). [x , y]) o switch\<^sub>2_01) ([[[oid1] , [oid2]] , [[oid4] , [oid5]] , [[oid6] , [oid4]]])))]))))" - -lemma dom_\<sigma>\<^sub>1 : "(dom ((heap (\<sigma>\<^sub>1)))) = {oid1 , oid2 , oid4 , oid5 , oid6 , oid9}" -by(auto simp: \<sigma>\<^sub>1_def) - -lemmas[simp,code_unfold] = dom_\<sigma>\<^sub>1 - -lemma perm_\<sigma>\<^sub>1 : "\<sigma>\<^sub>1 = (state.make ((Map.empty (oid9 \<mapsto> (in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))) (oid6 \<mapsto> (in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (\<sigma>\<^sub>1_object4\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))) (oid5 \<mapsto> (in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))) (oid4 \<mapsto> (in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (\<sigma>\<^sub>1_object2\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))) (oid2 \<mapsto> (in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (\<sigma>\<^sub>1_object1\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))) (oid1 \<mapsto> (in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (\<sigma>\<^sub>1_object0\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))))) ((assocs (\<sigma>\<^sub>1))))" - apply(simp add: \<sigma>\<^sub>1_def) - apply(subst (1) fun_upd_twist, metis distinct_oid distinct_length_2_or_more) - apply(subst (2) fun_upd_twist, metis distinct_oid distinct_length_2_or_more) - apply(subst (1) fun_upd_twist, metis distinct_oid distinct_length_2_or_more) - apply(subst (3) fun_upd_twist, metis distinct_oid distinct_length_2_or_more) - apply(subst (2) fun_upd_twist, metis distinct_oid distinct_length_2_or_more) - apply(subst (1) fun_upd_twist, metis distinct_oid distinct_length_2_or_more) - apply(subst (4) fun_upd_twist, metis distinct_oid distinct_length_2_or_more) - apply(subst (3) fun_upd_twist, metis distinct_oid distinct_length_2_or_more) - apply(subst (2) fun_upd_twist, metis distinct_oid distinct_length_2_or_more) - apply(subst (1) fun_upd_twist, metis distinct_oid distinct_length_2_or_more) - apply(subst (5) fun_upd_twist, metis distinct_oid distinct_length_2_or_more) - apply(subst (4) fun_upd_twist, metis distinct_oid distinct_length_2_or_more) - apply(subst (3) fun_upd_twist, metis distinct_oid distinct_length_2_or_more) - apply(subst (2) fun_upd_twist, metis distinct_oid distinct_length_2_or_more) - apply(subst (1) fun_upd_twist, metis distinct_oid distinct_length_2_or_more) -by(simp) - -lemma \<sigma>\<^sub>1_OclAllInstances_generic_exec_Person : -assumes [simp]: "(Person ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (\<sigma>\<^sub>1_object0\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(Person ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (\<sigma>\<^sub>1_object1\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(Person ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (\<sigma>\<^sub>1_object2\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(Person ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(Person ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (\<sigma>\<^sub>1_object4\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(Person ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(\<And>a. (pre_post ((mk (a)))) = a)" -shows "(mk (\<sigma>\<^sub>1)) \<Turnstile> (OclAllInstances_generic (pre_post) (Person)) \<doteq> Set{\<sigma>\<^sub>1_object0 , \<sigma>\<^sub>1_object1 , \<sigma>\<^sub>1_object2 , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5 , \<sigma>\<^sub>1_object4 , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9}" - apply(subst perm_\<sigma>\<^sub>1) - apply(simp only: state.make_def \<sigma>\<^sub>1_object0_def \<sigma>\<^sub>1_object1_def \<sigma>\<^sub>1_object2_def X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5_def \<sigma>\<^sub>1_object4_def X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9_def) - apply(subst state_update_vs_allInstances_generic_tc, simp, simp, (metis distinct_oid distinct_length_2_or_more)?, simp only: assms, blast, simp, rule const_StrictRefEq\<^sub>S\<^sub>e\<^sub>t_including, simp, simp, simp, rule OclIncluding_cong, (simp only: assms[symmetric ])?, simp add: valid_def OclValid_def bot_fun_def bot_option_def, (simp only: assms[symmetric ])?, simp add: valid_def OclValid_def bot_fun_def bot_option_def) - apply(subst state_update_vs_allInstances_generic_tc, simp, simp, (metis distinct_oid distinct_length_2_or_more)?, simp only: assms, blast, simp, rule const_StrictRefEq\<^sub>S\<^sub>e\<^sub>t_including, simp, simp, simp, rule OclIncluding_cong, (simp only: assms[symmetric ])?, simp add: valid_def OclValid_def bot_fun_def bot_option_def, (simp only: assms[symmetric ])?, simp add: valid_def OclValid_def bot_fun_def bot_option_def) - apply(subst state_update_vs_allInstances_generic_tc, simp, simp, (metis distinct_oid distinct_length_2_or_more)?, simp only: assms, blast, simp, rule const_StrictRefEq\<^sub>S\<^sub>e\<^sub>t_including, simp, simp, simp, rule OclIncluding_cong, (simp only: assms[symmetric ])?, simp add: valid_def OclValid_def bot_fun_def bot_option_def, (simp only: assms[symmetric ])?, simp add: valid_def OclValid_def bot_fun_def bot_option_def) - apply(subst state_update_vs_allInstances_generic_tc, simp, simp, (metis distinct_oid distinct_length_2_or_more)?, simp only: assms, blast, simp, rule const_StrictRefEq\<^sub>S\<^sub>e\<^sub>t_including, simp, simp, simp, rule OclIncluding_cong, (simp only: assms[symmetric ])?, simp add: valid_def OclValid_def bot_fun_def bot_option_def, (simp only: assms[symmetric ])?, simp add: valid_def OclValid_def bot_fun_def bot_option_def) - apply(subst state_update_vs_allInstances_generic_tc, simp, simp, (metis distinct_oid distinct_length_2_or_more)?, simp only: assms, blast, simp, rule const_StrictRefEq\<^sub>S\<^sub>e\<^sub>t_including, simp, simp, simp, rule OclIncluding_cong, (simp only: assms[symmetric ])?, simp add: valid_def OclValid_def bot_fun_def bot_option_def, (simp only: assms[symmetric ])?, simp add: valid_def OclValid_def bot_fun_def bot_option_def) - apply(subst state_update_vs_allInstances_generic_tc, simp, simp, (metis distinct_oid distinct_length_2_or_more)?, simp only: assms, blast, simp, rule const_StrictRefEq\<^sub>S\<^sub>e\<^sub>t_including, simp, simp, simp, rule OclIncluding_cong, (simp only: assms[symmetric ])?, simp add: valid_def OclValid_def bot_fun_def bot_option_def, (simp only: assms[symmetric ])?, simp add: valid_def OclValid_def bot_fun_def bot_option_def) - apply(rule state_update_vs_allInstances_generic_empty) -by(simp_all only: assms, (simp_all add: OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_\<AA>_def)?) - -lemma \<sigma>\<^sub>1_OclAllInstances_at_post_exec_Person : -assumes [simp]: "(Person ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (\<sigma>\<^sub>1_object0\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(Person ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (\<sigma>\<^sub>1_object1\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(Person ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (\<sigma>\<^sub>1_object2\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(Person ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(Person ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (\<sigma>\<^sub>1_object4\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(Person ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -shows "(st , \<sigma>\<^sub>1) \<Turnstile> (OclAllInstances_at_post (Person)) \<doteq> Set{\<sigma>\<^sub>1_object0 , \<sigma>\<^sub>1_object1 , \<sigma>\<^sub>1_object2 , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5 , \<sigma>\<^sub>1_object4 , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9}" - unfolding OclAllInstances_at_post_def -by(rule \<sigma>\<^sub>1_OclAllInstances_generic_exec_Person, simp_all only: assms, simp_all) - -lemma \<sigma>\<^sub>1_OclAllInstances_at_pre_exec_Person : -assumes [simp]: "(Person ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (\<sigma>\<^sub>1_object0\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(Person ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (\<sigma>\<^sub>1_object1\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(Person ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (\<sigma>\<^sub>1_object2\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(Person ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(Person ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (\<sigma>\<^sub>1_object4\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(Person ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -shows "(\<sigma>\<^sub>1 , st) \<Turnstile> (OclAllInstances_at_pre (Person)) \<doteq> Set{\<sigma>\<^sub>1_object0 , \<sigma>\<^sub>1_object1 , \<sigma>\<^sub>1_object2 , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5 , \<sigma>\<^sub>1_object4 , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9}" - unfolding OclAllInstances_at_pre_def -by(rule \<sigma>\<^sub>1_OclAllInstances_generic_exec_Person, simp_all only: assms, simp_all) - -lemma \<sigma>\<^sub>1_OclAllInstances_generic_exec_Planet : -assumes [simp]: "(Planet ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (\<sigma>\<^sub>1_object0\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(Planet ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (\<sigma>\<^sub>1_object1\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(Planet ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (\<sigma>\<^sub>1_object2\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(Planet ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(Planet ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (\<sigma>\<^sub>1_object4\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(Planet ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(\<lambda>_. \<lfloor>(Planet ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (\<sigma>\<^sub>1_object0\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))))\<rfloor>) = ((((\<lambda>_. \<lfloor>\<lfloor>\<sigma>\<^sub>1_object0\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)::\<cdot>Person)) .oclAsType(Planet))" -assumes [simp]: "(\<lambda>_. \<lfloor>(Planet ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (\<sigma>\<^sub>1_object1\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))))\<rfloor>) = ((((\<lambda>_. \<lfloor>\<lfloor>\<sigma>\<^sub>1_object1\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)::\<cdot>Person)) .oclAsType(Planet))" -assumes [simp]: "(\<lambda>_. \<lfloor>(Planet ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (\<sigma>\<^sub>1_object2\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))))\<rfloor>) = ((((\<lambda>_. \<lfloor>\<lfloor>\<sigma>\<^sub>1_object2\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)::\<cdot>Person)) .oclAsType(Planet))" -assumes [simp]: "(\<lambda>_. \<lfloor>(Planet ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))))\<rfloor>) = ((((\<lambda>_. \<lfloor>\<lfloor>X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)::\<cdot>Person)) .oclAsType(Planet))" -assumes [simp]: "(\<lambda>_. \<lfloor>(Planet ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (\<sigma>\<^sub>1_object4\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))))\<rfloor>) = ((((\<lambda>_. \<lfloor>\<lfloor>\<sigma>\<^sub>1_object4\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)::\<cdot>Person)) .oclAsType(Planet))" -assumes [simp]: "(\<lambda>_. \<lfloor>(Planet ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))))\<rfloor>) = ((((\<lambda>_. \<lfloor>\<lfloor>X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)::\<cdot>Person)) .oclAsType(Planet))" -assumes [simp]: "(\<And>a. (pre_post ((mk (a)))) = a)" -shows "(mk (\<sigma>\<^sub>1)) \<Turnstile> (OclAllInstances_generic (pre_post) (Planet)) \<doteq> Set{\<sigma>\<^sub>1_object0 .oclAsType(Planet) , \<sigma>\<^sub>1_object1 .oclAsType(Planet) , \<sigma>\<^sub>1_object2 .oclAsType(Planet) , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5 .oclAsType(Planet) , \<sigma>\<^sub>1_object4 .oclAsType(Planet) , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9 .oclAsType(Planet)}" - apply(subst perm_\<sigma>\<^sub>1) - apply(simp only: state.make_def \<sigma>\<^sub>1_object0_def \<sigma>\<^sub>1_object1_def \<sigma>\<^sub>1_object2_def X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5_def \<sigma>\<^sub>1_object4_def X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9_def) - apply(subst state_update_vs_allInstances_generic_tc, simp, simp, (metis distinct_oid distinct_length_2_or_more)?, simp only: assms, blast, simp, rule const_StrictRefEq\<^sub>S\<^sub>e\<^sub>t_including, simp del: OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person, simp del: OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person, simp, rule OclIncluding_cong, (simp only: assms[symmetric ])?, simp add: valid_def OclValid_def bot_fun_def bot_option_def, (simp only: assms[symmetric ])?, simp add: valid_def OclValid_def bot_fun_def bot_option_def) - apply(subst state_update_vs_allInstances_generic_tc, simp, simp, (metis distinct_oid distinct_length_2_or_more)?, simp only: assms, blast, simp, rule const_StrictRefEq\<^sub>S\<^sub>e\<^sub>t_including, simp del: OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person, simp del: OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person, simp, rule OclIncluding_cong, (simp only: assms[symmetric ])?, simp add: valid_def OclValid_def bot_fun_def bot_option_def, (simp only: assms[symmetric ])?, simp add: valid_def OclValid_def bot_fun_def bot_option_def) - apply(subst state_update_vs_allInstances_generic_tc, simp, simp, (metis distinct_oid distinct_length_2_or_more)?, simp only: assms, blast, simp, rule const_StrictRefEq\<^sub>S\<^sub>e\<^sub>t_including, simp del: OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person, simp del: OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person, simp, rule OclIncluding_cong, (simp only: assms[symmetric ])?, simp add: valid_def OclValid_def bot_fun_def bot_option_def, (simp only: assms[symmetric ])?, simp add: valid_def OclValid_def bot_fun_def bot_option_def) - apply(subst state_update_vs_allInstances_generic_tc, simp, simp, (metis distinct_oid distinct_length_2_or_more)?, simp only: assms, blast, simp, rule const_StrictRefEq\<^sub>S\<^sub>e\<^sub>t_including, simp del: OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person, simp del: OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person, simp, rule OclIncluding_cong, (simp only: assms[symmetric ])?, simp add: valid_def OclValid_def bot_fun_def bot_option_def, (simp only: assms[symmetric ])?, simp add: valid_def OclValid_def bot_fun_def bot_option_def) - apply(subst state_update_vs_allInstances_generic_tc, simp, simp, (metis distinct_oid distinct_length_2_or_more)?, simp only: assms, blast, simp, rule const_StrictRefEq\<^sub>S\<^sub>e\<^sub>t_including, simp del: OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person, simp del: OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person, simp, rule OclIncluding_cong, (simp only: assms[symmetric ])?, simp add: valid_def OclValid_def bot_fun_def bot_option_def, (simp only: assms[symmetric ])?, simp add: valid_def OclValid_def bot_fun_def bot_option_def) - apply(subst state_update_vs_allInstances_generic_tc, simp, simp, (metis distinct_oid distinct_length_2_or_more)?, simp only: assms, blast, simp, rule const_StrictRefEq\<^sub>S\<^sub>e\<^sub>t_including, simp del: OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person, simp del: OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person, simp, rule OclIncluding_cong, (simp only: assms[symmetric ])?, simp add: valid_def OclValid_def bot_fun_def bot_option_def, (simp only: assms[symmetric ])?, simp add: valid_def OclValid_def bot_fun_def bot_option_def) - apply(rule state_update_vs_allInstances_generic_empty) -by(simp_all only: assms, (simp_all add: OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_\<AA>_def)?) - -lemma \<sigma>\<^sub>1_OclAllInstances_at_post_exec_Planet : -assumes [simp]: "(Planet ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (\<sigma>\<^sub>1_object0\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(Planet ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (\<sigma>\<^sub>1_object1\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(Planet ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (\<sigma>\<^sub>1_object2\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(Planet ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(Planet ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (\<sigma>\<^sub>1_object4\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(Planet ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(\<lambda>_. \<lfloor>(Planet ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (\<sigma>\<^sub>1_object0\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))))\<rfloor>) = ((((\<lambda>_. \<lfloor>\<lfloor>\<sigma>\<^sub>1_object0\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)::\<cdot>Person)) .oclAsType(Planet))" -assumes [simp]: "(\<lambda>_. \<lfloor>(Planet ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (\<sigma>\<^sub>1_object1\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))))\<rfloor>) = ((((\<lambda>_. \<lfloor>\<lfloor>\<sigma>\<^sub>1_object1\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)::\<cdot>Person)) .oclAsType(Planet))" -assumes [simp]: "(\<lambda>_. \<lfloor>(Planet ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (\<sigma>\<^sub>1_object2\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))))\<rfloor>) = ((((\<lambda>_. \<lfloor>\<lfloor>\<sigma>\<^sub>1_object2\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)::\<cdot>Person)) .oclAsType(Planet))" -assumes [simp]: "(\<lambda>_. \<lfloor>(Planet ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))))\<rfloor>) = ((((\<lambda>_. \<lfloor>\<lfloor>X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)::\<cdot>Person)) .oclAsType(Planet))" -assumes [simp]: "(\<lambda>_. \<lfloor>(Planet ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (\<sigma>\<^sub>1_object4\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))))\<rfloor>) = ((((\<lambda>_. \<lfloor>\<lfloor>\<sigma>\<^sub>1_object4\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)::\<cdot>Person)) .oclAsType(Planet))" -assumes [simp]: "(\<lambda>_. \<lfloor>(Planet ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))))\<rfloor>) = ((((\<lambda>_. \<lfloor>\<lfloor>X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)::\<cdot>Person)) .oclAsType(Planet))" -shows "(st , \<sigma>\<^sub>1) \<Turnstile> (OclAllInstances_at_post (Planet)) \<doteq> Set{\<sigma>\<^sub>1_object0 .oclAsType(Planet) , \<sigma>\<^sub>1_object1 .oclAsType(Planet) , \<sigma>\<^sub>1_object2 .oclAsType(Planet) , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5 .oclAsType(Planet) , \<sigma>\<^sub>1_object4 .oclAsType(Planet) , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9 .oclAsType(Planet)}" - unfolding OclAllInstances_at_post_def -by(rule \<sigma>\<^sub>1_OclAllInstances_generic_exec_Planet, simp_all only: assms, simp_all) - -lemma \<sigma>\<^sub>1_OclAllInstances_at_pre_exec_Planet : -assumes [simp]: "(Planet ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (\<sigma>\<^sub>1_object0\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(Planet ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (\<sigma>\<^sub>1_object1\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(Planet ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (\<sigma>\<^sub>1_object2\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(Planet ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(Planet ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (\<sigma>\<^sub>1_object4\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(Planet ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(\<lambda>_. \<lfloor>(Planet ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (\<sigma>\<^sub>1_object0\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))))\<rfloor>) = ((((\<lambda>_. \<lfloor>\<lfloor>\<sigma>\<^sub>1_object0\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)::\<cdot>Person)) .oclAsType(Planet))" -assumes [simp]: "(\<lambda>_. \<lfloor>(Planet ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (\<sigma>\<^sub>1_object1\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))))\<rfloor>) = ((((\<lambda>_. \<lfloor>\<lfloor>\<sigma>\<^sub>1_object1\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)::\<cdot>Person)) .oclAsType(Planet))" -assumes [simp]: "(\<lambda>_. \<lfloor>(Planet ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (\<sigma>\<^sub>1_object2\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))))\<rfloor>) = ((((\<lambda>_. \<lfloor>\<lfloor>\<sigma>\<^sub>1_object2\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)::\<cdot>Person)) .oclAsType(Planet))" -assumes [simp]: "(\<lambda>_. \<lfloor>(Planet ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))))\<rfloor>) = ((((\<lambda>_. \<lfloor>\<lfloor>X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)::\<cdot>Person)) .oclAsType(Planet))" -assumes [simp]: "(\<lambda>_. \<lfloor>(Planet ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (\<sigma>\<^sub>1_object4\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))))\<rfloor>) = ((((\<lambda>_. \<lfloor>\<lfloor>\<sigma>\<^sub>1_object4\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)::\<cdot>Person)) .oclAsType(Planet))" -assumes [simp]: "(\<lambda>_. \<lfloor>(Planet ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))))\<rfloor>) = ((((\<lambda>_. \<lfloor>\<lfloor>X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)::\<cdot>Person)) .oclAsType(Planet))" -shows "(\<sigma>\<^sub>1 , st) \<Turnstile> (OclAllInstances_at_pre (Planet)) \<doteq> Set{\<sigma>\<^sub>1_object0 .oclAsType(Planet) , \<sigma>\<^sub>1_object1 .oclAsType(Planet) , \<sigma>\<^sub>1_object2 .oclAsType(Planet) , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5 .oclAsType(Planet) , \<sigma>\<^sub>1_object4 .oclAsType(Planet) , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9 .oclAsType(Planet)}" - unfolding OclAllInstances_at_pre_def -by(rule \<sigma>\<^sub>1_OclAllInstances_generic_exec_Planet, simp_all only: assms, simp_all) - -lemma \<sigma>\<^sub>1_OclAllInstances_generic_exec_Galaxy : -assumes [simp]: "(Galaxy ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (\<sigma>\<^sub>1_object0\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(Galaxy ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (\<sigma>\<^sub>1_object1\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(Galaxy ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (\<sigma>\<^sub>1_object2\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(Galaxy ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(Galaxy ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (\<sigma>\<^sub>1_object4\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(Galaxy ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(\<lambda>_. \<lfloor>(Galaxy ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (\<sigma>\<^sub>1_object0\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))))\<rfloor>) = ((((\<lambda>_. \<lfloor>\<lfloor>\<sigma>\<^sub>1_object0\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)::\<cdot>Person)) .oclAsType(Galaxy))" -assumes [simp]: "(\<lambda>_. \<lfloor>(Galaxy ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (\<sigma>\<^sub>1_object1\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))))\<rfloor>) = ((((\<lambda>_. \<lfloor>\<lfloor>\<sigma>\<^sub>1_object1\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)::\<cdot>Person)) .oclAsType(Galaxy))" -assumes [simp]: "(\<lambda>_. \<lfloor>(Galaxy ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (\<sigma>\<^sub>1_object2\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))))\<rfloor>) = ((((\<lambda>_. \<lfloor>\<lfloor>\<sigma>\<^sub>1_object2\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)::\<cdot>Person)) .oclAsType(Galaxy))" -assumes [simp]: "(\<lambda>_. \<lfloor>(Galaxy ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))))\<rfloor>) = ((((\<lambda>_. \<lfloor>\<lfloor>X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)::\<cdot>Person)) .oclAsType(Galaxy))" -assumes [simp]: "(\<lambda>_. \<lfloor>(Galaxy ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (\<sigma>\<^sub>1_object4\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))))\<rfloor>) = ((((\<lambda>_. \<lfloor>\<lfloor>\<sigma>\<^sub>1_object4\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)::\<cdot>Person)) .oclAsType(Galaxy))" -assumes [simp]: "(\<lambda>_. \<lfloor>(Galaxy ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))))\<rfloor>) = ((((\<lambda>_. \<lfloor>\<lfloor>X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)::\<cdot>Person)) .oclAsType(Galaxy))" -assumes [simp]: "(\<And>a. (pre_post ((mk (a)))) = a)" -shows "(mk (\<sigma>\<^sub>1)) \<Turnstile> (OclAllInstances_generic (pre_post) (Galaxy)) \<doteq> Set{\<sigma>\<^sub>1_object0 .oclAsType(Galaxy) , \<sigma>\<^sub>1_object1 .oclAsType(Galaxy) , \<sigma>\<^sub>1_object2 .oclAsType(Galaxy) , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5 .oclAsType(Galaxy) , \<sigma>\<^sub>1_object4 .oclAsType(Galaxy) , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9 .oclAsType(Galaxy)}" - apply(subst perm_\<sigma>\<^sub>1) - apply(simp only: state.make_def \<sigma>\<^sub>1_object0_def \<sigma>\<^sub>1_object1_def \<sigma>\<^sub>1_object2_def X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5_def \<sigma>\<^sub>1_object4_def X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9_def) - apply(subst state_update_vs_allInstances_generic_tc, simp, simp, (metis distinct_oid distinct_length_2_or_more)?, simp only: assms, blast, simp, rule const_StrictRefEq\<^sub>S\<^sub>e\<^sub>t_including, simp del: OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person, simp del: OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person, simp, rule OclIncluding_cong, (simp only: assms[symmetric ])?, simp add: valid_def OclValid_def bot_fun_def bot_option_def, (simp only: assms[symmetric ])?, simp add: valid_def OclValid_def bot_fun_def bot_option_def) - apply(subst state_update_vs_allInstances_generic_tc, simp, simp, (metis distinct_oid distinct_length_2_or_more)?, simp only: assms, blast, simp, rule const_StrictRefEq\<^sub>S\<^sub>e\<^sub>t_including, simp del: OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person, simp del: OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person, simp, rule OclIncluding_cong, (simp only: assms[symmetric ])?, simp add: valid_def OclValid_def bot_fun_def bot_option_def, (simp only: assms[symmetric ])?, simp add: valid_def OclValid_def bot_fun_def bot_option_def) - apply(subst state_update_vs_allInstances_generic_tc, simp, simp, (metis distinct_oid distinct_length_2_or_more)?, simp only: assms, blast, simp, rule const_StrictRefEq\<^sub>S\<^sub>e\<^sub>t_including, simp del: OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person, simp del: OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person, simp, rule OclIncluding_cong, (simp only: assms[symmetric ])?, simp add: valid_def OclValid_def bot_fun_def bot_option_def, (simp only: assms[symmetric ])?, simp add: valid_def OclValid_def bot_fun_def bot_option_def) - apply(subst state_update_vs_allInstances_generic_tc, simp, simp, (metis distinct_oid distinct_length_2_or_more)?, simp only: assms, blast, simp, rule const_StrictRefEq\<^sub>S\<^sub>e\<^sub>t_including, simp del: OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person, simp del: OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person, simp, rule OclIncluding_cong, (simp only: assms[symmetric ])?, simp add: valid_def OclValid_def bot_fun_def bot_option_def, (simp only: assms[symmetric ])?, simp add: valid_def OclValid_def bot_fun_def bot_option_def) - apply(subst state_update_vs_allInstances_generic_tc, simp, simp, (metis distinct_oid distinct_length_2_or_more)?, simp only: assms, blast, simp, rule const_StrictRefEq\<^sub>S\<^sub>e\<^sub>t_including, simp del: OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person, simp del: OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person, simp, rule OclIncluding_cong, (simp only: assms[symmetric ])?, simp add: valid_def OclValid_def bot_fun_def bot_option_def, (simp only: assms[symmetric ])?, simp add: valid_def OclValid_def bot_fun_def bot_option_def) - apply(subst state_update_vs_allInstances_generic_tc, simp, simp, (metis distinct_oid distinct_length_2_or_more)?, simp only: assms, blast, simp, rule const_StrictRefEq\<^sub>S\<^sub>e\<^sub>t_including, simp del: OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person, simp del: OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person, simp, rule OclIncluding_cong, (simp only: assms[symmetric ])?, simp add: valid_def OclValid_def bot_fun_def bot_option_def, (simp only: assms[symmetric ])?, simp add: valid_def OclValid_def bot_fun_def bot_option_def) - apply(rule state_update_vs_allInstances_generic_empty) -by(simp_all only: assms, (simp_all add: OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_\<AA>_def)?) - -lemma \<sigma>\<^sub>1_OclAllInstances_at_post_exec_Galaxy : -assumes [simp]: "(Galaxy ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (\<sigma>\<^sub>1_object0\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(Galaxy ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (\<sigma>\<^sub>1_object1\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(Galaxy ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (\<sigma>\<^sub>1_object2\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(Galaxy ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(Galaxy ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (\<sigma>\<^sub>1_object4\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(Galaxy ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(\<lambda>_. \<lfloor>(Galaxy ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (\<sigma>\<^sub>1_object0\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))))\<rfloor>) = ((((\<lambda>_. \<lfloor>\<lfloor>\<sigma>\<^sub>1_object0\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)::\<cdot>Person)) .oclAsType(Galaxy))" -assumes [simp]: "(\<lambda>_. \<lfloor>(Galaxy ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (\<sigma>\<^sub>1_object1\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))))\<rfloor>) = ((((\<lambda>_. \<lfloor>\<lfloor>\<sigma>\<^sub>1_object1\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)::\<cdot>Person)) .oclAsType(Galaxy))" -assumes [simp]: "(\<lambda>_. \<lfloor>(Galaxy ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (\<sigma>\<^sub>1_object2\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))))\<rfloor>) = ((((\<lambda>_. \<lfloor>\<lfloor>\<sigma>\<^sub>1_object2\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)::\<cdot>Person)) .oclAsType(Galaxy))" -assumes [simp]: "(\<lambda>_. \<lfloor>(Galaxy ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))))\<rfloor>) = ((((\<lambda>_. \<lfloor>\<lfloor>X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)::\<cdot>Person)) .oclAsType(Galaxy))" -assumes [simp]: "(\<lambda>_. \<lfloor>(Galaxy ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (\<sigma>\<^sub>1_object4\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))))\<rfloor>) = ((((\<lambda>_. \<lfloor>\<lfloor>\<sigma>\<^sub>1_object4\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)::\<cdot>Person)) .oclAsType(Galaxy))" -assumes [simp]: "(\<lambda>_. \<lfloor>(Galaxy ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))))\<rfloor>) = ((((\<lambda>_. \<lfloor>\<lfloor>X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)::\<cdot>Person)) .oclAsType(Galaxy))" -shows "(st , \<sigma>\<^sub>1) \<Turnstile> (OclAllInstances_at_post (Galaxy)) \<doteq> Set{\<sigma>\<^sub>1_object0 .oclAsType(Galaxy) , \<sigma>\<^sub>1_object1 .oclAsType(Galaxy) , \<sigma>\<^sub>1_object2 .oclAsType(Galaxy) , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5 .oclAsType(Galaxy) , \<sigma>\<^sub>1_object4 .oclAsType(Galaxy) , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9 .oclAsType(Galaxy)}" - unfolding OclAllInstances_at_post_def -by(rule \<sigma>\<^sub>1_OclAllInstances_generic_exec_Galaxy, simp_all only: assms, simp_all) - -lemma \<sigma>\<^sub>1_OclAllInstances_at_pre_exec_Galaxy : -assumes [simp]: "(Galaxy ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (\<sigma>\<^sub>1_object0\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(Galaxy ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (\<sigma>\<^sub>1_object1\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(Galaxy ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (\<sigma>\<^sub>1_object2\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(Galaxy ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(Galaxy ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (\<sigma>\<^sub>1_object4\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(Galaxy ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(\<lambda>_. \<lfloor>(Galaxy ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (\<sigma>\<^sub>1_object0\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))))\<rfloor>) = ((((\<lambda>_. \<lfloor>\<lfloor>\<sigma>\<^sub>1_object0\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)::\<cdot>Person)) .oclAsType(Galaxy))" -assumes [simp]: "(\<lambda>_. \<lfloor>(Galaxy ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (\<sigma>\<^sub>1_object1\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))))\<rfloor>) = ((((\<lambda>_. \<lfloor>\<lfloor>\<sigma>\<^sub>1_object1\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)::\<cdot>Person)) .oclAsType(Galaxy))" -assumes [simp]: "(\<lambda>_. \<lfloor>(Galaxy ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (\<sigma>\<^sub>1_object2\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))))\<rfloor>) = ((((\<lambda>_. \<lfloor>\<lfloor>\<sigma>\<^sub>1_object2\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)::\<cdot>Person)) .oclAsType(Galaxy))" -assumes [simp]: "(\<lambda>_. \<lfloor>(Galaxy ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))))\<rfloor>) = ((((\<lambda>_. \<lfloor>\<lfloor>X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)::\<cdot>Person)) .oclAsType(Galaxy))" -assumes [simp]: "(\<lambda>_. \<lfloor>(Galaxy ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (\<sigma>\<^sub>1_object4\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))))\<rfloor>) = ((((\<lambda>_. \<lfloor>\<lfloor>\<sigma>\<^sub>1_object4\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)::\<cdot>Person)) .oclAsType(Galaxy))" -assumes [simp]: "(\<lambda>_. \<lfloor>(Galaxy ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))))\<rfloor>) = ((((\<lambda>_. \<lfloor>\<lfloor>X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)::\<cdot>Person)) .oclAsType(Galaxy))" -shows "(\<sigma>\<^sub>1 , st) \<Turnstile> (OclAllInstances_at_pre (Galaxy)) \<doteq> Set{\<sigma>\<^sub>1_object0 .oclAsType(Galaxy) , \<sigma>\<^sub>1_object1 .oclAsType(Galaxy) , \<sigma>\<^sub>1_object2 .oclAsType(Galaxy) , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5 .oclAsType(Galaxy) , \<sigma>\<^sub>1_object4 .oclAsType(Galaxy) , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9 .oclAsType(Galaxy)}" - unfolding OclAllInstances_at_pre_def -by(rule \<sigma>\<^sub>1_OclAllInstances_generic_exec_Galaxy, simp_all only: assms, simp_all) - -lemma \<sigma>\<^sub>1_OclAllInstances_generic_exec_OclAny : -assumes [simp]: "(OclAny ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (\<sigma>\<^sub>1_object0\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(OclAny ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (\<sigma>\<^sub>1_object1\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(OclAny ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (\<sigma>\<^sub>1_object2\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(OclAny ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(OclAny ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (\<sigma>\<^sub>1_object4\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(OclAny ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(\<lambda>_. \<lfloor>(OclAny ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (\<sigma>\<^sub>1_object0\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))))\<rfloor>) = ((((\<lambda>_. \<lfloor>\<lfloor>\<sigma>\<^sub>1_object0\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)::\<cdot>Person)) .oclAsType(OclAny))" -assumes [simp]: "(\<lambda>_. \<lfloor>(OclAny ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (\<sigma>\<^sub>1_object1\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))))\<rfloor>) = ((((\<lambda>_. \<lfloor>\<lfloor>\<sigma>\<^sub>1_object1\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)::\<cdot>Person)) .oclAsType(OclAny))" -assumes [simp]: "(\<lambda>_. \<lfloor>(OclAny ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (\<sigma>\<^sub>1_object2\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))))\<rfloor>) = ((((\<lambda>_. \<lfloor>\<lfloor>\<sigma>\<^sub>1_object2\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)::\<cdot>Person)) .oclAsType(OclAny))" -assumes [simp]: "(\<lambda>_. \<lfloor>(OclAny ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))))\<rfloor>) = ((((\<lambda>_. \<lfloor>\<lfloor>X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)::\<cdot>Person)) .oclAsType(OclAny))" -assumes [simp]: "(\<lambda>_. \<lfloor>(OclAny ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (\<sigma>\<^sub>1_object4\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))))\<rfloor>) = ((((\<lambda>_. \<lfloor>\<lfloor>\<sigma>\<^sub>1_object4\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)::\<cdot>Person)) .oclAsType(OclAny))" -assumes [simp]: "(\<lambda>_. \<lfloor>(OclAny ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))))\<rfloor>) = ((((\<lambda>_. \<lfloor>\<lfloor>X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)::\<cdot>Person)) .oclAsType(OclAny))" -assumes [simp]: "(\<And>a. (pre_post ((mk (a)))) = a)" -shows "(mk (\<sigma>\<^sub>1)) \<Turnstile> (OclAllInstances_generic (pre_post) (OclAny)) \<doteq> Set{\<sigma>\<^sub>1_object0 .oclAsType(OclAny) , \<sigma>\<^sub>1_object1 .oclAsType(OclAny) , \<sigma>\<^sub>1_object2 .oclAsType(OclAny) , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5 .oclAsType(OclAny) , \<sigma>\<^sub>1_object4 .oclAsType(OclAny) , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9 .oclAsType(OclAny)}" - apply(subst perm_\<sigma>\<^sub>1) - apply(simp only: state.make_def \<sigma>\<^sub>1_object0_def \<sigma>\<^sub>1_object1_def \<sigma>\<^sub>1_object2_def X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5_def \<sigma>\<^sub>1_object4_def X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9_def) - apply(subst state_update_vs_allInstances_generic_tc, simp, simp, (metis distinct_oid distinct_length_2_or_more)?, simp only: assms, blast, simp, rule const_StrictRefEq\<^sub>S\<^sub>e\<^sub>t_including, simp del: OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person, simp del: OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person, simp, rule OclIncluding_cong, (simp only: assms[symmetric ])?, simp add: valid_def OclValid_def bot_fun_def bot_option_def, (simp only: assms[symmetric ])?, simp add: valid_def OclValid_def bot_fun_def bot_option_def) - apply(subst state_update_vs_allInstances_generic_tc, simp, simp, (metis distinct_oid distinct_length_2_or_more)?, simp only: assms, blast, simp, rule const_StrictRefEq\<^sub>S\<^sub>e\<^sub>t_including, simp del: OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person, simp del: OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person, simp, rule OclIncluding_cong, (simp only: assms[symmetric ])?, simp add: valid_def OclValid_def bot_fun_def bot_option_def, (simp only: assms[symmetric ])?, simp add: valid_def OclValid_def bot_fun_def bot_option_def) - apply(subst state_update_vs_allInstances_generic_tc, simp, simp, (metis distinct_oid distinct_length_2_or_more)?, simp only: assms, blast, simp, rule const_StrictRefEq\<^sub>S\<^sub>e\<^sub>t_including, simp del: OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person, simp del: OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person, simp, rule OclIncluding_cong, (simp only: assms[symmetric ])?, simp add: valid_def OclValid_def bot_fun_def bot_option_def, (simp only: assms[symmetric ])?, simp add: valid_def OclValid_def bot_fun_def bot_option_def) - apply(subst state_update_vs_allInstances_generic_tc, simp, simp, (metis distinct_oid distinct_length_2_or_more)?, simp only: assms, blast, simp, rule const_StrictRefEq\<^sub>S\<^sub>e\<^sub>t_including, simp del: OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person, simp del: OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person, simp, rule OclIncluding_cong, (simp only: assms[symmetric ])?, simp add: valid_def OclValid_def bot_fun_def bot_option_def, (simp only: assms[symmetric ])?, simp add: valid_def OclValid_def bot_fun_def bot_option_def) - apply(subst state_update_vs_allInstances_generic_tc, simp, simp, (metis distinct_oid distinct_length_2_or_more)?, simp only: assms, blast, simp, rule const_StrictRefEq\<^sub>S\<^sub>e\<^sub>t_including, simp del: OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person, simp del: OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person, simp, rule OclIncluding_cong, (simp only: assms[symmetric ])?, simp add: valid_def OclValid_def bot_fun_def bot_option_def, (simp only: assms[symmetric ])?, simp add: valid_def OclValid_def bot_fun_def bot_option_def) - apply(subst state_update_vs_allInstances_generic_tc, simp, simp, (metis distinct_oid distinct_length_2_or_more)?, simp only: assms, blast, simp, rule const_StrictRefEq\<^sub>S\<^sub>e\<^sub>t_including, simp del: OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person, simp del: OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person, simp, rule OclIncluding_cong, (simp only: assms[symmetric ])?, simp add: valid_def OclValid_def bot_fun_def bot_option_def, (simp only: assms[symmetric ])?, simp add: valid_def OclValid_def bot_fun_def bot_option_def) - apply(rule state_update_vs_allInstances_generic_empty) -by(simp_all only: assms, (simp_all add: OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_\<AA>_def)?) - -lemma \<sigma>\<^sub>1_OclAllInstances_at_post_exec_OclAny : -assumes [simp]: "(OclAny ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (\<sigma>\<^sub>1_object0\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(OclAny ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (\<sigma>\<^sub>1_object1\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(OclAny ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (\<sigma>\<^sub>1_object2\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(OclAny ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(OclAny ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (\<sigma>\<^sub>1_object4\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(OclAny ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(\<lambda>_. \<lfloor>(OclAny ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (\<sigma>\<^sub>1_object0\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))))\<rfloor>) = ((((\<lambda>_. \<lfloor>\<lfloor>\<sigma>\<^sub>1_object0\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)::\<cdot>Person)) .oclAsType(OclAny))" -assumes [simp]: "(\<lambda>_. \<lfloor>(OclAny ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (\<sigma>\<^sub>1_object1\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))))\<rfloor>) = ((((\<lambda>_. \<lfloor>\<lfloor>\<sigma>\<^sub>1_object1\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)::\<cdot>Person)) .oclAsType(OclAny))" -assumes [simp]: "(\<lambda>_. \<lfloor>(OclAny ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (\<sigma>\<^sub>1_object2\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))))\<rfloor>) = ((((\<lambda>_. \<lfloor>\<lfloor>\<sigma>\<^sub>1_object2\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)::\<cdot>Person)) .oclAsType(OclAny))" -assumes [simp]: "(\<lambda>_. \<lfloor>(OclAny ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))))\<rfloor>) = ((((\<lambda>_. \<lfloor>\<lfloor>X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)::\<cdot>Person)) .oclAsType(OclAny))" -assumes [simp]: "(\<lambda>_. \<lfloor>(OclAny ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (\<sigma>\<^sub>1_object4\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))))\<rfloor>) = ((((\<lambda>_. \<lfloor>\<lfloor>\<sigma>\<^sub>1_object4\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)::\<cdot>Person)) .oclAsType(OclAny))" -assumes [simp]: "(\<lambda>_. \<lfloor>(OclAny ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))))\<rfloor>) = ((((\<lambda>_. \<lfloor>\<lfloor>X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)::\<cdot>Person)) .oclAsType(OclAny))" -shows "(st , \<sigma>\<^sub>1) \<Turnstile> (OclAllInstances_at_post (OclAny)) \<doteq> Set{\<sigma>\<^sub>1_object0 .oclAsType(OclAny) , \<sigma>\<^sub>1_object1 .oclAsType(OclAny) , \<sigma>\<^sub>1_object2 .oclAsType(OclAny) , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5 .oclAsType(OclAny) , \<sigma>\<^sub>1_object4 .oclAsType(OclAny) , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9 .oclAsType(OclAny)}" - unfolding OclAllInstances_at_post_def -by(rule \<sigma>\<^sub>1_OclAllInstances_generic_exec_OclAny, simp_all only: assms, simp_all) - -lemma \<sigma>\<^sub>1_OclAllInstances_at_pre_exec_OclAny : -assumes [simp]: "(OclAny ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (\<sigma>\<^sub>1_object0\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(OclAny ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (\<sigma>\<^sub>1_object1\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(OclAny ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (\<sigma>\<^sub>1_object2\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(OclAny ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(OclAny ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (\<sigma>\<^sub>1_object4\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(OclAny ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(\<lambda>_. \<lfloor>(OclAny ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (\<sigma>\<^sub>1_object0\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))))\<rfloor>) = ((((\<lambda>_. \<lfloor>\<lfloor>\<sigma>\<^sub>1_object0\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)::\<cdot>Person)) .oclAsType(OclAny))" -assumes [simp]: "(\<lambda>_. \<lfloor>(OclAny ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (\<sigma>\<^sub>1_object1\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))))\<rfloor>) = ((((\<lambda>_. \<lfloor>\<lfloor>\<sigma>\<^sub>1_object1\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)::\<cdot>Person)) .oclAsType(OclAny))" -assumes [simp]: "(\<lambda>_. \<lfloor>(OclAny ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (\<sigma>\<^sub>1_object2\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))))\<rfloor>) = ((((\<lambda>_. \<lfloor>\<lfloor>\<sigma>\<^sub>1_object2\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)::\<cdot>Person)) .oclAsType(OclAny))" -assumes [simp]: "(\<lambda>_. \<lfloor>(OclAny ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))))\<rfloor>) = ((((\<lambda>_. \<lfloor>\<lfloor>X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)::\<cdot>Person)) .oclAsType(OclAny))" -assumes [simp]: "(\<lambda>_. \<lfloor>(OclAny ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (\<sigma>\<^sub>1_object4\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))))\<rfloor>) = ((((\<lambda>_. \<lfloor>\<lfloor>\<sigma>\<^sub>1_object4\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)::\<cdot>Person)) .oclAsType(OclAny))" -assumes [simp]: "(\<lambda>_. \<lfloor>(OclAny ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))))\<rfloor>) = ((((\<lambda>_. \<lfloor>\<lfloor>X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)::\<cdot>Person)) .oclAsType(OclAny))" -shows "(\<sigma>\<^sub>1 , st) \<Turnstile> (OclAllInstances_at_pre (OclAny)) \<doteq> Set{\<sigma>\<^sub>1_object0 .oclAsType(OclAny) , \<sigma>\<^sub>1_object1 .oclAsType(OclAny) , \<sigma>\<^sub>1_object2 .oclAsType(OclAny) , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5 .oclAsType(OclAny) , \<sigma>\<^sub>1_object4 .oclAsType(OclAny) , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9 .oclAsType(OclAny)}" - unfolding OclAllInstances_at_pre_def -by(rule \<sigma>\<^sub>1_OclAllInstances_generic_exec_OclAny, simp_all only: assms, simp_all) - -ML \<open>(Ty'.check ([]) (" error(s)"))\<close> -end - -(* 158 ************************************ 963 + 1 *) (* term Floor2_examp.print_examp_def_st_def_interp *) -definition "(state_interpretation_\<sigma>\<^sub>1 (\<tau>)) = (state_\<sigma>\<^sub>1 (oid1) (oid2) (oid4) (oid5) (oid6) (oid9) (\<lceil>\<lceil>(\<sigma>\<^sub>1_object0 (\<tau>))\<rceil>\<rceil>) (\<sigma>\<^sub>1_object0) (\<lceil>\<lceil>(\<sigma>\<^sub>1_object1 (\<tau>))\<rceil>\<rceil>) (\<sigma>\<^sub>1_object1) (\<lceil>\<lceil>(\<sigma>\<^sub>1_object2 (\<tau>))\<rceil>\<rceil>) (\<sigma>\<^sub>1_object2) (\<lceil>\<lceil>(X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5 (\<tau>))\<rceil>\<rceil>) (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5) (\<lceil>\<lceil>(\<sigma>\<^sub>1_object4 (\<tau>))\<rceil>\<rceil>) (\<sigma>\<^sub>1_object4) (\<lceil>\<lceil>(X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9 (\<tau>))\<rceil>\<rceil>) (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9))" - -(* 159 ************************************ 964 + 1 *) -section \<open>State (Floor 2)\<close> - -(* 160 ************************************ 965 + 1 *) -locale state_\<sigma>\<^sub>1' = -fixes "oid1" :: "nat" -fixes "oid2" :: "nat" -fixes "oid3" :: "nat" -fixes "oid4" :: "nat" -fixes "oid6" :: "nat" -fixes "oid7" :: "nat" -fixes "oid8" :: "nat" -fixes "oid9" :: "nat" -assumes distinct_oid: "(distinct ([oid1 , oid2 , oid3 , oid4 , oid6 , oid7 , oid8 , oid9]))" -fixes "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n" :: "ty\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n" -fixes "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1" :: "\<cdot>Person" -assumes X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1_def: "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1 = (\<lambda>_. \<lfloor>\<lfloor>X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)" -fixes "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n" :: "ty\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n" -fixes "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2" :: "\<cdot>Person" -assumes X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2_def: "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2 = (\<lambda>_. \<lfloor>\<lfloor>X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)" -fixes "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n" :: "ty\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n" -fixes "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3" :: "\<cdot>Person" -assumes X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3_def: "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3 = (\<lambda>_. \<lfloor>\<lfloor>X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)" -fixes "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n" :: "ty\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n" -fixes "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4" :: "\<cdot>Person" -assumes X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4_def: "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4 = (\<lambda>_. \<lfloor>\<lfloor>X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)" -fixes "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n" :: "ty\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n" -fixes "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6" :: "\<cdot>Person" -assumes X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6_def: "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6 = (\<lambda>_. \<lfloor>\<lfloor>X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)" -fixes "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y" :: "ty\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y" -fixes "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7" :: "\<cdot>OclAny" -assumes X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7_def: "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7 = (\<lambda>_. \<lfloor>\<lfloor>X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y\<rfloor>\<rfloor>)" -fixes "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n8\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y" :: "ty\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y" -fixes "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n8" :: "\<cdot>OclAny" -assumes X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n8_def: "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n8 = (\<lambda>_. \<lfloor>\<lfloor>X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n8\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y\<rfloor>\<rfloor>)" -fixes "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n" :: "ty\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n" -fixes "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9" :: "\<cdot>Person" -assumes X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9_def: "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9 = (\<lambda>_. \<lfloor>\<lfloor>X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)" -begin -definition "\<sigma>\<^sub>1' = (state.make ((Map.empty (oid1 \<mapsto> (in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))) (oid2 \<mapsto> (in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))) (oid3 \<mapsto> (in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))) (oid4 \<mapsto> (in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))) (oid6 \<mapsto> (in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))) (oid7 \<mapsto> (in\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y))) (oid8 \<mapsto> (in\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n8\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y))) (oid9 \<mapsto> (in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))))) ((map_of_list ([(oid\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_0___boss , (List.map ((\<lambda>(x , y). [x , y]) o switch\<^sub>2_01) ([[[oid1] , [oid2]] , [[oid2] , [oid2]] , [[oid6] , [oid7]] , [[oid7] , [oid7]]])))]))))" - -lemma dom_\<sigma>\<^sub>1' : "(dom ((heap (\<sigma>\<^sub>1')))) = {oid1 , oid2 , oid3 , oid4 , oid6 , oid7 , oid8 , oid9}" -by(auto simp: \<sigma>\<^sub>1'_def) - -lemmas[simp,code_unfold] = dom_\<sigma>\<^sub>1' - -lemma perm_\<sigma>\<^sub>1' : "\<sigma>\<^sub>1' = (state.make ((Map.empty (oid9 \<mapsto> (in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))) (oid8 \<mapsto> (in\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n8\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y))) (oid7 \<mapsto> (in\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y))) (oid6 \<mapsto> (in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))) (oid4 \<mapsto> (in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))) (oid3 \<mapsto> (in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))) (oid2 \<mapsto> (in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))) (oid1 \<mapsto> (in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))))) ((assocs (\<sigma>\<^sub>1'))))" - apply(simp add: \<sigma>\<^sub>1'_def) - apply(subst (1) fun_upd_twist, metis distinct_oid distinct_length_2_or_more) - apply(subst (2) fun_upd_twist, metis distinct_oid distinct_length_2_or_more) - apply(subst (1) fun_upd_twist, metis distinct_oid distinct_length_2_or_more) - apply(subst (3) fun_upd_twist, metis distinct_oid distinct_length_2_or_more) - apply(subst (2) fun_upd_twist, metis distinct_oid distinct_length_2_or_more) - apply(subst (1) fun_upd_twist, metis distinct_oid distinct_length_2_or_more) - apply(subst (4) fun_upd_twist, metis distinct_oid distinct_length_2_or_more) - apply(subst (3) fun_upd_twist, metis distinct_oid distinct_length_2_or_more) - apply(subst (2) fun_upd_twist, metis distinct_oid distinct_length_2_or_more) - apply(subst (1) fun_upd_twist, metis distinct_oid distinct_length_2_or_more) - apply(subst (5) fun_upd_twist, metis distinct_oid distinct_length_2_or_more) - apply(subst (4) fun_upd_twist, metis distinct_oid distinct_length_2_or_more) - apply(subst (3) fun_upd_twist, metis distinct_oid distinct_length_2_or_more) - apply(subst (2) fun_upd_twist, metis distinct_oid distinct_length_2_or_more) - apply(subst (1) fun_upd_twist, metis distinct_oid distinct_length_2_or_more) - apply(subst (6) fun_upd_twist, metis distinct_oid distinct_length_2_or_more) - apply(subst (5) fun_upd_twist, metis distinct_oid distinct_length_2_or_more) - apply(subst (4) fun_upd_twist, metis distinct_oid distinct_length_2_or_more) - apply(subst (3) fun_upd_twist, metis distinct_oid distinct_length_2_or_more) - apply(subst (2) fun_upd_twist, metis distinct_oid distinct_length_2_or_more) - apply(subst (1) fun_upd_twist, metis distinct_oid distinct_length_2_or_more) - apply(subst (7) fun_upd_twist, metis distinct_oid distinct_length_2_or_more) - apply(subst (6) fun_upd_twist, metis distinct_oid distinct_length_2_or_more) - apply(subst (5) fun_upd_twist, metis distinct_oid distinct_length_2_or_more) - apply(subst (4) fun_upd_twist, metis distinct_oid distinct_length_2_or_more) - apply(subst (3) fun_upd_twist, metis distinct_oid distinct_length_2_or_more) - apply(subst (2) fun_upd_twist, metis distinct_oid distinct_length_2_or_more) - apply(subst (1) fun_upd_twist, metis distinct_oid distinct_length_2_or_more) -by(simp) - -lemma \<sigma>\<^sub>1'_OclAllInstances_generic_exec_Person : -assumes [simp]: "(Person ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(Person ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(Person ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(Person ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(Person ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(Person ((in\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y)))) \<noteq> None" -assumes [simp]: "(Person ((in\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n8\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y)))) = None" -assumes [simp]: "(Person ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(\<lambda>_. \<lfloor>(Person ((in\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y))))\<rfloor>) = ((((\<lambda>_. \<lfloor>\<lfloor>X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y\<rfloor>\<rfloor>)::\<cdot>OclAny)) .oclAsType(Person))" -assumes [simp]: "(\<And>a. (pre_post ((mk (a)))) = a)" -shows "(mk (\<sigma>\<^sub>1')) \<Turnstile> (OclAllInstances_generic (pre_post) (Person)) \<doteq> Set{X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1 , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2 , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3 , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4 , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6 , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7 .oclAsType(Person) , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9}" - apply(subst perm_\<sigma>\<^sub>1') - apply(simp only: state.make_def X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1_def X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2_def X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3_def X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4_def X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6_def X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7_def X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9_def) - apply(subst state_update_vs_allInstances_generic_tc, simp, simp, (metis distinct_oid distinct_length_2_or_more)?, simp only: assms, blast, simp, rule const_StrictRefEq\<^sub>S\<^sub>e\<^sub>t_including, simp del: OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny, simp del: OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny, simp, rule OclIncluding_cong, (simp only: assms[symmetric ])?, simp add: valid_def OclValid_def bot_fun_def bot_option_def, (simp only: assms[symmetric ])?, simp add: valid_def OclValid_def bot_fun_def bot_option_def) - apply(subst state_update_vs_allInstances_generic_tc, simp, simp, (metis distinct_oid distinct_length_2_or_more)?, simp only: assms, blast, simp, rule const_StrictRefEq\<^sub>S\<^sub>e\<^sub>t_including, simp del: OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny, simp del: OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny, simp, rule OclIncluding_cong, (simp only: assms[symmetric ])?, simp add: valid_def OclValid_def bot_fun_def bot_option_def, (simp only: assms[symmetric ])?, simp add: valid_def OclValid_def bot_fun_def bot_option_def) - apply(subst state_update_vs_allInstances_generic_tc, simp, simp, (metis distinct_oid distinct_length_2_or_more)?, simp only: assms, blast, simp, rule const_StrictRefEq\<^sub>S\<^sub>e\<^sub>t_including, simp del: OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny, simp del: OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny, simp, rule OclIncluding_cong, (simp only: assms[symmetric ])?, simp add: valid_def OclValid_def bot_fun_def bot_option_def, (simp only: assms[symmetric ])?, simp add: valid_def OclValid_def bot_fun_def bot_option_def) - apply(subst state_update_vs_allInstances_generic_tc, simp, simp, (metis distinct_oid distinct_length_2_or_more)?, simp only: assms, blast, simp, rule const_StrictRefEq\<^sub>S\<^sub>e\<^sub>t_including, simp del: OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny, simp del: OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny, simp, rule OclIncluding_cong, (simp only: assms[symmetric ])?, simp add: valid_def OclValid_def bot_fun_def bot_option_def, (simp only: assms[symmetric ])?, simp add: valid_def OclValid_def bot_fun_def bot_option_def) - apply(subst state_update_vs_allInstances_generic_tc, simp, simp, (metis distinct_oid distinct_length_2_or_more)?, simp only: assms, blast, simp, rule const_StrictRefEq\<^sub>S\<^sub>e\<^sub>t_including, simp del: OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny, simp del: OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny, simp, rule OclIncluding_cong, (simp only: assms[symmetric ])?, simp add: valid_def OclValid_def bot_fun_def bot_option_def, (simp only: assms[symmetric ])?, simp add: valid_def OclValid_def bot_fun_def bot_option_def) - apply(subst state_update_vs_allInstances_generic_tc, simp, simp, (metis distinct_oid distinct_length_2_or_more)?, simp only: assms, blast, simp, rule const_StrictRefEq\<^sub>S\<^sub>e\<^sub>t_including, simp del: OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny, simp del: OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny, simp, rule OclIncluding_cong, (simp only: assms[symmetric ])?, simp add: valid_def OclValid_def bot_fun_def bot_option_def, (simp only: assms[symmetric ])?, simp add: valid_def OclValid_def bot_fun_def bot_option_def) - apply(subst state_update_vs_allInstances_generic_ntc, simp, simp, (metis distinct_oid distinct_length_2_or_more)?, simp only: assms, simp, rule const_StrictRefEq\<^sub>S\<^sub>e\<^sub>t_including, simp del: OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny, simp del: OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny, simp) - apply(subst state_update_vs_allInstances_generic_tc, simp, simp, (metis distinct_oid distinct_length_2_or_more)?, simp only: assms, blast, simp, rule const_StrictRefEq\<^sub>S\<^sub>e\<^sub>t_including, simp del: OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny, simp del: OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny, simp, rule OclIncluding_cong, (simp only: assms[symmetric ])?, simp add: valid_def OclValid_def bot_fun_def bot_option_def, (simp only: assms[symmetric ])?, simp add: valid_def OclValid_def bot_fun_def bot_option_def) - apply(rule state_update_vs_allInstances_generic_empty) -by(simp_all only: assms, (simp_all add: OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_\<AA>_def)?) - -lemma \<sigma>\<^sub>1'_OclAllInstances_at_post_exec_Person : -assumes [simp]: "(Person ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(Person ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(Person ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(Person ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(Person ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(Person ((in\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y)))) \<noteq> None" -assumes [simp]: "(Person ((in\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n8\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y)))) = None" -assumes [simp]: "(Person ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(\<lambda>_. \<lfloor>(Person ((in\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y))))\<rfloor>) = ((((\<lambda>_. \<lfloor>\<lfloor>X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y\<rfloor>\<rfloor>)::\<cdot>OclAny)) .oclAsType(Person))" -shows "(st , \<sigma>\<^sub>1') \<Turnstile> (OclAllInstances_at_post (Person)) \<doteq> Set{X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1 , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2 , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3 , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4 , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6 , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7 .oclAsType(Person) , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9}" - unfolding OclAllInstances_at_post_def -by(rule \<sigma>\<^sub>1'_OclAllInstances_generic_exec_Person, simp_all only: assms, simp_all) - -lemma \<sigma>\<^sub>1'_OclAllInstances_at_pre_exec_Person : -assumes [simp]: "(Person ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(Person ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(Person ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(Person ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(Person ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(Person ((in\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y)))) \<noteq> None" -assumes [simp]: "(Person ((in\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n8\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y)))) = None" -assumes [simp]: "(Person ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(\<lambda>_. \<lfloor>(Person ((in\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y))))\<rfloor>) = ((((\<lambda>_. \<lfloor>\<lfloor>X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y\<rfloor>\<rfloor>)::\<cdot>OclAny)) .oclAsType(Person))" -shows "(\<sigma>\<^sub>1' , st) \<Turnstile> (OclAllInstances_at_pre (Person)) \<doteq> Set{X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1 , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2 , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3 , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4 , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6 , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7 .oclAsType(Person) , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9}" - unfolding OclAllInstances_at_pre_def -by(rule \<sigma>\<^sub>1'_OclAllInstances_generic_exec_Person, simp_all only: assms, simp_all) - -lemma \<sigma>\<^sub>1'_OclAllInstances_generic_exec_Planet : -assumes [simp]: "(Planet ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(Planet ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(Planet ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(Planet ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(Planet ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(Planet ((in\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y)))) = None" -assumes [simp]: "(Planet ((in\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n8\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y)))) = None" -assumes [simp]: "(Planet ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(\<lambda>_. \<lfloor>(Planet ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))))\<rfloor>) = ((((\<lambda>_. \<lfloor>\<lfloor>X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)::\<cdot>Person)) .oclAsType(Planet))" -assumes [simp]: "(\<lambda>_. \<lfloor>(Planet ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))))\<rfloor>) = ((((\<lambda>_. \<lfloor>\<lfloor>X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)::\<cdot>Person)) .oclAsType(Planet))" -assumes [simp]: "(\<lambda>_. \<lfloor>(Planet ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))))\<rfloor>) = ((((\<lambda>_. \<lfloor>\<lfloor>X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)::\<cdot>Person)) .oclAsType(Planet))" -assumes [simp]: "(\<lambda>_. \<lfloor>(Planet ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))))\<rfloor>) = ((((\<lambda>_. \<lfloor>\<lfloor>X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)::\<cdot>Person)) .oclAsType(Planet))" -assumes [simp]: "(\<lambda>_. \<lfloor>(Planet ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))))\<rfloor>) = ((((\<lambda>_. \<lfloor>\<lfloor>X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)::\<cdot>Person)) .oclAsType(Planet))" -assumes [simp]: "(\<lambda>_. \<lfloor>(Planet ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))))\<rfloor>) = ((((\<lambda>_. \<lfloor>\<lfloor>X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)::\<cdot>Person)) .oclAsType(Planet))" -assumes [simp]: "(\<And>a. (pre_post ((mk (a)))) = a)" -shows "(mk (\<sigma>\<^sub>1')) \<Turnstile> (OclAllInstances_generic (pre_post) (Planet)) \<doteq> Set{X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1 .oclAsType(Planet) , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2 .oclAsType(Planet) , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3 .oclAsType(Planet) , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4 .oclAsType(Planet) , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6 .oclAsType(Planet) , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9 .oclAsType(Planet)}" - apply(subst perm_\<sigma>\<^sub>1') - apply(simp only: state.make_def X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1_def X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2_def X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3_def X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4_def X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6_def X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9_def) - apply(subst state_update_vs_allInstances_generic_tc, simp, simp, (metis distinct_oid distinct_length_2_or_more)?, simp only: assms, blast, simp, rule const_StrictRefEq\<^sub>S\<^sub>e\<^sub>t_including, simp del: OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person, simp del: OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person, simp, rule OclIncluding_cong, (simp only: assms[symmetric ])?, simp add: valid_def OclValid_def bot_fun_def bot_option_def, (simp only: assms[symmetric ])?, simp add: valid_def OclValid_def bot_fun_def bot_option_def) - apply(subst state_update_vs_allInstances_generic_tc, simp, simp, (metis distinct_oid distinct_length_2_or_more)?, simp only: assms, blast, simp, rule const_StrictRefEq\<^sub>S\<^sub>e\<^sub>t_including, simp del: OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person, simp del: OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person, simp, rule OclIncluding_cong, (simp only: assms[symmetric ])?, simp add: valid_def OclValid_def bot_fun_def bot_option_def, (simp only: assms[symmetric ])?, simp add: valid_def OclValid_def bot_fun_def bot_option_def) - apply(subst state_update_vs_allInstances_generic_tc, simp, simp, (metis distinct_oid distinct_length_2_or_more)?, simp only: assms, blast, simp, rule const_StrictRefEq\<^sub>S\<^sub>e\<^sub>t_including, simp del: OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person, simp del: OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person, simp, rule OclIncluding_cong, (simp only: assms[symmetric ])?, simp add: valid_def OclValid_def bot_fun_def bot_option_def, (simp only: assms[symmetric ])?, simp add: valid_def OclValid_def bot_fun_def bot_option_def) - apply(subst state_update_vs_allInstances_generic_tc, simp, simp, (metis distinct_oid distinct_length_2_or_more)?, simp only: assms, blast, simp, rule const_StrictRefEq\<^sub>S\<^sub>e\<^sub>t_including, simp del: OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person, simp del: OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person, simp, rule OclIncluding_cong, (simp only: assms[symmetric ])?, simp add: valid_def OclValid_def bot_fun_def bot_option_def, (simp only: assms[symmetric ])?, simp add: valid_def OclValid_def bot_fun_def bot_option_def) - apply(subst state_update_vs_allInstances_generic_tc, simp, simp, (metis distinct_oid distinct_length_2_or_more)?, simp only: assms, blast, simp, rule const_StrictRefEq\<^sub>S\<^sub>e\<^sub>t_including, simp del: OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person, simp del: OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person, simp, rule OclIncluding_cong, (simp only: assms[symmetric ])?, simp add: valid_def OclValid_def bot_fun_def bot_option_def, (simp only: assms[symmetric ])?, simp add: valid_def OclValid_def bot_fun_def bot_option_def) - apply(subst state_update_vs_allInstances_generic_ntc, simp, simp, (metis distinct_oid distinct_length_2_or_more)?, simp only: assms, simp, rule const_StrictRefEq\<^sub>S\<^sub>e\<^sub>t_including, simp del: OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person, simp del: OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person, simp) - apply(subst state_update_vs_allInstances_generic_ntc, simp, simp, (metis distinct_oid distinct_length_2_or_more)?, simp only: assms, simp, rule const_StrictRefEq\<^sub>S\<^sub>e\<^sub>t_including, simp del: OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person, simp del: OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person, simp) - apply(subst state_update_vs_allInstances_generic_tc, simp, simp, (metis distinct_oid distinct_length_2_or_more)?, simp only: assms, blast, simp, rule const_StrictRefEq\<^sub>S\<^sub>e\<^sub>t_including, simp del: OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person, simp del: OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person, simp, rule OclIncluding_cong, (simp only: assms[symmetric ])?, simp add: valid_def OclValid_def bot_fun_def bot_option_def, (simp only: assms[symmetric ])?, simp add: valid_def OclValid_def bot_fun_def bot_option_def) - apply(rule state_update_vs_allInstances_generic_empty) -by(simp_all only: assms, (simp_all add: OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_\<AA>_def)?) - -lemma \<sigma>\<^sub>1'_OclAllInstances_at_post_exec_Planet : -assumes [simp]: "(Planet ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(Planet ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(Planet ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(Planet ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(Planet ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(Planet ((in\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y)))) = None" -assumes [simp]: "(Planet ((in\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n8\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y)))) = None" -assumes [simp]: "(Planet ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(\<lambda>_. \<lfloor>(Planet ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))))\<rfloor>) = ((((\<lambda>_. \<lfloor>\<lfloor>X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)::\<cdot>Person)) .oclAsType(Planet))" -assumes [simp]: "(\<lambda>_. \<lfloor>(Planet ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))))\<rfloor>) = ((((\<lambda>_. \<lfloor>\<lfloor>X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)::\<cdot>Person)) .oclAsType(Planet))" -assumes [simp]: "(\<lambda>_. \<lfloor>(Planet ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))))\<rfloor>) = ((((\<lambda>_. \<lfloor>\<lfloor>X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)::\<cdot>Person)) .oclAsType(Planet))" -assumes [simp]: "(\<lambda>_. \<lfloor>(Planet ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))))\<rfloor>) = ((((\<lambda>_. \<lfloor>\<lfloor>X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)::\<cdot>Person)) .oclAsType(Planet))" -assumes [simp]: "(\<lambda>_. \<lfloor>(Planet ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))))\<rfloor>) = ((((\<lambda>_. \<lfloor>\<lfloor>X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)::\<cdot>Person)) .oclAsType(Planet))" -assumes [simp]: "(\<lambda>_. \<lfloor>(Planet ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))))\<rfloor>) = ((((\<lambda>_. \<lfloor>\<lfloor>X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)::\<cdot>Person)) .oclAsType(Planet))" -shows "(st , \<sigma>\<^sub>1') \<Turnstile> (OclAllInstances_at_post (Planet)) \<doteq> Set{X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1 .oclAsType(Planet) , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2 .oclAsType(Planet) , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3 .oclAsType(Planet) , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4 .oclAsType(Planet) , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6 .oclAsType(Planet) , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9 .oclAsType(Planet)}" - unfolding OclAllInstances_at_post_def -by(rule \<sigma>\<^sub>1'_OclAllInstances_generic_exec_Planet, simp_all only: assms, simp_all) - -lemma \<sigma>\<^sub>1'_OclAllInstances_at_pre_exec_Planet : -assumes [simp]: "(Planet ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(Planet ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(Planet ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(Planet ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(Planet ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(Planet ((in\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y)))) = None" -assumes [simp]: "(Planet ((in\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n8\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y)))) = None" -assumes [simp]: "(Planet ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(\<lambda>_. \<lfloor>(Planet ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))))\<rfloor>) = ((((\<lambda>_. \<lfloor>\<lfloor>X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)::\<cdot>Person)) .oclAsType(Planet))" -assumes [simp]: "(\<lambda>_. \<lfloor>(Planet ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))))\<rfloor>) = ((((\<lambda>_. \<lfloor>\<lfloor>X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)::\<cdot>Person)) .oclAsType(Planet))" -assumes [simp]: "(\<lambda>_. \<lfloor>(Planet ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))))\<rfloor>) = ((((\<lambda>_. \<lfloor>\<lfloor>X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)::\<cdot>Person)) .oclAsType(Planet))" -assumes [simp]: "(\<lambda>_. \<lfloor>(Planet ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))))\<rfloor>) = ((((\<lambda>_. \<lfloor>\<lfloor>X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)::\<cdot>Person)) .oclAsType(Planet))" -assumes [simp]: "(\<lambda>_. \<lfloor>(Planet ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))))\<rfloor>) = ((((\<lambda>_. \<lfloor>\<lfloor>X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)::\<cdot>Person)) .oclAsType(Planet))" -assumes [simp]: "(\<lambda>_. \<lfloor>(Planet ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))))\<rfloor>) = ((((\<lambda>_. \<lfloor>\<lfloor>X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)::\<cdot>Person)) .oclAsType(Planet))" -shows "(\<sigma>\<^sub>1' , st) \<Turnstile> (OclAllInstances_at_pre (Planet)) \<doteq> Set{X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1 .oclAsType(Planet) , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2 .oclAsType(Planet) , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3 .oclAsType(Planet) , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4 .oclAsType(Planet) , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6 .oclAsType(Planet) , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9 .oclAsType(Planet)}" - unfolding OclAllInstances_at_pre_def -by(rule \<sigma>\<^sub>1'_OclAllInstances_generic_exec_Planet, simp_all only: assms, simp_all) - -lemma \<sigma>\<^sub>1'_OclAllInstances_generic_exec_Galaxy : -assumes [simp]: "(Galaxy ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(Galaxy ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(Galaxy ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(Galaxy ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(Galaxy ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(Galaxy ((in\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y)))) = None" -assumes [simp]: "(Galaxy ((in\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n8\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y)))) = None" -assumes [simp]: "(Galaxy ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(\<lambda>_. \<lfloor>(Galaxy ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))))\<rfloor>) = ((((\<lambda>_. \<lfloor>\<lfloor>X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)::\<cdot>Person)) .oclAsType(Galaxy))" -assumes [simp]: "(\<lambda>_. \<lfloor>(Galaxy ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))))\<rfloor>) = ((((\<lambda>_. \<lfloor>\<lfloor>X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)::\<cdot>Person)) .oclAsType(Galaxy))" -assumes [simp]: "(\<lambda>_. \<lfloor>(Galaxy ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))))\<rfloor>) = ((((\<lambda>_. \<lfloor>\<lfloor>X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)::\<cdot>Person)) .oclAsType(Galaxy))" -assumes [simp]: "(\<lambda>_. \<lfloor>(Galaxy ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))))\<rfloor>) = ((((\<lambda>_. \<lfloor>\<lfloor>X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)::\<cdot>Person)) .oclAsType(Galaxy))" -assumes [simp]: "(\<lambda>_. \<lfloor>(Galaxy ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))))\<rfloor>) = ((((\<lambda>_. \<lfloor>\<lfloor>X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)::\<cdot>Person)) .oclAsType(Galaxy))" -assumes [simp]: "(\<lambda>_. \<lfloor>(Galaxy ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))))\<rfloor>) = ((((\<lambda>_. \<lfloor>\<lfloor>X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)::\<cdot>Person)) .oclAsType(Galaxy))" -assumes [simp]: "(\<And>a. (pre_post ((mk (a)))) = a)" -shows "(mk (\<sigma>\<^sub>1')) \<Turnstile> (OclAllInstances_generic (pre_post) (Galaxy)) \<doteq> Set{X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1 .oclAsType(Galaxy) , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2 .oclAsType(Galaxy) , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3 .oclAsType(Galaxy) , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4 .oclAsType(Galaxy) , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6 .oclAsType(Galaxy) , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9 .oclAsType(Galaxy)}" - apply(subst perm_\<sigma>\<^sub>1') - apply(simp only: state.make_def X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1_def X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2_def X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3_def X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4_def X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6_def X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9_def) - apply(subst state_update_vs_allInstances_generic_tc, simp, simp, (metis distinct_oid distinct_length_2_or_more)?, simp only: assms, blast, simp, rule const_StrictRefEq\<^sub>S\<^sub>e\<^sub>t_including, simp del: OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person, simp del: OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person, simp, rule OclIncluding_cong, (simp only: assms[symmetric ])?, simp add: valid_def OclValid_def bot_fun_def bot_option_def, (simp only: assms[symmetric ])?, simp add: valid_def OclValid_def bot_fun_def bot_option_def) - apply(subst state_update_vs_allInstances_generic_tc, simp, simp, (metis distinct_oid distinct_length_2_or_more)?, simp only: assms, blast, simp, rule const_StrictRefEq\<^sub>S\<^sub>e\<^sub>t_including, simp del: OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person, simp del: OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person, simp, rule OclIncluding_cong, (simp only: assms[symmetric ])?, simp add: valid_def OclValid_def bot_fun_def bot_option_def, (simp only: assms[symmetric ])?, simp add: valid_def OclValid_def bot_fun_def bot_option_def) - apply(subst state_update_vs_allInstances_generic_tc, simp, simp, (metis distinct_oid distinct_length_2_or_more)?, simp only: assms, blast, simp, rule const_StrictRefEq\<^sub>S\<^sub>e\<^sub>t_including, simp del: OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person, simp del: OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person, simp, rule OclIncluding_cong, (simp only: assms[symmetric ])?, simp add: valid_def OclValid_def bot_fun_def bot_option_def, (simp only: assms[symmetric ])?, simp add: valid_def OclValid_def bot_fun_def bot_option_def) - apply(subst state_update_vs_allInstances_generic_tc, simp, simp, (metis distinct_oid distinct_length_2_or_more)?, simp only: assms, blast, simp, rule const_StrictRefEq\<^sub>S\<^sub>e\<^sub>t_including, simp del: OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person, simp del: OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person, simp, rule OclIncluding_cong, (simp only: assms[symmetric ])?, simp add: valid_def OclValid_def bot_fun_def bot_option_def, (simp only: assms[symmetric ])?, simp add: valid_def OclValid_def bot_fun_def bot_option_def) - apply(subst state_update_vs_allInstances_generic_tc, simp, simp, (metis distinct_oid distinct_length_2_or_more)?, simp only: assms, blast, simp, rule const_StrictRefEq\<^sub>S\<^sub>e\<^sub>t_including, simp del: OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person, simp del: OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person, simp, rule OclIncluding_cong, (simp only: assms[symmetric ])?, simp add: valid_def OclValid_def bot_fun_def bot_option_def, (simp only: assms[symmetric ])?, simp add: valid_def OclValid_def bot_fun_def bot_option_def) - apply(subst state_update_vs_allInstances_generic_ntc, simp, simp, (metis distinct_oid distinct_length_2_or_more)?, simp only: assms, simp, rule const_StrictRefEq\<^sub>S\<^sub>e\<^sub>t_including, simp del: OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person, simp del: OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person, simp) - apply(subst state_update_vs_allInstances_generic_ntc, simp, simp, (metis distinct_oid distinct_length_2_or_more)?, simp only: assms, simp, rule const_StrictRefEq\<^sub>S\<^sub>e\<^sub>t_including, simp del: OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person, simp del: OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person, simp) - apply(subst state_update_vs_allInstances_generic_tc, simp, simp, (metis distinct_oid distinct_length_2_or_more)?, simp only: assms, blast, simp, rule const_StrictRefEq\<^sub>S\<^sub>e\<^sub>t_including, simp del: OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person, simp del: OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person, simp, rule OclIncluding_cong, (simp only: assms[symmetric ])?, simp add: valid_def OclValid_def bot_fun_def bot_option_def, (simp only: assms[symmetric ])?, simp add: valid_def OclValid_def bot_fun_def bot_option_def) - apply(rule state_update_vs_allInstances_generic_empty) -by(simp_all only: assms, (simp_all add: OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_\<AA>_def)?) - -lemma \<sigma>\<^sub>1'_OclAllInstances_at_post_exec_Galaxy : -assumes [simp]: "(Galaxy ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(Galaxy ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(Galaxy ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(Galaxy ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(Galaxy ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(Galaxy ((in\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y)))) = None" -assumes [simp]: "(Galaxy ((in\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n8\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y)))) = None" -assumes [simp]: "(Galaxy ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(\<lambda>_. \<lfloor>(Galaxy ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))))\<rfloor>) = ((((\<lambda>_. \<lfloor>\<lfloor>X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)::\<cdot>Person)) .oclAsType(Galaxy))" -assumes [simp]: "(\<lambda>_. \<lfloor>(Galaxy ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))))\<rfloor>) = ((((\<lambda>_. \<lfloor>\<lfloor>X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)::\<cdot>Person)) .oclAsType(Galaxy))" -assumes [simp]: "(\<lambda>_. \<lfloor>(Galaxy ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))))\<rfloor>) = ((((\<lambda>_. \<lfloor>\<lfloor>X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)::\<cdot>Person)) .oclAsType(Galaxy))" -assumes [simp]: "(\<lambda>_. \<lfloor>(Galaxy ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))))\<rfloor>) = ((((\<lambda>_. \<lfloor>\<lfloor>X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)::\<cdot>Person)) .oclAsType(Galaxy))" -assumes [simp]: "(\<lambda>_. \<lfloor>(Galaxy ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))))\<rfloor>) = ((((\<lambda>_. \<lfloor>\<lfloor>X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)::\<cdot>Person)) .oclAsType(Galaxy))" -assumes [simp]: "(\<lambda>_. \<lfloor>(Galaxy ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))))\<rfloor>) = ((((\<lambda>_. \<lfloor>\<lfloor>X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)::\<cdot>Person)) .oclAsType(Galaxy))" -shows "(st , \<sigma>\<^sub>1') \<Turnstile> (OclAllInstances_at_post (Galaxy)) \<doteq> Set{X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1 .oclAsType(Galaxy) , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2 .oclAsType(Galaxy) , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3 .oclAsType(Galaxy) , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4 .oclAsType(Galaxy) , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6 .oclAsType(Galaxy) , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9 .oclAsType(Galaxy)}" - unfolding OclAllInstances_at_post_def -by(rule \<sigma>\<^sub>1'_OclAllInstances_generic_exec_Galaxy, simp_all only: assms, simp_all) - -lemma \<sigma>\<^sub>1'_OclAllInstances_at_pre_exec_Galaxy : -assumes [simp]: "(Galaxy ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(Galaxy ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(Galaxy ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(Galaxy ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(Galaxy ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(Galaxy ((in\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y)))) = None" -assumes [simp]: "(Galaxy ((in\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n8\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y)))) = None" -assumes [simp]: "(Galaxy ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(\<lambda>_. \<lfloor>(Galaxy ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))))\<rfloor>) = ((((\<lambda>_. \<lfloor>\<lfloor>X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)::\<cdot>Person)) .oclAsType(Galaxy))" -assumes [simp]: "(\<lambda>_. \<lfloor>(Galaxy ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))))\<rfloor>) = ((((\<lambda>_. \<lfloor>\<lfloor>X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)::\<cdot>Person)) .oclAsType(Galaxy))" -assumes [simp]: "(\<lambda>_. \<lfloor>(Galaxy ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))))\<rfloor>) = ((((\<lambda>_. \<lfloor>\<lfloor>X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)::\<cdot>Person)) .oclAsType(Galaxy))" -assumes [simp]: "(\<lambda>_. \<lfloor>(Galaxy ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))))\<rfloor>) = ((((\<lambda>_. \<lfloor>\<lfloor>X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)::\<cdot>Person)) .oclAsType(Galaxy))" -assumes [simp]: "(\<lambda>_. \<lfloor>(Galaxy ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))))\<rfloor>) = ((((\<lambda>_. \<lfloor>\<lfloor>X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)::\<cdot>Person)) .oclAsType(Galaxy))" -assumes [simp]: "(\<lambda>_. \<lfloor>(Galaxy ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))))\<rfloor>) = ((((\<lambda>_. \<lfloor>\<lfloor>X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)::\<cdot>Person)) .oclAsType(Galaxy))" -shows "(\<sigma>\<^sub>1' , st) \<Turnstile> (OclAllInstances_at_pre (Galaxy)) \<doteq> Set{X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1 .oclAsType(Galaxy) , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2 .oclAsType(Galaxy) , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3 .oclAsType(Galaxy) , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4 .oclAsType(Galaxy) , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6 .oclAsType(Galaxy) , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9 .oclAsType(Galaxy)}" - unfolding OclAllInstances_at_pre_def -by(rule \<sigma>\<^sub>1'_OclAllInstances_generic_exec_Galaxy, simp_all only: assms, simp_all) - -lemma \<sigma>\<^sub>1'_OclAllInstances_generic_exec_OclAny : -assumes [simp]: "(OclAny ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(OclAny ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(OclAny ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(OclAny ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(OclAny ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(OclAny ((in\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y)))) \<noteq> None" -assumes [simp]: "(OclAny ((in\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n8\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y)))) \<noteq> None" -assumes [simp]: "(OclAny ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(\<lambda>_. \<lfloor>(OclAny ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))))\<rfloor>) = ((((\<lambda>_. \<lfloor>\<lfloor>X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)::\<cdot>Person)) .oclAsType(OclAny))" -assumes [simp]: "(\<lambda>_. \<lfloor>(OclAny ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))))\<rfloor>) = ((((\<lambda>_. \<lfloor>\<lfloor>X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)::\<cdot>Person)) .oclAsType(OclAny))" -assumes [simp]: "(\<lambda>_. \<lfloor>(OclAny ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))))\<rfloor>) = ((((\<lambda>_. \<lfloor>\<lfloor>X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)::\<cdot>Person)) .oclAsType(OclAny))" -assumes [simp]: "(\<lambda>_. \<lfloor>(OclAny ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))))\<rfloor>) = ((((\<lambda>_. \<lfloor>\<lfloor>X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)::\<cdot>Person)) .oclAsType(OclAny))" -assumes [simp]: "(\<lambda>_. \<lfloor>(OclAny ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))))\<rfloor>) = ((((\<lambda>_. \<lfloor>\<lfloor>X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)::\<cdot>Person)) .oclAsType(OclAny))" -assumes [simp]: "(\<lambda>_. \<lfloor>(OclAny ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))))\<rfloor>) = ((((\<lambda>_. \<lfloor>\<lfloor>X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)::\<cdot>Person)) .oclAsType(OclAny))" -assumes [simp]: "(\<And>a. (pre_post ((mk (a)))) = a)" -shows "(mk (\<sigma>\<^sub>1')) \<Turnstile> (OclAllInstances_generic (pre_post) (OclAny)) \<doteq> Set{X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1 .oclAsType(OclAny) , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2 .oclAsType(OclAny) , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3 .oclAsType(OclAny) , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4 .oclAsType(OclAny) , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6 .oclAsType(OclAny) , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7 , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n8 , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9 .oclAsType(OclAny)}" - apply(subst perm_\<sigma>\<^sub>1') - apply(simp only: state.make_def X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1_def X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2_def X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3_def X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4_def X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6_def X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7_def X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n8_def X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9_def) - apply(subst state_update_vs_allInstances_generic_tc, simp, simp, (metis distinct_oid distinct_length_2_or_more)?, simp only: assms, blast, simp, rule const_StrictRefEq\<^sub>S\<^sub>e\<^sub>t_including, simp del: OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person, simp del: OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person, simp, rule OclIncluding_cong, (simp only: assms[symmetric ])?, simp add: valid_def OclValid_def bot_fun_def bot_option_def, (simp only: assms[symmetric ])?, simp add: valid_def OclValid_def bot_fun_def bot_option_def) - apply(subst state_update_vs_allInstances_generic_tc, simp, simp, (metis distinct_oid distinct_length_2_or_more)?, simp only: assms, blast, simp, rule const_StrictRefEq\<^sub>S\<^sub>e\<^sub>t_including, simp del: OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person, simp del: OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person, simp, rule OclIncluding_cong, (simp only: assms[symmetric ])?, simp add: valid_def OclValid_def bot_fun_def bot_option_def, (simp only: assms[symmetric ])?, simp add: valid_def OclValid_def bot_fun_def bot_option_def) - apply(subst state_update_vs_allInstances_generic_tc, simp, simp, (metis distinct_oid distinct_length_2_or_more)?, simp only: assms, blast, simp, rule const_StrictRefEq\<^sub>S\<^sub>e\<^sub>t_including, simp del: OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person, simp del: OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person, simp, rule OclIncluding_cong, (simp only: assms[symmetric ])?, simp add: valid_def OclValid_def bot_fun_def bot_option_def, (simp only: assms[symmetric ])?, simp add: valid_def OclValid_def bot_fun_def bot_option_def) - apply(subst state_update_vs_allInstances_generic_tc, simp, simp, (metis distinct_oid distinct_length_2_or_more)?, simp only: assms, blast, simp, rule const_StrictRefEq\<^sub>S\<^sub>e\<^sub>t_including, simp del: OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person, simp del: OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person, simp, rule OclIncluding_cong, (simp only: assms[symmetric ])?, simp add: valid_def OclValid_def bot_fun_def bot_option_def, (simp only: assms[symmetric ])?, simp add: valid_def OclValid_def bot_fun_def bot_option_def) - apply(subst state_update_vs_allInstances_generic_tc, simp, simp, (metis distinct_oid distinct_length_2_or_more)?, simp only: assms, blast, simp, rule const_StrictRefEq\<^sub>S\<^sub>e\<^sub>t_including, simp del: OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person, simp del: OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person, simp, rule OclIncluding_cong, (simp only: assms[symmetric ])?, simp add: valid_def OclValid_def bot_fun_def bot_option_def, (simp only: assms[symmetric ])?, simp add: valid_def OclValid_def bot_fun_def bot_option_def) - apply(subst state_update_vs_allInstances_generic_tc, simp, simp, (metis distinct_oid distinct_length_2_or_more)?, simp only: assms, blast, simp, rule const_StrictRefEq\<^sub>S\<^sub>e\<^sub>t_including, simp del: OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person, simp del: OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person, simp, rule OclIncluding_cong, (simp only: assms[symmetric ])?, simp add: valid_def OclValid_def bot_fun_def bot_option_def, (simp only: assms[symmetric ])?, simp add: valid_def OclValid_def bot_fun_def bot_option_def) - apply(subst state_update_vs_allInstances_generic_tc, simp, simp, (metis distinct_oid distinct_length_2_or_more)?, simp only: assms, blast, simp, rule const_StrictRefEq\<^sub>S\<^sub>e\<^sub>t_including, simp del: OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person, simp del: OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person, simp, rule OclIncluding_cong, (simp only: assms[symmetric ])?, simp add: valid_def OclValid_def bot_fun_def bot_option_def, (simp only: assms[symmetric ])?, simp add: valid_def OclValid_def bot_fun_def bot_option_def) - apply(subst state_update_vs_allInstances_generic_tc, simp, simp, (metis distinct_oid distinct_length_2_or_more)?, simp only: assms, blast, simp, rule const_StrictRefEq\<^sub>S\<^sub>e\<^sub>t_including, simp del: OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person, simp del: OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person, simp, rule OclIncluding_cong, (simp only: assms[symmetric ])?, simp add: valid_def OclValid_def bot_fun_def bot_option_def, (simp only: assms[symmetric ])?, simp add: valid_def OclValid_def bot_fun_def bot_option_def) - apply(rule state_update_vs_allInstances_generic_empty) -by(simp_all only: assms, (simp_all add: OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_\<AA>_def)?) - -lemma \<sigma>\<^sub>1'_OclAllInstances_at_post_exec_OclAny : -assumes [simp]: "(OclAny ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(OclAny ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(OclAny ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(OclAny ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(OclAny ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(OclAny ((in\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y)))) \<noteq> None" -assumes [simp]: "(OclAny ((in\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n8\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y)))) \<noteq> None" -assumes [simp]: "(OclAny ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(\<lambda>_. \<lfloor>(OclAny ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))))\<rfloor>) = ((((\<lambda>_. \<lfloor>\<lfloor>X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)::\<cdot>Person)) .oclAsType(OclAny))" -assumes [simp]: "(\<lambda>_. \<lfloor>(OclAny ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))))\<rfloor>) = ((((\<lambda>_. \<lfloor>\<lfloor>X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)::\<cdot>Person)) .oclAsType(OclAny))" -assumes [simp]: "(\<lambda>_. \<lfloor>(OclAny ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))))\<rfloor>) = ((((\<lambda>_. \<lfloor>\<lfloor>X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)::\<cdot>Person)) .oclAsType(OclAny))" -assumes [simp]: "(\<lambda>_. \<lfloor>(OclAny ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))))\<rfloor>) = ((((\<lambda>_. \<lfloor>\<lfloor>X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)::\<cdot>Person)) .oclAsType(OclAny))" -assumes [simp]: "(\<lambda>_. \<lfloor>(OclAny ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))))\<rfloor>) = ((((\<lambda>_. \<lfloor>\<lfloor>X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)::\<cdot>Person)) .oclAsType(OclAny))" -assumes [simp]: "(\<lambda>_. \<lfloor>(OclAny ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))))\<rfloor>) = ((((\<lambda>_. \<lfloor>\<lfloor>X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)::\<cdot>Person)) .oclAsType(OclAny))" -shows "(st , \<sigma>\<^sub>1') \<Turnstile> (OclAllInstances_at_post (OclAny)) \<doteq> Set{X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1 .oclAsType(OclAny) , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2 .oclAsType(OclAny) , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3 .oclAsType(OclAny) , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4 .oclAsType(OclAny) , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6 .oclAsType(OclAny) , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7 , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n8 , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9 .oclAsType(OclAny)}" - unfolding OclAllInstances_at_post_def -by(rule \<sigma>\<^sub>1'_OclAllInstances_generic_exec_OclAny, simp_all only: assms, simp_all) - -lemma \<sigma>\<^sub>1'_OclAllInstances_at_pre_exec_OclAny : -assumes [simp]: "(OclAny ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(OclAny ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(OclAny ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(OclAny ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(OclAny ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(OclAny ((in\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y)))) \<noteq> None" -assumes [simp]: "(OclAny ((in\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n8\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y)))) \<noteq> None" -assumes [simp]: "(OclAny ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(\<lambda>_. \<lfloor>(OclAny ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))))\<rfloor>) = ((((\<lambda>_. \<lfloor>\<lfloor>X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)::\<cdot>Person)) .oclAsType(OclAny))" -assumes [simp]: "(\<lambda>_. \<lfloor>(OclAny ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))))\<rfloor>) = ((((\<lambda>_. \<lfloor>\<lfloor>X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)::\<cdot>Person)) .oclAsType(OclAny))" -assumes [simp]: "(\<lambda>_. \<lfloor>(OclAny ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))))\<rfloor>) = ((((\<lambda>_. \<lfloor>\<lfloor>X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)::\<cdot>Person)) .oclAsType(OclAny))" -assumes [simp]: "(\<lambda>_. \<lfloor>(OclAny ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))))\<rfloor>) = ((((\<lambda>_. \<lfloor>\<lfloor>X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)::\<cdot>Person)) .oclAsType(OclAny))" -assumes [simp]: "(\<lambda>_. \<lfloor>(OclAny ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))))\<rfloor>) = ((((\<lambda>_. \<lfloor>\<lfloor>X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)::\<cdot>Person)) .oclAsType(OclAny))" -assumes [simp]: "(\<lambda>_. \<lfloor>(OclAny ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))))\<rfloor>) = ((((\<lambda>_. \<lfloor>\<lfloor>X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)::\<cdot>Person)) .oclAsType(OclAny))" -shows "(\<sigma>\<^sub>1' , st) \<Turnstile> (OclAllInstances_at_pre (OclAny)) \<doteq> Set{X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1 .oclAsType(OclAny) , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2 .oclAsType(OclAny) , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3 .oclAsType(OclAny) , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4 .oclAsType(OclAny) , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6 .oclAsType(OclAny) , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7 , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n8 , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9 .oclAsType(OclAny)}" - unfolding OclAllInstances_at_pre_def -by(rule \<sigma>\<^sub>1'_OclAllInstances_generic_exec_OclAny, simp_all only: assms, simp_all) - -ML \<open>(Ty'.check ([]) (" error(s)"))\<close> -end - -(* 161 ************************************ 966 + 1 *) (* term Floor2_examp.print_examp_def_st_def_interp *) -definition "(state_interpretation_\<sigma>\<^sub>1' (\<tau>)) = (state_\<sigma>\<^sub>1' (oid1) (oid2) (oid3) (oid4) (oid6) (oid7) (oid8) (oid9) (\<lceil>\<lceil>(X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1 (\<tau>))\<rceil>\<rceil>) (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1) (\<lceil>\<lceil>(X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2 (\<tau>))\<rceil>\<rceil>) (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2) (\<lceil>\<lceil>(X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3 (\<tau>))\<rceil>\<rceil>) (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3) (\<lceil>\<lceil>(X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4 (\<tau>))\<rceil>\<rceil>) (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4) (\<lceil>\<lceil>(X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6 (\<tau>))\<rceil>\<rceil>) (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6) (\<lceil>\<lceil>(X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7 (\<tau>))\<rceil>\<rceil>) (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7) (\<lceil>\<lceil>(X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n8 (\<tau>))\<rceil>\<rceil>) (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n8) (\<lceil>\<lceil>(X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9 (\<tau>))\<rceil>\<rceil>) (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9))" - -(* 162 ************************************ 967 + 1 *) -section \<open>Transition (Floor 2)\<close> - -(* 163 ************************************ 968 + 1 *) -locale transition_\<sigma>\<^sub>1_\<sigma>\<^sub>1' = -fixes "oid1" :: "nat" -fixes "oid2" :: "nat" -fixes "oid3" :: "nat" -fixes "oid4" :: "nat" -fixes "oid5" :: "nat" -fixes "oid6" :: "nat" -fixes "oid7" :: "nat" -fixes "oid8" :: "nat" -fixes "oid9" :: "nat" -assumes distinct_oid: "(distinct ([oid1 , oid2 , oid3 , oid4 , oid5 , oid6 , oid7 , oid8 , oid9]))" -fixes "\<sigma>\<^sub>1_object0\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n" :: "ty\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n" -fixes "\<sigma>\<^sub>1_object0" :: "\<cdot>Person" -assumes \<sigma>\<^sub>1_object0_def: "\<sigma>\<^sub>1_object0 = (\<lambda>_. \<lfloor>\<lfloor>\<sigma>\<^sub>1_object0\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)" -fixes "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n" :: "ty\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n" -fixes "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1" :: "\<cdot>Person" -assumes X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1_def: "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1 = (\<lambda>_. \<lfloor>\<lfloor>X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)" -fixes "\<sigma>\<^sub>1_object1\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n" :: "ty\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n" -fixes "\<sigma>\<^sub>1_object1" :: "\<cdot>Person" -assumes \<sigma>\<^sub>1_object1_def: "\<sigma>\<^sub>1_object1 = (\<lambda>_. \<lfloor>\<lfloor>\<sigma>\<^sub>1_object1\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)" -fixes "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n" :: "ty\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n" -fixes "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2" :: "\<cdot>Person" -assumes X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2_def: "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2 = (\<lambda>_. \<lfloor>\<lfloor>X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)" -fixes "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n" :: "ty\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n" -fixes "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3" :: "\<cdot>Person" -assumes X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3_def: "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3 = (\<lambda>_. \<lfloor>\<lfloor>X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)" -fixes "\<sigma>\<^sub>1_object2\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n" :: "ty\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n" -fixes "\<sigma>\<^sub>1_object2" :: "\<cdot>Person" -assumes \<sigma>\<^sub>1_object2_def: "\<sigma>\<^sub>1_object2 = (\<lambda>_. \<lfloor>\<lfloor>\<sigma>\<^sub>1_object2\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)" -fixes "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n" :: "ty\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n" -fixes "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4" :: "\<cdot>Person" -assumes X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4_def: "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4 = (\<lambda>_. \<lfloor>\<lfloor>X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)" -fixes "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n" :: "ty\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n" -fixes "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5" :: "\<cdot>Person" -assumes X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5_def: "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5 = (\<lambda>_. \<lfloor>\<lfloor>X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)" -fixes "\<sigma>\<^sub>1_object4\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n" :: "ty\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n" -fixes "\<sigma>\<^sub>1_object4" :: "\<cdot>Person" -assumes \<sigma>\<^sub>1_object4_def: "\<sigma>\<^sub>1_object4 = (\<lambda>_. \<lfloor>\<lfloor>\<sigma>\<^sub>1_object4\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)" -fixes "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n" :: "ty\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n" -fixes "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6" :: "\<cdot>Person" -assumes X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6_def: "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6 = (\<lambda>_. \<lfloor>\<lfloor>X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)" -fixes "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y" :: "ty\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y" -fixes "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7" :: "\<cdot>OclAny" -assumes X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7_def: "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7 = (\<lambda>_. \<lfloor>\<lfloor>X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y\<rfloor>\<rfloor>)" -fixes "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n8\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y" :: "ty\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y" -fixes "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n8" :: "\<cdot>OclAny" -assumes X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n8_def: "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n8 = (\<lambda>_. \<lfloor>\<lfloor>X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n8\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y\<rfloor>\<rfloor>)" -fixes "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n" :: "ty\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n" -fixes "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9" :: "\<cdot>Person" -assumes X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9_def: "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9 = (\<lambda>_. \<lfloor>\<lfloor>X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)" - -assumes \<sigma>\<^sub>1: "(state_\<sigma>\<^sub>1 (oid1) (oid2) (oid4) (oid5) (oid6) (oid9) (\<sigma>\<^sub>1_object0\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n) (\<sigma>\<^sub>1_object0) (\<sigma>\<^sub>1_object1\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n) (\<sigma>\<^sub>1_object1) (\<sigma>\<^sub>1_object2\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n) (\<sigma>\<^sub>1_object2) (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n) (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5) (\<sigma>\<^sub>1_object4\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n) (\<sigma>\<^sub>1_object4) (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n) (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9))" - -assumes \<sigma>\<^sub>1': "(state_\<sigma>\<^sub>1' (oid1) (oid2) (oid3) (oid4) (oid6) (oid7) (oid8) (oid9) (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n) (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1) (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n) (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2) (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n) (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3) (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n) (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4) (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n) (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6) (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y) (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7) (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n8\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y) (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n8) (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n) (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9))" -begin -interpretation state_\<sigma>\<^sub>1: state_\<sigma>\<^sub>1 "oid1" "oid2" "oid4" "oid5" "oid6" "oid9" "\<sigma>\<^sub>1_object0\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n" "\<sigma>\<^sub>1_object0" "\<sigma>\<^sub>1_object1\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n" "\<sigma>\<^sub>1_object1" "\<sigma>\<^sub>1_object2\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n" "\<sigma>\<^sub>1_object2" "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n" "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5" "\<sigma>\<^sub>1_object4\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n" "\<sigma>\<^sub>1_object4" "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n" "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9" -by(rule \<sigma>\<^sub>1) - -interpretation state_\<sigma>\<^sub>1': state_\<sigma>\<^sub>1' "oid1" "oid2" "oid3" "oid4" "oid6" "oid7" "oid8" "oid9" "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n" "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1" "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n" "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2" "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n" "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3" "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n" "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4" "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n" "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6" "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y" "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7" "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n8\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y" "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n8" "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n" "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9" -by(rule \<sigma>\<^sub>1') - -definition "\<sigma>\<^sub>1 = state_\<sigma>\<^sub>1.\<sigma>\<^sub>1" - -definition "\<sigma>\<^sub>1' = state_\<sigma>\<^sub>1'.\<sigma>\<^sub>1'" - -lemma basic_\<sigma>\<^sub>1_\<sigma>\<^sub>1'_wff : -assumes [simp]: "(oid_of ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (\<sigma>\<^sub>1_object0\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) = oid1" -assumes [simp]: "(oid_of ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) = oid1" -assumes [simp]: "(oid_of ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (\<sigma>\<^sub>1_object1\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) = oid2" -assumes [simp]: "(oid_of ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) = oid2" -assumes [simp]: "(oid_of ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) = oid3" -assumes [simp]: "(oid_of ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (\<sigma>\<^sub>1_object2\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) = oid4" -assumes [simp]: "(oid_of ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) = oid4" -assumes [simp]: "(oid_of ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) = oid5" -assumes [simp]: "(oid_of ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (\<sigma>\<^sub>1_object4\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) = oid6" -assumes [simp]: "(oid_of ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) = oid6" -assumes [simp]: "(oid_of ((in\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y)))) = oid7" -assumes [simp]: "(oid_of ((in\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n8\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y)))) = oid8" -assumes [simp]: "(oid_of ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) = oid9" -shows "(WFF ((state_\<sigma>\<^sub>1.\<sigma>\<^sub>1 , state_\<sigma>\<^sub>1'.\<sigma>\<^sub>1')))" - proof - have [simp]: "oid1 \<noteq> oid2" by(metis distinct_oid distinct_length_2_or_more) show ?thesis - proof - have [simp]: "oid1 \<noteq> oid3" by(metis distinct_oid distinct_length_2_or_more) show ?thesis - proof - have [simp]: "oid1 \<noteq> oid4" by(metis distinct_oid distinct_length_2_or_more) show ?thesis - proof - have [simp]: "oid1 \<noteq> oid5" by(metis distinct_oid distinct_length_2_or_more) show ?thesis - proof - have [simp]: "oid1 \<noteq> oid6" by(metis distinct_oid distinct_length_2_or_more) show ?thesis - proof - have [simp]: "oid1 \<noteq> oid7" by(metis distinct_oid distinct_length_2_or_more) show ?thesis - proof - have [simp]: "oid1 \<noteq> oid8" by(metis distinct_oid distinct_length_2_or_more) show ?thesis - proof - have [simp]: "oid1 \<noteq> oid9" by(metis distinct_oid distinct_length_2_or_more) show ?thesis - proof - have [simp]: "oid2 \<noteq> oid1" by(metis distinct_oid distinct_length_2_or_more) show ?thesis - proof - have [simp]: "oid2 \<noteq> oid3" by(metis distinct_oid distinct_length_2_or_more) show ?thesis - proof - have [simp]: "oid2 \<noteq> oid4" by(metis distinct_oid distinct_length_2_or_more) show ?thesis - proof - have [simp]: "oid2 \<noteq> oid5" by(metis distinct_oid distinct_length_2_or_more) show ?thesis - proof - have [simp]: "oid2 \<noteq> oid6" by(metis distinct_oid distinct_length_2_or_more) show ?thesis - proof - have [simp]: "oid2 \<noteq> oid7" by(metis distinct_oid distinct_length_2_or_more) show ?thesis - proof - have [simp]: "oid2 \<noteq> oid8" by(metis distinct_oid distinct_length_2_or_more) show ?thesis - proof - have [simp]: "oid2 \<noteq> oid9" by(metis distinct_oid distinct_length_2_or_more) show ?thesis - proof - have [simp]: "oid3 \<noteq> oid1" by(metis distinct_oid distinct_length_2_or_more) show ?thesis - proof - have [simp]: "oid3 \<noteq> oid2" by(metis distinct_oid distinct_length_2_or_more) show ?thesis - proof - have [simp]: "oid3 \<noteq> oid4" by(metis distinct_oid distinct_length_2_or_more) show ?thesis - proof - have [simp]: "oid3 \<noteq> oid5" by(metis distinct_oid distinct_length_2_or_more) show ?thesis - proof - have [simp]: "oid3 \<noteq> oid6" by(metis distinct_oid distinct_length_2_or_more) show ?thesis - proof - have [simp]: "oid3 \<noteq> oid7" by(metis distinct_oid distinct_length_2_or_more) show ?thesis - proof - have [simp]: "oid3 \<noteq> oid8" by(metis distinct_oid distinct_length_2_or_more) show ?thesis - proof - have [simp]: "oid3 \<noteq> oid9" by(metis distinct_oid distinct_length_2_or_more) show ?thesis - proof - have [simp]: "oid4 \<noteq> oid1" by(metis distinct_oid distinct_length_2_or_more) show ?thesis - proof - have [simp]: "oid4 \<noteq> oid2" by(metis distinct_oid distinct_length_2_or_more) show ?thesis - proof - have [simp]: "oid4 \<noteq> oid3" by(metis distinct_oid distinct_length_2_or_more) show ?thesis - proof - have [simp]: "oid4 \<noteq> oid5" by(metis distinct_oid distinct_length_2_or_more) show ?thesis - proof - have [simp]: "oid4 \<noteq> oid6" by(metis distinct_oid distinct_length_2_or_more) show ?thesis - proof - have [simp]: "oid4 \<noteq> oid7" by(metis distinct_oid distinct_length_2_or_more) show ?thesis - proof - have [simp]: "oid4 \<noteq> oid8" by(metis distinct_oid distinct_length_2_or_more) show ?thesis - proof - have [simp]: "oid4 \<noteq> oid9" by(metis distinct_oid distinct_length_2_or_more) show ?thesis - proof - have [simp]: "oid5 \<noteq> oid1" by(metis distinct_oid distinct_length_2_or_more) show ?thesis - proof - have [simp]: "oid5 \<noteq> oid2" by(metis distinct_oid distinct_length_2_or_more) show ?thesis - proof - have [simp]: "oid5 \<noteq> oid3" by(metis distinct_oid distinct_length_2_or_more) show ?thesis - proof - have [simp]: "oid5 \<noteq> oid4" by(metis distinct_oid distinct_length_2_or_more) show ?thesis - proof - have [simp]: "oid5 \<noteq> oid6" by(metis distinct_oid distinct_length_2_or_more) show ?thesis - proof - have [simp]: "oid5 \<noteq> oid7" by(metis distinct_oid distinct_length_2_or_more) show ?thesis - proof - have [simp]: "oid5 \<noteq> oid8" by(metis distinct_oid distinct_length_2_or_more) show ?thesis - proof - have [simp]: "oid5 \<noteq> oid9" by(metis distinct_oid distinct_length_2_or_more) show ?thesis - proof - have [simp]: "oid6 \<noteq> oid1" by(metis distinct_oid distinct_length_2_or_more) show ?thesis - proof - have [simp]: "oid6 \<noteq> oid2" by(metis distinct_oid distinct_length_2_or_more) show ?thesis - proof - have [simp]: "oid6 \<noteq> oid3" by(metis distinct_oid distinct_length_2_or_more) show ?thesis - proof - have [simp]: "oid6 \<noteq> oid4" by(metis distinct_oid distinct_length_2_or_more) show ?thesis - proof - have [simp]: "oid6 \<noteq> oid5" by(metis distinct_oid distinct_length_2_or_more) show ?thesis - proof - have [simp]: "oid6 \<noteq> oid7" by(metis distinct_oid distinct_length_2_or_more) show ?thesis - proof - have [simp]: "oid6 \<noteq> oid8" by(metis distinct_oid distinct_length_2_or_more) show ?thesis - proof - have [simp]: "oid6 \<noteq> oid9" by(metis distinct_oid distinct_length_2_or_more) show ?thesis - proof - have [simp]: "oid7 \<noteq> oid1" by(metis distinct_oid distinct_length_2_or_more) show ?thesis - proof - have [simp]: "oid7 \<noteq> oid2" by(metis distinct_oid distinct_length_2_or_more) show ?thesis - proof - have [simp]: "oid7 \<noteq> oid3" by(metis distinct_oid distinct_length_2_or_more) show ?thesis - proof - have [simp]: "oid7 \<noteq> oid4" by(metis distinct_oid distinct_length_2_or_more) show ?thesis - proof - have [simp]: "oid7 \<noteq> oid5" by(metis distinct_oid distinct_length_2_or_more) show ?thesis - proof - have [simp]: "oid7 \<noteq> oid6" by(metis distinct_oid distinct_length_2_or_more) show ?thesis - proof - have [simp]: "oid7 \<noteq> oid8" by(metis distinct_oid distinct_length_2_or_more) show ?thesis - proof - have [simp]: "oid7 \<noteq> oid9" by(metis distinct_oid distinct_length_2_or_more) show ?thesis - proof - have [simp]: "oid8 \<noteq> oid1" by(metis distinct_oid distinct_length_2_or_more) show ?thesis - proof - have [simp]: "oid8 \<noteq> oid2" by(metis distinct_oid distinct_length_2_or_more) show ?thesis - proof - have [simp]: "oid8 \<noteq> oid3" by(metis distinct_oid distinct_length_2_or_more) show ?thesis - proof - have [simp]: "oid8 \<noteq> oid4" by(metis distinct_oid distinct_length_2_or_more) show ?thesis - proof - have [simp]: "oid8 \<noteq> oid5" by(metis distinct_oid distinct_length_2_or_more) show ?thesis - proof - have [simp]: "oid8 \<noteq> oid6" by(metis distinct_oid distinct_length_2_or_more) show ?thesis - proof - have [simp]: "oid8 \<noteq> oid7" by(metis distinct_oid distinct_length_2_or_more) show ?thesis - proof - have [simp]: "oid8 \<noteq> oid9" by(metis distinct_oid distinct_length_2_or_more) show ?thesis - proof - have [simp]: "oid9 \<noteq> oid1" by(metis distinct_oid distinct_length_2_or_more) show ?thesis - proof - have [simp]: "oid9 \<noteq> oid2" by(metis distinct_oid distinct_length_2_or_more) show ?thesis - proof - have [simp]: "oid9 \<noteq> oid3" by(metis distinct_oid distinct_length_2_or_more) show ?thesis - proof - have [simp]: "oid9 \<noteq> oid4" by(metis distinct_oid distinct_length_2_or_more) show ?thesis - proof - have [simp]: "oid9 \<noteq> oid5" by(metis distinct_oid distinct_length_2_or_more) show ?thesis - proof - have [simp]: "oid9 \<noteq> oid6" by(metis distinct_oid distinct_length_2_or_more) show ?thesis - proof - have [simp]: "oid9 \<noteq> oid7" by(metis distinct_oid distinct_length_2_or_more) show ?thesis - proof - have [simp]: "oid9 \<noteq> oid8" by(metis distinct_oid distinct_length_2_or_more) show ?thesis -by(auto simp: WFF_def state_\<sigma>\<^sub>1.\<sigma>\<^sub>1_def state_\<sigma>\<^sub>1'.\<sigma>\<^sub>1'_def) qed qed qed qed qed qed qed qed qed qed qed qed qed qed qed qed qed qed qed qed qed qed qed qed qed qed qed qed qed qed qed qed qed qed qed qed qed qed qed qed qed qed qed qed qed qed qed qed qed qed qed qed qed qed qed qed qed qed qed qed qed qed qed qed qed qed qed qed qed qed qed qed - -lemma oid1\<sigma>\<^sub>1\<sigma>\<^sub>1'_\<sigma>\<^sub>1_OclIsMaintained : -assumes [simp]: "(oid_of (\<sigma>\<^sub>1_object0\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)) = oid1" -shows "(state_\<sigma>\<^sub>1.\<sigma>\<^sub>1 , state_\<sigma>\<^sub>1'.\<sigma>\<^sub>1') \<Turnstile> (OclIsMaintained (\<sigma>\<^sub>1_object0))" - apply(simp add: state_\<sigma>\<^sub>1.\<sigma>\<^sub>1_def state_\<sigma>\<^sub>1'.\<sigma>\<^sub>1'_def \<sigma>\<^sub>1_object0_def OclIsMaintained_def OclValid_def oid_of_option_def) -by((metis distinct_oid distinct_length_2_or_more)?) - -lemma oid1\<sigma>\<^sub>1\<sigma>\<^sub>1'_\<sigma>\<^sub>1'_OclIsMaintained : -assumes [simp]: "(oid_of (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)) = oid1" -shows "(state_\<sigma>\<^sub>1.\<sigma>\<^sub>1 , state_\<sigma>\<^sub>1'.\<sigma>\<^sub>1') \<Turnstile> (OclIsMaintained (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1))" - apply(simp add: state_\<sigma>\<^sub>1.\<sigma>\<^sub>1_def state_\<sigma>\<^sub>1'.\<sigma>\<^sub>1'_def X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1_def OclIsMaintained_def OclValid_def oid_of_option_def) -by((metis distinct_oid distinct_length_2_or_more)?) - -lemma oid2\<sigma>\<^sub>1\<sigma>\<^sub>1'_\<sigma>\<^sub>1_OclIsMaintained : -assumes [simp]: "(oid_of (\<sigma>\<^sub>1_object1\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)) = oid2" -shows "(state_\<sigma>\<^sub>1.\<sigma>\<^sub>1 , state_\<sigma>\<^sub>1'.\<sigma>\<^sub>1') \<Turnstile> (OclIsMaintained (\<sigma>\<^sub>1_object1))" - apply(simp add: state_\<sigma>\<^sub>1.\<sigma>\<^sub>1_def state_\<sigma>\<^sub>1'.\<sigma>\<^sub>1'_def \<sigma>\<^sub>1_object1_def OclIsMaintained_def OclValid_def oid_of_option_def) -by((metis distinct_oid distinct_length_2_or_more)?) - -lemma oid2\<sigma>\<^sub>1\<sigma>\<^sub>1'_\<sigma>\<^sub>1'_OclIsMaintained : -assumes [simp]: "(oid_of (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)) = oid2" -shows "(state_\<sigma>\<^sub>1.\<sigma>\<^sub>1 , state_\<sigma>\<^sub>1'.\<sigma>\<^sub>1') \<Turnstile> (OclIsMaintained (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2))" - apply(simp add: state_\<sigma>\<^sub>1.\<sigma>\<^sub>1_def state_\<sigma>\<^sub>1'.\<sigma>\<^sub>1'_def X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2_def OclIsMaintained_def OclValid_def oid_of_option_def) -by((metis distinct_oid distinct_length_2_or_more)?) - -lemma oid3\<sigma>\<^sub>1\<sigma>\<^sub>1'_\<sigma>\<^sub>1'_OclIsNew : -assumes [simp]: "(oid_of (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)) = oid3" -shows "(state_\<sigma>\<^sub>1.\<sigma>\<^sub>1 , state_\<sigma>\<^sub>1'.\<sigma>\<^sub>1') \<Turnstile> (OclIsNew (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3))" - apply(simp add: state_\<sigma>\<^sub>1.\<sigma>\<^sub>1_def state_\<sigma>\<^sub>1'.\<sigma>\<^sub>1'_def X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3_def OclIsNew_def OclValid_def oid_of_option_def) -by((metis distinct_oid distinct_length_2_or_more)?) - -lemma oid4\<sigma>\<^sub>1\<sigma>\<^sub>1'_\<sigma>\<^sub>1_OclIsMaintained : -assumes [simp]: "(oid_of (\<sigma>\<^sub>1_object2\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)) = oid4" -shows "(state_\<sigma>\<^sub>1.\<sigma>\<^sub>1 , state_\<sigma>\<^sub>1'.\<sigma>\<^sub>1') \<Turnstile> (OclIsMaintained (\<sigma>\<^sub>1_object2))" - apply(simp add: state_\<sigma>\<^sub>1.\<sigma>\<^sub>1_def state_\<sigma>\<^sub>1'.\<sigma>\<^sub>1'_def \<sigma>\<^sub>1_object2_def OclIsMaintained_def OclValid_def oid_of_option_def) -by((metis distinct_oid distinct_length_2_or_more)?) - -lemma oid4\<sigma>\<^sub>1\<sigma>\<^sub>1'_\<sigma>\<^sub>1'_OclIsMaintained : -assumes [simp]: "(oid_of (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)) = oid4" -shows "(state_\<sigma>\<^sub>1.\<sigma>\<^sub>1 , state_\<sigma>\<^sub>1'.\<sigma>\<^sub>1') \<Turnstile> (OclIsMaintained (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4))" - apply(simp add: state_\<sigma>\<^sub>1.\<sigma>\<^sub>1_def state_\<sigma>\<^sub>1'.\<sigma>\<^sub>1'_def X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4_def OclIsMaintained_def OclValid_def oid_of_option_def) -by((metis distinct_oid distinct_length_2_or_more)?) - -lemma oid5\<sigma>\<^sub>1\<sigma>\<^sub>1'_\<sigma>\<^sub>1_OclIsDeleted : -assumes [simp]: "(oid_of (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)) = oid5" -shows "(state_\<sigma>\<^sub>1.\<sigma>\<^sub>1 , state_\<sigma>\<^sub>1'.\<sigma>\<^sub>1') \<Turnstile> (OclIsDeleted (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5))" - apply(simp add: state_\<sigma>\<^sub>1.\<sigma>\<^sub>1_def state_\<sigma>\<^sub>1'.\<sigma>\<^sub>1'_def X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5_def OclIsDeleted_def OclValid_def oid_of_option_def) -by((metis distinct_oid distinct_length_2_or_more)?) - -lemma oid6\<sigma>\<^sub>1\<sigma>\<^sub>1'_\<sigma>\<^sub>1_OclIsMaintained : -assumes [simp]: "(oid_of (\<sigma>\<^sub>1_object4\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)) = oid6" -shows "(state_\<sigma>\<^sub>1.\<sigma>\<^sub>1 , state_\<sigma>\<^sub>1'.\<sigma>\<^sub>1') \<Turnstile> (OclIsMaintained (\<sigma>\<^sub>1_object4))" - apply(simp add: state_\<sigma>\<^sub>1.\<sigma>\<^sub>1_def state_\<sigma>\<^sub>1'.\<sigma>\<^sub>1'_def \<sigma>\<^sub>1_object4_def OclIsMaintained_def OclValid_def oid_of_option_def) -by((metis distinct_oid distinct_length_2_or_more)?) - -lemma oid6\<sigma>\<^sub>1\<sigma>\<^sub>1'_\<sigma>\<^sub>1'_OclIsMaintained : -assumes [simp]: "(oid_of (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)) = oid6" -shows "(state_\<sigma>\<^sub>1.\<sigma>\<^sub>1 , state_\<sigma>\<^sub>1'.\<sigma>\<^sub>1') \<Turnstile> (OclIsMaintained (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6))" - apply(simp add: state_\<sigma>\<^sub>1.\<sigma>\<^sub>1_def state_\<sigma>\<^sub>1'.\<sigma>\<^sub>1'_def X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6_def OclIsMaintained_def OclValid_def oid_of_option_def) -by((metis distinct_oid distinct_length_2_or_more)?) - -lemma oid7\<sigma>\<^sub>1\<sigma>\<^sub>1'_\<sigma>\<^sub>1'_OclIsNew : -assumes [simp]: "(oid_of (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y)) = oid7" -shows "(state_\<sigma>\<^sub>1.\<sigma>\<^sub>1 , state_\<sigma>\<^sub>1'.\<sigma>\<^sub>1') \<Turnstile> (OclIsNew (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7))" - apply(simp add: state_\<sigma>\<^sub>1.\<sigma>\<^sub>1_def state_\<sigma>\<^sub>1'.\<sigma>\<^sub>1'_def X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7_def OclIsNew_def OclValid_def oid_of_option_def) -by((metis distinct_oid distinct_length_2_or_more)?) - -lemma oid8\<sigma>\<^sub>1\<sigma>\<^sub>1'_\<sigma>\<^sub>1'_OclIsNew : -assumes [simp]: "(oid_of (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n8\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y)) = oid8" -shows "(state_\<sigma>\<^sub>1.\<sigma>\<^sub>1 , state_\<sigma>\<^sub>1'.\<sigma>\<^sub>1') \<Turnstile> (OclIsNew (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n8))" - apply(simp add: state_\<sigma>\<^sub>1.\<sigma>\<^sub>1_def state_\<sigma>\<^sub>1'.\<sigma>\<^sub>1'_def X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n8_def OclIsNew_def OclValid_def oid_of_option_def) -by((metis distinct_oid distinct_length_2_or_more)?) - -lemma oid9\<sigma>\<^sub>1\<sigma>\<^sub>1'_\<sigma>\<^sub>1_OclIsMaintained : -assumes [simp]: "(oid_of (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)) = oid9" -shows "(state_\<sigma>\<^sub>1.\<sigma>\<^sub>1 , state_\<sigma>\<^sub>1'.\<sigma>\<^sub>1') \<Turnstile> (OclIsMaintained (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9))" - apply(simp add: state_\<sigma>\<^sub>1.\<sigma>\<^sub>1_def state_\<sigma>\<^sub>1'.\<sigma>\<^sub>1'_def X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9_def OclIsMaintained_def OclValid_def oid_of_option_def) -by((metis distinct_oid distinct_length_2_or_more)?) - -lemma oid9\<sigma>\<^sub>1\<sigma>\<^sub>1'_\<sigma>\<^sub>1'_OclIsMaintained : -assumes [simp]: "(oid_of (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)) = oid9" -shows "(state_\<sigma>\<^sub>1.\<sigma>\<^sub>1 , state_\<sigma>\<^sub>1'.\<sigma>\<^sub>1') \<Turnstile> (OclIsMaintained (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9))" - apply(simp add: state_\<sigma>\<^sub>1.\<sigma>\<^sub>1_def state_\<sigma>\<^sub>1'.\<sigma>\<^sub>1'_def X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9_def OclIsMaintained_def OclValid_def oid_of_option_def) -by((metis distinct_oid distinct_length_2_or_more)?) -end - -(* 164 ************************************ 969 + 1 *) (* term Floor2_examp.print_transition_def_interp *) -definition "(pp_\<sigma>\<^sub>1_\<sigma>\<^sub>1' (\<tau>)) = (transition_\<sigma>\<^sub>1_\<sigma>\<^sub>1' (oid1) (oid2) (oid3) (oid4) (oid5) (oid6) (oid7) (oid8) (oid9) (\<lceil>\<lceil>(\<sigma>\<^sub>1_object0 (\<tau>))\<rceil>\<rceil>) (\<sigma>\<^sub>1_object0) (\<lceil>\<lceil>(X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1 (\<tau>))\<rceil>\<rceil>) (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1) (\<lceil>\<lceil>(\<sigma>\<^sub>1_object1 (\<tau>))\<rceil>\<rceil>) (\<sigma>\<^sub>1_object1) (\<lceil>\<lceil>(X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2 (\<tau>))\<rceil>\<rceil>) (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2) (\<lceil>\<lceil>(X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3 (\<tau>))\<rceil>\<rceil>) (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3) (\<lceil>\<lceil>(\<sigma>\<^sub>1_object2 (\<tau>))\<rceil>\<rceil>) (\<sigma>\<^sub>1_object2) (\<lceil>\<lceil>(X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4 (\<tau>))\<rceil>\<rceil>) (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4) (\<lceil>\<lceil>(X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5 (\<tau>))\<rceil>\<rceil>) (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5) (\<lceil>\<lceil>(\<sigma>\<^sub>1_object4 (\<tau>))\<rceil>\<rceil>) (\<sigma>\<^sub>1_object4) (\<lceil>\<lceil>(X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6 (\<tau>))\<rceil>\<rceil>) (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6) (\<lceil>\<lceil>(X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7 (\<tau>))\<rceil>\<rceil>) (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7) (\<lceil>\<lceil>(X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n8 (\<tau>))\<rceil>\<rceil>) (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n8) (\<lceil>\<lceil>(X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9 (\<tau>))\<rceil>\<rceil>) (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9))" - -(* 165 ************************************ 970 + 3 *) (* term Floor2_examp.print_transition_lemmas_oid *) -lemmas pp_oid_\<sigma>\<^sub>1_\<sigma>\<^sub>1' = oid1_def - oid2_def - oid3_def - oid4_def - oid5_def - oid6_def - oid7_def - oid8_def - oid9_def -lemmas pp_object_\<sigma>\<^sub>1_\<sigma>\<^sub>1' = \<sigma>\<^sub>1_object0_def - X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1_def - \<sigma>\<^sub>1_object1_def - X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2_def - X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3_def - \<sigma>\<^sub>1_object2_def - X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4_def - X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5_def - \<sigma>\<^sub>1_object4_def - X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6_def - X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7_def - X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n8_def - X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9_def -lemmas pp_object_ty_\<sigma>\<^sub>1_\<sigma>\<^sub>1' = \<sigma>\<^sub>1_object0\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_def - X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_def - \<sigma>\<^sub>1_object1\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_def - X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_def - X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_def - \<sigma>\<^sub>1_object2\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_def - X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_def - X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_def - \<sigma>\<^sub>1_object4\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_def - X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_def - X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_def - X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n8\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_def - X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_def - -(* 166 ************************************ 973 + 1 *) -section \<open>Context (Floor 2)\<close> - -(* 167 ************************************ 974 + 6 *) (* term Floor2_ctxt.print_ctxt_pre_post *) -axiomatization where dot__contents_Person_def: -"(self::\<cdot>Person) .contents() \<equiv> (\<lambda>\<tau>. (Eps ((\<lambda>result. (HOL.Let ((\<lambda>_. result)) ((\<lambda>result. (if ((\<tau> \<Turnstile> ((\<delta> (self))))) then (\<tau> \<Turnstile> ((((UML_Logic.false :: (((_, Product_Type.unit) UML_Types.state.state_ext \<times> (_, Product_Type.unit) UML_Types.state.state_ext) \<Rightarrow> ((HOL.bool) Option.option) Option.option)))))) \<and> (\<tau> \<Turnstile> ((((((UML_Logic.StrongEq :: ((((Employee_AnalysisModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext \<times> (Employee_AnalysisModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext) \<Rightarrow> (((Int.int) Option.option) Option.option) UML_Types.Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e) \<Rightarrow> ((((Employee_AnalysisModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext \<times> (Employee_AnalysisModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext) \<Rightarrow> (((Int.int) Option.option) Option.option) UML_Types.Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e) \<Rightarrow> (((Employee_AnalysisModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext \<times> (Employee_AnalysisModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext) \<Rightarrow> ((HOL.bool) Option.option) Option.option))))) (result)) (((((UML_Logic.OclIf :: ((((Employee_AnalysisModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext \<times> (Employee_AnalysisModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext) \<Rightarrow> ((HOL.bool) Option.option) Option.option) \<Rightarrow> ((((Employee_AnalysisModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext \<times> (Employee_AnalysisModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext) \<Rightarrow> (((Int.int) Option.option) Option.option) UML_Types.Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e) \<Rightarrow> ((((Employee_AnalysisModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext \<times> (Employee_AnalysisModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext) \<Rightarrow> (((Int.int) Option.option) Option.option) UML_Types.Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e) \<Rightarrow> (((Employee_AnalysisModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext \<times> (Employee_AnalysisModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext) \<Rightarrow> (((Int.int) Option.option) Option.option) UML_Types.Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e)))))) ((((UML_Logic.StrictRefEq :: ((((Employee_AnalysisModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext \<times> (Employee_AnalysisModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext) \<Rightarrow> ((Employee_AnalysisModel_UMLPart_generated.ty\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n) Option.option) Option.option) \<Rightarrow> ((((Employee_AnalysisModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext \<times> (Employee_AnalysisModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext) \<Rightarrow> ((Employee_AnalysisModel_UMLPart_generated.ty\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n) Option.option) Option.option) \<Rightarrow> (((Employee_AnalysisModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext \<times> (Employee_AnalysisModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext) \<Rightarrow> ((HOL.bool) Option.option) Option.option))))) (((Employee_AnalysisModel_UMLPart_generated.dot_0___boss :: ((((Employee_AnalysisModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext \<times> (Employee_AnalysisModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext) \<Rightarrow> _) \<Rightarrow> (((Employee_AnalysisModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext \<times> (Employee_AnalysisModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext) \<Rightarrow> ((Employee_AnalysisModel_UMLPart_generated.ty\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n) Option.option) Option.option)))) (self))) ((UML_Types.null_class.null :: (((Employee_AnalysisModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext \<times> (Employee_AnalysisModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext) \<Rightarrow> ((Employee_AnalysisModel_UMLPart_generated.ty\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n) Option.option) Option.option))))) ((((UML_Set.OclIncluding :: ((((Employee_AnalysisModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext \<times> (Employee_AnalysisModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext) \<Rightarrow> (((Int.int) Option.option) Option.option) UML_Types.Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e) \<Rightarrow> ((((Employee_AnalysisModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext \<times> (Employee_AnalysisModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext) \<Rightarrow> ((Int.int) Option.option) Option.option) \<Rightarrow> (((Employee_AnalysisModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext \<times> (Employee_AnalysisModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext) \<Rightarrow> (((Int.int) Option.option) Option.option) UML_Types.Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e))))) ((UML_Set.mtSet :: (((Employee_AnalysisModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext \<times> (Employee_AnalysisModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext) \<Rightarrow> (((Int.int) Option.option) Option.option) UML_Types.Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e)))) (((Employee_AnalysisModel_UMLPart_generated.dot__salary :: ((((Employee_AnalysisModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext \<times> (Employee_AnalysisModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext) \<Rightarrow> _) \<Rightarrow> (((Employee_AnalysisModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext \<times> (Employee_AnalysisModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext) \<Rightarrow> ((Int.int) Option.option) Option.option)))) (self)))) ((((UML_Set.OclIncluding :: ((((Employee_AnalysisModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext \<times> (Employee_AnalysisModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext) \<Rightarrow> (((Int.int) Option.option) Option.option) UML_Types.Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e) \<Rightarrow> ((((Employee_AnalysisModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext \<times> (Employee_AnalysisModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext) \<Rightarrow> ((Int.int) Option.option) Option.option) \<Rightarrow> (((Employee_AnalysisModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext \<times> (Employee_AnalysisModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext) \<Rightarrow> (((Int.int) Option.option) Option.option) UML_Types.Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e))))) (((Employee_AnalysisModel_UMLPart_generated.dot__contents :: ((((Employee_AnalysisModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext \<times> (Employee_AnalysisModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext) \<Rightarrow> ((Employee_AnalysisModel_UMLPart_generated.ty\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n) Option.option) Option.option) \<Rightarrow> (((Employee_AnalysisModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext \<times> (Employee_AnalysisModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext) \<Rightarrow> (((Int.int) Option.option) Option.option) UML_Types.Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e)))) (((Employee_AnalysisModel_UMLPart_generated.dot_0___boss :: ((((Employee_AnalysisModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext \<times> (Employee_AnalysisModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext) \<Rightarrow> _) \<Rightarrow> (((Employee_AnalysisModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext \<times> (Employee_AnalysisModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext) \<Rightarrow> ((Employee_AnalysisModel_UMLPart_generated.ty\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n) Option.option) Option.option)))) (self)))) (((Employee_AnalysisModel_UMLPart_generated.dot__salary :: ((((Employee_AnalysisModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext \<times> (Employee_AnalysisModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext) \<Rightarrow> _) \<Rightarrow> (((Employee_AnalysisModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext \<times> (Employee_AnalysisModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext) \<Rightarrow> ((Int.int) Option.option) Option.option)))) (self)))) and (UML_Logic.true :: (((_, Product_Type.unit) UML_Types.state.state_ext \<times> (_, Product_Type.unit) UML_Types.state.state_ext) \<Rightarrow> ((HOL.bool) Option.option) Option.option)))))) else (\<tau> \<Turnstile> (result \<triangleq> invalid))))))))))" -thm dot__contents_Person_def -overloading dot__contents \<equiv> "(dot__contents::(\<cdot>Planet) \<Rightarrow> _)" -begin - definition dot__contents_Planet : "(x::\<cdot>Planet) .contents() \<equiv> x .oclAsType(Person) .contents()" -end -overloading dot__contents \<equiv> "(dot__contents::(\<cdot>Galaxy) \<Rightarrow> _)" -begin - definition dot__contents_Galaxy : "(x::\<cdot>Galaxy) .contents() \<equiv> x .oclAsType(Person) .contents()" -end -overloading dot__contents \<equiv> "(dot__contents::(\<cdot>OclAny) \<Rightarrow> _)" -begin - definition dot__contents_OclAny : "(x::\<cdot>OclAny) .contents() \<equiv> x .oclAsType(Person) .contents()" -end -ML \<open>(Ty'.check ([]) (" error(s)"))\<close> - -(* 168 ************************************ 980 + 0 *) (* term Floor2_ctxt.print_ctxt_inv *) - -(* 169 ************************************ 980 + 0 *) (* term Floor2_ctxt.print_ctxt_thm *) - -(* 170 ************************************ 980 + 1 *) -section \<open>Context (Floor 2)\<close> - -(* 171 ************************************ 981 + 0 *) (* term Floor2_ctxt.print_ctxt_pre_post *) - -(* 172 ************************************ 981 + 3 *) (* term Floor2_ctxt.print_ctxt_inv *) -definition "Person_aat_pre = (\<lambda>\<tau>. (\<tau> \<Turnstile> (UML_Set.OclForall ((OclAllInstances_at_pre (Person))) ((\<lambda>self. (((UML_Logic.OclImplies :: ((((Employee_AnalysisModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext \<times> (Employee_AnalysisModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext) \<Rightarrow> ((HOL.bool) Option.option) Option.option) \<Rightarrow> ((((Employee_AnalysisModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext \<times> (Employee_AnalysisModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext) \<Rightarrow> ((HOL.bool) Option.option) Option.option) \<Rightarrow> (((Employee_AnalysisModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext \<times> (Employee_AnalysisModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext) \<Rightarrow> ((HOL.bool) Option.option) Option.option))))) (((UML_Logic.OclNot :: ((((Employee_AnalysisModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext \<times> (Employee_AnalysisModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext) \<Rightarrow> ((HOL.bool) Option.option) Option.option) \<Rightarrow> (((Employee_AnalysisModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext \<times> (Employee_AnalysisModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext) \<Rightarrow> ((HOL.bool) Option.option) Option.option)))) ((((UML_Logic.StrictRefEq :: ((((Employee_AnalysisModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext \<times> (Employee_AnalysisModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext) \<Rightarrow> ((Employee_AnalysisModel_UMLPart_generated.ty\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n) Option.option) Option.option) \<Rightarrow> ((((Employee_AnalysisModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext \<times> (Employee_AnalysisModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext) \<Rightarrow> ((Employee_AnalysisModel_UMLPart_generated.ty\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n) Option.option) Option.option) \<Rightarrow> (((Employee_AnalysisModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext \<times> (Employee_AnalysisModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext) \<Rightarrow> ((HOL.bool) Option.option) Option.option))))) (((Employee_AnalysisModel_UMLPart_generated.dot_0___bossat_pre :: ((((Employee_AnalysisModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext \<times> (Employee_AnalysisModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext) \<Rightarrow> _) \<Rightarrow> (((Employee_AnalysisModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext \<times> (Employee_AnalysisModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext) \<Rightarrow> ((Employee_AnalysisModel_UMLPart_generated.ty\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n) Option.option) Option.option)))) (self))) ((UML_Types.null_class.null :: (((Employee_AnalysisModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext \<times> (Employee_AnalysisModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext) \<Rightarrow> ((Employee_AnalysisModel_UMLPart_generated.ty\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n) Option.option) Option.option)))))) ((((UML_Logic.StrongEq :: ((((Employee_AnalysisModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext \<times> (Employee_AnalysisModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext) \<Rightarrow> ((Int.int) Option.option) Option.option) \<Rightarrow> ((((Employee_AnalysisModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext \<times> (Employee_AnalysisModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext) \<Rightarrow> ((Int.int) Option.option) Option.option) \<Rightarrow> (((Employee_AnalysisModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext \<times> (Employee_AnalysisModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext) \<Rightarrow> ((HOL.bool) Option.option) Option.option))))) (((Employee_AnalysisModel_UMLPart_generated.dot__salaryat_pre :: ((((Employee_AnalysisModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext \<times> (Employee_AnalysisModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext) \<Rightarrow> _) \<Rightarrow> (((Employee_AnalysisModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext \<times> (Employee_AnalysisModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext) \<Rightarrow> ((Int.int) Option.option) Option.option)))) (self))) (((Employee_AnalysisModel_UMLPart_generated.dot__salaryat_pre :: ((((Employee_AnalysisModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext \<times> (Employee_AnalysisModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext) \<Rightarrow> ((Employee_AnalysisModel_UMLPart_generated.ty\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n) Option.option) Option.option) \<Rightarrow> (((Employee_AnalysisModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext \<times> (Employee_AnalysisModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext) \<Rightarrow> ((Int.int) Option.option) Option.option)))) (((Employee_AnalysisModel_UMLPart_generated.dot_0___bossat_pre :: ((((Employee_AnalysisModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext \<times> (Employee_AnalysisModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext) \<Rightarrow> _) \<Rightarrow> (((Employee_AnalysisModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext \<times> (Employee_AnalysisModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext) \<Rightarrow> ((Employee_AnalysisModel_UMLPart_generated.ty\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n) Option.option) Option.option)))) (self)))))))))" -definition "Person_a = (\<lambda>\<tau>. (\<tau> \<Turnstile> (UML_Set.OclForall ((OclAllInstances_at_post (Person))) ((\<lambda>self. (((UML_Logic.OclImplies :: ((((Employee_AnalysisModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext \<times> (Employee_AnalysisModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext) \<Rightarrow> ((HOL.bool) Option.option) Option.option) \<Rightarrow> ((((Employee_AnalysisModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext \<times> (Employee_AnalysisModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext) \<Rightarrow> ((HOL.bool) Option.option) Option.option) \<Rightarrow> (((Employee_AnalysisModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext \<times> (Employee_AnalysisModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext) \<Rightarrow> ((HOL.bool) Option.option) Option.option))))) (((UML_Logic.OclNot :: ((((Employee_AnalysisModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext \<times> (Employee_AnalysisModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext) \<Rightarrow> ((HOL.bool) Option.option) Option.option) \<Rightarrow> (((Employee_AnalysisModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext \<times> (Employee_AnalysisModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext) \<Rightarrow> ((HOL.bool) Option.option) Option.option)))) ((((UML_Logic.StrictRefEq :: ((((Employee_AnalysisModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext \<times> (Employee_AnalysisModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext) \<Rightarrow> ((Employee_AnalysisModel_UMLPart_generated.ty\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n) Option.option) Option.option) \<Rightarrow> ((((Employee_AnalysisModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext \<times> (Employee_AnalysisModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext) \<Rightarrow> ((Employee_AnalysisModel_UMLPart_generated.ty\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n) Option.option) Option.option) \<Rightarrow> (((Employee_AnalysisModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext \<times> (Employee_AnalysisModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext) \<Rightarrow> ((HOL.bool) Option.option) Option.option))))) (((Employee_AnalysisModel_UMLPart_generated.dot_0___boss :: ((((Employee_AnalysisModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext \<times> (Employee_AnalysisModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext) \<Rightarrow> _) \<Rightarrow> (((Employee_AnalysisModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext \<times> (Employee_AnalysisModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext) \<Rightarrow> ((Employee_AnalysisModel_UMLPart_generated.ty\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n) Option.option) Option.option)))) (self))) ((UML_Types.null_class.null :: (((Employee_AnalysisModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext \<times> (Employee_AnalysisModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext) \<Rightarrow> ((Employee_AnalysisModel_UMLPart_generated.ty\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n) Option.option) Option.option)))))) ((((UML_Logic.StrongEq :: ((((Employee_AnalysisModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext \<times> (Employee_AnalysisModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext) \<Rightarrow> ((Int.int) Option.option) Option.option) \<Rightarrow> ((((Employee_AnalysisModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext \<times> (Employee_AnalysisModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext) \<Rightarrow> ((Int.int) Option.option) Option.option) \<Rightarrow> (((Employee_AnalysisModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext \<times> (Employee_AnalysisModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext) \<Rightarrow> ((HOL.bool) Option.option) Option.option))))) (((Employee_AnalysisModel_UMLPart_generated.dot__salary :: ((((Employee_AnalysisModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext \<times> (Employee_AnalysisModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext) \<Rightarrow> _) \<Rightarrow> (((Employee_AnalysisModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext \<times> (Employee_AnalysisModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext) \<Rightarrow> ((Int.int) Option.option) Option.option)))) (self))) (((Employee_AnalysisModel_UMLPart_generated.dot__salary :: ((((Employee_AnalysisModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext \<times> (Employee_AnalysisModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext) \<Rightarrow> ((Employee_AnalysisModel_UMLPart_generated.ty\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n) Option.option) Option.option) \<Rightarrow> (((Employee_AnalysisModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext \<times> (Employee_AnalysisModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext) \<Rightarrow> ((Int.int) Option.option) Option.option)))) (((Employee_AnalysisModel_UMLPart_generated.dot_0___boss :: ((((Employee_AnalysisModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext \<times> (Employee_AnalysisModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext) \<Rightarrow> _) \<Rightarrow> (((Employee_AnalysisModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext \<times> (Employee_AnalysisModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext) \<Rightarrow> ((Employee_AnalysisModel_UMLPart_generated.ty\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n) Option.option) Option.option)))) (self)))))))))" -ML \<open>(Ty'.check ([]) (" error(s)"))\<close> - -(* 173 ************************************ 984 + 1 *) (* term Floor2_ctxt.print_ctxt_thm *) -thm Person_aat_pre_def Person_a_def - -(* 174 ************************************ 985 + 1 *) -section \<open>Context (Floor 2)\<close> - -(* 175 ************************************ 986 + 0 *) (* term Floor2_ctxt.print_ctxt_pre_post *) - -(* 176 ************************************ 986 + 3 *) (* term Floor2_ctxt.print_ctxt_inv *) -definition "Planet_Aat_pre = (\<lambda>\<tau>. (\<tau> \<Turnstile> (UML_Set.OclForall ((OclAllInstances_at_pre (Planet))) ((\<lambda>self. (((UML_Logic.OclAnd :: ((((Employee_AnalysisModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext \<times> (Employee_AnalysisModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext) \<Rightarrow> ((HOL.bool) Option.option) Option.option) \<Rightarrow> ((((Employee_AnalysisModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext \<times> (Employee_AnalysisModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext) \<Rightarrow> ((HOL.bool) Option.option) Option.option) \<Rightarrow> (((Employee_AnalysisModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext \<times> (Employee_AnalysisModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext) \<Rightarrow> ((HOL.bool) Option.option) Option.option))))) ((UML_Logic.true :: (((Employee_AnalysisModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext \<times> (Employee_AnalysisModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext) \<Rightarrow> ((HOL.bool) Option.option) Option.option)))) ((((UML_Integer.OclLe\<^sub>I\<^sub>n\<^sub>t\<^sub>e\<^sub>g\<^sub>e\<^sub>r :: ((((Employee_AnalysisModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext \<times> (Employee_AnalysisModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext) \<Rightarrow> ((Int.int) Option.option) Option.option) \<Rightarrow> ((((Employee_AnalysisModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext \<times> (Employee_AnalysisModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext) \<Rightarrow> ((Int.int) Option.option) Option.option) \<Rightarrow> (((Employee_AnalysisModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext \<times> (Employee_AnalysisModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext) \<Rightarrow> ((HOL.bool) Option.option) Option.option))))) (((Employee_AnalysisModel_UMLPart_generated.dot__weightat_pre :: ((((Employee_AnalysisModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext \<times> (Employee_AnalysisModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext) \<Rightarrow> _) \<Rightarrow> (((Employee_AnalysisModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext \<times> (Employee_AnalysisModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext) \<Rightarrow> ((Int.int) Option.option) Option.option)))) (self))) ((UML_Integer.OclInt0 :: (((Employee_AnalysisModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext \<times> (Employee_AnalysisModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext) \<Rightarrow> ((Int.int) Option.option) Option.option)))))))))" -definition "Planet_A = (\<lambda>\<tau>. (\<tau> \<Turnstile> (UML_Set.OclForall ((OclAllInstances_at_post (Planet))) ((\<lambda>self. (((UML_Logic.OclAnd :: ((((Employee_AnalysisModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext \<times> (Employee_AnalysisModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext) \<Rightarrow> ((HOL.bool) Option.option) Option.option) \<Rightarrow> ((((Employee_AnalysisModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext \<times> (Employee_AnalysisModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext) \<Rightarrow> ((HOL.bool) Option.option) Option.option) \<Rightarrow> (((Employee_AnalysisModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext \<times> (Employee_AnalysisModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext) \<Rightarrow> ((HOL.bool) Option.option) Option.option))))) ((UML_Logic.true :: (((Employee_AnalysisModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext \<times> (Employee_AnalysisModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext) \<Rightarrow> ((HOL.bool) Option.option) Option.option)))) ((((UML_Integer.OclLe\<^sub>I\<^sub>n\<^sub>t\<^sub>e\<^sub>g\<^sub>e\<^sub>r :: ((((Employee_AnalysisModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext \<times> (Employee_AnalysisModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext) \<Rightarrow> ((Int.int) Option.option) Option.option) \<Rightarrow> ((((Employee_AnalysisModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext \<times> (Employee_AnalysisModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext) \<Rightarrow> ((Int.int) Option.option) Option.option) \<Rightarrow> (((Employee_AnalysisModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext \<times> (Employee_AnalysisModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext) \<Rightarrow> ((HOL.bool) Option.option) Option.option))))) (((Employee_AnalysisModel_UMLPart_generated.dot__weight :: ((((Employee_AnalysisModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext \<times> (Employee_AnalysisModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext) \<Rightarrow> _) \<Rightarrow> (((Employee_AnalysisModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext \<times> (Employee_AnalysisModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext) \<Rightarrow> ((Int.int) Option.option) Option.option)))) (self))) ((UML_Integer.OclInt0 :: (((Employee_AnalysisModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext \<times> (Employee_AnalysisModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext) \<Rightarrow> ((Int.int) Option.option) Option.option)))))))))" -ML \<open>(Ty'.check ([]) (" error(s)"))\<close> - -(* 177 ************************************ 989 + 1 *) (* term Floor2_ctxt.print_ctxt_thm *) -thm Planet_Aat_pre_def Planet_A_def - -end diff --git a/Citadelle/doc/Employee_DesignModel_UMLPart_generated.thy b/Citadelle/doc/Employee_DesignModel_UMLPart_generated.thy deleted file mode 100644 index 7f047363374fbc78b8b2c70fecf84ea1e9642753..0000000000000000000000000000000000000000 --- a/Citadelle/doc/Employee_DesignModel_UMLPart_generated.thy +++ /dev/null @@ -1,3779 +0,0 @@ -theory Employee_DesignModel_UMLPart_generated imports "OCL.UML_Main" "FOCL.Static" "FOCL.Generator_dynamic_sequential" begin - -(* 1 ************************************ 0 + 0 *) (* term Floor1_infra.print_infra_enum_synonym *) - -(* 2 ************************************ 0 + 1 *) -text \<open> - \label{ex:Employee-DesignModel-UMLPart-generatedemployee-design:uml} \<close> - -(* 3 ************************************ 1 + 1 *) -text \<open>\<close> - -(* 4 ************************************ 2 + 1 *) -section \<open>Class Model: Introduction\<close> - -(* 5 ************************************ 3 + 1 *) -text \<open> - - For certain concepts like classes and class-types, only a generic - definition for its resulting semantics can be given. Generic means, - there is a function outside \HOL that ``compiles'' a concrete, - closed-world class diagram into a ``theory'' of this data model, - consisting of a bunch of definitions for classes, accessors, method, - casts, and tests for actual types, as well as proofs for the - fundamental properties of these operations in this concrete data - model. \<close> - -(* 6 ************************************ 4 + 1 *) -text \<open> - Such generic function or ``compiler'' can be implemented in - Isabelle on the \ML level. This has been done, for a semantics - following the open-world assumption, for \UML 2.0 - in~\cite{brucker.ea:extensible:2008-b, brucker:interactive:2007}. In - this paper, we follow another approach for \UML 2.4: we define the - concepts of the compilation informally, and present a concrete - example which is verified in Isabelle/\HOL. \<close> - -(* 7 ************************************ 5 + 1 *) -subsection \<open>Outlining the Example\<close> - -(* 8 ************************************ 6 + 1 *) -text \<open> - We are presenting here a ``design-model'' of the (slightly -modified) example Figure 7.3, page 20 of -the \OCL standard~\cite{omg:ocl:2012}. To be precise, this theory contains the formalization of -the data-part covered by the \UML class model (see \autoref{fig:Employee-DesignModel-UMLPart-generatedperson}):\<close> - -(* 9 ************************************ 7 + 1 *) -text \<open>\<close> - -(* 10 ************************************ 8 + 1 *) -text_raw \<open> - -\begin{figure} - \centering\scalebox{.3}{\includegraphics{figures/person.png}}% - \caption{A simple \UML class model drawn from Figure 7.3, - page 20 of~\cite{omg:ocl:2012}. \label{fig:Employee-DesignModel-UMLPart-generatedperson}} -\end{figure} -\<close> - -(* 11 ************************************ 9 + 1 *) -text_raw \<open>\<close> - -(* 12 ************************************ 10 + 1 *) -text \<open> - This means that the association (attached to the association class -\inlineocl{EmployeeRanking}) with the association ends \inlineocl+boss+ and \inlineocl+employees+ is implemented -by the attribute \inlineocl+boss+ and the operation \inlineocl+employees+ (to be discussed in the \OCL part -captured by the subsequent theory). -\<close> - -(* 13 ************************************ 11 + 1 *) -section \<open>Class Model: The Construction of the Object Universe\<close> - -(* 14 ************************************ 12 + 1 *) -text \<open> - Our data universe consists in the concrete class diagram just of node's, -and implicitly of the class object. Each class implies the existence of a class -type defined for the corresponding object representations as follows: \<close> - -(* 15 ************************************ 13 + 8 *) (* term Floor1_infra.print_infra_datatype_class_1 *) -datatype ty\<E>\<X>\<T>\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n = mk\<E>\<X>\<T>\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n "oid" "nat option" "int option" "unit option" "bool option" "oid list list option" -datatype ty\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n = mk\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n "ty\<E>\<X>\<T>\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n" "oid list option" "int option" -datatype ty\<E>\<X>\<T>\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t = mk\<E>\<X>\<T>\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n "ty\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n" - | mk\<E>\<X>\<T>\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t "oid" "unit option" "bool option" "oid list list option" -datatype ty\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t = mk\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t "ty\<E>\<X>\<T>\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t" "nat option" "int option" -datatype ty\<E>\<X>\<T>\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y = mk\<E>\<X>\<T>\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t "ty\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t" - | mk\<E>\<X>\<T>\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n "ty\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n" - | mk\<E>\<X>\<T>\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y "oid" -datatype ty\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y = mk\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y "ty\<E>\<X>\<T>\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y" "unit option" "bool option" "oid list list option" -datatype ty\<E>\<X>\<T>\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y = mk\<E>\<X>\<T>\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y "ty\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y" - | mk\<E>\<X>\<T>\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t "ty\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t" - | mk\<E>\<X>\<T>\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n "ty\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n" - | mk\<E>\<X>\<T>\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y "oid" -datatype ty\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y = mk\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y "ty\<E>\<X>\<T>\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y" - -(* 16 ************************************ 21 + 11 *) (* term Floor1_infra.print_infra_datatype_class_2 *) -datatype ty2\<E>\<X>\<T>\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n = mk2\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n "oid list option" "int option" -datatype ty2oid\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n = mk2oid\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n "oid" "nat option" "int option" "unit option" "bool option" "oid list list option" "ty2\<E>\<X>\<T>\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n" -datatype ty2\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t = mk2\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n "ty2\<E>\<X>\<T>\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n" -datatype ty2\<E>\<X>\<T>\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t = mk2\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t "nat option" "int option" "ty2\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t option" -datatype ty2oid\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t = mk2oid\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t "oid" "unit option" "bool option" "oid list list option" "ty2\<E>\<X>\<T>\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t" -datatype ty2\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y = mk2\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t "ty2\<E>\<X>\<T>\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t" -datatype ty2\<E>\<X>\<T>\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y = mk2\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y "unit option" "bool option" "oid list list option" "ty2\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y option" -datatype ty2oid\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y = mk2oid\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y "oid" "ty2\<E>\<X>\<T>\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y" -datatype ty2\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y = mk2\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y "ty2\<E>\<X>\<T>\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y" -datatype ty2\<E>\<X>\<T>\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y = mk2\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y "ty2\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y option" -datatype ty2oid\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y = mk2oid\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y "oid" "ty2\<E>\<X>\<T>\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y" - -(* 17 ************************************ 32 + 8 *) (* term Floor1_infra.print_infra_datatype_equiv_2of1 *) -definition "class_ty_ext_equiv_2of1_aux\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n = (\<lambda>oid inh\<^sub>w\<^sub>o\<^sub>r\<^sub>m\<^sub>h\<^sub>o\<^sub>l\<^sub>e inh\<^sub>w\<^sub>e\<^sub>i\<^sub>g\<^sub>h\<^sub>t inh\<^sub>s\<^sub>o\<^sub>u\<^sub>n\<^sub>d inh\<^sub>m\<^sub>o\<^sub>v\<^sub>i\<^sub>n\<^sub>g inh\<^sub>o\<^sub>u\<^sub>t\<^sub>e\<^sub>r\<^sub>_\<^sub>w\<^sub>o\<^sub>r\<^sub>l\<^sub>d. (\<lambda> (mk2\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (own\<^sub>b\<^sub>o\<^sub>s\<^sub>s) (own\<^sub>s\<^sub>a\<^sub>l\<^sub>a\<^sub>r\<^sub>y)) \<Rightarrow> (mk\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n ((mk\<E>\<X>\<T>\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (oid) (inh\<^sub>w\<^sub>o\<^sub>r\<^sub>m\<^sub>h\<^sub>o\<^sub>l\<^sub>e) (inh\<^sub>w\<^sub>e\<^sub>i\<^sub>g\<^sub>h\<^sub>t) (inh\<^sub>s\<^sub>o\<^sub>u\<^sub>n\<^sub>d) (inh\<^sub>m\<^sub>o\<^sub>v\<^sub>i\<^sub>n\<^sub>g) (inh\<^sub>o\<^sub>u\<^sub>t\<^sub>e\<^sub>r\<^sub>_\<^sub>w\<^sub>o\<^sub>r\<^sub>l\<^sub>d))) (own\<^sub>b\<^sub>o\<^sub>s\<^sub>s) (own\<^sub>s\<^sub>a\<^sub>l\<^sub>a\<^sub>r\<^sub>y))))" -definition "class_ty_ext_equiv_2of1\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n = (\<lambda> (mk2oid\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (oid) (inh\<^sub>w\<^sub>o\<^sub>r\<^sub>m\<^sub>h\<^sub>o\<^sub>l\<^sub>e) (inh\<^sub>w\<^sub>e\<^sub>i\<^sub>g\<^sub>h\<^sub>t) (inh\<^sub>s\<^sub>o\<^sub>u\<^sub>n\<^sub>d) (inh\<^sub>m\<^sub>o\<^sub>v\<^sub>i\<^sub>n\<^sub>g) (inh\<^sub>o\<^sub>u\<^sub>t\<^sub>e\<^sub>r\<^sub>_\<^sub>w\<^sub>o\<^sub>r\<^sub>l\<^sub>d) (t)) \<Rightarrow> (class_ty_ext_equiv_2of1_aux\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (oid) (inh\<^sub>w\<^sub>o\<^sub>r\<^sub>m\<^sub>h\<^sub>o\<^sub>l\<^sub>e) (inh\<^sub>w\<^sub>e\<^sub>i\<^sub>g\<^sub>h\<^sub>t) (inh\<^sub>s\<^sub>o\<^sub>u\<^sub>n\<^sub>d) (inh\<^sub>m\<^sub>o\<^sub>v\<^sub>i\<^sub>n\<^sub>g) (inh\<^sub>o\<^sub>u\<^sub>t\<^sub>e\<^sub>r\<^sub>_\<^sub>w\<^sub>o\<^sub>r\<^sub>l\<^sub>d) (t)))" -definition "class_ty_ext_equiv_2of1_aux\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t = (\<lambda>oid inh\<^sub>s\<^sub>o\<^sub>u\<^sub>n\<^sub>d inh\<^sub>m\<^sub>o\<^sub>v\<^sub>i\<^sub>n\<^sub>g inh\<^sub>o\<^sub>u\<^sub>t\<^sub>e\<^sub>r\<^sub>_\<^sub>w\<^sub>o\<^sub>r\<^sub>l\<^sub>d. (\<lambda> (mk2\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (own\<^sub>w\<^sub>o\<^sub>r\<^sub>m\<^sub>h\<^sub>o\<^sub>l\<^sub>e) (own\<^sub>w\<^sub>e\<^sub>i\<^sub>g\<^sub>h\<^sub>t) (t)) \<Rightarrow> (mk\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t ((case t of None \<Rightarrow> (mk\<E>\<X>\<T>\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (oid) (inh\<^sub>s\<^sub>o\<^sub>u\<^sub>n\<^sub>d) (inh\<^sub>m\<^sub>o\<^sub>v\<^sub>i\<^sub>n\<^sub>g) (inh\<^sub>o\<^sub>u\<^sub>t\<^sub>e\<^sub>r\<^sub>_\<^sub>w\<^sub>o\<^sub>r\<^sub>l\<^sub>d)) - | \<lfloor>(mk2\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (t))\<rfloor> \<Rightarrow> (case (class_ty_ext_equiv_2of1_aux\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (oid) (own\<^sub>w\<^sub>o\<^sub>r\<^sub>m\<^sub>h\<^sub>o\<^sub>l\<^sub>e) (own\<^sub>w\<^sub>e\<^sub>i\<^sub>g\<^sub>h\<^sub>t) (inh\<^sub>s\<^sub>o\<^sub>u\<^sub>n\<^sub>d) (inh\<^sub>m\<^sub>o\<^sub>v\<^sub>i\<^sub>n\<^sub>g) (inh\<^sub>o\<^sub>u\<^sub>t\<^sub>e\<^sub>r\<^sub>_\<^sub>w\<^sub>o\<^sub>r\<^sub>l\<^sub>d) (t)) of (mk\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n ((mk\<E>\<X>\<T>\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (oid) (own\<^sub>w\<^sub>o\<^sub>r\<^sub>m\<^sub>h\<^sub>o\<^sub>l\<^sub>e) (own\<^sub>w\<^sub>e\<^sub>i\<^sub>g\<^sub>h\<^sub>t) (inh\<^sub>s\<^sub>o\<^sub>u\<^sub>n\<^sub>d) (inh\<^sub>m\<^sub>o\<^sub>v\<^sub>i\<^sub>n\<^sub>g) (inh\<^sub>o\<^sub>u\<^sub>t\<^sub>e\<^sub>r\<^sub>_\<^sub>w\<^sub>o\<^sub>r\<^sub>l\<^sub>d))) (own\<^sub>b\<^sub>o\<^sub>s\<^sub>s) (own\<^sub>s\<^sub>a\<^sub>l\<^sub>a\<^sub>r\<^sub>y)) \<Rightarrow> (mk\<E>\<X>\<T>\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n ((mk\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n ((mk\<E>\<X>\<T>\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (oid) (own\<^sub>w\<^sub>o\<^sub>r\<^sub>m\<^sub>h\<^sub>o\<^sub>l\<^sub>e) (own\<^sub>w\<^sub>e\<^sub>i\<^sub>g\<^sub>h\<^sub>t) (inh\<^sub>s\<^sub>o\<^sub>u\<^sub>n\<^sub>d) (inh\<^sub>m\<^sub>o\<^sub>v\<^sub>i\<^sub>n\<^sub>g) (inh\<^sub>o\<^sub>u\<^sub>t\<^sub>e\<^sub>r\<^sub>_\<^sub>w\<^sub>o\<^sub>r\<^sub>l\<^sub>d))) (own\<^sub>b\<^sub>o\<^sub>s\<^sub>s) (own\<^sub>s\<^sub>a\<^sub>l\<^sub>a\<^sub>r\<^sub>y))))))) (own\<^sub>w\<^sub>o\<^sub>r\<^sub>m\<^sub>h\<^sub>o\<^sub>l\<^sub>e) (own\<^sub>w\<^sub>e\<^sub>i\<^sub>g\<^sub>h\<^sub>t))))" -definition "class_ty_ext_equiv_2of1\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t = (\<lambda> (mk2oid\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (oid) (inh\<^sub>s\<^sub>o\<^sub>u\<^sub>n\<^sub>d) (inh\<^sub>m\<^sub>o\<^sub>v\<^sub>i\<^sub>n\<^sub>g) (inh\<^sub>o\<^sub>u\<^sub>t\<^sub>e\<^sub>r\<^sub>_\<^sub>w\<^sub>o\<^sub>r\<^sub>l\<^sub>d) (t)) \<Rightarrow> (class_ty_ext_equiv_2of1_aux\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (oid) (inh\<^sub>s\<^sub>o\<^sub>u\<^sub>n\<^sub>d) (inh\<^sub>m\<^sub>o\<^sub>v\<^sub>i\<^sub>n\<^sub>g) (inh\<^sub>o\<^sub>u\<^sub>t\<^sub>e\<^sub>r\<^sub>_\<^sub>w\<^sub>o\<^sub>r\<^sub>l\<^sub>d) (t)))" -definition "class_ty_ext_equiv_2of1_aux\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y = (\<lambda>oid. (\<lambda> (mk2\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y (own\<^sub>s\<^sub>o\<^sub>u\<^sub>n\<^sub>d) (own\<^sub>m\<^sub>o\<^sub>v\<^sub>i\<^sub>n\<^sub>g) (own\<^sub>o\<^sub>u\<^sub>t\<^sub>e\<^sub>r\<^sub>_\<^sub>w\<^sub>o\<^sub>r\<^sub>l\<^sub>d) (t)) \<Rightarrow> (mk\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y ((case t of None \<Rightarrow> (mk\<E>\<X>\<T>\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y (oid)) - | \<lfloor>(mk2\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (t))\<rfloor> \<Rightarrow> (case (class_ty_ext_equiv_2of1_aux\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (oid) (own\<^sub>s\<^sub>o\<^sub>u\<^sub>n\<^sub>d) (own\<^sub>m\<^sub>o\<^sub>v\<^sub>i\<^sub>n\<^sub>g) (own\<^sub>o\<^sub>u\<^sub>t\<^sub>e\<^sub>r\<^sub>_\<^sub>w\<^sub>o\<^sub>r\<^sub>l\<^sub>d) (t)) of (mk\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t ((mk\<E>\<X>\<T>\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (oid) (own\<^sub>s\<^sub>o\<^sub>u\<^sub>n\<^sub>d) (own\<^sub>m\<^sub>o\<^sub>v\<^sub>i\<^sub>n\<^sub>g) (own\<^sub>o\<^sub>u\<^sub>t\<^sub>e\<^sub>r\<^sub>_\<^sub>w\<^sub>o\<^sub>r\<^sub>l\<^sub>d))) (own\<^sub>w\<^sub>o\<^sub>r\<^sub>m\<^sub>h\<^sub>o\<^sub>l\<^sub>e) (own\<^sub>w\<^sub>e\<^sub>i\<^sub>g\<^sub>h\<^sub>t)) \<Rightarrow> (mk\<E>\<X>\<T>\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t ((mk\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t ((mk\<E>\<X>\<T>\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (oid) (own\<^sub>s\<^sub>o\<^sub>u\<^sub>n\<^sub>d) (own\<^sub>m\<^sub>o\<^sub>v\<^sub>i\<^sub>n\<^sub>g) (own\<^sub>o\<^sub>u\<^sub>t\<^sub>e\<^sub>r\<^sub>_\<^sub>w\<^sub>o\<^sub>r\<^sub>l\<^sub>d))) (own\<^sub>w\<^sub>o\<^sub>r\<^sub>m\<^sub>h\<^sub>o\<^sub>l\<^sub>e) (own\<^sub>w\<^sub>e\<^sub>i\<^sub>g\<^sub>h\<^sub>t)))) - | (mk\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t ((mk\<E>\<X>\<T>\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (t))) (own\<^sub>w\<^sub>o\<^sub>r\<^sub>m\<^sub>h\<^sub>o\<^sub>l\<^sub>e) (own\<^sub>w\<^sub>e\<^sub>i\<^sub>g\<^sub>h\<^sub>t)) \<Rightarrow> (mk\<E>\<X>\<T>\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (t))))) (own\<^sub>s\<^sub>o\<^sub>u\<^sub>n\<^sub>d) (own\<^sub>m\<^sub>o\<^sub>v\<^sub>i\<^sub>n\<^sub>g) (own\<^sub>o\<^sub>u\<^sub>t\<^sub>e\<^sub>r\<^sub>_\<^sub>w\<^sub>o\<^sub>r\<^sub>l\<^sub>d))))" -definition "class_ty_ext_equiv_2of1\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y = (\<lambda> (mk2oid\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y (oid) (t)) \<Rightarrow> (class_ty_ext_equiv_2of1_aux\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y (oid) (t)))" -definition "class_ty_ext_equiv_2of1_aux\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y = (\<lambda>oid. (\<lambda> (mk2\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y (t)) \<Rightarrow> (mk\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y ((case t of None \<Rightarrow> (mk\<E>\<X>\<T>\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y (oid)) - | \<lfloor>(mk2\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y (t))\<rfloor> \<Rightarrow> (case (class_ty_ext_equiv_2of1_aux\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y (oid) (t)) of (mk\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y ((mk\<E>\<X>\<T>\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y (oid))) (own\<^sub>s\<^sub>o\<^sub>u\<^sub>n\<^sub>d) (own\<^sub>m\<^sub>o\<^sub>v\<^sub>i\<^sub>n\<^sub>g) (own\<^sub>o\<^sub>u\<^sub>t\<^sub>e\<^sub>r\<^sub>_\<^sub>w\<^sub>o\<^sub>r\<^sub>l\<^sub>d)) \<Rightarrow> (mk\<E>\<X>\<T>\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y ((mk\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y ((mk\<E>\<X>\<T>\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y (oid))) (own\<^sub>s\<^sub>o\<^sub>u\<^sub>n\<^sub>d) (own\<^sub>m\<^sub>o\<^sub>v\<^sub>i\<^sub>n\<^sub>g) (own\<^sub>o\<^sub>u\<^sub>t\<^sub>e\<^sub>r\<^sub>_\<^sub>w\<^sub>o\<^sub>r\<^sub>l\<^sub>d)))) - | (mk\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y ((mk\<E>\<X>\<T>\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (t))) (own\<^sub>s\<^sub>o\<^sub>u\<^sub>n\<^sub>d) (own\<^sub>m\<^sub>o\<^sub>v\<^sub>i\<^sub>n\<^sub>g) (own\<^sub>o\<^sub>u\<^sub>t\<^sub>e\<^sub>r\<^sub>_\<^sub>w\<^sub>o\<^sub>r\<^sub>l\<^sub>d)) \<Rightarrow> (mk\<E>\<X>\<T>\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (t)) - | (mk\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y ((mk\<E>\<X>\<T>\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (t))) (own\<^sub>s\<^sub>o\<^sub>u\<^sub>n\<^sub>d) (own\<^sub>m\<^sub>o\<^sub>v\<^sub>i\<^sub>n\<^sub>g) (own\<^sub>o\<^sub>u\<^sub>t\<^sub>e\<^sub>r\<^sub>_\<^sub>w\<^sub>o\<^sub>r\<^sub>l\<^sub>d)) \<Rightarrow> (mk\<E>\<X>\<T>\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (t))))))))" -definition "class_ty_ext_equiv_2of1\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y = (\<lambda> (mk2oid\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y (oid) (t)) \<Rightarrow> (class_ty_ext_equiv_2of1_aux\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y (oid) (t)))" - -(* 18 ************************************ 40 + 12 *) (* term Floor1_infra.print_infra_datatype_equiv_1of2 *) -definition "class_ty_ext_equiv_1of2_get_oid_inh\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n = (\<lambda> (mk\<E>\<X>\<T>\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (oid) (inh\<^sub>w\<^sub>o\<^sub>r\<^sub>m\<^sub>h\<^sub>o\<^sub>l\<^sub>e) (inh\<^sub>w\<^sub>e\<^sub>i\<^sub>g\<^sub>h\<^sub>t) (inh\<^sub>s\<^sub>o\<^sub>u\<^sub>n\<^sub>d) (inh\<^sub>m\<^sub>o\<^sub>v\<^sub>i\<^sub>n\<^sub>g) (inh\<^sub>o\<^sub>u\<^sub>t\<^sub>e\<^sub>r\<^sub>_\<^sub>w\<^sub>o\<^sub>r\<^sub>l\<^sub>d)) \<Rightarrow> (oid , inh\<^sub>w\<^sub>o\<^sub>r\<^sub>m\<^sub>h\<^sub>o\<^sub>l\<^sub>e , inh\<^sub>w\<^sub>e\<^sub>i\<^sub>g\<^sub>h\<^sub>t , inh\<^sub>s\<^sub>o\<^sub>u\<^sub>n\<^sub>d , inh\<^sub>m\<^sub>o\<^sub>v\<^sub>i\<^sub>n\<^sub>g , inh\<^sub>o\<^sub>u\<^sub>t\<^sub>e\<^sub>r\<^sub>_\<^sub>w\<^sub>o\<^sub>r\<^sub>l\<^sub>d))" -definition "class_ty_ext_equiv_1of2_aux\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n = (\<lambda> (mk\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (t) (own\<^sub>b\<^sub>o\<^sub>s\<^sub>s) (own\<^sub>s\<^sub>a\<^sub>l\<^sub>a\<^sub>r\<^sub>y)) \<Rightarrow> (mk2\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (own\<^sub>b\<^sub>o\<^sub>s\<^sub>s) (own\<^sub>s\<^sub>a\<^sub>l\<^sub>a\<^sub>r\<^sub>y)))" -definition "class_ty_ext_equiv_1of2\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n = (\<lambda> (mk\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (t) (own\<^sub>b\<^sub>o\<^sub>s\<^sub>s) (own\<^sub>s\<^sub>a\<^sub>l\<^sub>a\<^sub>r\<^sub>y)) \<Rightarrow> (case (class_ty_ext_equiv_1of2_get_oid_inh\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (t)) of (oid , inh\<^sub>w\<^sub>o\<^sub>r\<^sub>m\<^sub>h\<^sub>o\<^sub>l\<^sub>e , inh\<^sub>w\<^sub>e\<^sub>i\<^sub>g\<^sub>h\<^sub>t , inh\<^sub>s\<^sub>o\<^sub>u\<^sub>n\<^sub>d , inh\<^sub>m\<^sub>o\<^sub>v\<^sub>i\<^sub>n\<^sub>g , inh\<^sub>o\<^sub>u\<^sub>t\<^sub>e\<^sub>r\<^sub>_\<^sub>w\<^sub>o\<^sub>r\<^sub>l\<^sub>d) \<Rightarrow> (mk2oid\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (oid) (inh\<^sub>w\<^sub>o\<^sub>r\<^sub>m\<^sub>h\<^sub>o\<^sub>l\<^sub>e) (inh\<^sub>w\<^sub>e\<^sub>i\<^sub>g\<^sub>h\<^sub>t) (inh\<^sub>s\<^sub>o\<^sub>u\<^sub>n\<^sub>d) (inh\<^sub>m\<^sub>o\<^sub>v\<^sub>i\<^sub>n\<^sub>g) (inh\<^sub>o\<^sub>u\<^sub>t\<^sub>e\<^sub>r\<^sub>_\<^sub>w\<^sub>o\<^sub>r\<^sub>l\<^sub>d) ((class_ty_ext_equiv_1of2_aux\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n ((mk\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (t) (own\<^sub>b\<^sub>o\<^sub>s\<^sub>s) (own\<^sub>s\<^sub>a\<^sub>l\<^sub>a\<^sub>r\<^sub>y))))))))" -definition "class_ty_ext_equiv_1of2_get_oid_inh\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t = (\<lambda> (mk\<E>\<X>\<T>\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (oid) (inh\<^sub>s\<^sub>o\<^sub>u\<^sub>n\<^sub>d) (inh\<^sub>m\<^sub>o\<^sub>v\<^sub>i\<^sub>n\<^sub>g) (inh\<^sub>o\<^sub>u\<^sub>t\<^sub>e\<^sub>r\<^sub>_\<^sub>w\<^sub>o\<^sub>r\<^sub>l\<^sub>d)) \<Rightarrow> (oid , inh\<^sub>s\<^sub>o\<^sub>u\<^sub>n\<^sub>d , inh\<^sub>m\<^sub>o\<^sub>v\<^sub>i\<^sub>n\<^sub>g , inh\<^sub>o\<^sub>u\<^sub>t\<^sub>e\<^sub>r\<^sub>_\<^sub>w\<^sub>o\<^sub>r\<^sub>l\<^sub>d) - | (mk\<E>\<X>\<T>\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n ((mk\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (t) (var\<^sub>b\<^sub>o\<^sub>s\<^sub>s) (var\<^sub>s\<^sub>a\<^sub>l\<^sub>a\<^sub>r\<^sub>y)))) \<Rightarrow> (case (class_ty_ext_equiv_1of2_get_oid_inh\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (t)) of (oid , var\<^sub>w\<^sub>o\<^sub>r\<^sub>m\<^sub>h\<^sub>o\<^sub>l\<^sub>e , var\<^sub>w\<^sub>e\<^sub>i\<^sub>g\<^sub>h\<^sub>t , var\<^sub>s\<^sub>o\<^sub>u\<^sub>n\<^sub>d , var\<^sub>m\<^sub>o\<^sub>v\<^sub>i\<^sub>n\<^sub>g , var\<^sub>o\<^sub>u\<^sub>t\<^sub>e\<^sub>r\<^sub>_\<^sub>w\<^sub>o\<^sub>r\<^sub>l\<^sub>d) \<Rightarrow> (oid , var\<^sub>s\<^sub>o\<^sub>u\<^sub>n\<^sub>d , var\<^sub>m\<^sub>o\<^sub>v\<^sub>i\<^sub>n\<^sub>g , var\<^sub>o\<^sub>u\<^sub>t\<^sub>e\<^sub>r\<^sub>_\<^sub>w\<^sub>o\<^sub>r\<^sub>l\<^sub>d)))" -definition "class_ty_ext_equiv_1of2_aux\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t = (\<lambda> (mk\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (t) (own\<^sub>w\<^sub>o\<^sub>r\<^sub>m\<^sub>h\<^sub>o\<^sub>l\<^sub>e) (own\<^sub>w\<^sub>e\<^sub>i\<^sub>g\<^sub>h\<^sub>t)) \<Rightarrow> (mk2\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (own\<^sub>w\<^sub>o\<^sub>r\<^sub>m\<^sub>h\<^sub>o\<^sub>l\<^sub>e) (own\<^sub>w\<^sub>e\<^sub>i\<^sub>g\<^sub>h\<^sub>t) ((case t of (mk\<E>\<X>\<T>\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (oid) (inh\<^sub>s\<^sub>o\<^sub>u\<^sub>n\<^sub>d) (inh\<^sub>m\<^sub>o\<^sub>v\<^sub>i\<^sub>n\<^sub>g) (inh\<^sub>o\<^sub>u\<^sub>t\<^sub>e\<^sub>r\<^sub>_\<^sub>w\<^sub>o\<^sub>r\<^sub>l\<^sub>d)) \<Rightarrow> None - | (mk\<E>\<X>\<T>\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (tt)) \<Rightarrow> (case (case tt of (mk\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (t) (var\<^sub>b\<^sub>o\<^sub>s\<^sub>s) (var\<^sub>s\<^sub>a\<^sub>l\<^sub>a\<^sub>r\<^sub>y)) \<Rightarrow> (class_ty_ext_equiv_1of2_get_oid_inh\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (t))) of (oid , var\<^sub>w\<^sub>o\<^sub>r\<^sub>m\<^sub>h\<^sub>o\<^sub>l\<^sub>e , var\<^sub>w\<^sub>e\<^sub>i\<^sub>g\<^sub>h\<^sub>t , var\<^sub>s\<^sub>o\<^sub>u\<^sub>n\<^sub>d , var\<^sub>m\<^sub>o\<^sub>v\<^sub>i\<^sub>n\<^sub>g , var\<^sub>o\<^sub>u\<^sub>t\<^sub>e\<^sub>r\<^sub>_\<^sub>w\<^sub>o\<^sub>r\<^sub>l\<^sub>d) \<Rightarrow> \<lfloor>(mk2\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n ((class_ty_ext_equiv_1of2_aux\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (tt))))\<rfloor>)))))" -definition "class_ty_ext_equiv_1of2\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t = (\<lambda> (mk\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (t) (own\<^sub>w\<^sub>o\<^sub>r\<^sub>m\<^sub>h\<^sub>o\<^sub>l\<^sub>e) (own\<^sub>w\<^sub>e\<^sub>i\<^sub>g\<^sub>h\<^sub>t)) \<Rightarrow> (case (class_ty_ext_equiv_1of2_get_oid_inh\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (t)) of (oid , inh\<^sub>s\<^sub>o\<^sub>u\<^sub>n\<^sub>d , inh\<^sub>m\<^sub>o\<^sub>v\<^sub>i\<^sub>n\<^sub>g , inh\<^sub>o\<^sub>u\<^sub>t\<^sub>e\<^sub>r\<^sub>_\<^sub>w\<^sub>o\<^sub>r\<^sub>l\<^sub>d) \<Rightarrow> (mk2oid\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (oid) (inh\<^sub>s\<^sub>o\<^sub>u\<^sub>n\<^sub>d) (inh\<^sub>m\<^sub>o\<^sub>v\<^sub>i\<^sub>n\<^sub>g) (inh\<^sub>o\<^sub>u\<^sub>t\<^sub>e\<^sub>r\<^sub>_\<^sub>w\<^sub>o\<^sub>r\<^sub>l\<^sub>d) ((class_ty_ext_equiv_1of2_aux\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t ((mk\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (t) (own\<^sub>w\<^sub>o\<^sub>r\<^sub>m\<^sub>h\<^sub>o\<^sub>l\<^sub>e) (own\<^sub>w\<^sub>e\<^sub>i\<^sub>g\<^sub>h\<^sub>t))))))))" -definition "class_ty_ext_equiv_1of2_get_oid_inh\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y = (\<lambda> (mk\<E>\<X>\<T>\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y (oid)) \<Rightarrow> (oid) - | (mk\<E>\<X>\<T>\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n ((mk\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (t) (var\<^sub>b\<^sub>o\<^sub>s\<^sub>s) (var\<^sub>s\<^sub>a\<^sub>l\<^sub>a\<^sub>r\<^sub>y)))) \<Rightarrow> (case (class_ty_ext_equiv_1of2_get_oid_inh\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (t)) of (oid , var\<^sub>w\<^sub>o\<^sub>r\<^sub>m\<^sub>h\<^sub>o\<^sub>l\<^sub>e , var\<^sub>w\<^sub>e\<^sub>i\<^sub>g\<^sub>h\<^sub>t , var\<^sub>s\<^sub>o\<^sub>u\<^sub>n\<^sub>d , var\<^sub>m\<^sub>o\<^sub>v\<^sub>i\<^sub>n\<^sub>g , var\<^sub>o\<^sub>u\<^sub>t\<^sub>e\<^sub>r\<^sub>_\<^sub>w\<^sub>o\<^sub>r\<^sub>l\<^sub>d) \<Rightarrow> (oid)) - | (mk\<E>\<X>\<T>\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t ((mk\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (t) (var\<^sub>w\<^sub>o\<^sub>r\<^sub>m\<^sub>h\<^sub>o\<^sub>l\<^sub>e) (var\<^sub>w\<^sub>e\<^sub>i\<^sub>g\<^sub>h\<^sub>t)))) \<Rightarrow> (case (class_ty_ext_equiv_1of2_get_oid_inh\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (t)) of (oid , var\<^sub>s\<^sub>o\<^sub>u\<^sub>n\<^sub>d , var\<^sub>m\<^sub>o\<^sub>v\<^sub>i\<^sub>n\<^sub>g , var\<^sub>o\<^sub>u\<^sub>t\<^sub>e\<^sub>r\<^sub>_\<^sub>w\<^sub>o\<^sub>r\<^sub>l\<^sub>d) \<Rightarrow> (oid)))" -definition "class_ty_ext_equiv_1of2_aux\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y = (\<lambda> (mk\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y (t) (own\<^sub>s\<^sub>o\<^sub>u\<^sub>n\<^sub>d) (own\<^sub>m\<^sub>o\<^sub>v\<^sub>i\<^sub>n\<^sub>g) (own\<^sub>o\<^sub>u\<^sub>t\<^sub>e\<^sub>r\<^sub>_\<^sub>w\<^sub>o\<^sub>r\<^sub>l\<^sub>d)) \<Rightarrow> (mk2\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y (own\<^sub>s\<^sub>o\<^sub>u\<^sub>n\<^sub>d) (own\<^sub>m\<^sub>o\<^sub>v\<^sub>i\<^sub>n\<^sub>g) (own\<^sub>o\<^sub>u\<^sub>t\<^sub>e\<^sub>r\<^sub>_\<^sub>w\<^sub>o\<^sub>r\<^sub>l\<^sub>d) ((case t of (mk\<E>\<X>\<T>\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y (oid)) \<Rightarrow> None - | (mk\<E>\<X>\<T>\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (tt)) \<Rightarrow> (case (case tt of (mk\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (t) (var\<^sub>b\<^sub>o\<^sub>s\<^sub>s) (var\<^sub>s\<^sub>a\<^sub>l\<^sub>a\<^sub>r\<^sub>y)) \<Rightarrow> (class_ty_ext_equiv_1of2_get_oid_inh\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (t))) of (oid , var\<^sub>w\<^sub>o\<^sub>r\<^sub>m\<^sub>h\<^sub>o\<^sub>l\<^sub>e , var\<^sub>w\<^sub>e\<^sub>i\<^sub>g\<^sub>h\<^sub>t , var\<^sub>s\<^sub>o\<^sub>u\<^sub>n\<^sub>d , var\<^sub>m\<^sub>o\<^sub>v\<^sub>i\<^sub>n\<^sub>g , var\<^sub>o\<^sub>u\<^sub>t\<^sub>e\<^sub>r\<^sub>_\<^sub>w\<^sub>o\<^sub>r\<^sub>l\<^sub>d) \<Rightarrow> \<lfloor>(mk2\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t ((mk2\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (var\<^sub>w\<^sub>o\<^sub>r\<^sub>m\<^sub>h\<^sub>o\<^sub>l\<^sub>e) (var\<^sub>w\<^sub>e\<^sub>i\<^sub>g\<^sub>h\<^sub>t) (\<lfloor>(mk2\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n ((class_ty_ext_equiv_1of2_aux\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (tt))))\<rfloor>))))\<rfloor>) - | (mk\<E>\<X>\<T>\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (tt)) \<Rightarrow> (case (case tt of (mk\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (t) (var\<^sub>w\<^sub>o\<^sub>r\<^sub>m\<^sub>h\<^sub>o\<^sub>l\<^sub>e) (var\<^sub>w\<^sub>e\<^sub>i\<^sub>g\<^sub>h\<^sub>t)) \<Rightarrow> (class_ty_ext_equiv_1of2_get_oid_inh\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (t))) of (oid , var\<^sub>s\<^sub>o\<^sub>u\<^sub>n\<^sub>d , var\<^sub>m\<^sub>o\<^sub>v\<^sub>i\<^sub>n\<^sub>g , var\<^sub>o\<^sub>u\<^sub>t\<^sub>e\<^sub>r\<^sub>_\<^sub>w\<^sub>o\<^sub>r\<^sub>l\<^sub>d) \<Rightarrow> \<lfloor>(mk2\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t ((class_ty_ext_equiv_1of2_aux\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (tt))))\<rfloor>)))))" -definition "class_ty_ext_equiv_1of2\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y = (\<lambda> (mk\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y (t) (own\<^sub>s\<^sub>o\<^sub>u\<^sub>n\<^sub>d) (own\<^sub>m\<^sub>o\<^sub>v\<^sub>i\<^sub>n\<^sub>g) (own\<^sub>o\<^sub>u\<^sub>t\<^sub>e\<^sub>r\<^sub>_\<^sub>w\<^sub>o\<^sub>r\<^sub>l\<^sub>d)) \<Rightarrow> (case (class_ty_ext_equiv_1of2_get_oid_inh\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y (t)) of (oid) \<Rightarrow> (mk2oid\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y (oid) ((class_ty_ext_equiv_1of2_aux\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y ((mk\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y (t) (own\<^sub>s\<^sub>o\<^sub>u\<^sub>n\<^sub>d) (own\<^sub>m\<^sub>o\<^sub>v\<^sub>i\<^sub>n\<^sub>g) (own\<^sub>o\<^sub>u\<^sub>t\<^sub>e\<^sub>r\<^sub>_\<^sub>w\<^sub>o\<^sub>r\<^sub>l\<^sub>d))))))))" -definition "class_ty_ext_equiv_1of2_get_oid_inh\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y = (\<lambda> (mk\<E>\<X>\<T>\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y (oid)) \<Rightarrow> (oid) - | (mk\<E>\<X>\<T>\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n ((mk\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (t) (var\<^sub>b\<^sub>o\<^sub>s\<^sub>s) (var\<^sub>s\<^sub>a\<^sub>l\<^sub>a\<^sub>r\<^sub>y)))) \<Rightarrow> (case (class_ty_ext_equiv_1of2_get_oid_inh\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (t)) of (oid , var\<^sub>w\<^sub>o\<^sub>r\<^sub>m\<^sub>h\<^sub>o\<^sub>l\<^sub>e , var\<^sub>w\<^sub>e\<^sub>i\<^sub>g\<^sub>h\<^sub>t , var\<^sub>s\<^sub>o\<^sub>u\<^sub>n\<^sub>d , var\<^sub>m\<^sub>o\<^sub>v\<^sub>i\<^sub>n\<^sub>g , var\<^sub>o\<^sub>u\<^sub>t\<^sub>e\<^sub>r\<^sub>_\<^sub>w\<^sub>o\<^sub>r\<^sub>l\<^sub>d) \<Rightarrow> (oid)) - | (mk\<E>\<X>\<T>\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t ((mk\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (t) (var\<^sub>w\<^sub>o\<^sub>r\<^sub>m\<^sub>h\<^sub>o\<^sub>l\<^sub>e) (var\<^sub>w\<^sub>e\<^sub>i\<^sub>g\<^sub>h\<^sub>t)))) \<Rightarrow> (case (class_ty_ext_equiv_1of2_get_oid_inh\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (t)) of (oid , var\<^sub>s\<^sub>o\<^sub>u\<^sub>n\<^sub>d , var\<^sub>m\<^sub>o\<^sub>v\<^sub>i\<^sub>n\<^sub>g , var\<^sub>o\<^sub>u\<^sub>t\<^sub>e\<^sub>r\<^sub>_\<^sub>w\<^sub>o\<^sub>r\<^sub>l\<^sub>d) \<Rightarrow> (oid)) - | (mk\<E>\<X>\<T>\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y ((mk\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y (t) (var\<^sub>s\<^sub>o\<^sub>u\<^sub>n\<^sub>d) (var\<^sub>m\<^sub>o\<^sub>v\<^sub>i\<^sub>n\<^sub>g) (var\<^sub>o\<^sub>u\<^sub>t\<^sub>e\<^sub>r\<^sub>_\<^sub>w\<^sub>o\<^sub>r\<^sub>l\<^sub>d)))) \<Rightarrow> (case (class_ty_ext_equiv_1of2_get_oid_inh\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y (t)) of (oid) \<Rightarrow> (oid)))" -definition "class_ty_ext_equiv_1of2_aux\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y = (\<lambda> (mk\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y (t)) \<Rightarrow> (mk2\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y ((case t of (mk\<E>\<X>\<T>\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y (oid)) \<Rightarrow> None - | (mk\<E>\<X>\<T>\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (tt)) \<Rightarrow> (case (case tt of (mk\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (t) (var\<^sub>b\<^sub>o\<^sub>s\<^sub>s) (var\<^sub>s\<^sub>a\<^sub>l\<^sub>a\<^sub>r\<^sub>y)) \<Rightarrow> (class_ty_ext_equiv_1of2_get_oid_inh\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (t))) of (oid , var\<^sub>w\<^sub>o\<^sub>r\<^sub>m\<^sub>h\<^sub>o\<^sub>l\<^sub>e , var\<^sub>w\<^sub>e\<^sub>i\<^sub>g\<^sub>h\<^sub>t , var\<^sub>s\<^sub>o\<^sub>u\<^sub>n\<^sub>d , var\<^sub>m\<^sub>o\<^sub>v\<^sub>i\<^sub>n\<^sub>g , var\<^sub>o\<^sub>u\<^sub>t\<^sub>e\<^sub>r\<^sub>_\<^sub>w\<^sub>o\<^sub>r\<^sub>l\<^sub>d) \<Rightarrow> \<lfloor>(mk2\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y ((mk2\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y (var\<^sub>s\<^sub>o\<^sub>u\<^sub>n\<^sub>d) (var\<^sub>m\<^sub>o\<^sub>v\<^sub>i\<^sub>n\<^sub>g) (var\<^sub>o\<^sub>u\<^sub>t\<^sub>e\<^sub>r\<^sub>_\<^sub>w\<^sub>o\<^sub>r\<^sub>l\<^sub>d) (\<lfloor>(mk2\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t ((mk2\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (var\<^sub>w\<^sub>o\<^sub>r\<^sub>m\<^sub>h\<^sub>o\<^sub>l\<^sub>e) (var\<^sub>w\<^sub>e\<^sub>i\<^sub>g\<^sub>h\<^sub>t) (\<lfloor>(mk2\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n ((class_ty_ext_equiv_1of2_aux\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (tt))))\<rfloor>))))\<rfloor>))))\<rfloor>) - | (mk\<E>\<X>\<T>\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (tt)) \<Rightarrow> (case (case tt of (mk\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (t) (var\<^sub>w\<^sub>o\<^sub>r\<^sub>m\<^sub>h\<^sub>o\<^sub>l\<^sub>e) (var\<^sub>w\<^sub>e\<^sub>i\<^sub>g\<^sub>h\<^sub>t)) \<Rightarrow> (class_ty_ext_equiv_1of2_get_oid_inh\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (t))) of (oid , var\<^sub>s\<^sub>o\<^sub>u\<^sub>n\<^sub>d , var\<^sub>m\<^sub>o\<^sub>v\<^sub>i\<^sub>n\<^sub>g , var\<^sub>o\<^sub>u\<^sub>t\<^sub>e\<^sub>r\<^sub>_\<^sub>w\<^sub>o\<^sub>r\<^sub>l\<^sub>d) \<Rightarrow> \<lfloor>(mk2\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y ((mk2\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y (var\<^sub>s\<^sub>o\<^sub>u\<^sub>n\<^sub>d) (var\<^sub>m\<^sub>o\<^sub>v\<^sub>i\<^sub>n\<^sub>g) (var\<^sub>o\<^sub>u\<^sub>t\<^sub>e\<^sub>r\<^sub>_\<^sub>w\<^sub>o\<^sub>r\<^sub>l\<^sub>d) (\<lfloor>(mk2\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t ((class_ty_ext_equiv_1of2_aux\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (tt))))\<rfloor>))))\<rfloor>) - | (mk\<E>\<X>\<T>\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y (tt)) \<Rightarrow> (case (case tt of (mk\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y (t) (var\<^sub>s\<^sub>o\<^sub>u\<^sub>n\<^sub>d) (var\<^sub>m\<^sub>o\<^sub>v\<^sub>i\<^sub>n\<^sub>g) (var\<^sub>o\<^sub>u\<^sub>t\<^sub>e\<^sub>r\<^sub>_\<^sub>w\<^sub>o\<^sub>r\<^sub>l\<^sub>d)) \<Rightarrow> (class_ty_ext_equiv_1of2_get_oid_inh\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y (t))) of (oid) \<Rightarrow> \<lfloor>(mk2\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y ((class_ty_ext_equiv_1of2_aux\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y (tt))))\<rfloor>)))))" -definition "class_ty_ext_equiv_1of2\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y = (\<lambda> (mk\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y (t)) \<Rightarrow> (case (class_ty_ext_equiv_1of2_get_oid_inh\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y (t)) of (oid) \<Rightarrow> (mk2oid\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y (oid) ((class_ty_ext_equiv_1of2_aux\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y ((mk\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y (t))))))))" - -(* 19 ************************************ 52 + 1 *) -text \<open> - Now, we construct a concrete ``universe of OclAny types'' by injection into a -sum type containing the class types. This type of OclAny will be used as instance -for all respective type-variables. \<close> - -(* 20 ************************************ 53 + 1 *) (* term Floor1_infra.print_infra_datatype_universe *) -datatype \<AA> = in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n "ty\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n" - | in\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t "ty\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t" - | in\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y "ty\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y" - | in\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y "ty\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y" - -(* 21 ************************************ 54 + 1 *) -text \<open> - Having fixed the object universe, we can introduce type synonyms that exactly correspond -to \OCL types. Again, we exploit that our representation of \OCL is a ``shallow embedding'' with a -one-to-one correspondance of \OCL-types to types of the meta-language \HOL. \<close> - -(* 22 ************************************ 55 + 7 *) (* term Floor1_infra.print_infra_type_synonym_class *) -type_synonym Void = "\<AA> Void" -type_synonym Boolean = "\<AA> Boolean" -type_synonym Integer = "\<AA> Integer" -type_synonym Real = "\<AA> Real" -type_synonym String = "\<AA> String" -type_synonym '\<alpha> val' = "(\<AA>, '\<alpha>) val" -type_notation val' ("\<cdot>(_)") - -(* 23 ************************************ 62 + 4 *) (* term Floor1_infra.print_infra_type_synonym_class_higher *) -type_synonym Person = "\<langle>\<langle>ty\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rangle>\<^sub>\<bottom>\<rangle>\<^sub>\<bottom>" -type_synonym Planet = "\<langle>\<langle>ty\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t\<rangle>\<^sub>\<bottom>\<rangle>\<^sub>\<bottom>" -type_synonym Galaxy = "\<langle>\<langle>ty\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y\<rangle>\<^sub>\<bottom>\<rangle>\<^sub>\<bottom>" -type_synonym OclAny = "\<langle>\<langle>ty\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y\<rangle>\<^sub>\<bottom>\<rangle>\<^sub>\<bottom>" - -(* 24 ************************************ 66 + 3 *) (* term Floor1_infra.print_infra_type_synonym_class_rec *) -type_synonym Sequence_Person = "(\<AA>, ty\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n option option Sequence\<^sub>b\<^sub>a\<^sub>s\<^sub>e) val" -type_synonym Set_Person = "(\<AA>, ty\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n option option Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e) val" -type_synonym Set_Sequence_Planet = "(\<AA>, ty\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t option option Sequence\<^sub>b\<^sub>a\<^sub>s\<^sub>e Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e) val" - -(* 25 ************************************ 69 + 0 *) (* term Floor1_infra.print_infra_enum_syn *) - -(* 26 ************************************ 69 + 1 *) -text \<open> - To reuse key-elements of the library like referential equality, we have -to show that the object universe belongs to the type class ``oclany,'' \ie, - each class type has to provide a function @{term oid_of} yielding the Object ID (oid) of the object. \<close> - -(* 27 ************************************ 70 + 4 *) (* term Floor1_infra.print_infra_instantiation_class *) -instantiation ty\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n :: object -begin - definition oid_of_ty\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_def : "oid_of = (\<lambda> mk\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n t _ _ \<Rightarrow> (case t of (mk\<E>\<X>\<T>\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (t) (_) (_) (_) (_) (_)) \<Rightarrow> t))" - instance .. -end -instantiation ty\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t :: object -begin - definition oid_of_ty\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_def : "oid_of = (\<lambda> mk\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t t _ _ \<Rightarrow> (case t of (mk\<E>\<X>\<T>\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (t) (_) (_) (_)) \<Rightarrow> t - | (mk\<E>\<X>\<T>\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (t)) \<Rightarrow> (oid_of (t))))" - instance .. -end -instantiation ty\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y :: object -begin - definition oid_of_ty\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_def : "oid_of = (\<lambda> mk\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y t _ _ _ \<Rightarrow> (case t of (mk\<E>\<X>\<T>\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y (t)) \<Rightarrow> t - | (mk\<E>\<X>\<T>\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (t)) \<Rightarrow> (oid_of (t)) - | (mk\<E>\<X>\<T>\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (t)) \<Rightarrow> (oid_of (t))))" - instance .. -end -instantiation ty\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y :: object -begin - definition oid_of_ty\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_def : "oid_of = (\<lambda> mk\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y t \<Rightarrow> (case t of (mk\<E>\<X>\<T>\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y (t)) \<Rightarrow> t - | (mk\<E>\<X>\<T>\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (t)) \<Rightarrow> (oid_of (t)) - | (mk\<E>\<X>\<T>\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (t)) \<Rightarrow> (oid_of (t)) - | (mk\<E>\<X>\<T>\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y (t)) \<Rightarrow> (oid_of (t))))" - instance .. -end - -(* 28 ************************************ 74 + 1 *) (* term Floor1_infra.print_infra_instantiation_universe *) -instantiation \<AA> :: object -begin - definition oid_of_\<AA>_def : "oid_of = (\<lambda> in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n Person \<Rightarrow> oid_of Person - | in\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t Planet \<Rightarrow> oid_of Planet - | in\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y Galaxy \<Rightarrow> oid_of Galaxy - | in\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y OclAny \<Rightarrow> oid_of OclAny)" - instance .. -end - -(* 29 ************************************ 75 + 1 *) -section \<open>Class Model: Instantiation of the Generic Strict Equality\<close> - -(* 30 ************************************ 76 + 1 *) -text \<open> - We instantiate the referential equality -on @{text "Person"} and @{text "OclAny"} \<close> - -(* 31 ************************************ 77 + 4 *) (* term Floor1_infra.print_instantia_def_strictrefeq *) -overloading StrictRefEq \<equiv> "(StrictRefEq::(\<cdot>Person) \<Rightarrow> _ \<Rightarrow> _)" -begin - definition StrictRefEq\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n : "(x::\<cdot>Person) \<doteq> y \<equiv> StrictRefEq\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t x y" -end -overloading StrictRefEq \<equiv> "(StrictRefEq::(\<cdot>Planet) \<Rightarrow> _ \<Rightarrow> _)" -begin - definition StrictRefEq\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t : "(x::\<cdot>Planet) \<doteq> y \<equiv> StrictRefEq\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t x y" -end -overloading StrictRefEq \<equiv> "(StrictRefEq::(\<cdot>Galaxy) \<Rightarrow> _ \<Rightarrow> _)" -begin - definition StrictRefEq\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y : "(x::\<cdot>Galaxy) \<doteq> y \<equiv> StrictRefEq\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t x y" -end -overloading StrictRefEq \<equiv> "(StrictRefEq::(\<cdot>OclAny) \<Rightarrow> _ \<Rightarrow> _)" -begin - definition StrictRefEq\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y : "(x::\<cdot>OclAny) \<doteq> y \<equiv> StrictRefEq\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t x y" -end - -(* 32 ************************************ 81 + 1 *) (* term Floor1_infra.print_instantia_lemmas_strictrefeq *) -lemmas[simp,code_unfold] = StrictRefEq\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n - StrictRefEq\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t - StrictRefEq\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y - StrictRefEq\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y - -(* 33 ************************************ 82 + 1 *) -text \<open> - For each Class \emph{C}, we will have a casting operation \inlineocl{.oclAsType($C$)}, - a test on the actual type \inlineocl{.oclIsTypeOf($C$)} as well as its relaxed form - \inlineocl{.oclIsKindOf($C$)} (corresponding exactly to Java's \verb+instanceof+-operator. -\<close> - -(* 34 ************************************ 83 + 1 *) -text \<open> - Thus, since we have two class-types in our concrete class hierarchy, we have -two operations to declare and to provide two overloading definitions for the two static types. -\<close> - -(* 35 ************************************ 84 + 1 *) -section \<open>Class Model: OclAsType\<close> - -(* 36 ************************************ 85 + 1 *) -subsection \<open>Definition\<close> - -(* 37 ************************************ 86 + 4 *) (* term Floor1_astype.print_astype_consts *) -consts OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n :: "'\<alpha> \<Rightarrow> \<cdot>Person" ("(_) .oclAsType'(Person')") -consts OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t :: "'\<alpha> \<Rightarrow> \<cdot>Planet" ("(_) .oclAsType'(Planet')") -consts OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y :: "'\<alpha> \<Rightarrow> \<cdot>Galaxy" ("(_) .oclAsType'(Galaxy')") -consts OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y :: "'\<alpha> \<Rightarrow> \<cdot>OclAny" ("(_) .oclAsType'(OclAny')") - -(* 38 ************************************ 90 + 16 *) (* term Floor1_astype.print_astype_class *) -overloading OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n \<equiv> "(OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n::(\<cdot>Person) \<Rightarrow> _)" -begin - definition OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person : "(x::\<cdot>Person) .oclAsType(Person) \<equiv> x" -end -overloading OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n \<equiv> "(OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n::(\<cdot>Planet) \<Rightarrow> _)" -begin - definition OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet : "(x::\<cdot>Planet) .oclAsType(Person) \<equiv> (\<lambda>\<tau>. (case (x (\<tau>)) of \<bottom> \<Rightarrow> (invalid (\<tau>)) - | \<lfloor>\<bottom>\<rfloor> \<Rightarrow> (null (\<tau>)) - | \<lfloor>\<lfloor>(mk\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t ((mk\<E>\<X>\<T>\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (Person))) (_) (_))\<rfloor>\<rfloor> \<Rightarrow> \<lfloor>\<lfloor>Person\<rfloor>\<rfloor> - | _ \<Rightarrow> (invalid (\<tau>))))" -end -overloading OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n \<equiv> "(OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n::(\<cdot>Galaxy) \<Rightarrow> _)" -begin - definition OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy : "(x::\<cdot>Galaxy) .oclAsType(Person) \<equiv> (\<lambda>\<tau>. (case (x (\<tau>)) of \<bottom> \<Rightarrow> (invalid (\<tau>)) - | \<lfloor>\<bottom>\<rfloor> \<Rightarrow> (null (\<tau>)) - | \<lfloor>\<lfloor>(mk\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y ((mk\<E>\<X>\<T>\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (Person))) (_) (_) (_))\<rfloor>\<rfloor> \<Rightarrow> \<lfloor>\<lfloor>Person\<rfloor>\<rfloor> - | _ \<Rightarrow> (invalid (\<tau>))))" -end -overloading OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n \<equiv> "(OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n::(\<cdot>OclAny) \<Rightarrow> _)" -begin - definition OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny : "(x::\<cdot>OclAny) .oclAsType(Person) \<equiv> (\<lambda>\<tau>. (case (x (\<tau>)) of \<bottom> \<Rightarrow> (invalid (\<tau>)) - | \<lfloor>\<bottom>\<rfloor> \<Rightarrow> (null (\<tau>)) - | \<lfloor>\<lfloor>(mk\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y ((mk\<E>\<X>\<T>\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (Person))))\<rfloor>\<rfloor> \<Rightarrow> \<lfloor>\<lfloor>Person\<rfloor>\<rfloor> - | _ \<Rightarrow> (invalid (\<tau>))))" -end -overloading OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t \<equiv> "(OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t::(\<cdot>Planet) \<Rightarrow> _)" -begin - definition OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet : "(x::\<cdot>Planet) .oclAsType(Planet) \<equiv> x" -end -overloading OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t \<equiv> "(OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t::(\<cdot>Galaxy) \<Rightarrow> _)" -begin - definition OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy : "(x::\<cdot>Galaxy) .oclAsType(Planet) \<equiv> (\<lambda>\<tau>. (case (x (\<tau>)) of \<bottom> \<Rightarrow> (invalid (\<tau>)) - | \<lfloor>\<bottom>\<rfloor> \<Rightarrow> (null (\<tau>)) - | \<lfloor>\<lfloor>(mk\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y ((mk\<E>\<X>\<T>\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (Planet))) (_) (_) (_))\<rfloor>\<rfloor> \<Rightarrow> \<lfloor>\<lfloor>Planet\<rfloor>\<rfloor> - | _ \<Rightarrow> (invalid (\<tau>))))" -end -overloading OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t \<equiv> "(OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t::(\<cdot>OclAny) \<Rightarrow> _)" -begin - definition OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny : "(x::\<cdot>OclAny) .oclAsType(Planet) \<equiv> (\<lambda>\<tau>. (case (x (\<tau>)) of \<bottom> \<Rightarrow> (invalid (\<tau>)) - | \<lfloor>\<bottom>\<rfloor> \<Rightarrow> (null (\<tau>)) - | \<lfloor>\<lfloor>(mk\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y ((mk\<E>\<X>\<T>\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (Planet))))\<rfloor>\<rfloor> \<Rightarrow> \<lfloor>\<lfloor>Planet\<rfloor>\<rfloor> - | _ \<Rightarrow> (invalid (\<tau>))))" -end -overloading OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t \<equiv> "(OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t::(\<cdot>Person) \<Rightarrow> _)" -begin - definition OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person : "(x::\<cdot>Person) .oclAsType(Planet) \<equiv> (\<lambda>\<tau>. (case (x (\<tau>)) of \<bottom> \<Rightarrow> (invalid (\<tau>)) - | \<lfloor>\<bottom>\<rfloor> \<Rightarrow> (null (\<tau>)) - | \<lfloor>\<lfloor>Person\<rfloor>\<rfloor> \<Rightarrow> \<lfloor>\<lfloor>(mk\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t ((mk\<E>\<X>\<T>\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (Person))) (None) (None))\<rfloor>\<rfloor>))" -end -overloading OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y \<equiv> "(OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y::(\<cdot>Galaxy) \<Rightarrow> _)" -begin - definition OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy : "(x::\<cdot>Galaxy) .oclAsType(Galaxy) \<equiv> x" -end -overloading OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y \<equiv> "(OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y::(\<cdot>OclAny) \<Rightarrow> _)" -begin - definition OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny : "(x::\<cdot>OclAny) .oclAsType(Galaxy) \<equiv> (\<lambda>\<tau>. (case (x (\<tau>)) of \<bottom> \<Rightarrow> (invalid (\<tau>)) - | \<lfloor>\<bottom>\<rfloor> \<Rightarrow> (null (\<tau>)) - | \<lfloor>\<lfloor>(mk\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y ((mk\<E>\<X>\<T>\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y (Galaxy))))\<rfloor>\<rfloor> \<Rightarrow> \<lfloor>\<lfloor>Galaxy\<rfloor>\<rfloor> - | _ \<Rightarrow> (invalid (\<tau>))))" -end -overloading OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y \<equiv> "(OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y::(\<cdot>Person) \<Rightarrow> _)" -begin - definition OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person : "(x::\<cdot>Person) .oclAsType(Galaxy) \<equiv> (\<lambda>\<tau>. (case (x (\<tau>)) of \<bottom> \<Rightarrow> (invalid (\<tau>)) - | \<lfloor>\<bottom>\<rfloor> \<Rightarrow> (null (\<tau>)) - | \<lfloor>\<lfloor>Person\<rfloor>\<rfloor> \<Rightarrow> \<lfloor>\<lfloor>(mk\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y ((mk\<E>\<X>\<T>\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (Person))) (None) (None) (None))\<rfloor>\<rfloor>))" -end -overloading OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y \<equiv> "(OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y::(\<cdot>Planet) \<Rightarrow> _)" -begin - definition OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet : "(x::\<cdot>Planet) .oclAsType(Galaxy) \<equiv> (\<lambda>\<tau>. (case (x (\<tau>)) of \<bottom> \<Rightarrow> (invalid (\<tau>)) - | \<lfloor>\<bottom>\<rfloor> \<Rightarrow> (null (\<tau>)) - | \<lfloor>\<lfloor>Planet\<rfloor>\<rfloor> \<Rightarrow> \<lfloor>\<lfloor>(mk\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y ((mk\<E>\<X>\<T>\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (Planet))) (None) (None) (None))\<rfloor>\<rfloor>))" -end -overloading OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y \<equiv> "(OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y::(\<cdot>OclAny) \<Rightarrow> _)" -begin - definition OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny : "(x::\<cdot>OclAny) .oclAsType(OclAny) \<equiv> x" -end -overloading OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y \<equiv> "(OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y::(\<cdot>Person) \<Rightarrow> _)" -begin - definition OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person : "(x::\<cdot>Person) .oclAsType(OclAny) \<equiv> (\<lambda>\<tau>. (case (x (\<tau>)) of \<bottom> \<Rightarrow> (invalid (\<tau>)) - | \<lfloor>\<bottom>\<rfloor> \<Rightarrow> (null (\<tau>)) - | \<lfloor>\<lfloor>Person\<rfloor>\<rfloor> \<Rightarrow> \<lfloor>\<lfloor>(mk\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y ((mk\<E>\<X>\<T>\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (Person))))\<rfloor>\<rfloor>))" -end -overloading OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y \<equiv> "(OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y::(\<cdot>Planet) \<Rightarrow> _)" -begin - definition OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet : "(x::\<cdot>Planet) .oclAsType(OclAny) \<equiv> (\<lambda>\<tau>. (case (x (\<tau>)) of \<bottom> \<Rightarrow> (invalid (\<tau>)) - | \<lfloor>\<bottom>\<rfloor> \<Rightarrow> (null (\<tau>)) - | \<lfloor>\<lfloor>Planet\<rfloor>\<rfloor> \<Rightarrow> \<lfloor>\<lfloor>(mk\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y ((mk\<E>\<X>\<T>\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (Planet))))\<rfloor>\<rfloor>))" -end -overloading OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y \<equiv> "(OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y::(\<cdot>Galaxy) \<Rightarrow> _)" -begin - definition OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy : "(x::\<cdot>Galaxy) .oclAsType(OclAny) \<equiv> (\<lambda>\<tau>. (case (x (\<tau>)) of \<bottom> \<Rightarrow> (invalid (\<tau>)) - | \<lfloor>\<bottom>\<rfloor> \<Rightarrow> (null (\<tau>)) - | \<lfloor>\<lfloor>Galaxy\<rfloor>\<rfloor> \<Rightarrow> \<lfloor>\<lfloor>(mk\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y ((mk\<E>\<X>\<T>\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y (Galaxy))))\<rfloor>\<rfloor>))" -end - -(* 39 ************************************ 106 + 4 *) (* term Floor1_astype.print_astype_from_universe *) -definition "OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_\<AA> = (\<lambda> (in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (Person)) \<Rightarrow> \<lfloor>Person\<rfloor> - | (in\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t ((mk\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t ((mk\<E>\<X>\<T>\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (Person))) (_) (_)))) \<Rightarrow> \<lfloor>Person\<rfloor> - | (in\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y ((mk\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y ((mk\<E>\<X>\<T>\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (Person))) (_) (_) (_)))) \<Rightarrow> \<lfloor>Person\<rfloor> - | (in\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y ((mk\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y ((mk\<E>\<X>\<T>\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (Person)))))) \<Rightarrow> \<lfloor>Person\<rfloor> - | _ \<Rightarrow> None)" -definition "OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_\<AA> = (\<lambda> (in\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (Planet)) \<Rightarrow> \<lfloor>Planet\<rfloor> - | (in\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y ((mk\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y ((mk\<E>\<X>\<T>\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (Planet))) (_) (_) (_)))) \<Rightarrow> \<lfloor>Planet\<rfloor> - | (in\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y ((mk\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y ((mk\<E>\<X>\<T>\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (Planet)))))) \<Rightarrow> \<lfloor>Planet\<rfloor> - | (in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (Person)) \<Rightarrow> \<lfloor>(mk\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t ((mk\<E>\<X>\<T>\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (Person))) (None) (None))\<rfloor> - | _ \<Rightarrow> None)" -definition "OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_\<AA> = (\<lambda> (in\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y (Galaxy)) \<Rightarrow> \<lfloor>Galaxy\<rfloor> - | (in\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y ((mk\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y ((mk\<E>\<X>\<T>\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y (Galaxy)))))) \<Rightarrow> \<lfloor>Galaxy\<rfloor> - | (in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (Person)) \<Rightarrow> \<lfloor>(mk\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y ((mk\<E>\<X>\<T>\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (Person))) (None) (None) (None))\<rfloor> - | (in\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (Planet)) \<Rightarrow> \<lfloor>(mk\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y ((mk\<E>\<X>\<T>\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (Planet))) (None) (None) (None))\<rfloor> - | _ \<Rightarrow> None)" -definition "OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_\<AA> = Some o (\<lambda> (in\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y (OclAny)) \<Rightarrow> OclAny - | (in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (Person)) \<Rightarrow> (mk\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y ((mk\<E>\<X>\<T>\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (Person)))) - | (in\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (Planet)) \<Rightarrow> (mk\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y ((mk\<E>\<X>\<T>\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (Planet)))) - | (in\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y (Galaxy)) \<Rightarrow> (mk\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y ((mk\<E>\<X>\<T>\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y (Galaxy)))))" - -(* 40 ************************************ 110 + 1 *) (* term Floor1_astype.print_astype_lemmas_id *) -lemmas[simp,code_unfold] = OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person - OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet - OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy - OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny - -(* 41 ************************************ 111 + 1 *) -subsection \<open>Context Passing\<close> - -(* 42 ************************************ 112 + 64 *) (* term Floor1_astype.print_astype_lemma_cp *) -lemma cp_OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_OclAny : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>OclAny)))::\<cdot>OclAny) .oclAsType(OclAny)))))" -by(rule cpI1, simp) -lemma cp_OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy_OclAny : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Galaxy)))::\<cdot>OclAny) .oclAsType(OclAny)))))" -by(rule cpI1, simp) -lemma cp_OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet_OclAny : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Planet)))::\<cdot>OclAny) .oclAsType(OclAny)))))" -by(rule cpI1, simp) -lemma cp_OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_OclAny : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Person)))::\<cdot>OclAny) .oclAsType(OclAny)))))" -by(rule cpI1, simp) -lemma cp_OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_Galaxy : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>OclAny)))::\<cdot>Galaxy) .oclAsType(OclAny)))))" -by(rule cpI1, simp add: OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy) -lemma cp_OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy_Galaxy : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Galaxy)))::\<cdot>Galaxy) .oclAsType(OclAny)))))" -by(rule cpI1, simp add: OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy) -lemma cp_OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet_Galaxy : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Planet)))::\<cdot>Galaxy) .oclAsType(OclAny)))))" -by(rule cpI1, simp add: OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy) -lemma cp_OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_Galaxy : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Person)))::\<cdot>Galaxy) .oclAsType(OclAny)))))" -by(rule cpI1, simp add: OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy) -lemma cp_OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_Planet : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>OclAny)))::\<cdot>Planet) .oclAsType(OclAny)))))" -by(rule cpI1, simp add: OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet) -lemma cp_OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy_Planet : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Galaxy)))::\<cdot>Planet) .oclAsType(OclAny)))))" -by(rule cpI1, simp add: OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet) -lemma cp_OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet_Planet : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Planet)))::\<cdot>Planet) .oclAsType(OclAny)))))" -by(rule cpI1, simp add: OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet) -lemma cp_OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_Planet : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Person)))::\<cdot>Planet) .oclAsType(OclAny)))))" -by(rule cpI1, simp add: OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet) -lemma cp_OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_Person : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>OclAny)))::\<cdot>Person) .oclAsType(OclAny)))))" -by(rule cpI1, simp add: OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person) -lemma cp_OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy_Person : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Galaxy)))::\<cdot>Person) .oclAsType(OclAny)))))" -by(rule cpI1, simp add: OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person) -lemma cp_OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet_Person : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Planet)))::\<cdot>Person) .oclAsType(OclAny)))))" -by(rule cpI1, simp add: OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person) -lemma cp_OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_Person : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Person)))::\<cdot>Person) .oclAsType(OclAny)))))" -by(rule cpI1, simp add: OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person) -lemma cp_OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny_OclAny : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>OclAny)))::\<cdot>OclAny) .oclAsType(Galaxy)))))" -by(rule cpI1, simp add: OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny) -lemma cp_OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy_OclAny : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Galaxy)))::\<cdot>OclAny) .oclAsType(Galaxy)))))" -by(rule cpI1, simp add: OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny) -lemma cp_OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet_OclAny : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Planet)))::\<cdot>OclAny) .oclAsType(Galaxy)))))" -by(rule cpI1, simp add: OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny) -lemma cp_OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person_OclAny : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Person)))::\<cdot>OclAny) .oclAsType(Galaxy)))))" -by(rule cpI1, simp add: OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny) -lemma cp_OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny_Galaxy : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>OclAny)))::\<cdot>Galaxy) .oclAsType(Galaxy)))))" -by(rule cpI1, simp) -lemma cp_OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy_Galaxy : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Galaxy)))::\<cdot>Galaxy) .oclAsType(Galaxy)))))" -by(rule cpI1, simp) -lemma cp_OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet_Galaxy : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Planet)))::\<cdot>Galaxy) .oclAsType(Galaxy)))))" -by(rule cpI1, simp) -lemma cp_OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person_Galaxy : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Person)))::\<cdot>Galaxy) .oclAsType(Galaxy)))))" -by(rule cpI1, simp) -lemma cp_OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny_Planet : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>OclAny)))::\<cdot>Planet) .oclAsType(Galaxy)))))" -by(rule cpI1, simp add: OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet) -lemma cp_OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy_Planet : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Galaxy)))::\<cdot>Planet) .oclAsType(Galaxy)))))" -by(rule cpI1, simp add: OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet) -lemma cp_OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet_Planet : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Planet)))::\<cdot>Planet) .oclAsType(Galaxy)))))" -by(rule cpI1, simp add: OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet) -lemma cp_OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person_Planet : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Person)))::\<cdot>Planet) .oclAsType(Galaxy)))))" -by(rule cpI1, simp add: OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet) -lemma cp_OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny_Person : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>OclAny)))::\<cdot>Person) .oclAsType(Galaxy)))))" -by(rule cpI1, simp add: OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person) -lemma cp_OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy_Person : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Galaxy)))::\<cdot>Person) .oclAsType(Galaxy)))))" -by(rule cpI1, simp add: OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person) -lemma cp_OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet_Person : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Planet)))::\<cdot>Person) .oclAsType(Galaxy)))))" -by(rule cpI1, simp add: OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person) -lemma cp_OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person_Person : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Person)))::\<cdot>Person) .oclAsType(Galaxy)))))" -by(rule cpI1, simp add: OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person) -lemma cp_OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny_OclAny : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>OclAny)))::\<cdot>OclAny) .oclAsType(Planet)))))" -by(rule cpI1, simp add: OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny) -lemma cp_OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy_OclAny : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Galaxy)))::\<cdot>OclAny) .oclAsType(Planet)))))" -by(rule cpI1, simp add: OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny) -lemma cp_OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet_OclAny : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Planet)))::\<cdot>OclAny) .oclAsType(Planet)))))" -by(rule cpI1, simp add: OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny) -lemma cp_OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person_OclAny : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Person)))::\<cdot>OclAny) .oclAsType(Planet)))))" -by(rule cpI1, simp add: OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny) -lemma cp_OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny_Galaxy : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>OclAny)))::\<cdot>Galaxy) .oclAsType(Planet)))))" -by(rule cpI1, simp add: OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy) -lemma cp_OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy_Galaxy : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Galaxy)))::\<cdot>Galaxy) .oclAsType(Planet)))))" -by(rule cpI1, simp add: OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy) -lemma cp_OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet_Galaxy : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Planet)))::\<cdot>Galaxy) .oclAsType(Planet)))))" -by(rule cpI1, simp add: OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy) -lemma cp_OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person_Galaxy : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Person)))::\<cdot>Galaxy) .oclAsType(Planet)))))" -by(rule cpI1, simp add: OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy) -lemma cp_OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny_Planet : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>OclAny)))::\<cdot>Planet) .oclAsType(Planet)))))" -by(rule cpI1, simp) -lemma cp_OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy_Planet : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Galaxy)))::\<cdot>Planet) .oclAsType(Planet)))))" -by(rule cpI1, simp) -lemma cp_OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet_Planet : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Planet)))::\<cdot>Planet) .oclAsType(Planet)))))" -by(rule cpI1, simp) -lemma cp_OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person_Planet : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Person)))::\<cdot>Planet) .oclAsType(Planet)))))" -by(rule cpI1, simp) -lemma cp_OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny_Person : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>OclAny)))::\<cdot>Person) .oclAsType(Planet)))))" -by(rule cpI1, simp add: OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person) -lemma cp_OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy_Person : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Galaxy)))::\<cdot>Person) .oclAsType(Planet)))))" -by(rule cpI1, simp add: OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person) -lemma cp_OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet_Person : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Planet)))::\<cdot>Person) .oclAsType(Planet)))))" -by(rule cpI1, simp add: OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person) -lemma cp_OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person_Person : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Person)))::\<cdot>Person) .oclAsType(Planet)))))" -by(rule cpI1, simp add: OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person) -lemma cp_OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_OclAny : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>OclAny)))::\<cdot>OclAny) .oclAsType(Person)))))" -by(rule cpI1, simp add: OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny) -lemma cp_OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy_OclAny : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Galaxy)))::\<cdot>OclAny) .oclAsType(Person)))))" -by(rule cpI1, simp add: OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny) -lemma cp_OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet_OclAny : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Planet)))::\<cdot>OclAny) .oclAsType(Person)))))" -by(rule cpI1, simp add: OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny) -lemma cp_OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_OclAny : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Person)))::\<cdot>OclAny) .oclAsType(Person)))))" -by(rule cpI1, simp add: OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny) -lemma cp_OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_Galaxy : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>OclAny)))::\<cdot>Galaxy) .oclAsType(Person)))))" -by(rule cpI1, simp add: OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy) -lemma cp_OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy_Galaxy : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Galaxy)))::\<cdot>Galaxy) .oclAsType(Person)))))" -by(rule cpI1, simp add: OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy) -lemma cp_OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet_Galaxy : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Planet)))::\<cdot>Galaxy) .oclAsType(Person)))))" -by(rule cpI1, simp add: OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy) -lemma cp_OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_Galaxy : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Person)))::\<cdot>Galaxy) .oclAsType(Person)))))" -by(rule cpI1, simp add: OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy) -lemma cp_OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_Planet : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>OclAny)))::\<cdot>Planet) .oclAsType(Person)))))" -by(rule cpI1, simp add: OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet) -lemma cp_OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy_Planet : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Galaxy)))::\<cdot>Planet) .oclAsType(Person)))))" -by(rule cpI1, simp add: OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet) -lemma cp_OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet_Planet : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Planet)))::\<cdot>Planet) .oclAsType(Person)))))" -by(rule cpI1, simp add: OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet) -lemma cp_OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_Planet : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Person)))::\<cdot>Planet) .oclAsType(Person)))))" -by(rule cpI1, simp add: OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet) -lemma cp_OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_Person : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>OclAny)))::\<cdot>Person) .oclAsType(Person)))))" -by(rule cpI1, simp) -lemma cp_OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy_Person : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Galaxy)))::\<cdot>Person) .oclAsType(Person)))))" -by(rule cpI1, simp) -lemma cp_OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet_Person : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Planet)))::\<cdot>Person) .oclAsType(Person)))))" -by(rule cpI1, simp) -lemma cp_OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_Person : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Person)))::\<cdot>Person) .oclAsType(Person)))))" -by(rule cpI1, simp) - -(* 43 ************************************ 176 + 1 *) (* term Floor1_astype.print_astype_lemmas_cp *) -lemmas[simp,code_unfold] = cp_OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_OclAny - cp_OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy_OclAny - cp_OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet_OclAny - cp_OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_OclAny - cp_OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_Galaxy - cp_OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy_Galaxy - cp_OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet_Galaxy - cp_OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_Galaxy - cp_OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_Planet - cp_OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy_Planet - cp_OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet_Planet - cp_OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_Planet - cp_OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_Person - cp_OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy_Person - cp_OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet_Person - cp_OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_Person - cp_OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny_OclAny - cp_OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy_OclAny - cp_OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet_OclAny - cp_OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person_OclAny - cp_OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny_Galaxy - cp_OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy_Galaxy - cp_OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet_Galaxy - cp_OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person_Galaxy - cp_OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny_Planet - cp_OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy_Planet - cp_OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet_Planet - cp_OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person_Planet - cp_OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny_Person - cp_OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy_Person - cp_OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet_Person - cp_OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person_Person - cp_OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny_OclAny - cp_OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy_OclAny - cp_OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet_OclAny - cp_OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person_OclAny - cp_OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny_Galaxy - cp_OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy_Galaxy - cp_OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet_Galaxy - cp_OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person_Galaxy - cp_OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny_Planet - cp_OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy_Planet - cp_OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet_Planet - cp_OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person_Planet - cp_OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny_Person - cp_OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy_Person - cp_OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet_Person - cp_OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person_Person - cp_OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_OclAny - cp_OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy_OclAny - cp_OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet_OclAny - cp_OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_OclAny - cp_OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_Galaxy - cp_OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy_Galaxy - cp_OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet_Galaxy - cp_OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_Galaxy - cp_OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_Planet - cp_OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy_Planet - cp_OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet_Planet - cp_OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_Planet - cp_OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_Person - cp_OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy_Person - cp_OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet_Person - cp_OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_Person - -(* 44 ************************************ 177 + 1 *) -subsection \<open>Execution with Invalid or Null as Argument\<close> - -(* 45 ************************************ 178 + 32 *) (* term Floor1_astype.print_astype_lemma_strict *) -lemma OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_invalid : "((invalid::\<cdot>OclAny) .oclAsType(OclAny)) = invalid" -by(simp) -lemma OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy_invalid : "((invalid::\<cdot>Galaxy) .oclAsType(OclAny)) = invalid" -by(rule ext, simp add: OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy bot_option_def invalid_def) -lemma OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet_invalid : "((invalid::\<cdot>Planet) .oclAsType(OclAny)) = invalid" -by(rule ext, simp add: OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet bot_option_def invalid_def) -lemma OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_invalid : "((invalid::\<cdot>Person) .oclAsType(OclAny)) = invalid" -by(rule ext, simp add: OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person bot_option_def invalid_def) -lemma OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_null : "((null::\<cdot>OclAny) .oclAsType(OclAny)) = null" -by(simp) -lemma OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy_null : "((null::\<cdot>Galaxy) .oclAsType(OclAny)) = null" -by(rule ext, simp add: OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy bot_option_def null_fun_def null_option_def) -lemma OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet_null : "((null::\<cdot>Planet) .oclAsType(OclAny)) = null" -by(rule ext, simp add: OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet bot_option_def null_fun_def null_option_def) -lemma OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_null : "((null::\<cdot>Person) .oclAsType(OclAny)) = null" -by(rule ext, simp add: OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person bot_option_def null_fun_def null_option_def) -lemma OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny_invalid : "((invalid::\<cdot>OclAny) .oclAsType(Galaxy)) = invalid" -by(rule ext, simp add: OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny bot_option_def invalid_def) -lemma OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy_invalid : "((invalid::\<cdot>Galaxy) .oclAsType(Galaxy)) = invalid" -by(simp) -lemma OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet_invalid : "((invalid::\<cdot>Planet) .oclAsType(Galaxy)) = invalid" -by(rule ext, simp add: OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet bot_option_def invalid_def) -lemma OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person_invalid : "((invalid::\<cdot>Person) .oclAsType(Galaxy)) = invalid" -by(rule ext, simp add: OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person bot_option_def invalid_def) -lemma OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny_null : "((null::\<cdot>OclAny) .oclAsType(Galaxy)) = null" -by(rule ext, simp add: OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny bot_option_def null_fun_def null_option_def) -lemma OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy_null : "((null::\<cdot>Galaxy) .oclAsType(Galaxy)) = null" -by(simp) -lemma OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet_null : "((null::\<cdot>Planet) .oclAsType(Galaxy)) = null" -by(rule ext, simp add: OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet bot_option_def null_fun_def null_option_def) -lemma OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person_null : "((null::\<cdot>Person) .oclAsType(Galaxy)) = null" -by(rule ext, simp add: OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person bot_option_def null_fun_def null_option_def) -lemma OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny_invalid : "((invalid::\<cdot>OclAny) .oclAsType(Planet)) = invalid" -by(rule ext, simp add: OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny bot_option_def invalid_def) -lemma OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy_invalid : "((invalid::\<cdot>Galaxy) .oclAsType(Planet)) = invalid" -by(rule ext, simp add: OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy bot_option_def invalid_def) -lemma OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet_invalid : "((invalid::\<cdot>Planet) .oclAsType(Planet)) = invalid" -by(simp) -lemma OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person_invalid : "((invalid::\<cdot>Person) .oclAsType(Planet)) = invalid" -by(rule ext, simp add: OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person bot_option_def invalid_def) -lemma OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny_null : "((null::\<cdot>OclAny) .oclAsType(Planet)) = null" -by(rule ext, simp add: OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny bot_option_def null_fun_def null_option_def) -lemma OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy_null : "((null::\<cdot>Galaxy) .oclAsType(Planet)) = null" -by(rule ext, simp add: OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy bot_option_def null_fun_def null_option_def) -lemma OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet_null : "((null::\<cdot>Planet) .oclAsType(Planet)) = null" -by(simp) -lemma OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person_null : "((null::\<cdot>Person) .oclAsType(Planet)) = null" -by(rule ext, simp add: OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person bot_option_def null_fun_def null_option_def) -lemma OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_invalid : "((invalid::\<cdot>OclAny) .oclAsType(Person)) = invalid" -by(rule ext, simp add: OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny bot_option_def invalid_def) -lemma OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy_invalid : "((invalid::\<cdot>Galaxy) .oclAsType(Person)) = invalid" -by(rule ext, simp add: OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy bot_option_def invalid_def) -lemma OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet_invalid : "((invalid::\<cdot>Planet) .oclAsType(Person)) = invalid" -by(rule ext, simp add: OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet bot_option_def invalid_def) -lemma OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_invalid : "((invalid::\<cdot>Person) .oclAsType(Person)) = invalid" -by(simp) -lemma OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_null : "((null::\<cdot>OclAny) .oclAsType(Person)) = null" -by(rule ext, simp add: OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny bot_option_def null_fun_def null_option_def) -lemma OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy_null : "((null::\<cdot>Galaxy) .oclAsType(Person)) = null" -by(rule ext, simp add: OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy bot_option_def null_fun_def null_option_def) -lemma OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet_null : "((null::\<cdot>Planet) .oclAsType(Person)) = null" -by(rule ext, simp add: OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet bot_option_def null_fun_def null_option_def) -lemma OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_null : "((null::\<cdot>Person) .oclAsType(Person)) = null" -by(simp) - -(* 46 ************************************ 210 + 1 *) (* term Floor1_astype.print_astype_lemmas_strict *) -lemmas[simp,code_unfold] = OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_invalid - OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy_invalid - OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet_invalid - OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_invalid - OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_null - OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy_null - OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet_null - OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_null - OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny_invalid - OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy_invalid - OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet_invalid - OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person_invalid - OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny_null - OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy_null - OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet_null - OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person_null - OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny_invalid - OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy_invalid - OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet_invalid - OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person_invalid - OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny_null - OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy_null - OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet_null - OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person_null - OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_invalid - OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy_invalid - OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet_invalid - OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_invalid - OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_null - OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy_null - OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet_null - OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_null - -(* 47 ************************************ 211 + 1 *) -subsection \<open>Validity and Definedness Properties\<close> - -(* 48 ************************************ 212 + 6 *) (* term Floor1_astype.print_astype_defined *) -lemma OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person_defined : -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Person) .oclAsType(Planet)))" - using isdef -by(auto simp: OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person foundation16 null_option_def bot_option_def) -lemma OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person_defined : -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Person) .oclAsType(Galaxy)))" - using isdef -by(auto simp: OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person foundation16 null_option_def bot_option_def) -lemma OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet_defined : -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Planet) .oclAsType(Galaxy)))" - using isdef -by(auto simp: OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet foundation16 null_option_def bot_option_def) -lemma OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_defined : -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Person) .oclAsType(OclAny)))" - using isdef -by(auto simp: OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person foundation16 null_option_def bot_option_def) -lemma OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet_defined : -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Planet) .oclAsType(OclAny)))" - using isdef -by(auto simp: OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet foundation16 null_option_def bot_option_def) -lemma OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy_defined : -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Galaxy) .oclAsType(OclAny)))" - using isdef -by(auto simp: OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy foundation16 null_option_def bot_option_def) - -(* 49 ************************************ 218 + 1 *) -subsection \<open>Up Down Casting\<close> - -(* 50 ************************************ 219 + 6 *) (* term Floor1_astype.print_astype_up_d_cast0 *) -lemma up\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_down\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_cast0 : -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> (((X::\<cdot>Person) .oclAsType(Planet)) .oclAsType(Person)) \<triangleq> X" - using isdef -by(auto simp: OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet foundation22 foundation16 null_option_def bot_option_def split: ty\<E>\<X>\<T>\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n.split ty\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n.split) -lemma up\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_down\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_cast0 : -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> (((X::\<cdot>Person) .oclAsType(Galaxy)) .oclAsType(Person)) \<triangleq> X" - using isdef -by(auto simp: OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy foundation22 foundation16 null_option_def bot_option_def split: ty\<E>\<X>\<T>\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n.split ty\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n.split) -lemma up\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_down\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_cast0 : -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> (((X::\<cdot>Person) .oclAsType(OclAny)) .oclAsType(Person)) \<triangleq> X" - using isdef -by(auto simp: OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny foundation22 foundation16 null_option_def bot_option_def split: ty\<E>\<X>\<T>\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n.split ty\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n.split) -lemma up\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_down\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_cast0 : -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> (((X::\<cdot>Planet) .oclAsType(Galaxy)) .oclAsType(Planet)) \<triangleq> X" - using isdef -by(auto simp: OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy foundation22 foundation16 null_option_def bot_option_def split: ty\<E>\<X>\<T>\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t.split ty\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t.split) -lemma up\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_down\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_cast0 : -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> (((X::\<cdot>Planet) .oclAsType(OclAny)) .oclAsType(Planet)) \<triangleq> X" - using isdef -by(auto simp: OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny foundation22 foundation16 null_option_def bot_option_def split: ty\<E>\<X>\<T>\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t.split ty\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t.split) -lemma up\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_down\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_cast0 : -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> (((X::\<cdot>Galaxy) .oclAsType(OclAny)) .oclAsType(Galaxy)) \<triangleq> X" - using isdef -by(auto simp: OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny foundation22 foundation16 null_option_def bot_option_def split: ty\<E>\<X>\<T>\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y.split ty\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y.split) - -(* 51 ************************************ 225 + 6 *) (* term Floor1_astype.print_astype_up_d_cast *) -lemma up\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_down\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_cast : -shows "(((X::\<cdot>Person) .oclAsType(Planet)) .oclAsType(Person)) = X" - apply(rule ext, rename_tac \<tau>) - apply(rule foundation22[THEN iffD1]) - apply(case_tac "\<tau> \<Turnstile> (\<delta> (X))", simp add: up\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_down\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_cast0) - apply(simp add: defined_split, elim disjE) - apply((erule StrongEq_L_subst2_rev, simp, simp)+) -done -lemma up\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_down\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_cast : -shows "(((X::\<cdot>Person) .oclAsType(Galaxy)) .oclAsType(Person)) = X" - apply(rule ext, rename_tac \<tau>) - apply(rule foundation22[THEN iffD1]) - apply(case_tac "\<tau> \<Turnstile> (\<delta> (X))", simp add: up\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_down\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_cast0) - apply(simp add: defined_split, elim disjE) - apply((erule StrongEq_L_subst2_rev, simp, simp)+) -done -lemma up\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_down\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_cast : -shows "(((X::\<cdot>Person) .oclAsType(OclAny)) .oclAsType(Person)) = X" - apply(rule ext, rename_tac \<tau>) - apply(rule foundation22[THEN iffD1]) - apply(case_tac "\<tau> \<Turnstile> (\<delta> (X))", simp add: up\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_down\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_cast0) - apply(simp add: defined_split, elim disjE) - apply((erule StrongEq_L_subst2_rev, simp, simp)+) -done -lemma up\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_down\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_cast : -shows "(((X::\<cdot>Planet) .oclAsType(Galaxy)) .oclAsType(Planet)) = X" - apply(rule ext, rename_tac \<tau>) - apply(rule foundation22[THEN iffD1]) - apply(case_tac "\<tau> \<Turnstile> (\<delta> (X))", simp add: up\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_down\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_cast0) - apply(simp add: defined_split, elim disjE) - apply((erule StrongEq_L_subst2_rev, simp, simp)+) -done -lemma up\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_down\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_cast : -shows "(((X::\<cdot>Planet) .oclAsType(OclAny)) .oclAsType(Planet)) = X" - apply(rule ext, rename_tac \<tau>) - apply(rule foundation22[THEN iffD1]) - apply(case_tac "\<tau> \<Turnstile> (\<delta> (X))", simp add: up\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_down\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_cast0) - apply(simp add: defined_split, elim disjE) - apply((erule StrongEq_L_subst2_rev, simp, simp)+) -done -lemma up\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_down\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_cast : -shows "(((X::\<cdot>Galaxy) .oclAsType(OclAny)) .oclAsType(Galaxy)) = X" - apply(rule ext, rename_tac \<tau>) - apply(rule foundation22[THEN iffD1]) - apply(case_tac "\<tau> \<Turnstile> (\<delta> (X))", simp add: up\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_down\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_cast0) - apply(simp add: defined_split, elim disjE) - apply((erule StrongEq_L_subst2_rev, simp, simp)+) -done - -(* 52 ************************************ 231 + 6 *) (* term Floor1_astype.print_astype_d_up_cast *) -lemma down\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_up\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_cast : -assumes def_X: "X = ((Y::\<cdot>Person) .oclAsType(Planet))" -shows "(\<tau> \<Turnstile> ((not ((\<upsilon> (X)))) or ((X .oclAsType(Person)) .oclAsType(Planet)) \<doteq> X))" - apply(case_tac "(\<tau> \<Turnstile> ((not ((\<upsilon> (X))))))", rule foundation25, simp) -by(rule foundation25', simp add: def_X up\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_down\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_cast StrictRefEq\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_sym) -lemma down\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_up\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_cast : -assumes def_X: "X = ((Y::\<cdot>Person) .oclAsType(Galaxy))" -shows "(\<tau> \<Turnstile> ((not ((\<upsilon> (X)))) or ((X .oclAsType(Person)) .oclAsType(Galaxy)) \<doteq> X))" - apply(case_tac "(\<tau> \<Turnstile> ((not ((\<upsilon> (X))))))", rule foundation25, simp) -by(rule foundation25', simp add: def_X up\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_down\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_cast StrictRefEq\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_sym) -lemma down\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_up\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_cast : -assumes def_X: "X = ((Y::\<cdot>Person) .oclAsType(OclAny))" -shows "(\<tau> \<Turnstile> ((not ((\<upsilon> (X)))) or ((X .oclAsType(Person)) .oclAsType(OclAny)) \<doteq> X))" - apply(case_tac "(\<tau> \<Turnstile> ((not ((\<upsilon> (X))))))", rule foundation25, simp) -by(rule foundation25', simp add: def_X up\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_down\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_cast StrictRefEq\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_sym) -lemma down\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_up\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_cast : -assumes def_X: "X = ((Y::\<cdot>Planet) .oclAsType(Galaxy))" -shows "(\<tau> \<Turnstile> ((not ((\<upsilon> (X)))) or ((X .oclAsType(Planet)) .oclAsType(Galaxy)) \<doteq> X))" - apply(case_tac "(\<tau> \<Turnstile> ((not ((\<upsilon> (X))))))", rule foundation25, simp) -by(rule foundation25', simp add: def_X up\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_down\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_cast StrictRefEq\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_sym) -lemma down\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_up\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_cast : -assumes def_X: "X = ((Y::\<cdot>Planet) .oclAsType(OclAny))" -shows "(\<tau> \<Turnstile> ((not ((\<upsilon> (X)))) or ((X .oclAsType(Planet)) .oclAsType(OclAny)) \<doteq> X))" - apply(case_tac "(\<tau> \<Turnstile> ((not ((\<upsilon> (X))))))", rule foundation25, simp) -by(rule foundation25', simp add: def_X up\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_down\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_cast StrictRefEq\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_sym) -lemma down\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_up\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_cast : -assumes def_X: "X = ((Y::\<cdot>Galaxy) .oclAsType(OclAny))" -shows "(\<tau> \<Turnstile> ((not ((\<upsilon> (X)))) or ((X .oclAsType(Galaxy)) .oclAsType(OclAny)) \<doteq> X))" - apply(case_tac "(\<tau> \<Turnstile> ((not ((\<upsilon> (X))))))", rule foundation25, simp) -by(rule foundation25', simp add: def_X up\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_down\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_cast StrictRefEq\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_sym) - -(* 53 ************************************ 237 + 1 *) -subsection \<open>Const\<close> - -(* 54 ************************************ 238 + 16 *) (* term Floor1_astype.print_astype_lemma_const *) -lemma OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_const : "(const ((X::\<cdot>OclAny))) \<Longrightarrow> (const (X .oclAsType(OclAny)))" -by(simp add: const_def, (metis (no_types) OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny prod.collapse bot_option_def invalid_def null_fun_def null_option_def)?) -lemma OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy_const : "(const ((X::\<cdot>Galaxy))) \<Longrightarrow> (const (X .oclAsType(OclAny)))" -by(simp add: const_def, (metis (no_types) OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy prod.collapse bot_option_def invalid_def null_fun_def null_option_def)?) -lemma OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet_const : "(const ((X::\<cdot>Planet))) \<Longrightarrow> (const (X .oclAsType(OclAny)))" -by(simp add: const_def, (metis (no_types) OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet prod.collapse bot_option_def invalid_def null_fun_def null_option_def)?) -lemma OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_const : "(const ((X::\<cdot>Person))) \<Longrightarrow> (const (X .oclAsType(OclAny)))" -by(simp add: const_def, (metis (no_types) OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person prod.collapse bot_option_def invalid_def null_fun_def null_option_def)?) -lemma OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny_const : "(const ((X::\<cdot>OclAny))) \<Longrightarrow> (const (X .oclAsType(Galaxy)))" -by(simp add: const_def, (metis (no_types) OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny prod.collapse bot_option_def invalid_def null_fun_def null_option_def)?) -lemma OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy_const : "(const ((X::\<cdot>Galaxy))) \<Longrightarrow> (const (X .oclAsType(Galaxy)))" -by(simp add: const_def, (metis (no_types) OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy prod.collapse bot_option_def invalid_def null_fun_def null_option_def)?) -lemma OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet_const : "(const ((X::\<cdot>Planet))) \<Longrightarrow> (const (X .oclAsType(Galaxy)))" -by(simp add: const_def, (metis (no_types) OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet prod.collapse bot_option_def invalid_def null_fun_def null_option_def)?) -lemma OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person_const : "(const ((X::\<cdot>Person))) \<Longrightarrow> (const (X .oclAsType(Galaxy)))" -by(simp add: const_def, (metis (no_types) OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person prod.collapse bot_option_def invalid_def null_fun_def null_option_def)?) -lemma OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny_const : "(const ((X::\<cdot>OclAny))) \<Longrightarrow> (const (X .oclAsType(Planet)))" -by(simp add: const_def, (metis (no_types) OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny prod.collapse bot_option_def invalid_def null_fun_def null_option_def)?) -lemma OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy_const : "(const ((X::\<cdot>Galaxy))) \<Longrightarrow> (const (X .oclAsType(Planet)))" -by(simp add: const_def, (metis (no_types) OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy prod.collapse bot_option_def invalid_def null_fun_def null_option_def)?) -lemma OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet_const : "(const ((X::\<cdot>Planet))) \<Longrightarrow> (const (X .oclAsType(Planet)))" -by(simp add: const_def, (metis (no_types) OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet prod.collapse bot_option_def invalid_def null_fun_def null_option_def)?) -lemma OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person_const : "(const ((X::\<cdot>Person))) \<Longrightarrow> (const (X .oclAsType(Planet)))" -by(simp add: const_def, (metis (no_types) OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person prod.collapse bot_option_def invalid_def null_fun_def null_option_def)?) -lemma OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_const : "(const ((X::\<cdot>OclAny))) \<Longrightarrow> (const (X .oclAsType(Person)))" -by(simp add: const_def, (metis (no_types) OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny prod.collapse bot_option_def invalid_def null_fun_def null_option_def)?) -lemma OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy_const : "(const ((X::\<cdot>Galaxy))) \<Longrightarrow> (const (X .oclAsType(Person)))" -by(simp add: const_def, (metis (no_types) OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy prod.collapse bot_option_def invalid_def null_fun_def null_option_def)?) -lemma OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet_const : "(const ((X::\<cdot>Planet))) \<Longrightarrow> (const (X .oclAsType(Person)))" -by(simp add: const_def, (metis (no_types) OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet prod.collapse bot_option_def invalid_def null_fun_def null_option_def)?) -lemma OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_const : "(const ((X::\<cdot>Person))) \<Longrightarrow> (const (X .oclAsType(Person)))" -by(simp add: const_def, (metis (no_types) OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person prod.collapse bot_option_def invalid_def null_fun_def null_option_def)?) - -(* 55 ************************************ 254 + 1 *) (* term Floor1_astype.print_astype_lemmas_const *) -lemmas[simp,code_unfold] = OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_const - OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy_const - OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet_const - OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_const - OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny_const - OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy_const - OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet_const - OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person_const - OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny_const - OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy_const - OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet_const - OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person_const - OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_const - OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy_const - OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet_const - OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_const - -(* 56 ************************************ 255 + 1 *) -section \<open>Class Model: OclIsTypeOf\<close> - -(* 57 ************************************ 256 + 1 *) -subsection \<open>Definition\<close> - -(* 58 ************************************ 257 + 4 *) (* term Floor1_istypeof.print_istypeof_consts *) -consts OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n :: "'\<alpha> \<Rightarrow> Boolean" ("(_) .oclIsTypeOf'(Person')") -consts OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t :: "'\<alpha> \<Rightarrow> Boolean" ("(_) .oclIsTypeOf'(Planet')") -consts OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y :: "'\<alpha> \<Rightarrow> Boolean" ("(_) .oclIsTypeOf'(Galaxy')") -consts OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y :: "'\<alpha> \<Rightarrow> Boolean" ("(_) .oclIsTypeOf'(OclAny')") - -(* 59 ************************************ 261 + 16 *) (* term Floor1_istypeof.print_istypeof_class *) -overloading OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n \<equiv> "(OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n::(\<cdot>Person) \<Rightarrow> _)" -begin - definition OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person : "(x::\<cdot>Person) .oclIsTypeOf(Person) \<equiv> (\<lambda>\<tau>. (case (x (\<tau>)) of \<bottom> \<Rightarrow> (invalid (\<tau>)) - | \<lfloor>\<bottom>\<rfloor> \<Rightarrow> (true (\<tau>)) - | \<lfloor>\<lfloor>(mk\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n ((mk\<E>\<X>\<T>\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (_) (_) (_) (_) (_) (_))) (_) (_))\<rfloor>\<rfloor> \<Rightarrow> (true (\<tau>))))" -end -overloading OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n \<equiv> "(OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n::(\<cdot>Planet) \<Rightarrow> _)" -begin - definition OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet : "(x::\<cdot>Planet) .oclIsTypeOf(Person) \<equiv> (\<lambda>\<tau>. (case (x (\<tau>)) of \<bottom> \<Rightarrow> (invalid (\<tau>)) - | \<lfloor>\<bottom>\<rfloor> \<Rightarrow> (true (\<tau>)) - | \<lfloor>\<lfloor>(mk\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t ((mk\<E>\<X>\<T>\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (_))) (_) (_))\<rfloor>\<rfloor> \<Rightarrow> (true (\<tau>)) - | _ \<Rightarrow> (false (\<tau>))))" -end -overloading OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n \<equiv> "(OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n::(\<cdot>Galaxy) \<Rightarrow> _)" -begin - definition OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy : "(x::\<cdot>Galaxy) .oclIsTypeOf(Person) \<equiv> (\<lambda>\<tau>. (case (x (\<tau>)) of \<bottom> \<Rightarrow> (invalid (\<tau>)) - | \<lfloor>\<bottom>\<rfloor> \<Rightarrow> (true (\<tau>)) - | \<lfloor>\<lfloor>(mk\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y ((mk\<E>\<X>\<T>\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (_))) (_) (_) (_))\<rfloor>\<rfloor> \<Rightarrow> (true (\<tau>)) - | _ \<Rightarrow> (false (\<tau>))))" -end -overloading OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n \<equiv> "(OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n::(\<cdot>OclAny) \<Rightarrow> _)" -begin - definition OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny : "(x::\<cdot>OclAny) .oclIsTypeOf(Person) \<equiv> (\<lambda>\<tau>. (case (x (\<tau>)) of \<bottom> \<Rightarrow> (invalid (\<tau>)) - | \<lfloor>\<bottom>\<rfloor> \<Rightarrow> (true (\<tau>)) - | \<lfloor>\<lfloor>(mk\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y ((mk\<E>\<X>\<T>\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (_))))\<rfloor>\<rfloor> \<Rightarrow> (true (\<tau>)) - | _ \<Rightarrow> (false (\<tau>))))" -end -overloading OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t \<equiv> "(OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t::(\<cdot>Planet) \<Rightarrow> _)" -begin - definition OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet : "(x::\<cdot>Planet) .oclIsTypeOf(Planet) \<equiv> (\<lambda>\<tau>. (case (x (\<tau>)) of \<bottom> \<Rightarrow> (invalid (\<tau>)) - | \<lfloor>\<bottom>\<rfloor> \<Rightarrow> (true (\<tau>)) - | \<lfloor>\<lfloor>(mk\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t ((mk\<E>\<X>\<T>\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (_) (_) (_) (_))) (_) (_))\<rfloor>\<rfloor> \<Rightarrow> (true (\<tau>)) - | _ \<Rightarrow> (false (\<tau>))))" -end -overloading OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t \<equiv> "(OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t::(\<cdot>Galaxy) \<Rightarrow> _)" -begin - definition OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy : "(x::\<cdot>Galaxy) .oclIsTypeOf(Planet) \<equiv> (\<lambda>\<tau>. (case (x (\<tau>)) of \<bottom> \<Rightarrow> (invalid (\<tau>)) - | \<lfloor>\<bottom>\<rfloor> \<Rightarrow> (true (\<tau>)) - | \<lfloor>\<lfloor>(mk\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y ((mk\<E>\<X>\<T>\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (_))) (_) (_) (_))\<rfloor>\<rfloor> \<Rightarrow> (true (\<tau>)) - | _ \<Rightarrow> (false (\<tau>))))" -end -overloading OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t \<equiv> "(OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t::(\<cdot>OclAny) \<Rightarrow> _)" -begin - definition OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny : "(x::\<cdot>OclAny) .oclIsTypeOf(Planet) \<equiv> (\<lambda>\<tau>. (case (x (\<tau>)) of \<bottom> \<Rightarrow> (invalid (\<tau>)) - | \<lfloor>\<bottom>\<rfloor> \<Rightarrow> (true (\<tau>)) - | \<lfloor>\<lfloor>(mk\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y ((mk\<E>\<X>\<T>\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (_))))\<rfloor>\<rfloor> \<Rightarrow> (true (\<tau>)) - | _ \<Rightarrow> (false (\<tau>))))" -end -overloading OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t \<equiv> "(OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t::(\<cdot>Person) \<Rightarrow> _)" -begin - definition OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person : "(x::\<cdot>Person) .oclIsTypeOf(Planet) \<equiv> (\<lambda>\<tau>. (case (x (\<tau>)) of \<bottom> \<Rightarrow> (invalid (\<tau>)) - | \<lfloor>\<bottom>\<rfloor> \<Rightarrow> (true (\<tau>)) - | _ \<Rightarrow> (false (\<tau>))))" -end -overloading OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y \<equiv> "(OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y::(\<cdot>Galaxy) \<Rightarrow> _)" -begin - definition OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy : "(x::\<cdot>Galaxy) .oclIsTypeOf(Galaxy) \<equiv> (\<lambda>\<tau>. (case (x (\<tau>)) of \<bottom> \<Rightarrow> (invalid (\<tau>)) - | \<lfloor>\<bottom>\<rfloor> \<Rightarrow> (true (\<tau>)) - | \<lfloor>\<lfloor>(mk\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y ((mk\<E>\<X>\<T>\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y (_))) (_) (_) (_))\<rfloor>\<rfloor> \<Rightarrow> (true (\<tau>)) - | _ \<Rightarrow> (false (\<tau>))))" -end -overloading OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y \<equiv> "(OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y::(\<cdot>OclAny) \<Rightarrow> _)" -begin - definition OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny : "(x::\<cdot>OclAny) .oclIsTypeOf(Galaxy) \<equiv> (\<lambda>\<tau>. (case (x (\<tau>)) of \<bottom> \<Rightarrow> (invalid (\<tau>)) - | \<lfloor>\<bottom>\<rfloor> \<Rightarrow> (true (\<tau>)) - | \<lfloor>\<lfloor>(mk\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y ((mk\<E>\<X>\<T>\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y (_))))\<rfloor>\<rfloor> \<Rightarrow> (true (\<tau>)) - | _ \<Rightarrow> (false (\<tau>))))" -end -overloading OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y \<equiv> "(OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y::(\<cdot>Person) \<Rightarrow> _)" -begin - definition OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person : "(x::\<cdot>Person) .oclIsTypeOf(Galaxy) \<equiv> (\<lambda>\<tau>. (case (x (\<tau>)) of \<bottom> \<Rightarrow> (invalid (\<tau>)) - | \<lfloor>\<bottom>\<rfloor> \<Rightarrow> (true (\<tau>)) - | _ \<Rightarrow> (false (\<tau>))))" -end -overloading OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y \<equiv> "(OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y::(\<cdot>Planet) \<Rightarrow> _)" -begin - definition OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet : "(x::\<cdot>Planet) .oclIsTypeOf(Galaxy) \<equiv> (\<lambda>\<tau>. (case (x (\<tau>)) of \<bottom> \<Rightarrow> (invalid (\<tau>)) - | \<lfloor>\<bottom>\<rfloor> \<Rightarrow> (true (\<tau>)) - | _ \<Rightarrow> (false (\<tau>))))" -end -overloading OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y \<equiv> "(OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y::(\<cdot>OclAny) \<Rightarrow> _)" -begin - definition OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny : "(x::\<cdot>OclAny) .oclIsTypeOf(OclAny) \<equiv> (\<lambda>\<tau>. (case (x (\<tau>)) of \<bottom> \<Rightarrow> (invalid (\<tau>)) - | \<lfloor>\<bottom>\<rfloor> \<Rightarrow> (true (\<tau>)) - | \<lfloor>\<lfloor>(mk\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y ((mk\<E>\<X>\<T>\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y (_))))\<rfloor>\<rfloor> \<Rightarrow> (true (\<tau>)) - | _ \<Rightarrow> (false (\<tau>))))" -end -overloading OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y \<equiv> "(OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y::(\<cdot>Person) \<Rightarrow> _)" -begin - definition OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person : "(x::\<cdot>Person) .oclIsTypeOf(OclAny) \<equiv> (\<lambda>\<tau>. (case (x (\<tau>)) of \<bottom> \<Rightarrow> (invalid (\<tau>)) - | \<lfloor>\<bottom>\<rfloor> \<Rightarrow> (true (\<tau>)) - | _ \<Rightarrow> (false (\<tau>))))" -end -overloading OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y \<equiv> "(OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y::(\<cdot>Planet) \<Rightarrow> _)" -begin - definition OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet : "(x::\<cdot>Planet) .oclIsTypeOf(OclAny) \<equiv> (\<lambda>\<tau>. (case (x (\<tau>)) of \<bottom> \<Rightarrow> (invalid (\<tau>)) - | \<lfloor>\<bottom>\<rfloor> \<Rightarrow> (true (\<tau>)) - | _ \<Rightarrow> (false (\<tau>))))" -end -overloading OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y \<equiv> "(OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y::(\<cdot>Galaxy) \<Rightarrow> _)" -begin - definition OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy : "(x::\<cdot>Galaxy) .oclIsTypeOf(OclAny) \<equiv> (\<lambda>\<tau>. (case (x (\<tau>)) of \<bottom> \<Rightarrow> (invalid (\<tau>)) - | \<lfloor>\<bottom>\<rfloor> \<Rightarrow> (true (\<tau>)) - | _ \<Rightarrow> (false (\<tau>))))" -end - -(* 60 ************************************ 277 + 4 *) (* term Floor1_istypeof.print_istypeof_from_universe *) -definition "OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_\<AA> = (\<lambda> (in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (Person)) \<Rightarrow> (((((\<lambda>x _. \<lfloor>\<lfloor>x\<rfloor>\<rfloor>)) (Person))::\<cdot>Person) .oclIsTypeOf(Person)) - | (in\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (Planet)) \<Rightarrow> (((((\<lambda>x _. \<lfloor>\<lfloor>x\<rfloor>\<rfloor>)) (Planet))::\<cdot>Planet) .oclIsTypeOf(Person)) - | (in\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y (Galaxy)) \<Rightarrow> (((((\<lambda>x _. \<lfloor>\<lfloor>x\<rfloor>\<rfloor>)) (Galaxy))::\<cdot>Galaxy) .oclIsTypeOf(Person)) - | (in\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y (OclAny)) \<Rightarrow> (((((\<lambda>x _. \<lfloor>\<lfloor>x\<rfloor>\<rfloor>)) (OclAny))::\<cdot>OclAny) .oclIsTypeOf(Person)))" -definition "OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_\<AA> = (\<lambda> (in\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (Planet)) \<Rightarrow> (((((\<lambda>x _. \<lfloor>\<lfloor>x\<rfloor>\<rfloor>)) (Planet))::\<cdot>Planet) .oclIsTypeOf(Planet)) - | (in\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y (Galaxy)) \<Rightarrow> (((((\<lambda>x _. \<lfloor>\<lfloor>x\<rfloor>\<rfloor>)) (Galaxy))::\<cdot>Galaxy) .oclIsTypeOf(Planet)) - | (in\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y (OclAny)) \<Rightarrow> (((((\<lambda>x _. \<lfloor>\<lfloor>x\<rfloor>\<rfloor>)) (OclAny))::\<cdot>OclAny) .oclIsTypeOf(Planet)) - | (in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (Person)) \<Rightarrow> (((((\<lambda>x _. \<lfloor>\<lfloor>x\<rfloor>\<rfloor>)) (Person))::\<cdot>Person) .oclIsTypeOf(Planet)))" -definition "OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_\<AA> = (\<lambda> (in\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y (Galaxy)) \<Rightarrow> (((((\<lambda>x _. \<lfloor>\<lfloor>x\<rfloor>\<rfloor>)) (Galaxy))::\<cdot>Galaxy) .oclIsTypeOf(Galaxy)) - | (in\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y (OclAny)) \<Rightarrow> (((((\<lambda>x _. \<lfloor>\<lfloor>x\<rfloor>\<rfloor>)) (OclAny))::\<cdot>OclAny) .oclIsTypeOf(Galaxy)) - | (in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (Person)) \<Rightarrow> (((((\<lambda>x _. \<lfloor>\<lfloor>x\<rfloor>\<rfloor>)) (Person))::\<cdot>Person) .oclIsTypeOf(Galaxy)) - | (in\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (Planet)) \<Rightarrow> (((((\<lambda>x _. \<lfloor>\<lfloor>x\<rfloor>\<rfloor>)) (Planet))::\<cdot>Planet) .oclIsTypeOf(Galaxy)))" -definition "OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_\<AA> = (\<lambda> (in\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y (OclAny)) \<Rightarrow> (((((\<lambda>x _. \<lfloor>\<lfloor>x\<rfloor>\<rfloor>)) (OclAny))::\<cdot>OclAny) .oclIsTypeOf(OclAny)) - | (in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (Person)) \<Rightarrow> (((((\<lambda>x _. \<lfloor>\<lfloor>x\<rfloor>\<rfloor>)) (Person))::\<cdot>Person) .oclIsTypeOf(OclAny)) - | (in\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (Planet)) \<Rightarrow> (((((\<lambda>x _. \<lfloor>\<lfloor>x\<rfloor>\<rfloor>)) (Planet))::\<cdot>Planet) .oclIsTypeOf(OclAny)) - | (in\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y (Galaxy)) \<Rightarrow> (((((\<lambda>x _. \<lfloor>\<lfloor>x\<rfloor>\<rfloor>)) (Galaxy))::\<cdot>Galaxy) .oclIsTypeOf(OclAny)))" - -(* 61 ************************************ 281 + 1 *) (* term Floor1_istypeof.print_istypeof_lemmas_id *) -lemmas[simp,code_unfold] = OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person - OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet - OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy - OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny - -(* 62 ************************************ 282 + 1 *) -subsection \<open>Context Passing\<close> - -(* 63 ************************************ 283 + 64 *) (* term Floor1_istypeof.print_istypeof_lemma_cp *) -lemma cp_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_OclAny : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>OclAny)))::\<cdot>OclAny) .oclIsTypeOf(OclAny)))))" -by(rule cpI1, simp) -lemma cp_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy_OclAny : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Galaxy)))::\<cdot>OclAny) .oclIsTypeOf(OclAny)))))" -by(rule cpI1, simp) -lemma cp_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet_OclAny : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Planet)))::\<cdot>OclAny) .oclIsTypeOf(OclAny)))))" -by(rule cpI1, simp) -lemma cp_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_OclAny : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Person)))::\<cdot>OclAny) .oclIsTypeOf(OclAny)))))" -by(rule cpI1, simp) -lemma cp_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_Galaxy : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>OclAny)))::\<cdot>Galaxy) .oclIsTypeOf(OclAny)))))" -by(rule cpI1, simp add: OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy) -lemma cp_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy_Galaxy : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Galaxy)))::\<cdot>Galaxy) .oclIsTypeOf(OclAny)))))" -by(rule cpI1, simp add: OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy) -lemma cp_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet_Galaxy : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Planet)))::\<cdot>Galaxy) .oclIsTypeOf(OclAny)))))" -by(rule cpI1, simp add: OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy) -lemma cp_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_Galaxy : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Person)))::\<cdot>Galaxy) .oclIsTypeOf(OclAny)))))" -by(rule cpI1, simp add: OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy) -lemma cp_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_Planet : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>OclAny)))::\<cdot>Planet) .oclIsTypeOf(OclAny)))))" -by(rule cpI1, simp add: OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet) -lemma cp_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy_Planet : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Galaxy)))::\<cdot>Planet) .oclIsTypeOf(OclAny)))))" -by(rule cpI1, simp add: OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet) -lemma cp_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet_Planet : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Planet)))::\<cdot>Planet) .oclIsTypeOf(OclAny)))))" -by(rule cpI1, simp add: OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet) -lemma cp_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_Planet : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Person)))::\<cdot>Planet) .oclIsTypeOf(OclAny)))))" -by(rule cpI1, simp add: OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet) -lemma cp_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_Person : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>OclAny)))::\<cdot>Person) .oclIsTypeOf(OclAny)))))" -by(rule cpI1, simp add: OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person) -lemma cp_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy_Person : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Galaxy)))::\<cdot>Person) .oclIsTypeOf(OclAny)))))" -by(rule cpI1, simp add: OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person) -lemma cp_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet_Person : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Planet)))::\<cdot>Person) .oclIsTypeOf(OclAny)))))" -by(rule cpI1, simp add: OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person) -lemma cp_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_Person : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Person)))::\<cdot>Person) .oclIsTypeOf(OclAny)))))" -by(rule cpI1, simp add: OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person) -lemma cp_OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny_OclAny : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>OclAny)))::\<cdot>OclAny) .oclIsTypeOf(Galaxy)))))" -by(rule cpI1, simp add: OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny) -lemma cp_OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy_OclAny : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Galaxy)))::\<cdot>OclAny) .oclIsTypeOf(Galaxy)))))" -by(rule cpI1, simp add: OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny) -lemma cp_OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet_OclAny : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Planet)))::\<cdot>OclAny) .oclIsTypeOf(Galaxy)))))" -by(rule cpI1, simp add: OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny) -lemma cp_OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person_OclAny : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Person)))::\<cdot>OclAny) .oclIsTypeOf(Galaxy)))))" -by(rule cpI1, simp add: OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny) -lemma cp_OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny_Galaxy : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>OclAny)))::\<cdot>Galaxy) .oclIsTypeOf(Galaxy)))))" -by(rule cpI1, simp) -lemma cp_OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy_Galaxy : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Galaxy)))::\<cdot>Galaxy) .oclIsTypeOf(Galaxy)))))" -by(rule cpI1, simp) -lemma cp_OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet_Galaxy : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Planet)))::\<cdot>Galaxy) .oclIsTypeOf(Galaxy)))))" -by(rule cpI1, simp) -lemma cp_OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person_Galaxy : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Person)))::\<cdot>Galaxy) .oclIsTypeOf(Galaxy)))))" -by(rule cpI1, simp) -lemma cp_OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny_Planet : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>OclAny)))::\<cdot>Planet) .oclIsTypeOf(Galaxy)))))" -by(rule cpI1, simp add: OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet) -lemma cp_OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy_Planet : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Galaxy)))::\<cdot>Planet) .oclIsTypeOf(Galaxy)))))" -by(rule cpI1, simp add: OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet) -lemma cp_OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet_Planet : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Planet)))::\<cdot>Planet) .oclIsTypeOf(Galaxy)))))" -by(rule cpI1, simp add: OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet) -lemma cp_OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person_Planet : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Person)))::\<cdot>Planet) .oclIsTypeOf(Galaxy)))))" -by(rule cpI1, simp add: OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet) -lemma cp_OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny_Person : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>OclAny)))::\<cdot>Person) .oclIsTypeOf(Galaxy)))))" -by(rule cpI1, simp add: OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person) -lemma cp_OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy_Person : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Galaxy)))::\<cdot>Person) .oclIsTypeOf(Galaxy)))))" -by(rule cpI1, simp add: OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person) -lemma cp_OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet_Person : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Planet)))::\<cdot>Person) .oclIsTypeOf(Galaxy)))))" -by(rule cpI1, simp add: OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person) -lemma cp_OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person_Person : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Person)))::\<cdot>Person) .oclIsTypeOf(Galaxy)))))" -by(rule cpI1, simp add: OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person) -lemma cp_OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny_OclAny : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>OclAny)))::\<cdot>OclAny) .oclIsTypeOf(Planet)))))" -by(rule cpI1, simp add: OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny) -lemma cp_OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy_OclAny : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Galaxy)))::\<cdot>OclAny) .oclIsTypeOf(Planet)))))" -by(rule cpI1, simp add: OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny) -lemma cp_OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet_OclAny : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Planet)))::\<cdot>OclAny) .oclIsTypeOf(Planet)))))" -by(rule cpI1, simp add: OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny) -lemma cp_OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person_OclAny : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Person)))::\<cdot>OclAny) .oclIsTypeOf(Planet)))))" -by(rule cpI1, simp add: OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny) -lemma cp_OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny_Galaxy : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>OclAny)))::\<cdot>Galaxy) .oclIsTypeOf(Planet)))))" -by(rule cpI1, simp add: OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy) -lemma cp_OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy_Galaxy : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Galaxy)))::\<cdot>Galaxy) .oclIsTypeOf(Planet)))))" -by(rule cpI1, simp add: OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy) -lemma cp_OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet_Galaxy : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Planet)))::\<cdot>Galaxy) .oclIsTypeOf(Planet)))))" -by(rule cpI1, simp add: OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy) -lemma cp_OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person_Galaxy : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Person)))::\<cdot>Galaxy) .oclIsTypeOf(Planet)))))" -by(rule cpI1, simp add: OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy) -lemma cp_OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny_Planet : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>OclAny)))::\<cdot>Planet) .oclIsTypeOf(Planet)))))" -by(rule cpI1, simp) -lemma cp_OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy_Planet : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Galaxy)))::\<cdot>Planet) .oclIsTypeOf(Planet)))))" -by(rule cpI1, simp) -lemma cp_OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet_Planet : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Planet)))::\<cdot>Planet) .oclIsTypeOf(Planet)))))" -by(rule cpI1, simp) -lemma cp_OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person_Planet : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Person)))::\<cdot>Planet) .oclIsTypeOf(Planet)))))" -by(rule cpI1, simp) -lemma cp_OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny_Person : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>OclAny)))::\<cdot>Person) .oclIsTypeOf(Planet)))))" -by(rule cpI1, simp add: OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person) -lemma cp_OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy_Person : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Galaxy)))::\<cdot>Person) .oclIsTypeOf(Planet)))))" -by(rule cpI1, simp add: OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person) -lemma cp_OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet_Person : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Planet)))::\<cdot>Person) .oclIsTypeOf(Planet)))))" -by(rule cpI1, simp add: OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person) -lemma cp_OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person_Person : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Person)))::\<cdot>Person) .oclIsTypeOf(Planet)))))" -by(rule cpI1, simp add: OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person) -lemma cp_OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_OclAny : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>OclAny)))::\<cdot>OclAny) .oclIsTypeOf(Person)))))" -by(rule cpI1, simp add: OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny) -lemma cp_OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy_OclAny : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Galaxy)))::\<cdot>OclAny) .oclIsTypeOf(Person)))))" -by(rule cpI1, simp add: OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny) -lemma cp_OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet_OclAny : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Planet)))::\<cdot>OclAny) .oclIsTypeOf(Person)))))" -by(rule cpI1, simp add: OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny) -lemma cp_OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_OclAny : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Person)))::\<cdot>OclAny) .oclIsTypeOf(Person)))))" -by(rule cpI1, simp add: OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny) -lemma cp_OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_Galaxy : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>OclAny)))::\<cdot>Galaxy) .oclIsTypeOf(Person)))))" -by(rule cpI1, simp add: OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy) -lemma cp_OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy_Galaxy : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Galaxy)))::\<cdot>Galaxy) .oclIsTypeOf(Person)))))" -by(rule cpI1, simp add: OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy) -lemma cp_OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet_Galaxy : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Planet)))::\<cdot>Galaxy) .oclIsTypeOf(Person)))))" -by(rule cpI1, simp add: OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy) -lemma cp_OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_Galaxy : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Person)))::\<cdot>Galaxy) .oclIsTypeOf(Person)))))" -by(rule cpI1, simp add: OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy) -lemma cp_OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_Planet : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>OclAny)))::\<cdot>Planet) .oclIsTypeOf(Person)))))" -by(rule cpI1, simp add: OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet) -lemma cp_OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy_Planet : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Galaxy)))::\<cdot>Planet) .oclIsTypeOf(Person)))))" -by(rule cpI1, simp add: OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet) -lemma cp_OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet_Planet : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Planet)))::\<cdot>Planet) .oclIsTypeOf(Person)))))" -by(rule cpI1, simp add: OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet) -lemma cp_OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_Planet : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Person)))::\<cdot>Planet) .oclIsTypeOf(Person)))))" -by(rule cpI1, simp add: OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet) -lemma cp_OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_Person : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>OclAny)))::\<cdot>Person) .oclIsTypeOf(Person)))))" -by(rule cpI1, simp) -lemma cp_OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy_Person : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Galaxy)))::\<cdot>Person) .oclIsTypeOf(Person)))))" -by(rule cpI1, simp) -lemma cp_OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet_Person : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Planet)))::\<cdot>Person) .oclIsTypeOf(Person)))))" -by(rule cpI1, simp) -lemma cp_OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_Person : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Person)))::\<cdot>Person) .oclIsTypeOf(Person)))))" -by(rule cpI1, simp) - -(* 64 ************************************ 347 + 1 *) (* term Floor1_istypeof.print_istypeof_lemmas_cp *) -lemmas[simp,code_unfold] = cp_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_OclAny - cp_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy_OclAny - cp_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet_OclAny - cp_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_OclAny - cp_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_Galaxy - cp_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy_Galaxy - cp_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet_Galaxy - cp_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_Galaxy - cp_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_Planet - cp_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy_Planet - cp_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet_Planet - cp_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_Planet - cp_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_Person - cp_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy_Person - cp_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet_Person - cp_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_Person - cp_OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny_OclAny - cp_OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy_OclAny - cp_OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet_OclAny - cp_OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person_OclAny - cp_OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny_Galaxy - cp_OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy_Galaxy - cp_OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet_Galaxy - cp_OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person_Galaxy - cp_OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny_Planet - cp_OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy_Planet - cp_OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet_Planet - cp_OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person_Planet - cp_OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny_Person - cp_OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy_Person - cp_OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet_Person - cp_OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person_Person - cp_OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny_OclAny - cp_OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy_OclAny - cp_OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet_OclAny - cp_OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person_OclAny - cp_OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny_Galaxy - cp_OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy_Galaxy - cp_OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet_Galaxy - cp_OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person_Galaxy - cp_OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny_Planet - cp_OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy_Planet - cp_OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet_Planet - cp_OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person_Planet - cp_OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny_Person - cp_OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy_Person - cp_OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet_Person - cp_OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person_Person - cp_OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_OclAny - cp_OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy_OclAny - cp_OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet_OclAny - cp_OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_OclAny - cp_OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_Galaxy - cp_OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy_Galaxy - cp_OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet_Galaxy - cp_OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_Galaxy - cp_OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_Planet - cp_OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy_Planet - cp_OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet_Planet - cp_OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_Planet - cp_OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_Person - cp_OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy_Person - cp_OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet_Person - cp_OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_Person - -(* 65 ************************************ 348 + 1 *) -subsection \<open>Execution with Invalid or Null as Argument\<close> - -(* 66 ************************************ 349 + 32 *) (* term Floor1_istypeof.print_istypeof_lemma_strict *) -lemma OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_invalid : "((invalid::\<cdot>OclAny) .oclIsTypeOf(OclAny)) = invalid" -by(rule ext, simp add: bot_option_def invalid_def) -lemma OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy_invalid : "((invalid::\<cdot>Galaxy) .oclIsTypeOf(OclAny)) = invalid" -by(rule ext, simp add: OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy bot_option_def invalid_def) -lemma OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet_invalid : "((invalid::\<cdot>Planet) .oclIsTypeOf(OclAny)) = invalid" -by(rule ext, simp add: OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet bot_option_def invalid_def) -lemma OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_invalid : "((invalid::\<cdot>Person) .oclIsTypeOf(OclAny)) = invalid" -by(rule ext, simp add: OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person bot_option_def invalid_def) -lemma OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_null : "((null::\<cdot>OclAny) .oclIsTypeOf(OclAny)) = true" -by(rule ext, simp add: bot_option_def null_fun_def null_option_def) -lemma OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy_null : "((null::\<cdot>Galaxy) .oclIsTypeOf(OclAny)) = true" -by(rule ext, simp add: OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy bot_option_def null_fun_def null_option_def) -lemma OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet_null : "((null::\<cdot>Planet) .oclIsTypeOf(OclAny)) = true" -by(rule ext, simp add: OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet bot_option_def null_fun_def null_option_def) -lemma OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_null : "((null::\<cdot>Person) .oclIsTypeOf(OclAny)) = true" -by(rule ext, simp add: OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person bot_option_def null_fun_def null_option_def) -lemma OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny_invalid : "((invalid::\<cdot>OclAny) .oclIsTypeOf(Galaxy)) = invalid" -by(rule ext, simp add: OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny bot_option_def invalid_def) -lemma OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy_invalid : "((invalid::\<cdot>Galaxy) .oclIsTypeOf(Galaxy)) = invalid" -by(rule ext, simp add: bot_option_def invalid_def) -lemma OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet_invalid : "((invalid::\<cdot>Planet) .oclIsTypeOf(Galaxy)) = invalid" -by(rule ext, simp add: OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet bot_option_def invalid_def) -lemma OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person_invalid : "((invalid::\<cdot>Person) .oclIsTypeOf(Galaxy)) = invalid" -by(rule ext, simp add: OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person bot_option_def invalid_def) -lemma OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny_null : "((null::\<cdot>OclAny) .oclIsTypeOf(Galaxy)) = true" -by(rule ext, simp add: OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny bot_option_def null_fun_def null_option_def) -lemma OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy_null : "((null::\<cdot>Galaxy) .oclIsTypeOf(Galaxy)) = true" -by(rule ext, simp add: bot_option_def null_fun_def null_option_def) -lemma OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet_null : "((null::\<cdot>Planet) .oclIsTypeOf(Galaxy)) = true" -by(rule ext, simp add: OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet bot_option_def null_fun_def null_option_def) -lemma OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person_null : "((null::\<cdot>Person) .oclIsTypeOf(Galaxy)) = true" -by(rule ext, simp add: OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person bot_option_def null_fun_def null_option_def) -lemma OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny_invalid : "((invalid::\<cdot>OclAny) .oclIsTypeOf(Planet)) = invalid" -by(rule ext, simp add: OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny bot_option_def invalid_def) -lemma OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy_invalid : "((invalid::\<cdot>Galaxy) .oclIsTypeOf(Planet)) = invalid" -by(rule ext, simp add: OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy bot_option_def invalid_def) -lemma OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet_invalid : "((invalid::\<cdot>Planet) .oclIsTypeOf(Planet)) = invalid" -by(rule ext, simp add: bot_option_def invalid_def) -lemma OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person_invalid : "((invalid::\<cdot>Person) .oclIsTypeOf(Planet)) = invalid" -by(rule ext, simp add: OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person bot_option_def invalid_def) -lemma OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny_null : "((null::\<cdot>OclAny) .oclIsTypeOf(Planet)) = true" -by(rule ext, simp add: OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny bot_option_def null_fun_def null_option_def) -lemma OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy_null : "((null::\<cdot>Galaxy) .oclIsTypeOf(Planet)) = true" -by(rule ext, simp add: OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy bot_option_def null_fun_def null_option_def) -lemma OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet_null : "((null::\<cdot>Planet) .oclIsTypeOf(Planet)) = true" -by(rule ext, simp add: bot_option_def null_fun_def null_option_def) -lemma OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person_null : "((null::\<cdot>Person) .oclIsTypeOf(Planet)) = true" -by(rule ext, simp add: OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person bot_option_def null_fun_def null_option_def) -lemma OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_invalid : "((invalid::\<cdot>OclAny) .oclIsTypeOf(Person)) = invalid" -by(rule ext, simp add: OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny bot_option_def invalid_def) -lemma OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy_invalid : "((invalid::\<cdot>Galaxy) .oclIsTypeOf(Person)) = invalid" -by(rule ext, simp add: OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy bot_option_def invalid_def) -lemma OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet_invalid : "((invalid::\<cdot>Planet) .oclIsTypeOf(Person)) = invalid" -by(rule ext, simp add: OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet bot_option_def invalid_def) -lemma OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_invalid : "((invalid::\<cdot>Person) .oclIsTypeOf(Person)) = invalid" -by(rule ext, simp add: bot_option_def invalid_def) -lemma OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_null : "((null::\<cdot>OclAny) .oclIsTypeOf(Person)) = true" -by(rule ext, simp add: OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny bot_option_def null_fun_def null_option_def) -lemma OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy_null : "((null::\<cdot>Galaxy) .oclIsTypeOf(Person)) = true" -by(rule ext, simp add: OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy bot_option_def null_fun_def null_option_def) -lemma OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet_null : "((null::\<cdot>Planet) .oclIsTypeOf(Person)) = true" -by(rule ext, simp add: OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet bot_option_def null_fun_def null_option_def) -lemma OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_null : "((null::\<cdot>Person) .oclIsTypeOf(Person)) = true" -by(rule ext, simp add: bot_option_def null_fun_def null_option_def) - -(* 67 ************************************ 381 + 1 *) (* term Floor1_istypeof.print_istypeof_lemmas_strict *) -lemmas[simp,code_unfold] = OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_invalid - OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy_invalid - OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet_invalid - OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_invalid - OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_null - OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy_null - OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet_null - OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_null - OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny_invalid - OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy_invalid - OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet_invalid - OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person_invalid - OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny_null - OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy_null - OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet_null - OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person_null - OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny_invalid - OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy_invalid - OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet_invalid - OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person_invalid - OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny_null - OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy_null - OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet_null - OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person_null - OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_invalid - OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy_invalid - OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet_invalid - OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_invalid - OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_null - OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy_null - OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet_null - OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_null - -(* 68 ************************************ 382 + 1 *) -subsection \<open>Validity and Definedness Properties\<close> - -(* 69 ************************************ 383 + 16 *) (* term Floor1_istypeof.print_istypeof_defined *) -lemma OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_defined : -assumes isdef: "\<tau> \<Turnstile> (\<upsilon> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Person) .oclIsTypeOf(Person)))" - apply(insert isdef[simplified foundation18'], simp only: OclValid_def, subst cp_defined) -by(auto simp: cp_defined[symmetric ] bot_option_def OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person split: option.split ty\<E>\<X>\<T>\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n.split ty\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n.split) -lemma OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet_defined : -assumes isdef: "\<tau> \<Turnstile> (\<upsilon> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Planet) .oclIsTypeOf(Person)))" - apply(insert isdef[simplified foundation18'], simp only: OclValid_def, subst cp_defined) -by(auto simp: cp_defined[symmetric ] bot_option_def OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet split: option.split ty\<E>\<X>\<T>\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t.split ty\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t.split) -lemma OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy_defined : -assumes isdef: "\<tau> \<Turnstile> (\<upsilon> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Galaxy) .oclIsTypeOf(Person)))" - apply(insert isdef[simplified foundation18'], simp only: OclValid_def, subst cp_defined) -by(auto simp: cp_defined[symmetric ] bot_option_def OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy split: option.split ty\<E>\<X>\<T>\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y.split ty\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y.split) -lemma OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_defined : -assumes isdef: "\<tau> \<Turnstile> (\<upsilon> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>OclAny) .oclIsTypeOf(Person)))" - apply(insert isdef[simplified foundation18'], simp only: OclValid_def, subst cp_defined) -by(auto simp: cp_defined[symmetric ] bot_option_def OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny split: option.split ty\<E>\<X>\<T>\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y.split ty\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y.split) -lemma OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet_defined : -assumes isdef: "\<tau> \<Turnstile> (\<upsilon> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Planet) .oclIsTypeOf(Planet)))" - apply(insert isdef[simplified foundation18'], simp only: OclValid_def, subst cp_defined) -by(auto simp: cp_defined[symmetric ] bot_option_def OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet split: option.split ty\<E>\<X>\<T>\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t.split ty\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t.split) -lemma OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy_defined : -assumes isdef: "\<tau> \<Turnstile> (\<upsilon> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Galaxy) .oclIsTypeOf(Planet)))" - apply(insert isdef[simplified foundation18'], simp only: OclValid_def, subst cp_defined) -by(auto simp: cp_defined[symmetric ] bot_option_def OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy split: option.split ty\<E>\<X>\<T>\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y.split ty\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y.split) -lemma OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny_defined : -assumes isdef: "\<tau> \<Turnstile> (\<upsilon> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>OclAny) .oclIsTypeOf(Planet)))" - apply(insert isdef[simplified foundation18'], simp only: OclValid_def, subst cp_defined) -by(auto simp: cp_defined[symmetric ] bot_option_def OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny split: option.split ty\<E>\<X>\<T>\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y.split ty\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y.split) -lemma OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person_defined : -assumes isdef: "\<tau> \<Turnstile> (\<upsilon> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Person) .oclIsTypeOf(Planet)))" - apply(insert isdef[simplified foundation18'], simp only: OclValid_def, subst cp_defined) -by(auto simp: cp_defined[symmetric ] bot_option_def OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person split: option.split ty\<E>\<X>\<T>\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n.split ty\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n.split) -lemma OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy_defined : -assumes isdef: "\<tau> \<Turnstile> (\<upsilon> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Galaxy) .oclIsTypeOf(Galaxy)))" - apply(insert isdef[simplified foundation18'], simp only: OclValid_def, subst cp_defined) -by(auto simp: cp_defined[symmetric ] bot_option_def OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy split: option.split ty\<E>\<X>\<T>\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y.split ty\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y.split) -lemma OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny_defined : -assumes isdef: "\<tau> \<Turnstile> (\<upsilon> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>OclAny) .oclIsTypeOf(Galaxy)))" - apply(insert isdef[simplified foundation18'], simp only: OclValid_def, subst cp_defined) -by(auto simp: cp_defined[symmetric ] bot_option_def OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny split: option.split ty\<E>\<X>\<T>\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y.split ty\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y.split) -lemma OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person_defined : -assumes isdef: "\<tau> \<Turnstile> (\<upsilon> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Person) .oclIsTypeOf(Galaxy)))" - apply(insert isdef[simplified foundation18'], simp only: OclValid_def, subst cp_defined) -by(auto simp: cp_defined[symmetric ] bot_option_def OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person split: option.split ty\<E>\<X>\<T>\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n.split ty\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n.split) -lemma OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet_defined : -assumes isdef: "\<tau> \<Turnstile> (\<upsilon> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Planet) .oclIsTypeOf(Galaxy)))" - apply(insert isdef[simplified foundation18'], simp only: OclValid_def, subst cp_defined) -by(auto simp: cp_defined[symmetric ] bot_option_def OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet split: option.split ty\<E>\<X>\<T>\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t.split ty\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t.split) -lemma OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_defined : -assumes isdef: "\<tau> \<Turnstile> (\<upsilon> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>OclAny) .oclIsTypeOf(OclAny)))" - apply(insert isdef[simplified foundation18'], simp only: OclValid_def, subst cp_defined) -by(auto simp: cp_defined[symmetric ] bot_option_def OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny split: option.split ty\<E>\<X>\<T>\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y.split ty\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y.split) -lemma OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_defined : -assumes isdef: "\<tau> \<Turnstile> (\<upsilon> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Person) .oclIsTypeOf(OclAny)))" - apply(insert isdef[simplified foundation18'], simp only: OclValid_def, subst cp_defined) -by(auto simp: cp_defined[symmetric ] bot_option_def OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person split: option.split ty\<E>\<X>\<T>\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n.split ty\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n.split) -lemma OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet_defined : -assumes isdef: "\<tau> \<Turnstile> (\<upsilon> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Planet) .oclIsTypeOf(OclAny)))" - apply(insert isdef[simplified foundation18'], simp only: OclValid_def, subst cp_defined) -by(auto simp: cp_defined[symmetric ] bot_option_def OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet split: option.split ty\<E>\<X>\<T>\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t.split ty\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t.split) -lemma OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy_defined : -assumes isdef: "\<tau> \<Turnstile> (\<upsilon> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Galaxy) .oclIsTypeOf(OclAny)))" - apply(insert isdef[simplified foundation18'], simp only: OclValid_def, subst cp_defined) -by(auto simp: cp_defined[symmetric ] bot_option_def OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy split: option.split ty\<E>\<X>\<T>\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y.split ty\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y.split) - -(* 70 ************************************ 399 + 16 *) (* term Floor1_istypeof.print_istypeof_defined' *) -lemma OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_defined' : -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Person) .oclIsTypeOf(Person)))" -by(rule OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_defined[OF isdef[THEN foundation20]]) -lemma OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet_defined' : -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Planet) .oclIsTypeOf(Person)))" -by(rule OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet_defined[OF isdef[THEN foundation20]]) -lemma OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy_defined' : -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Galaxy) .oclIsTypeOf(Person)))" -by(rule OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy_defined[OF isdef[THEN foundation20]]) -lemma OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_defined' : -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>OclAny) .oclIsTypeOf(Person)))" -by(rule OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_defined[OF isdef[THEN foundation20]]) -lemma OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet_defined' : -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Planet) .oclIsTypeOf(Planet)))" -by(rule OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet_defined[OF isdef[THEN foundation20]]) -lemma OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy_defined' : -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Galaxy) .oclIsTypeOf(Planet)))" -by(rule OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy_defined[OF isdef[THEN foundation20]]) -lemma OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny_defined' : -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>OclAny) .oclIsTypeOf(Planet)))" -by(rule OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny_defined[OF isdef[THEN foundation20]]) -lemma OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person_defined' : -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Person) .oclIsTypeOf(Planet)))" -by(rule OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person_defined[OF isdef[THEN foundation20]]) -lemma OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy_defined' : -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Galaxy) .oclIsTypeOf(Galaxy)))" -by(rule OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy_defined[OF isdef[THEN foundation20]]) -lemma OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny_defined' : -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>OclAny) .oclIsTypeOf(Galaxy)))" -by(rule OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny_defined[OF isdef[THEN foundation20]]) -lemma OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person_defined' : -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Person) .oclIsTypeOf(Galaxy)))" -by(rule OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person_defined[OF isdef[THEN foundation20]]) -lemma OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet_defined' : -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Planet) .oclIsTypeOf(Galaxy)))" -by(rule OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet_defined[OF isdef[THEN foundation20]]) -lemma OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_defined' : -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>OclAny) .oclIsTypeOf(OclAny)))" -by(rule OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_defined[OF isdef[THEN foundation20]]) -lemma OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_defined' : -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Person) .oclIsTypeOf(OclAny)))" -by(rule OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_defined[OF isdef[THEN foundation20]]) -lemma OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet_defined' : -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Planet) .oclIsTypeOf(OclAny)))" -by(rule OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet_defined[OF isdef[THEN foundation20]]) -lemma OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy_defined' : -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Galaxy) .oclIsTypeOf(OclAny)))" -by(rule OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy_defined[OF isdef[THEN foundation20]]) - -(* 71 ************************************ 415 + 1 *) -subsection \<open>Up Down Casting\<close> - -(* 72 ************************************ 416 + 6 *) (* term Floor1_istypeof.print_istypeof_up_larger *) -lemma actualType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_larger_staticType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t : -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> ((X::\<cdot>Person) .oclIsTypeOf(Planet)) \<triangleq> false" - using isdef -by(auto simp: OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person foundation22 foundation16 null_option_def bot_option_def) -lemma actualType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_larger_staticType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y : -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> ((X::\<cdot>Person) .oclIsTypeOf(Galaxy)) \<triangleq> false" - using isdef -by(auto simp: OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person foundation22 foundation16 null_option_def bot_option_def) -lemma actualType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_larger_staticType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y : -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> ((X::\<cdot>Person) .oclIsTypeOf(OclAny)) \<triangleq> false" - using isdef -by(auto simp: OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person foundation22 foundation16 null_option_def bot_option_def) -lemma actualType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_larger_staticType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y : -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> ((X::\<cdot>Planet) .oclIsTypeOf(Galaxy)) \<triangleq> false" - using isdef -by(auto simp: OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet foundation22 foundation16 null_option_def bot_option_def) -lemma actualType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_larger_staticType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y : -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> ((X::\<cdot>Planet) .oclIsTypeOf(OclAny)) \<triangleq> false" - using isdef -by(auto simp: OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet foundation22 foundation16 null_option_def bot_option_def) -lemma actualType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_larger_staticType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y : -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> ((X::\<cdot>Galaxy) .oclIsTypeOf(OclAny)) \<triangleq> false" - using isdef -by(auto simp: OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy foundation22 foundation16 null_option_def bot_option_def) - -(* 73 ************************************ 422 + 10 *) (* term Floor1_istypeof.print_istypeof_up_d_cast *) -lemma down_cast_type\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_from_Planet_to_Person : -assumes istyp: "\<tau> \<Turnstile> ((X::\<cdot>Planet) .oclIsTypeOf(Planet))" -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> (X .oclAsType(Person)) \<triangleq> invalid" - using istyp isdef - apply(auto simp: OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet foundation22 foundation16 null_option_def bot_option_def split: ty\<E>\<X>\<T>\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t.split ty\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t.split) -by(simp add: OclValid_def false_def true_def) -lemma down_cast_type\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_from_Galaxy_to_Person : -assumes istyp: "\<tau> \<Turnstile> ((X::\<cdot>Galaxy) .oclIsTypeOf(Galaxy))" -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> (X .oclAsType(Person)) \<triangleq> invalid" - using istyp isdef - apply(auto simp: OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy foundation22 foundation16 null_option_def bot_option_def split: ty\<E>\<X>\<T>\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y.split ty\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y.split) -by(simp add: OclValid_def false_def true_def) -lemma down_cast_type\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_from_OclAny_to_Person : -assumes istyp: "\<tau> \<Turnstile> ((X::\<cdot>OclAny) .oclIsTypeOf(OclAny))" -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> (X .oclAsType(Person)) \<triangleq> invalid" - using istyp isdef - apply(auto simp: OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny foundation22 foundation16 null_option_def bot_option_def split: ty\<E>\<X>\<T>\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y.split ty\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y.split) -by(simp add: OclValid_def false_def true_def) -lemma down_cast_type\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_from_Galaxy_to_Person : -assumes istyp: "\<tau> \<Turnstile> ((X::\<cdot>Galaxy) .oclIsTypeOf(Planet))" -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> (X .oclAsType(Person)) \<triangleq> invalid" - using istyp isdef - apply(auto simp: OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy foundation22 foundation16 null_option_def bot_option_def split: ty\<E>\<X>\<T>\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y.split ty\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y.split) -by(simp add: OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy OclValid_def false_def true_def) -lemma down_cast_type\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_from_OclAny_to_Person : -assumes istyp: "\<tau> \<Turnstile> ((X::\<cdot>OclAny) .oclIsTypeOf(Planet))" -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> (X .oclAsType(Person)) \<triangleq> invalid" - using istyp isdef - apply(auto simp: OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny foundation22 foundation16 null_option_def bot_option_def split: ty\<E>\<X>\<T>\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y.split ty\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y.split) -by(simp add: OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny OclValid_def false_def true_def) -lemma down_cast_type\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_from_OclAny_to_Person : -assumes istyp: "\<tau> \<Turnstile> ((X::\<cdot>OclAny) .oclIsTypeOf(Galaxy))" -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> (X .oclAsType(Person)) \<triangleq> invalid" - using istyp isdef - apply(auto simp: OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny foundation22 foundation16 null_option_def bot_option_def split: ty\<E>\<X>\<T>\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y.split ty\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y.split) -by(simp add: OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny OclValid_def false_def true_def) -lemma down_cast_type\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_from_Galaxy_to_Planet : -assumes istyp: "\<tau> \<Turnstile> ((X::\<cdot>Galaxy) .oclIsTypeOf(Galaxy))" -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> (X .oclAsType(Planet)) \<triangleq> invalid" - using istyp isdef - apply(auto simp: OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy foundation22 foundation16 null_option_def bot_option_def split: ty\<E>\<X>\<T>\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y.split ty\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y.split) -by(simp add: OclValid_def false_def true_def) -lemma down_cast_type\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_from_OclAny_to_Planet : -assumes istyp: "\<tau> \<Turnstile> ((X::\<cdot>OclAny) .oclIsTypeOf(OclAny))" -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> (X .oclAsType(Planet)) \<triangleq> invalid" - using istyp isdef - apply(auto simp: OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny foundation22 foundation16 null_option_def bot_option_def split: ty\<E>\<X>\<T>\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y.split ty\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y.split) -by(simp add: OclValid_def false_def true_def) -lemma down_cast_type\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_from_OclAny_to_Planet : -assumes istyp: "\<tau> \<Turnstile> ((X::\<cdot>OclAny) .oclIsTypeOf(Galaxy))" -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> (X .oclAsType(Planet)) \<triangleq> invalid" - using istyp isdef - apply(auto simp: OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny foundation22 foundation16 null_option_def bot_option_def split: ty\<E>\<X>\<T>\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y.split ty\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y.split) -by(simp add: OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny OclValid_def false_def true_def) -lemma down_cast_type\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_from_OclAny_to_Galaxy : -assumes istyp: "\<tau> \<Turnstile> ((X::\<cdot>OclAny) .oclIsTypeOf(OclAny))" -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> (X .oclAsType(Galaxy)) \<triangleq> invalid" - using istyp isdef - apply(auto simp: OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny foundation22 foundation16 null_option_def bot_option_def split: ty\<E>\<X>\<T>\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y.split ty\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y.split) -by(simp add: OclValid_def false_def true_def) - -(* 74 ************************************ 432 + 1 *) -subsection \<open>Const\<close> - -(* 75 ************************************ 433 + 1 *) -section \<open>Class Model: OclIsKindOf\<close> - -(* 76 ************************************ 434 + 1 *) -subsection \<open>Definition\<close> - -(* 77 ************************************ 435 + 4 *) (* term Floor1_iskindof.print_iskindof_consts *) -consts OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n :: "'\<alpha> \<Rightarrow> Boolean" ("(_) .oclIsKindOf'(Person')") -consts OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t :: "'\<alpha> \<Rightarrow> Boolean" ("(_) .oclIsKindOf'(Planet')") -consts OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y :: "'\<alpha> \<Rightarrow> Boolean" ("(_) .oclIsKindOf'(Galaxy')") -consts OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y :: "'\<alpha> \<Rightarrow> Boolean" ("(_) .oclIsKindOf'(OclAny')") - -(* 78 ************************************ 439 + 16 *) (* term Floor1_iskindof.print_iskindof_class *) -overloading OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n \<equiv> "(OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n::(\<cdot>Person) \<Rightarrow> _)" -begin - definition OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person : "(x::\<cdot>Person) .oclIsKindOf(Person) \<equiv> (x .oclIsTypeOf(Person))" -end -overloading OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n \<equiv> "(OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n::(\<cdot>Planet) \<Rightarrow> _)" -begin - definition OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet : "(x::\<cdot>Planet) .oclIsKindOf(Person) \<equiv> (x .oclIsTypeOf(Person))" -end -overloading OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n \<equiv> "(OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n::(\<cdot>Galaxy) \<Rightarrow> _)" -begin - definition OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy : "(x::\<cdot>Galaxy) .oclIsKindOf(Person) \<equiv> (x .oclIsTypeOf(Person))" -end -overloading OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n \<equiv> "(OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n::(\<cdot>OclAny) \<Rightarrow> _)" -begin - definition OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny : "(x::\<cdot>OclAny) .oclIsKindOf(Person) \<equiv> (x .oclIsTypeOf(Person))" -end -overloading OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t \<equiv> "(OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t::(\<cdot>Planet) \<Rightarrow> _)" -begin - definition OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet : "(x::\<cdot>Planet) .oclIsKindOf(Planet) \<equiv> (x .oclIsTypeOf(Planet)) or (x .oclIsKindOf(Person))" -end -overloading OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t \<equiv> "(OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t::(\<cdot>Galaxy) \<Rightarrow> _)" -begin - definition OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy : "(x::\<cdot>Galaxy) .oclIsKindOf(Planet) \<equiv> (x .oclIsTypeOf(Planet)) or (x .oclIsKindOf(Person))" -end -overloading OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t \<equiv> "(OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t::(\<cdot>OclAny) \<Rightarrow> _)" -begin - definition OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny : "(x::\<cdot>OclAny) .oclIsKindOf(Planet) \<equiv> (x .oclIsTypeOf(Planet)) or (x .oclIsKindOf(Person))" -end -overloading OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t \<equiv> "(OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t::(\<cdot>Person) \<Rightarrow> _)" -begin - definition OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person : "(x::\<cdot>Person) .oclIsKindOf(Planet) \<equiv> (x .oclIsTypeOf(Planet)) or (x .oclIsKindOf(Person))" -end -overloading OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y \<equiv> "(OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y::(\<cdot>Galaxy) \<Rightarrow> _)" -begin - definition OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy : "(x::\<cdot>Galaxy) .oclIsKindOf(Galaxy) \<equiv> (x .oclIsTypeOf(Galaxy)) or (x .oclIsKindOf(Planet))" -end -overloading OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y \<equiv> "(OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y::(\<cdot>OclAny) \<Rightarrow> _)" -begin - definition OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny : "(x::\<cdot>OclAny) .oclIsKindOf(Galaxy) \<equiv> (x .oclIsTypeOf(Galaxy)) or (x .oclIsKindOf(Planet))" -end -overloading OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y \<equiv> "(OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y::(\<cdot>Person) \<Rightarrow> _)" -begin - definition OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person : "(x::\<cdot>Person) .oclIsKindOf(Galaxy) \<equiv> (x .oclIsTypeOf(Galaxy)) or (x .oclIsKindOf(Planet))" -end -overloading OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y \<equiv> "(OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y::(\<cdot>Planet) \<Rightarrow> _)" -begin - definition OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet : "(x::\<cdot>Planet) .oclIsKindOf(Galaxy) \<equiv> (x .oclIsTypeOf(Galaxy)) or (x .oclIsKindOf(Planet))" -end -overloading OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y \<equiv> "(OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y::(\<cdot>OclAny) \<Rightarrow> _)" -begin - definition OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny : "(x::\<cdot>OclAny) .oclIsKindOf(OclAny) \<equiv> (x .oclIsTypeOf(OclAny)) or (x .oclIsKindOf(Galaxy))" -end -overloading OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y \<equiv> "(OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y::(\<cdot>Person) \<Rightarrow> _)" -begin - definition OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person : "(x::\<cdot>Person) .oclIsKindOf(OclAny) \<equiv> (x .oclIsTypeOf(OclAny)) or (x .oclIsKindOf(Galaxy))" -end -overloading OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y \<equiv> "(OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y::(\<cdot>Planet) \<Rightarrow> _)" -begin - definition OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet : "(x::\<cdot>Planet) .oclIsKindOf(OclAny) \<equiv> (x .oclIsTypeOf(OclAny)) or (x .oclIsKindOf(Galaxy))" -end -overloading OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y \<equiv> "(OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y::(\<cdot>Galaxy) \<Rightarrow> _)" -begin - definition OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy : "(x::\<cdot>Galaxy) .oclIsKindOf(OclAny) \<equiv> (x .oclIsTypeOf(OclAny)) or (x .oclIsKindOf(Galaxy))" -end - -(* 79 ************************************ 455 + 4 *) (* term Floor1_iskindof.print_iskindof_from_universe *) -definition "OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_\<AA> = (\<lambda> (in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (Person)) \<Rightarrow> (((((\<lambda>x _. \<lfloor>\<lfloor>x\<rfloor>\<rfloor>)) (Person))::\<cdot>Person) .oclIsKindOf(Person)) - | (in\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (Planet)) \<Rightarrow> (((((\<lambda>x _. \<lfloor>\<lfloor>x\<rfloor>\<rfloor>)) (Planet))::\<cdot>Planet) .oclIsKindOf(Person)) - | (in\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y (Galaxy)) \<Rightarrow> (((((\<lambda>x _. \<lfloor>\<lfloor>x\<rfloor>\<rfloor>)) (Galaxy))::\<cdot>Galaxy) .oclIsKindOf(Person)) - | (in\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y (OclAny)) \<Rightarrow> (((((\<lambda>x _. \<lfloor>\<lfloor>x\<rfloor>\<rfloor>)) (OclAny))::\<cdot>OclAny) .oclIsKindOf(Person)))" -definition "OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_\<AA> = (\<lambda> (in\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (Planet)) \<Rightarrow> (((((\<lambda>x _. \<lfloor>\<lfloor>x\<rfloor>\<rfloor>)) (Planet))::\<cdot>Planet) .oclIsKindOf(Planet)) - | (in\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y (Galaxy)) \<Rightarrow> (((((\<lambda>x _. \<lfloor>\<lfloor>x\<rfloor>\<rfloor>)) (Galaxy))::\<cdot>Galaxy) .oclIsKindOf(Planet)) - | (in\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y (OclAny)) \<Rightarrow> (((((\<lambda>x _. \<lfloor>\<lfloor>x\<rfloor>\<rfloor>)) (OclAny))::\<cdot>OclAny) .oclIsKindOf(Planet)) - | (in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (Person)) \<Rightarrow> (((((\<lambda>x _. \<lfloor>\<lfloor>x\<rfloor>\<rfloor>)) (Person))::\<cdot>Person) .oclIsKindOf(Planet)))" -definition "OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_\<AA> = (\<lambda> (in\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y (Galaxy)) \<Rightarrow> (((((\<lambda>x _. \<lfloor>\<lfloor>x\<rfloor>\<rfloor>)) (Galaxy))::\<cdot>Galaxy) .oclIsKindOf(Galaxy)) - | (in\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y (OclAny)) \<Rightarrow> (((((\<lambda>x _. \<lfloor>\<lfloor>x\<rfloor>\<rfloor>)) (OclAny))::\<cdot>OclAny) .oclIsKindOf(Galaxy)) - | (in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (Person)) \<Rightarrow> (((((\<lambda>x _. \<lfloor>\<lfloor>x\<rfloor>\<rfloor>)) (Person))::\<cdot>Person) .oclIsKindOf(Galaxy)) - | (in\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (Planet)) \<Rightarrow> (((((\<lambda>x _. \<lfloor>\<lfloor>x\<rfloor>\<rfloor>)) (Planet))::\<cdot>Planet) .oclIsKindOf(Galaxy)))" -definition "OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_\<AA> = (\<lambda> (in\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y (OclAny)) \<Rightarrow> (((((\<lambda>x _. \<lfloor>\<lfloor>x\<rfloor>\<rfloor>)) (OclAny))::\<cdot>OclAny) .oclIsKindOf(OclAny)) - | (in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (Person)) \<Rightarrow> (((((\<lambda>x _. \<lfloor>\<lfloor>x\<rfloor>\<rfloor>)) (Person))::\<cdot>Person) .oclIsKindOf(OclAny)) - | (in\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (Planet)) \<Rightarrow> (((((\<lambda>x _. \<lfloor>\<lfloor>x\<rfloor>\<rfloor>)) (Planet))::\<cdot>Planet) .oclIsKindOf(OclAny)) - | (in\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y (Galaxy)) \<Rightarrow> (((((\<lambda>x _. \<lfloor>\<lfloor>x\<rfloor>\<rfloor>)) (Galaxy))::\<cdot>Galaxy) .oclIsKindOf(OclAny)))" - -(* 80 ************************************ 459 + 1 *) (* term Floor1_iskindof.print_iskindof_lemmas_id *) -lemmas[simp,code_unfold] = OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person - OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet - OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy - OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny - -(* 81 ************************************ 460 + 1 *) -subsection \<open>Context Passing\<close> - -(* 82 ************************************ 461 + 64 *) (* term Floor1_iskindof.print_iskindof_lemma_cp *) -lemma cp_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_Person : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Person)))::\<cdot>Person) .oclIsKindOf(Person)))))" -by(simp only: OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person, simp only: cp_OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_Person) -lemma cp_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet_Person : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Planet)))::\<cdot>Person) .oclIsKindOf(Person)))))" -by(simp only: OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person, simp only: cp_OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet_Person) -lemma cp_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy_Person : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Galaxy)))::\<cdot>Person) .oclIsKindOf(Person)))))" -by(simp only: OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person, simp only: cp_OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy_Person) -lemma cp_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_Person : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>OclAny)))::\<cdot>Person) .oclIsKindOf(Person)))))" -by(simp only: OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person, simp only: cp_OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_Person) -lemma cp_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_Planet : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Person)))::\<cdot>Planet) .oclIsKindOf(Person)))))" -by(simp only: OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet, simp only: cp_OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_Planet) -lemma cp_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet_Planet : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Planet)))::\<cdot>Planet) .oclIsKindOf(Person)))))" -by(simp only: OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet, simp only: cp_OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet_Planet) -lemma cp_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy_Planet : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Galaxy)))::\<cdot>Planet) .oclIsKindOf(Person)))))" -by(simp only: OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet, simp only: cp_OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy_Planet) -lemma cp_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_Planet : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>OclAny)))::\<cdot>Planet) .oclIsKindOf(Person)))))" -by(simp only: OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet, simp only: cp_OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_Planet) -lemma cp_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_Galaxy : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Person)))::\<cdot>Galaxy) .oclIsKindOf(Person)))))" -by(simp only: OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy, simp only: cp_OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_Galaxy) -lemma cp_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet_Galaxy : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Planet)))::\<cdot>Galaxy) .oclIsKindOf(Person)))))" -by(simp only: OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy, simp only: cp_OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet_Galaxy) -lemma cp_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy_Galaxy : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Galaxy)))::\<cdot>Galaxy) .oclIsKindOf(Person)))))" -by(simp only: OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy, simp only: cp_OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy_Galaxy) -lemma cp_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_Galaxy : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>OclAny)))::\<cdot>Galaxy) .oclIsKindOf(Person)))))" -by(simp only: OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy, simp only: cp_OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_Galaxy) -lemma cp_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_OclAny : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Person)))::\<cdot>OclAny) .oclIsKindOf(Person)))))" -by(simp only: OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny, simp only: cp_OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_OclAny) -lemma cp_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet_OclAny : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Planet)))::\<cdot>OclAny) .oclIsKindOf(Person)))))" -by(simp only: OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny, simp only: cp_OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet_OclAny) -lemma cp_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy_OclAny : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Galaxy)))::\<cdot>OclAny) .oclIsKindOf(Person)))))" -by(simp only: OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny, simp only: cp_OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy_OclAny) -lemma cp_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_OclAny : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>OclAny)))::\<cdot>OclAny) .oclIsKindOf(Person)))))" -by(simp only: OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny, simp only: cp_OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_OclAny) -lemma cp_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet_Planet : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Planet)))::\<cdot>Planet) .oclIsKindOf(Planet)))))" - apply(simp only: OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet) - apply((rule cpI2[where f = "(or)"], (rule allI)+, rule cp_OclOr)+) - apply(simp only: cp_OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet_Planet) -by(simp only: cp_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet_Planet) -lemma cp_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy_Planet : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Galaxy)))::\<cdot>Planet) .oclIsKindOf(Planet)))))" - apply(simp only: OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet) - apply((rule cpI2[where f = "(or)"], (rule allI)+, rule cp_OclOr)+) - apply(simp only: cp_OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy_Planet) -by(simp only: cp_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy_Planet) -lemma cp_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny_Planet : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>OclAny)))::\<cdot>Planet) .oclIsKindOf(Planet)))))" - apply(simp only: OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet) - apply((rule cpI2[where f = "(or)"], (rule allI)+, rule cp_OclOr)+) - apply(simp only: cp_OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny_Planet) -by(simp only: cp_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_Planet) -lemma cp_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person_Planet : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Person)))::\<cdot>Planet) .oclIsKindOf(Planet)))))" - apply(simp only: OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet) - apply((rule cpI2[where f = "(or)"], (rule allI)+, rule cp_OclOr)+) - apply(simp only: cp_OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person_Planet) -by(simp only: cp_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_Planet) -lemma cp_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet_Galaxy : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Planet)))::\<cdot>Galaxy) .oclIsKindOf(Planet)))))" - apply(simp only: OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy) - apply((rule cpI2[where f = "(or)"], (rule allI)+, rule cp_OclOr)+) - apply(simp only: cp_OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet_Galaxy) -by(simp only: cp_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet_Galaxy) -lemma cp_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy_Galaxy : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Galaxy)))::\<cdot>Galaxy) .oclIsKindOf(Planet)))))" - apply(simp only: OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy) - apply((rule cpI2[where f = "(or)"], (rule allI)+, rule cp_OclOr)+) - apply(simp only: cp_OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy_Galaxy) -by(simp only: cp_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy_Galaxy) -lemma cp_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny_Galaxy : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>OclAny)))::\<cdot>Galaxy) .oclIsKindOf(Planet)))))" - apply(simp only: OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy) - apply((rule cpI2[where f = "(or)"], (rule allI)+, rule cp_OclOr)+) - apply(simp only: cp_OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny_Galaxy) -by(simp only: cp_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_Galaxy) -lemma cp_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person_Galaxy : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Person)))::\<cdot>Galaxy) .oclIsKindOf(Planet)))))" - apply(simp only: OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy) - apply((rule cpI2[where f = "(or)"], (rule allI)+, rule cp_OclOr)+) - apply(simp only: cp_OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person_Galaxy) -by(simp only: cp_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_Galaxy) -lemma cp_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet_OclAny : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Planet)))::\<cdot>OclAny) .oclIsKindOf(Planet)))))" - apply(simp only: OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny) - apply((rule cpI2[where f = "(or)"], (rule allI)+, rule cp_OclOr)+) - apply(simp only: cp_OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet_OclAny) -by(simp only: cp_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet_OclAny) -lemma cp_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy_OclAny : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Galaxy)))::\<cdot>OclAny) .oclIsKindOf(Planet)))))" - apply(simp only: OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny) - apply((rule cpI2[where f = "(or)"], (rule allI)+, rule cp_OclOr)+) - apply(simp only: cp_OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy_OclAny) -by(simp only: cp_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy_OclAny) -lemma cp_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny_OclAny : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>OclAny)))::\<cdot>OclAny) .oclIsKindOf(Planet)))))" - apply(simp only: OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny) - apply((rule cpI2[where f = "(or)"], (rule allI)+, rule cp_OclOr)+) - apply(simp only: cp_OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny_OclAny) -by(simp only: cp_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_OclAny) -lemma cp_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person_OclAny : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Person)))::\<cdot>OclAny) .oclIsKindOf(Planet)))))" - apply(simp only: OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny) - apply((rule cpI2[where f = "(or)"], (rule allI)+, rule cp_OclOr)+) - apply(simp only: cp_OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person_OclAny) -by(simp only: cp_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_OclAny) -lemma cp_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet_Person : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Planet)))::\<cdot>Person) .oclIsKindOf(Planet)))))" - apply(simp only: OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person) - apply((rule cpI2[where f = "(or)"], (rule allI)+, rule cp_OclOr)+) - apply(simp only: cp_OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet_Person) -by(simp only: cp_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet_Person) -lemma cp_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy_Person : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Galaxy)))::\<cdot>Person) .oclIsKindOf(Planet)))))" - apply(simp only: OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person) - apply((rule cpI2[where f = "(or)"], (rule allI)+, rule cp_OclOr)+) - apply(simp only: cp_OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy_Person) -by(simp only: cp_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy_Person) -lemma cp_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny_Person : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>OclAny)))::\<cdot>Person) .oclIsKindOf(Planet)))))" - apply(simp only: OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person) - apply((rule cpI2[where f = "(or)"], (rule allI)+, rule cp_OclOr)+) - apply(simp only: cp_OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny_Person) -by(simp only: cp_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_Person) -lemma cp_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person_Person : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Person)))::\<cdot>Person) .oclIsKindOf(Planet)))))" - apply(simp only: OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person) - apply((rule cpI2[where f = "(or)"], (rule allI)+, rule cp_OclOr)+) - apply(simp only: cp_OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person_Person) -by(simp only: cp_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_Person) -lemma cp_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy_Galaxy : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Galaxy)))::\<cdot>Galaxy) .oclIsKindOf(Galaxy)))))" - apply(simp only: OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy) - apply((rule cpI2[where f = "(or)"], (rule allI)+, rule cp_OclOr)+) - apply(simp only: cp_OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy_Galaxy) -by(simp only: cp_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy_Galaxy) -lemma cp_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny_Galaxy : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>OclAny)))::\<cdot>Galaxy) .oclIsKindOf(Galaxy)))))" - apply(simp only: OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy) - apply((rule cpI2[where f = "(or)"], (rule allI)+, rule cp_OclOr)+) - apply(simp only: cp_OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny_Galaxy) -by(simp only: cp_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny_Galaxy) -lemma cp_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person_Galaxy : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Person)))::\<cdot>Galaxy) .oclIsKindOf(Galaxy)))))" - apply(simp only: OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy) - apply((rule cpI2[where f = "(or)"], (rule allI)+, rule cp_OclOr)+) - apply(simp only: cp_OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person_Galaxy) -by(simp only: cp_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person_Galaxy) -lemma cp_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet_Galaxy : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Planet)))::\<cdot>Galaxy) .oclIsKindOf(Galaxy)))))" - apply(simp only: OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy) - apply((rule cpI2[where f = "(or)"], (rule allI)+, rule cp_OclOr)+) - apply(simp only: cp_OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet_Galaxy) -by(simp only: cp_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet_Galaxy) -lemma cp_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy_OclAny : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Galaxy)))::\<cdot>OclAny) .oclIsKindOf(Galaxy)))))" - apply(simp only: OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny) - apply((rule cpI2[where f = "(or)"], (rule allI)+, rule cp_OclOr)+) - apply(simp only: cp_OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy_OclAny) -by(simp only: cp_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy_OclAny) -lemma cp_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny_OclAny : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>OclAny)))::\<cdot>OclAny) .oclIsKindOf(Galaxy)))))" - apply(simp only: OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny) - apply((rule cpI2[where f = "(or)"], (rule allI)+, rule cp_OclOr)+) - apply(simp only: cp_OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny_OclAny) -by(simp only: cp_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny_OclAny) -lemma cp_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person_OclAny : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Person)))::\<cdot>OclAny) .oclIsKindOf(Galaxy)))))" - apply(simp only: OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny) - apply((rule cpI2[where f = "(or)"], (rule allI)+, rule cp_OclOr)+) - apply(simp only: cp_OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person_OclAny) -by(simp only: cp_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person_OclAny) -lemma cp_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet_OclAny : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Planet)))::\<cdot>OclAny) .oclIsKindOf(Galaxy)))))" - apply(simp only: OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny) - apply((rule cpI2[where f = "(or)"], (rule allI)+, rule cp_OclOr)+) - apply(simp only: cp_OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet_OclAny) -by(simp only: cp_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet_OclAny) -lemma cp_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy_Person : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Galaxy)))::\<cdot>Person) .oclIsKindOf(Galaxy)))))" - apply(simp only: OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person) - apply((rule cpI2[where f = "(or)"], (rule allI)+, rule cp_OclOr)+) - apply(simp only: cp_OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy_Person) -by(simp only: cp_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy_Person) -lemma cp_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny_Person : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>OclAny)))::\<cdot>Person) .oclIsKindOf(Galaxy)))))" - apply(simp only: OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person) - apply((rule cpI2[where f = "(or)"], (rule allI)+, rule cp_OclOr)+) - apply(simp only: cp_OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny_Person) -by(simp only: cp_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny_Person) -lemma cp_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person_Person : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Person)))::\<cdot>Person) .oclIsKindOf(Galaxy)))))" - apply(simp only: OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person) - apply((rule cpI2[where f = "(or)"], (rule allI)+, rule cp_OclOr)+) - apply(simp only: cp_OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person_Person) -by(simp only: cp_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person_Person) -lemma cp_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet_Person : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Planet)))::\<cdot>Person) .oclIsKindOf(Galaxy)))))" - apply(simp only: OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person) - apply((rule cpI2[where f = "(or)"], (rule allI)+, rule cp_OclOr)+) - apply(simp only: cp_OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet_Person) -by(simp only: cp_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet_Person) -lemma cp_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy_Planet : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Galaxy)))::\<cdot>Planet) .oclIsKindOf(Galaxy)))))" - apply(simp only: OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet) - apply((rule cpI2[where f = "(or)"], (rule allI)+, rule cp_OclOr)+) - apply(simp only: cp_OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy_Planet) -by(simp only: cp_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy_Planet) -lemma cp_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny_Planet : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>OclAny)))::\<cdot>Planet) .oclIsKindOf(Galaxy)))))" - apply(simp only: OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet) - apply((rule cpI2[where f = "(or)"], (rule allI)+, rule cp_OclOr)+) - apply(simp only: cp_OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny_Planet) -by(simp only: cp_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny_Planet) -lemma cp_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person_Planet : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Person)))::\<cdot>Planet) .oclIsKindOf(Galaxy)))))" - apply(simp only: OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet) - apply((rule cpI2[where f = "(or)"], (rule allI)+, rule cp_OclOr)+) - apply(simp only: cp_OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person_Planet) -by(simp only: cp_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person_Planet) -lemma cp_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet_Planet : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Planet)))::\<cdot>Planet) .oclIsKindOf(Galaxy)))))" - apply(simp only: OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet) - apply((rule cpI2[where f = "(or)"], (rule allI)+, rule cp_OclOr)+) - apply(simp only: cp_OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet_Planet) -by(simp only: cp_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet_Planet) -lemma cp_OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_OclAny : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>OclAny)))::\<cdot>OclAny) .oclIsKindOf(OclAny)))))" - apply(simp only: OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny) - apply((rule cpI2[where f = "(or)"], (rule allI)+, rule cp_OclOr)+) - apply(simp only: cp_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_OclAny) -by(simp only: cp_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny_OclAny) -lemma cp_OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_OclAny : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Person)))::\<cdot>OclAny) .oclIsKindOf(OclAny)))))" - apply(simp only: OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny) - apply((rule cpI2[where f = "(or)"], (rule allI)+, rule cp_OclOr)+) - apply(simp only: cp_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_OclAny) -by(simp only: cp_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person_OclAny) -lemma cp_OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet_OclAny : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Planet)))::\<cdot>OclAny) .oclIsKindOf(OclAny)))))" - apply(simp only: OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny) - apply((rule cpI2[where f = "(or)"], (rule allI)+, rule cp_OclOr)+) - apply(simp only: cp_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet_OclAny) -by(simp only: cp_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet_OclAny) -lemma cp_OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy_OclAny : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Galaxy)))::\<cdot>OclAny) .oclIsKindOf(OclAny)))))" - apply(simp only: OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny) - apply((rule cpI2[where f = "(or)"], (rule allI)+, rule cp_OclOr)+) - apply(simp only: cp_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy_OclAny) -by(simp only: cp_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy_OclAny) -lemma cp_OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_Person : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>OclAny)))::\<cdot>Person) .oclIsKindOf(OclAny)))))" - apply(simp only: OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person) - apply((rule cpI2[where f = "(or)"], (rule allI)+, rule cp_OclOr)+) - apply(simp only: cp_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_Person) -by(simp only: cp_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny_Person) -lemma cp_OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_Person : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Person)))::\<cdot>Person) .oclIsKindOf(OclAny)))))" - apply(simp only: OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person) - apply((rule cpI2[where f = "(or)"], (rule allI)+, rule cp_OclOr)+) - apply(simp only: cp_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_Person) -by(simp only: cp_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person_Person) -lemma cp_OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet_Person : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Planet)))::\<cdot>Person) .oclIsKindOf(OclAny)))))" - apply(simp only: OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person) - apply((rule cpI2[where f = "(or)"], (rule allI)+, rule cp_OclOr)+) - apply(simp only: cp_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet_Person) -by(simp only: cp_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet_Person) -lemma cp_OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy_Person : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Galaxy)))::\<cdot>Person) .oclIsKindOf(OclAny)))))" - apply(simp only: OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person) - apply((rule cpI2[where f = "(or)"], (rule allI)+, rule cp_OclOr)+) - apply(simp only: cp_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy_Person) -by(simp only: cp_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy_Person) -lemma cp_OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_Planet : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>OclAny)))::\<cdot>Planet) .oclIsKindOf(OclAny)))))" - apply(simp only: OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet) - apply((rule cpI2[where f = "(or)"], (rule allI)+, rule cp_OclOr)+) - apply(simp only: cp_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_Planet) -by(simp only: cp_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny_Planet) -lemma cp_OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_Planet : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Person)))::\<cdot>Planet) .oclIsKindOf(OclAny)))))" - apply(simp only: OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet) - apply((rule cpI2[where f = "(or)"], (rule allI)+, rule cp_OclOr)+) - apply(simp only: cp_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_Planet) -by(simp only: cp_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person_Planet) -lemma cp_OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet_Planet : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Planet)))::\<cdot>Planet) .oclIsKindOf(OclAny)))))" - apply(simp only: OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet) - apply((rule cpI2[where f = "(or)"], (rule allI)+, rule cp_OclOr)+) - apply(simp only: cp_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet_Planet) -by(simp only: cp_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet_Planet) -lemma cp_OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy_Planet : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Galaxy)))::\<cdot>Planet) .oclIsKindOf(OclAny)))))" - apply(simp only: OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet) - apply((rule cpI2[where f = "(or)"], (rule allI)+, rule cp_OclOr)+) - apply(simp only: cp_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy_Planet) -by(simp only: cp_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy_Planet) -lemma cp_OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_Galaxy : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>OclAny)))::\<cdot>Galaxy) .oclIsKindOf(OclAny)))))" - apply(simp only: OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy) - apply((rule cpI2[where f = "(or)"], (rule allI)+, rule cp_OclOr)+) - apply(simp only: cp_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_Galaxy) -by(simp only: cp_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny_Galaxy) -lemma cp_OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_Galaxy : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Person)))::\<cdot>Galaxy) .oclIsKindOf(OclAny)))))" - apply(simp only: OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy) - apply((rule cpI2[where f = "(or)"], (rule allI)+, rule cp_OclOr)+) - apply(simp only: cp_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_Galaxy) -by(simp only: cp_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person_Galaxy) -lemma cp_OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet_Galaxy : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Planet)))::\<cdot>Galaxy) .oclIsKindOf(OclAny)))))" - apply(simp only: OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy) - apply((rule cpI2[where f = "(or)"], (rule allI)+, rule cp_OclOr)+) - apply(simp only: cp_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet_Galaxy) -by(simp only: cp_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet_Galaxy) -lemma cp_OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy_Galaxy : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Galaxy)))::\<cdot>Galaxy) .oclIsKindOf(OclAny)))))" - apply(simp only: OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy) - apply((rule cpI2[where f = "(or)"], (rule allI)+, rule cp_OclOr)+) - apply(simp only: cp_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy_Galaxy) -by(simp only: cp_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy_Galaxy) - -(* 83 ************************************ 525 + 1 *) (* term Floor1_iskindof.print_iskindof_lemmas_cp *) -lemmas[simp,code_unfold] = cp_OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_OclAny - cp_OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy_OclAny - cp_OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet_OclAny - cp_OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_OclAny - cp_OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_Galaxy - cp_OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy_Galaxy - cp_OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet_Galaxy - cp_OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_Galaxy - cp_OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_Planet - cp_OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy_Planet - cp_OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet_Planet - cp_OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_Planet - cp_OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_Person - cp_OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy_Person - cp_OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet_Person - cp_OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_Person - cp_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny_OclAny - cp_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy_OclAny - cp_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet_OclAny - cp_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person_OclAny - cp_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny_Galaxy - cp_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy_Galaxy - cp_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet_Galaxy - cp_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person_Galaxy - cp_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny_Planet - cp_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy_Planet - cp_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet_Planet - cp_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person_Planet - cp_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny_Person - cp_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy_Person - cp_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet_Person - cp_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person_Person - cp_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny_OclAny - cp_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy_OclAny - cp_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet_OclAny - cp_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person_OclAny - cp_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny_Galaxy - cp_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy_Galaxy - cp_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet_Galaxy - cp_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person_Galaxy - cp_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny_Planet - cp_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy_Planet - cp_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet_Planet - cp_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person_Planet - cp_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny_Person - cp_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy_Person - cp_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet_Person - cp_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person_Person - cp_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_OclAny - cp_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy_OclAny - cp_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet_OclAny - cp_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_OclAny - cp_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_Galaxy - cp_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy_Galaxy - cp_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet_Galaxy - cp_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_Galaxy - cp_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_Planet - cp_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy_Planet - cp_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet_Planet - cp_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_Planet - cp_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_Person - cp_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy_Person - cp_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet_Person - cp_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_Person - -(* 84 ************************************ 526 + 1 *) -subsection \<open>Execution with Invalid or Null as Argument\<close> - -(* 85 ************************************ 527 + 32 *) (* term Floor1_iskindof.print_iskindof_lemma_strict *) -lemma OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_invalid : "((invalid::\<cdot>Person) .oclIsKindOf(Person)) = invalid" -by(simp only: OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_invalid) -lemma OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_null : "((null::\<cdot>Person) .oclIsKindOf(Person)) = true" -by(simp only: OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_null) -lemma OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet_invalid : "((invalid::\<cdot>Planet) .oclIsKindOf(Person)) = invalid" -by(simp only: OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet_invalid) -lemma OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet_null : "((null::\<cdot>Planet) .oclIsKindOf(Person)) = true" -by(simp only: OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet_null) -lemma OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy_invalid : "((invalid::\<cdot>Galaxy) .oclIsKindOf(Person)) = invalid" -by(simp only: OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy_invalid) -lemma OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy_null : "((null::\<cdot>Galaxy) .oclIsKindOf(Person)) = true" -by(simp only: OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy_null) -lemma OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_invalid : "((invalid::\<cdot>OclAny) .oclIsKindOf(Person)) = invalid" -by(simp only: OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_invalid) -lemma OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_null : "((null::\<cdot>OclAny) .oclIsKindOf(Person)) = true" -by(simp only: OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_null) -lemma OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet_invalid : "((invalid::\<cdot>Planet) .oclIsKindOf(Planet)) = invalid" -by(simp only: OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet_invalid OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet_invalid, simp) -lemma OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet_null : "((null::\<cdot>Planet) .oclIsKindOf(Planet)) = true" -by(simp only: OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet_null OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet_null, simp) -lemma OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy_invalid : "((invalid::\<cdot>Galaxy) .oclIsKindOf(Planet)) = invalid" -by(simp only: OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy_invalid OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy_invalid, simp) -lemma OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy_null : "((null::\<cdot>Galaxy) .oclIsKindOf(Planet)) = true" -by(simp only: OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy_null OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy_null, simp) -lemma OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny_invalid : "((invalid::\<cdot>OclAny) .oclIsKindOf(Planet)) = invalid" -by(simp only: OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny_invalid OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_invalid, simp) -lemma OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny_null : "((null::\<cdot>OclAny) .oclIsKindOf(Planet)) = true" -by(simp only: OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny_null OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_null, simp) -lemma OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person_invalid : "((invalid::\<cdot>Person) .oclIsKindOf(Planet)) = invalid" -by(simp only: OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person_invalid OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_invalid, simp) -lemma OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person_null : "((null::\<cdot>Person) .oclIsKindOf(Planet)) = true" -by(simp only: OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person_null OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_null, simp) -lemma OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy_invalid : "((invalid::\<cdot>Galaxy) .oclIsKindOf(Galaxy)) = invalid" -by(simp only: OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy_invalid OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy_invalid, simp) -lemma OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy_null : "((null::\<cdot>Galaxy) .oclIsKindOf(Galaxy)) = true" -by(simp only: OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy_null OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy_null, simp) -lemma OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny_invalid : "((invalid::\<cdot>OclAny) .oclIsKindOf(Galaxy)) = invalid" -by(simp only: OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny_invalid OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny_invalid, simp) -lemma OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny_null : "((null::\<cdot>OclAny) .oclIsKindOf(Galaxy)) = true" -by(simp only: OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny_null OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny_null, simp) -lemma OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person_invalid : "((invalid::\<cdot>Person) .oclIsKindOf(Galaxy)) = invalid" -by(simp only: OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person_invalid OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person_invalid, simp) -lemma OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person_null : "((null::\<cdot>Person) .oclIsKindOf(Galaxy)) = true" -by(simp only: OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person_null OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person_null, simp) -lemma OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet_invalid : "((invalid::\<cdot>Planet) .oclIsKindOf(Galaxy)) = invalid" -by(simp only: OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet_invalid OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet_invalid, simp) -lemma OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet_null : "((null::\<cdot>Planet) .oclIsKindOf(Galaxy)) = true" -by(simp only: OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet_null OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet_null, simp) -lemma OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_invalid : "((invalid::\<cdot>OclAny) .oclIsKindOf(OclAny)) = invalid" -by(simp only: OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_invalid OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny_invalid, simp) -lemma OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_null : "((null::\<cdot>OclAny) .oclIsKindOf(OclAny)) = true" -by(simp only: OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_null OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny_null, simp) -lemma OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_invalid : "((invalid::\<cdot>Person) .oclIsKindOf(OclAny)) = invalid" -by(simp only: OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_invalid OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person_invalid, simp) -lemma OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_null : "((null::\<cdot>Person) .oclIsKindOf(OclAny)) = true" -by(simp only: OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_null OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person_null, simp) -lemma OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet_invalid : "((invalid::\<cdot>Planet) .oclIsKindOf(OclAny)) = invalid" -by(simp only: OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet_invalid OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet_invalid, simp) -lemma OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet_null : "((null::\<cdot>Planet) .oclIsKindOf(OclAny)) = true" -by(simp only: OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet_null OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet_null, simp) -lemma OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy_invalid : "((invalid::\<cdot>Galaxy) .oclIsKindOf(OclAny)) = invalid" -by(simp only: OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy_invalid OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy_invalid, simp) -lemma OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy_null : "((null::\<cdot>Galaxy) .oclIsKindOf(OclAny)) = true" -by(simp only: OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy_null OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy_null, simp) - -(* 86 ************************************ 559 + 1 *) (* term Floor1_iskindof.print_iskindof_lemmas_strict *) -lemmas[simp,code_unfold] = OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_invalid - OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy_invalid - OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet_invalid - OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_invalid - OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_null - OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy_null - OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet_null - OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_null - OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny_invalid - OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy_invalid - OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet_invalid - OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person_invalid - OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny_null - OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy_null - OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet_null - OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person_null - OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny_invalid - OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy_invalid - OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet_invalid - OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person_invalid - OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny_null - OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy_null - OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet_null - OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person_null - OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_invalid - OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy_invalid - OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet_invalid - OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_invalid - OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_null - OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy_null - OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet_null - OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_null - -(* 87 ************************************ 560 + 1 *) -subsection \<open>Validity and Definedness Properties\<close> - -(* 88 ************************************ 561 + 16 *) (* term Floor1_iskindof.print_iskindof_defined *) -lemma OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_defined : -assumes isdef: "\<tau> \<Turnstile> (\<upsilon> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Person) .oclIsKindOf(Person)))" -by(simp only: OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person, rule OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_defined[OF isdef]) -lemma OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet_defined : -assumes isdef: "\<tau> \<Turnstile> (\<upsilon> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Planet) .oclIsKindOf(Person)))" -by(simp only: OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet, rule OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet_defined[OF isdef]) -lemma OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy_defined : -assumes isdef: "\<tau> \<Turnstile> (\<upsilon> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Galaxy) .oclIsKindOf(Person)))" -by(simp only: OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy, rule OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy_defined[OF isdef]) -lemma OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_defined : -assumes isdef: "\<tau> \<Turnstile> (\<upsilon> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>OclAny) .oclIsKindOf(Person)))" -by(simp only: OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny, rule OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_defined[OF isdef]) -lemma OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet_defined : -assumes isdef: "\<tau> \<Turnstile> (\<upsilon> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Planet) .oclIsKindOf(Planet)))" -by(simp only: OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet, rule defined_or_I[OF OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet_defined[OF isdef], OF OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet_defined[OF isdef]]) -lemma OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy_defined : -assumes isdef: "\<tau> \<Turnstile> (\<upsilon> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Galaxy) .oclIsKindOf(Planet)))" -by(simp only: OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy, rule defined_or_I[OF OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy_defined[OF isdef], OF OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy_defined[OF isdef]]) -lemma OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny_defined : -assumes isdef: "\<tau> \<Turnstile> (\<upsilon> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>OclAny) .oclIsKindOf(Planet)))" -by(simp only: OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny, rule defined_or_I[OF OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny_defined[OF isdef], OF OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_defined[OF isdef]]) -lemma OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person_defined : -assumes isdef: "\<tau> \<Turnstile> (\<upsilon> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Person) .oclIsKindOf(Planet)))" -by(simp only: OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person, rule defined_or_I[OF OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person_defined[OF isdef], OF OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_defined[OF isdef]]) -lemma OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy_defined : -assumes isdef: "\<tau> \<Turnstile> (\<upsilon> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Galaxy) .oclIsKindOf(Galaxy)))" -by(simp only: OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy, rule defined_or_I[OF OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy_defined[OF isdef], OF OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy_defined[OF isdef]]) -lemma OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny_defined : -assumes isdef: "\<tau> \<Turnstile> (\<upsilon> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>OclAny) .oclIsKindOf(Galaxy)))" -by(simp only: OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny, rule defined_or_I[OF OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny_defined[OF isdef], OF OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny_defined[OF isdef]]) -lemma OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person_defined : -assumes isdef: "\<tau> \<Turnstile> (\<upsilon> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Person) .oclIsKindOf(Galaxy)))" -by(simp only: OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person, rule defined_or_I[OF OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person_defined[OF isdef], OF OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person_defined[OF isdef]]) -lemma OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet_defined : -assumes isdef: "\<tau> \<Turnstile> (\<upsilon> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Planet) .oclIsKindOf(Galaxy)))" -by(simp only: OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet, rule defined_or_I[OF OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet_defined[OF isdef], OF OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet_defined[OF isdef]]) -lemma OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_defined : -assumes isdef: "\<tau> \<Turnstile> (\<upsilon> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>OclAny) .oclIsKindOf(OclAny)))" -by(simp only: OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny, rule defined_or_I[OF OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_defined[OF isdef], OF OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny_defined[OF isdef]]) -lemma OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_defined : -assumes isdef: "\<tau> \<Turnstile> (\<upsilon> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Person) .oclIsKindOf(OclAny)))" -by(simp only: OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person, rule defined_or_I[OF OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_defined[OF isdef], OF OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person_defined[OF isdef]]) -lemma OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet_defined : -assumes isdef: "\<tau> \<Turnstile> (\<upsilon> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Planet) .oclIsKindOf(OclAny)))" -by(simp only: OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet, rule defined_or_I[OF OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet_defined[OF isdef], OF OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet_defined[OF isdef]]) -lemma OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy_defined : -assumes isdef: "\<tau> \<Turnstile> (\<upsilon> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Galaxy) .oclIsKindOf(OclAny)))" -by(simp only: OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy, rule defined_or_I[OF OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy_defined[OF isdef], OF OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy_defined[OF isdef]]) - -(* 89 ************************************ 577 + 16 *) (* term Floor1_iskindof.print_iskindof_defined' *) -lemma OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_defined' : -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Person) .oclIsKindOf(Person)))" -by(rule OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_defined[OF isdef[THEN foundation20]]) -lemma OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet_defined' : -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Planet) .oclIsKindOf(Person)))" -by(rule OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet_defined[OF isdef[THEN foundation20]]) -lemma OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy_defined' : -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Galaxy) .oclIsKindOf(Person)))" -by(rule OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy_defined[OF isdef[THEN foundation20]]) -lemma OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_defined' : -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>OclAny) .oclIsKindOf(Person)))" -by(rule OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_defined[OF isdef[THEN foundation20]]) -lemma OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet_defined' : -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Planet) .oclIsKindOf(Planet)))" -by(rule OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet_defined[OF isdef[THEN foundation20]]) -lemma OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy_defined' : -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Galaxy) .oclIsKindOf(Planet)))" -by(rule OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy_defined[OF isdef[THEN foundation20]]) -lemma OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny_defined' : -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>OclAny) .oclIsKindOf(Planet)))" -by(rule OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny_defined[OF isdef[THEN foundation20]]) -lemma OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person_defined' : -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Person) .oclIsKindOf(Planet)))" -by(rule OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person_defined[OF isdef[THEN foundation20]]) -lemma OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy_defined' : -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Galaxy) .oclIsKindOf(Galaxy)))" -by(rule OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy_defined[OF isdef[THEN foundation20]]) -lemma OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny_defined' : -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>OclAny) .oclIsKindOf(Galaxy)))" -by(rule OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny_defined[OF isdef[THEN foundation20]]) -lemma OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person_defined' : -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Person) .oclIsKindOf(Galaxy)))" -by(rule OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person_defined[OF isdef[THEN foundation20]]) -lemma OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet_defined' : -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Planet) .oclIsKindOf(Galaxy)))" -by(rule OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet_defined[OF isdef[THEN foundation20]]) -lemma OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_defined' : -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>OclAny) .oclIsKindOf(OclAny)))" -by(rule OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_defined[OF isdef[THEN foundation20]]) -lemma OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_defined' : -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Person) .oclIsKindOf(OclAny)))" -by(rule OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_defined[OF isdef[THEN foundation20]]) -lemma OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet_defined' : -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Planet) .oclIsKindOf(OclAny)))" -by(rule OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet_defined[OF isdef[THEN foundation20]]) -lemma OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy_defined' : -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Galaxy) .oclIsKindOf(OclAny)))" -by(rule OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy_defined[OF isdef[THEN foundation20]]) - -(* 90 ************************************ 593 + 1 *) -subsection \<open>Up Down Casting\<close> - -(* 91 ************************************ 594 + 4 *) (* term Floor1_iskindof.print_iskindof_up_eq_asty *) -lemma actual_eq_static\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n : -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> ((X::\<cdot>Person) .oclIsKindOf(Person))" - apply(simp only: OclValid_def, insert isdef) - apply(simp only: OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person) - apply(auto simp: foundation16 bot_option_def split: option.split ty\<E>\<X>\<T>\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n.split ty\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n.split) -by((simp_all add: false_def true_def OclOr_def OclAnd_def OclNot_def)?) -lemma actual_eq_static\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t : -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> ((X::\<cdot>Planet) .oclIsKindOf(Planet))" - apply(simp only: OclValid_def, insert isdef) - apply(simp only: OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet, subst (1) cp_OclOr, simp only: OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet) - apply(auto simp: cp_OclOr[symmetric ] foundation16 bot_option_def OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet split: option.split ty\<E>\<X>\<T>\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t.split ty\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t.split ty\<E>\<X>\<T>\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n.split ty\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n.split) -by((simp_all add: false_def true_def OclOr_def OclAnd_def OclNot_def)?) -lemma actual_eq_static\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y : -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> ((X::\<cdot>Galaxy) .oclIsKindOf(Galaxy))" - apply(simp only: OclValid_def, insert isdef) - apply(simp only: OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy, subst (1) cp_OclOr, simp only: OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy, subst (2 1) cp_OclOr, simp only: OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy) - apply(auto simp: cp_OclOr[symmetric ] foundation16 bot_option_def OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy split: option.split ty\<E>\<X>\<T>\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y.split ty\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y.split ty\<E>\<X>\<T>\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n.split ty\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n.split ty\<E>\<X>\<T>\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t.split ty\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t.split) -by((simp_all add: false_def true_def OclOr_def OclAnd_def OclNot_def)?) -lemma actual_eq_static\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y : -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> ((X::\<cdot>OclAny) .oclIsKindOf(OclAny))" - apply(simp only: OclValid_def, insert isdef) - apply(simp only: OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny, subst (1) cp_OclOr, simp only: OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny, subst (2 1) cp_OclOr, simp only: OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny, subst (3 2 1) cp_OclOr, simp only: OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny) - apply(auto simp: cp_OclOr[symmetric ] foundation16 bot_option_def OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny split: option.split ty\<E>\<X>\<T>\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y.split ty\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y.split ty\<E>\<X>\<T>\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n.split ty\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n.split ty\<E>\<X>\<T>\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t.split ty\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t.split ty\<E>\<X>\<T>\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y.split ty\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y.split) -by((simp_all add: false_def true_def OclOr_def OclAnd_def OclNot_def)?) - -(* 92 ************************************ 598 + 6 *) (* term Floor1_iskindof.print_iskindof_up_larger *) -lemma actualKind\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_larger_staticKind\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t : -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> ((X::\<cdot>Person) .oclIsKindOf(Planet))" - apply(simp only: OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person) -by(rule foundation25', rule actual_eq_static\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n[OF isdef]) -lemma actualKind\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_larger_staticKind\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y : -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> ((X::\<cdot>Person) .oclIsKindOf(Galaxy))" - apply(simp only: OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person) -by(rule foundation25', rule actualKind\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_larger_staticKind\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t[OF isdef]) -lemma actualKind\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_larger_staticKind\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y : -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> ((X::\<cdot>Person) .oclIsKindOf(OclAny))" - apply(simp only: OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person) -by(rule foundation25', rule actualKind\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_larger_staticKind\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y[OF isdef]) -lemma actualKind\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_larger_staticKind\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y : -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> ((X::\<cdot>Planet) .oclIsKindOf(Galaxy))" - apply(simp only: OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet) -by(rule foundation25', rule actual_eq_static\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t[OF isdef]) -lemma actualKind\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_larger_staticKind\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y : -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> ((X::\<cdot>Planet) .oclIsKindOf(OclAny))" - apply(simp only: OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet) -by(rule foundation25', rule actualKind\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_larger_staticKind\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y[OF isdef]) -lemma actualKind\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_larger_staticKind\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y : -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> ((X::\<cdot>Galaxy) .oclIsKindOf(OclAny))" - apply(simp only: OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy) -by(rule foundation25', rule actual_eq_static\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y[OF isdef]) - -(* 93 ************************************ 604 + 6 *) (* term Floor1_iskindof.print_iskindof_up_istypeof_unfold *) -lemma not_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_then_Planet_OclIsTypeOf_others_unfold : -assumes isdef: "(\<tau> \<Turnstile> (\<delta> (X)))" -assumes iskin: "(\<tau> \<Turnstile> ((X::\<cdot>Planet) .oclIsKindOf(Person)))" -shows "(\<tau> \<Turnstile> ((X::\<cdot>Planet) .oclIsTypeOf(Person)))" - using iskin - apply(simp only: OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet) -done -lemma not_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_then_Galaxy_OclIsTypeOf_others_unfold : -assumes isdef: "(\<tau> \<Turnstile> (\<delta> (X)))" -assumes iskin: "(\<tau> \<Turnstile> ((X::\<cdot>Galaxy) .oclIsKindOf(Person)))" -shows "(\<tau> \<Turnstile> ((X::\<cdot>Galaxy) .oclIsTypeOf(Person)))" - using iskin - apply(simp only: OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy) -done -lemma not_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_then_OclAny_OclIsTypeOf_others_unfold : -assumes isdef: "(\<tau> \<Turnstile> (\<delta> (X)))" -assumes iskin: "(\<tau> \<Turnstile> ((X::\<cdot>OclAny) .oclIsKindOf(Person)))" -shows "(\<tau> \<Turnstile> ((X::\<cdot>OclAny) .oclIsTypeOf(Person)))" - using iskin - apply(simp only: OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny) -done -lemma not_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_then_Galaxy_OclIsTypeOf_others_unfold : -assumes isdef: "(\<tau> \<Turnstile> (\<delta> (X)))" -assumes iskin: "(\<tau> \<Turnstile> ((X::\<cdot>Galaxy) .oclIsKindOf(Planet)))" -shows "((\<tau> \<Turnstile> ((X::\<cdot>Galaxy) .oclIsTypeOf(Planet))) \<or> (\<tau> \<Turnstile> ((X::\<cdot>Galaxy) .oclIsTypeOf(Person))))" - using iskin - apply(simp only: OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy) - apply(erule foundation26[OF OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy_defined'[OF isdef], OF OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy_defined'[OF isdef]]) - apply(simp) - apply(drule not_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_then_Galaxy_OclIsTypeOf_others_unfold[OF isdef], blast) -done -lemma not_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_then_OclAny_OclIsTypeOf_others_unfold : -assumes isdef: "(\<tau> \<Turnstile> (\<delta> (X)))" -assumes iskin: "(\<tau> \<Turnstile> ((X::\<cdot>OclAny) .oclIsKindOf(Planet)))" -shows "((\<tau> \<Turnstile> ((X::\<cdot>OclAny) .oclIsTypeOf(Planet))) \<or> (\<tau> \<Turnstile> ((X::\<cdot>OclAny) .oclIsTypeOf(Person))))" - using iskin - apply(simp only: OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny) - apply(erule foundation26[OF OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny_defined'[OF isdef], OF OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_defined'[OF isdef]]) - apply(simp) - apply(drule not_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_then_OclAny_OclIsTypeOf_others_unfold[OF isdef], blast) -done -lemma not_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_then_OclAny_OclIsTypeOf_others_unfold : -assumes isdef: "(\<tau> \<Turnstile> (\<delta> (X)))" -assumes iskin: "(\<tau> \<Turnstile> ((X::\<cdot>OclAny) .oclIsKindOf(Galaxy)))" -shows "((\<tau> \<Turnstile> ((X::\<cdot>OclAny) .oclIsTypeOf(Galaxy))) \<or> ((\<tau> \<Turnstile> ((X::\<cdot>OclAny) .oclIsTypeOf(Person))) \<or> (\<tau> \<Turnstile> ((X::\<cdot>OclAny) .oclIsTypeOf(Planet)))))" - using iskin - apply(simp only: OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny) - apply(erule foundation26[OF OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny_defined'[OF isdef], OF OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny_defined'[OF isdef]]) - apply(simp) - apply(drule not_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_then_OclAny_OclIsTypeOf_others_unfold[OF isdef], blast) -done - -(* 94 ************************************ 610 + 6 *) (* term Floor1_iskindof.print_iskindof_up_istypeof *) -lemma not_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_then_Planet_OclIsTypeOf_others : -assumes iskin: "\<not> \<tau> \<Turnstile> ((X::\<cdot>Planet) .oclIsKindOf(Person))" -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> ((X::\<cdot>Planet) .oclIsTypeOf(Planet))" - using actual_eq_static\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t[OF isdef] - apply(simp only: OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet) - apply(erule foundation26[OF OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet_defined'[OF isdef], OF OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet_defined'[OF isdef]]) - apply(simp) - apply(simp add: iskin) -done -lemma not_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_then_Galaxy_OclIsTypeOf_others : -assumes iskin: "\<not> \<tau> \<Turnstile> ((X::\<cdot>Galaxy) .oclIsKindOf(Person))" -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "(\<tau> \<Turnstile> ((X::\<cdot>Galaxy) .oclIsTypeOf(Galaxy)) \<or> \<tau> \<Turnstile> ((X::\<cdot>Galaxy) .oclIsTypeOf(Planet)))" - using actual_eq_static\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y[OF isdef] - apply(simp only: OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy) - apply(erule foundation26[OF OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy_defined'[OF isdef], OF OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy_defined'[OF isdef]]) - apply(simp) - apply(simp only: OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy) - apply(erule foundation26[OF OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy_defined'[OF isdef], OF OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy_defined'[OF isdef]]) - apply(simp) - apply(simp add: iskin) -done -lemma not_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_then_OclAny_OclIsTypeOf_others : -assumes iskin: "\<not> \<tau> \<Turnstile> ((X::\<cdot>OclAny) .oclIsKindOf(Person))" -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "(\<tau> \<Turnstile> ((X::\<cdot>OclAny) .oclIsTypeOf(OclAny)) \<or> (\<tau> \<Turnstile> ((X::\<cdot>OclAny) .oclIsTypeOf(Galaxy)) \<or> \<tau> \<Turnstile> ((X::\<cdot>OclAny) .oclIsTypeOf(Planet))))" - using actual_eq_static\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y[OF isdef] - apply(simp only: OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny) - apply(erule foundation26[OF OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_defined'[OF isdef], OF OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny_defined'[OF isdef]]) - apply(simp) - apply(simp only: OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny) - apply(erule foundation26[OF OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny_defined'[OF isdef], OF OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny_defined'[OF isdef]]) - apply(simp) - apply(simp only: OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny) - apply(erule foundation26[OF OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny_defined'[OF isdef], OF OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_defined'[OF isdef]]) - apply(simp) - apply(simp add: iskin) -done -lemma not_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_then_Galaxy_OclIsTypeOf_others : -assumes iskin: "\<not> \<tau> \<Turnstile> ((X::\<cdot>Galaxy) .oclIsKindOf(Planet))" -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> ((X::\<cdot>Galaxy) .oclIsTypeOf(Galaxy))" - using actual_eq_static\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y[OF isdef] - apply(simp only: OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy) - apply(erule foundation26[OF OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy_defined'[OF isdef], OF OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy_defined'[OF isdef]]) - apply(simp) - apply(simp add: iskin) -done -lemma not_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_then_OclAny_OclIsTypeOf_others : -assumes iskin: "\<not> \<tau> \<Turnstile> ((X::\<cdot>OclAny) .oclIsKindOf(Planet))" -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "(\<tau> \<Turnstile> ((X::\<cdot>OclAny) .oclIsTypeOf(OclAny)) \<or> \<tau> \<Turnstile> ((X::\<cdot>OclAny) .oclIsTypeOf(Galaxy)))" - using actual_eq_static\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y[OF isdef] - apply(simp only: OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny) - apply(erule foundation26[OF OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_defined'[OF isdef], OF OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny_defined'[OF isdef]]) - apply(simp) - apply(simp only: OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny) - apply(erule foundation26[OF OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny_defined'[OF isdef], OF OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny_defined'[OF isdef]]) - apply(simp) - apply(simp add: iskin) -done -lemma not_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_then_OclAny_OclIsTypeOf_others : -assumes iskin: "\<not> \<tau> \<Turnstile> ((X::\<cdot>OclAny) .oclIsKindOf(Galaxy))" -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> ((X::\<cdot>OclAny) .oclIsTypeOf(OclAny))" - using actual_eq_static\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y[OF isdef] - apply(simp only: OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny) - apply(erule foundation26[OF OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_defined'[OF isdef], OF OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny_defined'[OF isdef]]) - apply(simp) - apply(simp add: iskin) -done - -(* 95 ************************************ 616 + 10 *) (* term Floor1_iskindof.print_iskindof_up_d_cast *) -lemma down_cast_kind\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_from_Planet_to_Person : -assumes iskin: "\<not> \<tau> \<Turnstile> ((X::\<cdot>Planet) .oclIsKindOf(Person))" -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> (X .oclAsType(Person)) \<triangleq> invalid" - apply(insert not_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_then_Planet_OclIsTypeOf_others[OF iskin, OF isdef]) - apply(rule down_cast_type\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_from_Planet_to_Person, simp only: , simp only: isdef) -done -lemma down_cast_kind\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_from_Galaxy_to_Person : -assumes iskin: "\<not> \<tau> \<Turnstile> ((X::\<cdot>Galaxy) .oclIsKindOf(Person))" -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> (X .oclAsType(Person)) \<triangleq> invalid" - apply(insert not_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_then_Galaxy_OclIsTypeOf_others[OF iskin, OF isdef], elim disjE) - apply(rule down_cast_type\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_from_Galaxy_to_Person, simp only: , simp only: isdef) - apply(rule down_cast_type\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_from_Galaxy_to_Person, simp only: , simp only: isdef) -done -lemma down_cast_kind\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_from_OclAny_to_Person : -assumes iskin: "\<not> \<tau> \<Turnstile> ((X::\<cdot>OclAny) .oclIsKindOf(Person))" -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> (X .oclAsType(Person)) \<triangleq> invalid" - apply(insert not_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_then_OclAny_OclIsTypeOf_others[OF iskin, OF isdef], elim disjE) - apply(rule down_cast_type\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_from_OclAny_to_Person, simp only: , simp only: isdef) - apply(rule down_cast_type\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_from_OclAny_to_Person, simp only: , simp only: isdef) - apply(rule down_cast_type\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_from_OclAny_to_Person, simp only: , simp only: isdef) -done -lemma down_cast_kind\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_from_Galaxy_to_Planet : -assumes iskin: "\<not> \<tau> \<Turnstile> ((X::\<cdot>Galaxy) .oclIsKindOf(Planet))" -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> (X .oclAsType(Planet)) \<triangleq> invalid" - apply(insert not_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_then_Galaxy_OclIsTypeOf_others[OF iskin, OF isdef]) - apply(rule down_cast_type\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_from_Galaxy_to_Planet, simp only: , simp only: isdef) -done -lemma down_cast_kind\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_from_Galaxy_to_Person : -assumes iskin: "\<not> \<tau> \<Turnstile> ((X::\<cdot>Galaxy) .oclIsKindOf(Planet))" -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> (X .oclAsType(Person)) \<triangleq> invalid" - apply(insert not_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_then_Galaxy_OclIsTypeOf_others[OF iskin, OF isdef]) - apply(rule down_cast_type\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_from_Galaxy_to_Person, simp only: , simp only: isdef) -done -lemma down_cast_kind\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_from_OclAny_to_Planet : -assumes iskin: "\<not> \<tau> \<Turnstile> ((X::\<cdot>OclAny) .oclIsKindOf(Planet))" -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> (X .oclAsType(Planet)) \<triangleq> invalid" - apply(insert not_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_then_OclAny_OclIsTypeOf_others[OF iskin, OF isdef], elim disjE) - apply(rule down_cast_type\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_from_OclAny_to_Planet, simp only: , simp only: isdef) - apply(rule down_cast_type\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_from_OclAny_to_Planet, simp only: , simp only: isdef) -done -lemma down_cast_kind\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_from_OclAny_to_Person : -assumes iskin: "\<not> \<tau> \<Turnstile> ((X::\<cdot>OclAny) .oclIsKindOf(Planet))" -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> (X .oclAsType(Person)) \<triangleq> invalid" - apply(insert not_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_then_OclAny_OclIsTypeOf_others[OF iskin, OF isdef], elim disjE) - apply(rule down_cast_type\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_from_OclAny_to_Person, simp only: , simp only: isdef) - apply(rule down_cast_type\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_from_OclAny_to_Person, simp only: , simp only: isdef) -done -lemma down_cast_kind\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_from_OclAny_to_Galaxy : -assumes iskin: "\<not> \<tau> \<Turnstile> ((X::\<cdot>OclAny) .oclIsKindOf(Galaxy))" -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> (X .oclAsType(Galaxy)) \<triangleq> invalid" - apply(insert not_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_then_OclAny_OclIsTypeOf_others[OF iskin, OF isdef]) - apply(rule down_cast_type\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_from_OclAny_to_Galaxy, simp only: , simp only: isdef) -done -lemma down_cast_kind\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_from_OclAny_to_Person : -assumes iskin: "\<not> \<tau> \<Turnstile> ((X::\<cdot>OclAny) .oclIsKindOf(Galaxy))" -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> (X .oclAsType(Person)) \<triangleq> invalid" - apply(insert not_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_then_OclAny_OclIsTypeOf_others[OF iskin, OF isdef]) - apply(rule down_cast_type\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_from_OclAny_to_Person, simp only: , simp only: isdef) -done -lemma down_cast_kind\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_from_OclAny_to_Planet : -assumes iskin: "\<not> \<tau> \<Turnstile> ((X::\<cdot>OclAny) .oclIsKindOf(Galaxy))" -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> (X .oclAsType(Planet)) \<triangleq> invalid" - apply(insert not_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_then_OclAny_OclIsTypeOf_others[OF iskin, OF isdef]) - apply(rule down_cast_type\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_from_OclAny_to_Planet, simp only: , simp only: isdef) -done - -(* 96 ************************************ 626 + 1 *) -subsection \<open>Const\<close> - -(* 97 ************************************ 627 + 1 *) -section \<open>Class Model: OclAllInstances\<close> - -(* 98 ************************************ 628 + 1 *) -text \<open> - To denote \OCL-types occurring in \OCL expressions syntactically---as, for example, as -``argument'' of \inlineisar{oclAllInstances()}---we use the inverses of the injection -functions into the object universes; we show that this is sufficient ``characterization.'' \<close> - -(* 99 ************************************ 629 + 4 *) (* term Floor1_allinst.print_allinst_def_id *) -definition "Person = OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_\<AA>" -definition "Planet = OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_\<AA>" -definition "Galaxy = OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_\<AA>" -definition "OclAny = OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_\<AA>" - -(* 100 ************************************ 633 + 1 *) (* term Floor1_allinst.print_allinst_lemmas_id *) -lemmas[simp,code_unfold] = Person_def - Planet_def - Galaxy_def - OclAny_def - -(* 101 ************************************ 634 + 1 *) (* term Floor1_allinst.print_allinst_astype *) -lemma OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_\<AA>_some : "(OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_\<AA> (x)) \<noteq> None" -by(simp add: OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_\<AA>_def) - -(* 102 ************************************ 635 + 3 *) (* term Floor1_allinst.print_allinst_exec *) -lemma OclAllInstances_generic\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_exec : -shows "(OclAllInstances_generic (pre_post) (OclAny)) = (\<lambda>\<tau>. (Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (\<lfloor>\<lfloor>Some ` OclAny ` (ran ((heap ((pre_post (\<tau>))))))\<rfloor>\<rfloor>)))" - proof - let ?S1 = "(\<lambda>\<tau>. OclAny ` (ran ((heap ((pre_post (\<tau>)))))))" show ?thesis - proof - let ?S2 = "(\<lambda>\<tau>. ((?S1) (\<tau>)) - {None})" show ?thesis - proof - have B: "(\<And>\<tau>. ((?S2) (\<tau>)) \<subseteq> ((?S1) (\<tau>)))" by(auto) show ?thesis - proof - have C: "(\<And>\<tau>. ((?S1) (\<tau>)) \<subseteq> ((?S2) (\<tau>)))" by(auto simp: OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_\<AA>_some) show ?thesis - apply(simp add: OclValid_def del: OclAllInstances_generic_def OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny) -by(insert equalityI[OF B, OF C], simp) qed qed qed qed -lemma OclAllInstances_at_post\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_exec : -shows "(OclAllInstances_at_post (OclAny)) = (\<lambda>\<tau>. (Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (\<lfloor>\<lfloor>Some ` OclAny ` (ran ((heap ((snd (\<tau>))))))\<rfloor>\<rfloor>)))" - unfolding OclAllInstances_at_post_def -by(rule OclAllInstances_generic\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_exec) -lemma OclAllInstances_at_pre\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_exec : -shows "(OclAllInstances_at_pre (OclAny)) = (\<lambda>\<tau>. (Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (\<lfloor>\<lfloor>Some ` OclAny ` (ran ((heap ((fst (\<tau>))))))\<rfloor>\<rfloor>)))" - unfolding OclAllInstances_at_pre_def -by(rule OclAllInstances_generic\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_exec) - -(* 103 ************************************ 638 + 1 *) -subsection \<open>OclIsTypeOf\<close> - -(* 104 ************************************ 639 + 2 *) (* term Floor1_allinst.print_allinst_istypeof_pre *) -lemma ex_ssubst : "(\<forall>x \<in> B. (s (x)) = (t (x))) \<Longrightarrow> (\<exists>x \<in> B. (P ((s (x))))) = (\<exists>x \<in> B. (P ((t (x)))))" -by(simp) -lemma ex_def : "x \<in> \<lceil>\<lceil>\<lfloor>\<lfloor>Some ` (X - {None})\<rfloor>\<rfloor>\<rceil>\<rceil> \<Longrightarrow> (\<exists>y. x = \<lfloor>\<lfloor>y\<rfloor>\<rfloor>)" -by(auto) - -(* 105 ************************************ 641 + 21 *) (* term Floor1_allinst.print_allinst_istypeof *) -lemma Person_OclAllInstances_generic_OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n : "\<tau> \<Turnstile> (UML_Set.OclForall ((OclAllInstances_generic (pre_post) (Person))) (OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))" - apply(simp add: OclValid_def del: OclAllInstances_generic_def) - apply(simp only: UML_Set.OclForall_def refl if_True OclAllInstances_generic_defined[simplified OclValid_def]) - apply(simp only: OclAllInstances_generic_def) - apply(subst (1 2 3) Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inverse, simp add: bot_option_def) - apply(subst (1 2 3) ex_ssubst[where s = "(\<lambda>x. (((\<lambda>_. x) .oclIsTypeOf(Person)) (\<tau>)))" and t = "(\<lambda>_. (true (\<tau>)))"]) - apply(intro ballI actual_eq_static\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n[simplified OclValid_def, simplified OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person]) - apply(drule ex_def, erule exE, simp) -by(simp) -lemma Person_OclAllInstances_at_post_OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n : -shows "\<tau> \<Turnstile> (UML_Set.OclForall ((OclAllInstances_at_post (Person))) (OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))" - unfolding OclAllInstances_at_post_def -by(rule Person_OclAllInstances_generic_OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n) -lemma Person_OclAllInstances_at_pre_OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n : -shows "\<tau> \<Turnstile> (UML_Set.OclForall ((OclAllInstances_at_pre (Person))) (OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))" - unfolding OclAllInstances_at_pre_def -by(rule Person_OclAllInstances_generic_OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n) -lemma Planet_OclAllInstances_generic_OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t1 : -assumes [simp]: "(\<And>x. (pre_post ((x , x))) = x)" -shows "(\<exists>\<tau>. \<tau> \<Turnstile> (UML_Set.OclForall ((OclAllInstances_generic (pre_post) (Planet))) (OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t)))" - apply(rule exI[where x = "\<tau>\<^sub>0"], simp add: \<tau>\<^sub>0_def OclValid_def del: OclAllInstances_generic_def) - apply(simp only: UML_Set.OclForall_def refl if_True OclAllInstances_generic_defined[simplified OclValid_def]) - apply(simp only: OclAllInstances_generic_def) - apply(subst (1 2 3) Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inverse, simp add: bot_option_def) -by(simp) -lemma Planet_OclAllInstances_at_post_OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t1 : -shows "(\<exists>\<tau>. \<tau> \<Turnstile> (UML_Set.OclForall ((OclAllInstances_at_post (Planet))) (OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t)))" - unfolding OclAllInstances_at_post_def -by(rule Planet_OclAllInstances_generic_OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t1, simp) -lemma Planet_OclAllInstances_at_pre_OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t1 : -shows "(\<exists>\<tau>. \<tau> \<Turnstile> (UML_Set.OclForall ((OclAllInstances_at_pre (Planet))) (OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t)))" - unfolding OclAllInstances_at_pre_def -by(rule Planet_OclAllInstances_generic_OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t1, simp) -lemma Planet_OclAllInstances_generic_OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t2 : -assumes [simp]: "(\<And>x. (pre_post ((x , x))) = x)" -shows "(\<exists>\<tau>. \<tau> \<Turnstile> (not ((UML_Set.OclForall ((OclAllInstances_generic (pre_post) (Planet))) (OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t)))))" - proof - fix oid a show ?thesis - proof - let ?t0 = "(state.make ((Map.empty (oid \<mapsto> (in\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t ((mk\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t ((mk\<E>\<X>\<T>\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (a))) (None) (None))))))) (Map.empty))" show ?thesis - apply(rule exI[where x = "(?t0 , ?t0)"], simp add: OclValid_def del: OclAllInstances_generic_def) - apply(simp only: UML_Set.OclForall_def refl if_True OclAllInstances_generic_defined[simplified OclValid_def]) - apply(simp only: OclAllInstances_generic_def OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_\<AA>_def) - apply(subst (1 2 3) Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inverse, simp add: bot_option_def) -by(simp add: state.make_def OclNot_def) qed qed -lemma Planet_OclAllInstances_at_post_OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t2 : -shows "(\<exists>\<tau>. \<tau> \<Turnstile> (not ((UML_Set.OclForall ((OclAllInstances_at_post (Planet))) (OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t)))))" - unfolding OclAllInstances_at_post_def -by(rule Planet_OclAllInstances_generic_OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t2, simp) -lemma Planet_OclAllInstances_at_pre_OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t2 : -shows "(\<exists>\<tau>. \<tau> \<Turnstile> (not ((UML_Set.OclForall ((OclAllInstances_at_pre (Planet))) (OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t)))))" - unfolding OclAllInstances_at_pre_def -by(rule Planet_OclAllInstances_generic_OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t2, simp) -lemma Galaxy_OclAllInstances_generic_OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y1 : -assumes [simp]: "(\<And>x. (pre_post ((x , x))) = x)" -shows "(\<exists>\<tau>. \<tau> \<Turnstile> (UML_Set.OclForall ((OclAllInstances_generic (pre_post) (Galaxy))) (OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y)))" - apply(rule exI[where x = "\<tau>\<^sub>0"], simp add: \<tau>\<^sub>0_def OclValid_def del: OclAllInstances_generic_def) - apply(simp only: UML_Set.OclForall_def refl if_True OclAllInstances_generic_defined[simplified OclValid_def]) - apply(simp only: OclAllInstances_generic_def) - apply(subst (1 2 3) Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inverse, simp add: bot_option_def) -by(simp) -lemma Galaxy_OclAllInstances_at_post_OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y1 : -shows "(\<exists>\<tau>. \<tau> \<Turnstile> (UML_Set.OclForall ((OclAllInstances_at_post (Galaxy))) (OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y)))" - unfolding OclAllInstances_at_post_def -by(rule Galaxy_OclAllInstances_generic_OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y1, simp) -lemma Galaxy_OclAllInstances_at_pre_OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y1 : -shows "(\<exists>\<tau>. \<tau> \<Turnstile> (UML_Set.OclForall ((OclAllInstances_at_pre (Galaxy))) (OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y)))" - unfolding OclAllInstances_at_pre_def -by(rule Galaxy_OclAllInstances_generic_OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y1, simp) -lemma Galaxy_OclAllInstances_generic_OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y2 : -assumes [simp]: "(\<And>x. (pre_post ((x , x))) = x)" -shows "(\<exists>\<tau>. \<tau> \<Turnstile> (not ((UML_Set.OclForall ((OclAllInstances_generic (pre_post) (Galaxy))) (OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y)))))" - proof - fix oid a show ?thesis - proof - let ?t0 = "(state.make ((Map.empty (oid \<mapsto> (in\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y ((mk\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y ((mk\<E>\<X>\<T>\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (a))) (None) (None) (None))))))) (Map.empty))" show ?thesis - apply(rule exI[where x = "(?t0 , ?t0)"], simp add: OclValid_def del: OclAllInstances_generic_def) - apply(simp only: UML_Set.OclForall_def refl if_True OclAllInstances_generic_defined[simplified OclValid_def]) - apply(simp only: OclAllInstances_generic_def OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_\<AA>_def) - apply(subst (1 2 3) Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inverse, simp add: bot_option_def) -by(simp add: state.make_def OclNot_def) qed qed -lemma Galaxy_OclAllInstances_at_post_OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y2 : -shows "(\<exists>\<tau>. \<tau> \<Turnstile> (not ((UML_Set.OclForall ((OclAllInstances_at_post (Galaxy))) (OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y)))))" - unfolding OclAllInstances_at_post_def -by(rule Galaxy_OclAllInstances_generic_OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y2, simp) -lemma Galaxy_OclAllInstances_at_pre_OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y2 : -shows "(\<exists>\<tau>. \<tau> \<Turnstile> (not ((UML_Set.OclForall ((OclAllInstances_at_pre (Galaxy))) (OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y)))))" - unfolding OclAllInstances_at_pre_def -by(rule Galaxy_OclAllInstances_generic_OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y2, simp) -lemma OclAny_OclAllInstances_generic_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y1 : -assumes [simp]: "(\<And>x. (pre_post ((x , x))) = x)" -shows "(\<exists>\<tau>. \<tau> \<Turnstile> (UML_Set.OclForall ((OclAllInstances_generic (pre_post) (OclAny))) (OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y)))" - apply(rule exI[where x = "\<tau>\<^sub>0"], simp add: \<tau>\<^sub>0_def OclValid_def del: OclAllInstances_generic_def) - apply(simp only: UML_Set.OclForall_def refl if_True OclAllInstances_generic_defined[simplified OclValid_def]) - apply(simp only: OclAllInstances_generic_def) - apply(subst (1 2 3) Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inverse, simp add: bot_option_def) -by(simp) -lemma OclAny_OclAllInstances_at_post_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y1 : -shows "(\<exists>\<tau>. \<tau> \<Turnstile> (UML_Set.OclForall ((OclAllInstances_at_post (OclAny))) (OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y)))" - unfolding OclAllInstances_at_post_def -by(rule OclAny_OclAllInstances_generic_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y1, simp) -lemma OclAny_OclAllInstances_at_pre_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y1 : -shows "(\<exists>\<tau>. \<tau> \<Turnstile> (UML_Set.OclForall ((OclAllInstances_at_pre (OclAny))) (OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y)))" - unfolding OclAllInstances_at_pre_def -by(rule OclAny_OclAllInstances_generic_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y1, simp) -lemma OclAny_OclAllInstances_generic_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y2 : -assumes [simp]: "(\<And>x. (pre_post ((x , x))) = x)" -shows "(\<exists>\<tau>. \<tau> \<Turnstile> (not ((UML_Set.OclForall ((OclAllInstances_generic (pre_post) (OclAny))) (OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y)))))" - proof - fix oid a show ?thesis - proof - let ?t0 = "(state.make ((Map.empty (oid \<mapsto> (in\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y ((mk\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y ((mk\<E>\<X>\<T>\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y (a))))))))) (Map.empty))" show ?thesis - apply(rule exI[where x = "(?t0 , ?t0)"], simp add: OclValid_def del: OclAllInstances_generic_def) - apply(simp only: UML_Set.OclForall_def refl if_True OclAllInstances_generic_defined[simplified OclValid_def]) - apply(simp only: OclAllInstances_generic_def OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_\<AA>_def) - apply(subst (1 2 3) Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inverse, simp add: bot_option_def) -by(simp add: state.make_def OclNot_def) qed qed -lemma OclAny_OclAllInstances_at_post_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y2 : -shows "(\<exists>\<tau>. \<tau> \<Turnstile> (not ((UML_Set.OclForall ((OclAllInstances_at_post (OclAny))) (OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y)))))" - unfolding OclAllInstances_at_post_def -by(rule OclAny_OclAllInstances_generic_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y2, simp) -lemma OclAny_OclAllInstances_at_pre_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y2 : -shows "(\<exists>\<tau>. \<tau> \<Turnstile> (not ((UML_Set.OclForall ((OclAllInstances_at_pre (OclAny))) (OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y)))))" - unfolding OclAllInstances_at_pre_def -by(rule OclAny_OclAllInstances_generic_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y2, simp) - -(* 106 ************************************ 662 + 1 *) -subsection \<open>OclIsKindOf\<close> - -(* 107 ************************************ 663 + 12 *) (* term Floor1_allinst.print_allinst_iskindof_eq *) -lemma Person_OclAllInstances_generic_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n : "\<tau> \<Turnstile> (UML_Set.OclForall ((OclAllInstances_generic (pre_post) (Person))) (OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))" - apply(simp add: OclValid_def del: OclAllInstances_generic_def OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person) - apply(simp only: UML_Set.OclForall_def refl if_True OclAllInstances_generic_defined[simplified OclValid_def]) - apply(simp only: OclAllInstances_generic_def) - apply(subst (1 2 3) Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inverse, simp add: bot_option_def) - apply(subst (1 2 3) ex_ssubst[where s = "(\<lambda>x. (((\<lambda>_. x) .oclIsKindOf(Person)) (\<tau>)))" and t = "(\<lambda>_. (true (\<tau>)))"]) - apply(intro ballI actual_eq_static\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n[simplified OclValid_def]) - apply(drule ex_def, erule exE, simp) -by(simp) -lemma Person_OclAllInstances_at_post_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n : -shows "\<tau> \<Turnstile> (UML_Set.OclForall ((OclAllInstances_at_post (Person))) (OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))" - unfolding OclAllInstances_at_post_def -by(rule Person_OclAllInstances_generic_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n) -lemma Person_OclAllInstances_at_pre_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n : -shows "\<tau> \<Turnstile> (UML_Set.OclForall ((OclAllInstances_at_pre (Person))) (OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))" - unfolding OclAllInstances_at_pre_def -by(rule Person_OclAllInstances_generic_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n) -lemma Planet_OclAllInstances_generic_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t : "\<tau> \<Turnstile> (UML_Set.OclForall ((OclAllInstances_generic (pre_post) (Planet))) (OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t))" - apply(simp add: OclValid_def del: OclAllInstances_generic_def OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet) - apply(simp only: UML_Set.OclForall_def refl if_True OclAllInstances_generic_defined[simplified OclValid_def]) - apply(simp only: OclAllInstances_generic_def) - apply(subst (1 2 3) Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inverse, simp add: bot_option_def) - apply(subst (1 2 3) ex_ssubst[where s = "(\<lambda>x. (((\<lambda>_. x) .oclIsKindOf(Planet)) (\<tau>)))" and t = "(\<lambda>_. (true (\<tau>)))"]) - apply(intro ballI actual_eq_static\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t[simplified OclValid_def]) - apply(drule ex_def, erule exE, simp) -by(simp) -lemma Planet_OclAllInstances_at_post_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t : -shows "\<tau> \<Turnstile> (UML_Set.OclForall ((OclAllInstances_at_post (Planet))) (OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t))" - unfolding OclAllInstances_at_post_def -by(rule Planet_OclAllInstances_generic_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t) -lemma Planet_OclAllInstances_at_pre_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t : -shows "\<tau> \<Turnstile> (UML_Set.OclForall ((OclAllInstances_at_pre (Planet))) (OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t))" - unfolding OclAllInstances_at_pre_def -by(rule Planet_OclAllInstances_generic_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t) -lemma Galaxy_OclAllInstances_generic_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y : "\<tau> \<Turnstile> (UML_Set.OclForall ((OclAllInstances_generic (pre_post) (Galaxy))) (OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y))" - apply(simp add: OclValid_def del: OclAllInstances_generic_def OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy) - apply(simp only: UML_Set.OclForall_def refl if_True OclAllInstances_generic_defined[simplified OclValid_def]) - apply(simp only: OclAllInstances_generic_def) - apply(subst (1 2 3) Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inverse, simp add: bot_option_def) - apply(subst (1 2 3) ex_ssubst[where s = "(\<lambda>x. (((\<lambda>_. x) .oclIsKindOf(Galaxy)) (\<tau>)))" and t = "(\<lambda>_. (true (\<tau>)))"]) - apply(intro ballI actual_eq_static\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y[simplified OclValid_def]) - apply(drule ex_def, erule exE, simp) -by(simp) -lemma Galaxy_OclAllInstances_at_post_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y : -shows "\<tau> \<Turnstile> (UML_Set.OclForall ((OclAllInstances_at_post (Galaxy))) (OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y))" - unfolding OclAllInstances_at_post_def -by(rule Galaxy_OclAllInstances_generic_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y) -lemma Galaxy_OclAllInstances_at_pre_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y : -shows "\<tau> \<Turnstile> (UML_Set.OclForall ((OclAllInstances_at_pre (Galaxy))) (OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y))" - unfolding OclAllInstances_at_pre_def -by(rule Galaxy_OclAllInstances_generic_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y) -lemma OclAny_OclAllInstances_generic_OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y : "\<tau> \<Turnstile> (UML_Set.OclForall ((OclAllInstances_generic (pre_post) (OclAny))) (OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y))" - apply(simp add: OclValid_def del: OclAllInstances_generic_def OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny) - apply(simp only: UML_Set.OclForall_def refl if_True OclAllInstances_generic_defined[simplified OclValid_def]) - apply(simp only: OclAllInstances_generic_def) - apply(subst (1 2 3) Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inverse, simp add: bot_option_def) - apply(subst (1 2 3) ex_ssubst[where s = "(\<lambda>x. (((\<lambda>_. x) .oclIsKindOf(OclAny)) (\<tau>)))" and t = "(\<lambda>_. (true (\<tau>)))"]) - apply(intro ballI actual_eq_static\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y[simplified OclValid_def]) - apply(drule ex_def, erule exE, simp) -by(simp) -lemma OclAny_OclAllInstances_at_post_OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y : -shows "\<tau> \<Turnstile> (UML_Set.OclForall ((OclAllInstances_at_post (OclAny))) (OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y))" - unfolding OclAllInstances_at_post_def -by(rule OclAny_OclAllInstances_generic_OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y) -lemma OclAny_OclAllInstances_at_pre_OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y : -shows "\<tau> \<Turnstile> (UML_Set.OclForall ((OclAllInstances_at_pre (OclAny))) (OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y))" - unfolding OclAllInstances_at_pre_def -by(rule OclAny_OclAllInstances_generic_OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y) - -(* 108 ************************************ 675 + 18 *) (* term Floor1_allinst.print_allinst_iskindof_larger *) -lemma Person_OclAllInstances_generic_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t : "\<tau> \<Turnstile> (UML_Set.OclForall ((OclAllInstances_generic (pre_post) (Person))) (OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t))" - apply(simp add: OclValid_def del: OclAllInstances_generic_def OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person) - apply(simp only: UML_Set.OclForall_def refl if_True OclAllInstances_generic_defined[simplified OclValid_def]) - apply(simp only: OclAllInstances_generic_def) - apply(subst (1 2 3) Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inverse, simp add: bot_option_def) - apply(subst (1 2 3) ex_ssubst[where s = "(\<lambda>x. (((\<lambda>_. x) .oclIsKindOf(Planet)) (\<tau>)))" and t = "(\<lambda>_. (true (\<tau>)))"]) - apply(intro ballI actualKind\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_larger_staticKind\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t[simplified OclValid_def]) - apply(drule ex_def, erule exE, simp) -by(simp) -lemma Person_OclAllInstances_at_post_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t : -shows "\<tau> \<Turnstile> (UML_Set.OclForall ((OclAllInstances_at_post (Person))) (OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t))" - unfolding OclAllInstances_at_post_def -by(rule Person_OclAllInstances_generic_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t) -lemma Person_OclAllInstances_at_pre_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t : -shows "\<tau> \<Turnstile> (UML_Set.OclForall ((OclAllInstances_at_pre (Person))) (OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t))" - unfolding OclAllInstances_at_pre_def -by(rule Person_OclAllInstances_generic_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t) -lemma Person_OclAllInstances_generic_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y : "\<tau> \<Turnstile> (UML_Set.OclForall ((OclAllInstances_generic (pre_post) (Person))) (OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y))" - apply(simp add: OclValid_def del: OclAllInstances_generic_def OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person) - apply(simp only: UML_Set.OclForall_def refl if_True OclAllInstances_generic_defined[simplified OclValid_def]) - apply(simp only: OclAllInstances_generic_def) - apply(subst (1 2 3) Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inverse, simp add: bot_option_def) - apply(subst (1 2 3) ex_ssubst[where s = "(\<lambda>x. (((\<lambda>_. x) .oclIsKindOf(Galaxy)) (\<tau>)))" and t = "(\<lambda>_. (true (\<tau>)))"]) - apply(intro ballI actualKind\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_larger_staticKind\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y[simplified OclValid_def]) - apply(drule ex_def, erule exE, simp) -by(simp) -lemma Person_OclAllInstances_at_post_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y : -shows "\<tau> \<Turnstile> (UML_Set.OclForall ((OclAllInstances_at_post (Person))) (OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y))" - unfolding OclAllInstances_at_post_def -by(rule Person_OclAllInstances_generic_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y) -lemma Person_OclAllInstances_at_pre_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y : -shows "\<tau> \<Turnstile> (UML_Set.OclForall ((OclAllInstances_at_pre (Person))) (OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y))" - unfolding OclAllInstances_at_pre_def -by(rule Person_OclAllInstances_generic_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y) -lemma Person_OclAllInstances_generic_OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y : "\<tau> \<Turnstile> (UML_Set.OclForall ((OclAllInstances_generic (pre_post) (Person))) (OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y))" - apply(simp add: OclValid_def del: OclAllInstances_generic_def OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person) - apply(simp only: UML_Set.OclForall_def refl if_True OclAllInstances_generic_defined[simplified OclValid_def]) - apply(simp only: OclAllInstances_generic_def) - apply(subst (1 2 3) Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inverse, simp add: bot_option_def) - apply(subst (1 2 3) ex_ssubst[where s = "(\<lambda>x. (((\<lambda>_. x) .oclIsKindOf(OclAny)) (\<tau>)))" and t = "(\<lambda>_. (true (\<tau>)))"]) - apply(intro ballI actualKind\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_larger_staticKind\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y[simplified OclValid_def]) - apply(drule ex_def, erule exE, simp) -by(simp) -lemma Person_OclAllInstances_at_post_OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y : -shows "\<tau> \<Turnstile> (UML_Set.OclForall ((OclAllInstances_at_post (Person))) (OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y))" - unfolding OclAllInstances_at_post_def -by(rule Person_OclAllInstances_generic_OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y) -lemma Person_OclAllInstances_at_pre_OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y : -shows "\<tau> \<Turnstile> (UML_Set.OclForall ((OclAllInstances_at_pre (Person))) (OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y))" - unfolding OclAllInstances_at_pre_def -by(rule Person_OclAllInstances_generic_OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y) -lemma Planet_OclAllInstances_generic_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y : "\<tau> \<Turnstile> (UML_Set.OclForall ((OclAllInstances_generic (pre_post) (Planet))) (OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y))" - apply(simp add: OclValid_def del: OclAllInstances_generic_def OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet) - apply(simp only: UML_Set.OclForall_def refl if_True OclAllInstances_generic_defined[simplified OclValid_def]) - apply(simp only: OclAllInstances_generic_def) - apply(subst (1 2 3) Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inverse, simp add: bot_option_def) - apply(subst (1 2 3) ex_ssubst[where s = "(\<lambda>x. (((\<lambda>_. x) .oclIsKindOf(Galaxy)) (\<tau>)))" and t = "(\<lambda>_. (true (\<tau>)))"]) - apply(intro ballI actualKind\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_larger_staticKind\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y[simplified OclValid_def]) - apply(drule ex_def, erule exE, simp) -by(simp) -lemma Planet_OclAllInstances_at_post_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y : -shows "\<tau> \<Turnstile> (UML_Set.OclForall ((OclAllInstances_at_post (Planet))) (OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y))" - unfolding OclAllInstances_at_post_def -by(rule Planet_OclAllInstances_generic_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y) -lemma Planet_OclAllInstances_at_pre_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y : -shows "\<tau> \<Turnstile> (UML_Set.OclForall ((OclAllInstances_at_pre (Planet))) (OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y))" - unfolding OclAllInstances_at_pre_def -by(rule Planet_OclAllInstances_generic_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y) -lemma Planet_OclAllInstances_generic_OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y : "\<tau> \<Turnstile> (UML_Set.OclForall ((OclAllInstances_generic (pre_post) (Planet))) (OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y))" - apply(simp add: OclValid_def del: OclAllInstances_generic_def OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet) - apply(simp only: UML_Set.OclForall_def refl if_True OclAllInstances_generic_defined[simplified OclValid_def]) - apply(simp only: OclAllInstances_generic_def) - apply(subst (1 2 3) Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inverse, simp add: bot_option_def) - apply(subst (1 2 3) ex_ssubst[where s = "(\<lambda>x. (((\<lambda>_. x) .oclIsKindOf(OclAny)) (\<tau>)))" and t = "(\<lambda>_. (true (\<tau>)))"]) - apply(intro ballI actualKind\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_larger_staticKind\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y[simplified OclValid_def]) - apply(drule ex_def, erule exE, simp) -by(simp) -lemma Planet_OclAllInstances_at_post_OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y : -shows "\<tau> \<Turnstile> (UML_Set.OclForall ((OclAllInstances_at_post (Planet))) (OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y))" - unfolding OclAllInstances_at_post_def -by(rule Planet_OclAllInstances_generic_OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y) -lemma Planet_OclAllInstances_at_pre_OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y : -shows "\<tau> \<Turnstile> (UML_Set.OclForall ((OclAllInstances_at_pre (Planet))) (OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y))" - unfolding OclAllInstances_at_pre_def -by(rule Planet_OclAllInstances_generic_OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y) -lemma Galaxy_OclAllInstances_generic_OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y : "\<tau> \<Turnstile> (UML_Set.OclForall ((OclAllInstances_generic (pre_post) (Galaxy))) (OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y))" - apply(simp add: OclValid_def del: OclAllInstances_generic_def OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy) - apply(simp only: UML_Set.OclForall_def refl if_True OclAllInstances_generic_defined[simplified OclValid_def]) - apply(simp only: OclAllInstances_generic_def) - apply(subst (1 2 3) Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inverse, simp add: bot_option_def) - apply(subst (1 2 3) ex_ssubst[where s = "(\<lambda>x. (((\<lambda>_. x) .oclIsKindOf(OclAny)) (\<tau>)))" and t = "(\<lambda>_. (true (\<tau>)))"]) - apply(intro ballI actualKind\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_larger_staticKind\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y[simplified OclValid_def]) - apply(drule ex_def, erule exE, simp) -by(simp) -lemma Galaxy_OclAllInstances_at_post_OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y : -shows "\<tau> \<Turnstile> (UML_Set.OclForall ((OclAllInstances_at_post (Galaxy))) (OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y))" - unfolding OclAllInstances_at_post_def -by(rule Galaxy_OclAllInstances_generic_OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y) -lemma Galaxy_OclAllInstances_at_pre_OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y : -shows "\<tau> \<Turnstile> (UML_Set.OclForall ((OclAllInstances_at_pre (Galaxy))) (OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y))" - unfolding OclAllInstances_at_pre_def -by(rule Galaxy_OclAllInstances_generic_OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y) - -(* 109 ************************************ 693 + 1 *) -section \<open>Class Model: The Accessors\<close> - -(* 110 ************************************ 694 + 1 *) -text \<open> - \label{sec:Employee-DesignModel-UMLPart-generatededm-accessors}\<close> - -(* 111 ************************************ 695 + 1 *) -text \<open>\<close> - -(* 112 ************************************ 696 + 1 *) -subsection \<open>Definition\<close> - -(* 113 ************************************ 697 + 1 *) -text \<open>\<close> - -(* 114 ************************************ 698 + 1 *) (* term Floor1_access.print_access_oid_uniq_ml *) -ML \<open>val oidPerson_0_boss = 0\<close> - -(* 115 ************************************ 699 + 1 *) (* term Floor1_access.print_access_oid_uniq *) -definition "oid\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_0___boss = 0" - -(* 116 ************************************ 700 + 1 *) -text \<open>\<close> - -(* 117 ************************************ 701 + 5 *) (* term Floor1_access.print_access_eval_extract *) -definition "eval_extract x f = (\<lambda>\<tau>. (case x \<tau> of \<lfloor>\<lfloor>obj\<rfloor>\<rfloor> \<Rightarrow> (f ((oid_of (obj))) (\<tau>)) - | _ \<Rightarrow> invalid \<tau>))" -definition "in_pre_state = fst" -definition "in_post_state = snd" -definition "reconst_basetype = (\<lambda>x _. \<lfloor>\<lfloor>x\<rfloor>\<rfloor>)" -definition "reconst_basetype\<^sub>V\<^sub>o\<^sub>i\<^sub>d x = Abs_Void\<^sub>b\<^sub>a\<^sub>s\<^sub>e o (reconst_basetype (x))" - -(* 118 ************************************ 706 + 1 *) -text \<open>\<close> - -(* 119 ************************************ 707 + 2 *) (* term Floor1_access.print_access_choose_ml *) -ML \<open>val switch2_01 = (fn [x0 , x1] => (x0 , x1))\<close> -ML \<open>val switch2_10 = (fn [x0 , x1] => (x1 , x0))\<close> - -(* 120 ************************************ 709 + 3 *) (* term Floor1_access.print_access_choose *) -definition "switch\<^sub>2_01 = (\<lambda> [x0 , x1] \<Rightarrow> (x0 , x1))" -definition "switch\<^sub>2_10 = (\<lambda> [x0 , x1] \<Rightarrow> (x1 , x0))" -definition "deref_assocs pre_post to_from assoc_oid f oid = (\<lambda>\<tau>. (case (assocs ((pre_post (\<tau>))) (assoc_oid)) of \<lfloor>S\<rfloor> \<Rightarrow> (f ((deref_assocs_list (to_from) (oid) (S))) (\<tau>)) - | _ \<Rightarrow> (invalid (\<tau>))))" - -(* 121 ************************************ 712 + 4 *) (* term Floor1_access.print_access_deref_oid *) -definition "deref_oid\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n fst_snd f oid = (\<lambda>\<tau>. (case (heap (fst_snd \<tau>) (oid)) of \<lfloor>in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n obj\<rfloor> \<Rightarrow> f obj \<tau> - | _ \<Rightarrow> invalid \<tau>))" -definition "deref_oid\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t fst_snd f oid = (\<lambda>\<tau>. (case (heap (fst_snd \<tau>) (oid)) of \<lfloor>in\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t obj\<rfloor> \<Rightarrow> f obj \<tau> - | _ \<Rightarrow> invalid \<tau>))" -definition "deref_oid\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y fst_snd f oid = (\<lambda>\<tau>. (case (heap (fst_snd \<tau>) (oid)) of \<lfloor>in\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y obj\<rfloor> \<Rightarrow> f obj \<tau> - | _ \<Rightarrow> invalid \<tau>))" -definition "deref_oid\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y fst_snd f oid = (\<lambda>\<tau>. (case (heap (fst_snd \<tau>) (oid)) of \<lfloor>in\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y obj\<rfloor> \<Rightarrow> f obj \<tau> - | _ \<Rightarrow> invalid \<tau>))" - -(* 122 ************************************ 716 + 0 *) (* term Floor1_access.print_access_deref_assocs *) - -(* 123 ************************************ 716 + 1 *) -text \<open> - pointer undefined in state or not referencing a type conform object representation \<close> - -(* 124 ************************************ 717 + 15 *) (* term Floor1_access.print_access_select *) -definition "select\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__boss f = (\<lambda> (mk\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (_) (\<bottom>) (_)) \<Rightarrow> null - | (mk\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (_) (\<lfloor>x___boss\<rfloor>) (_)) \<Rightarrow> (f (x___boss)))" -definition "select\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__salary f = (\<lambda> (mk\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (_) (_) (\<bottom>)) \<Rightarrow> null - | (mk\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (_) (_) (\<lfloor>x___salary\<rfloor>)) \<Rightarrow> (f (x___salary)))" -definition "select\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__wormhole f = (\<lambda> (mk\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (_) (\<bottom>) (_)) \<Rightarrow> null - | (mk\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (_) (\<lfloor>x___wormhole\<rfloor>) (_)) \<Rightarrow> (f (x___wormhole)))" -definition "select\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__weight f = (\<lambda> (mk\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (_) (_) (\<bottom>)) \<Rightarrow> null - | (mk\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (_) (_) (\<lfloor>x___weight\<rfloor>)) \<Rightarrow> (f (x___weight)))" -definition "select\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y__sound f = (\<lambda> (mk\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y (_) (\<bottom>) (_) (_)) \<Rightarrow> null - | (mk\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y (_) (\<lfloor>x___sound\<rfloor>) (_) (_)) \<Rightarrow> (f (x___sound)))" -definition "select\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y__moving f = (\<lambda> (mk\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y (_) (_) (\<bottom>) (_)) \<Rightarrow> null - | (mk\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y (_) (_) (\<lfloor>x___moving\<rfloor>) (_)) \<Rightarrow> (f (x___moving)))" -definition "select\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y__outer_world f = (\<lambda> (mk\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y (_) (_) (_) (\<bottom>)) \<Rightarrow> null - | (mk\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y (_) (_) (_) (\<lfloor>x___outer_world\<rfloor>)) \<Rightarrow> (f (x___outer_world)))" -definition "select\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__wormhole f = (\<lambda> (mk\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n ((mk\<E>\<X>\<T>\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (_) (\<bottom>) (_) (_) (_) (_))) (_) (_)) \<Rightarrow> null - | (mk\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n ((mk\<E>\<X>\<T>\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (_) (\<lfloor>x___wormhole\<rfloor>) (_) (_) (_) (_))) (_) (_)) \<Rightarrow> (f (x___wormhole)))" -definition "select\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__weight f = (\<lambda> (mk\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n ((mk\<E>\<X>\<T>\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (_) (_) (\<bottom>) (_) (_) (_))) (_) (_)) \<Rightarrow> null - | (mk\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n ((mk\<E>\<X>\<T>\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (_) (_) (\<lfloor>x___weight\<rfloor>) (_) (_) (_))) (_) (_)) \<Rightarrow> (f (x___weight)))" -definition "select\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__sound f = (\<lambda> (mk\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n ((mk\<E>\<X>\<T>\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (_) (_) (_) (\<bottom>) (_) (_))) (_) (_)) \<Rightarrow> null - | (mk\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n ((mk\<E>\<X>\<T>\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (_) (_) (_) (\<lfloor>x___sound\<rfloor>) (_) (_))) (_) (_)) \<Rightarrow> (f (x___sound)))" -definition "select\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__moving f = (\<lambda> (mk\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n ((mk\<E>\<X>\<T>\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (_) (_) (_) (_) (\<bottom>) (_))) (_) (_)) \<Rightarrow> null - | (mk\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n ((mk\<E>\<X>\<T>\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (_) (_) (_) (_) (\<lfloor>x___moving\<rfloor>) (_))) (_) (_)) \<Rightarrow> (f (x___moving)))" -definition "select\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__outer_world f = (\<lambda> (mk\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n ((mk\<E>\<X>\<T>\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (_) (_) (_) (_) (_) (\<bottom>))) (_) (_)) \<Rightarrow> null - | (mk\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n ((mk\<E>\<X>\<T>\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (_) (_) (_) (_) (_) (\<lfloor>x___outer_world\<rfloor>))) (_) (_)) \<Rightarrow> (f (x___outer_world)))" -definition "select\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__sound f = (\<lambda> (mk\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t ((mk\<E>\<X>\<T>\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (_) (\<bottom>) (_) (_))) (_) (_)) \<Rightarrow> null - | (mk\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t ((mk\<E>\<X>\<T>\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (_) (\<lfloor>x___sound\<rfloor>) (_) (_))) (_) (_)) \<Rightarrow> (f (x___sound)) - | (mk\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t ((mk\<E>\<X>\<T>\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (person))) (_) (_)) \<Rightarrow> (select\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__sound (f) (person)))" -definition "select\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__moving f = (\<lambda> (mk\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t ((mk\<E>\<X>\<T>\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (_) (_) (\<bottom>) (_))) (_) (_)) \<Rightarrow> null - | (mk\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t ((mk\<E>\<X>\<T>\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (_) (_) (\<lfloor>x___moving\<rfloor>) (_))) (_) (_)) \<Rightarrow> (f (x___moving)) - | (mk\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t ((mk\<E>\<X>\<T>\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (person))) (_) (_)) \<Rightarrow> (select\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__moving (f) (person)))" -definition "select\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__outer_world f = (\<lambda> (mk\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t ((mk\<E>\<X>\<T>\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (_) (_) (_) (\<bottom>))) (_) (_)) \<Rightarrow> null - | (mk\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t ((mk\<E>\<X>\<T>\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (_) (_) (_) (\<lfloor>x___outer_world\<rfloor>))) (_) (_)) \<Rightarrow> (f (x___outer_world)) - | (mk\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t ((mk\<E>\<X>\<T>\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (person))) (_) (_)) \<Rightarrow> (select\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__outer_world (f) (person)))" - -(* 125 ************************************ 732 + 0 *) (* term Floor1_access.print_access_select_obj *) - -(* 126 ************************************ 732 + 14 *) (* term Floor1_access.print_access_dot_consts *) -consts dot_0___boss :: "(\<AA>, '\<alpha>) val \<Rightarrow> \<cdot>Person" ("(_) .boss") -consts dot_0___bossat_pre :: "(\<AA>, '\<alpha>) val \<Rightarrow> \<cdot>Person" ("(_) .boss@pre") -consts dot__salary :: "(\<AA>, '\<alpha>) val \<Rightarrow> Integer" ("(_) .salary") -consts dot__salaryat_pre :: "(\<AA>, '\<alpha>) val \<Rightarrow> Integer" ("(_) .salary@pre") -consts dot__wormhole :: "(\<AA>, '\<alpha>) val \<Rightarrow> (\<AA>, nat option option) val" ("(_) .wormhole") -consts dot__wormholeat_pre :: "(\<AA>, '\<alpha>) val \<Rightarrow> (\<AA>, nat option option) val" ("(_) .wormhole@pre") -consts dot__weight :: "(\<AA>, '\<alpha>) val \<Rightarrow> Integer" ("(_) .weight") -consts dot__weightat_pre :: "(\<AA>, '\<alpha>) val \<Rightarrow> Integer" ("(_) .weight@pre") -consts dot__sound :: "(\<AA>, '\<alpha>) val \<Rightarrow> Void" ("(_) .sound") -consts dot__soundat_pre :: "(\<AA>, '\<alpha>) val \<Rightarrow> Void" ("(_) .sound@pre") -consts dot__moving :: "(\<AA>, '\<alpha>) val \<Rightarrow> Boolean" ("(_) .moving") -consts dot__movingat_pre :: "(\<AA>, '\<alpha>) val \<Rightarrow> Boolean" ("(_) .moving@pre") -consts dot__outer_world :: "(\<AA>, '\<alpha>) val \<Rightarrow> Set_Sequence_Planet" ("(_) .outer'_world") -consts dot__outer_worldat_pre :: "(\<AA>, '\<alpha>) val \<Rightarrow> Set_Sequence_Planet" ("(_) .outer'_world@pre") - -(* 127 ************************************ 746 + 30 *) (* term Floor1_access.print_access_dot *) -overloading dot_0___boss \<equiv> "(dot_0___boss::(\<cdot>Person) \<Rightarrow> _)" -begin - definition dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_0___boss : "(x::\<cdot>Person) .boss \<equiv> (eval_extract (x) ((deref_oid\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (in_post_state) ((select\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__boss ((select_object_any\<^sub>S\<^sub>e\<^sub>t ((deref_oid\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (in_post_state) (reconst_basetype))))))))))" -end -overloading dot__salary \<equiv> "(dot__salary::(\<cdot>Person) \<Rightarrow> _)" -begin - definition dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__salary : "(x::\<cdot>Person) .salary \<equiv> (eval_extract (x) ((deref_oid\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (in_post_state) ((select\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__salary (reconst_basetype))))))" -end -overloading dot_0___bossat_pre \<equiv> "(dot_0___bossat_pre::(\<cdot>Person) \<Rightarrow> _)" -begin - definition dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_0___bossat_pre : "(x::\<cdot>Person) .boss@pre \<equiv> (eval_extract (x) ((deref_oid\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (in_pre_state) ((select\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__boss ((select_object_any\<^sub>S\<^sub>e\<^sub>t ((deref_oid\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (in_pre_state) (reconst_basetype))))))))))" -end -overloading dot__salaryat_pre \<equiv> "(dot__salaryat_pre::(\<cdot>Person) \<Rightarrow> _)" -begin - definition dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__salaryat_pre : "(x::\<cdot>Person) .salary@pre \<equiv> (eval_extract (x) ((deref_oid\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (in_pre_state) ((select\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__salary (reconst_basetype))))))" -end -overloading dot__wormhole \<equiv> "(dot__wormhole::(\<cdot>Planet) \<Rightarrow> _)" -begin - definition dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__wormhole : "(x::\<cdot>Planet) .wormhole \<equiv> (eval_extract (x) ((deref_oid\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (in_post_state) ((select\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__wormhole (reconst_basetype))))))" -end -overloading dot__weight \<equiv> "(dot__weight::(\<cdot>Planet) \<Rightarrow> _)" -begin - definition dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__weight : "(x::\<cdot>Planet) .weight \<equiv> (eval_extract (x) ((deref_oid\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (in_post_state) ((select\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__weight (reconst_basetype))))))" -end -overloading dot__wormholeat_pre \<equiv> "(dot__wormholeat_pre::(\<cdot>Planet) \<Rightarrow> _)" -begin - definition dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__wormholeat_pre : "(x::\<cdot>Planet) .wormhole@pre \<equiv> (eval_extract (x) ((deref_oid\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (in_pre_state) ((select\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__wormhole (reconst_basetype))))))" -end -overloading dot__weightat_pre \<equiv> "(dot__weightat_pre::(\<cdot>Planet) \<Rightarrow> _)" -begin - definition dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__weightat_pre : "(x::\<cdot>Planet) .weight@pre \<equiv> (eval_extract (x) ((deref_oid\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (in_pre_state) ((select\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__weight (reconst_basetype))))))" -end -overloading dot__sound \<equiv> "(dot__sound::(\<cdot>Galaxy) \<Rightarrow> _)" -begin - definition dot\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y__sound : "(x::\<cdot>Galaxy) .sound \<equiv> (eval_extract (x) ((deref_oid\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y (in_post_state) ((select\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y__sound (reconst_basetype\<^sub>V\<^sub>o\<^sub>i\<^sub>d))))))" -end -overloading dot__moving \<equiv> "(dot__moving::(\<cdot>Galaxy) \<Rightarrow> _)" -begin - definition dot\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y__moving : "(x::\<cdot>Galaxy) .moving \<equiv> (eval_extract (x) ((deref_oid\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y (in_post_state) ((select\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y__moving (reconst_basetype))))))" -end -overloading dot__outer_world \<equiv> "(dot__outer_world::(\<cdot>Galaxy) \<Rightarrow> _)" -begin - definition dot\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y__outer_world : "(x::\<cdot>Galaxy) .outer_world \<equiv> (eval_extract (x) ((deref_oid\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y (in_post_state) ((select\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y__outer_world ((select_object\<^sub>S\<^sub>e\<^sub>t ((select_object\<^sub>S\<^sub>e\<^sub>q ((deref_oid\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (in_post_state) (reconst_basetype))))))))))))" -end -overloading dot__soundat_pre \<equiv> "(dot__soundat_pre::(\<cdot>Galaxy) \<Rightarrow> _)" -begin - definition dot\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y__soundat_pre : "(x::\<cdot>Galaxy) .sound@pre \<equiv> (eval_extract (x) ((deref_oid\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y (in_pre_state) ((select\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y__sound (reconst_basetype\<^sub>V\<^sub>o\<^sub>i\<^sub>d))))))" -end -overloading dot__movingat_pre \<equiv> "(dot__movingat_pre::(\<cdot>Galaxy) \<Rightarrow> _)" -begin - definition dot\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y__movingat_pre : "(x::\<cdot>Galaxy) .moving@pre \<equiv> (eval_extract (x) ((deref_oid\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y (in_pre_state) ((select\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y__moving (reconst_basetype))))))" -end -overloading dot__outer_worldat_pre \<equiv> "(dot__outer_worldat_pre::(\<cdot>Galaxy) \<Rightarrow> _)" -begin - definition dot\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y__outer_worldat_pre : "(x::\<cdot>Galaxy) .outer_world@pre \<equiv> (eval_extract (x) ((deref_oid\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y (in_pre_state) ((select\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y__outer_world ((select_object\<^sub>S\<^sub>e\<^sub>t ((select_object\<^sub>S\<^sub>e\<^sub>q ((deref_oid\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (in_pre_state) (reconst_basetype))))))))))))" -end -overloading dot__wormhole \<equiv> "(dot__wormhole::(\<cdot>Person) \<Rightarrow> _)" -begin - definition dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__wormhole : "(x::\<cdot>Person) .wormhole \<equiv> (eval_extract (x) ((deref_oid\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (in_post_state) ((select\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__wormhole (reconst_basetype))))))" -end -overloading dot__weight \<equiv> "(dot__weight::(\<cdot>Person) \<Rightarrow> _)" -begin - definition dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__weight : "(x::\<cdot>Person) .weight \<equiv> (eval_extract (x) ((deref_oid\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (in_post_state) ((select\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__weight (reconst_basetype))))))" -end -overloading dot__sound \<equiv> "(dot__sound::(\<cdot>Person) \<Rightarrow> _)" -begin - definition dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__sound : "(x::\<cdot>Person) .sound \<equiv> (eval_extract (x) ((deref_oid\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (in_post_state) ((select\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__sound (reconst_basetype\<^sub>V\<^sub>o\<^sub>i\<^sub>d))))))" -end -overloading dot__moving \<equiv> "(dot__moving::(\<cdot>Person) \<Rightarrow> _)" -begin - definition dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__moving : "(x::\<cdot>Person) .moving \<equiv> (eval_extract (x) ((deref_oid\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (in_post_state) ((select\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__moving (reconst_basetype))))))" -end -overloading dot__outer_world \<equiv> "(dot__outer_world::(\<cdot>Person) \<Rightarrow> _)" -begin - definition dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__outer_world : "(x::\<cdot>Person) .outer_world \<equiv> (eval_extract (x) ((deref_oid\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (in_post_state) ((select\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__outer_world ((select_object\<^sub>S\<^sub>e\<^sub>t ((select_object\<^sub>S\<^sub>e\<^sub>q ((deref_oid\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (in_post_state) (reconst_basetype))))))))))))" -end -overloading dot__wormholeat_pre \<equiv> "(dot__wormholeat_pre::(\<cdot>Person) \<Rightarrow> _)" -begin - definition dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__wormholeat_pre : "(x::\<cdot>Person) .wormhole@pre \<equiv> (eval_extract (x) ((deref_oid\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (in_pre_state) ((select\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__wormhole (reconst_basetype))))))" -end -overloading dot__weightat_pre \<equiv> "(dot__weightat_pre::(\<cdot>Person) \<Rightarrow> _)" -begin - definition dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__weightat_pre : "(x::\<cdot>Person) .weight@pre \<equiv> (eval_extract (x) ((deref_oid\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (in_pre_state) ((select\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__weight (reconst_basetype))))))" -end -overloading dot__soundat_pre \<equiv> "(dot__soundat_pre::(\<cdot>Person) \<Rightarrow> _)" -begin - definition dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__soundat_pre : "(x::\<cdot>Person) .sound@pre \<equiv> (eval_extract (x) ((deref_oid\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (in_pre_state) ((select\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__sound (reconst_basetype\<^sub>V\<^sub>o\<^sub>i\<^sub>d))))))" -end -overloading dot__movingat_pre \<equiv> "(dot__movingat_pre::(\<cdot>Person) \<Rightarrow> _)" -begin - definition dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__movingat_pre : "(x::\<cdot>Person) .moving@pre \<equiv> (eval_extract (x) ((deref_oid\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (in_pre_state) ((select\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__moving (reconst_basetype))))))" -end -overloading dot__outer_worldat_pre \<equiv> "(dot__outer_worldat_pre::(\<cdot>Person) \<Rightarrow> _)" -begin - definition dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__outer_worldat_pre : "(x::\<cdot>Person) .outer_world@pre \<equiv> (eval_extract (x) ((deref_oid\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (in_pre_state) ((select\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__outer_world ((select_object\<^sub>S\<^sub>e\<^sub>t ((select_object\<^sub>S\<^sub>e\<^sub>q ((deref_oid\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (in_pre_state) (reconst_basetype))))))))))))" -end -overloading dot__sound \<equiv> "(dot__sound::(\<cdot>Planet) \<Rightarrow> _)" -begin - definition dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__sound : "(x::\<cdot>Planet) .sound \<equiv> (eval_extract (x) ((deref_oid\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (in_post_state) ((select\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__sound (reconst_basetype\<^sub>V\<^sub>o\<^sub>i\<^sub>d))))))" -end -overloading dot__moving \<equiv> "(dot__moving::(\<cdot>Planet) \<Rightarrow> _)" -begin - definition dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__moving : "(x::\<cdot>Planet) .moving \<equiv> (eval_extract (x) ((deref_oid\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (in_post_state) ((select\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__moving (reconst_basetype))))))" -end -overloading dot__outer_world \<equiv> "(dot__outer_world::(\<cdot>Planet) \<Rightarrow> _)" -begin - definition dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__outer_world : "(x::\<cdot>Planet) .outer_world \<equiv> (eval_extract (x) ((deref_oid\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (in_post_state) ((select\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__outer_world ((select_object\<^sub>S\<^sub>e\<^sub>t ((select_object\<^sub>S\<^sub>e\<^sub>q ((deref_oid\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (in_post_state) (reconst_basetype))))))))))))" -end -overloading dot__soundat_pre \<equiv> "(dot__soundat_pre::(\<cdot>Planet) \<Rightarrow> _)" -begin - definition dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__soundat_pre : "(x::\<cdot>Planet) .sound@pre \<equiv> (eval_extract (x) ((deref_oid\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (in_pre_state) ((select\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__sound (reconst_basetype\<^sub>V\<^sub>o\<^sub>i\<^sub>d))))))" -end -overloading dot__movingat_pre \<equiv> "(dot__movingat_pre::(\<cdot>Planet) \<Rightarrow> _)" -begin - definition dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__movingat_pre : "(x::\<cdot>Planet) .moving@pre \<equiv> (eval_extract (x) ((deref_oid\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (in_pre_state) ((select\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__moving (reconst_basetype))))))" -end -overloading dot__outer_worldat_pre \<equiv> "(dot__outer_worldat_pre::(\<cdot>Planet) \<Rightarrow> _)" -begin - definition dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__outer_worldat_pre : "(x::\<cdot>Planet) .outer_world@pre \<equiv> (eval_extract (x) ((deref_oid\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (in_pre_state) ((select\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__outer_world ((select_object\<^sub>S\<^sub>e\<^sub>t ((select_object\<^sub>S\<^sub>e\<^sub>q ((deref_oid\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (in_pre_state) (reconst_basetype))))))))))))" -end - -(* 128 ************************************ 776 + 1 *) (* term Floor1_access.print_access_dot_lemmas_id *) -lemmas dot_accessor = dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_0___boss - dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__salary - dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_0___bossat_pre - dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__salaryat_pre - dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__wormhole - dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__weight - dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__wormholeat_pre - dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__weightat_pre - dot\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y__sound - dot\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y__moving - dot\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y__outer_world - dot\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y__soundat_pre - dot\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y__movingat_pre - dot\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y__outer_worldat_pre - dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__wormhole - dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__weight - dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__sound - dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__moving - dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__outer_world - dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__wormholeat_pre - dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__weightat_pre - dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__soundat_pre - dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__movingat_pre - dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__outer_worldat_pre - dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__sound - dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__moving - dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__outer_world - dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__soundat_pre - dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__movingat_pre - dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__outer_worldat_pre - -(* 129 ************************************ 777 + 1 *) -subsection \<open>Context Passing\<close> - -(* 130 ************************************ 778 + 1 *) (* term Floor1_access.print_access_dot_cp_lemmas *) -lemmas[simp,code_unfold] = eval_extract_def - -(* 131 ************************************ 779 + 30 *) (* term Floor1_access.print_access_dot_lemma_cp *) -lemma cp_dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_0___boss : "(cp ((\<lambda>X. (X::\<cdot>Person) .boss)))" -by(auto simp: dot_accessor cp_def) -lemma cp_dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__salary : "(cp ((\<lambda>X. (X::\<cdot>Person) .salary)))" -by(auto simp: dot_accessor cp_def) -lemma cp_dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_0___bossat_pre : "(cp ((\<lambda>X. (X::\<cdot>Person) .boss@pre)))" -by(auto simp: dot_accessor cp_def) -lemma cp_dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__salaryat_pre : "(cp ((\<lambda>X. (X::\<cdot>Person) .salary@pre)))" -by(auto simp: dot_accessor cp_def) -lemma cp_dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__wormhole : "(cp ((\<lambda>X. (X::\<cdot>Planet) .wormhole)))" -by(auto simp: dot_accessor cp_def) -lemma cp_dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__weight : "(cp ((\<lambda>X. (X::\<cdot>Planet) .weight)))" -by(auto simp: dot_accessor cp_def) -lemma cp_dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__wormholeat_pre : "(cp ((\<lambda>X. (X::\<cdot>Planet) .wormhole@pre)))" -by(auto simp: dot_accessor cp_def) -lemma cp_dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__weightat_pre : "(cp ((\<lambda>X. (X::\<cdot>Planet) .weight@pre)))" -by(auto simp: dot_accessor cp_def) -lemma cp_dot\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y__sound : "(cp ((\<lambda>X. (X::\<cdot>Galaxy) .sound)))" -by(auto simp: dot_accessor cp_def) -lemma cp_dot\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y__moving : "(cp ((\<lambda>X. (X::\<cdot>Galaxy) .moving)))" -by(auto simp: dot_accessor cp_def) -lemma cp_dot\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y__outer_world : "(cp ((\<lambda>X. (X::\<cdot>Galaxy) .outer_world)))" -by(auto simp: dot_accessor cp_def) -lemma cp_dot\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y__soundat_pre : "(cp ((\<lambda>X. (X::\<cdot>Galaxy) .sound@pre)))" -by(auto simp: dot_accessor cp_def) -lemma cp_dot\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y__movingat_pre : "(cp ((\<lambda>X. (X::\<cdot>Galaxy) .moving@pre)))" -by(auto simp: dot_accessor cp_def) -lemma cp_dot\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y__outer_worldat_pre : "(cp ((\<lambda>X. (X::\<cdot>Galaxy) .outer_world@pre)))" -by(auto simp: dot_accessor cp_def) -lemma cp_dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__wormhole : "(cp ((\<lambda>X. (X::\<cdot>Person) .wormhole)))" -by(auto simp: dot_accessor cp_def) -lemma cp_dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__weight : "(cp ((\<lambda>X. (X::\<cdot>Person) .weight)))" -by(auto simp: dot_accessor cp_def) -lemma cp_dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__sound : "(cp ((\<lambda>X. (X::\<cdot>Person) .sound)))" -by(auto simp: dot_accessor cp_def) -lemma cp_dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__moving : "(cp ((\<lambda>X. (X::\<cdot>Person) .moving)))" -by(auto simp: dot_accessor cp_def) -lemma cp_dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__outer_world : "(cp ((\<lambda>X. (X::\<cdot>Person) .outer_world)))" -by(auto simp: dot_accessor cp_def) -lemma cp_dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__wormholeat_pre : "(cp ((\<lambda>X. (X::\<cdot>Person) .wormhole@pre)))" -by(auto simp: dot_accessor cp_def) -lemma cp_dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__weightat_pre : "(cp ((\<lambda>X. (X::\<cdot>Person) .weight@pre)))" -by(auto simp: dot_accessor cp_def) -lemma cp_dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__soundat_pre : "(cp ((\<lambda>X. (X::\<cdot>Person) .sound@pre)))" -by(auto simp: dot_accessor cp_def) -lemma cp_dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__movingat_pre : "(cp ((\<lambda>X. (X::\<cdot>Person) .moving@pre)))" -by(auto simp: dot_accessor cp_def) -lemma cp_dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__outer_worldat_pre : "(cp ((\<lambda>X. (X::\<cdot>Person) .outer_world@pre)))" -by(auto simp: dot_accessor cp_def) -lemma cp_dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__sound : "(cp ((\<lambda>X. (X::\<cdot>Planet) .sound)))" -by(auto simp: dot_accessor cp_def) -lemma cp_dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__moving : "(cp ((\<lambda>X. (X::\<cdot>Planet) .moving)))" -by(auto simp: dot_accessor cp_def) -lemma cp_dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__outer_world : "(cp ((\<lambda>X. (X::\<cdot>Planet) .outer_world)))" -by(auto simp: dot_accessor cp_def) -lemma cp_dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__soundat_pre : "(cp ((\<lambda>X. (X::\<cdot>Planet) .sound@pre)))" -by(auto simp: dot_accessor cp_def) -lemma cp_dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__movingat_pre : "(cp ((\<lambda>X. (X::\<cdot>Planet) .moving@pre)))" -by(auto simp: dot_accessor cp_def) -lemma cp_dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__outer_worldat_pre : "(cp ((\<lambda>X. (X::\<cdot>Planet) .outer_world@pre)))" -by(auto simp: dot_accessor cp_def) - -(* 132 ************************************ 809 + 1 *) (* term Floor1_access.print_access_dot_lemmas_cp *) -lemmas[simp,code_unfold] = cp_dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_0___boss - cp_dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__salary - cp_dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_0___bossat_pre - cp_dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__salaryat_pre - cp_dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__wormhole - cp_dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__weight - cp_dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__wormholeat_pre - cp_dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__weightat_pre - cp_dot\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y__sound - cp_dot\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y__moving - cp_dot\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y__outer_world - cp_dot\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y__soundat_pre - cp_dot\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y__movingat_pre - cp_dot\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y__outer_worldat_pre - cp_dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__wormhole - cp_dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__weight - cp_dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__sound - cp_dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__moving - cp_dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__outer_world - cp_dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__wormholeat_pre - cp_dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__weightat_pre - cp_dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__soundat_pre - cp_dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__movingat_pre - cp_dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__outer_worldat_pre - cp_dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__sound - cp_dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__moving - cp_dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__outer_world - cp_dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__soundat_pre - cp_dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__movingat_pre - cp_dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__outer_worldat_pre - -(* 133 ************************************ 810 + 1 *) -subsection \<open>Execution with Invalid or Null as Argument\<close> - -(* 134 ************************************ 811 + 60 *) (* term Floor1_access.print_access_lemma_strict *) -lemma dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_0___boss_invalid : "(invalid::\<cdot>Person) .boss = invalid" -by(rule ext, simp add: dot_accessor bot_option_def invalid_def) -lemma dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_0___boss_null : "(null::\<cdot>Person) .boss = invalid" -by(rule ext, simp add: dot_accessor bot_option_def null_fun_def null_option_def) -lemma dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__salary_invalid : "(invalid::\<cdot>Person) .salary = invalid" -by(rule ext, simp add: dot_accessor bot_option_def invalid_def) -lemma dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__salary_null : "(null::\<cdot>Person) .salary = invalid" -by(rule ext, simp add: dot_accessor bot_option_def null_fun_def null_option_def) -lemma dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_0___bossat_pre_invalid : "(invalid::\<cdot>Person) .boss@pre = invalid" -by(rule ext, simp add: dot_accessor bot_option_def invalid_def) -lemma dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_0___bossat_pre_null : "(null::\<cdot>Person) .boss@pre = invalid" -by(rule ext, simp add: dot_accessor bot_option_def null_fun_def null_option_def) -lemma dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__salaryat_pre_invalid : "(invalid::\<cdot>Person) .salary@pre = invalid" -by(rule ext, simp add: dot_accessor bot_option_def invalid_def) -lemma dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__salaryat_pre_null : "(null::\<cdot>Person) .salary@pre = invalid" -by(rule ext, simp add: dot_accessor bot_option_def null_fun_def null_option_def) -lemma dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__wormhole_invalid : "(invalid::\<cdot>Planet) .wormhole = invalid" -by(rule ext, simp add: dot_accessor bot_option_def invalid_def) -lemma dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__wormhole_null : "(null::\<cdot>Planet) .wormhole = invalid" -by(rule ext, simp add: dot_accessor bot_option_def null_fun_def null_option_def) -lemma dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__weight_invalid : "(invalid::\<cdot>Planet) .weight = invalid" -by(rule ext, simp add: dot_accessor bot_option_def invalid_def) -lemma dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__weight_null : "(null::\<cdot>Planet) .weight = invalid" -by(rule ext, simp add: dot_accessor bot_option_def null_fun_def null_option_def) -lemma dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__wormholeat_pre_invalid : "(invalid::\<cdot>Planet) .wormhole@pre = invalid" -by(rule ext, simp add: dot_accessor bot_option_def invalid_def) -lemma dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__wormholeat_pre_null : "(null::\<cdot>Planet) .wormhole@pre = invalid" -by(rule ext, simp add: dot_accessor bot_option_def null_fun_def null_option_def) -lemma dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__weightat_pre_invalid : "(invalid::\<cdot>Planet) .weight@pre = invalid" -by(rule ext, simp add: dot_accessor bot_option_def invalid_def) -lemma dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__weightat_pre_null : "(null::\<cdot>Planet) .weight@pre = invalid" -by(rule ext, simp add: dot_accessor bot_option_def null_fun_def null_option_def) -lemma dot\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y__sound_invalid : "(invalid::\<cdot>Galaxy) .sound = invalid" -by(rule ext, simp add: dot_accessor bot_option_def invalid_def) -lemma dot\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y__sound_null : "(null::\<cdot>Galaxy) .sound = invalid" -by(rule ext, simp add: dot_accessor bot_option_def null_fun_def null_option_def) -lemma dot\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y__moving_invalid : "(invalid::\<cdot>Galaxy) .moving = invalid" -by(rule ext, simp add: dot_accessor bot_option_def invalid_def) -lemma dot\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y__moving_null : "(null::\<cdot>Galaxy) .moving = invalid" -by(rule ext, simp add: dot_accessor bot_option_def null_fun_def null_option_def) -lemma dot\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y__outer_world_invalid : "(invalid::\<cdot>Galaxy) .outer_world = invalid" -by(rule ext, simp add: dot_accessor bot_option_def invalid_def) -lemma dot\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y__outer_world_null : "(null::\<cdot>Galaxy) .outer_world = invalid" -by(rule ext, simp add: dot_accessor bot_option_def null_fun_def null_option_def) -lemma dot\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y__soundat_pre_invalid : "(invalid::\<cdot>Galaxy) .sound@pre = invalid" -by(rule ext, simp add: dot_accessor bot_option_def invalid_def) -lemma dot\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y__soundat_pre_null : "(null::\<cdot>Galaxy) .sound@pre = invalid" -by(rule ext, simp add: dot_accessor bot_option_def null_fun_def null_option_def) -lemma dot\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y__movingat_pre_invalid : "(invalid::\<cdot>Galaxy) .moving@pre = invalid" -by(rule ext, simp add: dot_accessor bot_option_def invalid_def) -lemma dot\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y__movingat_pre_null : "(null::\<cdot>Galaxy) .moving@pre = invalid" -by(rule ext, simp add: dot_accessor bot_option_def null_fun_def null_option_def) -lemma dot\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y__outer_worldat_pre_invalid : "(invalid::\<cdot>Galaxy) .outer_world@pre = invalid" -by(rule ext, simp add: dot_accessor bot_option_def invalid_def) -lemma dot\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y__outer_worldat_pre_null : "(null::\<cdot>Galaxy) .outer_world@pre = invalid" -by(rule ext, simp add: dot_accessor bot_option_def null_fun_def null_option_def) -lemma dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__wormhole_invalid : "(invalid::\<cdot>Person) .wormhole = invalid" -by(rule ext, simp add: dot_accessor bot_option_def invalid_def) -lemma dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__wormhole_null : "(null::\<cdot>Person) .wormhole = invalid" -by(rule ext, simp add: dot_accessor bot_option_def null_fun_def null_option_def) -lemma dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__weight_invalid : "(invalid::\<cdot>Person) .weight = invalid" -by(rule ext, simp add: dot_accessor bot_option_def invalid_def) -lemma dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__weight_null : "(null::\<cdot>Person) .weight = invalid" -by(rule ext, simp add: dot_accessor bot_option_def null_fun_def null_option_def) -lemma dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__sound_invalid : "(invalid::\<cdot>Person) .sound = invalid" -by(rule ext, simp add: dot_accessor bot_option_def invalid_def) -lemma dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__sound_null : "(null::\<cdot>Person) .sound = invalid" -by(rule ext, simp add: dot_accessor bot_option_def null_fun_def null_option_def) -lemma dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__moving_invalid : "(invalid::\<cdot>Person) .moving = invalid" -by(rule ext, simp add: dot_accessor bot_option_def invalid_def) -lemma dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__moving_null : "(null::\<cdot>Person) .moving = invalid" -by(rule ext, simp add: dot_accessor bot_option_def null_fun_def null_option_def) -lemma dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__outer_world_invalid : "(invalid::\<cdot>Person) .outer_world = invalid" -by(rule ext, simp add: dot_accessor bot_option_def invalid_def) -lemma dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__outer_world_null : "(null::\<cdot>Person) .outer_world = invalid" -by(rule ext, simp add: dot_accessor bot_option_def null_fun_def null_option_def) -lemma dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__wormholeat_pre_invalid : "(invalid::\<cdot>Person) .wormhole@pre = invalid" -by(rule ext, simp add: dot_accessor bot_option_def invalid_def) -lemma dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__wormholeat_pre_null : "(null::\<cdot>Person) .wormhole@pre = invalid" -by(rule ext, simp add: dot_accessor bot_option_def null_fun_def null_option_def) -lemma dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__weightat_pre_invalid : "(invalid::\<cdot>Person) .weight@pre = invalid" -by(rule ext, simp add: dot_accessor bot_option_def invalid_def) -lemma dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__weightat_pre_null : "(null::\<cdot>Person) .weight@pre = invalid" -by(rule ext, simp add: dot_accessor bot_option_def null_fun_def null_option_def) -lemma dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__soundat_pre_invalid : "(invalid::\<cdot>Person) .sound@pre = invalid" -by(rule ext, simp add: dot_accessor bot_option_def invalid_def) -lemma dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__soundat_pre_null : "(null::\<cdot>Person) .sound@pre = invalid" -by(rule ext, simp add: dot_accessor bot_option_def null_fun_def null_option_def) -lemma dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__movingat_pre_invalid : "(invalid::\<cdot>Person) .moving@pre = invalid" -by(rule ext, simp add: dot_accessor bot_option_def invalid_def) -lemma dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__movingat_pre_null : "(null::\<cdot>Person) .moving@pre = invalid" -by(rule ext, simp add: dot_accessor bot_option_def null_fun_def null_option_def) -lemma dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__outer_worldat_pre_invalid : "(invalid::\<cdot>Person) .outer_world@pre = invalid" -by(rule ext, simp add: dot_accessor bot_option_def invalid_def) -lemma dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__outer_worldat_pre_null : "(null::\<cdot>Person) .outer_world@pre = invalid" -by(rule ext, simp add: dot_accessor bot_option_def null_fun_def null_option_def) -lemma dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__sound_invalid : "(invalid::\<cdot>Planet) .sound = invalid" -by(rule ext, simp add: dot_accessor bot_option_def invalid_def) -lemma dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__sound_null : "(null::\<cdot>Planet) .sound = invalid" -by(rule ext, simp add: dot_accessor bot_option_def null_fun_def null_option_def) -lemma dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__moving_invalid : "(invalid::\<cdot>Planet) .moving = invalid" -by(rule ext, simp add: dot_accessor bot_option_def invalid_def) -lemma dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__moving_null : "(null::\<cdot>Planet) .moving = invalid" -by(rule ext, simp add: dot_accessor bot_option_def null_fun_def null_option_def) -lemma dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__outer_world_invalid : "(invalid::\<cdot>Planet) .outer_world = invalid" -by(rule ext, simp add: dot_accessor bot_option_def invalid_def) -lemma dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__outer_world_null : "(null::\<cdot>Planet) .outer_world = invalid" -by(rule ext, simp add: dot_accessor bot_option_def null_fun_def null_option_def) -lemma dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__soundat_pre_invalid : "(invalid::\<cdot>Planet) .sound@pre = invalid" -by(rule ext, simp add: dot_accessor bot_option_def invalid_def) -lemma dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__soundat_pre_null : "(null::\<cdot>Planet) .sound@pre = invalid" -by(rule ext, simp add: dot_accessor bot_option_def null_fun_def null_option_def) -lemma dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__movingat_pre_invalid : "(invalid::\<cdot>Planet) .moving@pre = invalid" -by(rule ext, simp add: dot_accessor bot_option_def invalid_def) -lemma dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__movingat_pre_null : "(null::\<cdot>Planet) .moving@pre = invalid" -by(rule ext, simp add: dot_accessor bot_option_def null_fun_def null_option_def) -lemma dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__outer_worldat_pre_invalid : "(invalid::\<cdot>Planet) .outer_world@pre = invalid" -by(rule ext, simp add: dot_accessor bot_option_def invalid_def) -lemma dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__outer_worldat_pre_null : "(null::\<cdot>Planet) .outer_world@pre = invalid" -by(rule ext, simp add: dot_accessor bot_option_def null_fun_def null_option_def) - -(* 135 ************************************ 871 + 1 *) -subsection \<open>Representation in States\<close> - -(* 136 ************************************ 872 + 30 *) (* term Floor1_access.print_access_def_mono *) -lemma defined_mono_dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_0___boss : "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Person) .boss)) \<Longrightarrow> \<tau> \<Turnstile> (\<delta> (X))" - apply(case_tac "\<tau> \<Turnstile> (X \<triangleq> invalid)", insert StrongEq_L_subst2[where P = "(\<lambda>x. (\<delta> (x .boss)))" and \<tau> = "\<tau>" and x = "X" and y = "invalid"], simp add: foundation16' dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_0___boss_invalid) - apply(case_tac "\<tau> \<Turnstile> (X \<triangleq> null)", insert StrongEq_L_subst2[where P = "(\<lambda>x. (\<delta> (x .boss)))" and \<tau> = "\<tau>" and x = "X" and y = "null"], simp add: foundation16' dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_0___boss_null) -by(simp add: defined_split) -lemma defined_mono_dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__salary : "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Person) .salary)) \<Longrightarrow> \<tau> \<Turnstile> (\<delta> (X))" - apply(case_tac "\<tau> \<Turnstile> (X \<triangleq> invalid)", insert StrongEq_L_subst2[where P = "(\<lambda>x. (\<delta> (x .salary)))" and \<tau> = "\<tau>" and x = "X" and y = "invalid"], simp add: foundation16' dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__salary_invalid) - apply(case_tac "\<tau> \<Turnstile> (X \<triangleq> null)", insert StrongEq_L_subst2[where P = "(\<lambda>x. (\<delta> (x .salary)))" and \<tau> = "\<tau>" and x = "X" and y = "null"], simp add: foundation16' dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__salary_null) -by(simp add: defined_split) -lemma defined_mono_dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_0___bossat_pre : "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Person) .boss@pre)) \<Longrightarrow> \<tau> \<Turnstile> (\<delta> (X))" - apply(case_tac "\<tau> \<Turnstile> (X \<triangleq> invalid)", insert StrongEq_L_subst2[where P = "(\<lambda>x. (\<delta> (x .boss@pre)))" and \<tau> = "\<tau>" and x = "X" and y = "invalid"], simp add: foundation16' dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_0___bossat_pre_invalid) - apply(case_tac "\<tau> \<Turnstile> (X \<triangleq> null)", insert StrongEq_L_subst2[where P = "(\<lambda>x. (\<delta> (x .boss@pre)))" and \<tau> = "\<tau>" and x = "X" and y = "null"], simp add: foundation16' dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_0___bossat_pre_null) -by(simp add: defined_split) -lemma defined_mono_dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__salaryat_pre : "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Person) .salary@pre)) \<Longrightarrow> \<tau> \<Turnstile> (\<delta> (X))" - apply(case_tac "\<tau> \<Turnstile> (X \<triangleq> invalid)", insert StrongEq_L_subst2[where P = "(\<lambda>x. (\<delta> (x .salary@pre)))" and \<tau> = "\<tau>" and x = "X" and y = "invalid"], simp add: foundation16' dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__salaryat_pre_invalid) - apply(case_tac "\<tau> \<Turnstile> (X \<triangleq> null)", insert StrongEq_L_subst2[where P = "(\<lambda>x. (\<delta> (x .salary@pre)))" and \<tau> = "\<tau>" and x = "X" and y = "null"], simp add: foundation16' dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__salaryat_pre_null) -by(simp add: defined_split) -lemma defined_mono_dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__wormhole : "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Planet) .wormhole)) \<Longrightarrow> \<tau> \<Turnstile> (\<delta> (X))" - apply(case_tac "\<tau> \<Turnstile> (X \<triangleq> invalid)", insert StrongEq_L_subst2[where P = "(\<lambda>x. (\<delta> (x .wormhole)))" and \<tau> = "\<tau>" and x = "X" and y = "invalid"], simp add: foundation16' dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__wormhole_invalid) - apply(case_tac "\<tau> \<Turnstile> (X \<triangleq> null)", insert StrongEq_L_subst2[where P = "(\<lambda>x. (\<delta> (x .wormhole)))" and \<tau> = "\<tau>" and x = "X" and y = "null"], simp add: foundation16' dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__wormhole_null) -by(simp add: defined_split) -lemma defined_mono_dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__weight : "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Planet) .weight)) \<Longrightarrow> \<tau> \<Turnstile> (\<delta> (X))" - apply(case_tac "\<tau> \<Turnstile> (X \<triangleq> invalid)", insert StrongEq_L_subst2[where P = "(\<lambda>x. (\<delta> (x .weight)))" and \<tau> = "\<tau>" and x = "X" and y = "invalid"], simp add: foundation16' dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__weight_invalid) - apply(case_tac "\<tau> \<Turnstile> (X \<triangleq> null)", insert StrongEq_L_subst2[where P = "(\<lambda>x. (\<delta> (x .weight)))" and \<tau> = "\<tau>" and x = "X" and y = "null"], simp add: foundation16' dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__weight_null) -by(simp add: defined_split) -lemma defined_mono_dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__wormholeat_pre : "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Planet) .wormhole@pre)) \<Longrightarrow> \<tau> \<Turnstile> (\<delta> (X))" - apply(case_tac "\<tau> \<Turnstile> (X \<triangleq> invalid)", insert StrongEq_L_subst2[where P = "(\<lambda>x. (\<delta> (x .wormhole@pre)))" and \<tau> = "\<tau>" and x = "X" and y = "invalid"], simp add: foundation16' dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__wormholeat_pre_invalid) - apply(case_tac "\<tau> \<Turnstile> (X \<triangleq> null)", insert StrongEq_L_subst2[where P = "(\<lambda>x. (\<delta> (x .wormhole@pre)))" and \<tau> = "\<tau>" and x = "X" and y = "null"], simp add: foundation16' dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__wormholeat_pre_null) -by(simp add: defined_split) -lemma defined_mono_dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__weightat_pre : "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Planet) .weight@pre)) \<Longrightarrow> \<tau> \<Turnstile> (\<delta> (X))" - apply(case_tac "\<tau> \<Turnstile> (X \<triangleq> invalid)", insert StrongEq_L_subst2[where P = "(\<lambda>x. (\<delta> (x .weight@pre)))" and \<tau> = "\<tau>" and x = "X" and y = "invalid"], simp add: foundation16' dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__weightat_pre_invalid) - apply(case_tac "\<tau> \<Turnstile> (X \<triangleq> null)", insert StrongEq_L_subst2[where P = "(\<lambda>x. (\<delta> (x .weight@pre)))" and \<tau> = "\<tau>" and x = "X" and y = "null"], simp add: foundation16' dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__weightat_pre_null) -by(simp add: defined_split) -lemma defined_mono_dot\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y__sound : "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Galaxy) .sound)) \<Longrightarrow> \<tau> \<Turnstile> (\<delta> (X))" - apply(case_tac "\<tau> \<Turnstile> (X \<triangleq> invalid)", insert StrongEq_L_subst2[where P = "(\<lambda>x. (\<delta> (x .sound)))" and \<tau> = "\<tau>" and x = "X" and y = "invalid"], simp add: foundation16' dot\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y__sound_invalid) - apply(case_tac "\<tau> \<Turnstile> (X \<triangleq> null)", insert StrongEq_L_subst2[where P = "(\<lambda>x. (\<delta> (x .sound)))" and \<tau> = "\<tau>" and x = "X" and y = "null"], simp add: foundation16' dot\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y__sound_null) -by(simp add: defined_split) -lemma defined_mono_dot\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y__moving : "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Galaxy) .moving)) \<Longrightarrow> \<tau> \<Turnstile> (\<delta> (X))" - apply(case_tac "\<tau> \<Turnstile> (X \<triangleq> invalid)", insert StrongEq_L_subst2[where P = "(\<lambda>x. (\<delta> (x .moving)))" and \<tau> = "\<tau>" and x = "X" and y = "invalid"], simp add: foundation16' dot\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y__moving_invalid) - apply(case_tac "\<tau> \<Turnstile> (X \<triangleq> null)", insert StrongEq_L_subst2[where P = "(\<lambda>x. (\<delta> (x .moving)))" and \<tau> = "\<tau>" and x = "X" and y = "null"], simp add: foundation16' dot\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y__moving_null) -by(simp add: defined_split) -lemma defined_mono_dot\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y__outer_world : "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Galaxy) .outer_world)) \<Longrightarrow> \<tau> \<Turnstile> (\<delta> (X))" - apply(case_tac "\<tau> \<Turnstile> (X \<triangleq> invalid)", insert StrongEq_L_subst2[where P = "(\<lambda>x. (\<delta> (x .outer_world)))" and \<tau> = "\<tau>" and x = "X" and y = "invalid"], simp add: foundation16' dot\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y__outer_world_invalid) - apply(case_tac "\<tau> \<Turnstile> (X \<triangleq> null)", insert StrongEq_L_subst2[where P = "(\<lambda>x. (\<delta> (x .outer_world)))" and \<tau> = "\<tau>" and x = "X" and y = "null"], simp add: foundation16' dot\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y__outer_world_null) -by(simp add: defined_split) -lemma defined_mono_dot\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y__soundat_pre : "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Galaxy) .sound@pre)) \<Longrightarrow> \<tau> \<Turnstile> (\<delta> (X))" - apply(case_tac "\<tau> \<Turnstile> (X \<triangleq> invalid)", insert StrongEq_L_subst2[where P = "(\<lambda>x. (\<delta> (x .sound@pre)))" and \<tau> = "\<tau>" and x = "X" and y = "invalid"], simp add: foundation16' dot\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y__soundat_pre_invalid) - apply(case_tac "\<tau> \<Turnstile> (X \<triangleq> null)", insert StrongEq_L_subst2[where P = "(\<lambda>x. (\<delta> (x .sound@pre)))" and \<tau> = "\<tau>" and x = "X" and y = "null"], simp add: foundation16' dot\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y__soundat_pre_null) -by(simp add: defined_split) -lemma defined_mono_dot\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y__movingat_pre : "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Galaxy) .moving@pre)) \<Longrightarrow> \<tau> \<Turnstile> (\<delta> (X))" - apply(case_tac "\<tau> \<Turnstile> (X \<triangleq> invalid)", insert StrongEq_L_subst2[where P = "(\<lambda>x. (\<delta> (x .moving@pre)))" and \<tau> = "\<tau>" and x = "X" and y = "invalid"], simp add: foundation16' dot\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y__movingat_pre_invalid) - apply(case_tac "\<tau> \<Turnstile> (X \<triangleq> null)", insert StrongEq_L_subst2[where P = "(\<lambda>x. (\<delta> (x .moving@pre)))" and \<tau> = "\<tau>" and x = "X" and y = "null"], simp add: foundation16' dot\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y__movingat_pre_null) -by(simp add: defined_split) -lemma defined_mono_dot\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y__outer_worldat_pre : "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Galaxy) .outer_world@pre)) \<Longrightarrow> \<tau> \<Turnstile> (\<delta> (X))" - apply(case_tac "\<tau> \<Turnstile> (X \<triangleq> invalid)", insert StrongEq_L_subst2[where P = "(\<lambda>x. (\<delta> (x .outer_world@pre)))" and \<tau> = "\<tau>" and x = "X" and y = "invalid"], simp add: foundation16' dot\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y__outer_worldat_pre_invalid) - apply(case_tac "\<tau> \<Turnstile> (X \<triangleq> null)", insert StrongEq_L_subst2[where P = "(\<lambda>x. (\<delta> (x .outer_world@pre)))" and \<tau> = "\<tau>" and x = "X" and y = "null"], simp add: foundation16' dot\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y__outer_worldat_pre_null) -by(simp add: defined_split) -lemma defined_mono_dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__wormhole : "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Person) .wormhole)) \<Longrightarrow> \<tau> \<Turnstile> (\<delta> (X))" - apply(case_tac "\<tau> \<Turnstile> (X \<triangleq> invalid)", insert StrongEq_L_subst2[where P = "(\<lambda>x. (\<delta> (x .wormhole)))" and \<tau> = "\<tau>" and x = "X" and y = "invalid"], simp add: foundation16' dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__wormhole_invalid) - apply(case_tac "\<tau> \<Turnstile> (X \<triangleq> null)", insert StrongEq_L_subst2[where P = "(\<lambda>x. (\<delta> (x .wormhole)))" and \<tau> = "\<tau>" and x = "X" and y = "null"], simp add: foundation16' dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__wormhole_null) -by(simp add: defined_split) -lemma defined_mono_dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__weight : "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Person) .weight)) \<Longrightarrow> \<tau> \<Turnstile> (\<delta> (X))" - apply(case_tac "\<tau> \<Turnstile> (X \<triangleq> invalid)", insert StrongEq_L_subst2[where P = "(\<lambda>x. (\<delta> (x .weight)))" and \<tau> = "\<tau>" and x = "X" and y = "invalid"], simp add: foundation16' dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__weight_invalid) - apply(case_tac "\<tau> \<Turnstile> (X \<triangleq> null)", insert StrongEq_L_subst2[where P = "(\<lambda>x. (\<delta> (x .weight)))" and \<tau> = "\<tau>" and x = "X" and y = "null"], simp add: foundation16' dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__weight_null) -by(simp add: defined_split) -lemma defined_mono_dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__sound : "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Person) .sound)) \<Longrightarrow> \<tau> \<Turnstile> (\<delta> (X))" - apply(case_tac "\<tau> \<Turnstile> (X \<triangleq> invalid)", insert StrongEq_L_subst2[where P = "(\<lambda>x. (\<delta> (x .sound)))" and \<tau> = "\<tau>" and x = "X" and y = "invalid"], simp add: foundation16' dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__sound_invalid) - apply(case_tac "\<tau> \<Turnstile> (X \<triangleq> null)", insert StrongEq_L_subst2[where P = "(\<lambda>x. (\<delta> (x .sound)))" and \<tau> = "\<tau>" and x = "X" and y = "null"], simp add: foundation16' dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__sound_null) -by(simp add: defined_split) -lemma defined_mono_dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__moving : "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Person) .moving)) \<Longrightarrow> \<tau> \<Turnstile> (\<delta> (X))" - apply(case_tac "\<tau> \<Turnstile> (X \<triangleq> invalid)", insert StrongEq_L_subst2[where P = "(\<lambda>x. (\<delta> (x .moving)))" and \<tau> = "\<tau>" and x = "X" and y = "invalid"], simp add: foundation16' dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__moving_invalid) - apply(case_tac "\<tau> \<Turnstile> (X \<triangleq> null)", insert StrongEq_L_subst2[where P = "(\<lambda>x. (\<delta> (x .moving)))" and \<tau> = "\<tau>" and x = "X" and y = "null"], simp add: foundation16' dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__moving_null) -by(simp add: defined_split) -lemma defined_mono_dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__outer_world : "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Person) .outer_world)) \<Longrightarrow> \<tau> \<Turnstile> (\<delta> (X))" - apply(case_tac "\<tau> \<Turnstile> (X \<triangleq> invalid)", insert StrongEq_L_subst2[where P = "(\<lambda>x. (\<delta> (x .outer_world)))" and \<tau> = "\<tau>" and x = "X" and y = "invalid"], simp add: foundation16' dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__outer_world_invalid) - apply(case_tac "\<tau> \<Turnstile> (X \<triangleq> null)", insert StrongEq_L_subst2[where P = "(\<lambda>x. (\<delta> (x .outer_world)))" and \<tau> = "\<tau>" and x = "X" and y = "null"], simp add: foundation16' dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__outer_world_null) -by(simp add: defined_split) -lemma defined_mono_dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__wormholeat_pre : "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Person) .wormhole@pre)) \<Longrightarrow> \<tau> \<Turnstile> (\<delta> (X))" - apply(case_tac "\<tau> \<Turnstile> (X \<triangleq> invalid)", insert StrongEq_L_subst2[where P = "(\<lambda>x. (\<delta> (x .wormhole@pre)))" and \<tau> = "\<tau>" and x = "X" and y = "invalid"], simp add: foundation16' dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__wormholeat_pre_invalid) - apply(case_tac "\<tau> \<Turnstile> (X \<triangleq> null)", insert StrongEq_L_subst2[where P = "(\<lambda>x. (\<delta> (x .wormhole@pre)))" and \<tau> = "\<tau>" and x = "X" and y = "null"], simp add: foundation16' dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__wormholeat_pre_null) -by(simp add: defined_split) -lemma defined_mono_dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__weightat_pre : "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Person) .weight@pre)) \<Longrightarrow> \<tau> \<Turnstile> (\<delta> (X))" - apply(case_tac "\<tau> \<Turnstile> (X \<triangleq> invalid)", insert StrongEq_L_subst2[where P = "(\<lambda>x. (\<delta> (x .weight@pre)))" and \<tau> = "\<tau>" and x = "X" and y = "invalid"], simp add: foundation16' dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__weightat_pre_invalid) - apply(case_tac "\<tau> \<Turnstile> (X \<triangleq> null)", insert StrongEq_L_subst2[where P = "(\<lambda>x. (\<delta> (x .weight@pre)))" and \<tau> = "\<tau>" and x = "X" and y = "null"], simp add: foundation16' dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__weightat_pre_null) -by(simp add: defined_split) -lemma defined_mono_dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__soundat_pre : "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Person) .sound@pre)) \<Longrightarrow> \<tau> \<Turnstile> (\<delta> (X))" - apply(case_tac "\<tau> \<Turnstile> (X \<triangleq> invalid)", insert StrongEq_L_subst2[where P = "(\<lambda>x. (\<delta> (x .sound@pre)))" and \<tau> = "\<tau>" and x = "X" and y = "invalid"], simp add: foundation16' dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__soundat_pre_invalid) - apply(case_tac "\<tau> \<Turnstile> (X \<triangleq> null)", insert StrongEq_L_subst2[where P = "(\<lambda>x. (\<delta> (x .sound@pre)))" and \<tau> = "\<tau>" and x = "X" and y = "null"], simp add: foundation16' dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__soundat_pre_null) -by(simp add: defined_split) -lemma defined_mono_dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__movingat_pre : "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Person) .moving@pre)) \<Longrightarrow> \<tau> \<Turnstile> (\<delta> (X))" - apply(case_tac "\<tau> \<Turnstile> (X \<triangleq> invalid)", insert StrongEq_L_subst2[where P = "(\<lambda>x. (\<delta> (x .moving@pre)))" and \<tau> = "\<tau>" and x = "X" and y = "invalid"], simp add: foundation16' dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__movingat_pre_invalid) - apply(case_tac "\<tau> \<Turnstile> (X \<triangleq> null)", insert StrongEq_L_subst2[where P = "(\<lambda>x. (\<delta> (x .moving@pre)))" and \<tau> = "\<tau>" and x = "X" and y = "null"], simp add: foundation16' dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__movingat_pre_null) -by(simp add: defined_split) -lemma defined_mono_dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__outer_worldat_pre : "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Person) .outer_world@pre)) \<Longrightarrow> \<tau> \<Turnstile> (\<delta> (X))" - apply(case_tac "\<tau> \<Turnstile> (X \<triangleq> invalid)", insert StrongEq_L_subst2[where P = "(\<lambda>x. (\<delta> (x .outer_world@pre)))" and \<tau> = "\<tau>" and x = "X" and y = "invalid"], simp add: foundation16' dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__outer_worldat_pre_invalid) - apply(case_tac "\<tau> \<Turnstile> (X \<triangleq> null)", insert StrongEq_L_subst2[where P = "(\<lambda>x. (\<delta> (x .outer_world@pre)))" and \<tau> = "\<tau>" and x = "X" and y = "null"], simp add: foundation16' dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__outer_worldat_pre_null) -by(simp add: defined_split) -lemma defined_mono_dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__sound : "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Planet) .sound)) \<Longrightarrow> \<tau> \<Turnstile> (\<delta> (X))" - apply(case_tac "\<tau> \<Turnstile> (X \<triangleq> invalid)", insert StrongEq_L_subst2[where P = "(\<lambda>x. (\<delta> (x .sound)))" and \<tau> = "\<tau>" and x = "X" and y = "invalid"], simp add: foundation16' dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__sound_invalid) - apply(case_tac "\<tau> \<Turnstile> (X \<triangleq> null)", insert StrongEq_L_subst2[where P = "(\<lambda>x. (\<delta> (x .sound)))" and \<tau> = "\<tau>" and x = "X" and y = "null"], simp add: foundation16' dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__sound_null) -by(simp add: defined_split) -lemma defined_mono_dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__moving : "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Planet) .moving)) \<Longrightarrow> \<tau> \<Turnstile> (\<delta> (X))" - apply(case_tac "\<tau> \<Turnstile> (X \<triangleq> invalid)", insert StrongEq_L_subst2[where P = "(\<lambda>x. (\<delta> (x .moving)))" and \<tau> = "\<tau>" and x = "X" and y = "invalid"], simp add: foundation16' dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__moving_invalid) - apply(case_tac "\<tau> \<Turnstile> (X \<triangleq> null)", insert StrongEq_L_subst2[where P = "(\<lambda>x. (\<delta> (x .moving)))" and \<tau> = "\<tau>" and x = "X" and y = "null"], simp add: foundation16' dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__moving_null) -by(simp add: defined_split) -lemma defined_mono_dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__outer_world : "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Planet) .outer_world)) \<Longrightarrow> \<tau> \<Turnstile> (\<delta> (X))" - apply(case_tac "\<tau> \<Turnstile> (X \<triangleq> invalid)", insert StrongEq_L_subst2[where P = "(\<lambda>x. (\<delta> (x .outer_world)))" and \<tau> = "\<tau>" and x = "X" and y = "invalid"], simp add: foundation16' dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__outer_world_invalid) - apply(case_tac "\<tau> \<Turnstile> (X \<triangleq> null)", insert StrongEq_L_subst2[where P = "(\<lambda>x. (\<delta> (x .outer_world)))" and \<tau> = "\<tau>" and x = "X" and y = "null"], simp add: foundation16' dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__outer_world_null) -by(simp add: defined_split) -lemma defined_mono_dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__soundat_pre : "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Planet) .sound@pre)) \<Longrightarrow> \<tau> \<Turnstile> (\<delta> (X))" - apply(case_tac "\<tau> \<Turnstile> (X \<triangleq> invalid)", insert StrongEq_L_subst2[where P = "(\<lambda>x. (\<delta> (x .sound@pre)))" and \<tau> = "\<tau>" and x = "X" and y = "invalid"], simp add: foundation16' dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__soundat_pre_invalid) - apply(case_tac "\<tau> \<Turnstile> (X \<triangleq> null)", insert StrongEq_L_subst2[where P = "(\<lambda>x. (\<delta> (x .sound@pre)))" and \<tau> = "\<tau>" and x = "X" and y = "null"], simp add: foundation16' dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__soundat_pre_null) -by(simp add: defined_split) -lemma defined_mono_dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__movingat_pre : "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Planet) .moving@pre)) \<Longrightarrow> \<tau> \<Turnstile> (\<delta> (X))" - apply(case_tac "\<tau> \<Turnstile> (X \<triangleq> invalid)", insert StrongEq_L_subst2[where P = "(\<lambda>x. (\<delta> (x .moving@pre)))" and \<tau> = "\<tau>" and x = "X" and y = "invalid"], simp add: foundation16' dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__movingat_pre_invalid) - apply(case_tac "\<tau> \<Turnstile> (X \<triangleq> null)", insert StrongEq_L_subst2[where P = "(\<lambda>x. (\<delta> (x .moving@pre)))" and \<tau> = "\<tau>" and x = "X" and y = "null"], simp add: foundation16' dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__movingat_pre_null) -by(simp add: defined_split) -lemma defined_mono_dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__outer_worldat_pre : "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Planet) .outer_world@pre)) \<Longrightarrow> \<tau> \<Turnstile> (\<delta> (X))" - apply(case_tac "\<tau> \<Turnstile> (X \<triangleq> invalid)", insert StrongEq_L_subst2[where P = "(\<lambda>x. (\<delta> (x .outer_world@pre)))" and \<tau> = "\<tau>" and x = "X" and y = "invalid"], simp add: foundation16' dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__outer_worldat_pre_invalid) - apply(case_tac "\<tau> \<Turnstile> (X \<triangleq> null)", insert StrongEq_L_subst2[where P = "(\<lambda>x. (\<delta> (x .outer_world@pre)))" and \<tau> = "\<tau>" and x = "X" and y = "null"], simp add: foundation16' dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__outer_worldat_pre_null) -by(simp add: defined_split) - -(* 137 ************************************ 902 + 2 *) (* term Floor1_access.print_access_is_repr *) -lemma is_repr_dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_0___boss : -assumes def_dot: "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Person) .boss))" -shows "(is_represented_in_state (in_post_state) (X .boss) (Person) (\<tau>))" - apply(insert defined_mono_dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_0___boss[OF def_dot, simplified foundation16]) - apply(case_tac "(X (\<tau>))", simp add: bot_option_def) - proof - fix a0 show "(X (\<tau>)) = (Some (a0)) \<Longrightarrow> ?thesis" when "(X (\<tau>)) \<noteq> null" - apply(insert that, case_tac "a0", simp add: null_option_def bot_option_def, clarify) - proof - fix a show "(X (\<tau>)) = (Some ((Some (a)))) \<Longrightarrow> ?thesis" - apply(case_tac "(heap ((in_post_state (\<tau>))) ((oid_of (a))))", simp add: invalid_def bot_option_def) - apply(insert def_dot, simp add: dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_0___boss is_represented_in_state_def select\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__boss_def deref_oid\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_def in_post_state_def defined_def OclValid_def false_def true_def invalid_def bot_fun_def split: if_split_asm) - proof - fix b show "(X (\<tau>)) = (Some ((Some (a)))) \<Longrightarrow> (heap ((in_post_state (\<tau>))) ((oid_of (a)))) = (Some (b)) \<Longrightarrow> ?thesis" - apply(insert def_dot[simplified foundation16], auto simp: dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_0___boss is_represented_in_state_def deref_oid\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_def bot_option_def null_option_def) - apply(case_tac "b", simp_all add: invalid_def bot_option_def) - proof - fix r typeoid let ?t = "(Some ((Some (r)))) \<in> (Some o OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_\<AA>) ` (ran ((heap ((in_post_state (\<tau>))))))" - let ?sel_any = "(select_object_any\<^sub>S\<^sub>e\<^sub>t ((deref_oid\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (in_post_state) (reconst_basetype))))" show "(select\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__boss (?sel_any) (typeoid) (\<tau>)) = (Some ((Some (r)))) \<Longrightarrow> ?t" - apply(case_tac "typeoid", simp add: select\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__boss_def) - proof - fix opt show "(((case opt of None \<Rightarrow> null - | (Some (x)) \<Rightarrow> ((?sel_any) (x)))) (\<tau>)) = (Some ((Some (r)))) \<Longrightarrow> ?t" - apply(case_tac "opt", auto simp: null_fun_def null_option_def bot_option_def) - proof - fix aa show "((?sel_any) (aa) (\<tau>)) = (Some ((Some (r)))) \<Longrightarrow> ?t" when "\<tau> \<Turnstile> (\<delta> (((?sel_any) (aa))))" - apply(insert that, drule select_object_any_exec\<^sub>S\<^sub>e\<^sub>t[simplified foundation22], erule exE) - proof - fix e show "?t" when "((?sel_any) (aa) (\<tau>)) = (Some ((Some (r))))" "((?sel_any) (aa) (\<tau>)) = (deref_oid\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (in_post_state) (reconst_basetype) (e) (\<tau>))" - apply(insert that, simp add: deref_oid\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_def) - apply(case_tac "(heap ((in_post_state (\<tau>))) (e))", simp add: invalid_def bot_option_def, simp) - proof - fix aaa show "(case aaa of (in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (obj)) \<Rightarrow> (reconst_basetype (obj) (\<tau>)) - | _ \<Rightarrow> (invalid (\<tau>))) = (Some ((Some (r)))) \<Longrightarrow> (heap ((in_post_state (\<tau>))) (e)) = (Some (aaa)) \<Longrightarrow> ?t" - apply(case_tac "aaa", auto simp: invalid_def bot_option_def image_def ran_def) - apply(rule exI[where x = "(in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (r))"], simp add: OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_\<AA>_def Let_def reconst_basetype_def split: if_split_asm) -by(rule) qed - apply_end((blast)+) - qed - apply_end(simp add: foundation16 bot_option_def null_option_def) - qed qed qed qed qed - apply_end(simp_all) - qed -lemma is_repr_dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_0___bossat_pre : -assumes def_dot: "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Person) .boss@pre))" -shows "(is_represented_in_state (in_pre_state) (X .boss@pre) (Person) (\<tau>))" - apply(insert defined_mono_dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_0___bossat_pre[OF def_dot, simplified foundation16]) - apply(case_tac "(X (\<tau>))", simp add: bot_option_def) - proof - fix a0 show "(X (\<tau>)) = (Some (a0)) \<Longrightarrow> ?thesis" when "(X (\<tau>)) \<noteq> null" - apply(insert that, case_tac "a0", simp add: null_option_def bot_option_def, clarify) - proof - fix a show "(X (\<tau>)) = (Some ((Some (a)))) \<Longrightarrow> ?thesis" - apply(case_tac "(heap ((in_pre_state (\<tau>))) ((oid_of (a))))", simp add: invalid_def bot_option_def) - apply(insert def_dot, simp add: dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_0___bossat_pre is_represented_in_state_def select\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__boss_def deref_oid\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_def in_pre_state_def defined_def OclValid_def false_def true_def invalid_def bot_fun_def split: if_split_asm) - proof - fix b show "(X (\<tau>)) = (Some ((Some (a)))) \<Longrightarrow> (heap ((in_pre_state (\<tau>))) ((oid_of (a)))) = (Some (b)) \<Longrightarrow> ?thesis" - apply(insert def_dot[simplified foundation16], auto simp: dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_0___bossat_pre is_represented_in_state_def deref_oid\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_def bot_option_def null_option_def) - apply(case_tac "b", simp_all add: invalid_def bot_option_def) - proof - fix r typeoid let ?t = "(Some ((Some (r)))) \<in> (Some o OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_\<AA>) ` (ran ((heap ((in_pre_state (\<tau>))))))" - let ?sel_any = "(select_object_any\<^sub>S\<^sub>e\<^sub>t ((deref_oid\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (in_pre_state) (reconst_basetype))))" show "(select\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__boss (?sel_any) (typeoid) (\<tau>)) = (Some ((Some (r)))) \<Longrightarrow> ?t" - apply(case_tac "typeoid", simp add: select\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__boss_def) - proof - fix opt show "(((case opt of None \<Rightarrow> null - | (Some (x)) \<Rightarrow> ((?sel_any) (x)))) (\<tau>)) = (Some ((Some (r)))) \<Longrightarrow> ?t" - apply(case_tac "opt", auto simp: null_fun_def null_option_def bot_option_def) - proof - fix aa show "((?sel_any) (aa) (\<tau>)) = (Some ((Some (r)))) \<Longrightarrow> ?t" when "\<tau> \<Turnstile> (\<delta> (((?sel_any) (aa))))" - apply(insert that, drule select_object_any_exec\<^sub>S\<^sub>e\<^sub>t[simplified foundation22], erule exE) - proof - fix e show "?t" when "((?sel_any) (aa) (\<tau>)) = (Some ((Some (r))))" "((?sel_any) (aa) (\<tau>)) = (deref_oid\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (in_pre_state) (reconst_basetype) (e) (\<tau>))" - apply(insert that, simp add: deref_oid\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_def) - apply(case_tac "(heap ((in_pre_state (\<tau>))) (e))", simp add: invalid_def bot_option_def, simp) - proof - fix aaa show "(case aaa of (in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (obj)) \<Rightarrow> (reconst_basetype (obj) (\<tau>)) - | _ \<Rightarrow> (invalid (\<tau>))) = (Some ((Some (r)))) \<Longrightarrow> (heap ((in_pre_state (\<tau>))) (e)) = (Some (aaa)) \<Longrightarrow> ?t" - apply(case_tac "aaa", auto simp: invalid_def bot_option_def image_def ran_def) - apply(rule exI[where x = "(in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (r))"], simp add: OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_\<AA>_def Let_def reconst_basetype_def split: if_split_asm) -by(rule) qed - apply_end((blast)+) - qed - apply_end(simp add: foundation16 bot_option_def null_option_def) - qed qed qed qed qed - apply_end(simp_all) - qed - -(* 138 ************************************ 904 + 0 *) (* term Floor1_access.print_access_repr_allinst *) - -(* 139 ************************************ 904 + 1 *) -section \<open>Class Model: Towards the Object Instances\<close> - -(* 140 ************************************ 905 + 1 *) -text \<open> - -The example we are defining in this section comes from the \autoref{fig:Employee-DesignModel-UMLPart-generatededm1_system-states}. -\<close> - -(* 141 ************************************ 906 + 1 *) -text_raw \<open> -\begin{figure} -\includegraphics[width=\textwidth]{figures/pre-post.pdf} -\caption{(a) pre-state $\sigma_1$ and - (b) post-state $\sigma_1'$.} -\label{fig:Employee-DesignModel-UMLPart-generatededm1_system-states} -\end{figure} -\<close> - -(* 142 ************************************ 907 + 1 *) -text \<open>\<close> - -(* 143 ************************************ 908 + 1 *) -text_raw \<open>\<close> - -(* 144 ************************************ 909 + 1 *) (* term Floor1_examp.print_examp_def_st_defs *) -lemmas [simp,code_unfold] = state.defs - const_ss - -(* 145 ************************************ 910 + 1 *) (* term Floor1_astype.print_astype_lemmas_id2 *) -lemmas[simp,code_unfold] = OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet - OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy - OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny - OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy - OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny - OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person - OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny - OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person - OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet - OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person - OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet - OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy - -(* 146 ************************************ 911 + 1 *) -section \<open>Instance\<close> - -(* 147 ************************************ 912 + 2 *) (* term Floor1_examp.print_examp_instance_defassoc_typecheck_var *) -definition "(typecheck_instance_bad_head_on_lhs_P1_X0_X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9_X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n8_X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7_X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6_X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5_X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4_X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3_X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2_X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1 (P1) (X0) (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9) (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n8) (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7) (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6) (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5) (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4) (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3) (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2) (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1)) = ()" -definition "typecheck_instance_extra_variables_on_rhs_P1_X0_X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9_X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n8_X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7_X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6_X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5_X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4_X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3_X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2_X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1 = (\<lambda>P1 X0 X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9 X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n8 X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7 X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6 X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5 X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4 X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3 X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2 X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1. (P1 , P1 , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7 , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7 , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2 , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2))" - -(* 148 ************************************ 914 + 12 *) (* term Floor1_examp.print_examp_instance_defassoc *) -definition "oid1 = 1" -definition "oid2 = 2" -definition "oid3 = 3" -definition "oid4 = 4" -definition "oid5 = 5" -definition "oid6 = 6" -definition "oid7 = 7" -definition "oid8 = 8" -definition "oid9 = 9" -definition "oid10 = 10" -definition "oid11 = 11" -definition "inst_assoc1 = (\<lambda>oid_class to_from oid. ((case (deref_assocs_list ((to_from::oid list list \<Rightarrow> oid list \<times> oid list)) ((oid::oid)) ((the ((((map_of_list ([(oid\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_0___boss , (List.map ((\<lambda>(x , y). [x , y]) o switch\<^sub>2_01) ([[[oid7] , [oid7]] , [[oid6] , [oid7]] , [[oid2] , [oid2]] , [[oid1] , [oid2]]])))]))) ((oid_class::oid))))))) of Nil \<Rightarrow> None - | l \<Rightarrow> (Some (l)))::oid list option))" - -(* 149 ************************************ 926 + 22 *) (* term Floor1_examp.print_examp_instance *) -definition "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n inst_assoc = (mk\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n ((mk\<E>\<X>\<T>\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (oid1) (None) (None) (None) (None) (None))) (((inst_assoc) (oid\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_0___boss) (switch\<^sub>2_01) (oid1))) (\<lfloor>1300\<rfloor>))" -definition "(X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1::\<cdot>Person) = ((\<lambda>_. \<lfloor>\<lfloor>(X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (inst_assoc1))\<rfloor>\<rfloor>))" -definition "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n inst_assoc = (mk\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n ((mk\<E>\<X>\<T>\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (oid2) (None) (None) (None) (None) (None))) (((inst_assoc) (oid\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_0___boss) (switch\<^sub>2_01) (oid2))) (\<lfloor>1800\<rfloor>))" -definition "(X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2::\<cdot>Person) = ((\<lambda>_. \<lfloor>\<lfloor>(X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (inst_assoc1))\<rfloor>\<rfloor>))" -definition "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n inst_assoc = (mk\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n ((mk\<E>\<X>\<T>\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (oid3) (None) (None) (None) (None) (None))) (((inst_assoc) (oid\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_0___boss) (switch\<^sub>2_01) (oid3))) (None))" -definition "(X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3::\<cdot>Person) = ((\<lambda>_. \<lfloor>\<lfloor>(X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (inst_assoc1))\<rfloor>\<rfloor>))" -definition "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n inst_assoc = (mk\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n ((mk\<E>\<X>\<T>\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (oid4) (None) (None) (None) (None) (None))) (((inst_assoc) (oid\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_0___boss) (switch\<^sub>2_01) (oid4))) (\<lfloor>2900\<rfloor>))" -definition "(X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4::\<cdot>Person) = ((\<lambda>_. \<lfloor>\<lfloor>(X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (inst_assoc1))\<rfloor>\<rfloor>))" -definition "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n inst_assoc = (mk\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n ((mk\<E>\<X>\<T>\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (oid5) (None) (None) (None) (None) (None))) (((inst_assoc) (oid\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_0___boss) (switch\<^sub>2_01) (oid5))) (\<lfloor>3500\<rfloor>))" -definition "(X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5::\<cdot>Person) = ((\<lambda>_. \<lfloor>\<lfloor>(X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (inst_assoc1))\<rfloor>\<rfloor>))" -definition "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n inst_assoc = (mk\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n ((mk\<E>\<X>\<T>\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (oid6) (None) (None) (None) (None) (None))) (((inst_assoc) (oid\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_0___boss) (switch\<^sub>2_01) (oid6))) (\<lfloor>2500\<rfloor>))" -definition "(X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6::\<cdot>Person) = ((\<lambda>_. \<lfloor>\<lfloor>(X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (inst_assoc1))\<rfloor>\<rfloor>))" -definition "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y inst_assoc = (mk\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n ((mk\<E>\<X>\<T>\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (oid7) (None) (None) (None) (None) (None))) (((inst_assoc) (oid\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_0___boss) (switch\<^sub>2_01) (oid7))) (\<lfloor>3200\<rfloor>))" -definition "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7 = ((((\<lambda>_. \<lfloor>\<lfloor>(X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y (inst_assoc1))\<rfloor>\<rfloor>)::\<cdot>Person)) .oclAsType(OclAny))" -definition "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n8\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y inst_assoc = (mk\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y ((mk\<E>\<X>\<T>\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y (oid8))))" -definition "(X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n8::\<cdot>OclAny) = ((\<lambda>_. \<lfloor>\<lfloor>(X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n8\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y (inst_assoc1))\<rfloor>\<rfloor>))" -definition "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n inst_assoc = (mk\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n ((mk\<E>\<X>\<T>\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (oid9) (None) (None) (None) (None) (None))) (((inst_assoc) (oid\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_0___boss) (switch\<^sub>2_01) (oid9))) (\<lfloor>0\<rfloor>))" -definition "(X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9::\<cdot>Person) = ((\<lambda>_. \<lfloor>\<lfloor>(X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (inst_assoc1))\<rfloor>\<rfloor>))" -definition "X0\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n inst_assoc = (mk\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n ((mk\<E>\<X>\<T>\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (oid10) (None) (None) (None) (None) (\<lfloor>[[oid11]]\<rfloor>))) (((inst_assoc) (oid\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_0___boss) (switch\<^sub>2_01) (oid10))) (None))" -definition "(X0::\<cdot>Person) = ((\<lambda>_. \<lfloor>\<lfloor>(X0\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (inst_assoc1))\<rfloor>\<rfloor>))" -definition "P1\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t inst_assoc = (mk\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t ((mk\<E>\<X>\<T>\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (oid11) (None) (None) (\<lfloor>[[oid11] , [oid11]]\<rfloor>))) (None) (None))" -definition "(P1::\<cdot>Planet) = ((\<lambda>_. \<lfloor>\<lfloor>(P1\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (inst_assoc1))\<rfloor>\<rfloor>))" - -(* 150 ************************************ 948 + 1 *) (* term Floor1_examp.print_examp_instance_defassoc_typecheck *) -ML \<open>(Ty'.check ([(META.Writeln , "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1 .boss \<cong> Set{ X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2 }") , (META.Writeln , "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1 /* unnamed attribute */ \<cong> Set{}") , (META.Writeln , "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2 .boss \<cong> Set{ X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2 }") , (META.Writeln , "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2 /* unnamed attribute */ \<cong> Set{ X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1 , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2 }") , (META.Writeln , "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3 .boss \<cong> Set{}") , (META.Writeln , "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3 /* unnamed attribute */ \<cong> Set{}") , (META.Writeln , "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4 .boss \<cong> Set{}") , (META.Writeln , "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4 /* unnamed attribute */ \<cong> Set{}") , (META.Writeln , "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5 .boss \<cong> Set{}") , (META.Writeln , "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5 /* unnamed attribute */ \<cong> Set{}") , (META.Writeln , "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6 .boss \<cong> Set{ X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7 }") , (META.Writeln , "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6 /* unnamed attribute */ \<cong> Set{}") , (META.Writeln , "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7 .boss \<cong> Set{ X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7 }") , (META.Writeln , "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7 /* unnamed attribute */ \<cong> Set{ X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6 , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7 }") , (META.Writeln , "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9 .boss \<cong> Set{}") , (META.Writeln , "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9 /* unnamed attribute */ \<cong> Set{}") , (META.Writeln , "X0 .boss \<cong> Set{}") , (META.Writeln , "X0 /* unnamed attribute */ \<cong> Set{}")]) (" error(s)"))\<close> - -(* 151 ************************************ 949 + 1 *) -section \<open>State (Floor 1)\<close> - -(* 152 ************************************ 950 + 2 *) (* term Floor1_examp.print_examp_def_st_typecheck_var *) -definition "(typecheck_state_bad_head_on_lhs_\<sigma>\<^sub>1 (\<sigma>\<^sub>1)) = ()" -definition "typecheck_state_extra_variables_on_rhs_\<sigma>\<^sub>1 = (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9 , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6 , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5 , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4 , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2 , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1)" - -(* 153 ************************************ 952 + 4 *) (* term Floor1_examp.print_examp_def_st1 *) -generation_syntax [ shallow (generation_semantics [ design ]) ] -setup \<open>(Generation_mode.update_compiler_config ((K (let open META in Compiler_env_config_ext (true, NONE, Oids ((Code_Numeral.natural_of_integer 0), (Code_Numeral.natural_of_integer 1), (Code_Numeral.natural_of_integer 12)), I ((Code_Numeral.natural_of_integer 0), (Code_Numeral.natural_of_integer 0)), Gen_only_design, SOME (OclClass ((META.SS_base (META.ST "OclAny")), nil, uncurry cons (OclClass ((META.SS_base (META.ST "Galaxy")), uncurry cons (I ((META.SS_base (META.ST "sound")), OclTy_base_void), uncurry cons (I ((META.SS_base (META.ST "moving")), OclTy_base_boolean), uncurry cons (I ((META.SS_base (META.ST "outer_world")), OclTy_collection (Ocl_multiplicity_ext (nil, NONE, uncurry cons (Set, nil), ()), OclTy_collection (Ocl_multiplicity_ext (nil, NONE, uncurry cons (Sequence, nil), ()), OclTy_object (OclTyObj (OclTyCore_pre ((META.SS_base (META.ST "Planet"))), nil))))), nil))), uncurry cons (OclClass ((META.SS_base (META.ST "Planet")), uncurry cons (I ((META.SS_base (META.ST "wormhole")), OclTy_base_unlimitednatural), uncurry cons (I ((META.SS_base (META.ST "weight")), OclTy_base_integer), nil)), uncurry cons (OclClass ((META.SS_base (META.ST "Person")), uncurry cons (I ((META.SS_base (META.ST "boss")), OclTy_object (OclTyObj (OclTyCore (Ocl_ty_class_ext ((META.SS_base (META.ST "oid")), (Code_Numeral.natural_of_integer 0), (Code_Numeral.natural_of_integer 2), Ocl_ty_class_node_ext ((Code_Numeral.natural_of_integer 0), Ocl_multiplicity_ext (uncurry cons (I (Mult_star, NONE), nil), NONE, nil, ()), (META.SS_base (META.ST "Person")), ()), Ocl_ty_class_node_ext ((Code_Numeral.natural_of_integer 1), Ocl_multiplicity_ext (uncurry cons (I (Mult_nat ((Code_Numeral.natural_of_integer 0)), SOME (Mult_nat ((Code_Numeral.natural_of_integer 1)))), nil), SOME ((META.SS_base (META.ST "boss"))), nil, ()), (META.SS_base (META.ST "Person")), ()), ())), nil))), uncurry cons (I ((META.SS_base (META.ST "salary")), OclTy_base_integer), nil)), nil), nil)), nil)), nil))), uncurry cons (META_instance (OclInstance (uncurry cons (Ocl_instance_single_ext (SOME ((META.SS_base (META.ST "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1"))), SOME ((META.SS_base (META.ST "Person"))), NONE, OclAttrNoCast (uncurry cons (I (NONE, I ((META.SS_base (META.ST "salary")), ShallB_term (OclDefInteger ((META.SS_base (META.ST "1300")))))), uncurry cons (I (NONE, I ((META.SS_base (META.ST "boss")), ShallB_str ((META.SS_base (META.ST "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2"))))), nil))), ()), uncurry cons (Ocl_instance_single_ext (SOME ((META.SS_base (META.ST "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2"))), SOME ((META.SS_base (META.ST "Person"))), NONE, OclAttrNoCast (uncurry cons (I (NONE, I ((META.SS_base (META.ST "salary")), ShallB_term (OclDefInteger ((META.SS_base (META.ST "1800")))))), uncurry cons (I (NONE, I ((META.SS_base (META.ST "boss")), ShallB_str ((META.SS_base (META.ST "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2"))))), nil))), ()), uncurry cons (Ocl_instance_single_ext (SOME ((META.SS_base (META.ST "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3"))), SOME ((META.SS_base (META.ST "Person"))), NONE, OclAttrNoCast (nil), ()), uncurry cons (Ocl_instance_single_ext (SOME ((META.SS_base (META.ST "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4"))), SOME ((META.SS_base (META.ST "Person"))), NONE, OclAttrNoCast (uncurry cons (I (NONE, I ((META.SS_base (META.ST "salary")), ShallB_term (OclDefInteger ((META.SS_base (META.ST "2900")))))), nil)), ()), uncurry cons (Ocl_instance_single_ext (SOME ((META.SS_base (META.ST "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5"))), SOME ((META.SS_base (META.ST "Person"))), NONE, OclAttrNoCast (uncurry cons (I (NONE, I ((META.SS_base (META.ST "salary")), ShallB_term (OclDefInteger ((META.SS_base (META.ST "3500")))))), nil)), ()), uncurry cons (Ocl_instance_single_ext (SOME ((META.SS_base (META.ST "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6"))), SOME ((META.SS_base (META.ST "Person"))), NONE, OclAttrNoCast (uncurry cons (I (NONE, I ((META.SS_base (META.ST "salary")), ShallB_term (OclDefInteger ((META.SS_base (META.ST "2500")))))), uncurry cons (I (NONE, I ((META.SS_base (META.ST "boss")), ShallB_str ((META.SS_base (META.ST "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7"))))), nil))), ()), uncurry cons (Ocl_instance_single_ext (SOME ((META.SS_base (META.ST "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7"))), NONE, NONE, OclAttrCast ((META.SS_base (META.ST "OclAny")), OclAttrCast ((META.SS_base (META.ST "Person")), OclAttrNoCast (uncurry cons (I (NONE, I ((META.SS_base (META.ST "salary")), ShallB_term (OclDefInteger ((META.SS_base (META.ST "3200")))))), uncurry cons (I (NONE, I ((META.SS_base (META.ST "boss")), ShallB_str ((META.SS_base (META.ST "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7"))))), nil))), nil), nil), ()), uncurry cons (Ocl_instance_single_ext (SOME ((META.SS_base (META.ST "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n8"))), SOME ((META.SS_base (META.ST "OclAny"))), NONE, OclAttrNoCast (nil), ()), uncurry cons (Ocl_instance_single_ext (SOME ((META.SS_base (META.ST "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9"))), SOME ((META.SS_base (META.ST "Person"))), NONE, OclAttrNoCast (uncurry cons (I (NONE, I ((META.SS_base (META.ST "salary")), ShallB_term (OclDefInteger ((META.SS_base (META.ST "0")))))), nil)), ()), uncurry cons (Ocl_instance_single_ext (SOME ((META.SS_base (META.ST "X0"))), SOME ((META.SS_base (META.ST "Person"))), NONE, OclAttrNoCast (uncurry cons (I (NONE, I ((META.SS_base (META.ST "outer_world")), ShallB_list (uncurry cons (ShallB_list (uncurry cons (ShallB_str ((META.SS_base (META.ST "P1"))), nil)), nil)))), nil)), ()), uncurry cons (Ocl_instance_single_ext (SOME ((META.SS_base (META.ST "P1"))), SOME ((META.SS_base (META.ST "Planet"))), NONE, OclAttrNoCast (uncurry cons (I (NONE, I ((META.SS_base (META.ST "outer_world")), ShallB_list (uncurry cons (ShallB_list (uncurry cons (ShallB_str ((META.SS_base (META.ST "P1"))), nil)), uncurry cons (ShallB_list (uncurry cons (ShallB_self (Oid ((Code_Numeral.natural_of_integer 10))), nil)), nil))))), nil)), ()), nil))))))))))))), uncurry cons (META_class_raw (Floor1, Ocl_class_raw_ext (OclTyObj (OclTyCore_pre ((META.SS_base (META.ST "Galaxy"))), nil), uncurry cons (I ((META.SS_base (META.ST "sound")), OclTy_base_void), uncurry cons (I ((META.SS_base (META.ST "moving")), OclTy_base_boolean), uncurry cons (I ((META.SS_base (META.ST "outer_world")), OclTy_collection (Ocl_multiplicity_ext (nil, NONE, uncurry cons (Set, nil), ()), OclTy_binding (I (NONE, OclTy_collection (Ocl_multiplicity_ext (nil, NONE, uncurry cons (Sequence, nil), ()), OclTy_binding (I (NONE, OclTy_object (OclTyObj (OclTyCore_pre ((META.SS_base (META.ST "Planet"))), nil))))))))), nil))), nil, false, ())), uncurry cons (META_class_raw (Floor1, Ocl_class_raw_ext (OclTyObj (OclTyCore_pre ((META.SS_base (META.ST "Planet"))), uncurry cons (uncurry cons (OclTyCore_pre ((META.SS_base (META.ST "Galaxy"))), nil), nil)), uncurry cons (I ((META.SS_base (META.ST "wormhole")), OclTy_base_unlimitednatural), uncurry cons (I ((META.SS_base (META.ST "weight")), OclTy_base_integer), nil)), nil, false, ())), uncurry cons (META_association (Ocl_association_ext (OclAssTy_association, OclAssRel (uncurry cons (I (OclTyObj (OclTyCore_pre ((META.SS_base (META.ST "Person"))), nil), Ocl_multiplicity_ext (uncurry cons (I (Mult_star, NONE), nil), NONE, nil, ())), uncurry cons (I (OclTyObj (OclTyCore_pre ((META.SS_base (META.ST "Person"))), nil), Ocl_multiplicity_ext (uncurry cons (I (Mult_nat ((Code_Numeral.natural_of_integer 0)), SOME (Mult_nat ((Code_Numeral.natural_of_integer 1)))), nil), SOME ((META.SS_base (META.ST "boss"))), nil, ())), nil))), ())), uncurry cons (META_class_raw (Floor1, Ocl_class_raw_ext (OclTyObj (OclTyCore_pre ((META.SS_base (META.ST "Person"))), uncurry cons (uncurry cons (OclTyCore_pre ((META.SS_base (META.ST "Planet"))), nil), nil)), uncurry cons (I ((META.SS_base (META.ST "salary")), OclTy_base_integer), nil), nil, false, ())), nil))))), uncurry cons (I ((META.ST "P1"), I (Ocl_instance_single_ext (SOME ((META.SS_base (META.ST "P1"))), SOME ((META.SS_base (META.ST "Planet"))), NONE, OclAttrNoCast (uncurry cons (I (NONE, I ((META.SS_base (META.ST "outer_world")), ShallB_list (uncurry cons (ShallB_list (uncurry cons (ShallB_str ((META.SS_base (META.ST "P1"))), nil)), uncurry cons (ShallB_list (uncurry cons (ShallB_str ((META.SS_base (META.ST "P1"))), nil)), nil))))), nil)), ()), Oids ((Code_Numeral.natural_of_integer 0), (Code_Numeral.natural_of_integer 1), (Code_Numeral.natural_of_integer 11)))), uncurry cons (I ((META.ST "X0"), I (Ocl_instance_single_ext (SOME ((META.SS_base (META.ST "X0"))), SOME ((META.SS_base (META.ST "Person"))), NONE, OclAttrNoCast (uncurry cons (I (NONE, I ((META.SS_base (META.ST "outer_world")), ShallB_list (uncurry cons (ShallB_list (uncurry cons (ShallB_str ((META.SS_base (META.ST "P1"))), nil)), nil)))), nil)), ()), Oids ((Code_Numeral.natural_of_integer 0), (Code_Numeral.natural_of_integer 1), (Code_Numeral.natural_of_integer 10)))), uncurry cons (I ((META.ST "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9"), I (Ocl_instance_single_ext (SOME ((META.SS_base (META.ST "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9"))), SOME ((META.SS_base (META.ST "Person"))), NONE, OclAttrNoCast (uncurry cons (I (NONE, I ((META.SS_base (META.ST "salary")), ShallB_term (OclDefInteger ((META.SS_base (META.ST "0")))))), nil)), ()), Oids ((Code_Numeral.natural_of_integer 0), (Code_Numeral.natural_of_integer 1), (Code_Numeral.natural_of_integer 9)))), uncurry cons (I ((META.ST "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n8"), I (Ocl_instance_single_ext (SOME ((META.SS_base (META.ST "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n8"))), SOME ((META.SS_base (META.ST "OclAny"))), NONE, OclAttrNoCast (nil), ()), Oids ((Code_Numeral.natural_of_integer 0), (Code_Numeral.natural_of_integer 1), (Code_Numeral.natural_of_integer 8)))), uncurry cons (I ((META.ST "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7"), I (Ocl_instance_single_ext (SOME ((META.SS_base (META.ST "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7"))), NONE, NONE, OclAttrCast ((META.SS_base (META.ST "OclAny")), OclAttrCast ((META.SS_base (META.ST "Person")), OclAttrNoCast (uncurry cons (I (NONE, I ((META.SS_base (META.ST "salary")), ShallB_term (OclDefInteger ((META.SS_base (META.ST "3200")))))), uncurry cons (I (NONE, I ((META.SS_base (META.ST "boss")), ShallB_str ((META.SS_base (META.ST "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7"))))), nil))), nil), nil), ()), Oids ((Code_Numeral.natural_of_integer 0), (Code_Numeral.natural_of_integer 1), (Code_Numeral.natural_of_integer 7)))), uncurry cons (I ((META.ST "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6"), I (Ocl_instance_single_ext (SOME ((META.SS_base (META.ST "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6"))), SOME ((META.SS_base (META.ST "Person"))), NONE, OclAttrNoCast (uncurry cons (I (NONE, I ((META.SS_base (META.ST "salary")), ShallB_term (OclDefInteger ((META.SS_base (META.ST "2500")))))), uncurry cons (I (NONE, I ((META.SS_base (META.ST "boss")), ShallB_str ((META.SS_base (META.ST "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7"))))), nil))), ()), Oids ((Code_Numeral.natural_of_integer 0), (Code_Numeral.natural_of_integer 1), (Code_Numeral.natural_of_integer 6)))), uncurry cons (I ((META.ST "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5"), I (Ocl_instance_single_ext (SOME ((META.SS_base (META.ST "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5"))), SOME ((META.SS_base (META.ST "Person"))), NONE, OclAttrNoCast (uncurry cons (I (NONE, I ((META.SS_base (META.ST "salary")), ShallB_term (OclDefInteger ((META.SS_base (META.ST "3500")))))), nil)), ()), Oids ((Code_Numeral.natural_of_integer 0), (Code_Numeral.natural_of_integer 1), (Code_Numeral.natural_of_integer 5)))), uncurry cons (I ((META.ST "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4"), I (Ocl_instance_single_ext (SOME ((META.SS_base (META.ST "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4"))), SOME ((META.SS_base (META.ST "Person"))), NONE, OclAttrNoCast (uncurry cons (I (NONE, I ((META.SS_base (META.ST "salary")), ShallB_term (OclDefInteger ((META.SS_base (META.ST "2900")))))), nil)), ()), Oids ((Code_Numeral.natural_of_integer 0), (Code_Numeral.natural_of_integer 1), (Code_Numeral.natural_of_integer 4)))), uncurry cons (I ((META.ST "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3"), I (Ocl_instance_single_ext (SOME ((META.SS_base (META.ST "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3"))), SOME ((META.SS_base (META.ST "Person"))), NONE, OclAttrNoCast (nil), ()), Oids ((Code_Numeral.natural_of_integer 0), (Code_Numeral.natural_of_integer 1), (Code_Numeral.natural_of_integer 3)))), uncurry cons (I ((META.ST "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2"), I (Ocl_instance_single_ext (SOME ((META.SS_base (META.ST "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2"))), SOME ((META.SS_base (META.ST "Person"))), NONE, OclAttrNoCast (uncurry cons (I (NONE, I ((META.SS_base (META.ST "salary")), ShallB_term (OclDefInteger ((META.SS_base (META.ST "1800")))))), uncurry cons (I (NONE, I ((META.SS_base (META.ST "boss")), ShallB_str ((META.SS_base (META.ST "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2"))))), nil))), ()), Oids ((Code_Numeral.natural_of_integer 0), (Code_Numeral.natural_of_integer 1), (Code_Numeral.natural_of_integer 2)))), uncurry cons (I ((META.ST "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1"), I (Ocl_instance_single_ext (SOME ((META.SS_base (META.ST "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1"))), SOME ((META.SS_base (META.ST "Person"))), NONE, OclAttrNoCast (uncurry cons (I (NONE, I ((META.SS_base (META.ST "salary")), ShallB_term (OclDefInteger ((META.SS_base (META.ST "1300")))))), uncurry cons (I (NONE, I ((META.SS_base (META.ST "boss")), ShallB_str ((META.SS_base (META.ST "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2"))))), nil))), ()), Oids ((Code_Numeral.natural_of_integer 0), (Code_Numeral.natural_of_integer 1), (Code_Numeral.natural_of_integer 1)))), nil))))))))))), nil, true, false, I (uncurry cons ((META.ST "dot__outer_worldat_pre"), uncurry cons ((META.ST "dot__movingat_pre"), uncurry cons ((META.ST "dot__soundat_pre"), uncurry cons ((META.ST "dot__weightat_pre"), uncurry cons ((META.ST "dot__wormholeat_pre"), uncurry cons ((META.ST "dot__salaryat_pre"), uncurry cons ((META.ST "dot_0___bossat_pre"), nil))))))), uncurry cons ((META.ST "dot__outer_world"), uncurry cons ((META.ST "dot__moving"), uncurry cons ((META.ST "dot__sound"), uncurry cons ((META.ST "dot__weight"), uncurry cons ((META.ST "dot__wormhole"), uncurry cons ((META.ST "dot__salary"), uncurry cons ((META.ST "dot_0___boss"), nil)))))))), uncurry cons ((META.ST "Sequence_Person"), uncurry cons ((META.ST "Set_Person"), uncurry cons ((META.ST "Set_Sequence_Planet"), nil))), nil, I (NONE, false), ()) end))))\<close> -Instance \<sigma>\<^sub>1_object0 :: Person = [ X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1 with_only "salary" = 1000, "boss" = self 1 ] - and \<sigma>\<^sub>1_object1 :: Person = [ X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2 with_only "salary" = 1200 ] - and \<sigma>\<^sub>1_object2 :: Person = [ X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4 with_only "salary" = 2600, "boss" = X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5 ] - and \<sigma>\<^sub>1_object4 :: Person = [ X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6 with_only "salary" = 2300, "boss" = self 2 ] -State[shallow] \<sigma>\<^sub>1 = [ \<sigma>\<^sub>1_object0, \<sigma>\<^sub>1_object1, \<sigma>\<^sub>1_object2, X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5, \<sigma>\<^sub>1_object4, X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9 ] - -(* 154 ************************************ 956 + 1 *) -section \<open>State (Floor 1)\<close> - -(* 155 ************************************ 957 + 2 *) (* term Floor1_examp.print_examp_def_st_typecheck_var *) -definition "(typecheck_state_bad_head_on_lhs_\<sigma>\<^sub>1' (\<sigma>\<^sub>1')) = ()" -definition "typecheck_state_extra_variables_on_rhs_\<sigma>\<^sub>1' = (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9 , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n8 , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7 , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6 , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4 , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3 , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2 , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1)" - -(* 156 ************************************ 959 + 1 *) (* term Floor1_examp.print_examp_def_st1 *) -State[shallow] \<sigma>\<^sub>1' = [ X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1, X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2, X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3, X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4, X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6, X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7, X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n8, X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9 ] - -(* 157 ************************************ 960 + 1 *) -section \<open>Transition (Floor 1)\<close> - -(* 158 ************************************ 961 + 1 *) (* term Floor1_examp.print_transition *) -Transition[shallow] \<sigma>\<^sub>1 \<sigma>\<^sub>1' - -(* 159 ************************************ 962 + 1 *) -section \<open>Context (Floor 1)\<close> - -(* 160 ************************************ 963 + 4 *) (* term Floor1_ctxt.print_ctxt *) -type_synonym Set_Integer = "(\<AA>, Integer\<^sub>b\<^sub>a\<^sub>s\<^sub>e Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e) val" -consts dot__contents :: "(\<AA>, '\<alpha>) val \<Rightarrow> (Set_Integer)" ("(_) .contents'(')") -consts dot__contentsat_pre :: "(\<AA>, '\<alpha>) val \<Rightarrow> (Set_Integer)" ("(_) .contents@pre'(')") -Context[shallow] Person :: contents () : Set(Integer) - Post : "(\<lambda> result self. (result \<triangleq> if (self .boss \<doteq> null) - then (Set{}->including\<^sub>S\<^sub>e\<^sub>t(self .salary)) - else (self .boss .contents()->including\<^sub>S\<^sub>e\<^sub>t(self .salary)) - endif))" - Post : "(\<lambda> result self. (true))" - Pre : "(\<lambda> self. (false))" - -(* 161 ************************************ 967 + 1 *) -section \<open>Context (Floor 1)\<close> - -(* 162 ************************************ 968 + 1 *) (* term Floor1_ctxt.print_ctxt *) -Context[shallow] Person Inv a : "(\<lambda> self. (self .boss <> null implies (self .salary \<triangleq> ((self .boss) .salary))))" - -(* 163 ************************************ 969 + 1 *) -section \<open>Context (Floor 1)\<close> - -(* 164 ************************************ 970 + 1 *) (* term Floor1_ctxt.print_ctxt *) -Context[shallow] Planet Inv A : "(\<lambda> self. (true and (self .weight \<le>\<^sub>i\<^sub>n\<^sub>t \<zero>)))" - -end diff --git a/Citadelle/doc/Employee_DesignModel_UMLPart_generated_generated.thy b/Citadelle/doc/Employee_DesignModel_UMLPart_generated_generated.thy deleted file mode 100644 index d3a94ddc1d528926e86e305c93ce4bd595868d0f..0000000000000000000000000000000000000000 --- a/Citadelle/doc/Employee_DesignModel_UMLPart_generated_generated.thy +++ /dev/null @@ -1,4704 +0,0 @@ -theory Employee_DesignModel_UMLPart_generated_generated imports "OCL.UML_Main" "FOCL.Static" "FOCL.Generator_dynamic_sequential" begin - -(* 1 ************************************ 0 + 0 *) (* term Floor1_infra.print_infra_enum_synonym *) - -(* 2 ************************************ 0 + 1 *) -text \<open> - \label{ex:Employee-DesignModel-UMLPart-generated-generatedemployee-design:uml} \<close> - -(* 3 ************************************ 1 + 1 *) -text \<open>\<close> - -(* 4 ************************************ 2 + 1 *) -section \<open>Class Model: Introduction\<close> - -(* 5 ************************************ 3 + 1 *) -text \<open> - - For certain concepts like classes and class-types, only a generic - definition for its resulting semantics can be given. Generic means, - there is a function outside \HOL that ``compiles'' a concrete, - closed-world class diagram into a ``theory'' of this data model, - consisting of a bunch of definitions for classes, accessors, method, - casts, and tests for actual types, as well as proofs for the - fundamental properties of these operations in this concrete data - model. \<close> - -(* 6 ************************************ 4 + 1 *) -text \<open> - Such generic function or ``compiler'' can be implemented in - Isabelle on the \ML level. This has been done, for a semantics - following the open-world assumption, for \UML 2.0 - in~\cite{brucker.ea:extensible:2008-b, brucker:interactive:2007}. In - this paper, we follow another approach for \UML 2.4: we define the - concepts of the compilation informally, and present a concrete - example which is verified in Isabelle/\HOL. \<close> - -(* 7 ************************************ 5 + 1 *) -subsection \<open>Outlining the Example\<close> - -(* 8 ************************************ 6 + 1 *) -text \<open> - We are presenting here a ``design-model'' of the (slightly -modified) example Figure 7.3, page 20 of -the \OCL standard~\cite{omg:ocl:2012}. To be precise, this theory contains the formalization of -the data-part covered by the \UML class model (see \autoref{fig:Employee-DesignModel-UMLPart-generated-generatedperson}):\<close> - -(* 9 ************************************ 7 + 1 *) -text \<open>\<close> - -(* 10 ************************************ 8 + 1 *) -text_raw \<open> - -\begin{figure} - \centering\scalebox{.3}{\includegraphics{figures/person.png}}% - \caption{A simple \UML class model drawn from Figure 7.3, - page 20 of~\cite{omg:ocl:2012}. \label{fig:Employee-DesignModel-UMLPart-generated-generatedperson}} -\end{figure} -\<close> - -(* 11 ************************************ 9 + 1 *) -text_raw \<open>\<close> - -(* 12 ************************************ 10 + 1 *) -text \<open> - This means that the association (attached to the association class -\inlineocl{EmployeeRanking}) with the association ends \inlineocl+boss+ and \inlineocl+employees+ is implemented -by the attribute \inlineocl+boss+ and the operation \inlineocl+employees+ (to be discussed in the \OCL part -captured by the subsequent theory). -\<close> - -(* 13 ************************************ 11 + 1 *) -section \<open>Class Model: The Construction of the Object Universe\<close> - -(* 14 ************************************ 12 + 1 *) -text \<open> - Our data universe consists in the concrete class diagram just of node's, -and implicitly of the class object. Each class implies the existence of a class -type defined for the corresponding object representations as follows: \<close> - -(* 15 ************************************ 13 + 8 *) (* term Floor1_infra.print_infra_datatype_class_1 *) -datatype ty\<E>\<X>\<T>\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n = mk\<E>\<X>\<T>\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n "oid" "nat option" "int option" "unit option" "bool option" "oid list list option" -datatype ty\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n = mk\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n "ty\<E>\<X>\<T>\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n" "oid list option" "int option" -datatype ty\<E>\<X>\<T>\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t = mk\<E>\<X>\<T>\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n "ty\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n" - | mk\<E>\<X>\<T>\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t "oid" "unit option" "bool option" "oid list list option" -datatype ty\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t = mk\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t "ty\<E>\<X>\<T>\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t" "nat option" "int option" -datatype ty\<E>\<X>\<T>\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y = mk\<E>\<X>\<T>\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t "ty\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t" - | mk\<E>\<X>\<T>\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n "ty\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n" - | mk\<E>\<X>\<T>\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y "oid" -datatype ty\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y = mk\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y "ty\<E>\<X>\<T>\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y" "unit option" "bool option" "oid list list option" -datatype ty\<E>\<X>\<T>\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y = mk\<E>\<X>\<T>\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y "ty\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y" - | mk\<E>\<X>\<T>\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t "ty\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t" - | mk\<E>\<X>\<T>\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n "ty\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n" - | mk\<E>\<X>\<T>\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y "oid" -datatype ty\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y = mk\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y "ty\<E>\<X>\<T>\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y" - -(* 16 ************************************ 21 + 11 *) (* term Floor1_infra.print_infra_datatype_class_2 *) -datatype ty2\<E>\<X>\<T>\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n = mk2\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n "oid list option" "int option" -datatype ty2oid\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n = mk2oid\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n "oid" "nat option" "int option" "unit option" "bool option" "oid list list option" "ty2\<E>\<X>\<T>\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n" -datatype ty2\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t = mk2\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n "ty2\<E>\<X>\<T>\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n" -datatype ty2\<E>\<X>\<T>\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t = mk2\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t "nat option" "int option" "ty2\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t option" -datatype ty2oid\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t = mk2oid\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t "oid" "unit option" "bool option" "oid list list option" "ty2\<E>\<X>\<T>\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t" -datatype ty2\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y = mk2\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t "ty2\<E>\<X>\<T>\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t" -datatype ty2\<E>\<X>\<T>\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y = mk2\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y "unit option" "bool option" "oid list list option" "ty2\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y option" -datatype ty2oid\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y = mk2oid\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y "oid" "ty2\<E>\<X>\<T>\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y" -datatype ty2\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y = mk2\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y "ty2\<E>\<X>\<T>\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y" -datatype ty2\<E>\<X>\<T>\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y = mk2\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y "ty2\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y option" -datatype ty2oid\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y = mk2oid\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y "oid" "ty2\<E>\<X>\<T>\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y" - -(* 17 ************************************ 32 + 8 *) (* term Floor1_infra.print_infra_datatype_equiv_2of1 *) -definition "class_ty_ext_equiv_2of1_aux\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n = (\<lambda>oid inh\<^sub>w\<^sub>o\<^sub>r\<^sub>m\<^sub>h\<^sub>o\<^sub>l\<^sub>e inh\<^sub>w\<^sub>e\<^sub>i\<^sub>g\<^sub>h\<^sub>t inh\<^sub>s\<^sub>o\<^sub>u\<^sub>n\<^sub>d inh\<^sub>m\<^sub>o\<^sub>v\<^sub>i\<^sub>n\<^sub>g inh\<^sub>o\<^sub>u\<^sub>t\<^sub>e\<^sub>r\<^sub>_\<^sub>w\<^sub>o\<^sub>r\<^sub>l\<^sub>d. (\<lambda> (mk2\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (own\<^sub>b\<^sub>o\<^sub>s\<^sub>s) (own\<^sub>s\<^sub>a\<^sub>l\<^sub>a\<^sub>r\<^sub>y)) \<Rightarrow> (mk\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n ((mk\<E>\<X>\<T>\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (oid) (inh\<^sub>w\<^sub>o\<^sub>r\<^sub>m\<^sub>h\<^sub>o\<^sub>l\<^sub>e) (inh\<^sub>w\<^sub>e\<^sub>i\<^sub>g\<^sub>h\<^sub>t) (inh\<^sub>s\<^sub>o\<^sub>u\<^sub>n\<^sub>d) (inh\<^sub>m\<^sub>o\<^sub>v\<^sub>i\<^sub>n\<^sub>g) (inh\<^sub>o\<^sub>u\<^sub>t\<^sub>e\<^sub>r\<^sub>_\<^sub>w\<^sub>o\<^sub>r\<^sub>l\<^sub>d))) (own\<^sub>b\<^sub>o\<^sub>s\<^sub>s) (own\<^sub>s\<^sub>a\<^sub>l\<^sub>a\<^sub>r\<^sub>y))))" -definition "class_ty_ext_equiv_2of1\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n = (\<lambda> (mk2oid\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (oid) (inh\<^sub>w\<^sub>o\<^sub>r\<^sub>m\<^sub>h\<^sub>o\<^sub>l\<^sub>e) (inh\<^sub>w\<^sub>e\<^sub>i\<^sub>g\<^sub>h\<^sub>t) (inh\<^sub>s\<^sub>o\<^sub>u\<^sub>n\<^sub>d) (inh\<^sub>m\<^sub>o\<^sub>v\<^sub>i\<^sub>n\<^sub>g) (inh\<^sub>o\<^sub>u\<^sub>t\<^sub>e\<^sub>r\<^sub>_\<^sub>w\<^sub>o\<^sub>r\<^sub>l\<^sub>d) (t)) \<Rightarrow> (class_ty_ext_equiv_2of1_aux\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (oid) (inh\<^sub>w\<^sub>o\<^sub>r\<^sub>m\<^sub>h\<^sub>o\<^sub>l\<^sub>e) (inh\<^sub>w\<^sub>e\<^sub>i\<^sub>g\<^sub>h\<^sub>t) (inh\<^sub>s\<^sub>o\<^sub>u\<^sub>n\<^sub>d) (inh\<^sub>m\<^sub>o\<^sub>v\<^sub>i\<^sub>n\<^sub>g) (inh\<^sub>o\<^sub>u\<^sub>t\<^sub>e\<^sub>r\<^sub>_\<^sub>w\<^sub>o\<^sub>r\<^sub>l\<^sub>d) (t)))" -definition "class_ty_ext_equiv_2of1_aux\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t = (\<lambda>oid inh\<^sub>s\<^sub>o\<^sub>u\<^sub>n\<^sub>d inh\<^sub>m\<^sub>o\<^sub>v\<^sub>i\<^sub>n\<^sub>g inh\<^sub>o\<^sub>u\<^sub>t\<^sub>e\<^sub>r\<^sub>_\<^sub>w\<^sub>o\<^sub>r\<^sub>l\<^sub>d. (\<lambda> (mk2\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (own\<^sub>w\<^sub>o\<^sub>r\<^sub>m\<^sub>h\<^sub>o\<^sub>l\<^sub>e) (own\<^sub>w\<^sub>e\<^sub>i\<^sub>g\<^sub>h\<^sub>t) (t)) \<Rightarrow> (mk\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t ((case t of None \<Rightarrow> (mk\<E>\<X>\<T>\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (oid) (inh\<^sub>s\<^sub>o\<^sub>u\<^sub>n\<^sub>d) (inh\<^sub>m\<^sub>o\<^sub>v\<^sub>i\<^sub>n\<^sub>g) (inh\<^sub>o\<^sub>u\<^sub>t\<^sub>e\<^sub>r\<^sub>_\<^sub>w\<^sub>o\<^sub>r\<^sub>l\<^sub>d)) - | \<lfloor>(mk2\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (t))\<rfloor> \<Rightarrow> (case (class_ty_ext_equiv_2of1_aux\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (oid) (own\<^sub>w\<^sub>o\<^sub>r\<^sub>m\<^sub>h\<^sub>o\<^sub>l\<^sub>e) (own\<^sub>w\<^sub>e\<^sub>i\<^sub>g\<^sub>h\<^sub>t) (inh\<^sub>s\<^sub>o\<^sub>u\<^sub>n\<^sub>d) (inh\<^sub>m\<^sub>o\<^sub>v\<^sub>i\<^sub>n\<^sub>g) (inh\<^sub>o\<^sub>u\<^sub>t\<^sub>e\<^sub>r\<^sub>_\<^sub>w\<^sub>o\<^sub>r\<^sub>l\<^sub>d) (t)) of (mk\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n ((mk\<E>\<X>\<T>\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (oid) (own\<^sub>w\<^sub>o\<^sub>r\<^sub>m\<^sub>h\<^sub>o\<^sub>l\<^sub>e) (own\<^sub>w\<^sub>e\<^sub>i\<^sub>g\<^sub>h\<^sub>t) (inh\<^sub>s\<^sub>o\<^sub>u\<^sub>n\<^sub>d) (inh\<^sub>m\<^sub>o\<^sub>v\<^sub>i\<^sub>n\<^sub>g) (inh\<^sub>o\<^sub>u\<^sub>t\<^sub>e\<^sub>r\<^sub>_\<^sub>w\<^sub>o\<^sub>r\<^sub>l\<^sub>d))) (own\<^sub>b\<^sub>o\<^sub>s\<^sub>s) (own\<^sub>s\<^sub>a\<^sub>l\<^sub>a\<^sub>r\<^sub>y)) \<Rightarrow> (mk\<E>\<X>\<T>\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n ((mk\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n ((mk\<E>\<X>\<T>\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (oid) (own\<^sub>w\<^sub>o\<^sub>r\<^sub>m\<^sub>h\<^sub>o\<^sub>l\<^sub>e) (own\<^sub>w\<^sub>e\<^sub>i\<^sub>g\<^sub>h\<^sub>t) (inh\<^sub>s\<^sub>o\<^sub>u\<^sub>n\<^sub>d) (inh\<^sub>m\<^sub>o\<^sub>v\<^sub>i\<^sub>n\<^sub>g) (inh\<^sub>o\<^sub>u\<^sub>t\<^sub>e\<^sub>r\<^sub>_\<^sub>w\<^sub>o\<^sub>r\<^sub>l\<^sub>d))) (own\<^sub>b\<^sub>o\<^sub>s\<^sub>s) (own\<^sub>s\<^sub>a\<^sub>l\<^sub>a\<^sub>r\<^sub>y))))))) (own\<^sub>w\<^sub>o\<^sub>r\<^sub>m\<^sub>h\<^sub>o\<^sub>l\<^sub>e) (own\<^sub>w\<^sub>e\<^sub>i\<^sub>g\<^sub>h\<^sub>t))))" -definition "class_ty_ext_equiv_2of1\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t = (\<lambda> (mk2oid\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (oid) (inh\<^sub>s\<^sub>o\<^sub>u\<^sub>n\<^sub>d) (inh\<^sub>m\<^sub>o\<^sub>v\<^sub>i\<^sub>n\<^sub>g) (inh\<^sub>o\<^sub>u\<^sub>t\<^sub>e\<^sub>r\<^sub>_\<^sub>w\<^sub>o\<^sub>r\<^sub>l\<^sub>d) (t)) \<Rightarrow> (class_ty_ext_equiv_2of1_aux\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (oid) (inh\<^sub>s\<^sub>o\<^sub>u\<^sub>n\<^sub>d) (inh\<^sub>m\<^sub>o\<^sub>v\<^sub>i\<^sub>n\<^sub>g) (inh\<^sub>o\<^sub>u\<^sub>t\<^sub>e\<^sub>r\<^sub>_\<^sub>w\<^sub>o\<^sub>r\<^sub>l\<^sub>d) (t)))" -definition "class_ty_ext_equiv_2of1_aux\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y = (\<lambda>oid. (\<lambda> (mk2\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y (own\<^sub>s\<^sub>o\<^sub>u\<^sub>n\<^sub>d) (own\<^sub>m\<^sub>o\<^sub>v\<^sub>i\<^sub>n\<^sub>g) (own\<^sub>o\<^sub>u\<^sub>t\<^sub>e\<^sub>r\<^sub>_\<^sub>w\<^sub>o\<^sub>r\<^sub>l\<^sub>d) (t)) \<Rightarrow> (mk\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y ((case t of None \<Rightarrow> (mk\<E>\<X>\<T>\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y (oid)) - | \<lfloor>(mk2\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (t))\<rfloor> \<Rightarrow> (case (class_ty_ext_equiv_2of1_aux\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (oid) (own\<^sub>s\<^sub>o\<^sub>u\<^sub>n\<^sub>d) (own\<^sub>m\<^sub>o\<^sub>v\<^sub>i\<^sub>n\<^sub>g) (own\<^sub>o\<^sub>u\<^sub>t\<^sub>e\<^sub>r\<^sub>_\<^sub>w\<^sub>o\<^sub>r\<^sub>l\<^sub>d) (t)) of (mk\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t ((mk\<E>\<X>\<T>\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (oid) (own\<^sub>s\<^sub>o\<^sub>u\<^sub>n\<^sub>d) (own\<^sub>m\<^sub>o\<^sub>v\<^sub>i\<^sub>n\<^sub>g) (own\<^sub>o\<^sub>u\<^sub>t\<^sub>e\<^sub>r\<^sub>_\<^sub>w\<^sub>o\<^sub>r\<^sub>l\<^sub>d))) (own\<^sub>w\<^sub>o\<^sub>r\<^sub>m\<^sub>h\<^sub>o\<^sub>l\<^sub>e) (own\<^sub>w\<^sub>e\<^sub>i\<^sub>g\<^sub>h\<^sub>t)) \<Rightarrow> (mk\<E>\<X>\<T>\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t ((mk\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t ((mk\<E>\<X>\<T>\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (oid) (own\<^sub>s\<^sub>o\<^sub>u\<^sub>n\<^sub>d) (own\<^sub>m\<^sub>o\<^sub>v\<^sub>i\<^sub>n\<^sub>g) (own\<^sub>o\<^sub>u\<^sub>t\<^sub>e\<^sub>r\<^sub>_\<^sub>w\<^sub>o\<^sub>r\<^sub>l\<^sub>d))) (own\<^sub>w\<^sub>o\<^sub>r\<^sub>m\<^sub>h\<^sub>o\<^sub>l\<^sub>e) (own\<^sub>w\<^sub>e\<^sub>i\<^sub>g\<^sub>h\<^sub>t)))) - | (mk\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t ((mk\<E>\<X>\<T>\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (t))) (own\<^sub>w\<^sub>o\<^sub>r\<^sub>m\<^sub>h\<^sub>o\<^sub>l\<^sub>e) (own\<^sub>w\<^sub>e\<^sub>i\<^sub>g\<^sub>h\<^sub>t)) \<Rightarrow> (mk\<E>\<X>\<T>\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (t))))) (own\<^sub>s\<^sub>o\<^sub>u\<^sub>n\<^sub>d) (own\<^sub>m\<^sub>o\<^sub>v\<^sub>i\<^sub>n\<^sub>g) (own\<^sub>o\<^sub>u\<^sub>t\<^sub>e\<^sub>r\<^sub>_\<^sub>w\<^sub>o\<^sub>r\<^sub>l\<^sub>d))))" -definition "class_ty_ext_equiv_2of1\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y = (\<lambda> (mk2oid\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y (oid) (t)) \<Rightarrow> (class_ty_ext_equiv_2of1_aux\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y (oid) (t)))" -definition "class_ty_ext_equiv_2of1_aux\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y = (\<lambda>oid. (\<lambda> (mk2\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y (t)) \<Rightarrow> (mk\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y ((case t of None \<Rightarrow> (mk\<E>\<X>\<T>\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y (oid)) - | \<lfloor>(mk2\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y (t))\<rfloor> \<Rightarrow> (case (class_ty_ext_equiv_2of1_aux\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y (oid) (t)) of (mk\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y ((mk\<E>\<X>\<T>\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y (oid))) (own\<^sub>s\<^sub>o\<^sub>u\<^sub>n\<^sub>d) (own\<^sub>m\<^sub>o\<^sub>v\<^sub>i\<^sub>n\<^sub>g) (own\<^sub>o\<^sub>u\<^sub>t\<^sub>e\<^sub>r\<^sub>_\<^sub>w\<^sub>o\<^sub>r\<^sub>l\<^sub>d)) \<Rightarrow> (mk\<E>\<X>\<T>\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y ((mk\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y ((mk\<E>\<X>\<T>\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y (oid))) (own\<^sub>s\<^sub>o\<^sub>u\<^sub>n\<^sub>d) (own\<^sub>m\<^sub>o\<^sub>v\<^sub>i\<^sub>n\<^sub>g) (own\<^sub>o\<^sub>u\<^sub>t\<^sub>e\<^sub>r\<^sub>_\<^sub>w\<^sub>o\<^sub>r\<^sub>l\<^sub>d)))) - | (mk\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y ((mk\<E>\<X>\<T>\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (t))) (own\<^sub>s\<^sub>o\<^sub>u\<^sub>n\<^sub>d) (own\<^sub>m\<^sub>o\<^sub>v\<^sub>i\<^sub>n\<^sub>g) (own\<^sub>o\<^sub>u\<^sub>t\<^sub>e\<^sub>r\<^sub>_\<^sub>w\<^sub>o\<^sub>r\<^sub>l\<^sub>d)) \<Rightarrow> (mk\<E>\<X>\<T>\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (t)) - | (mk\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y ((mk\<E>\<X>\<T>\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (t))) (own\<^sub>s\<^sub>o\<^sub>u\<^sub>n\<^sub>d) (own\<^sub>m\<^sub>o\<^sub>v\<^sub>i\<^sub>n\<^sub>g) (own\<^sub>o\<^sub>u\<^sub>t\<^sub>e\<^sub>r\<^sub>_\<^sub>w\<^sub>o\<^sub>r\<^sub>l\<^sub>d)) \<Rightarrow> (mk\<E>\<X>\<T>\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (t))))))))" -definition "class_ty_ext_equiv_2of1\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y = (\<lambda> (mk2oid\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y (oid) (t)) \<Rightarrow> (class_ty_ext_equiv_2of1_aux\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y (oid) (t)))" - -(* 18 ************************************ 40 + 12 *) (* term Floor1_infra.print_infra_datatype_equiv_1of2 *) -definition "class_ty_ext_equiv_1of2_get_oid_inh\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n = (\<lambda> (mk\<E>\<X>\<T>\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (oid) (inh\<^sub>w\<^sub>o\<^sub>r\<^sub>m\<^sub>h\<^sub>o\<^sub>l\<^sub>e) (inh\<^sub>w\<^sub>e\<^sub>i\<^sub>g\<^sub>h\<^sub>t) (inh\<^sub>s\<^sub>o\<^sub>u\<^sub>n\<^sub>d) (inh\<^sub>m\<^sub>o\<^sub>v\<^sub>i\<^sub>n\<^sub>g) (inh\<^sub>o\<^sub>u\<^sub>t\<^sub>e\<^sub>r\<^sub>_\<^sub>w\<^sub>o\<^sub>r\<^sub>l\<^sub>d)) \<Rightarrow> (oid , inh\<^sub>w\<^sub>o\<^sub>r\<^sub>m\<^sub>h\<^sub>o\<^sub>l\<^sub>e , inh\<^sub>w\<^sub>e\<^sub>i\<^sub>g\<^sub>h\<^sub>t , inh\<^sub>s\<^sub>o\<^sub>u\<^sub>n\<^sub>d , inh\<^sub>m\<^sub>o\<^sub>v\<^sub>i\<^sub>n\<^sub>g , inh\<^sub>o\<^sub>u\<^sub>t\<^sub>e\<^sub>r\<^sub>_\<^sub>w\<^sub>o\<^sub>r\<^sub>l\<^sub>d))" -definition "class_ty_ext_equiv_1of2_aux\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n = (\<lambda> (mk\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (t) (own\<^sub>b\<^sub>o\<^sub>s\<^sub>s) (own\<^sub>s\<^sub>a\<^sub>l\<^sub>a\<^sub>r\<^sub>y)) \<Rightarrow> (mk2\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (own\<^sub>b\<^sub>o\<^sub>s\<^sub>s) (own\<^sub>s\<^sub>a\<^sub>l\<^sub>a\<^sub>r\<^sub>y)))" -definition "class_ty_ext_equiv_1of2\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n = (\<lambda> (mk\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (t) (own\<^sub>b\<^sub>o\<^sub>s\<^sub>s) (own\<^sub>s\<^sub>a\<^sub>l\<^sub>a\<^sub>r\<^sub>y)) \<Rightarrow> (case (class_ty_ext_equiv_1of2_get_oid_inh\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (t)) of (oid , inh\<^sub>w\<^sub>o\<^sub>r\<^sub>m\<^sub>h\<^sub>o\<^sub>l\<^sub>e , inh\<^sub>w\<^sub>e\<^sub>i\<^sub>g\<^sub>h\<^sub>t , inh\<^sub>s\<^sub>o\<^sub>u\<^sub>n\<^sub>d , inh\<^sub>m\<^sub>o\<^sub>v\<^sub>i\<^sub>n\<^sub>g , inh\<^sub>o\<^sub>u\<^sub>t\<^sub>e\<^sub>r\<^sub>_\<^sub>w\<^sub>o\<^sub>r\<^sub>l\<^sub>d) \<Rightarrow> (mk2oid\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (oid) (inh\<^sub>w\<^sub>o\<^sub>r\<^sub>m\<^sub>h\<^sub>o\<^sub>l\<^sub>e) (inh\<^sub>w\<^sub>e\<^sub>i\<^sub>g\<^sub>h\<^sub>t) (inh\<^sub>s\<^sub>o\<^sub>u\<^sub>n\<^sub>d) (inh\<^sub>m\<^sub>o\<^sub>v\<^sub>i\<^sub>n\<^sub>g) (inh\<^sub>o\<^sub>u\<^sub>t\<^sub>e\<^sub>r\<^sub>_\<^sub>w\<^sub>o\<^sub>r\<^sub>l\<^sub>d) ((class_ty_ext_equiv_1of2_aux\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n ((mk\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (t) (own\<^sub>b\<^sub>o\<^sub>s\<^sub>s) (own\<^sub>s\<^sub>a\<^sub>l\<^sub>a\<^sub>r\<^sub>y))))))))" -definition "class_ty_ext_equiv_1of2_get_oid_inh\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t = (\<lambda> (mk\<E>\<X>\<T>\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (oid) (inh\<^sub>s\<^sub>o\<^sub>u\<^sub>n\<^sub>d) (inh\<^sub>m\<^sub>o\<^sub>v\<^sub>i\<^sub>n\<^sub>g) (inh\<^sub>o\<^sub>u\<^sub>t\<^sub>e\<^sub>r\<^sub>_\<^sub>w\<^sub>o\<^sub>r\<^sub>l\<^sub>d)) \<Rightarrow> (oid , inh\<^sub>s\<^sub>o\<^sub>u\<^sub>n\<^sub>d , inh\<^sub>m\<^sub>o\<^sub>v\<^sub>i\<^sub>n\<^sub>g , inh\<^sub>o\<^sub>u\<^sub>t\<^sub>e\<^sub>r\<^sub>_\<^sub>w\<^sub>o\<^sub>r\<^sub>l\<^sub>d) - | (mk\<E>\<X>\<T>\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n ((mk\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (t) (var\<^sub>b\<^sub>o\<^sub>s\<^sub>s) (var\<^sub>s\<^sub>a\<^sub>l\<^sub>a\<^sub>r\<^sub>y)))) \<Rightarrow> (case (class_ty_ext_equiv_1of2_get_oid_inh\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (t)) of (oid , var\<^sub>w\<^sub>o\<^sub>r\<^sub>m\<^sub>h\<^sub>o\<^sub>l\<^sub>e , var\<^sub>w\<^sub>e\<^sub>i\<^sub>g\<^sub>h\<^sub>t , var\<^sub>s\<^sub>o\<^sub>u\<^sub>n\<^sub>d , var\<^sub>m\<^sub>o\<^sub>v\<^sub>i\<^sub>n\<^sub>g , var\<^sub>o\<^sub>u\<^sub>t\<^sub>e\<^sub>r\<^sub>_\<^sub>w\<^sub>o\<^sub>r\<^sub>l\<^sub>d) \<Rightarrow> (oid , var\<^sub>s\<^sub>o\<^sub>u\<^sub>n\<^sub>d , var\<^sub>m\<^sub>o\<^sub>v\<^sub>i\<^sub>n\<^sub>g , var\<^sub>o\<^sub>u\<^sub>t\<^sub>e\<^sub>r\<^sub>_\<^sub>w\<^sub>o\<^sub>r\<^sub>l\<^sub>d)))" -definition "class_ty_ext_equiv_1of2_aux\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t = (\<lambda> (mk\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (t) (own\<^sub>w\<^sub>o\<^sub>r\<^sub>m\<^sub>h\<^sub>o\<^sub>l\<^sub>e) (own\<^sub>w\<^sub>e\<^sub>i\<^sub>g\<^sub>h\<^sub>t)) \<Rightarrow> (mk2\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (own\<^sub>w\<^sub>o\<^sub>r\<^sub>m\<^sub>h\<^sub>o\<^sub>l\<^sub>e) (own\<^sub>w\<^sub>e\<^sub>i\<^sub>g\<^sub>h\<^sub>t) ((case t of (mk\<E>\<X>\<T>\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (oid) (inh\<^sub>s\<^sub>o\<^sub>u\<^sub>n\<^sub>d) (inh\<^sub>m\<^sub>o\<^sub>v\<^sub>i\<^sub>n\<^sub>g) (inh\<^sub>o\<^sub>u\<^sub>t\<^sub>e\<^sub>r\<^sub>_\<^sub>w\<^sub>o\<^sub>r\<^sub>l\<^sub>d)) \<Rightarrow> None - | (mk\<E>\<X>\<T>\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (tt)) \<Rightarrow> (case (case tt of (mk\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (t) (var\<^sub>b\<^sub>o\<^sub>s\<^sub>s) (var\<^sub>s\<^sub>a\<^sub>l\<^sub>a\<^sub>r\<^sub>y)) \<Rightarrow> (class_ty_ext_equiv_1of2_get_oid_inh\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (t))) of (oid , var\<^sub>w\<^sub>o\<^sub>r\<^sub>m\<^sub>h\<^sub>o\<^sub>l\<^sub>e , var\<^sub>w\<^sub>e\<^sub>i\<^sub>g\<^sub>h\<^sub>t , var\<^sub>s\<^sub>o\<^sub>u\<^sub>n\<^sub>d , var\<^sub>m\<^sub>o\<^sub>v\<^sub>i\<^sub>n\<^sub>g , var\<^sub>o\<^sub>u\<^sub>t\<^sub>e\<^sub>r\<^sub>_\<^sub>w\<^sub>o\<^sub>r\<^sub>l\<^sub>d) \<Rightarrow> \<lfloor>(mk2\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n ((class_ty_ext_equiv_1of2_aux\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (tt))))\<rfloor>)))))" -definition "class_ty_ext_equiv_1of2\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t = (\<lambda> (mk\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (t) (own\<^sub>w\<^sub>o\<^sub>r\<^sub>m\<^sub>h\<^sub>o\<^sub>l\<^sub>e) (own\<^sub>w\<^sub>e\<^sub>i\<^sub>g\<^sub>h\<^sub>t)) \<Rightarrow> (case (class_ty_ext_equiv_1of2_get_oid_inh\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (t)) of (oid , inh\<^sub>s\<^sub>o\<^sub>u\<^sub>n\<^sub>d , inh\<^sub>m\<^sub>o\<^sub>v\<^sub>i\<^sub>n\<^sub>g , inh\<^sub>o\<^sub>u\<^sub>t\<^sub>e\<^sub>r\<^sub>_\<^sub>w\<^sub>o\<^sub>r\<^sub>l\<^sub>d) \<Rightarrow> (mk2oid\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (oid) (inh\<^sub>s\<^sub>o\<^sub>u\<^sub>n\<^sub>d) (inh\<^sub>m\<^sub>o\<^sub>v\<^sub>i\<^sub>n\<^sub>g) (inh\<^sub>o\<^sub>u\<^sub>t\<^sub>e\<^sub>r\<^sub>_\<^sub>w\<^sub>o\<^sub>r\<^sub>l\<^sub>d) ((class_ty_ext_equiv_1of2_aux\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t ((mk\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (t) (own\<^sub>w\<^sub>o\<^sub>r\<^sub>m\<^sub>h\<^sub>o\<^sub>l\<^sub>e) (own\<^sub>w\<^sub>e\<^sub>i\<^sub>g\<^sub>h\<^sub>t))))))))" -definition "class_ty_ext_equiv_1of2_get_oid_inh\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y = (\<lambda> (mk\<E>\<X>\<T>\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y (oid)) \<Rightarrow> (oid) - | (mk\<E>\<X>\<T>\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n ((mk\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (t) (var\<^sub>b\<^sub>o\<^sub>s\<^sub>s) (var\<^sub>s\<^sub>a\<^sub>l\<^sub>a\<^sub>r\<^sub>y)))) \<Rightarrow> (case (class_ty_ext_equiv_1of2_get_oid_inh\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (t)) of (oid , var\<^sub>w\<^sub>o\<^sub>r\<^sub>m\<^sub>h\<^sub>o\<^sub>l\<^sub>e , var\<^sub>w\<^sub>e\<^sub>i\<^sub>g\<^sub>h\<^sub>t , var\<^sub>s\<^sub>o\<^sub>u\<^sub>n\<^sub>d , var\<^sub>m\<^sub>o\<^sub>v\<^sub>i\<^sub>n\<^sub>g , var\<^sub>o\<^sub>u\<^sub>t\<^sub>e\<^sub>r\<^sub>_\<^sub>w\<^sub>o\<^sub>r\<^sub>l\<^sub>d) \<Rightarrow> (oid)) - | (mk\<E>\<X>\<T>\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t ((mk\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (t) (var\<^sub>w\<^sub>o\<^sub>r\<^sub>m\<^sub>h\<^sub>o\<^sub>l\<^sub>e) (var\<^sub>w\<^sub>e\<^sub>i\<^sub>g\<^sub>h\<^sub>t)))) \<Rightarrow> (case (class_ty_ext_equiv_1of2_get_oid_inh\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (t)) of (oid , var\<^sub>s\<^sub>o\<^sub>u\<^sub>n\<^sub>d , var\<^sub>m\<^sub>o\<^sub>v\<^sub>i\<^sub>n\<^sub>g , var\<^sub>o\<^sub>u\<^sub>t\<^sub>e\<^sub>r\<^sub>_\<^sub>w\<^sub>o\<^sub>r\<^sub>l\<^sub>d) \<Rightarrow> (oid)))" -definition "class_ty_ext_equiv_1of2_aux\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y = (\<lambda> (mk\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y (t) (own\<^sub>s\<^sub>o\<^sub>u\<^sub>n\<^sub>d) (own\<^sub>m\<^sub>o\<^sub>v\<^sub>i\<^sub>n\<^sub>g) (own\<^sub>o\<^sub>u\<^sub>t\<^sub>e\<^sub>r\<^sub>_\<^sub>w\<^sub>o\<^sub>r\<^sub>l\<^sub>d)) \<Rightarrow> (mk2\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y (own\<^sub>s\<^sub>o\<^sub>u\<^sub>n\<^sub>d) (own\<^sub>m\<^sub>o\<^sub>v\<^sub>i\<^sub>n\<^sub>g) (own\<^sub>o\<^sub>u\<^sub>t\<^sub>e\<^sub>r\<^sub>_\<^sub>w\<^sub>o\<^sub>r\<^sub>l\<^sub>d) ((case t of (mk\<E>\<X>\<T>\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y (oid)) \<Rightarrow> None - | (mk\<E>\<X>\<T>\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (tt)) \<Rightarrow> (case (case tt of (mk\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (t) (var\<^sub>b\<^sub>o\<^sub>s\<^sub>s) (var\<^sub>s\<^sub>a\<^sub>l\<^sub>a\<^sub>r\<^sub>y)) \<Rightarrow> (class_ty_ext_equiv_1of2_get_oid_inh\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (t))) of (oid , var\<^sub>w\<^sub>o\<^sub>r\<^sub>m\<^sub>h\<^sub>o\<^sub>l\<^sub>e , var\<^sub>w\<^sub>e\<^sub>i\<^sub>g\<^sub>h\<^sub>t , var\<^sub>s\<^sub>o\<^sub>u\<^sub>n\<^sub>d , var\<^sub>m\<^sub>o\<^sub>v\<^sub>i\<^sub>n\<^sub>g , var\<^sub>o\<^sub>u\<^sub>t\<^sub>e\<^sub>r\<^sub>_\<^sub>w\<^sub>o\<^sub>r\<^sub>l\<^sub>d) \<Rightarrow> \<lfloor>(mk2\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t ((mk2\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (var\<^sub>w\<^sub>o\<^sub>r\<^sub>m\<^sub>h\<^sub>o\<^sub>l\<^sub>e) (var\<^sub>w\<^sub>e\<^sub>i\<^sub>g\<^sub>h\<^sub>t) (\<lfloor>(mk2\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n ((class_ty_ext_equiv_1of2_aux\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (tt))))\<rfloor>))))\<rfloor>) - | (mk\<E>\<X>\<T>\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (tt)) \<Rightarrow> (case (case tt of (mk\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (t) (var\<^sub>w\<^sub>o\<^sub>r\<^sub>m\<^sub>h\<^sub>o\<^sub>l\<^sub>e) (var\<^sub>w\<^sub>e\<^sub>i\<^sub>g\<^sub>h\<^sub>t)) \<Rightarrow> (class_ty_ext_equiv_1of2_get_oid_inh\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (t))) of (oid , var\<^sub>s\<^sub>o\<^sub>u\<^sub>n\<^sub>d , var\<^sub>m\<^sub>o\<^sub>v\<^sub>i\<^sub>n\<^sub>g , var\<^sub>o\<^sub>u\<^sub>t\<^sub>e\<^sub>r\<^sub>_\<^sub>w\<^sub>o\<^sub>r\<^sub>l\<^sub>d) \<Rightarrow> \<lfloor>(mk2\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t ((class_ty_ext_equiv_1of2_aux\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (tt))))\<rfloor>)))))" -definition "class_ty_ext_equiv_1of2\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y = (\<lambda> (mk\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y (t) (own\<^sub>s\<^sub>o\<^sub>u\<^sub>n\<^sub>d) (own\<^sub>m\<^sub>o\<^sub>v\<^sub>i\<^sub>n\<^sub>g) (own\<^sub>o\<^sub>u\<^sub>t\<^sub>e\<^sub>r\<^sub>_\<^sub>w\<^sub>o\<^sub>r\<^sub>l\<^sub>d)) \<Rightarrow> (case (class_ty_ext_equiv_1of2_get_oid_inh\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y (t)) of (oid) \<Rightarrow> (mk2oid\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y (oid) ((class_ty_ext_equiv_1of2_aux\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y ((mk\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y (t) (own\<^sub>s\<^sub>o\<^sub>u\<^sub>n\<^sub>d) (own\<^sub>m\<^sub>o\<^sub>v\<^sub>i\<^sub>n\<^sub>g) (own\<^sub>o\<^sub>u\<^sub>t\<^sub>e\<^sub>r\<^sub>_\<^sub>w\<^sub>o\<^sub>r\<^sub>l\<^sub>d))))))))" -definition "class_ty_ext_equiv_1of2_get_oid_inh\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y = (\<lambda> (mk\<E>\<X>\<T>\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y (oid)) \<Rightarrow> (oid) - | (mk\<E>\<X>\<T>\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n ((mk\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (t) (var\<^sub>b\<^sub>o\<^sub>s\<^sub>s) (var\<^sub>s\<^sub>a\<^sub>l\<^sub>a\<^sub>r\<^sub>y)))) \<Rightarrow> (case (class_ty_ext_equiv_1of2_get_oid_inh\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (t)) of (oid , var\<^sub>w\<^sub>o\<^sub>r\<^sub>m\<^sub>h\<^sub>o\<^sub>l\<^sub>e , var\<^sub>w\<^sub>e\<^sub>i\<^sub>g\<^sub>h\<^sub>t , var\<^sub>s\<^sub>o\<^sub>u\<^sub>n\<^sub>d , var\<^sub>m\<^sub>o\<^sub>v\<^sub>i\<^sub>n\<^sub>g , var\<^sub>o\<^sub>u\<^sub>t\<^sub>e\<^sub>r\<^sub>_\<^sub>w\<^sub>o\<^sub>r\<^sub>l\<^sub>d) \<Rightarrow> (oid)) - | (mk\<E>\<X>\<T>\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t ((mk\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (t) (var\<^sub>w\<^sub>o\<^sub>r\<^sub>m\<^sub>h\<^sub>o\<^sub>l\<^sub>e) (var\<^sub>w\<^sub>e\<^sub>i\<^sub>g\<^sub>h\<^sub>t)))) \<Rightarrow> (case (class_ty_ext_equiv_1of2_get_oid_inh\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (t)) of (oid , var\<^sub>s\<^sub>o\<^sub>u\<^sub>n\<^sub>d , var\<^sub>m\<^sub>o\<^sub>v\<^sub>i\<^sub>n\<^sub>g , var\<^sub>o\<^sub>u\<^sub>t\<^sub>e\<^sub>r\<^sub>_\<^sub>w\<^sub>o\<^sub>r\<^sub>l\<^sub>d) \<Rightarrow> (oid)) - | (mk\<E>\<X>\<T>\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y ((mk\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y (t) (var\<^sub>s\<^sub>o\<^sub>u\<^sub>n\<^sub>d) (var\<^sub>m\<^sub>o\<^sub>v\<^sub>i\<^sub>n\<^sub>g) (var\<^sub>o\<^sub>u\<^sub>t\<^sub>e\<^sub>r\<^sub>_\<^sub>w\<^sub>o\<^sub>r\<^sub>l\<^sub>d)))) \<Rightarrow> (case (class_ty_ext_equiv_1of2_get_oid_inh\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y (t)) of (oid) \<Rightarrow> (oid)))" -definition "class_ty_ext_equiv_1of2_aux\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y = (\<lambda> (mk\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y (t)) \<Rightarrow> (mk2\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y ((case t of (mk\<E>\<X>\<T>\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y (oid)) \<Rightarrow> None - | (mk\<E>\<X>\<T>\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (tt)) \<Rightarrow> (case (case tt of (mk\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (t) (var\<^sub>b\<^sub>o\<^sub>s\<^sub>s) (var\<^sub>s\<^sub>a\<^sub>l\<^sub>a\<^sub>r\<^sub>y)) \<Rightarrow> (class_ty_ext_equiv_1of2_get_oid_inh\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (t))) of (oid , var\<^sub>w\<^sub>o\<^sub>r\<^sub>m\<^sub>h\<^sub>o\<^sub>l\<^sub>e , var\<^sub>w\<^sub>e\<^sub>i\<^sub>g\<^sub>h\<^sub>t , var\<^sub>s\<^sub>o\<^sub>u\<^sub>n\<^sub>d , var\<^sub>m\<^sub>o\<^sub>v\<^sub>i\<^sub>n\<^sub>g , var\<^sub>o\<^sub>u\<^sub>t\<^sub>e\<^sub>r\<^sub>_\<^sub>w\<^sub>o\<^sub>r\<^sub>l\<^sub>d) \<Rightarrow> \<lfloor>(mk2\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y ((mk2\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y (var\<^sub>s\<^sub>o\<^sub>u\<^sub>n\<^sub>d) (var\<^sub>m\<^sub>o\<^sub>v\<^sub>i\<^sub>n\<^sub>g) (var\<^sub>o\<^sub>u\<^sub>t\<^sub>e\<^sub>r\<^sub>_\<^sub>w\<^sub>o\<^sub>r\<^sub>l\<^sub>d) (\<lfloor>(mk2\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t ((mk2\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (var\<^sub>w\<^sub>o\<^sub>r\<^sub>m\<^sub>h\<^sub>o\<^sub>l\<^sub>e) (var\<^sub>w\<^sub>e\<^sub>i\<^sub>g\<^sub>h\<^sub>t) (\<lfloor>(mk2\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n ((class_ty_ext_equiv_1of2_aux\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (tt))))\<rfloor>))))\<rfloor>))))\<rfloor>) - | (mk\<E>\<X>\<T>\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (tt)) \<Rightarrow> (case (case tt of (mk\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (t) (var\<^sub>w\<^sub>o\<^sub>r\<^sub>m\<^sub>h\<^sub>o\<^sub>l\<^sub>e) (var\<^sub>w\<^sub>e\<^sub>i\<^sub>g\<^sub>h\<^sub>t)) \<Rightarrow> (class_ty_ext_equiv_1of2_get_oid_inh\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (t))) of (oid , var\<^sub>s\<^sub>o\<^sub>u\<^sub>n\<^sub>d , var\<^sub>m\<^sub>o\<^sub>v\<^sub>i\<^sub>n\<^sub>g , var\<^sub>o\<^sub>u\<^sub>t\<^sub>e\<^sub>r\<^sub>_\<^sub>w\<^sub>o\<^sub>r\<^sub>l\<^sub>d) \<Rightarrow> \<lfloor>(mk2\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y ((mk2\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y (var\<^sub>s\<^sub>o\<^sub>u\<^sub>n\<^sub>d) (var\<^sub>m\<^sub>o\<^sub>v\<^sub>i\<^sub>n\<^sub>g) (var\<^sub>o\<^sub>u\<^sub>t\<^sub>e\<^sub>r\<^sub>_\<^sub>w\<^sub>o\<^sub>r\<^sub>l\<^sub>d) (\<lfloor>(mk2\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t ((class_ty_ext_equiv_1of2_aux\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (tt))))\<rfloor>))))\<rfloor>) - | (mk\<E>\<X>\<T>\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y (tt)) \<Rightarrow> (case (case tt of (mk\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y (t) (var\<^sub>s\<^sub>o\<^sub>u\<^sub>n\<^sub>d) (var\<^sub>m\<^sub>o\<^sub>v\<^sub>i\<^sub>n\<^sub>g) (var\<^sub>o\<^sub>u\<^sub>t\<^sub>e\<^sub>r\<^sub>_\<^sub>w\<^sub>o\<^sub>r\<^sub>l\<^sub>d)) \<Rightarrow> (class_ty_ext_equiv_1of2_get_oid_inh\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y (t))) of (oid) \<Rightarrow> \<lfloor>(mk2\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y ((class_ty_ext_equiv_1of2_aux\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y (tt))))\<rfloor>)))))" -definition "class_ty_ext_equiv_1of2\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y = (\<lambda> (mk\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y (t)) \<Rightarrow> (case (class_ty_ext_equiv_1of2_get_oid_inh\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y (t)) of (oid) \<Rightarrow> (mk2oid\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y (oid) ((class_ty_ext_equiv_1of2_aux\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y ((mk\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y (t))))))))" - -(* 19 ************************************ 52 + 1 *) -text \<open> - Now, we construct a concrete ``universe of OclAny types'' by injection into a -sum type containing the class types. This type of OclAny will be used as instance -for all respective type-variables. \<close> - -(* 20 ************************************ 53 + 1 *) (* term Floor1_infra.print_infra_datatype_universe *) -datatype \<AA> = in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n "ty\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n" - | in\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t "ty\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t" - | in\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y "ty\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y" - | in\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y "ty\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y" - -(* 21 ************************************ 54 + 1 *) -text \<open> - Having fixed the object universe, we can introduce type synonyms that exactly correspond -to \OCL types. Again, we exploit that our representation of \OCL is a ``shallow embedding'' with a -one-to-one correspondance of \OCL-types to types of the meta-language \HOL. \<close> - -(* 22 ************************************ 55 + 7 *) (* term Floor1_infra.print_infra_type_synonym_class *) -type_synonym Void = "\<AA> Void" -type_synonym Boolean = "\<AA> Boolean" -type_synonym Integer = "\<AA> Integer" -type_synonym Real = "\<AA> Real" -type_synonym String = "\<AA> String" -type_synonym '\<alpha> val' = "(\<AA>, '\<alpha>) val" -type_notation val' ("\<cdot>(_)") - -(* 23 ************************************ 62 + 4 *) (* term Floor1_infra.print_infra_type_synonym_class_higher *) -type_synonym Person = "\<langle>\<langle>ty\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rangle>\<^sub>\<bottom>\<rangle>\<^sub>\<bottom>" -type_synonym Planet = "\<langle>\<langle>ty\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t\<rangle>\<^sub>\<bottom>\<rangle>\<^sub>\<bottom>" -type_synonym Galaxy = "\<langle>\<langle>ty\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y\<rangle>\<^sub>\<bottom>\<rangle>\<^sub>\<bottom>" -type_synonym OclAny = "\<langle>\<langle>ty\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y\<rangle>\<^sub>\<bottom>\<rangle>\<^sub>\<bottom>" - -(* 24 ************************************ 66 + 3 *) (* term Floor1_infra.print_infra_type_synonym_class_rec *) -type_synonym Sequence_Person = "(\<AA>, ty\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n option option Sequence\<^sub>b\<^sub>a\<^sub>s\<^sub>e) val" -type_synonym Set_Person = "(\<AA>, ty\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n option option Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e) val" -type_synonym Set_Sequence_Planet = "(\<AA>, ty\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t option option Sequence\<^sub>b\<^sub>a\<^sub>s\<^sub>e Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e) val" - -(* 25 ************************************ 69 + 0 *) (* term Floor1_infra.print_infra_enum_syn *) - -(* 26 ************************************ 69 + 1 *) -text \<open> - To reuse key-elements of the library like referential equality, we have -to show that the object universe belongs to the type class ``oclany,'' \ie, - each class type has to provide a function @{term oid_of} yielding the Object ID (oid) of the object. \<close> - -(* 27 ************************************ 70 + 4 *) (* term Floor1_infra.print_infra_instantiation_class *) -instantiation ty\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n :: object -begin - definition oid_of_ty\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_def : "oid_of = (\<lambda> mk\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n t _ _ \<Rightarrow> (case t of (mk\<E>\<X>\<T>\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (t) (_) (_) (_) (_) (_)) \<Rightarrow> t))" - instance .. -end -instantiation ty\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t :: object -begin - definition oid_of_ty\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_def : "oid_of = (\<lambda> mk\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t t _ _ \<Rightarrow> (case t of (mk\<E>\<X>\<T>\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (t) (_) (_) (_)) \<Rightarrow> t - | (mk\<E>\<X>\<T>\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (t)) \<Rightarrow> (oid_of (t))))" - instance .. -end -instantiation ty\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y :: object -begin - definition oid_of_ty\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_def : "oid_of = (\<lambda> mk\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y t _ _ _ \<Rightarrow> (case t of (mk\<E>\<X>\<T>\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y (t)) \<Rightarrow> t - | (mk\<E>\<X>\<T>\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (t)) \<Rightarrow> (oid_of (t)) - | (mk\<E>\<X>\<T>\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (t)) \<Rightarrow> (oid_of (t))))" - instance .. -end -instantiation ty\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y :: object -begin - definition oid_of_ty\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_def : "oid_of = (\<lambda> mk\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y t \<Rightarrow> (case t of (mk\<E>\<X>\<T>\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y (t)) \<Rightarrow> t - | (mk\<E>\<X>\<T>\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (t)) \<Rightarrow> (oid_of (t)) - | (mk\<E>\<X>\<T>\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (t)) \<Rightarrow> (oid_of (t)) - | (mk\<E>\<X>\<T>\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y (t)) \<Rightarrow> (oid_of (t))))" - instance .. -end - -(* 28 ************************************ 74 + 1 *) (* term Floor1_infra.print_infra_instantiation_universe *) -instantiation \<AA> :: object -begin - definition oid_of_\<AA>_def : "oid_of = (\<lambda> in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n Person \<Rightarrow> oid_of Person - | in\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t Planet \<Rightarrow> oid_of Planet - | in\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y Galaxy \<Rightarrow> oid_of Galaxy - | in\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y OclAny \<Rightarrow> oid_of OclAny)" - instance .. -end - -(* 29 ************************************ 75 + 1 *) -section \<open>Class Model: Instantiation of the Generic Strict Equality\<close> - -(* 30 ************************************ 76 + 1 *) -text \<open> - We instantiate the referential equality -on @{text "Person"} and @{text "OclAny"} \<close> - -(* 31 ************************************ 77 + 4 *) (* term Floor1_infra.print_instantia_def_strictrefeq *) -overloading StrictRefEq \<equiv> "(StrictRefEq::(\<cdot>Person) \<Rightarrow> _ \<Rightarrow> _)" -begin - definition StrictRefEq\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n : "(x::\<cdot>Person) \<doteq> y \<equiv> StrictRefEq\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t x y" -end -overloading StrictRefEq \<equiv> "(StrictRefEq::(\<cdot>Planet) \<Rightarrow> _ \<Rightarrow> _)" -begin - definition StrictRefEq\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t : "(x::\<cdot>Planet) \<doteq> y \<equiv> StrictRefEq\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t x y" -end -overloading StrictRefEq \<equiv> "(StrictRefEq::(\<cdot>Galaxy) \<Rightarrow> _ \<Rightarrow> _)" -begin - definition StrictRefEq\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y : "(x::\<cdot>Galaxy) \<doteq> y \<equiv> StrictRefEq\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t x y" -end -overloading StrictRefEq \<equiv> "(StrictRefEq::(\<cdot>OclAny) \<Rightarrow> _ \<Rightarrow> _)" -begin - definition StrictRefEq\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y : "(x::\<cdot>OclAny) \<doteq> y \<equiv> StrictRefEq\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t x y" -end - -(* 32 ************************************ 81 + 1 *) (* term Floor1_infra.print_instantia_lemmas_strictrefeq *) -lemmas[simp,code_unfold] = StrictRefEq\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n - StrictRefEq\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t - StrictRefEq\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y - StrictRefEq\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y - -(* 33 ************************************ 82 + 1 *) -text \<open> - For each Class \emph{C}, we will have a casting operation \inlineocl{.oclAsType($C$)}, - a test on the actual type \inlineocl{.oclIsTypeOf($C$)} as well as its relaxed form - \inlineocl{.oclIsKindOf($C$)} (corresponding exactly to Java's \verb+instanceof+-operator. -\<close> - -(* 34 ************************************ 83 + 1 *) -text \<open> - Thus, since we have two class-types in our concrete class hierarchy, we have -two operations to declare and to provide two overloading definitions for the two static types. -\<close> - -(* 35 ************************************ 84 + 1 *) -section \<open>Class Model: OclAsType\<close> - -(* 36 ************************************ 85 + 1 *) -subsection \<open>Definition\<close> - -(* 37 ************************************ 86 + 4 *) (* term Floor1_astype.print_astype_consts *) -consts OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n :: "'\<alpha> \<Rightarrow> \<cdot>Person" ("(_) .oclAsType'(Person')") -consts OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t :: "'\<alpha> \<Rightarrow> \<cdot>Planet" ("(_) .oclAsType'(Planet')") -consts OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y :: "'\<alpha> \<Rightarrow> \<cdot>Galaxy" ("(_) .oclAsType'(Galaxy')") -consts OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y :: "'\<alpha> \<Rightarrow> \<cdot>OclAny" ("(_) .oclAsType'(OclAny')") - -(* 38 ************************************ 90 + 16 *) (* term Floor1_astype.print_astype_class *) -overloading OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n \<equiv> "(OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n::(\<cdot>Person) \<Rightarrow> _)" -begin - definition OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person : "(x::\<cdot>Person) .oclAsType(Person) \<equiv> x" -end -overloading OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n \<equiv> "(OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n::(\<cdot>Planet) \<Rightarrow> _)" -begin - definition OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet : "(x::\<cdot>Planet) .oclAsType(Person) \<equiv> (\<lambda>\<tau>. (case (x (\<tau>)) of \<bottom> \<Rightarrow> (invalid (\<tau>)) - | \<lfloor>\<bottom>\<rfloor> \<Rightarrow> (null (\<tau>)) - | \<lfloor>\<lfloor>(mk\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t ((mk\<E>\<X>\<T>\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (Person))) (_) (_))\<rfloor>\<rfloor> \<Rightarrow> \<lfloor>\<lfloor>Person\<rfloor>\<rfloor> - | _ \<Rightarrow> (invalid (\<tau>))))" -end -overloading OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n \<equiv> "(OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n::(\<cdot>Galaxy) \<Rightarrow> _)" -begin - definition OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy : "(x::\<cdot>Galaxy) .oclAsType(Person) \<equiv> (\<lambda>\<tau>. (case (x (\<tau>)) of \<bottom> \<Rightarrow> (invalid (\<tau>)) - | \<lfloor>\<bottom>\<rfloor> \<Rightarrow> (null (\<tau>)) - | \<lfloor>\<lfloor>(mk\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y ((mk\<E>\<X>\<T>\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (Person))) (_) (_) (_))\<rfloor>\<rfloor> \<Rightarrow> \<lfloor>\<lfloor>Person\<rfloor>\<rfloor> - | _ \<Rightarrow> (invalid (\<tau>))))" -end -overloading OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n \<equiv> "(OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n::(\<cdot>OclAny) \<Rightarrow> _)" -begin - definition OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny : "(x::\<cdot>OclAny) .oclAsType(Person) \<equiv> (\<lambda>\<tau>. (case (x (\<tau>)) of \<bottom> \<Rightarrow> (invalid (\<tau>)) - | \<lfloor>\<bottom>\<rfloor> \<Rightarrow> (null (\<tau>)) - | \<lfloor>\<lfloor>(mk\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y ((mk\<E>\<X>\<T>\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (Person))))\<rfloor>\<rfloor> \<Rightarrow> \<lfloor>\<lfloor>Person\<rfloor>\<rfloor> - | _ \<Rightarrow> (invalid (\<tau>))))" -end -overloading OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t \<equiv> "(OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t::(\<cdot>Planet) \<Rightarrow> _)" -begin - definition OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet : "(x::\<cdot>Planet) .oclAsType(Planet) \<equiv> x" -end -overloading OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t \<equiv> "(OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t::(\<cdot>Galaxy) \<Rightarrow> _)" -begin - definition OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy : "(x::\<cdot>Galaxy) .oclAsType(Planet) \<equiv> (\<lambda>\<tau>. (case (x (\<tau>)) of \<bottom> \<Rightarrow> (invalid (\<tau>)) - | \<lfloor>\<bottom>\<rfloor> \<Rightarrow> (null (\<tau>)) - | \<lfloor>\<lfloor>(mk\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y ((mk\<E>\<X>\<T>\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (Planet))) (_) (_) (_))\<rfloor>\<rfloor> \<Rightarrow> \<lfloor>\<lfloor>Planet\<rfloor>\<rfloor> - | _ \<Rightarrow> (invalid (\<tau>))))" -end -overloading OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t \<equiv> "(OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t::(\<cdot>OclAny) \<Rightarrow> _)" -begin - definition OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny : "(x::\<cdot>OclAny) .oclAsType(Planet) \<equiv> (\<lambda>\<tau>. (case (x (\<tau>)) of \<bottom> \<Rightarrow> (invalid (\<tau>)) - | \<lfloor>\<bottom>\<rfloor> \<Rightarrow> (null (\<tau>)) - | \<lfloor>\<lfloor>(mk\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y ((mk\<E>\<X>\<T>\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (Planet))))\<rfloor>\<rfloor> \<Rightarrow> \<lfloor>\<lfloor>Planet\<rfloor>\<rfloor> - | _ \<Rightarrow> (invalid (\<tau>))))" -end -overloading OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t \<equiv> "(OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t::(\<cdot>Person) \<Rightarrow> _)" -begin - definition OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person : "(x::\<cdot>Person) .oclAsType(Planet) \<equiv> (\<lambda>\<tau>. (case (x (\<tau>)) of \<bottom> \<Rightarrow> (invalid (\<tau>)) - | \<lfloor>\<bottom>\<rfloor> \<Rightarrow> (null (\<tau>)) - | \<lfloor>\<lfloor>Person\<rfloor>\<rfloor> \<Rightarrow> \<lfloor>\<lfloor>(mk\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t ((mk\<E>\<X>\<T>\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (Person))) (None) (None))\<rfloor>\<rfloor>))" -end -overloading OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y \<equiv> "(OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y::(\<cdot>Galaxy) \<Rightarrow> _)" -begin - definition OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy : "(x::\<cdot>Galaxy) .oclAsType(Galaxy) \<equiv> x" -end -overloading OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y \<equiv> "(OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y::(\<cdot>OclAny) \<Rightarrow> _)" -begin - definition OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny : "(x::\<cdot>OclAny) .oclAsType(Galaxy) \<equiv> (\<lambda>\<tau>. (case (x (\<tau>)) of \<bottom> \<Rightarrow> (invalid (\<tau>)) - | \<lfloor>\<bottom>\<rfloor> \<Rightarrow> (null (\<tau>)) - | \<lfloor>\<lfloor>(mk\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y ((mk\<E>\<X>\<T>\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y (Galaxy))))\<rfloor>\<rfloor> \<Rightarrow> \<lfloor>\<lfloor>Galaxy\<rfloor>\<rfloor> - | _ \<Rightarrow> (invalid (\<tau>))))" -end -overloading OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y \<equiv> "(OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y::(\<cdot>Person) \<Rightarrow> _)" -begin - definition OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person : "(x::\<cdot>Person) .oclAsType(Galaxy) \<equiv> (\<lambda>\<tau>. (case (x (\<tau>)) of \<bottom> \<Rightarrow> (invalid (\<tau>)) - | \<lfloor>\<bottom>\<rfloor> \<Rightarrow> (null (\<tau>)) - | \<lfloor>\<lfloor>Person\<rfloor>\<rfloor> \<Rightarrow> \<lfloor>\<lfloor>(mk\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y ((mk\<E>\<X>\<T>\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (Person))) (None) (None) (None))\<rfloor>\<rfloor>))" -end -overloading OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y \<equiv> "(OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y::(\<cdot>Planet) \<Rightarrow> _)" -begin - definition OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet : "(x::\<cdot>Planet) .oclAsType(Galaxy) \<equiv> (\<lambda>\<tau>. (case (x (\<tau>)) of \<bottom> \<Rightarrow> (invalid (\<tau>)) - | \<lfloor>\<bottom>\<rfloor> \<Rightarrow> (null (\<tau>)) - | \<lfloor>\<lfloor>Planet\<rfloor>\<rfloor> \<Rightarrow> \<lfloor>\<lfloor>(mk\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y ((mk\<E>\<X>\<T>\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (Planet))) (None) (None) (None))\<rfloor>\<rfloor>))" -end -overloading OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y \<equiv> "(OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y::(\<cdot>OclAny) \<Rightarrow> _)" -begin - definition OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny : "(x::\<cdot>OclAny) .oclAsType(OclAny) \<equiv> x" -end -overloading OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y \<equiv> "(OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y::(\<cdot>Person) \<Rightarrow> _)" -begin - definition OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person : "(x::\<cdot>Person) .oclAsType(OclAny) \<equiv> (\<lambda>\<tau>. (case (x (\<tau>)) of \<bottom> \<Rightarrow> (invalid (\<tau>)) - | \<lfloor>\<bottom>\<rfloor> \<Rightarrow> (null (\<tau>)) - | \<lfloor>\<lfloor>Person\<rfloor>\<rfloor> \<Rightarrow> \<lfloor>\<lfloor>(mk\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y ((mk\<E>\<X>\<T>\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (Person))))\<rfloor>\<rfloor>))" -end -overloading OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y \<equiv> "(OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y::(\<cdot>Planet) \<Rightarrow> _)" -begin - definition OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet : "(x::\<cdot>Planet) .oclAsType(OclAny) \<equiv> (\<lambda>\<tau>. (case (x (\<tau>)) of \<bottom> \<Rightarrow> (invalid (\<tau>)) - | \<lfloor>\<bottom>\<rfloor> \<Rightarrow> (null (\<tau>)) - | \<lfloor>\<lfloor>Planet\<rfloor>\<rfloor> \<Rightarrow> \<lfloor>\<lfloor>(mk\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y ((mk\<E>\<X>\<T>\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (Planet))))\<rfloor>\<rfloor>))" -end -overloading OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y \<equiv> "(OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y::(\<cdot>Galaxy) \<Rightarrow> _)" -begin - definition OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy : "(x::\<cdot>Galaxy) .oclAsType(OclAny) \<equiv> (\<lambda>\<tau>. (case (x (\<tau>)) of \<bottom> \<Rightarrow> (invalid (\<tau>)) - | \<lfloor>\<bottom>\<rfloor> \<Rightarrow> (null (\<tau>)) - | \<lfloor>\<lfloor>Galaxy\<rfloor>\<rfloor> \<Rightarrow> \<lfloor>\<lfloor>(mk\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y ((mk\<E>\<X>\<T>\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y (Galaxy))))\<rfloor>\<rfloor>))" -end - -(* 39 ************************************ 106 + 4 *) (* term Floor1_astype.print_astype_from_universe *) -definition "OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_\<AA> = (\<lambda> (in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (Person)) \<Rightarrow> \<lfloor>Person\<rfloor> - | (in\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t ((mk\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t ((mk\<E>\<X>\<T>\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (Person))) (_) (_)))) \<Rightarrow> \<lfloor>Person\<rfloor> - | (in\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y ((mk\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y ((mk\<E>\<X>\<T>\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (Person))) (_) (_) (_)))) \<Rightarrow> \<lfloor>Person\<rfloor> - | (in\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y ((mk\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y ((mk\<E>\<X>\<T>\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (Person)))))) \<Rightarrow> \<lfloor>Person\<rfloor> - | _ \<Rightarrow> None)" -definition "OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_\<AA> = (\<lambda> (in\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (Planet)) \<Rightarrow> \<lfloor>Planet\<rfloor> - | (in\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y ((mk\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y ((mk\<E>\<X>\<T>\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (Planet))) (_) (_) (_)))) \<Rightarrow> \<lfloor>Planet\<rfloor> - | (in\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y ((mk\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y ((mk\<E>\<X>\<T>\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (Planet)))))) \<Rightarrow> \<lfloor>Planet\<rfloor> - | (in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (Person)) \<Rightarrow> \<lfloor>(mk\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t ((mk\<E>\<X>\<T>\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (Person))) (None) (None))\<rfloor> - | _ \<Rightarrow> None)" -definition "OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_\<AA> = (\<lambda> (in\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y (Galaxy)) \<Rightarrow> \<lfloor>Galaxy\<rfloor> - | (in\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y ((mk\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y ((mk\<E>\<X>\<T>\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y (Galaxy)))))) \<Rightarrow> \<lfloor>Galaxy\<rfloor> - | (in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (Person)) \<Rightarrow> \<lfloor>(mk\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y ((mk\<E>\<X>\<T>\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (Person))) (None) (None) (None))\<rfloor> - | (in\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (Planet)) \<Rightarrow> \<lfloor>(mk\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y ((mk\<E>\<X>\<T>\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (Planet))) (None) (None) (None))\<rfloor> - | _ \<Rightarrow> None)" -definition "OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_\<AA> = Some o (\<lambda> (in\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y (OclAny)) \<Rightarrow> OclAny - | (in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (Person)) \<Rightarrow> (mk\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y ((mk\<E>\<X>\<T>\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (Person)))) - | (in\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (Planet)) \<Rightarrow> (mk\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y ((mk\<E>\<X>\<T>\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (Planet)))) - | (in\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y (Galaxy)) \<Rightarrow> (mk\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y ((mk\<E>\<X>\<T>\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y (Galaxy)))))" - -(* 40 ************************************ 110 + 1 *) (* term Floor1_astype.print_astype_lemmas_id *) -lemmas[simp,code_unfold] = OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person - OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet - OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy - OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny - -(* 41 ************************************ 111 + 1 *) -subsection \<open>Context Passing\<close> - -(* 42 ************************************ 112 + 64 *) (* term Floor1_astype.print_astype_lemma_cp *) -lemma cp_OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_OclAny : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>OclAny)))::\<cdot>OclAny) .oclAsType(OclAny)))))" -by(rule cpI1, simp) -lemma cp_OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy_OclAny : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Galaxy)))::\<cdot>OclAny) .oclAsType(OclAny)))))" -by(rule cpI1, simp) -lemma cp_OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet_OclAny : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Planet)))::\<cdot>OclAny) .oclAsType(OclAny)))))" -by(rule cpI1, simp) -lemma cp_OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_OclAny : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Person)))::\<cdot>OclAny) .oclAsType(OclAny)))))" -by(rule cpI1, simp) -lemma cp_OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_Galaxy : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>OclAny)))::\<cdot>Galaxy) .oclAsType(OclAny)))))" -by(rule cpI1, simp add: OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy) -lemma cp_OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy_Galaxy : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Galaxy)))::\<cdot>Galaxy) .oclAsType(OclAny)))))" -by(rule cpI1, simp add: OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy) -lemma cp_OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet_Galaxy : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Planet)))::\<cdot>Galaxy) .oclAsType(OclAny)))))" -by(rule cpI1, simp add: OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy) -lemma cp_OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_Galaxy : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Person)))::\<cdot>Galaxy) .oclAsType(OclAny)))))" -by(rule cpI1, simp add: OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy) -lemma cp_OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_Planet : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>OclAny)))::\<cdot>Planet) .oclAsType(OclAny)))))" -by(rule cpI1, simp add: OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet) -lemma cp_OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy_Planet : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Galaxy)))::\<cdot>Planet) .oclAsType(OclAny)))))" -by(rule cpI1, simp add: OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet) -lemma cp_OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet_Planet : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Planet)))::\<cdot>Planet) .oclAsType(OclAny)))))" -by(rule cpI1, simp add: OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet) -lemma cp_OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_Planet : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Person)))::\<cdot>Planet) .oclAsType(OclAny)))))" -by(rule cpI1, simp add: OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet) -lemma cp_OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_Person : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>OclAny)))::\<cdot>Person) .oclAsType(OclAny)))))" -by(rule cpI1, simp add: OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person) -lemma cp_OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy_Person : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Galaxy)))::\<cdot>Person) .oclAsType(OclAny)))))" -by(rule cpI1, simp add: OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person) -lemma cp_OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet_Person : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Planet)))::\<cdot>Person) .oclAsType(OclAny)))))" -by(rule cpI1, simp add: OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person) -lemma cp_OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_Person : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Person)))::\<cdot>Person) .oclAsType(OclAny)))))" -by(rule cpI1, simp add: OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person) -lemma cp_OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny_OclAny : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>OclAny)))::\<cdot>OclAny) .oclAsType(Galaxy)))))" -by(rule cpI1, simp add: OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny) -lemma cp_OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy_OclAny : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Galaxy)))::\<cdot>OclAny) .oclAsType(Galaxy)))))" -by(rule cpI1, simp add: OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny) -lemma cp_OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet_OclAny : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Planet)))::\<cdot>OclAny) .oclAsType(Galaxy)))))" -by(rule cpI1, simp add: OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny) -lemma cp_OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person_OclAny : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Person)))::\<cdot>OclAny) .oclAsType(Galaxy)))))" -by(rule cpI1, simp add: OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny) -lemma cp_OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny_Galaxy : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>OclAny)))::\<cdot>Galaxy) .oclAsType(Galaxy)))))" -by(rule cpI1, simp) -lemma cp_OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy_Galaxy : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Galaxy)))::\<cdot>Galaxy) .oclAsType(Galaxy)))))" -by(rule cpI1, simp) -lemma cp_OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet_Galaxy : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Planet)))::\<cdot>Galaxy) .oclAsType(Galaxy)))))" -by(rule cpI1, simp) -lemma cp_OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person_Galaxy : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Person)))::\<cdot>Galaxy) .oclAsType(Galaxy)))))" -by(rule cpI1, simp) -lemma cp_OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny_Planet : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>OclAny)))::\<cdot>Planet) .oclAsType(Galaxy)))))" -by(rule cpI1, simp add: OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet) -lemma cp_OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy_Planet : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Galaxy)))::\<cdot>Planet) .oclAsType(Galaxy)))))" -by(rule cpI1, simp add: OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet) -lemma cp_OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet_Planet : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Planet)))::\<cdot>Planet) .oclAsType(Galaxy)))))" -by(rule cpI1, simp add: OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet) -lemma cp_OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person_Planet : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Person)))::\<cdot>Planet) .oclAsType(Galaxy)))))" -by(rule cpI1, simp add: OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet) -lemma cp_OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny_Person : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>OclAny)))::\<cdot>Person) .oclAsType(Galaxy)))))" -by(rule cpI1, simp add: OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person) -lemma cp_OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy_Person : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Galaxy)))::\<cdot>Person) .oclAsType(Galaxy)))))" -by(rule cpI1, simp add: OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person) -lemma cp_OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet_Person : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Planet)))::\<cdot>Person) .oclAsType(Galaxy)))))" -by(rule cpI1, simp add: OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person) -lemma cp_OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person_Person : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Person)))::\<cdot>Person) .oclAsType(Galaxy)))))" -by(rule cpI1, simp add: OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person) -lemma cp_OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny_OclAny : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>OclAny)))::\<cdot>OclAny) .oclAsType(Planet)))))" -by(rule cpI1, simp add: OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny) -lemma cp_OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy_OclAny : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Galaxy)))::\<cdot>OclAny) .oclAsType(Planet)))))" -by(rule cpI1, simp add: OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny) -lemma cp_OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet_OclAny : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Planet)))::\<cdot>OclAny) .oclAsType(Planet)))))" -by(rule cpI1, simp add: OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny) -lemma cp_OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person_OclAny : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Person)))::\<cdot>OclAny) .oclAsType(Planet)))))" -by(rule cpI1, simp add: OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny) -lemma cp_OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny_Galaxy : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>OclAny)))::\<cdot>Galaxy) .oclAsType(Planet)))))" -by(rule cpI1, simp add: OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy) -lemma cp_OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy_Galaxy : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Galaxy)))::\<cdot>Galaxy) .oclAsType(Planet)))))" -by(rule cpI1, simp add: OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy) -lemma cp_OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet_Galaxy : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Planet)))::\<cdot>Galaxy) .oclAsType(Planet)))))" -by(rule cpI1, simp add: OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy) -lemma cp_OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person_Galaxy : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Person)))::\<cdot>Galaxy) .oclAsType(Planet)))))" -by(rule cpI1, simp add: OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy) -lemma cp_OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny_Planet : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>OclAny)))::\<cdot>Planet) .oclAsType(Planet)))))" -by(rule cpI1, simp) -lemma cp_OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy_Planet : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Galaxy)))::\<cdot>Planet) .oclAsType(Planet)))))" -by(rule cpI1, simp) -lemma cp_OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet_Planet : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Planet)))::\<cdot>Planet) .oclAsType(Planet)))))" -by(rule cpI1, simp) -lemma cp_OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person_Planet : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Person)))::\<cdot>Planet) .oclAsType(Planet)))))" -by(rule cpI1, simp) -lemma cp_OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny_Person : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>OclAny)))::\<cdot>Person) .oclAsType(Planet)))))" -by(rule cpI1, simp add: OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person) -lemma cp_OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy_Person : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Galaxy)))::\<cdot>Person) .oclAsType(Planet)))))" -by(rule cpI1, simp add: OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person) -lemma cp_OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet_Person : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Planet)))::\<cdot>Person) .oclAsType(Planet)))))" -by(rule cpI1, simp add: OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person) -lemma cp_OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person_Person : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Person)))::\<cdot>Person) .oclAsType(Planet)))))" -by(rule cpI1, simp add: OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person) -lemma cp_OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_OclAny : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>OclAny)))::\<cdot>OclAny) .oclAsType(Person)))))" -by(rule cpI1, simp add: OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny) -lemma cp_OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy_OclAny : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Galaxy)))::\<cdot>OclAny) .oclAsType(Person)))))" -by(rule cpI1, simp add: OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny) -lemma cp_OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet_OclAny : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Planet)))::\<cdot>OclAny) .oclAsType(Person)))))" -by(rule cpI1, simp add: OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny) -lemma cp_OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_OclAny : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Person)))::\<cdot>OclAny) .oclAsType(Person)))))" -by(rule cpI1, simp add: OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny) -lemma cp_OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_Galaxy : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>OclAny)))::\<cdot>Galaxy) .oclAsType(Person)))))" -by(rule cpI1, simp add: OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy) -lemma cp_OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy_Galaxy : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Galaxy)))::\<cdot>Galaxy) .oclAsType(Person)))))" -by(rule cpI1, simp add: OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy) -lemma cp_OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet_Galaxy : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Planet)))::\<cdot>Galaxy) .oclAsType(Person)))))" -by(rule cpI1, simp add: OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy) -lemma cp_OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_Galaxy : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Person)))::\<cdot>Galaxy) .oclAsType(Person)))))" -by(rule cpI1, simp add: OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy) -lemma cp_OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_Planet : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>OclAny)))::\<cdot>Planet) .oclAsType(Person)))))" -by(rule cpI1, simp add: OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet) -lemma cp_OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy_Planet : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Galaxy)))::\<cdot>Planet) .oclAsType(Person)))))" -by(rule cpI1, simp add: OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet) -lemma cp_OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet_Planet : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Planet)))::\<cdot>Planet) .oclAsType(Person)))))" -by(rule cpI1, simp add: OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet) -lemma cp_OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_Planet : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Person)))::\<cdot>Planet) .oclAsType(Person)))))" -by(rule cpI1, simp add: OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet) -lemma cp_OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_Person : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>OclAny)))::\<cdot>Person) .oclAsType(Person)))))" -by(rule cpI1, simp) -lemma cp_OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy_Person : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Galaxy)))::\<cdot>Person) .oclAsType(Person)))))" -by(rule cpI1, simp) -lemma cp_OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet_Person : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Planet)))::\<cdot>Person) .oclAsType(Person)))))" -by(rule cpI1, simp) -lemma cp_OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_Person : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Person)))::\<cdot>Person) .oclAsType(Person)))))" -by(rule cpI1, simp) - -(* 43 ************************************ 176 + 1 *) (* term Floor1_astype.print_astype_lemmas_cp *) -lemmas[simp,code_unfold] = cp_OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_OclAny - cp_OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy_OclAny - cp_OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet_OclAny - cp_OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_OclAny - cp_OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_Galaxy - cp_OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy_Galaxy - cp_OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet_Galaxy - cp_OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_Galaxy - cp_OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_Planet - cp_OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy_Planet - cp_OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet_Planet - cp_OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_Planet - cp_OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_Person - cp_OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy_Person - cp_OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet_Person - cp_OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_Person - cp_OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny_OclAny - cp_OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy_OclAny - cp_OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet_OclAny - cp_OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person_OclAny - cp_OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny_Galaxy - cp_OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy_Galaxy - cp_OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet_Galaxy - cp_OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person_Galaxy - cp_OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny_Planet - cp_OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy_Planet - cp_OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet_Planet - cp_OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person_Planet - cp_OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny_Person - cp_OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy_Person - cp_OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet_Person - cp_OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person_Person - cp_OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny_OclAny - cp_OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy_OclAny - cp_OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet_OclAny - cp_OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person_OclAny - cp_OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny_Galaxy - cp_OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy_Galaxy - cp_OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet_Galaxy - cp_OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person_Galaxy - cp_OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny_Planet - cp_OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy_Planet - cp_OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet_Planet - cp_OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person_Planet - cp_OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny_Person - cp_OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy_Person - cp_OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet_Person - cp_OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person_Person - cp_OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_OclAny - cp_OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy_OclAny - cp_OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet_OclAny - cp_OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_OclAny - cp_OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_Galaxy - cp_OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy_Galaxy - cp_OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet_Galaxy - cp_OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_Galaxy - cp_OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_Planet - cp_OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy_Planet - cp_OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet_Planet - cp_OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_Planet - cp_OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_Person - cp_OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy_Person - cp_OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet_Person - cp_OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_Person - -(* 44 ************************************ 177 + 1 *) -subsection \<open>Execution with Invalid or Null as Argument\<close> - -(* 45 ************************************ 178 + 32 *) (* term Floor1_astype.print_astype_lemma_strict *) -lemma OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_invalid : "((invalid::\<cdot>OclAny) .oclAsType(OclAny)) = invalid" -by(simp) -lemma OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy_invalid : "((invalid::\<cdot>Galaxy) .oclAsType(OclAny)) = invalid" -by(rule ext, simp add: OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy bot_option_def invalid_def) -lemma OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet_invalid : "((invalid::\<cdot>Planet) .oclAsType(OclAny)) = invalid" -by(rule ext, simp add: OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet bot_option_def invalid_def) -lemma OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_invalid : "((invalid::\<cdot>Person) .oclAsType(OclAny)) = invalid" -by(rule ext, simp add: OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person bot_option_def invalid_def) -lemma OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_null : "((null::\<cdot>OclAny) .oclAsType(OclAny)) = null" -by(simp) -lemma OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy_null : "((null::\<cdot>Galaxy) .oclAsType(OclAny)) = null" -by(rule ext, simp add: OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy bot_option_def null_fun_def null_option_def) -lemma OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet_null : "((null::\<cdot>Planet) .oclAsType(OclAny)) = null" -by(rule ext, simp add: OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet bot_option_def null_fun_def null_option_def) -lemma OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_null : "((null::\<cdot>Person) .oclAsType(OclAny)) = null" -by(rule ext, simp add: OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person bot_option_def null_fun_def null_option_def) -lemma OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny_invalid : "((invalid::\<cdot>OclAny) .oclAsType(Galaxy)) = invalid" -by(rule ext, simp add: OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny bot_option_def invalid_def) -lemma OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy_invalid : "((invalid::\<cdot>Galaxy) .oclAsType(Galaxy)) = invalid" -by(simp) -lemma OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet_invalid : "((invalid::\<cdot>Planet) .oclAsType(Galaxy)) = invalid" -by(rule ext, simp add: OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet bot_option_def invalid_def) -lemma OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person_invalid : "((invalid::\<cdot>Person) .oclAsType(Galaxy)) = invalid" -by(rule ext, simp add: OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person bot_option_def invalid_def) -lemma OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny_null : "((null::\<cdot>OclAny) .oclAsType(Galaxy)) = null" -by(rule ext, simp add: OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny bot_option_def null_fun_def null_option_def) -lemma OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy_null : "((null::\<cdot>Galaxy) .oclAsType(Galaxy)) = null" -by(simp) -lemma OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet_null : "((null::\<cdot>Planet) .oclAsType(Galaxy)) = null" -by(rule ext, simp add: OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet bot_option_def null_fun_def null_option_def) -lemma OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person_null : "((null::\<cdot>Person) .oclAsType(Galaxy)) = null" -by(rule ext, simp add: OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person bot_option_def null_fun_def null_option_def) -lemma OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny_invalid : "((invalid::\<cdot>OclAny) .oclAsType(Planet)) = invalid" -by(rule ext, simp add: OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny bot_option_def invalid_def) -lemma OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy_invalid : "((invalid::\<cdot>Galaxy) .oclAsType(Planet)) = invalid" -by(rule ext, simp add: OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy bot_option_def invalid_def) -lemma OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet_invalid : "((invalid::\<cdot>Planet) .oclAsType(Planet)) = invalid" -by(simp) -lemma OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person_invalid : "((invalid::\<cdot>Person) .oclAsType(Planet)) = invalid" -by(rule ext, simp add: OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person bot_option_def invalid_def) -lemma OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny_null : "((null::\<cdot>OclAny) .oclAsType(Planet)) = null" -by(rule ext, simp add: OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny bot_option_def null_fun_def null_option_def) -lemma OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy_null : "((null::\<cdot>Galaxy) .oclAsType(Planet)) = null" -by(rule ext, simp add: OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy bot_option_def null_fun_def null_option_def) -lemma OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet_null : "((null::\<cdot>Planet) .oclAsType(Planet)) = null" -by(simp) -lemma OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person_null : "((null::\<cdot>Person) .oclAsType(Planet)) = null" -by(rule ext, simp add: OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person bot_option_def null_fun_def null_option_def) -lemma OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_invalid : "((invalid::\<cdot>OclAny) .oclAsType(Person)) = invalid" -by(rule ext, simp add: OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny bot_option_def invalid_def) -lemma OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy_invalid : "((invalid::\<cdot>Galaxy) .oclAsType(Person)) = invalid" -by(rule ext, simp add: OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy bot_option_def invalid_def) -lemma OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet_invalid : "((invalid::\<cdot>Planet) .oclAsType(Person)) = invalid" -by(rule ext, simp add: OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet bot_option_def invalid_def) -lemma OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_invalid : "((invalid::\<cdot>Person) .oclAsType(Person)) = invalid" -by(simp) -lemma OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_null : "((null::\<cdot>OclAny) .oclAsType(Person)) = null" -by(rule ext, simp add: OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny bot_option_def null_fun_def null_option_def) -lemma OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy_null : "((null::\<cdot>Galaxy) .oclAsType(Person)) = null" -by(rule ext, simp add: OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy bot_option_def null_fun_def null_option_def) -lemma OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet_null : "((null::\<cdot>Planet) .oclAsType(Person)) = null" -by(rule ext, simp add: OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet bot_option_def null_fun_def null_option_def) -lemma OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_null : "((null::\<cdot>Person) .oclAsType(Person)) = null" -by(simp) - -(* 46 ************************************ 210 + 1 *) (* term Floor1_astype.print_astype_lemmas_strict *) -lemmas[simp,code_unfold] = OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_invalid - OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy_invalid - OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet_invalid - OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_invalid - OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_null - OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy_null - OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet_null - OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_null - OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny_invalid - OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy_invalid - OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet_invalid - OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person_invalid - OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny_null - OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy_null - OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet_null - OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person_null - OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny_invalid - OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy_invalid - OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet_invalid - OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person_invalid - OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny_null - OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy_null - OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet_null - OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person_null - OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_invalid - OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy_invalid - OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet_invalid - OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_invalid - OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_null - OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy_null - OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet_null - OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_null - -(* 47 ************************************ 211 + 1 *) -subsection \<open>Validity and Definedness Properties\<close> - -(* 48 ************************************ 212 + 6 *) (* term Floor1_astype.print_astype_defined *) -lemma OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person_defined : -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Person) .oclAsType(Planet)))" - using isdef -by(auto simp: OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person foundation16 null_option_def bot_option_def) -lemma OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person_defined : -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Person) .oclAsType(Galaxy)))" - using isdef -by(auto simp: OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person foundation16 null_option_def bot_option_def) -lemma OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet_defined : -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Planet) .oclAsType(Galaxy)))" - using isdef -by(auto simp: OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet foundation16 null_option_def bot_option_def) -lemma OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_defined : -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Person) .oclAsType(OclAny)))" - using isdef -by(auto simp: OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person foundation16 null_option_def bot_option_def) -lemma OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet_defined : -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Planet) .oclAsType(OclAny)))" - using isdef -by(auto simp: OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet foundation16 null_option_def bot_option_def) -lemma OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy_defined : -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Galaxy) .oclAsType(OclAny)))" - using isdef -by(auto simp: OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy foundation16 null_option_def bot_option_def) - -(* 49 ************************************ 218 + 1 *) -subsection \<open>Up Down Casting\<close> - -(* 50 ************************************ 219 + 6 *) (* term Floor1_astype.print_astype_up_d_cast0 *) -lemma up\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_down\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_cast0 : -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> (((X::\<cdot>Person) .oclAsType(Planet)) .oclAsType(Person)) \<triangleq> X" - using isdef -by(auto simp: OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet foundation22 foundation16 null_option_def bot_option_def split: ty\<E>\<X>\<T>\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n.split ty\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n.split) -lemma up\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_down\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_cast0 : -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> (((X::\<cdot>Person) .oclAsType(Galaxy)) .oclAsType(Person)) \<triangleq> X" - using isdef -by(auto simp: OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy foundation22 foundation16 null_option_def bot_option_def split: ty\<E>\<X>\<T>\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n.split ty\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n.split) -lemma up\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_down\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_cast0 : -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> (((X::\<cdot>Person) .oclAsType(OclAny)) .oclAsType(Person)) \<triangleq> X" - using isdef -by(auto simp: OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny foundation22 foundation16 null_option_def bot_option_def split: ty\<E>\<X>\<T>\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n.split ty\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n.split) -lemma up\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_down\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_cast0 : -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> (((X::\<cdot>Planet) .oclAsType(Galaxy)) .oclAsType(Planet)) \<triangleq> X" - using isdef -by(auto simp: OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy foundation22 foundation16 null_option_def bot_option_def split: ty\<E>\<X>\<T>\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t.split ty\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t.split) -lemma up\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_down\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_cast0 : -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> (((X::\<cdot>Planet) .oclAsType(OclAny)) .oclAsType(Planet)) \<triangleq> X" - using isdef -by(auto simp: OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny foundation22 foundation16 null_option_def bot_option_def split: ty\<E>\<X>\<T>\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t.split ty\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t.split) -lemma up\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_down\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_cast0 : -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> (((X::\<cdot>Galaxy) .oclAsType(OclAny)) .oclAsType(Galaxy)) \<triangleq> X" - using isdef -by(auto simp: OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny foundation22 foundation16 null_option_def bot_option_def split: ty\<E>\<X>\<T>\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y.split ty\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y.split) - -(* 51 ************************************ 225 + 6 *) (* term Floor1_astype.print_astype_up_d_cast *) -lemma up\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_down\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_cast : -shows "(((X::\<cdot>Person) .oclAsType(Planet)) .oclAsType(Person)) = X" - apply(rule ext, rename_tac \<tau>) - apply(rule foundation22[THEN iffD1]) - apply(case_tac "\<tau> \<Turnstile> (\<delta> (X))", simp add: up\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_down\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_cast0) - apply(simp add: defined_split, elim disjE) - apply((erule StrongEq_L_subst2_rev, simp, simp)+) -done -lemma up\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_down\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_cast : -shows "(((X::\<cdot>Person) .oclAsType(Galaxy)) .oclAsType(Person)) = X" - apply(rule ext, rename_tac \<tau>) - apply(rule foundation22[THEN iffD1]) - apply(case_tac "\<tau> \<Turnstile> (\<delta> (X))", simp add: up\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_down\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_cast0) - apply(simp add: defined_split, elim disjE) - apply((erule StrongEq_L_subst2_rev, simp, simp)+) -done -lemma up\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_down\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_cast : -shows "(((X::\<cdot>Person) .oclAsType(OclAny)) .oclAsType(Person)) = X" - apply(rule ext, rename_tac \<tau>) - apply(rule foundation22[THEN iffD1]) - apply(case_tac "\<tau> \<Turnstile> (\<delta> (X))", simp add: up\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_down\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_cast0) - apply(simp add: defined_split, elim disjE) - apply((erule StrongEq_L_subst2_rev, simp, simp)+) -done -lemma up\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_down\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_cast : -shows "(((X::\<cdot>Planet) .oclAsType(Galaxy)) .oclAsType(Planet)) = X" - apply(rule ext, rename_tac \<tau>) - apply(rule foundation22[THEN iffD1]) - apply(case_tac "\<tau> \<Turnstile> (\<delta> (X))", simp add: up\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_down\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_cast0) - apply(simp add: defined_split, elim disjE) - apply((erule StrongEq_L_subst2_rev, simp, simp)+) -done -lemma up\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_down\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_cast : -shows "(((X::\<cdot>Planet) .oclAsType(OclAny)) .oclAsType(Planet)) = X" - apply(rule ext, rename_tac \<tau>) - apply(rule foundation22[THEN iffD1]) - apply(case_tac "\<tau> \<Turnstile> (\<delta> (X))", simp add: up\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_down\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_cast0) - apply(simp add: defined_split, elim disjE) - apply((erule StrongEq_L_subst2_rev, simp, simp)+) -done -lemma up\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_down\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_cast : -shows "(((X::\<cdot>Galaxy) .oclAsType(OclAny)) .oclAsType(Galaxy)) = X" - apply(rule ext, rename_tac \<tau>) - apply(rule foundation22[THEN iffD1]) - apply(case_tac "\<tau> \<Turnstile> (\<delta> (X))", simp add: up\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_down\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_cast0) - apply(simp add: defined_split, elim disjE) - apply((erule StrongEq_L_subst2_rev, simp, simp)+) -done - -(* 52 ************************************ 231 + 6 *) (* term Floor1_astype.print_astype_d_up_cast *) -lemma down\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_up\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_cast : -assumes def_X: "X = ((Y::\<cdot>Person) .oclAsType(Planet))" -shows "(\<tau> \<Turnstile> ((not ((\<upsilon> (X)))) or ((X .oclAsType(Person)) .oclAsType(Planet)) \<doteq> X))" - apply(case_tac "(\<tau> \<Turnstile> ((not ((\<upsilon> (X))))))", rule foundation25, simp) -by(rule foundation25', simp add: def_X up\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_down\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_cast StrictRefEq\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_sym) -lemma down\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_up\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_cast : -assumes def_X: "X = ((Y::\<cdot>Person) .oclAsType(Galaxy))" -shows "(\<tau> \<Turnstile> ((not ((\<upsilon> (X)))) or ((X .oclAsType(Person)) .oclAsType(Galaxy)) \<doteq> X))" - apply(case_tac "(\<tau> \<Turnstile> ((not ((\<upsilon> (X))))))", rule foundation25, simp) -by(rule foundation25', simp add: def_X up\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_down\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_cast StrictRefEq\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_sym) -lemma down\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_up\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_cast : -assumes def_X: "X = ((Y::\<cdot>Person) .oclAsType(OclAny))" -shows "(\<tau> \<Turnstile> ((not ((\<upsilon> (X)))) or ((X .oclAsType(Person)) .oclAsType(OclAny)) \<doteq> X))" - apply(case_tac "(\<tau> \<Turnstile> ((not ((\<upsilon> (X))))))", rule foundation25, simp) -by(rule foundation25', simp add: def_X up\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_down\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_cast StrictRefEq\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_sym) -lemma down\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_up\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_cast : -assumes def_X: "X = ((Y::\<cdot>Planet) .oclAsType(Galaxy))" -shows "(\<tau> \<Turnstile> ((not ((\<upsilon> (X)))) or ((X .oclAsType(Planet)) .oclAsType(Galaxy)) \<doteq> X))" - apply(case_tac "(\<tau> \<Turnstile> ((not ((\<upsilon> (X))))))", rule foundation25, simp) -by(rule foundation25', simp add: def_X up\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_down\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_cast StrictRefEq\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_sym) -lemma down\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_up\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_cast : -assumes def_X: "X = ((Y::\<cdot>Planet) .oclAsType(OclAny))" -shows "(\<tau> \<Turnstile> ((not ((\<upsilon> (X)))) or ((X .oclAsType(Planet)) .oclAsType(OclAny)) \<doteq> X))" - apply(case_tac "(\<tau> \<Turnstile> ((not ((\<upsilon> (X))))))", rule foundation25, simp) -by(rule foundation25', simp add: def_X up\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_down\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_cast StrictRefEq\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_sym) -lemma down\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_up\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_cast : -assumes def_X: "X = ((Y::\<cdot>Galaxy) .oclAsType(OclAny))" -shows "(\<tau> \<Turnstile> ((not ((\<upsilon> (X)))) or ((X .oclAsType(Galaxy)) .oclAsType(OclAny)) \<doteq> X))" - apply(case_tac "(\<tau> \<Turnstile> ((not ((\<upsilon> (X))))))", rule foundation25, simp) -by(rule foundation25', simp add: def_X up\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_down\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_cast StrictRefEq\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_sym) - -(* 53 ************************************ 237 + 1 *) -subsection \<open>Const\<close> - -(* 54 ************************************ 238 + 16 *) (* term Floor1_astype.print_astype_lemma_const *) -lemma OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_const : "(const ((X::\<cdot>OclAny))) \<Longrightarrow> (const (X .oclAsType(OclAny)))" -by(simp add: const_def, (metis (no_types) OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny prod.collapse bot_option_def invalid_def null_fun_def null_option_def)?) -lemma OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy_const : "(const ((X::\<cdot>Galaxy))) \<Longrightarrow> (const (X .oclAsType(OclAny)))" -by(simp add: const_def, (metis (no_types) OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy prod.collapse bot_option_def invalid_def null_fun_def null_option_def)?) -lemma OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet_const : "(const ((X::\<cdot>Planet))) \<Longrightarrow> (const (X .oclAsType(OclAny)))" -by(simp add: const_def, (metis (no_types) OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet prod.collapse bot_option_def invalid_def null_fun_def null_option_def)?) -lemma OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_const : "(const ((X::\<cdot>Person))) \<Longrightarrow> (const (X .oclAsType(OclAny)))" -by(simp add: const_def, (metis (no_types) OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person prod.collapse bot_option_def invalid_def null_fun_def null_option_def)?) -lemma OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny_const : "(const ((X::\<cdot>OclAny))) \<Longrightarrow> (const (X .oclAsType(Galaxy)))" -by(simp add: const_def, (metis (no_types) OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny prod.collapse bot_option_def invalid_def null_fun_def null_option_def)?) -lemma OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy_const : "(const ((X::\<cdot>Galaxy))) \<Longrightarrow> (const (X .oclAsType(Galaxy)))" -by(simp add: const_def, (metis (no_types) OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy prod.collapse bot_option_def invalid_def null_fun_def null_option_def)?) -lemma OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet_const : "(const ((X::\<cdot>Planet))) \<Longrightarrow> (const (X .oclAsType(Galaxy)))" -by(simp add: const_def, (metis (no_types) OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet prod.collapse bot_option_def invalid_def null_fun_def null_option_def)?) -lemma OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person_const : "(const ((X::\<cdot>Person))) \<Longrightarrow> (const (X .oclAsType(Galaxy)))" -by(simp add: const_def, (metis (no_types) OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person prod.collapse bot_option_def invalid_def null_fun_def null_option_def)?) -lemma OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny_const : "(const ((X::\<cdot>OclAny))) \<Longrightarrow> (const (X .oclAsType(Planet)))" -by(simp add: const_def, (metis (no_types) OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny prod.collapse bot_option_def invalid_def null_fun_def null_option_def)?) -lemma OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy_const : "(const ((X::\<cdot>Galaxy))) \<Longrightarrow> (const (X .oclAsType(Planet)))" -by(simp add: const_def, (metis (no_types) OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy prod.collapse bot_option_def invalid_def null_fun_def null_option_def)?) -lemma OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet_const : "(const ((X::\<cdot>Planet))) \<Longrightarrow> (const (X .oclAsType(Planet)))" -by(simp add: const_def, (metis (no_types) OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet prod.collapse bot_option_def invalid_def null_fun_def null_option_def)?) -lemma OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person_const : "(const ((X::\<cdot>Person))) \<Longrightarrow> (const (X .oclAsType(Planet)))" -by(simp add: const_def, (metis (no_types) OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person prod.collapse bot_option_def invalid_def null_fun_def null_option_def)?) -lemma OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_const : "(const ((X::\<cdot>OclAny))) \<Longrightarrow> (const (X .oclAsType(Person)))" -by(simp add: const_def, (metis (no_types) OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny prod.collapse bot_option_def invalid_def null_fun_def null_option_def)?) -lemma OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy_const : "(const ((X::\<cdot>Galaxy))) \<Longrightarrow> (const (X .oclAsType(Person)))" -by(simp add: const_def, (metis (no_types) OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy prod.collapse bot_option_def invalid_def null_fun_def null_option_def)?) -lemma OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet_const : "(const ((X::\<cdot>Planet))) \<Longrightarrow> (const (X .oclAsType(Person)))" -by(simp add: const_def, (metis (no_types) OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet prod.collapse bot_option_def invalid_def null_fun_def null_option_def)?) -lemma OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_const : "(const ((X::\<cdot>Person))) \<Longrightarrow> (const (X .oclAsType(Person)))" -by(simp add: const_def, (metis (no_types) OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person prod.collapse bot_option_def invalid_def null_fun_def null_option_def)?) - -(* 55 ************************************ 254 + 1 *) (* term Floor1_astype.print_astype_lemmas_const *) -lemmas[simp,code_unfold] = OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_const - OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy_const - OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet_const - OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_const - OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny_const - OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy_const - OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet_const - OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person_const - OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny_const - OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy_const - OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet_const - OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person_const - OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_const - OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy_const - OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet_const - OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_const - -(* 56 ************************************ 255 + 1 *) -section \<open>Class Model: OclIsTypeOf\<close> - -(* 57 ************************************ 256 + 1 *) -subsection \<open>Definition\<close> - -(* 58 ************************************ 257 + 4 *) (* term Floor1_istypeof.print_istypeof_consts *) -consts OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n :: "'\<alpha> \<Rightarrow> Boolean" ("(_) .oclIsTypeOf'(Person')") -consts OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t :: "'\<alpha> \<Rightarrow> Boolean" ("(_) .oclIsTypeOf'(Planet')") -consts OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y :: "'\<alpha> \<Rightarrow> Boolean" ("(_) .oclIsTypeOf'(Galaxy')") -consts OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y :: "'\<alpha> \<Rightarrow> Boolean" ("(_) .oclIsTypeOf'(OclAny')") - -(* 59 ************************************ 261 + 16 *) (* term Floor1_istypeof.print_istypeof_class *) -overloading OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n \<equiv> "(OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n::(\<cdot>Person) \<Rightarrow> _)" -begin - definition OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person : "(x::\<cdot>Person) .oclIsTypeOf(Person) \<equiv> (\<lambda>\<tau>. (case (x (\<tau>)) of \<bottom> \<Rightarrow> (invalid (\<tau>)) - | \<lfloor>\<bottom>\<rfloor> \<Rightarrow> (true (\<tau>)) - | \<lfloor>\<lfloor>(mk\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n ((mk\<E>\<X>\<T>\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (_) (_) (_) (_) (_) (_))) (_) (_))\<rfloor>\<rfloor> \<Rightarrow> (true (\<tau>))))" -end -overloading OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n \<equiv> "(OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n::(\<cdot>Planet) \<Rightarrow> _)" -begin - definition OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet : "(x::\<cdot>Planet) .oclIsTypeOf(Person) \<equiv> (\<lambda>\<tau>. (case (x (\<tau>)) of \<bottom> \<Rightarrow> (invalid (\<tau>)) - | \<lfloor>\<bottom>\<rfloor> \<Rightarrow> (true (\<tau>)) - | \<lfloor>\<lfloor>(mk\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t ((mk\<E>\<X>\<T>\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (_))) (_) (_))\<rfloor>\<rfloor> \<Rightarrow> (true (\<tau>)) - | _ \<Rightarrow> (false (\<tau>))))" -end -overloading OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n \<equiv> "(OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n::(\<cdot>Galaxy) \<Rightarrow> _)" -begin - definition OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy : "(x::\<cdot>Galaxy) .oclIsTypeOf(Person) \<equiv> (\<lambda>\<tau>. (case (x (\<tau>)) of \<bottom> \<Rightarrow> (invalid (\<tau>)) - | \<lfloor>\<bottom>\<rfloor> \<Rightarrow> (true (\<tau>)) - | \<lfloor>\<lfloor>(mk\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y ((mk\<E>\<X>\<T>\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (_))) (_) (_) (_))\<rfloor>\<rfloor> \<Rightarrow> (true (\<tau>)) - | _ \<Rightarrow> (false (\<tau>))))" -end -overloading OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n \<equiv> "(OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n::(\<cdot>OclAny) \<Rightarrow> _)" -begin - definition OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny : "(x::\<cdot>OclAny) .oclIsTypeOf(Person) \<equiv> (\<lambda>\<tau>. (case (x (\<tau>)) of \<bottom> \<Rightarrow> (invalid (\<tau>)) - | \<lfloor>\<bottom>\<rfloor> \<Rightarrow> (true (\<tau>)) - | \<lfloor>\<lfloor>(mk\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y ((mk\<E>\<X>\<T>\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (_))))\<rfloor>\<rfloor> \<Rightarrow> (true (\<tau>)) - | _ \<Rightarrow> (false (\<tau>))))" -end -overloading OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t \<equiv> "(OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t::(\<cdot>Planet) \<Rightarrow> _)" -begin - definition OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet : "(x::\<cdot>Planet) .oclIsTypeOf(Planet) \<equiv> (\<lambda>\<tau>. (case (x (\<tau>)) of \<bottom> \<Rightarrow> (invalid (\<tau>)) - | \<lfloor>\<bottom>\<rfloor> \<Rightarrow> (true (\<tau>)) - | \<lfloor>\<lfloor>(mk\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t ((mk\<E>\<X>\<T>\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (_) (_) (_) (_))) (_) (_))\<rfloor>\<rfloor> \<Rightarrow> (true (\<tau>)) - | _ \<Rightarrow> (false (\<tau>))))" -end -overloading OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t \<equiv> "(OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t::(\<cdot>Galaxy) \<Rightarrow> _)" -begin - definition OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy : "(x::\<cdot>Galaxy) .oclIsTypeOf(Planet) \<equiv> (\<lambda>\<tau>. (case (x (\<tau>)) of \<bottom> \<Rightarrow> (invalid (\<tau>)) - | \<lfloor>\<bottom>\<rfloor> \<Rightarrow> (true (\<tau>)) - | \<lfloor>\<lfloor>(mk\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y ((mk\<E>\<X>\<T>\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (_))) (_) (_) (_))\<rfloor>\<rfloor> \<Rightarrow> (true (\<tau>)) - | _ \<Rightarrow> (false (\<tau>))))" -end -overloading OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t \<equiv> "(OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t::(\<cdot>OclAny) \<Rightarrow> _)" -begin - definition OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny : "(x::\<cdot>OclAny) .oclIsTypeOf(Planet) \<equiv> (\<lambda>\<tau>. (case (x (\<tau>)) of \<bottom> \<Rightarrow> (invalid (\<tau>)) - | \<lfloor>\<bottom>\<rfloor> \<Rightarrow> (true (\<tau>)) - | \<lfloor>\<lfloor>(mk\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y ((mk\<E>\<X>\<T>\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (_))))\<rfloor>\<rfloor> \<Rightarrow> (true (\<tau>)) - | _ \<Rightarrow> (false (\<tau>))))" -end -overloading OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t \<equiv> "(OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t::(\<cdot>Person) \<Rightarrow> _)" -begin - definition OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person : "(x::\<cdot>Person) .oclIsTypeOf(Planet) \<equiv> (\<lambda>\<tau>. (case (x (\<tau>)) of \<bottom> \<Rightarrow> (invalid (\<tau>)) - | \<lfloor>\<bottom>\<rfloor> \<Rightarrow> (true (\<tau>)) - | _ \<Rightarrow> (false (\<tau>))))" -end -overloading OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y \<equiv> "(OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y::(\<cdot>Galaxy) \<Rightarrow> _)" -begin - definition OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy : "(x::\<cdot>Galaxy) .oclIsTypeOf(Galaxy) \<equiv> (\<lambda>\<tau>. (case (x (\<tau>)) of \<bottom> \<Rightarrow> (invalid (\<tau>)) - | \<lfloor>\<bottom>\<rfloor> \<Rightarrow> (true (\<tau>)) - | \<lfloor>\<lfloor>(mk\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y ((mk\<E>\<X>\<T>\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y (_))) (_) (_) (_))\<rfloor>\<rfloor> \<Rightarrow> (true (\<tau>)) - | _ \<Rightarrow> (false (\<tau>))))" -end -overloading OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y \<equiv> "(OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y::(\<cdot>OclAny) \<Rightarrow> _)" -begin - definition OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny : "(x::\<cdot>OclAny) .oclIsTypeOf(Galaxy) \<equiv> (\<lambda>\<tau>. (case (x (\<tau>)) of \<bottom> \<Rightarrow> (invalid (\<tau>)) - | \<lfloor>\<bottom>\<rfloor> \<Rightarrow> (true (\<tau>)) - | \<lfloor>\<lfloor>(mk\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y ((mk\<E>\<X>\<T>\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y (_))))\<rfloor>\<rfloor> \<Rightarrow> (true (\<tau>)) - | _ \<Rightarrow> (false (\<tau>))))" -end -overloading OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y \<equiv> "(OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y::(\<cdot>Person) \<Rightarrow> _)" -begin - definition OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person : "(x::\<cdot>Person) .oclIsTypeOf(Galaxy) \<equiv> (\<lambda>\<tau>. (case (x (\<tau>)) of \<bottom> \<Rightarrow> (invalid (\<tau>)) - | \<lfloor>\<bottom>\<rfloor> \<Rightarrow> (true (\<tau>)) - | _ \<Rightarrow> (false (\<tau>))))" -end -overloading OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y \<equiv> "(OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y::(\<cdot>Planet) \<Rightarrow> _)" -begin - definition OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet : "(x::\<cdot>Planet) .oclIsTypeOf(Galaxy) \<equiv> (\<lambda>\<tau>. (case (x (\<tau>)) of \<bottom> \<Rightarrow> (invalid (\<tau>)) - | \<lfloor>\<bottom>\<rfloor> \<Rightarrow> (true (\<tau>)) - | _ \<Rightarrow> (false (\<tau>))))" -end -overloading OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y \<equiv> "(OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y::(\<cdot>OclAny) \<Rightarrow> _)" -begin - definition OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny : "(x::\<cdot>OclAny) .oclIsTypeOf(OclAny) \<equiv> (\<lambda>\<tau>. (case (x (\<tau>)) of \<bottom> \<Rightarrow> (invalid (\<tau>)) - | \<lfloor>\<bottom>\<rfloor> \<Rightarrow> (true (\<tau>)) - | \<lfloor>\<lfloor>(mk\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y ((mk\<E>\<X>\<T>\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y (_))))\<rfloor>\<rfloor> \<Rightarrow> (true (\<tau>)) - | _ \<Rightarrow> (false (\<tau>))))" -end -overloading OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y \<equiv> "(OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y::(\<cdot>Person) \<Rightarrow> _)" -begin - definition OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person : "(x::\<cdot>Person) .oclIsTypeOf(OclAny) \<equiv> (\<lambda>\<tau>. (case (x (\<tau>)) of \<bottom> \<Rightarrow> (invalid (\<tau>)) - | \<lfloor>\<bottom>\<rfloor> \<Rightarrow> (true (\<tau>)) - | _ \<Rightarrow> (false (\<tau>))))" -end -overloading OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y \<equiv> "(OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y::(\<cdot>Planet) \<Rightarrow> _)" -begin - definition OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet : "(x::\<cdot>Planet) .oclIsTypeOf(OclAny) \<equiv> (\<lambda>\<tau>. (case (x (\<tau>)) of \<bottom> \<Rightarrow> (invalid (\<tau>)) - | \<lfloor>\<bottom>\<rfloor> \<Rightarrow> (true (\<tau>)) - | _ \<Rightarrow> (false (\<tau>))))" -end -overloading OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y \<equiv> "(OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y::(\<cdot>Galaxy) \<Rightarrow> _)" -begin - definition OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy : "(x::\<cdot>Galaxy) .oclIsTypeOf(OclAny) \<equiv> (\<lambda>\<tau>. (case (x (\<tau>)) of \<bottom> \<Rightarrow> (invalid (\<tau>)) - | \<lfloor>\<bottom>\<rfloor> \<Rightarrow> (true (\<tau>)) - | _ \<Rightarrow> (false (\<tau>))))" -end - -(* 60 ************************************ 277 + 4 *) (* term Floor1_istypeof.print_istypeof_from_universe *) -definition "OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_\<AA> = (\<lambda> (in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (Person)) \<Rightarrow> (((((\<lambda>x _. \<lfloor>\<lfloor>x\<rfloor>\<rfloor>)) (Person))::\<cdot>Person) .oclIsTypeOf(Person)) - | (in\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (Planet)) \<Rightarrow> (((((\<lambda>x _. \<lfloor>\<lfloor>x\<rfloor>\<rfloor>)) (Planet))::\<cdot>Planet) .oclIsTypeOf(Person)) - | (in\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y (Galaxy)) \<Rightarrow> (((((\<lambda>x _. \<lfloor>\<lfloor>x\<rfloor>\<rfloor>)) (Galaxy))::\<cdot>Galaxy) .oclIsTypeOf(Person)) - | (in\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y (OclAny)) \<Rightarrow> (((((\<lambda>x _. \<lfloor>\<lfloor>x\<rfloor>\<rfloor>)) (OclAny))::\<cdot>OclAny) .oclIsTypeOf(Person)))" -definition "OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_\<AA> = (\<lambda> (in\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (Planet)) \<Rightarrow> (((((\<lambda>x _. \<lfloor>\<lfloor>x\<rfloor>\<rfloor>)) (Planet))::\<cdot>Planet) .oclIsTypeOf(Planet)) - | (in\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y (Galaxy)) \<Rightarrow> (((((\<lambda>x _. \<lfloor>\<lfloor>x\<rfloor>\<rfloor>)) (Galaxy))::\<cdot>Galaxy) .oclIsTypeOf(Planet)) - | (in\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y (OclAny)) \<Rightarrow> (((((\<lambda>x _. \<lfloor>\<lfloor>x\<rfloor>\<rfloor>)) (OclAny))::\<cdot>OclAny) .oclIsTypeOf(Planet)) - | (in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (Person)) \<Rightarrow> (((((\<lambda>x _. \<lfloor>\<lfloor>x\<rfloor>\<rfloor>)) (Person))::\<cdot>Person) .oclIsTypeOf(Planet)))" -definition "OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_\<AA> = (\<lambda> (in\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y (Galaxy)) \<Rightarrow> (((((\<lambda>x _. \<lfloor>\<lfloor>x\<rfloor>\<rfloor>)) (Galaxy))::\<cdot>Galaxy) .oclIsTypeOf(Galaxy)) - | (in\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y (OclAny)) \<Rightarrow> (((((\<lambda>x _. \<lfloor>\<lfloor>x\<rfloor>\<rfloor>)) (OclAny))::\<cdot>OclAny) .oclIsTypeOf(Galaxy)) - | (in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (Person)) \<Rightarrow> (((((\<lambda>x _. \<lfloor>\<lfloor>x\<rfloor>\<rfloor>)) (Person))::\<cdot>Person) .oclIsTypeOf(Galaxy)) - | (in\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (Planet)) \<Rightarrow> (((((\<lambda>x _. \<lfloor>\<lfloor>x\<rfloor>\<rfloor>)) (Planet))::\<cdot>Planet) .oclIsTypeOf(Galaxy)))" -definition "OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_\<AA> = (\<lambda> (in\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y (OclAny)) \<Rightarrow> (((((\<lambda>x _. \<lfloor>\<lfloor>x\<rfloor>\<rfloor>)) (OclAny))::\<cdot>OclAny) .oclIsTypeOf(OclAny)) - | (in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (Person)) \<Rightarrow> (((((\<lambda>x _. \<lfloor>\<lfloor>x\<rfloor>\<rfloor>)) (Person))::\<cdot>Person) .oclIsTypeOf(OclAny)) - | (in\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (Planet)) \<Rightarrow> (((((\<lambda>x _. \<lfloor>\<lfloor>x\<rfloor>\<rfloor>)) (Planet))::\<cdot>Planet) .oclIsTypeOf(OclAny)) - | (in\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y (Galaxy)) \<Rightarrow> (((((\<lambda>x _. \<lfloor>\<lfloor>x\<rfloor>\<rfloor>)) (Galaxy))::\<cdot>Galaxy) .oclIsTypeOf(OclAny)))" - -(* 61 ************************************ 281 + 1 *) (* term Floor1_istypeof.print_istypeof_lemmas_id *) -lemmas[simp,code_unfold] = OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person - OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet - OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy - OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny - -(* 62 ************************************ 282 + 1 *) -subsection \<open>Context Passing\<close> - -(* 63 ************************************ 283 + 64 *) (* term Floor1_istypeof.print_istypeof_lemma_cp *) -lemma cp_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_OclAny : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>OclAny)))::\<cdot>OclAny) .oclIsTypeOf(OclAny)))))" -by(rule cpI1, simp) -lemma cp_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy_OclAny : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Galaxy)))::\<cdot>OclAny) .oclIsTypeOf(OclAny)))))" -by(rule cpI1, simp) -lemma cp_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet_OclAny : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Planet)))::\<cdot>OclAny) .oclIsTypeOf(OclAny)))))" -by(rule cpI1, simp) -lemma cp_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_OclAny : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Person)))::\<cdot>OclAny) .oclIsTypeOf(OclAny)))))" -by(rule cpI1, simp) -lemma cp_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_Galaxy : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>OclAny)))::\<cdot>Galaxy) .oclIsTypeOf(OclAny)))))" -by(rule cpI1, simp add: OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy) -lemma cp_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy_Galaxy : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Galaxy)))::\<cdot>Galaxy) .oclIsTypeOf(OclAny)))))" -by(rule cpI1, simp add: OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy) -lemma cp_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet_Galaxy : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Planet)))::\<cdot>Galaxy) .oclIsTypeOf(OclAny)))))" -by(rule cpI1, simp add: OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy) -lemma cp_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_Galaxy : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Person)))::\<cdot>Galaxy) .oclIsTypeOf(OclAny)))))" -by(rule cpI1, simp add: OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy) -lemma cp_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_Planet : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>OclAny)))::\<cdot>Planet) .oclIsTypeOf(OclAny)))))" -by(rule cpI1, simp add: OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet) -lemma cp_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy_Planet : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Galaxy)))::\<cdot>Planet) .oclIsTypeOf(OclAny)))))" -by(rule cpI1, simp add: OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet) -lemma cp_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet_Planet : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Planet)))::\<cdot>Planet) .oclIsTypeOf(OclAny)))))" -by(rule cpI1, simp add: OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet) -lemma cp_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_Planet : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Person)))::\<cdot>Planet) .oclIsTypeOf(OclAny)))))" -by(rule cpI1, simp add: OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet) -lemma cp_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_Person : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>OclAny)))::\<cdot>Person) .oclIsTypeOf(OclAny)))))" -by(rule cpI1, simp add: OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person) -lemma cp_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy_Person : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Galaxy)))::\<cdot>Person) .oclIsTypeOf(OclAny)))))" -by(rule cpI1, simp add: OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person) -lemma cp_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet_Person : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Planet)))::\<cdot>Person) .oclIsTypeOf(OclAny)))))" -by(rule cpI1, simp add: OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person) -lemma cp_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_Person : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Person)))::\<cdot>Person) .oclIsTypeOf(OclAny)))))" -by(rule cpI1, simp add: OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person) -lemma cp_OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny_OclAny : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>OclAny)))::\<cdot>OclAny) .oclIsTypeOf(Galaxy)))))" -by(rule cpI1, simp add: OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny) -lemma cp_OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy_OclAny : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Galaxy)))::\<cdot>OclAny) .oclIsTypeOf(Galaxy)))))" -by(rule cpI1, simp add: OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny) -lemma cp_OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet_OclAny : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Planet)))::\<cdot>OclAny) .oclIsTypeOf(Galaxy)))))" -by(rule cpI1, simp add: OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny) -lemma cp_OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person_OclAny : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Person)))::\<cdot>OclAny) .oclIsTypeOf(Galaxy)))))" -by(rule cpI1, simp add: OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny) -lemma cp_OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny_Galaxy : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>OclAny)))::\<cdot>Galaxy) .oclIsTypeOf(Galaxy)))))" -by(rule cpI1, simp) -lemma cp_OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy_Galaxy : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Galaxy)))::\<cdot>Galaxy) .oclIsTypeOf(Galaxy)))))" -by(rule cpI1, simp) -lemma cp_OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet_Galaxy : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Planet)))::\<cdot>Galaxy) .oclIsTypeOf(Galaxy)))))" -by(rule cpI1, simp) -lemma cp_OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person_Galaxy : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Person)))::\<cdot>Galaxy) .oclIsTypeOf(Galaxy)))))" -by(rule cpI1, simp) -lemma cp_OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny_Planet : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>OclAny)))::\<cdot>Planet) .oclIsTypeOf(Galaxy)))))" -by(rule cpI1, simp add: OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet) -lemma cp_OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy_Planet : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Galaxy)))::\<cdot>Planet) .oclIsTypeOf(Galaxy)))))" -by(rule cpI1, simp add: OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet) -lemma cp_OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet_Planet : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Planet)))::\<cdot>Planet) .oclIsTypeOf(Galaxy)))))" -by(rule cpI1, simp add: OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet) -lemma cp_OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person_Planet : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Person)))::\<cdot>Planet) .oclIsTypeOf(Galaxy)))))" -by(rule cpI1, simp add: OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet) -lemma cp_OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny_Person : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>OclAny)))::\<cdot>Person) .oclIsTypeOf(Galaxy)))))" -by(rule cpI1, simp add: OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person) -lemma cp_OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy_Person : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Galaxy)))::\<cdot>Person) .oclIsTypeOf(Galaxy)))))" -by(rule cpI1, simp add: OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person) -lemma cp_OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet_Person : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Planet)))::\<cdot>Person) .oclIsTypeOf(Galaxy)))))" -by(rule cpI1, simp add: OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person) -lemma cp_OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person_Person : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Person)))::\<cdot>Person) .oclIsTypeOf(Galaxy)))))" -by(rule cpI1, simp add: OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person) -lemma cp_OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny_OclAny : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>OclAny)))::\<cdot>OclAny) .oclIsTypeOf(Planet)))))" -by(rule cpI1, simp add: OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny) -lemma cp_OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy_OclAny : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Galaxy)))::\<cdot>OclAny) .oclIsTypeOf(Planet)))))" -by(rule cpI1, simp add: OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny) -lemma cp_OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet_OclAny : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Planet)))::\<cdot>OclAny) .oclIsTypeOf(Planet)))))" -by(rule cpI1, simp add: OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny) -lemma cp_OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person_OclAny : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Person)))::\<cdot>OclAny) .oclIsTypeOf(Planet)))))" -by(rule cpI1, simp add: OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny) -lemma cp_OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny_Galaxy : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>OclAny)))::\<cdot>Galaxy) .oclIsTypeOf(Planet)))))" -by(rule cpI1, simp add: OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy) -lemma cp_OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy_Galaxy : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Galaxy)))::\<cdot>Galaxy) .oclIsTypeOf(Planet)))))" -by(rule cpI1, simp add: OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy) -lemma cp_OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet_Galaxy : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Planet)))::\<cdot>Galaxy) .oclIsTypeOf(Planet)))))" -by(rule cpI1, simp add: OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy) -lemma cp_OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person_Galaxy : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Person)))::\<cdot>Galaxy) .oclIsTypeOf(Planet)))))" -by(rule cpI1, simp add: OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy) -lemma cp_OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny_Planet : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>OclAny)))::\<cdot>Planet) .oclIsTypeOf(Planet)))))" -by(rule cpI1, simp) -lemma cp_OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy_Planet : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Galaxy)))::\<cdot>Planet) .oclIsTypeOf(Planet)))))" -by(rule cpI1, simp) -lemma cp_OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet_Planet : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Planet)))::\<cdot>Planet) .oclIsTypeOf(Planet)))))" -by(rule cpI1, simp) -lemma cp_OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person_Planet : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Person)))::\<cdot>Planet) .oclIsTypeOf(Planet)))))" -by(rule cpI1, simp) -lemma cp_OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny_Person : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>OclAny)))::\<cdot>Person) .oclIsTypeOf(Planet)))))" -by(rule cpI1, simp add: OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person) -lemma cp_OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy_Person : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Galaxy)))::\<cdot>Person) .oclIsTypeOf(Planet)))))" -by(rule cpI1, simp add: OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person) -lemma cp_OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet_Person : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Planet)))::\<cdot>Person) .oclIsTypeOf(Planet)))))" -by(rule cpI1, simp add: OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person) -lemma cp_OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person_Person : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Person)))::\<cdot>Person) .oclIsTypeOf(Planet)))))" -by(rule cpI1, simp add: OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person) -lemma cp_OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_OclAny : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>OclAny)))::\<cdot>OclAny) .oclIsTypeOf(Person)))))" -by(rule cpI1, simp add: OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny) -lemma cp_OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy_OclAny : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Galaxy)))::\<cdot>OclAny) .oclIsTypeOf(Person)))))" -by(rule cpI1, simp add: OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny) -lemma cp_OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet_OclAny : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Planet)))::\<cdot>OclAny) .oclIsTypeOf(Person)))))" -by(rule cpI1, simp add: OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny) -lemma cp_OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_OclAny : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Person)))::\<cdot>OclAny) .oclIsTypeOf(Person)))))" -by(rule cpI1, simp add: OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny) -lemma cp_OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_Galaxy : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>OclAny)))::\<cdot>Galaxy) .oclIsTypeOf(Person)))))" -by(rule cpI1, simp add: OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy) -lemma cp_OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy_Galaxy : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Galaxy)))::\<cdot>Galaxy) .oclIsTypeOf(Person)))))" -by(rule cpI1, simp add: OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy) -lemma cp_OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet_Galaxy : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Planet)))::\<cdot>Galaxy) .oclIsTypeOf(Person)))))" -by(rule cpI1, simp add: OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy) -lemma cp_OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_Galaxy : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Person)))::\<cdot>Galaxy) .oclIsTypeOf(Person)))))" -by(rule cpI1, simp add: OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy) -lemma cp_OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_Planet : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>OclAny)))::\<cdot>Planet) .oclIsTypeOf(Person)))))" -by(rule cpI1, simp add: OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet) -lemma cp_OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy_Planet : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Galaxy)))::\<cdot>Planet) .oclIsTypeOf(Person)))))" -by(rule cpI1, simp add: OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet) -lemma cp_OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet_Planet : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Planet)))::\<cdot>Planet) .oclIsTypeOf(Person)))))" -by(rule cpI1, simp add: OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet) -lemma cp_OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_Planet : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Person)))::\<cdot>Planet) .oclIsTypeOf(Person)))))" -by(rule cpI1, simp add: OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet) -lemma cp_OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_Person : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>OclAny)))::\<cdot>Person) .oclIsTypeOf(Person)))))" -by(rule cpI1, simp) -lemma cp_OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy_Person : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Galaxy)))::\<cdot>Person) .oclIsTypeOf(Person)))))" -by(rule cpI1, simp) -lemma cp_OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet_Person : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Planet)))::\<cdot>Person) .oclIsTypeOf(Person)))))" -by(rule cpI1, simp) -lemma cp_OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_Person : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Person)))::\<cdot>Person) .oclIsTypeOf(Person)))))" -by(rule cpI1, simp) - -(* 64 ************************************ 347 + 1 *) (* term Floor1_istypeof.print_istypeof_lemmas_cp *) -lemmas[simp,code_unfold] = cp_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_OclAny - cp_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy_OclAny - cp_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet_OclAny - cp_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_OclAny - cp_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_Galaxy - cp_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy_Galaxy - cp_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet_Galaxy - cp_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_Galaxy - cp_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_Planet - cp_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy_Planet - cp_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet_Planet - cp_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_Planet - cp_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_Person - cp_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy_Person - cp_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet_Person - cp_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_Person - cp_OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny_OclAny - cp_OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy_OclAny - cp_OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet_OclAny - cp_OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person_OclAny - cp_OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny_Galaxy - cp_OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy_Galaxy - cp_OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet_Galaxy - cp_OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person_Galaxy - cp_OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny_Planet - cp_OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy_Planet - cp_OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet_Planet - cp_OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person_Planet - cp_OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny_Person - cp_OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy_Person - cp_OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet_Person - cp_OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person_Person - cp_OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny_OclAny - cp_OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy_OclAny - cp_OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet_OclAny - cp_OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person_OclAny - cp_OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny_Galaxy - cp_OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy_Galaxy - cp_OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet_Galaxy - cp_OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person_Galaxy - cp_OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny_Planet - cp_OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy_Planet - cp_OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet_Planet - cp_OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person_Planet - cp_OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny_Person - cp_OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy_Person - cp_OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet_Person - cp_OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person_Person - cp_OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_OclAny - cp_OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy_OclAny - cp_OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet_OclAny - cp_OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_OclAny - cp_OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_Galaxy - cp_OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy_Galaxy - cp_OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet_Galaxy - cp_OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_Galaxy - cp_OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_Planet - cp_OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy_Planet - cp_OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet_Planet - cp_OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_Planet - cp_OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_Person - cp_OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy_Person - cp_OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet_Person - cp_OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_Person - -(* 65 ************************************ 348 + 1 *) -subsection \<open>Execution with Invalid or Null as Argument\<close> - -(* 66 ************************************ 349 + 32 *) (* term Floor1_istypeof.print_istypeof_lemma_strict *) -lemma OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_invalid : "((invalid::\<cdot>OclAny) .oclIsTypeOf(OclAny)) = invalid" -by(rule ext, simp add: bot_option_def invalid_def) -lemma OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy_invalid : "((invalid::\<cdot>Galaxy) .oclIsTypeOf(OclAny)) = invalid" -by(rule ext, simp add: OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy bot_option_def invalid_def) -lemma OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet_invalid : "((invalid::\<cdot>Planet) .oclIsTypeOf(OclAny)) = invalid" -by(rule ext, simp add: OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet bot_option_def invalid_def) -lemma OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_invalid : "((invalid::\<cdot>Person) .oclIsTypeOf(OclAny)) = invalid" -by(rule ext, simp add: OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person bot_option_def invalid_def) -lemma OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_null : "((null::\<cdot>OclAny) .oclIsTypeOf(OclAny)) = true" -by(rule ext, simp add: bot_option_def null_fun_def null_option_def) -lemma OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy_null : "((null::\<cdot>Galaxy) .oclIsTypeOf(OclAny)) = true" -by(rule ext, simp add: OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy bot_option_def null_fun_def null_option_def) -lemma OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet_null : "((null::\<cdot>Planet) .oclIsTypeOf(OclAny)) = true" -by(rule ext, simp add: OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet bot_option_def null_fun_def null_option_def) -lemma OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_null : "((null::\<cdot>Person) .oclIsTypeOf(OclAny)) = true" -by(rule ext, simp add: OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person bot_option_def null_fun_def null_option_def) -lemma OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny_invalid : "((invalid::\<cdot>OclAny) .oclIsTypeOf(Galaxy)) = invalid" -by(rule ext, simp add: OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny bot_option_def invalid_def) -lemma OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy_invalid : "((invalid::\<cdot>Galaxy) .oclIsTypeOf(Galaxy)) = invalid" -by(rule ext, simp add: bot_option_def invalid_def) -lemma OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet_invalid : "((invalid::\<cdot>Planet) .oclIsTypeOf(Galaxy)) = invalid" -by(rule ext, simp add: OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet bot_option_def invalid_def) -lemma OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person_invalid : "((invalid::\<cdot>Person) .oclIsTypeOf(Galaxy)) = invalid" -by(rule ext, simp add: OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person bot_option_def invalid_def) -lemma OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny_null : "((null::\<cdot>OclAny) .oclIsTypeOf(Galaxy)) = true" -by(rule ext, simp add: OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny bot_option_def null_fun_def null_option_def) -lemma OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy_null : "((null::\<cdot>Galaxy) .oclIsTypeOf(Galaxy)) = true" -by(rule ext, simp add: bot_option_def null_fun_def null_option_def) -lemma OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet_null : "((null::\<cdot>Planet) .oclIsTypeOf(Galaxy)) = true" -by(rule ext, simp add: OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet bot_option_def null_fun_def null_option_def) -lemma OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person_null : "((null::\<cdot>Person) .oclIsTypeOf(Galaxy)) = true" -by(rule ext, simp add: OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person bot_option_def null_fun_def null_option_def) -lemma OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny_invalid : "((invalid::\<cdot>OclAny) .oclIsTypeOf(Planet)) = invalid" -by(rule ext, simp add: OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny bot_option_def invalid_def) -lemma OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy_invalid : "((invalid::\<cdot>Galaxy) .oclIsTypeOf(Planet)) = invalid" -by(rule ext, simp add: OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy bot_option_def invalid_def) -lemma OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet_invalid : "((invalid::\<cdot>Planet) .oclIsTypeOf(Planet)) = invalid" -by(rule ext, simp add: bot_option_def invalid_def) -lemma OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person_invalid : "((invalid::\<cdot>Person) .oclIsTypeOf(Planet)) = invalid" -by(rule ext, simp add: OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person bot_option_def invalid_def) -lemma OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny_null : "((null::\<cdot>OclAny) .oclIsTypeOf(Planet)) = true" -by(rule ext, simp add: OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny bot_option_def null_fun_def null_option_def) -lemma OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy_null : "((null::\<cdot>Galaxy) .oclIsTypeOf(Planet)) = true" -by(rule ext, simp add: OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy bot_option_def null_fun_def null_option_def) -lemma OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet_null : "((null::\<cdot>Planet) .oclIsTypeOf(Planet)) = true" -by(rule ext, simp add: bot_option_def null_fun_def null_option_def) -lemma OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person_null : "((null::\<cdot>Person) .oclIsTypeOf(Planet)) = true" -by(rule ext, simp add: OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person bot_option_def null_fun_def null_option_def) -lemma OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_invalid : "((invalid::\<cdot>OclAny) .oclIsTypeOf(Person)) = invalid" -by(rule ext, simp add: OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny bot_option_def invalid_def) -lemma OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy_invalid : "((invalid::\<cdot>Galaxy) .oclIsTypeOf(Person)) = invalid" -by(rule ext, simp add: OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy bot_option_def invalid_def) -lemma OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet_invalid : "((invalid::\<cdot>Planet) .oclIsTypeOf(Person)) = invalid" -by(rule ext, simp add: OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet bot_option_def invalid_def) -lemma OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_invalid : "((invalid::\<cdot>Person) .oclIsTypeOf(Person)) = invalid" -by(rule ext, simp add: bot_option_def invalid_def) -lemma OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_null : "((null::\<cdot>OclAny) .oclIsTypeOf(Person)) = true" -by(rule ext, simp add: OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny bot_option_def null_fun_def null_option_def) -lemma OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy_null : "((null::\<cdot>Galaxy) .oclIsTypeOf(Person)) = true" -by(rule ext, simp add: OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy bot_option_def null_fun_def null_option_def) -lemma OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet_null : "((null::\<cdot>Planet) .oclIsTypeOf(Person)) = true" -by(rule ext, simp add: OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet bot_option_def null_fun_def null_option_def) -lemma OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_null : "((null::\<cdot>Person) .oclIsTypeOf(Person)) = true" -by(rule ext, simp add: bot_option_def null_fun_def null_option_def) - -(* 67 ************************************ 381 + 1 *) (* term Floor1_istypeof.print_istypeof_lemmas_strict *) -lemmas[simp,code_unfold] = OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_invalid - OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy_invalid - OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet_invalid - OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_invalid - OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_null - OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy_null - OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet_null - OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_null - OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny_invalid - OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy_invalid - OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet_invalid - OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person_invalid - OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny_null - OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy_null - OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet_null - OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person_null - OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny_invalid - OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy_invalid - OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet_invalid - OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person_invalid - OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny_null - OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy_null - OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet_null - OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person_null - OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_invalid - OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy_invalid - OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet_invalid - OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_invalid - OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_null - OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy_null - OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet_null - OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_null - -(* 68 ************************************ 382 + 1 *) -subsection \<open>Validity and Definedness Properties\<close> - -(* 69 ************************************ 383 + 16 *) (* term Floor1_istypeof.print_istypeof_defined *) -lemma OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_defined : -assumes isdef: "\<tau> \<Turnstile> (\<upsilon> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Person) .oclIsTypeOf(Person)))" - apply(insert isdef[simplified foundation18'], simp only: OclValid_def, subst cp_defined) -by(auto simp: cp_defined[symmetric ] bot_option_def OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person split: option.split ty\<E>\<X>\<T>\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n.split ty\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n.split) -lemma OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet_defined : -assumes isdef: "\<tau> \<Turnstile> (\<upsilon> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Planet) .oclIsTypeOf(Person)))" - apply(insert isdef[simplified foundation18'], simp only: OclValid_def, subst cp_defined) -by(auto simp: cp_defined[symmetric ] bot_option_def OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet split: option.split ty\<E>\<X>\<T>\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t.split ty\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t.split) -lemma OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy_defined : -assumes isdef: "\<tau> \<Turnstile> (\<upsilon> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Galaxy) .oclIsTypeOf(Person)))" - apply(insert isdef[simplified foundation18'], simp only: OclValid_def, subst cp_defined) -by(auto simp: cp_defined[symmetric ] bot_option_def OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy split: option.split ty\<E>\<X>\<T>\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y.split ty\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y.split) -lemma OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_defined : -assumes isdef: "\<tau> \<Turnstile> (\<upsilon> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>OclAny) .oclIsTypeOf(Person)))" - apply(insert isdef[simplified foundation18'], simp only: OclValid_def, subst cp_defined) -by(auto simp: cp_defined[symmetric ] bot_option_def OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny split: option.split ty\<E>\<X>\<T>\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y.split ty\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y.split) -lemma OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet_defined : -assumes isdef: "\<tau> \<Turnstile> (\<upsilon> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Planet) .oclIsTypeOf(Planet)))" - apply(insert isdef[simplified foundation18'], simp only: OclValid_def, subst cp_defined) -by(auto simp: cp_defined[symmetric ] bot_option_def OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet split: option.split ty\<E>\<X>\<T>\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t.split ty\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t.split) -lemma OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy_defined : -assumes isdef: "\<tau> \<Turnstile> (\<upsilon> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Galaxy) .oclIsTypeOf(Planet)))" - apply(insert isdef[simplified foundation18'], simp only: OclValid_def, subst cp_defined) -by(auto simp: cp_defined[symmetric ] bot_option_def OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy split: option.split ty\<E>\<X>\<T>\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y.split ty\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y.split) -lemma OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny_defined : -assumes isdef: "\<tau> \<Turnstile> (\<upsilon> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>OclAny) .oclIsTypeOf(Planet)))" - apply(insert isdef[simplified foundation18'], simp only: OclValid_def, subst cp_defined) -by(auto simp: cp_defined[symmetric ] bot_option_def OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny split: option.split ty\<E>\<X>\<T>\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y.split ty\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y.split) -lemma OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person_defined : -assumes isdef: "\<tau> \<Turnstile> (\<upsilon> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Person) .oclIsTypeOf(Planet)))" - apply(insert isdef[simplified foundation18'], simp only: OclValid_def, subst cp_defined) -by(auto simp: cp_defined[symmetric ] bot_option_def OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person split: option.split ty\<E>\<X>\<T>\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n.split ty\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n.split) -lemma OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy_defined : -assumes isdef: "\<tau> \<Turnstile> (\<upsilon> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Galaxy) .oclIsTypeOf(Galaxy)))" - apply(insert isdef[simplified foundation18'], simp only: OclValid_def, subst cp_defined) -by(auto simp: cp_defined[symmetric ] bot_option_def OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy split: option.split ty\<E>\<X>\<T>\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y.split ty\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y.split) -lemma OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny_defined : -assumes isdef: "\<tau> \<Turnstile> (\<upsilon> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>OclAny) .oclIsTypeOf(Galaxy)))" - apply(insert isdef[simplified foundation18'], simp only: OclValid_def, subst cp_defined) -by(auto simp: cp_defined[symmetric ] bot_option_def OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny split: option.split ty\<E>\<X>\<T>\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y.split ty\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y.split) -lemma OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person_defined : -assumes isdef: "\<tau> \<Turnstile> (\<upsilon> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Person) .oclIsTypeOf(Galaxy)))" - apply(insert isdef[simplified foundation18'], simp only: OclValid_def, subst cp_defined) -by(auto simp: cp_defined[symmetric ] bot_option_def OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person split: option.split ty\<E>\<X>\<T>\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n.split ty\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n.split) -lemma OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet_defined : -assumes isdef: "\<tau> \<Turnstile> (\<upsilon> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Planet) .oclIsTypeOf(Galaxy)))" - apply(insert isdef[simplified foundation18'], simp only: OclValid_def, subst cp_defined) -by(auto simp: cp_defined[symmetric ] bot_option_def OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet split: option.split ty\<E>\<X>\<T>\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t.split ty\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t.split) -lemma OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_defined : -assumes isdef: "\<tau> \<Turnstile> (\<upsilon> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>OclAny) .oclIsTypeOf(OclAny)))" - apply(insert isdef[simplified foundation18'], simp only: OclValid_def, subst cp_defined) -by(auto simp: cp_defined[symmetric ] bot_option_def OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny split: option.split ty\<E>\<X>\<T>\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y.split ty\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y.split) -lemma OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_defined : -assumes isdef: "\<tau> \<Turnstile> (\<upsilon> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Person) .oclIsTypeOf(OclAny)))" - apply(insert isdef[simplified foundation18'], simp only: OclValid_def, subst cp_defined) -by(auto simp: cp_defined[symmetric ] bot_option_def OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person split: option.split ty\<E>\<X>\<T>\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n.split ty\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n.split) -lemma OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet_defined : -assumes isdef: "\<tau> \<Turnstile> (\<upsilon> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Planet) .oclIsTypeOf(OclAny)))" - apply(insert isdef[simplified foundation18'], simp only: OclValid_def, subst cp_defined) -by(auto simp: cp_defined[symmetric ] bot_option_def OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet split: option.split ty\<E>\<X>\<T>\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t.split ty\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t.split) -lemma OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy_defined : -assumes isdef: "\<tau> \<Turnstile> (\<upsilon> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Galaxy) .oclIsTypeOf(OclAny)))" - apply(insert isdef[simplified foundation18'], simp only: OclValid_def, subst cp_defined) -by(auto simp: cp_defined[symmetric ] bot_option_def OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy split: option.split ty\<E>\<X>\<T>\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y.split ty\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y.split) - -(* 70 ************************************ 399 + 16 *) (* term Floor1_istypeof.print_istypeof_defined' *) -lemma OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_defined' : -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Person) .oclIsTypeOf(Person)))" -by(rule OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_defined[OF isdef[THEN foundation20]]) -lemma OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet_defined' : -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Planet) .oclIsTypeOf(Person)))" -by(rule OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet_defined[OF isdef[THEN foundation20]]) -lemma OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy_defined' : -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Galaxy) .oclIsTypeOf(Person)))" -by(rule OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy_defined[OF isdef[THEN foundation20]]) -lemma OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_defined' : -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>OclAny) .oclIsTypeOf(Person)))" -by(rule OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_defined[OF isdef[THEN foundation20]]) -lemma OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet_defined' : -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Planet) .oclIsTypeOf(Planet)))" -by(rule OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet_defined[OF isdef[THEN foundation20]]) -lemma OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy_defined' : -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Galaxy) .oclIsTypeOf(Planet)))" -by(rule OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy_defined[OF isdef[THEN foundation20]]) -lemma OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny_defined' : -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>OclAny) .oclIsTypeOf(Planet)))" -by(rule OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny_defined[OF isdef[THEN foundation20]]) -lemma OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person_defined' : -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Person) .oclIsTypeOf(Planet)))" -by(rule OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person_defined[OF isdef[THEN foundation20]]) -lemma OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy_defined' : -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Galaxy) .oclIsTypeOf(Galaxy)))" -by(rule OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy_defined[OF isdef[THEN foundation20]]) -lemma OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny_defined' : -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>OclAny) .oclIsTypeOf(Galaxy)))" -by(rule OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny_defined[OF isdef[THEN foundation20]]) -lemma OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person_defined' : -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Person) .oclIsTypeOf(Galaxy)))" -by(rule OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person_defined[OF isdef[THEN foundation20]]) -lemma OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet_defined' : -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Planet) .oclIsTypeOf(Galaxy)))" -by(rule OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet_defined[OF isdef[THEN foundation20]]) -lemma OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_defined' : -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>OclAny) .oclIsTypeOf(OclAny)))" -by(rule OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_defined[OF isdef[THEN foundation20]]) -lemma OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_defined' : -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Person) .oclIsTypeOf(OclAny)))" -by(rule OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_defined[OF isdef[THEN foundation20]]) -lemma OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet_defined' : -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Planet) .oclIsTypeOf(OclAny)))" -by(rule OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet_defined[OF isdef[THEN foundation20]]) -lemma OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy_defined' : -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Galaxy) .oclIsTypeOf(OclAny)))" -by(rule OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy_defined[OF isdef[THEN foundation20]]) - -(* 71 ************************************ 415 + 1 *) -subsection \<open>Up Down Casting\<close> - -(* 72 ************************************ 416 + 6 *) (* term Floor1_istypeof.print_istypeof_up_larger *) -lemma actualType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_larger_staticType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t : -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> ((X::\<cdot>Person) .oclIsTypeOf(Planet)) \<triangleq> false" - using isdef -by(auto simp: OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person foundation22 foundation16 null_option_def bot_option_def) -lemma actualType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_larger_staticType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y : -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> ((X::\<cdot>Person) .oclIsTypeOf(Galaxy)) \<triangleq> false" - using isdef -by(auto simp: OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person foundation22 foundation16 null_option_def bot_option_def) -lemma actualType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_larger_staticType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y : -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> ((X::\<cdot>Person) .oclIsTypeOf(OclAny)) \<triangleq> false" - using isdef -by(auto simp: OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person foundation22 foundation16 null_option_def bot_option_def) -lemma actualType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_larger_staticType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y : -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> ((X::\<cdot>Planet) .oclIsTypeOf(Galaxy)) \<triangleq> false" - using isdef -by(auto simp: OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet foundation22 foundation16 null_option_def bot_option_def) -lemma actualType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_larger_staticType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y : -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> ((X::\<cdot>Planet) .oclIsTypeOf(OclAny)) \<triangleq> false" - using isdef -by(auto simp: OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet foundation22 foundation16 null_option_def bot_option_def) -lemma actualType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_larger_staticType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y : -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> ((X::\<cdot>Galaxy) .oclIsTypeOf(OclAny)) \<triangleq> false" - using isdef -by(auto simp: OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy foundation22 foundation16 null_option_def bot_option_def) - -(* 73 ************************************ 422 + 10 *) (* term Floor1_istypeof.print_istypeof_up_d_cast *) -lemma down_cast_type\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_from_Planet_to_Person : -assumes istyp: "\<tau> \<Turnstile> ((X::\<cdot>Planet) .oclIsTypeOf(Planet))" -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> (X .oclAsType(Person)) \<triangleq> invalid" - using istyp isdef - apply(auto simp: OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet foundation22 foundation16 null_option_def bot_option_def split: ty\<E>\<X>\<T>\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t.split ty\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t.split) -by(simp add: OclValid_def false_def true_def) -lemma down_cast_type\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_from_Galaxy_to_Person : -assumes istyp: "\<tau> \<Turnstile> ((X::\<cdot>Galaxy) .oclIsTypeOf(Galaxy))" -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> (X .oclAsType(Person)) \<triangleq> invalid" - using istyp isdef - apply(auto simp: OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy foundation22 foundation16 null_option_def bot_option_def split: ty\<E>\<X>\<T>\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y.split ty\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y.split) -by(simp add: OclValid_def false_def true_def) -lemma down_cast_type\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_from_OclAny_to_Person : -assumes istyp: "\<tau> \<Turnstile> ((X::\<cdot>OclAny) .oclIsTypeOf(OclAny))" -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> (X .oclAsType(Person)) \<triangleq> invalid" - using istyp isdef - apply(auto simp: OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny foundation22 foundation16 null_option_def bot_option_def split: ty\<E>\<X>\<T>\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y.split ty\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y.split) -by(simp add: OclValid_def false_def true_def) -lemma down_cast_type\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_from_Galaxy_to_Person : -assumes istyp: "\<tau> \<Turnstile> ((X::\<cdot>Galaxy) .oclIsTypeOf(Planet))" -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> (X .oclAsType(Person)) \<triangleq> invalid" - using istyp isdef - apply(auto simp: OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy foundation22 foundation16 null_option_def bot_option_def split: ty\<E>\<X>\<T>\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y.split ty\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y.split) -by(simp add: OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy OclValid_def false_def true_def) -lemma down_cast_type\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_from_OclAny_to_Person : -assumes istyp: "\<tau> \<Turnstile> ((X::\<cdot>OclAny) .oclIsTypeOf(Planet))" -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> (X .oclAsType(Person)) \<triangleq> invalid" - using istyp isdef - apply(auto simp: OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny foundation22 foundation16 null_option_def bot_option_def split: ty\<E>\<X>\<T>\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y.split ty\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y.split) -by(simp add: OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny OclValid_def false_def true_def) -lemma down_cast_type\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_from_OclAny_to_Person : -assumes istyp: "\<tau> \<Turnstile> ((X::\<cdot>OclAny) .oclIsTypeOf(Galaxy))" -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> (X .oclAsType(Person)) \<triangleq> invalid" - using istyp isdef - apply(auto simp: OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny foundation22 foundation16 null_option_def bot_option_def split: ty\<E>\<X>\<T>\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y.split ty\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y.split) -by(simp add: OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny OclValid_def false_def true_def) -lemma down_cast_type\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_from_Galaxy_to_Planet : -assumes istyp: "\<tau> \<Turnstile> ((X::\<cdot>Galaxy) .oclIsTypeOf(Galaxy))" -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> (X .oclAsType(Planet)) \<triangleq> invalid" - using istyp isdef - apply(auto simp: OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy foundation22 foundation16 null_option_def bot_option_def split: ty\<E>\<X>\<T>\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y.split ty\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y.split) -by(simp add: OclValid_def false_def true_def) -lemma down_cast_type\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_from_OclAny_to_Planet : -assumes istyp: "\<tau> \<Turnstile> ((X::\<cdot>OclAny) .oclIsTypeOf(OclAny))" -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> (X .oclAsType(Planet)) \<triangleq> invalid" - using istyp isdef - apply(auto simp: OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny foundation22 foundation16 null_option_def bot_option_def split: ty\<E>\<X>\<T>\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y.split ty\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y.split) -by(simp add: OclValid_def false_def true_def) -lemma down_cast_type\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_from_OclAny_to_Planet : -assumes istyp: "\<tau> \<Turnstile> ((X::\<cdot>OclAny) .oclIsTypeOf(Galaxy))" -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> (X .oclAsType(Planet)) \<triangleq> invalid" - using istyp isdef - apply(auto simp: OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny foundation22 foundation16 null_option_def bot_option_def split: ty\<E>\<X>\<T>\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y.split ty\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y.split) -by(simp add: OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny OclValid_def false_def true_def) -lemma down_cast_type\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_from_OclAny_to_Galaxy : -assumes istyp: "\<tau> \<Turnstile> ((X::\<cdot>OclAny) .oclIsTypeOf(OclAny))" -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> (X .oclAsType(Galaxy)) \<triangleq> invalid" - using istyp isdef - apply(auto simp: OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny foundation22 foundation16 null_option_def bot_option_def split: ty\<E>\<X>\<T>\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y.split ty\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y.split) -by(simp add: OclValid_def false_def true_def) - -(* 74 ************************************ 432 + 1 *) -subsection \<open>Const\<close> - -(* 75 ************************************ 433 + 1 *) -section \<open>Class Model: OclIsKindOf\<close> - -(* 76 ************************************ 434 + 1 *) -subsection \<open>Definition\<close> - -(* 77 ************************************ 435 + 4 *) (* term Floor1_iskindof.print_iskindof_consts *) -consts OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n :: "'\<alpha> \<Rightarrow> Boolean" ("(_) .oclIsKindOf'(Person')") -consts OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t :: "'\<alpha> \<Rightarrow> Boolean" ("(_) .oclIsKindOf'(Planet')") -consts OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y :: "'\<alpha> \<Rightarrow> Boolean" ("(_) .oclIsKindOf'(Galaxy')") -consts OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y :: "'\<alpha> \<Rightarrow> Boolean" ("(_) .oclIsKindOf'(OclAny')") - -(* 78 ************************************ 439 + 16 *) (* term Floor1_iskindof.print_iskindof_class *) -overloading OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n \<equiv> "(OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n::(\<cdot>Person) \<Rightarrow> _)" -begin - definition OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person : "(x::\<cdot>Person) .oclIsKindOf(Person) \<equiv> (x .oclIsTypeOf(Person))" -end -overloading OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n \<equiv> "(OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n::(\<cdot>Planet) \<Rightarrow> _)" -begin - definition OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet : "(x::\<cdot>Planet) .oclIsKindOf(Person) \<equiv> (x .oclIsTypeOf(Person))" -end -overloading OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n \<equiv> "(OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n::(\<cdot>Galaxy) \<Rightarrow> _)" -begin - definition OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy : "(x::\<cdot>Galaxy) .oclIsKindOf(Person) \<equiv> (x .oclIsTypeOf(Person))" -end -overloading OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n \<equiv> "(OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n::(\<cdot>OclAny) \<Rightarrow> _)" -begin - definition OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny : "(x::\<cdot>OclAny) .oclIsKindOf(Person) \<equiv> (x .oclIsTypeOf(Person))" -end -overloading OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t \<equiv> "(OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t::(\<cdot>Planet) \<Rightarrow> _)" -begin - definition OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet : "(x::\<cdot>Planet) .oclIsKindOf(Planet) \<equiv> (x .oclIsTypeOf(Planet)) or (x .oclIsKindOf(Person))" -end -overloading OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t \<equiv> "(OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t::(\<cdot>Galaxy) \<Rightarrow> _)" -begin - definition OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy : "(x::\<cdot>Galaxy) .oclIsKindOf(Planet) \<equiv> (x .oclIsTypeOf(Planet)) or (x .oclIsKindOf(Person))" -end -overloading OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t \<equiv> "(OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t::(\<cdot>OclAny) \<Rightarrow> _)" -begin - definition OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny : "(x::\<cdot>OclAny) .oclIsKindOf(Planet) \<equiv> (x .oclIsTypeOf(Planet)) or (x .oclIsKindOf(Person))" -end -overloading OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t \<equiv> "(OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t::(\<cdot>Person) \<Rightarrow> _)" -begin - definition OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person : "(x::\<cdot>Person) .oclIsKindOf(Planet) \<equiv> (x .oclIsTypeOf(Planet)) or (x .oclIsKindOf(Person))" -end -overloading OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y \<equiv> "(OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y::(\<cdot>Galaxy) \<Rightarrow> _)" -begin - definition OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy : "(x::\<cdot>Galaxy) .oclIsKindOf(Galaxy) \<equiv> (x .oclIsTypeOf(Galaxy)) or (x .oclIsKindOf(Planet))" -end -overloading OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y \<equiv> "(OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y::(\<cdot>OclAny) \<Rightarrow> _)" -begin - definition OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny : "(x::\<cdot>OclAny) .oclIsKindOf(Galaxy) \<equiv> (x .oclIsTypeOf(Galaxy)) or (x .oclIsKindOf(Planet))" -end -overloading OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y \<equiv> "(OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y::(\<cdot>Person) \<Rightarrow> _)" -begin - definition OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person : "(x::\<cdot>Person) .oclIsKindOf(Galaxy) \<equiv> (x .oclIsTypeOf(Galaxy)) or (x .oclIsKindOf(Planet))" -end -overloading OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y \<equiv> "(OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y::(\<cdot>Planet) \<Rightarrow> _)" -begin - definition OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet : "(x::\<cdot>Planet) .oclIsKindOf(Galaxy) \<equiv> (x .oclIsTypeOf(Galaxy)) or (x .oclIsKindOf(Planet))" -end -overloading OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y \<equiv> "(OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y::(\<cdot>OclAny) \<Rightarrow> _)" -begin - definition OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny : "(x::\<cdot>OclAny) .oclIsKindOf(OclAny) \<equiv> (x .oclIsTypeOf(OclAny)) or (x .oclIsKindOf(Galaxy))" -end -overloading OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y \<equiv> "(OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y::(\<cdot>Person) \<Rightarrow> _)" -begin - definition OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person : "(x::\<cdot>Person) .oclIsKindOf(OclAny) \<equiv> (x .oclIsTypeOf(OclAny)) or (x .oclIsKindOf(Galaxy))" -end -overloading OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y \<equiv> "(OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y::(\<cdot>Planet) \<Rightarrow> _)" -begin - definition OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet : "(x::\<cdot>Planet) .oclIsKindOf(OclAny) \<equiv> (x .oclIsTypeOf(OclAny)) or (x .oclIsKindOf(Galaxy))" -end -overloading OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y \<equiv> "(OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y::(\<cdot>Galaxy) \<Rightarrow> _)" -begin - definition OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy : "(x::\<cdot>Galaxy) .oclIsKindOf(OclAny) \<equiv> (x .oclIsTypeOf(OclAny)) or (x .oclIsKindOf(Galaxy))" -end - -(* 79 ************************************ 455 + 4 *) (* term Floor1_iskindof.print_iskindof_from_universe *) -definition "OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_\<AA> = (\<lambda> (in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (Person)) \<Rightarrow> (((((\<lambda>x _. \<lfloor>\<lfloor>x\<rfloor>\<rfloor>)) (Person))::\<cdot>Person) .oclIsKindOf(Person)) - | (in\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (Planet)) \<Rightarrow> (((((\<lambda>x _. \<lfloor>\<lfloor>x\<rfloor>\<rfloor>)) (Planet))::\<cdot>Planet) .oclIsKindOf(Person)) - | (in\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y (Galaxy)) \<Rightarrow> (((((\<lambda>x _. \<lfloor>\<lfloor>x\<rfloor>\<rfloor>)) (Galaxy))::\<cdot>Galaxy) .oclIsKindOf(Person)) - | (in\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y (OclAny)) \<Rightarrow> (((((\<lambda>x _. \<lfloor>\<lfloor>x\<rfloor>\<rfloor>)) (OclAny))::\<cdot>OclAny) .oclIsKindOf(Person)))" -definition "OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_\<AA> = (\<lambda> (in\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (Planet)) \<Rightarrow> (((((\<lambda>x _. \<lfloor>\<lfloor>x\<rfloor>\<rfloor>)) (Planet))::\<cdot>Planet) .oclIsKindOf(Planet)) - | (in\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y (Galaxy)) \<Rightarrow> (((((\<lambda>x _. \<lfloor>\<lfloor>x\<rfloor>\<rfloor>)) (Galaxy))::\<cdot>Galaxy) .oclIsKindOf(Planet)) - | (in\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y (OclAny)) \<Rightarrow> (((((\<lambda>x _. \<lfloor>\<lfloor>x\<rfloor>\<rfloor>)) (OclAny))::\<cdot>OclAny) .oclIsKindOf(Planet)) - | (in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (Person)) \<Rightarrow> (((((\<lambda>x _. \<lfloor>\<lfloor>x\<rfloor>\<rfloor>)) (Person))::\<cdot>Person) .oclIsKindOf(Planet)))" -definition "OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_\<AA> = (\<lambda> (in\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y (Galaxy)) \<Rightarrow> (((((\<lambda>x _. \<lfloor>\<lfloor>x\<rfloor>\<rfloor>)) (Galaxy))::\<cdot>Galaxy) .oclIsKindOf(Galaxy)) - | (in\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y (OclAny)) \<Rightarrow> (((((\<lambda>x _. \<lfloor>\<lfloor>x\<rfloor>\<rfloor>)) (OclAny))::\<cdot>OclAny) .oclIsKindOf(Galaxy)) - | (in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (Person)) \<Rightarrow> (((((\<lambda>x _. \<lfloor>\<lfloor>x\<rfloor>\<rfloor>)) (Person))::\<cdot>Person) .oclIsKindOf(Galaxy)) - | (in\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (Planet)) \<Rightarrow> (((((\<lambda>x _. \<lfloor>\<lfloor>x\<rfloor>\<rfloor>)) (Planet))::\<cdot>Planet) .oclIsKindOf(Galaxy)))" -definition "OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_\<AA> = (\<lambda> (in\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y (OclAny)) \<Rightarrow> (((((\<lambda>x _. \<lfloor>\<lfloor>x\<rfloor>\<rfloor>)) (OclAny))::\<cdot>OclAny) .oclIsKindOf(OclAny)) - | (in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (Person)) \<Rightarrow> (((((\<lambda>x _. \<lfloor>\<lfloor>x\<rfloor>\<rfloor>)) (Person))::\<cdot>Person) .oclIsKindOf(OclAny)) - | (in\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (Planet)) \<Rightarrow> (((((\<lambda>x _. \<lfloor>\<lfloor>x\<rfloor>\<rfloor>)) (Planet))::\<cdot>Planet) .oclIsKindOf(OclAny)) - | (in\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y (Galaxy)) \<Rightarrow> (((((\<lambda>x _. \<lfloor>\<lfloor>x\<rfloor>\<rfloor>)) (Galaxy))::\<cdot>Galaxy) .oclIsKindOf(OclAny)))" - -(* 80 ************************************ 459 + 1 *) (* term Floor1_iskindof.print_iskindof_lemmas_id *) -lemmas[simp,code_unfold] = OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person - OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet - OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy - OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny - -(* 81 ************************************ 460 + 1 *) -subsection \<open>Context Passing\<close> - -(* 82 ************************************ 461 + 64 *) (* term Floor1_iskindof.print_iskindof_lemma_cp *) -lemma cp_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_Person : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Person)))::\<cdot>Person) .oclIsKindOf(Person)))))" -by(simp only: OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person, simp only: cp_OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_Person) -lemma cp_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet_Person : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Planet)))::\<cdot>Person) .oclIsKindOf(Person)))))" -by(simp only: OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person, simp only: cp_OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet_Person) -lemma cp_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy_Person : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Galaxy)))::\<cdot>Person) .oclIsKindOf(Person)))))" -by(simp only: OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person, simp only: cp_OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy_Person) -lemma cp_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_Person : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>OclAny)))::\<cdot>Person) .oclIsKindOf(Person)))))" -by(simp only: OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person, simp only: cp_OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_Person) -lemma cp_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_Planet : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Person)))::\<cdot>Planet) .oclIsKindOf(Person)))))" -by(simp only: OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet, simp only: cp_OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_Planet) -lemma cp_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet_Planet : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Planet)))::\<cdot>Planet) .oclIsKindOf(Person)))))" -by(simp only: OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet, simp only: cp_OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet_Planet) -lemma cp_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy_Planet : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Galaxy)))::\<cdot>Planet) .oclIsKindOf(Person)))))" -by(simp only: OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet, simp only: cp_OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy_Planet) -lemma cp_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_Planet : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>OclAny)))::\<cdot>Planet) .oclIsKindOf(Person)))))" -by(simp only: OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet, simp only: cp_OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_Planet) -lemma cp_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_Galaxy : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Person)))::\<cdot>Galaxy) .oclIsKindOf(Person)))))" -by(simp only: OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy, simp only: cp_OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_Galaxy) -lemma cp_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet_Galaxy : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Planet)))::\<cdot>Galaxy) .oclIsKindOf(Person)))))" -by(simp only: OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy, simp only: cp_OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet_Galaxy) -lemma cp_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy_Galaxy : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Galaxy)))::\<cdot>Galaxy) .oclIsKindOf(Person)))))" -by(simp only: OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy, simp only: cp_OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy_Galaxy) -lemma cp_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_Galaxy : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>OclAny)))::\<cdot>Galaxy) .oclIsKindOf(Person)))))" -by(simp only: OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy, simp only: cp_OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_Galaxy) -lemma cp_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_OclAny : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Person)))::\<cdot>OclAny) .oclIsKindOf(Person)))))" -by(simp only: OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny, simp only: cp_OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_OclAny) -lemma cp_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet_OclAny : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Planet)))::\<cdot>OclAny) .oclIsKindOf(Person)))))" -by(simp only: OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny, simp only: cp_OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet_OclAny) -lemma cp_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy_OclAny : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Galaxy)))::\<cdot>OclAny) .oclIsKindOf(Person)))))" -by(simp only: OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny, simp only: cp_OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy_OclAny) -lemma cp_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_OclAny : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>OclAny)))::\<cdot>OclAny) .oclIsKindOf(Person)))))" -by(simp only: OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny, simp only: cp_OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_OclAny) -lemma cp_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet_Planet : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Planet)))::\<cdot>Planet) .oclIsKindOf(Planet)))))" - apply(simp only: OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet) - apply((rule cpI2[where f = "(or)"], (rule allI)+, rule cp_OclOr)+) - apply(simp only: cp_OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet_Planet) -by(simp only: cp_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet_Planet) -lemma cp_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy_Planet : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Galaxy)))::\<cdot>Planet) .oclIsKindOf(Planet)))))" - apply(simp only: OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet) - apply((rule cpI2[where f = "(or)"], (rule allI)+, rule cp_OclOr)+) - apply(simp only: cp_OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy_Planet) -by(simp only: cp_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy_Planet) -lemma cp_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny_Planet : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>OclAny)))::\<cdot>Planet) .oclIsKindOf(Planet)))))" - apply(simp only: OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet) - apply((rule cpI2[where f = "(or)"], (rule allI)+, rule cp_OclOr)+) - apply(simp only: cp_OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny_Planet) -by(simp only: cp_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_Planet) -lemma cp_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person_Planet : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Person)))::\<cdot>Planet) .oclIsKindOf(Planet)))))" - apply(simp only: OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet) - apply((rule cpI2[where f = "(or)"], (rule allI)+, rule cp_OclOr)+) - apply(simp only: cp_OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person_Planet) -by(simp only: cp_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_Planet) -lemma cp_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet_Galaxy : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Planet)))::\<cdot>Galaxy) .oclIsKindOf(Planet)))))" - apply(simp only: OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy) - apply((rule cpI2[where f = "(or)"], (rule allI)+, rule cp_OclOr)+) - apply(simp only: cp_OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet_Galaxy) -by(simp only: cp_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet_Galaxy) -lemma cp_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy_Galaxy : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Galaxy)))::\<cdot>Galaxy) .oclIsKindOf(Planet)))))" - apply(simp only: OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy) - apply((rule cpI2[where f = "(or)"], (rule allI)+, rule cp_OclOr)+) - apply(simp only: cp_OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy_Galaxy) -by(simp only: cp_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy_Galaxy) -lemma cp_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny_Galaxy : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>OclAny)))::\<cdot>Galaxy) .oclIsKindOf(Planet)))))" - apply(simp only: OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy) - apply((rule cpI2[where f = "(or)"], (rule allI)+, rule cp_OclOr)+) - apply(simp only: cp_OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny_Galaxy) -by(simp only: cp_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_Galaxy) -lemma cp_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person_Galaxy : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Person)))::\<cdot>Galaxy) .oclIsKindOf(Planet)))))" - apply(simp only: OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy) - apply((rule cpI2[where f = "(or)"], (rule allI)+, rule cp_OclOr)+) - apply(simp only: cp_OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person_Galaxy) -by(simp only: cp_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_Galaxy) -lemma cp_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet_OclAny : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Planet)))::\<cdot>OclAny) .oclIsKindOf(Planet)))))" - apply(simp only: OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny) - apply((rule cpI2[where f = "(or)"], (rule allI)+, rule cp_OclOr)+) - apply(simp only: cp_OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet_OclAny) -by(simp only: cp_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet_OclAny) -lemma cp_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy_OclAny : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Galaxy)))::\<cdot>OclAny) .oclIsKindOf(Planet)))))" - apply(simp only: OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny) - apply((rule cpI2[where f = "(or)"], (rule allI)+, rule cp_OclOr)+) - apply(simp only: cp_OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy_OclAny) -by(simp only: cp_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy_OclAny) -lemma cp_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny_OclAny : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>OclAny)))::\<cdot>OclAny) .oclIsKindOf(Planet)))))" - apply(simp only: OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny) - apply((rule cpI2[where f = "(or)"], (rule allI)+, rule cp_OclOr)+) - apply(simp only: cp_OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny_OclAny) -by(simp only: cp_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_OclAny) -lemma cp_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person_OclAny : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Person)))::\<cdot>OclAny) .oclIsKindOf(Planet)))))" - apply(simp only: OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny) - apply((rule cpI2[where f = "(or)"], (rule allI)+, rule cp_OclOr)+) - apply(simp only: cp_OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person_OclAny) -by(simp only: cp_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_OclAny) -lemma cp_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet_Person : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Planet)))::\<cdot>Person) .oclIsKindOf(Planet)))))" - apply(simp only: OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person) - apply((rule cpI2[where f = "(or)"], (rule allI)+, rule cp_OclOr)+) - apply(simp only: cp_OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet_Person) -by(simp only: cp_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet_Person) -lemma cp_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy_Person : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Galaxy)))::\<cdot>Person) .oclIsKindOf(Planet)))))" - apply(simp only: OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person) - apply((rule cpI2[where f = "(or)"], (rule allI)+, rule cp_OclOr)+) - apply(simp only: cp_OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy_Person) -by(simp only: cp_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy_Person) -lemma cp_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny_Person : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>OclAny)))::\<cdot>Person) .oclIsKindOf(Planet)))))" - apply(simp only: OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person) - apply((rule cpI2[where f = "(or)"], (rule allI)+, rule cp_OclOr)+) - apply(simp only: cp_OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny_Person) -by(simp only: cp_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_Person) -lemma cp_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person_Person : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Person)))::\<cdot>Person) .oclIsKindOf(Planet)))))" - apply(simp only: OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person) - apply((rule cpI2[where f = "(or)"], (rule allI)+, rule cp_OclOr)+) - apply(simp only: cp_OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person_Person) -by(simp only: cp_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_Person) -lemma cp_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy_Galaxy : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Galaxy)))::\<cdot>Galaxy) .oclIsKindOf(Galaxy)))))" - apply(simp only: OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy) - apply((rule cpI2[where f = "(or)"], (rule allI)+, rule cp_OclOr)+) - apply(simp only: cp_OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy_Galaxy) -by(simp only: cp_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy_Galaxy) -lemma cp_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny_Galaxy : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>OclAny)))::\<cdot>Galaxy) .oclIsKindOf(Galaxy)))))" - apply(simp only: OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy) - apply((rule cpI2[where f = "(or)"], (rule allI)+, rule cp_OclOr)+) - apply(simp only: cp_OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny_Galaxy) -by(simp only: cp_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny_Galaxy) -lemma cp_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person_Galaxy : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Person)))::\<cdot>Galaxy) .oclIsKindOf(Galaxy)))))" - apply(simp only: OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy) - apply((rule cpI2[where f = "(or)"], (rule allI)+, rule cp_OclOr)+) - apply(simp only: cp_OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person_Galaxy) -by(simp only: cp_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person_Galaxy) -lemma cp_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet_Galaxy : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Planet)))::\<cdot>Galaxy) .oclIsKindOf(Galaxy)))))" - apply(simp only: OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy) - apply((rule cpI2[where f = "(or)"], (rule allI)+, rule cp_OclOr)+) - apply(simp only: cp_OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet_Galaxy) -by(simp only: cp_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet_Galaxy) -lemma cp_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy_OclAny : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Galaxy)))::\<cdot>OclAny) .oclIsKindOf(Galaxy)))))" - apply(simp only: OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny) - apply((rule cpI2[where f = "(or)"], (rule allI)+, rule cp_OclOr)+) - apply(simp only: cp_OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy_OclAny) -by(simp only: cp_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy_OclAny) -lemma cp_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny_OclAny : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>OclAny)))::\<cdot>OclAny) .oclIsKindOf(Galaxy)))))" - apply(simp only: OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny) - apply((rule cpI2[where f = "(or)"], (rule allI)+, rule cp_OclOr)+) - apply(simp only: cp_OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny_OclAny) -by(simp only: cp_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny_OclAny) -lemma cp_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person_OclAny : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Person)))::\<cdot>OclAny) .oclIsKindOf(Galaxy)))))" - apply(simp only: OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny) - apply((rule cpI2[where f = "(or)"], (rule allI)+, rule cp_OclOr)+) - apply(simp only: cp_OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person_OclAny) -by(simp only: cp_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person_OclAny) -lemma cp_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet_OclAny : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Planet)))::\<cdot>OclAny) .oclIsKindOf(Galaxy)))))" - apply(simp only: OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny) - apply((rule cpI2[where f = "(or)"], (rule allI)+, rule cp_OclOr)+) - apply(simp only: cp_OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet_OclAny) -by(simp only: cp_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet_OclAny) -lemma cp_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy_Person : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Galaxy)))::\<cdot>Person) .oclIsKindOf(Galaxy)))))" - apply(simp only: OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person) - apply((rule cpI2[where f = "(or)"], (rule allI)+, rule cp_OclOr)+) - apply(simp only: cp_OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy_Person) -by(simp only: cp_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy_Person) -lemma cp_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny_Person : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>OclAny)))::\<cdot>Person) .oclIsKindOf(Galaxy)))))" - apply(simp only: OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person) - apply((rule cpI2[where f = "(or)"], (rule allI)+, rule cp_OclOr)+) - apply(simp only: cp_OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny_Person) -by(simp only: cp_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny_Person) -lemma cp_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person_Person : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Person)))::\<cdot>Person) .oclIsKindOf(Galaxy)))))" - apply(simp only: OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person) - apply((rule cpI2[where f = "(or)"], (rule allI)+, rule cp_OclOr)+) - apply(simp only: cp_OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person_Person) -by(simp only: cp_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person_Person) -lemma cp_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet_Person : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Planet)))::\<cdot>Person) .oclIsKindOf(Galaxy)))))" - apply(simp only: OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person) - apply((rule cpI2[where f = "(or)"], (rule allI)+, rule cp_OclOr)+) - apply(simp only: cp_OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet_Person) -by(simp only: cp_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet_Person) -lemma cp_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy_Planet : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Galaxy)))::\<cdot>Planet) .oclIsKindOf(Galaxy)))))" - apply(simp only: OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet) - apply((rule cpI2[where f = "(or)"], (rule allI)+, rule cp_OclOr)+) - apply(simp only: cp_OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy_Planet) -by(simp only: cp_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy_Planet) -lemma cp_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny_Planet : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>OclAny)))::\<cdot>Planet) .oclIsKindOf(Galaxy)))))" - apply(simp only: OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet) - apply((rule cpI2[where f = "(or)"], (rule allI)+, rule cp_OclOr)+) - apply(simp only: cp_OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny_Planet) -by(simp only: cp_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny_Planet) -lemma cp_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person_Planet : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Person)))::\<cdot>Planet) .oclIsKindOf(Galaxy)))))" - apply(simp only: OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet) - apply((rule cpI2[where f = "(or)"], (rule allI)+, rule cp_OclOr)+) - apply(simp only: cp_OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person_Planet) -by(simp only: cp_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person_Planet) -lemma cp_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet_Planet : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Planet)))::\<cdot>Planet) .oclIsKindOf(Galaxy)))))" - apply(simp only: OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet) - apply((rule cpI2[where f = "(or)"], (rule allI)+, rule cp_OclOr)+) - apply(simp only: cp_OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet_Planet) -by(simp only: cp_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet_Planet) -lemma cp_OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_OclAny : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>OclAny)))::\<cdot>OclAny) .oclIsKindOf(OclAny)))))" - apply(simp only: OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny) - apply((rule cpI2[where f = "(or)"], (rule allI)+, rule cp_OclOr)+) - apply(simp only: cp_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_OclAny) -by(simp only: cp_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny_OclAny) -lemma cp_OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_OclAny : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Person)))::\<cdot>OclAny) .oclIsKindOf(OclAny)))))" - apply(simp only: OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny) - apply((rule cpI2[where f = "(or)"], (rule allI)+, rule cp_OclOr)+) - apply(simp only: cp_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_OclAny) -by(simp only: cp_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person_OclAny) -lemma cp_OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet_OclAny : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Planet)))::\<cdot>OclAny) .oclIsKindOf(OclAny)))))" - apply(simp only: OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny) - apply((rule cpI2[where f = "(or)"], (rule allI)+, rule cp_OclOr)+) - apply(simp only: cp_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet_OclAny) -by(simp only: cp_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet_OclAny) -lemma cp_OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy_OclAny : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Galaxy)))::\<cdot>OclAny) .oclIsKindOf(OclAny)))))" - apply(simp only: OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny) - apply((rule cpI2[where f = "(or)"], (rule allI)+, rule cp_OclOr)+) - apply(simp only: cp_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy_OclAny) -by(simp only: cp_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy_OclAny) -lemma cp_OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_Person : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>OclAny)))::\<cdot>Person) .oclIsKindOf(OclAny)))))" - apply(simp only: OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person) - apply((rule cpI2[where f = "(or)"], (rule allI)+, rule cp_OclOr)+) - apply(simp only: cp_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_Person) -by(simp only: cp_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny_Person) -lemma cp_OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_Person : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Person)))::\<cdot>Person) .oclIsKindOf(OclAny)))))" - apply(simp only: OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person) - apply((rule cpI2[where f = "(or)"], (rule allI)+, rule cp_OclOr)+) - apply(simp only: cp_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_Person) -by(simp only: cp_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person_Person) -lemma cp_OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet_Person : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Planet)))::\<cdot>Person) .oclIsKindOf(OclAny)))))" - apply(simp only: OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person) - apply((rule cpI2[where f = "(or)"], (rule allI)+, rule cp_OclOr)+) - apply(simp only: cp_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet_Person) -by(simp only: cp_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet_Person) -lemma cp_OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy_Person : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Galaxy)))::\<cdot>Person) .oclIsKindOf(OclAny)))))" - apply(simp only: OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person) - apply((rule cpI2[where f = "(or)"], (rule allI)+, rule cp_OclOr)+) - apply(simp only: cp_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy_Person) -by(simp only: cp_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy_Person) -lemma cp_OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_Planet : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>OclAny)))::\<cdot>Planet) .oclIsKindOf(OclAny)))))" - apply(simp only: OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet) - apply((rule cpI2[where f = "(or)"], (rule allI)+, rule cp_OclOr)+) - apply(simp only: cp_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_Planet) -by(simp only: cp_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny_Planet) -lemma cp_OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_Planet : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Person)))::\<cdot>Planet) .oclIsKindOf(OclAny)))))" - apply(simp only: OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet) - apply((rule cpI2[where f = "(or)"], (rule allI)+, rule cp_OclOr)+) - apply(simp only: cp_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_Planet) -by(simp only: cp_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person_Planet) -lemma cp_OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet_Planet : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Planet)))::\<cdot>Planet) .oclIsKindOf(OclAny)))))" - apply(simp only: OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet) - apply((rule cpI2[where f = "(or)"], (rule allI)+, rule cp_OclOr)+) - apply(simp only: cp_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet_Planet) -by(simp only: cp_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet_Planet) -lemma cp_OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy_Planet : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Galaxy)))::\<cdot>Planet) .oclIsKindOf(OclAny)))))" - apply(simp only: OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet) - apply((rule cpI2[where f = "(or)"], (rule allI)+, rule cp_OclOr)+) - apply(simp only: cp_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy_Planet) -by(simp only: cp_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy_Planet) -lemma cp_OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_Galaxy : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>OclAny)))::\<cdot>Galaxy) .oclIsKindOf(OclAny)))))" - apply(simp only: OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy) - apply((rule cpI2[where f = "(or)"], (rule allI)+, rule cp_OclOr)+) - apply(simp only: cp_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_Galaxy) -by(simp only: cp_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny_Galaxy) -lemma cp_OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_Galaxy : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Person)))::\<cdot>Galaxy) .oclIsKindOf(OclAny)))))" - apply(simp only: OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy) - apply((rule cpI2[where f = "(or)"], (rule allI)+, rule cp_OclOr)+) - apply(simp only: cp_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_Galaxy) -by(simp only: cp_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person_Galaxy) -lemma cp_OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet_Galaxy : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Planet)))::\<cdot>Galaxy) .oclIsKindOf(OclAny)))))" - apply(simp only: OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy) - apply((rule cpI2[where f = "(or)"], (rule allI)+, rule cp_OclOr)+) - apply(simp only: cp_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet_Galaxy) -by(simp only: cp_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet_Galaxy) -lemma cp_OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy_Galaxy : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>Galaxy)))::\<cdot>Galaxy) .oclIsKindOf(OclAny)))))" - apply(simp only: OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy) - apply((rule cpI2[where f = "(or)"], (rule allI)+, rule cp_OclOr)+) - apply(simp only: cp_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy_Galaxy) -by(simp only: cp_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy_Galaxy) - -(* 83 ************************************ 525 + 1 *) (* term Floor1_iskindof.print_iskindof_lemmas_cp *) -lemmas[simp,code_unfold] = cp_OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_OclAny - cp_OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy_OclAny - cp_OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet_OclAny - cp_OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_OclAny - cp_OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_Galaxy - cp_OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy_Galaxy - cp_OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet_Galaxy - cp_OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_Galaxy - cp_OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_Planet - cp_OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy_Planet - cp_OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet_Planet - cp_OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_Planet - cp_OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_Person - cp_OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy_Person - cp_OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet_Person - cp_OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_Person - cp_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny_OclAny - cp_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy_OclAny - cp_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet_OclAny - cp_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person_OclAny - cp_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny_Galaxy - cp_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy_Galaxy - cp_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet_Galaxy - cp_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person_Galaxy - cp_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny_Planet - cp_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy_Planet - cp_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet_Planet - cp_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person_Planet - cp_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny_Person - cp_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy_Person - cp_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet_Person - cp_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person_Person - cp_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny_OclAny - cp_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy_OclAny - cp_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet_OclAny - cp_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person_OclAny - cp_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny_Galaxy - cp_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy_Galaxy - cp_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet_Galaxy - cp_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person_Galaxy - cp_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny_Planet - cp_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy_Planet - cp_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet_Planet - cp_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person_Planet - cp_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny_Person - cp_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy_Person - cp_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet_Person - cp_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person_Person - cp_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_OclAny - cp_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy_OclAny - cp_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet_OclAny - cp_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_OclAny - cp_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_Galaxy - cp_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy_Galaxy - cp_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet_Galaxy - cp_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_Galaxy - cp_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_Planet - cp_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy_Planet - cp_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet_Planet - cp_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_Planet - cp_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_Person - cp_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy_Person - cp_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet_Person - cp_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_Person - -(* 84 ************************************ 526 + 1 *) -subsection \<open>Execution with Invalid or Null as Argument\<close> - -(* 85 ************************************ 527 + 32 *) (* term Floor1_iskindof.print_iskindof_lemma_strict *) -lemma OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_invalid : "((invalid::\<cdot>Person) .oclIsKindOf(Person)) = invalid" -by(simp only: OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_invalid) -lemma OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_null : "((null::\<cdot>Person) .oclIsKindOf(Person)) = true" -by(simp only: OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_null) -lemma OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet_invalid : "((invalid::\<cdot>Planet) .oclIsKindOf(Person)) = invalid" -by(simp only: OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet_invalid) -lemma OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet_null : "((null::\<cdot>Planet) .oclIsKindOf(Person)) = true" -by(simp only: OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet_null) -lemma OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy_invalid : "((invalid::\<cdot>Galaxy) .oclIsKindOf(Person)) = invalid" -by(simp only: OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy_invalid) -lemma OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy_null : "((null::\<cdot>Galaxy) .oclIsKindOf(Person)) = true" -by(simp only: OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy_null) -lemma OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_invalid : "((invalid::\<cdot>OclAny) .oclIsKindOf(Person)) = invalid" -by(simp only: OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_invalid) -lemma OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_null : "((null::\<cdot>OclAny) .oclIsKindOf(Person)) = true" -by(simp only: OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_null) -lemma OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet_invalid : "((invalid::\<cdot>Planet) .oclIsKindOf(Planet)) = invalid" -by(simp only: OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet_invalid OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet_invalid, simp) -lemma OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet_null : "((null::\<cdot>Planet) .oclIsKindOf(Planet)) = true" -by(simp only: OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet_null OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet_null, simp) -lemma OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy_invalid : "((invalid::\<cdot>Galaxy) .oclIsKindOf(Planet)) = invalid" -by(simp only: OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy_invalid OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy_invalid, simp) -lemma OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy_null : "((null::\<cdot>Galaxy) .oclIsKindOf(Planet)) = true" -by(simp only: OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy_null OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy_null, simp) -lemma OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny_invalid : "((invalid::\<cdot>OclAny) .oclIsKindOf(Planet)) = invalid" -by(simp only: OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny_invalid OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_invalid, simp) -lemma OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny_null : "((null::\<cdot>OclAny) .oclIsKindOf(Planet)) = true" -by(simp only: OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny_null OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_null, simp) -lemma OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person_invalid : "((invalid::\<cdot>Person) .oclIsKindOf(Planet)) = invalid" -by(simp only: OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person_invalid OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_invalid, simp) -lemma OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person_null : "((null::\<cdot>Person) .oclIsKindOf(Planet)) = true" -by(simp only: OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person_null OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_null, simp) -lemma OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy_invalid : "((invalid::\<cdot>Galaxy) .oclIsKindOf(Galaxy)) = invalid" -by(simp only: OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy_invalid OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy_invalid, simp) -lemma OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy_null : "((null::\<cdot>Galaxy) .oclIsKindOf(Galaxy)) = true" -by(simp only: OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy_null OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy_null, simp) -lemma OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny_invalid : "((invalid::\<cdot>OclAny) .oclIsKindOf(Galaxy)) = invalid" -by(simp only: OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny_invalid OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny_invalid, simp) -lemma OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny_null : "((null::\<cdot>OclAny) .oclIsKindOf(Galaxy)) = true" -by(simp only: OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny_null OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny_null, simp) -lemma OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person_invalid : "((invalid::\<cdot>Person) .oclIsKindOf(Galaxy)) = invalid" -by(simp only: OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person_invalid OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person_invalid, simp) -lemma OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person_null : "((null::\<cdot>Person) .oclIsKindOf(Galaxy)) = true" -by(simp only: OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person_null OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person_null, simp) -lemma OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet_invalid : "((invalid::\<cdot>Planet) .oclIsKindOf(Galaxy)) = invalid" -by(simp only: OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet_invalid OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet_invalid, simp) -lemma OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet_null : "((null::\<cdot>Planet) .oclIsKindOf(Galaxy)) = true" -by(simp only: OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet_null OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet_null, simp) -lemma OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_invalid : "((invalid::\<cdot>OclAny) .oclIsKindOf(OclAny)) = invalid" -by(simp only: OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_invalid OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny_invalid, simp) -lemma OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_null : "((null::\<cdot>OclAny) .oclIsKindOf(OclAny)) = true" -by(simp only: OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_null OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny_null, simp) -lemma OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_invalid : "((invalid::\<cdot>Person) .oclIsKindOf(OclAny)) = invalid" -by(simp only: OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_invalid OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person_invalid, simp) -lemma OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_null : "((null::\<cdot>Person) .oclIsKindOf(OclAny)) = true" -by(simp only: OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_null OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person_null, simp) -lemma OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet_invalid : "((invalid::\<cdot>Planet) .oclIsKindOf(OclAny)) = invalid" -by(simp only: OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet_invalid OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet_invalid, simp) -lemma OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet_null : "((null::\<cdot>Planet) .oclIsKindOf(OclAny)) = true" -by(simp only: OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet_null OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet_null, simp) -lemma OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy_invalid : "((invalid::\<cdot>Galaxy) .oclIsKindOf(OclAny)) = invalid" -by(simp only: OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy_invalid OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy_invalid, simp) -lemma OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy_null : "((null::\<cdot>Galaxy) .oclIsKindOf(OclAny)) = true" -by(simp only: OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy_null OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy_null, simp) - -(* 86 ************************************ 559 + 1 *) (* term Floor1_iskindof.print_iskindof_lemmas_strict *) -lemmas[simp,code_unfold] = OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_invalid - OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy_invalid - OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet_invalid - OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_invalid - OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_null - OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy_null - OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet_null - OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_null - OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny_invalid - OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy_invalid - OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet_invalid - OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person_invalid - OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny_null - OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy_null - OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet_null - OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person_null - OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny_invalid - OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy_invalid - OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet_invalid - OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person_invalid - OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny_null - OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy_null - OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet_null - OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person_null - OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_invalid - OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy_invalid - OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet_invalid - OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_invalid - OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_null - OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy_null - OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet_null - OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_null - -(* 87 ************************************ 560 + 1 *) -subsection \<open>Validity and Definedness Properties\<close> - -(* 88 ************************************ 561 + 16 *) (* term Floor1_iskindof.print_iskindof_defined *) -lemma OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_defined : -assumes isdef: "\<tau> \<Turnstile> (\<upsilon> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Person) .oclIsKindOf(Person)))" -by(simp only: OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person, rule OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_defined[OF isdef]) -lemma OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet_defined : -assumes isdef: "\<tau> \<Turnstile> (\<upsilon> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Planet) .oclIsKindOf(Person)))" -by(simp only: OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet, rule OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet_defined[OF isdef]) -lemma OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy_defined : -assumes isdef: "\<tau> \<Turnstile> (\<upsilon> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Galaxy) .oclIsKindOf(Person)))" -by(simp only: OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy, rule OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy_defined[OF isdef]) -lemma OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_defined : -assumes isdef: "\<tau> \<Turnstile> (\<upsilon> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>OclAny) .oclIsKindOf(Person)))" -by(simp only: OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny, rule OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_defined[OF isdef]) -lemma OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet_defined : -assumes isdef: "\<tau> \<Turnstile> (\<upsilon> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Planet) .oclIsKindOf(Planet)))" -by(simp only: OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet, rule defined_or_I[OF OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet_defined[OF isdef], OF OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet_defined[OF isdef]]) -lemma OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy_defined : -assumes isdef: "\<tau> \<Turnstile> (\<upsilon> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Galaxy) .oclIsKindOf(Planet)))" -by(simp only: OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy, rule defined_or_I[OF OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy_defined[OF isdef], OF OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy_defined[OF isdef]]) -lemma OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny_defined : -assumes isdef: "\<tau> \<Turnstile> (\<upsilon> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>OclAny) .oclIsKindOf(Planet)))" -by(simp only: OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny, rule defined_or_I[OF OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny_defined[OF isdef], OF OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_defined[OF isdef]]) -lemma OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person_defined : -assumes isdef: "\<tau> \<Turnstile> (\<upsilon> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Person) .oclIsKindOf(Planet)))" -by(simp only: OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person, rule defined_or_I[OF OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person_defined[OF isdef], OF OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_defined[OF isdef]]) -lemma OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy_defined : -assumes isdef: "\<tau> \<Turnstile> (\<upsilon> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Galaxy) .oclIsKindOf(Galaxy)))" -by(simp only: OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy, rule defined_or_I[OF OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy_defined[OF isdef], OF OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy_defined[OF isdef]]) -lemma OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny_defined : -assumes isdef: "\<tau> \<Turnstile> (\<upsilon> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>OclAny) .oclIsKindOf(Galaxy)))" -by(simp only: OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny, rule defined_or_I[OF OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny_defined[OF isdef], OF OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny_defined[OF isdef]]) -lemma OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person_defined : -assumes isdef: "\<tau> \<Turnstile> (\<upsilon> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Person) .oclIsKindOf(Galaxy)))" -by(simp only: OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person, rule defined_or_I[OF OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person_defined[OF isdef], OF OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person_defined[OF isdef]]) -lemma OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet_defined : -assumes isdef: "\<tau> \<Turnstile> (\<upsilon> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Planet) .oclIsKindOf(Galaxy)))" -by(simp only: OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet, rule defined_or_I[OF OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet_defined[OF isdef], OF OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet_defined[OF isdef]]) -lemma OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_defined : -assumes isdef: "\<tau> \<Turnstile> (\<upsilon> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>OclAny) .oclIsKindOf(OclAny)))" -by(simp only: OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny, rule defined_or_I[OF OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_defined[OF isdef], OF OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny_defined[OF isdef]]) -lemma OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_defined : -assumes isdef: "\<tau> \<Turnstile> (\<upsilon> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Person) .oclIsKindOf(OclAny)))" -by(simp only: OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person, rule defined_or_I[OF OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_defined[OF isdef], OF OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person_defined[OF isdef]]) -lemma OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet_defined : -assumes isdef: "\<tau> \<Turnstile> (\<upsilon> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Planet) .oclIsKindOf(OclAny)))" -by(simp only: OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet, rule defined_or_I[OF OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet_defined[OF isdef], OF OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet_defined[OF isdef]]) -lemma OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy_defined : -assumes isdef: "\<tau> \<Turnstile> (\<upsilon> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Galaxy) .oclIsKindOf(OclAny)))" -by(simp only: OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy, rule defined_or_I[OF OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy_defined[OF isdef], OF OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy_defined[OF isdef]]) - -(* 89 ************************************ 577 + 16 *) (* term Floor1_iskindof.print_iskindof_defined' *) -lemma OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_defined' : -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Person) .oclIsKindOf(Person)))" -by(rule OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_defined[OF isdef[THEN foundation20]]) -lemma OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet_defined' : -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Planet) .oclIsKindOf(Person)))" -by(rule OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet_defined[OF isdef[THEN foundation20]]) -lemma OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy_defined' : -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Galaxy) .oclIsKindOf(Person)))" -by(rule OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy_defined[OF isdef[THEN foundation20]]) -lemma OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_defined' : -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>OclAny) .oclIsKindOf(Person)))" -by(rule OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_defined[OF isdef[THEN foundation20]]) -lemma OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet_defined' : -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Planet) .oclIsKindOf(Planet)))" -by(rule OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet_defined[OF isdef[THEN foundation20]]) -lemma OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy_defined' : -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Galaxy) .oclIsKindOf(Planet)))" -by(rule OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy_defined[OF isdef[THEN foundation20]]) -lemma OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny_defined' : -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>OclAny) .oclIsKindOf(Planet)))" -by(rule OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny_defined[OF isdef[THEN foundation20]]) -lemma OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person_defined' : -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Person) .oclIsKindOf(Planet)))" -by(rule OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person_defined[OF isdef[THEN foundation20]]) -lemma OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy_defined' : -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Galaxy) .oclIsKindOf(Galaxy)))" -by(rule OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy_defined[OF isdef[THEN foundation20]]) -lemma OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny_defined' : -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>OclAny) .oclIsKindOf(Galaxy)))" -by(rule OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny_defined[OF isdef[THEN foundation20]]) -lemma OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person_defined' : -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Person) .oclIsKindOf(Galaxy)))" -by(rule OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person_defined[OF isdef[THEN foundation20]]) -lemma OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet_defined' : -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Planet) .oclIsKindOf(Galaxy)))" -by(rule OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet_defined[OF isdef[THEN foundation20]]) -lemma OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_defined' : -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>OclAny) .oclIsKindOf(OclAny)))" -by(rule OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_defined[OF isdef[THEN foundation20]]) -lemma OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_defined' : -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Person) .oclIsKindOf(OclAny)))" -by(rule OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_defined[OF isdef[THEN foundation20]]) -lemma OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet_defined' : -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Planet) .oclIsKindOf(OclAny)))" -by(rule OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet_defined[OF isdef[THEN foundation20]]) -lemma OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy_defined' : -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Galaxy) .oclIsKindOf(OclAny)))" -by(rule OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy_defined[OF isdef[THEN foundation20]]) - -(* 90 ************************************ 593 + 1 *) -subsection \<open>Up Down Casting\<close> - -(* 91 ************************************ 594 + 4 *) (* term Floor1_iskindof.print_iskindof_up_eq_asty *) -lemma actual_eq_static\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n : -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> ((X::\<cdot>Person) .oclIsKindOf(Person))" - apply(simp only: OclValid_def, insert isdef) - apply(simp only: OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person) - apply(auto simp: foundation16 bot_option_def split: option.split ty\<E>\<X>\<T>\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n.split ty\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n.split) -by((simp_all add: false_def true_def OclOr_def OclAnd_def OclNot_def)?) -lemma actual_eq_static\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t : -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> ((X::\<cdot>Planet) .oclIsKindOf(Planet))" - apply(simp only: OclValid_def, insert isdef) - apply(simp only: OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet, subst (1) cp_OclOr, simp only: OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet) - apply(auto simp: cp_OclOr[symmetric ] foundation16 bot_option_def OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet split: option.split ty\<E>\<X>\<T>\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t.split ty\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t.split ty\<E>\<X>\<T>\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n.split ty\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n.split) -by((simp_all add: false_def true_def OclOr_def OclAnd_def OclNot_def)?) -lemma actual_eq_static\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y : -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> ((X::\<cdot>Galaxy) .oclIsKindOf(Galaxy))" - apply(simp only: OclValid_def, insert isdef) - apply(simp only: OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy, subst (1) cp_OclOr, simp only: OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy, subst (2 1) cp_OclOr, simp only: OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy) - apply(auto simp: cp_OclOr[symmetric ] foundation16 bot_option_def OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy split: option.split ty\<E>\<X>\<T>\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y.split ty\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y.split ty\<E>\<X>\<T>\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n.split ty\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n.split ty\<E>\<X>\<T>\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t.split ty\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t.split) -by((simp_all add: false_def true_def OclOr_def OclAnd_def OclNot_def)?) -lemma actual_eq_static\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y : -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> ((X::\<cdot>OclAny) .oclIsKindOf(OclAny))" - apply(simp only: OclValid_def, insert isdef) - apply(simp only: OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny, subst (1) cp_OclOr, simp only: OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny, subst (2 1) cp_OclOr, simp only: OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny, subst (3 2 1) cp_OclOr, simp only: OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny) - apply(auto simp: cp_OclOr[symmetric ] foundation16 bot_option_def OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny split: option.split ty\<E>\<X>\<T>\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y.split ty\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y.split ty\<E>\<X>\<T>\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n.split ty\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n.split ty\<E>\<X>\<T>\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t.split ty\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t.split ty\<E>\<X>\<T>\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y.split ty\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y.split) -by((simp_all add: false_def true_def OclOr_def OclAnd_def OclNot_def)?) - -(* 92 ************************************ 598 + 6 *) (* term Floor1_iskindof.print_iskindof_up_larger *) -lemma actualKind\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_larger_staticKind\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t : -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> ((X::\<cdot>Person) .oclIsKindOf(Planet))" - apply(simp only: OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person) -by(rule foundation25', rule actual_eq_static\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n[OF isdef]) -lemma actualKind\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_larger_staticKind\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y : -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> ((X::\<cdot>Person) .oclIsKindOf(Galaxy))" - apply(simp only: OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person) -by(rule foundation25', rule actualKind\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_larger_staticKind\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t[OF isdef]) -lemma actualKind\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_larger_staticKind\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y : -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> ((X::\<cdot>Person) .oclIsKindOf(OclAny))" - apply(simp only: OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person) -by(rule foundation25', rule actualKind\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_larger_staticKind\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y[OF isdef]) -lemma actualKind\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_larger_staticKind\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y : -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> ((X::\<cdot>Planet) .oclIsKindOf(Galaxy))" - apply(simp only: OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet) -by(rule foundation25', rule actual_eq_static\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t[OF isdef]) -lemma actualKind\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_larger_staticKind\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y : -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> ((X::\<cdot>Planet) .oclIsKindOf(OclAny))" - apply(simp only: OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet) -by(rule foundation25', rule actualKind\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_larger_staticKind\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y[OF isdef]) -lemma actualKind\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_larger_staticKind\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y : -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> ((X::\<cdot>Galaxy) .oclIsKindOf(OclAny))" - apply(simp only: OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy) -by(rule foundation25', rule actual_eq_static\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y[OF isdef]) - -(* 93 ************************************ 604 + 6 *) (* term Floor1_iskindof.print_iskindof_up_istypeof_unfold *) -lemma not_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_then_Planet_OclIsTypeOf_others_unfold : -assumes isdef: "(\<tau> \<Turnstile> (\<delta> (X)))" -assumes iskin: "(\<tau> \<Turnstile> ((X::\<cdot>Planet) .oclIsKindOf(Person)))" -shows "(\<tau> \<Turnstile> ((X::\<cdot>Planet) .oclIsTypeOf(Person)))" - using iskin - apply(simp only: OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet) -done -lemma not_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_then_Galaxy_OclIsTypeOf_others_unfold : -assumes isdef: "(\<tau> \<Turnstile> (\<delta> (X)))" -assumes iskin: "(\<tau> \<Turnstile> ((X::\<cdot>Galaxy) .oclIsKindOf(Person)))" -shows "(\<tau> \<Turnstile> ((X::\<cdot>Galaxy) .oclIsTypeOf(Person)))" - using iskin - apply(simp only: OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy) -done -lemma not_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_then_OclAny_OclIsTypeOf_others_unfold : -assumes isdef: "(\<tau> \<Turnstile> (\<delta> (X)))" -assumes iskin: "(\<tau> \<Turnstile> ((X::\<cdot>OclAny) .oclIsKindOf(Person)))" -shows "(\<tau> \<Turnstile> ((X::\<cdot>OclAny) .oclIsTypeOf(Person)))" - using iskin - apply(simp only: OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny) -done -lemma not_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_then_Galaxy_OclIsTypeOf_others_unfold : -assumes isdef: "(\<tau> \<Turnstile> (\<delta> (X)))" -assumes iskin: "(\<tau> \<Turnstile> ((X::\<cdot>Galaxy) .oclIsKindOf(Planet)))" -shows "((\<tau> \<Turnstile> ((X::\<cdot>Galaxy) .oclIsTypeOf(Planet))) \<or> (\<tau> \<Turnstile> ((X::\<cdot>Galaxy) .oclIsTypeOf(Person))))" - using iskin - apply(simp only: OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy) - apply(erule foundation26[OF OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy_defined'[OF isdef], OF OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy_defined'[OF isdef]]) - apply(simp) - apply(drule not_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_then_Galaxy_OclIsTypeOf_others_unfold[OF isdef], blast) -done -lemma not_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_then_OclAny_OclIsTypeOf_others_unfold : -assumes isdef: "(\<tau> \<Turnstile> (\<delta> (X)))" -assumes iskin: "(\<tau> \<Turnstile> ((X::\<cdot>OclAny) .oclIsKindOf(Planet)))" -shows "((\<tau> \<Turnstile> ((X::\<cdot>OclAny) .oclIsTypeOf(Planet))) \<or> (\<tau> \<Turnstile> ((X::\<cdot>OclAny) .oclIsTypeOf(Person))))" - using iskin - apply(simp only: OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny) - apply(erule foundation26[OF OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny_defined'[OF isdef], OF OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_defined'[OF isdef]]) - apply(simp) - apply(drule not_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_then_OclAny_OclIsTypeOf_others_unfold[OF isdef], blast) -done -lemma not_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_then_OclAny_OclIsTypeOf_others_unfold : -assumes isdef: "(\<tau> \<Turnstile> (\<delta> (X)))" -assumes iskin: "(\<tau> \<Turnstile> ((X::\<cdot>OclAny) .oclIsKindOf(Galaxy)))" -shows "((\<tau> \<Turnstile> ((X::\<cdot>OclAny) .oclIsTypeOf(Galaxy))) \<or> ((\<tau> \<Turnstile> ((X::\<cdot>OclAny) .oclIsTypeOf(Person))) \<or> (\<tau> \<Turnstile> ((X::\<cdot>OclAny) .oclIsTypeOf(Planet)))))" - using iskin - apply(simp only: OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny) - apply(erule foundation26[OF OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny_defined'[OF isdef], OF OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny_defined'[OF isdef]]) - apply(simp) - apply(drule not_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_then_OclAny_OclIsTypeOf_others_unfold[OF isdef], blast) -done - -(* 94 ************************************ 610 + 6 *) (* term Floor1_iskindof.print_iskindof_up_istypeof *) -lemma not_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_then_Planet_OclIsTypeOf_others : -assumes iskin: "\<not> \<tau> \<Turnstile> ((X::\<cdot>Planet) .oclIsKindOf(Person))" -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> ((X::\<cdot>Planet) .oclIsTypeOf(Planet))" - using actual_eq_static\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t[OF isdef] - apply(simp only: OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet) - apply(erule foundation26[OF OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet_defined'[OF isdef], OF OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet_defined'[OF isdef]]) - apply(simp) - apply(simp add: iskin) -done -lemma not_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_then_Galaxy_OclIsTypeOf_others : -assumes iskin: "\<not> \<tau> \<Turnstile> ((X::\<cdot>Galaxy) .oclIsKindOf(Person))" -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "(\<tau> \<Turnstile> ((X::\<cdot>Galaxy) .oclIsTypeOf(Galaxy)) \<or> \<tau> \<Turnstile> ((X::\<cdot>Galaxy) .oclIsTypeOf(Planet)))" - using actual_eq_static\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y[OF isdef] - apply(simp only: OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy) - apply(erule foundation26[OF OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy_defined'[OF isdef], OF OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy_defined'[OF isdef]]) - apply(simp) - apply(simp only: OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy) - apply(erule foundation26[OF OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy_defined'[OF isdef], OF OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy_defined'[OF isdef]]) - apply(simp) - apply(simp add: iskin) -done -lemma not_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_then_OclAny_OclIsTypeOf_others : -assumes iskin: "\<not> \<tau> \<Turnstile> ((X::\<cdot>OclAny) .oclIsKindOf(Person))" -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "(\<tau> \<Turnstile> ((X::\<cdot>OclAny) .oclIsTypeOf(OclAny)) \<or> (\<tau> \<Turnstile> ((X::\<cdot>OclAny) .oclIsTypeOf(Galaxy)) \<or> \<tau> \<Turnstile> ((X::\<cdot>OclAny) .oclIsTypeOf(Planet))))" - using actual_eq_static\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y[OF isdef] - apply(simp only: OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny) - apply(erule foundation26[OF OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_defined'[OF isdef], OF OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny_defined'[OF isdef]]) - apply(simp) - apply(simp only: OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny) - apply(erule foundation26[OF OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny_defined'[OF isdef], OF OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny_defined'[OF isdef]]) - apply(simp) - apply(simp only: OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny) - apply(erule foundation26[OF OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny_defined'[OF isdef], OF OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_defined'[OF isdef]]) - apply(simp) - apply(simp add: iskin) -done -lemma not_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_then_Galaxy_OclIsTypeOf_others : -assumes iskin: "\<not> \<tau> \<Turnstile> ((X::\<cdot>Galaxy) .oclIsKindOf(Planet))" -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> ((X::\<cdot>Galaxy) .oclIsTypeOf(Galaxy))" - using actual_eq_static\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y[OF isdef] - apply(simp only: OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy) - apply(erule foundation26[OF OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy_defined'[OF isdef], OF OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy_defined'[OF isdef]]) - apply(simp) - apply(simp add: iskin) -done -lemma not_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_then_OclAny_OclIsTypeOf_others : -assumes iskin: "\<not> \<tau> \<Turnstile> ((X::\<cdot>OclAny) .oclIsKindOf(Planet))" -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "(\<tau> \<Turnstile> ((X::\<cdot>OclAny) .oclIsTypeOf(OclAny)) \<or> \<tau> \<Turnstile> ((X::\<cdot>OclAny) .oclIsTypeOf(Galaxy)))" - using actual_eq_static\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y[OF isdef] - apply(simp only: OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny) - apply(erule foundation26[OF OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_defined'[OF isdef], OF OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny_defined'[OF isdef]]) - apply(simp) - apply(simp only: OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny) - apply(erule foundation26[OF OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny_defined'[OF isdef], OF OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny_defined'[OF isdef]]) - apply(simp) - apply(simp add: iskin) -done -lemma not_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_then_OclAny_OclIsTypeOf_others : -assumes iskin: "\<not> \<tau> \<Turnstile> ((X::\<cdot>OclAny) .oclIsKindOf(Galaxy))" -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> ((X::\<cdot>OclAny) .oclIsTypeOf(OclAny))" - using actual_eq_static\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y[OF isdef] - apply(simp only: OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny) - apply(erule foundation26[OF OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_defined'[OF isdef], OF OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny_defined'[OF isdef]]) - apply(simp) - apply(simp add: iskin) -done - -(* 95 ************************************ 616 + 10 *) (* term Floor1_iskindof.print_iskindof_up_d_cast *) -lemma down_cast_kind\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_from_Planet_to_Person : -assumes iskin: "\<not> \<tau> \<Turnstile> ((X::\<cdot>Planet) .oclIsKindOf(Person))" -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> (X .oclAsType(Person)) \<triangleq> invalid" - apply(insert not_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_then_Planet_OclIsTypeOf_others[OF iskin, OF isdef]) - apply(rule down_cast_type\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_from_Planet_to_Person, simp only: , simp only: isdef) -done -lemma down_cast_kind\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_from_Galaxy_to_Person : -assumes iskin: "\<not> \<tau> \<Turnstile> ((X::\<cdot>Galaxy) .oclIsKindOf(Person))" -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> (X .oclAsType(Person)) \<triangleq> invalid" - apply(insert not_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_then_Galaxy_OclIsTypeOf_others[OF iskin, OF isdef], elim disjE) - apply(rule down_cast_type\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_from_Galaxy_to_Person, simp only: , simp only: isdef) - apply(rule down_cast_type\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_from_Galaxy_to_Person, simp only: , simp only: isdef) -done -lemma down_cast_kind\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_from_OclAny_to_Person : -assumes iskin: "\<not> \<tau> \<Turnstile> ((X::\<cdot>OclAny) .oclIsKindOf(Person))" -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> (X .oclAsType(Person)) \<triangleq> invalid" - apply(insert not_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_then_OclAny_OclIsTypeOf_others[OF iskin, OF isdef], elim disjE) - apply(rule down_cast_type\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_from_OclAny_to_Person, simp only: , simp only: isdef) - apply(rule down_cast_type\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_from_OclAny_to_Person, simp only: , simp only: isdef) - apply(rule down_cast_type\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_from_OclAny_to_Person, simp only: , simp only: isdef) -done -lemma down_cast_kind\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_from_Galaxy_to_Planet : -assumes iskin: "\<not> \<tau> \<Turnstile> ((X::\<cdot>Galaxy) .oclIsKindOf(Planet))" -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> (X .oclAsType(Planet)) \<triangleq> invalid" - apply(insert not_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_then_Galaxy_OclIsTypeOf_others[OF iskin, OF isdef]) - apply(rule down_cast_type\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_from_Galaxy_to_Planet, simp only: , simp only: isdef) -done -lemma down_cast_kind\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_from_Galaxy_to_Person : -assumes iskin: "\<not> \<tau> \<Turnstile> ((X::\<cdot>Galaxy) .oclIsKindOf(Planet))" -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> (X .oclAsType(Person)) \<triangleq> invalid" - apply(insert not_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_then_Galaxy_OclIsTypeOf_others[OF iskin, OF isdef]) - apply(rule down_cast_type\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_from_Galaxy_to_Person, simp only: , simp only: isdef) -done -lemma down_cast_kind\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_from_OclAny_to_Planet : -assumes iskin: "\<not> \<tau> \<Turnstile> ((X::\<cdot>OclAny) .oclIsKindOf(Planet))" -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> (X .oclAsType(Planet)) \<triangleq> invalid" - apply(insert not_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_then_OclAny_OclIsTypeOf_others[OF iskin, OF isdef], elim disjE) - apply(rule down_cast_type\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_from_OclAny_to_Planet, simp only: , simp only: isdef) - apply(rule down_cast_type\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_from_OclAny_to_Planet, simp only: , simp only: isdef) -done -lemma down_cast_kind\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_from_OclAny_to_Person : -assumes iskin: "\<not> \<tau> \<Turnstile> ((X::\<cdot>OclAny) .oclIsKindOf(Planet))" -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> (X .oclAsType(Person)) \<triangleq> invalid" - apply(insert not_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_then_OclAny_OclIsTypeOf_others[OF iskin, OF isdef], elim disjE) - apply(rule down_cast_type\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_from_OclAny_to_Person, simp only: , simp only: isdef) - apply(rule down_cast_type\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_from_OclAny_to_Person, simp only: , simp only: isdef) -done -lemma down_cast_kind\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_from_OclAny_to_Galaxy : -assumes iskin: "\<not> \<tau> \<Turnstile> ((X::\<cdot>OclAny) .oclIsKindOf(Galaxy))" -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> (X .oclAsType(Galaxy)) \<triangleq> invalid" - apply(insert not_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_then_OclAny_OclIsTypeOf_others[OF iskin, OF isdef]) - apply(rule down_cast_type\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_from_OclAny_to_Galaxy, simp only: , simp only: isdef) -done -lemma down_cast_kind\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_from_OclAny_to_Person : -assumes iskin: "\<not> \<tau> \<Turnstile> ((X::\<cdot>OclAny) .oclIsKindOf(Galaxy))" -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> (X .oclAsType(Person)) \<triangleq> invalid" - apply(insert not_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_then_OclAny_OclIsTypeOf_others[OF iskin, OF isdef]) - apply(rule down_cast_type\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_from_OclAny_to_Person, simp only: , simp only: isdef) -done -lemma down_cast_kind\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_from_OclAny_to_Planet : -assumes iskin: "\<not> \<tau> \<Turnstile> ((X::\<cdot>OclAny) .oclIsKindOf(Galaxy))" -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> (X .oclAsType(Planet)) \<triangleq> invalid" - apply(insert not_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_then_OclAny_OclIsTypeOf_others[OF iskin, OF isdef]) - apply(rule down_cast_type\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_from_OclAny_to_Planet, simp only: , simp only: isdef) -done - -(* 96 ************************************ 626 + 1 *) -subsection \<open>Const\<close> - -(* 97 ************************************ 627 + 1 *) -section \<open>Class Model: OclAllInstances\<close> - -(* 98 ************************************ 628 + 1 *) -text \<open> - To denote \OCL-types occurring in \OCL expressions syntactically---as, for example, as -``argument'' of \inlineisar{oclAllInstances()}---we use the inverses of the injection -functions into the object universes; we show that this is sufficient ``characterization.'' \<close> - -(* 99 ************************************ 629 + 4 *) (* term Floor1_allinst.print_allinst_def_id *) -definition "Person = OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_\<AA>" -definition "Planet = OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_\<AA>" -definition "Galaxy = OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_\<AA>" -definition "OclAny = OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_\<AA>" - -(* 100 ************************************ 633 + 1 *) (* term Floor1_allinst.print_allinst_lemmas_id *) -lemmas[simp,code_unfold] = Person_def - Planet_def - Galaxy_def - OclAny_def - -(* 101 ************************************ 634 + 1 *) (* term Floor1_allinst.print_allinst_astype *) -lemma OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_\<AA>_some : "(OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_\<AA> (x)) \<noteq> None" -by(simp add: OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_\<AA>_def) - -(* 102 ************************************ 635 + 3 *) (* term Floor1_allinst.print_allinst_exec *) -lemma OclAllInstances_generic\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_exec : -shows "(OclAllInstances_generic (pre_post) (OclAny)) = (\<lambda>\<tau>. (Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (\<lfloor>\<lfloor>Some ` OclAny ` (ran ((heap ((pre_post (\<tau>))))))\<rfloor>\<rfloor>)))" - proof - let ?S1 = "(\<lambda>\<tau>. OclAny ` (ran ((heap ((pre_post (\<tau>)))))))" show ?thesis - proof - let ?S2 = "(\<lambda>\<tau>. ((?S1) (\<tau>)) - {None})" show ?thesis - proof - have B: "(\<And>\<tau>. ((?S2) (\<tau>)) \<subseteq> ((?S1) (\<tau>)))" by(auto) show ?thesis - proof - have C: "(\<And>\<tau>. ((?S1) (\<tau>)) \<subseteq> ((?S2) (\<tau>)))" by(auto simp: OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_\<AA>_some) show ?thesis - apply(simp add: OclValid_def del: OclAllInstances_generic_def OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny) -by(insert equalityI[OF B, OF C], simp) qed qed qed qed -lemma OclAllInstances_at_post\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_exec : -shows "(OclAllInstances_at_post (OclAny)) = (\<lambda>\<tau>. (Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (\<lfloor>\<lfloor>Some ` OclAny ` (ran ((heap ((snd (\<tau>))))))\<rfloor>\<rfloor>)))" - unfolding OclAllInstances_at_post_def -by(rule OclAllInstances_generic\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_exec) -lemma OclAllInstances_at_pre\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_exec : -shows "(OclAllInstances_at_pre (OclAny)) = (\<lambda>\<tau>. (Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (\<lfloor>\<lfloor>Some ` OclAny ` (ran ((heap ((fst (\<tau>))))))\<rfloor>\<rfloor>)))" - unfolding OclAllInstances_at_pre_def -by(rule OclAllInstances_generic\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_exec) - -(* 103 ************************************ 638 + 1 *) -subsection \<open>OclIsTypeOf\<close> - -(* 104 ************************************ 639 + 2 *) (* term Floor1_allinst.print_allinst_istypeof_pre *) -lemma ex_ssubst : "(\<forall>x \<in> B. (s (x)) = (t (x))) \<Longrightarrow> (\<exists>x \<in> B. (P ((s (x))))) = (\<exists>x \<in> B. (P ((t (x)))))" -by(simp) -lemma ex_def : "x \<in> \<lceil>\<lceil>\<lfloor>\<lfloor>Some ` (X - {None})\<rfloor>\<rfloor>\<rceil>\<rceil> \<Longrightarrow> (\<exists>y. x = \<lfloor>\<lfloor>y\<rfloor>\<rfloor>)" -by(auto) - -(* 105 ************************************ 641 + 21 *) (* term Floor1_allinst.print_allinst_istypeof *) -lemma Person_OclAllInstances_generic_OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n : "\<tau> \<Turnstile> (UML_Set.OclForall ((OclAllInstances_generic (pre_post) (Person))) (OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))" - apply(simp add: OclValid_def del: OclAllInstances_generic_def) - apply(simp only: UML_Set.OclForall_def refl if_True OclAllInstances_generic_defined[simplified OclValid_def]) - apply(simp only: OclAllInstances_generic_def) - apply(subst (1 2 3) Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inverse, simp add: bot_option_def) - apply(subst (1 2 3) ex_ssubst[where s = "(\<lambda>x. (((\<lambda>_. x) .oclIsTypeOf(Person)) (\<tau>)))" and t = "(\<lambda>_. (true (\<tau>)))"]) - apply(intro ballI actual_eq_static\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n[simplified OclValid_def, simplified OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person]) - apply(drule ex_def, erule exE, simp) -by(simp) -lemma Person_OclAllInstances_at_post_OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n : -shows "\<tau> \<Turnstile> (UML_Set.OclForall ((OclAllInstances_at_post (Person))) (OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))" - unfolding OclAllInstances_at_post_def -by(rule Person_OclAllInstances_generic_OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n) -lemma Person_OclAllInstances_at_pre_OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n : -shows "\<tau> \<Turnstile> (UML_Set.OclForall ((OclAllInstances_at_pre (Person))) (OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))" - unfolding OclAllInstances_at_pre_def -by(rule Person_OclAllInstances_generic_OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n) -lemma Planet_OclAllInstances_generic_OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t1 : -assumes [simp]: "(\<And>x. (pre_post ((x , x))) = x)" -shows "(\<exists>\<tau>. \<tau> \<Turnstile> (UML_Set.OclForall ((OclAllInstances_generic (pre_post) (Planet))) (OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t)))" - apply(rule exI[where x = "\<tau>\<^sub>0"], simp add: \<tau>\<^sub>0_def OclValid_def del: OclAllInstances_generic_def) - apply(simp only: UML_Set.OclForall_def refl if_True OclAllInstances_generic_defined[simplified OclValid_def]) - apply(simp only: OclAllInstances_generic_def) - apply(subst (1 2 3) Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inverse, simp add: bot_option_def) -by(simp) -lemma Planet_OclAllInstances_at_post_OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t1 : -shows "(\<exists>\<tau>. \<tau> \<Turnstile> (UML_Set.OclForall ((OclAllInstances_at_post (Planet))) (OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t)))" - unfolding OclAllInstances_at_post_def -by(rule Planet_OclAllInstances_generic_OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t1, simp) -lemma Planet_OclAllInstances_at_pre_OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t1 : -shows "(\<exists>\<tau>. \<tau> \<Turnstile> (UML_Set.OclForall ((OclAllInstances_at_pre (Planet))) (OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t)))" - unfolding OclAllInstances_at_pre_def -by(rule Planet_OclAllInstances_generic_OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t1, simp) -lemma Planet_OclAllInstances_generic_OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t2 : -assumes [simp]: "(\<And>x. (pre_post ((x , x))) = x)" -shows "(\<exists>\<tau>. \<tau> \<Turnstile> (not ((UML_Set.OclForall ((OclAllInstances_generic (pre_post) (Planet))) (OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t)))))" - proof - fix oid a show ?thesis - proof - let ?t0 = "(state.make ((Map.empty (oid \<mapsto> (in\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t ((mk\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t ((mk\<E>\<X>\<T>\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (a))) (None) (None))))))) (Map.empty))" show ?thesis - apply(rule exI[where x = "(?t0 , ?t0)"], simp add: OclValid_def del: OclAllInstances_generic_def) - apply(simp only: UML_Set.OclForall_def refl if_True OclAllInstances_generic_defined[simplified OclValid_def]) - apply(simp only: OclAllInstances_generic_def OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_\<AA>_def) - apply(subst (1 2 3) Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inverse, simp add: bot_option_def) -by(simp add: state.make_def OclNot_def) qed qed -lemma Planet_OclAllInstances_at_post_OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t2 : -shows "(\<exists>\<tau>. \<tau> \<Turnstile> (not ((UML_Set.OclForall ((OclAllInstances_at_post (Planet))) (OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t)))))" - unfolding OclAllInstances_at_post_def -by(rule Planet_OclAllInstances_generic_OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t2, simp) -lemma Planet_OclAllInstances_at_pre_OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t2 : -shows "(\<exists>\<tau>. \<tau> \<Turnstile> (not ((UML_Set.OclForall ((OclAllInstances_at_pre (Planet))) (OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t)))))" - unfolding OclAllInstances_at_pre_def -by(rule Planet_OclAllInstances_generic_OclIsTypeOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t2, simp) -lemma Galaxy_OclAllInstances_generic_OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y1 : -assumes [simp]: "(\<And>x. (pre_post ((x , x))) = x)" -shows "(\<exists>\<tau>. \<tau> \<Turnstile> (UML_Set.OclForall ((OclAllInstances_generic (pre_post) (Galaxy))) (OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y)))" - apply(rule exI[where x = "\<tau>\<^sub>0"], simp add: \<tau>\<^sub>0_def OclValid_def del: OclAllInstances_generic_def) - apply(simp only: UML_Set.OclForall_def refl if_True OclAllInstances_generic_defined[simplified OclValid_def]) - apply(simp only: OclAllInstances_generic_def) - apply(subst (1 2 3) Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inverse, simp add: bot_option_def) -by(simp) -lemma Galaxy_OclAllInstances_at_post_OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y1 : -shows "(\<exists>\<tau>. \<tau> \<Turnstile> (UML_Set.OclForall ((OclAllInstances_at_post (Galaxy))) (OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y)))" - unfolding OclAllInstances_at_post_def -by(rule Galaxy_OclAllInstances_generic_OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y1, simp) -lemma Galaxy_OclAllInstances_at_pre_OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y1 : -shows "(\<exists>\<tau>. \<tau> \<Turnstile> (UML_Set.OclForall ((OclAllInstances_at_pre (Galaxy))) (OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y)))" - unfolding OclAllInstances_at_pre_def -by(rule Galaxy_OclAllInstances_generic_OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y1, simp) -lemma Galaxy_OclAllInstances_generic_OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y2 : -assumes [simp]: "(\<And>x. (pre_post ((x , x))) = x)" -shows "(\<exists>\<tau>. \<tau> \<Turnstile> (not ((UML_Set.OclForall ((OclAllInstances_generic (pre_post) (Galaxy))) (OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y)))))" - proof - fix oid a show ?thesis - proof - let ?t0 = "(state.make ((Map.empty (oid \<mapsto> (in\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y ((mk\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y ((mk\<E>\<X>\<T>\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (a))) (None) (None) (None))))))) (Map.empty))" show ?thesis - apply(rule exI[where x = "(?t0 , ?t0)"], simp add: OclValid_def del: OclAllInstances_generic_def) - apply(simp only: UML_Set.OclForall_def refl if_True OclAllInstances_generic_defined[simplified OclValid_def]) - apply(simp only: OclAllInstances_generic_def OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_\<AA>_def) - apply(subst (1 2 3) Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inverse, simp add: bot_option_def) -by(simp add: state.make_def OclNot_def) qed qed -lemma Galaxy_OclAllInstances_at_post_OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y2 : -shows "(\<exists>\<tau>. \<tau> \<Turnstile> (not ((UML_Set.OclForall ((OclAllInstances_at_post (Galaxy))) (OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y)))))" - unfolding OclAllInstances_at_post_def -by(rule Galaxy_OclAllInstances_generic_OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y2, simp) -lemma Galaxy_OclAllInstances_at_pre_OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y2 : -shows "(\<exists>\<tau>. \<tau> \<Turnstile> (not ((UML_Set.OclForall ((OclAllInstances_at_pre (Galaxy))) (OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y)))))" - unfolding OclAllInstances_at_pre_def -by(rule Galaxy_OclAllInstances_generic_OclIsTypeOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y2, simp) -lemma OclAny_OclAllInstances_generic_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y1 : -assumes [simp]: "(\<And>x. (pre_post ((x , x))) = x)" -shows "(\<exists>\<tau>. \<tau> \<Turnstile> (UML_Set.OclForall ((OclAllInstances_generic (pre_post) (OclAny))) (OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y)))" - apply(rule exI[where x = "\<tau>\<^sub>0"], simp add: \<tau>\<^sub>0_def OclValid_def del: OclAllInstances_generic_def) - apply(simp only: UML_Set.OclForall_def refl if_True OclAllInstances_generic_defined[simplified OclValid_def]) - apply(simp only: OclAllInstances_generic_def) - apply(subst (1 2 3) Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inverse, simp add: bot_option_def) -by(simp) -lemma OclAny_OclAllInstances_at_post_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y1 : -shows "(\<exists>\<tau>. \<tau> \<Turnstile> (UML_Set.OclForall ((OclAllInstances_at_post (OclAny))) (OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y)))" - unfolding OclAllInstances_at_post_def -by(rule OclAny_OclAllInstances_generic_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y1, simp) -lemma OclAny_OclAllInstances_at_pre_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y1 : -shows "(\<exists>\<tau>. \<tau> \<Turnstile> (UML_Set.OclForall ((OclAllInstances_at_pre (OclAny))) (OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y)))" - unfolding OclAllInstances_at_pre_def -by(rule OclAny_OclAllInstances_generic_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y1, simp) -lemma OclAny_OclAllInstances_generic_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y2 : -assumes [simp]: "(\<And>x. (pre_post ((x , x))) = x)" -shows "(\<exists>\<tau>. \<tau> \<Turnstile> (not ((UML_Set.OclForall ((OclAllInstances_generic (pre_post) (OclAny))) (OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y)))))" - proof - fix oid a show ?thesis - proof - let ?t0 = "(state.make ((Map.empty (oid \<mapsto> (in\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y ((mk\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y ((mk\<E>\<X>\<T>\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y (a))))))))) (Map.empty))" show ?thesis - apply(rule exI[where x = "(?t0 , ?t0)"], simp add: OclValid_def del: OclAllInstances_generic_def) - apply(simp only: UML_Set.OclForall_def refl if_True OclAllInstances_generic_defined[simplified OclValid_def]) - apply(simp only: OclAllInstances_generic_def OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_\<AA>_def) - apply(subst (1 2 3) Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inverse, simp add: bot_option_def) -by(simp add: state.make_def OclNot_def) qed qed -lemma OclAny_OclAllInstances_at_post_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y2 : -shows "(\<exists>\<tau>. \<tau> \<Turnstile> (not ((UML_Set.OclForall ((OclAllInstances_at_post (OclAny))) (OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y)))))" - unfolding OclAllInstances_at_post_def -by(rule OclAny_OclAllInstances_generic_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y2, simp) -lemma OclAny_OclAllInstances_at_pre_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y2 : -shows "(\<exists>\<tau>. \<tau> \<Turnstile> (not ((UML_Set.OclForall ((OclAllInstances_at_pre (OclAny))) (OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y)))))" - unfolding OclAllInstances_at_pre_def -by(rule OclAny_OclAllInstances_generic_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y2, simp) - -(* 106 ************************************ 662 + 1 *) -subsection \<open>OclIsKindOf\<close> - -(* 107 ************************************ 663 + 12 *) (* term Floor1_allinst.print_allinst_iskindof_eq *) -lemma Person_OclAllInstances_generic_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n : "\<tau> \<Turnstile> (UML_Set.OclForall ((OclAllInstances_generic (pre_post) (Person))) (OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))" - apply(simp add: OclValid_def del: OclAllInstances_generic_def OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person) - apply(simp only: UML_Set.OclForall_def refl if_True OclAllInstances_generic_defined[simplified OclValid_def]) - apply(simp only: OclAllInstances_generic_def) - apply(subst (1 2 3) Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inverse, simp add: bot_option_def) - apply(subst (1 2 3) ex_ssubst[where s = "(\<lambda>x. (((\<lambda>_. x) .oclIsKindOf(Person)) (\<tau>)))" and t = "(\<lambda>_. (true (\<tau>)))"]) - apply(intro ballI actual_eq_static\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n[simplified OclValid_def]) - apply(drule ex_def, erule exE, simp) -by(simp) -lemma Person_OclAllInstances_at_post_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n : -shows "\<tau> \<Turnstile> (UML_Set.OclForall ((OclAllInstances_at_post (Person))) (OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))" - unfolding OclAllInstances_at_post_def -by(rule Person_OclAllInstances_generic_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n) -lemma Person_OclAllInstances_at_pre_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n : -shows "\<tau> \<Turnstile> (UML_Set.OclForall ((OclAllInstances_at_pre (Person))) (OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))" - unfolding OclAllInstances_at_pre_def -by(rule Person_OclAllInstances_generic_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n) -lemma Planet_OclAllInstances_generic_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t : "\<tau> \<Turnstile> (UML_Set.OclForall ((OclAllInstances_generic (pre_post) (Planet))) (OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t))" - apply(simp add: OclValid_def del: OclAllInstances_generic_def OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Planet) - apply(simp only: UML_Set.OclForall_def refl if_True OclAllInstances_generic_defined[simplified OclValid_def]) - apply(simp only: OclAllInstances_generic_def) - apply(subst (1 2 3) Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inverse, simp add: bot_option_def) - apply(subst (1 2 3) ex_ssubst[where s = "(\<lambda>x. (((\<lambda>_. x) .oclIsKindOf(Planet)) (\<tau>)))" and t = "(\<lambda>_. (true (\<tau>)))"]) - apply(intro ballI actual_eq_static\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t[simplified OclValid_def]) - apply(drule ex_def, erule exE, simp) -by(simp) -lemma Planet_OclAllInstances_at_post_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t : -shows "\<tau> \<Turnstile> (UML_Set.OclForall ((OclAllInstances_at_post (Planet))) (OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t))" - unfolding OclAllInstances_at_post_def -by(rule Planet_OclAllInstances_generic_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t) -lemma Planet_OclAllInstances_at_pre_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t : -shows "\<tau> \<Turnstile> (UML_Set.OclForall ((OclAllInstances_at_pre (Planet))) (OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t))" - unfolding OclAllInstances_at_pre_def -by(rule Planet_OclAllInstances_generic_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t) -lemma Galaxy_OclAllInstances_generic_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y : "\<tau> \<Turnstile> (UML_Set.OclForall ((OclAllInstances_generic (pre_post) (Galaxy))) (OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y))" - apply(simp add: OclValid_def del: OclAllInstances_generic_def OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Galaxy) - apply(simp only: UML_Set.OclForall_def refl if_True OclAllInstances_generic_defined[simplified OclValid_def]) - apply(simp only: OclAllInstances_generic_def) - apply(subst (1 2 3) Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inverse, simp add: bot_option_def) - apply(subst (1 2 3) ex_ssubst[where s = "(\<lambda>x. (((\<lambda>_. x) .oclIsKindOf(Galaxy)) (\<tau>)))" and t = "(\<lambda>_. (true (\<tau>)))"]) - apply(intro ballI actual_eq_static\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y[simplified OclValid_def]) - apply(drule ex_def, erule exE, simp) -by(simp) -lemma Galaxy_OclAllInstances_at_post_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y : -shows "\<tau> \<Turnstile> (UML_Set.OclForall ((OclAllInstances_at_post (Galaxy))) (OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y))" - unfolding OclAllInstances_at_post_def -by(rule Galaxy_OclAllInstances_generic_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y) -lemma Galaxy_OclAllInstances_at_pre_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y : -shows "\<tau> \<Turnstile> (UML_Set.OclForall ((OclAllInstances_at_pre (Galaxy))) (OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y))" - unfolding OclAllInstances_at_pre_def -by(rule Galaxy_OclAllInstances_generic_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y) -lemma OclAny_OclAllInstances_generic_OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y : "\<tau> \<Turnstile> (UML_Set.OclForall ((OclAllInstances_generic (pre_post) (OclAny))) (OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y))" - apply(simp add: OclValid_def del: OclAllInstances_generic_def OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny) - apply(simp only: UML_Set.OclForall_def refl if_True OclAllInstances_generic_defined[simplified OclValid_def]) - apply(simp only: OclAllInstances_generic_def) - apply(subst (1 2 3) Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inverse, simp add: bot_option_def) - apply(subst (1 2 3) ex_ssubst[where s = "(\<lambda>x. (((\<lambda>_. x) .oclIsKindOf(OclAny)) (\<tau>)))" and t = "(\<lambda>_. (true (\<tau>)))"]) - apply(intro ballI actual_eq_static\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y[simplified OclValid_def]) - apply(drule ex_def, erule exE, simp) -by(simp) -lemma OclAny_OclAllInstances_at_post_OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y : -shows "\<tau> \<Turnstile> (UML_Set.OclForall ((OclAllInstances_at_post (OclAny))) (OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y))" - unfolding OclAllInstances_at_post_def -by(rule OclAny_OclAllInstances_generic_OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y) -lemma OclAny_OclAllInstances_at_pre_OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y : -shows "\<tau> \<Turnstile> (UML_Set.OclForall ((OclAllInstances_at_pre (OclAny))) (OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y))" - unfolding OclAllInstances_at_pre_def -by(rule OclAny_OclAllInstances_generic_OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y) - -(* 108 ************************************ 675 + 18 *) (* term Floor1_allinst.print_allinst_iskindof_larger *) -lemma Person_OclAllInstances_generic_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t : "\<tau> \<Turnstile> (UML_Set.OclForall ((OclAllInstances_generic (pre_post) (Person))) (OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t))" - apply(simp add: OclValid_def del: OclAllInstances_generic_def OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person) - apply(simp only: UML_Set.OclForall_def refl if_True OclAllInstances_generic_defined[simplified OclValid_def]) - apply(simp only: OclAllInstances_generic_def) - apply(subst (1 2 3) Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inverse, simp add: bot_option_def) - apply(subst (1 2 3) ex_ssubst[where s = "(\<lambda>x. (((\<lambda>_. x) .oclIsKindOf(Planet)) (\<tau>)))" and t = "(\<lambda>_. (true (\<tau>)))"]) - apply(intro ballI actualKind\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_larger_staticKind\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t[simplified OclValid_def]) - apply(drule ex_def, erule exE, simp) -by(simp) -lemma Person_OclAllInstances_at_post_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t : -shows "\<tau> \<Turnstile> (UML_Set.OclForall ((OclAllInstances_at_post (Person))) (OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t))" - unfolding OclAllInstances_at_post_def -by(rule Person_OclAllInstances_generic_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t) -lemma Person_OclAllInstances_at_pre_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t : -shows "\<tau> \<Turnstile> (UML_Set.OclForall ((OclAllInstances_at_pre (Person))) (OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t))" - unfolding OclAllInstances_at_pre_def -by(rule Person_OclAllInstances_generic_OclIsKindOf\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t) -lemma Person_OclAllInstances_generic_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y : "\<tau> \<Turnstile> (UML_Set.OclForall ((OclAllInstances_generic (pre_post) (Person))) (OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y))" - apply(simp add: OclValid_def del: OclAllInstances_generic_def OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person) - apply(simp only: UML_Set.OclForall_def refl if_True OclAllInstances_generic_defined[simplified OclValid_def]) - apply(simp only: OclAllInstances_generic_def) - apply(subst (1 2 3) Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inverse, simp add: bot_option_def) - apply(subst (1 2 3) ex_ssubst[where s = "(\<lambda>x. (((\<lambda>_. x) .oclIsKindOf(Galaxy)) (\<tau>)))" and t = "(\<lambda>_. (true (\<tau>)))"]) - apply(intro ballI actualKind\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_larger_staticKind\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y[simplified OclValid_def]) - apply(drule ex_def, erule exE, simp) -by(simp) -lemma Person_OclAllInstances_at_post_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y : -shows "\<tau> \<Turnstile> (UML_Set.OclForall ((OclAllInstances_at_post (Person))) (OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y))" - unfolding OclAllInstances_at_post_def -by(rule Person_OclAllInstances_generic_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y) -lemma Person_OclAllInstances_at_pre_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y : -shows "\<tau> \<Turnstile> (UML_Set.OclForall ((OclAllInstances_at_pre (Person))) (OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y))" - unfolding OclAllInstances_at_pre_def -by(rule Person_OclAllInstances_generic_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y) -lemma Person_OclAllInstances_generic_OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y : "\<tau> \<Turnstile> (UML_Set.OclForall ((OclAllInstances_generic (pre_post) (Person))) (OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y))" - apply(simp add: OclValid_def del: OclAllInstances_generic_def OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person) - apply(simp only: UML_Set.OclForall_def refl if_True OclAllInstances_generic_defined[simplified OclValid_def]) - apply(simp only: OclAllInstances_generic_def) - apply(subst (1 2 3) Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inverse, simp add: bot_option_def) - apply(subst (1 2 3) ex_ssubst[where s = "(\<lambda>x. (((\<lambda>_. x) .oclIsKindOf(OclAny)) (\<tau>)))" and t = "(\<lambda>_. (true (\<tau>)))"]) - apply(intro ballI actualKind\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_larger_staticKind\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y[simplified OclValid_def]) - apply(drule ex_def, erule exE, simp) -by(simp) -lemma Person_OclAllInstances_at_post_OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y : -shows "\<tau> \<Turnstile> (UML_Set.OclForall ((OclAllInstances_at_post (Person))) (OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y))" - unfolding OclAllInstances_at_post_def -by(rule Person_OclAllInstances_generic_OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y) -lemma Person_OclAllInstances_at_pre_OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y : -shows "\<tau> \<Turnstile> (UML_Set.OclForall ((OclAllInstances_at_pre (Person))) (OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y))" - unfolding OclAllInstances_at_pre_def -by(rule Person_OclAllInstances_generic_OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y) -lemma Planet_OclAllInstances_generic_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y : "\<tau> \<Turnstile> (UML_Set.OclForall ((OclAllInstances_generic (pre_post) (Planet))) (OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y))" - apply(simp add: OclValid_def del: OclAllInstances_generic_def OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet) - apply(simp only: UML_Set.OclForall_def refl if_True OclAllInstances_generic_defined[simplified OclValid_def]) - apply(simp only: OclAllInstances_generic_def) - apply(subst (1 2 3) Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inverse, simp add: bot_option_def) - apply(subst (1 2 3) ex_ssubst[where s = "(\<lambda>x. (((\<lambda>_. x) .oclIsKindOf(Galaxy)) (\<tau>)))" and t = "(\<lambda>_. (true (\<tau>)))"]) - apply(intro ballI actualKind\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_larger_staticKind\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y[simplified OclValid_def]) - apply(drule ex_def, erule exE, simp) -by(simp) -lemma Planet_OclAllInstances_at_post_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y : -shows "\<tau> \<Turnstile> (UML_Set.OclForall ((OclAllInstances_at_post (Planet))) (OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y))" - unfolding OclAllInstances_at_post_def -by(rule Planet_OclAllInstances_generic_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y) -lemma Planet_OclAllInstances_at_pre_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y : -shows "\<tau> \<Turnstile> (UML_Set.OclForall ((OclAllInstances_at_pre (Planet))) (OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y))" - unfolding OclAllInstances_at_pre_def -by(rule Planet_OclAllInstances_generic_OclIsKindOf\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y) -lemma Planet_OclAllInstances_generic_OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y : "\<tau> \<Turnstile> (UML_Set.OclForall ((OclAllInstances_generic (pre_post) (Planet))) (OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y))" - apply(simp add: OclValid_def del: OclAllInstances_generic_def OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet) - apply(simp only: UML_Set.OclForall_def refl if_True OclAllInstances_generic_defined[simplified OclValid_def]) - apply(simp only: OclAllInstances_generic_def) - apply(subst (1 2 3) Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inverse, simp add: bot_option_def) - apply(subst (1 2 3) ex_ssubst[where s = "(\<lambda>x. (((\<lambda>_. x) .oclIsKindOf(OclAny)) (\<tau>)))" and t = "(\<lambda>_. (true (\<tau>)))"]) - apply(intro ballI actualKind\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_larger_staticKind\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y[simplified OclValid_def]) - apply(drule ex_def, erule exE, simp) -by(simp) -lemma Planet_OclAllInstances_at_post_OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y : -shows "\<tau> \<Turnstile> (UML_Set.OclForall ((OclAllInstances_at_post (Planet))) (OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y))" - unfolding OclAllInstances_at_post_def -by(rule Planet_OclAllInstances_generic_OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y) -lemma Planet_OclAllInstances_at_pre_OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y : -shows "\<tau> \<Turnstile> (UML_Set.OclForall ((OclAllInstances_at_pre (Planet))) (OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y))" - unfolding OclAllInstances_at_pre_def -by(rule Planet_OclAllInstances_generic_OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y) -lemma Galaxy_OclAllInstances_generic_OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y : "\<tau> \<Turnstile> (UML_Set.OclForall ((OclAllInstances_generic (pre_post) (Galaxy))) (OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y))" - apply(simp add: OclValid_def del: OclAllInstances_generic_def OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy) - apply(simp only: UML_Set.OclForall_def refl if_True OclAllInstances_generic_defined[simplified OclValid_def]) - apply(simp only: OclAllInstances_generic_def) - apply(subst (1 2 3) Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inverse, simp add: bot_option_def) - apply(subst (1 2 3) ex_ssubst[where s = "(\<lambda>x. (((\<lambda>_. x) .oclIsKindOf(OclAny)) (\<tau>)))" and t = "(\<lambda>_. (true (\<tau>)))"]) - apply(intro ballI actualKind\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_larger_staticKind\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y[simplified OclValid_def]) - apply(drule ex_def, erule exE, simp) -by(simp) -lemma Galaxy_OclAllInstances_at_post_OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y : -shows "\<tau> \<Turnstile> (UML_Set.OclForall ((OclAllInstances_at_post (Galaxy))) (OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y))" - unfolding OclAllInstances_at_post_def -by(rule Galaxy_OclAllInstances_generic_OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y) -lemma Galaxy_OclAllInstances_at_pre_OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y : -shows "\<tau> \<Turnstile> (UML_Set.OclForall ((OclAllInstances_at_pre (Galaxy))) (OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y))" - unfolding OclAllInstances_at_pre_def -by(rule Galaxy_OclAllInstances_generic_OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y) - -(* 109 ************************************ 693 + 1 *) -section \<open>Class Model: The Accessors\<close> - -(* 110 ************************************ 694 + 1 *) -text \<open> - \label{sec:Employee-DesignModel-UMLPart-generated-generatededm-accessors}\<close> - -(* 111 ************************************ 695 + 1 *) -text \<open>\<close> - -(* 112 ************************************ 696 + 1 *) -subsection \<open>Definition\<close> - -(* 113 ************************************ 697 + 1 *) -text \<open>\<close> - -(* 114 ************************************ 698 + 1 *) (* term Floor1_access.print_access_oid_uniq_ml *) -ML \<open>val oidPerson_0_boss = 0\<close> - -(* 115 ************************************ 699 + 1 *) (* term Floor1_access.print_access_oid_uniq *) -definition "oid\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_0___boss = 0" - -(* 116 ************************************ 700 + 1 *) -text \<open>\<close> - -(* 117 ************************************ 701 + 5 *) (* term Floor1_access.print_access_eval_extract *) -definition "eval_extract x f = (\<lambda>\<tau>. (case x \<tau> of \<lfloor>\<lfloor>obj\<rfloor>\<rfloor> \<Rightarrow> (f ((oid_of (obj))) (\<tau>)) - | _ \<Rightarrow> invalid \<tau>))" -definition "in_pre_state = fst" -definition "in_post_state = snd" -definition "reconst_basetype = (\<lambda>x _. \<lfloor>\<lfloor>x\<rfloor>\<rfloor>)" -definition "reconst_basetype\<^sub>V\<^sub>o\<^sub>i\<^sub>d x = Abs_Void\<^sub>b\<^sub>a\<^sub>s\<^sub>e o (reconst_basetype (x))" - -(* 118 ************************************ 706 + 1 *) -text \<open>\<close> - -(* 119 ************************************ 707 + 2 *) (* term Floor1_access.print_access_choose_ml *) -ML \<open>val switch2_01 = (fn [x0 , x1] => (x0 , x1))\<close> -ML \<open>val switch2_10 = (fn [x0 , x1] => (x1 , x0))\<close> - -(* 120 ************************************ 709 + 3 *) (* term Floor1_access.print_access_choose *) -definition "switch\<^sub>2_01 = (\<lambda> [x0 , x1] \<Rightarrow> (x0 , x1))" -definition "switch\<^sub>2_10 = (\<lambda> [x0 , x1] \<Rightarrow> (x1 , x0))" -definition "deref_assocs pre_post to_from assoc_oid f oid = (\<lambda>\<tau>. (case (assocs ((pre_post (\<tau>))) (assoc_oid)) of \<lfloor>S\<rfloor> \<Rightarrow> (f ((deref_assocs_list (to_from) (oid) (S))) (\<tau>)) - | _ \<Rightarrow> (invalid (\<tau>))))" - -(* 121 ************************************ 712 + 4 *) (* term Floor1_access.print_access_deref_oid *) -definition "deref_oid\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n fst_snd f oid = (\<lambda>\<tau>. (case (heap (fst_snd \<tau>) (oid)) of \<lfloor>in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n obj\<rfloor> \<Rightarrow> f obj \<tau> - | _ \<Rightarrow> invalid \<tau>))" -definition "deref_oid\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t fst_snd f oid = (\<lambda>\<tau>. (case (heap (fst_snd \<tau>) (oid)) of \<lfloor>in\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t obj\<rfloor> \<Rightarrow> f obj \<tau> - | _ \<Rightarrow> invalid \<tau>))" -definition "deref_oid\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y fst_snd f oid = (\<lambda>\<tau>. (case (heap (fst_snd \<tau>) (oid)) of \<lfloor>in\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y obj\<rfloor> \<Rightarrow> f obj \<tau> - | _ \<Rightarrow> invalid \<tau>))" -definition "deref_oid\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y fst_snd f oid = (\<lambda>\<tau>. (case (heap (fst_snd \<tau>) (oid)) of \<lfloor>in\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y obj\<rfloor> \<Rightarrow> f obj \<tau> - | _ \<Rightarrow> invalid \<tau>))" - -(* 122 ************************************ 716 + 0 *) (* term Floor1_access.print_access_deref_assocs *) - -(* 123 ************************************ 716 + 1 *) -text \<open> - pointer undefined in state or not referencing a type conform object representation \<close> - -(* 124 ************************************ 717 + 15 *) (* term Floor1_access.print_access_select *) -definition "select\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__boss f = (\<lambda> (mk\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (_) (\<bottom>) (_)) \<Rightarrow> null - | (mk\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (_) (\<lfloor>x___boss\<rfloor>) (_)) \<Rightarrow> (f (x___boss)))" -definition "select\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__salary f = (\<lambda> (mk\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (_) (_) (\<bottom>)) \<Rightarrow> null - | (mk\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (_) (_) (\<lfloor>x___salary\<rfloor>)) \<Rightarrow> (f (x___salary)))" -definition "select\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__wormhole f = (\<lambda> (mk\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (_) (\<bottom>) (_)) \<Rightarrow> null - | (mk\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (_) (\<lfloor>x___wormhole\<rfloor>) (_)) \<Rightarrow> (f (x___wormhole)))" -definition "select\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__weight f = (\<lambda> (mk\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (_) (_) (\<bottom>)) \<Rightarrow> null - | (mk\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (_) (_) (\<lfloor>x___weight\<rfloor>)) \<Rightarrow> (f (x___weight)))" -definition "select\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y__sound f = (\<lambda> (mk\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y (_) (\<bottom>) (_) (_)) \<Rightarrow> null - | (mk\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y (_) (\<lfloor>x___sound\<rfloor>) (_) (_)) \<Rightarrow> (f (x___sound)))" -definition "select\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y__moving f = (\<lambda> (mk\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y (_) (_) (\<bottom>) (_)) \<Rightarrow> null - | (mk\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y (_) (_) (\<lfloor>x___moving\<rfloor>) (_)) \<Rightarrow> (f (x___moving)))" -definition "select\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y__outer_world f = (\<lambda> (mk\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y (_) (_) (_) (\<bottom>)) \<Rightarrow> null - | (mk\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y (_) (_) (_) (\<lfloor>x___outer_world\<rfloor>)) \<Rightarrow> (f (x___outer_world)))" -definition "select\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__wormhole f = (\<lambda> (mk\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n ((mk\<E>\<X>\<T>\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (_) (\<bottom>) (_) (_) (_) (_))) (_) (_)) \<Rightarrow> null - | (mk\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n ((mk\<E>\<X>\<T>\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (_) (\<lfloor>x___wormhole\<rfloor>) (_) (_) (_) (_))) (_) (_)) \<Rightarrow> (f (x___wormhole)))" -definition "select\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__weight f = (\<lambda> (mk\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n ((mk\<E>\<X>\<T>\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (_) (_) (\<bottom>) (_) (_) (_))) (_) (_)) \<Rightarrow> null - | (mk\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n ((mk\<E>\<X>\<T>\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (_) (_) (\<lfloor>x___weight\<rfloor>) (_) (_) (_))) (_) (_)) \<Rightarrow> (f (x___weight)))" -definition "select\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__sound f = (\<lambda> (mk\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n ((mk\<E>\<X>\<T>\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (_) (_) (_) (\<bottom>) (_) (_))) (_) (_)) \<Rightarrow> null - | (mk\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n ((mk\<E>\<X>\<T>\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (_) (_) (_) (\<lfloor>x___sound\<rfloor>) (_) (_))) (_) (_)) \<Rightarrow> (f (x___sound)))" -definition "select\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__moving f = (\<lambda> (mk\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n ((mk\<E>\<X>\<T>\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (_) (_) (_) (_) (\<bottom>) (_))) (_) (_)) \<Rightarrow> null - | (mk\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n ((mk\<E>\<X>\<T>\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (_) (_) (_) (_) (\<lfloor>x___moving\<rfloor>) (_))) (_) (_)) \<Rightarrow> (f (x___moving)))" -definition "select\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__outer_world f = (\<lambda> (mk\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n ((mk\<E>\<X>\<T>\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (_) (_) (_) (_) (_) (\<bottom>))) (_) (_)) \<Rightarrow> null - | (mk\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n ((mk\<E>\<X>\<T>\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (_) (_) (_) (_) (_) (\<lfloor>x___outer_world\<rfloor>))) (_) (_)) \<Rightarrow> (f (x___outer_world)))" -definition "select\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__sound f = (\<lambda> (mk\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t ((mk\<E>\<X>\<T>\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (_) (\<bottom>) (_) (_))) (_) (_)) \<Rightarrow> null - | (mk\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t ((mk\<E>\<X>\<T>\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (_) (\<lfloor>x___sound\<rfloor>) (_) (_))) (_) (_)) \<Rightarrow> (f (x___sound)) - | (mk\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t ((mk\<E>\<X>\<T>\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (person))) (_) (_)) \<Rightarrow> (select\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__sound (f) (person)))" -definition "select\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__moving f = (\<lambda> (mk\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t ((mk\<E>\<X>\<T>\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (_) (_) (\<bottom>) (_))) (_) (_)) \<Rightarrow> null - | (mk\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t ((mk\<E>\<X>\<T>\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (_) (_) (\<lfloor>x___moving\<rfloor>) (_))) (_) (_)) \<Rightarrow> (f (x___moving)) - | (mk\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t ((mk\<E>\<X>\<T>\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (person))) (_) (_)) \<Rightarrow> (select\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__moving (f) (person)))" -definition "select\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__outer_world f = (\<lambda> (mk\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t ((mk\<E>\<X>\<T>\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (_) (_) (_) (\<bottom>))) (_) (_)) \<Rightarrow> null - | (mk\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t ((mk\<E>\<X>\<T>\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (_) (_) (_) (\<lfloor>x___outer_world\<rfloor>))) (_) (_)) \<Rightarrow> (f (x___outer_world)) - | (mk\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t ((mk\<E>\<X>\<T>\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (person))) (_) (_)) \<Rightarrow> (select\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__outer_world (f) (person)))" - -(* 125 ************************************ 732 + 0 *) (* term Floor1_access.print_access_select_obj *) - -(* 126 ************************************ 732 + 14 *) (* term Floor1_access.print_access_dot_consts *) -consts dot_0___boss :: "(\<AA>, '\<alpha>) val \<Rightarrow> \<cdot>Person" ("(_) .boss") -consts dot_0___bossat_pre :: "(\<AA>, '\<alpha>) val \<Rightarrow> \<cdot>Person" ("(_) .boss@pre") -consts dot__salary :: "(\<AA>, '\<alpha>) val \<Rightarrow> Integer" ("(_) .salary") -consts dot__salaryat_pre :: "(\<AA>, '\<alpha>) val \<Rightarrow> Integer" ("(_) .salary@pre") -consts dot__wormhole :: "(\<AA>, '\<alpha>) val \<Rightarrow> (\<AA>, nat option option) val" ("(_) .wormhole") -consts dot__wormholeat_pre :: "(\<AA>, '\<alpha>) val \<Rightarrow> (\<AA>, nat option option) val" ("(_) .wormhole@pre") -consts dot__weight :: "(\<AA>, '\<alpha>) val \<Rightarrow> Integer" ("(_) .weight") -consts dot__weightat_pre :: "(\<AA>, '\<alpha>) val \<Rightarrow> Integer" ("(_) .weight@pre") -consts dot__sound :: "(\<AA>, '\<alpha>) val \<Rightarrow> Void" ("(_) .sound") -consts dot__soundat_pre :: "(\<AA>, '\<alpha>) val \<Rightarrow> Void" ("(_) .sound@pre") -consts dot__moving :: "(\<AA>, '\<alpha>) val \<Rightarrow> Boolean" ("(_) .moving") -consts dot__movingat_pre :: "(\<AA>, '\<alpha>) val \<Rightarrow> Boolean" ("(_) .moving@pre") -consts dot__outer_world :: "(\<AA>, '\<alpha>) val \<Rightarrow> Set_Sequence_Planet" ("(_) .outer'_world") -consts dot__outer_worldat_pre :: "(\<AA>, '\<alpha>) val \<Rightarrow> Set_Sequence_Planet" ("(_) .outer'_world@pre") - -(* 127 ************************************ 746 + 30 *) (* term Floor1_access.print_access_dot *) -overloading dot_0___boss \<equiv> "(dot_0___boss::(\<cdot>Person) \<Rightarrow> _)" -begin - definition dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_0___boss : "(x::\<cdot>Person) .boss \<equiv> (eval_extract (x) ((deref_oid\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (in_post_state) ((select\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__boss ((select_object_any\<^sub>S\<^sub>e\<^sub>t ((deref_oid\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (in_post_state) (reconst_basetype))))))))))" -end -overloading dot__salary \<equiv> "(dot__salary::(\<cdot>Person) \<Rightarrow> _)" -begin - definition dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__salary : "(x::\<cdot>Person) .salary \<equiv> (eval_extract (x) ((deref_oid\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (in_post_state) ((select\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__salary (reconst_basetype))))))" -end -overloading dot_0___bossat_pre \<equiv> "(dot_0___bossat_pre::(\<cdot>Person) \<Rightarrow> _)" -begin - definition dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_0___bossat_pre : "(x::\<cdot>Person) .boss@pre \<equiv> (eval_extract (x) ((deref_oid\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (in_pre_state) ((select\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__boss ((select_object_any\<^sub>S\<^sub>e\<^sub>t ((deref_oid\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (in_pre_state) (reconst_basetype))))))))))" -end -overloading dot__salaryat_pre \<equiv> "(dot__salaryat_pre::(\<cdot>Person) \<Rightarrow> _)" -begin - definition dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__salaryat_pre : "(x::\<cdot>Person) .salary@pre \<equiv> (eval_extract (x) ((deref_oid\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (in_pre_state) ((select\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__salary (reconst_basetype))))))" -end -overloading dot__wormhole \<equiv> "(dot__wormhole::(\<cdot>Planet) \<Rightarrow> _)" -begin - definition dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__wormhole : "(x::\<cdot>Planet) .wormhole \<equiv> (eval_extract (x) ((deref_oid\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (in_post_state) ((select\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__wormhole (reconst_basetype))))))" -end -overloading dot__weight \<equiv> "(dot__weight::(\<cdot>Planet) \<Rightarrow> _)" -begin - definition dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__weight : "(x::\<cdot>Planet) .weight \<equiv> (eval_extract (x) ((deref_oid\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (in_post_state) ((select\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__weight (reconst_basetype))))))" -end -overloading dot__wormholeat_pre \<equiv> "(dot__wormholeat_pre::(\<cdot>Planet) \<Rightarrow> _)" -begin - definition dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__wormholeat_pre : "(x::\<cdot>Planet) .wormhole@pre \<equiv> (eval_extract (x) ((deref_oid\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (in_pre_state) ((select\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__wormhole (reconst_basetype))))))" -end -overloading dot__weightat_pre \<equiv> "(dot__weightat_pre::(\<cdot>Planet) \<Rightarrow> _)" -begin - definition dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__weightat_pre : "(x::\<cdot>Planet) .weight@pre \<equiv> (eval_extract (x) ((deref_oid\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (in_pre_state) ((select\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__weight (reconst_basetype))))))" -end -overloading dot__sound \<equiv> "(dot__sound::(\<cdot>Galaxy) \<Rightarrow> _)" -begin - definition dot\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y__sound : "(x::\<cdot>Galaxy) .sound \<equiv> (eval_extract (x) ((deref_oid\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y (in_post_state) ((select\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y__sound (reconst_basetype\<^sub>V\<^sub>o\<^sub>i\<^sub>d))))))" -end -overloading dot__moving \<equiv> "(dot__moving::(\<cdot>Galaxy) \<Rightarrow> _)" -begin - definition dot\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y__moving : "(x::\<cdot>Galaxy) .moving \<equiv> (eval_extract (x) ((deref_oid\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y (in_post_state) ((select\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y__moving (reconst_basetype))))))" -end -overloading dot__outer_world \<equiv> "(dot__outer_world::(\<cdot>Galaxy) \<Rightarrow> _)" -begin - definition dot\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y__outer_world : "(x::\<cdot>Galaxy) .outer_world \<equiv> (eval_extract (x) ((deref_oid\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y (in_post_state) ((select\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y__outer_world ((select_object\<^sub>S\<^sub>e\<^sub>t ((select_object\<^sub>S\<^sub>e\<^sub>q ((deref_oid\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (in_post_state) (reconst_basetype))))))))))))" -end -overloading dot__soundat_pre \<equiv> "(dot__soundat_pre::(\<cdot>Galaxy) \<Rightarrow> _)" -begin - definition dot\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y__soundat_pre : "(x::\<cdot>Galaxy) .sound@pre \<equiv> (eval_extract (x) ((deref_oid\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y (in_pre_state) ((select\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y__sound (reconst_basetype\<^sub>V\<^sub>o\<^sub>i\<^sub>d))))))" -end -overloading dot__movingat_pre \<equiv> "(dot__movingat_pre::(\<cdot>Galaxy) \<Rightarrow> _)" -begin - definition dot\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y__movingat_pre : "(x::\<cdot>Galaxy) .moving@pre \<equiv> (eval_extract (x) ((deref_oid\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y (in_pre_state) ((select\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y__moving (reconst_basetype))))))" -end -overloading dot__outer_worldat_pre \<equiv> "(dot__outer_worldat_pre::(\<cdot>Galaxy) \<Rightarrow> _)" -begin - definition dot\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y__outer_worldat_pre : "(x::\<cdot>Galaxy) .outer_world@pre \<equiv> (eval_extract (x) ((deref_oid\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y (in_pre_state) ((select\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y__outer_world ((select_object\<^sub>S\<^sub>e\<^sub>t ((select_object\<^sub>S\<^sub>e\<^sub>q ((deref_oid\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (in_pre_state) (reconst_basetype))))))))))))" -end -overloading dot__wormhole \<equiv> "(dot__wormhole::(\<cdot>Person) \<Rightarrow> _)" -begin - definition dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__wormhole : "(x::\<cdot>Person) .wormhole \<equiv> (eval_extract (x) ((deref_oid\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (in_post_state) ((select\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__wormhole (reconst_basetype))))))" -end -overloading dot__weight \<equiv> "(dot__weight::(\<cdot>Person) \<Rightarrow> _)" -begin - definition dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__weight : "(x::\<cdot>Person) .weight \<equiv> (eval_extract (x) ((deref_oid\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (in_post_state) ((select\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__weight (reconst_basetype))))))" -end -overloading dot__sound \<equiv> "(dot__sound::(\<cdot>Person) \<Rightarrow> _)" -begin - definition dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__sound : "(x::\<cdot>Person) .sound \<equiv> (eval_extract (x) ((deref_oid\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (in_post_state) ((select\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__sound (reconst_basetype\<^sub>V\<^sub>o\<^sub>i\<^sub>d))))))" -end -overloading dot__moving \<equiv> "(dot__moving::(\<cdot>Person) \<Rightarrow> _)" -begin - definition dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__moving : "(x::\<cdot>Person) .moving \<equiv> (eval_extract (x) ((deref_oid\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (in_post_state) ((select\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__moving (reconst_basetype))))))" -end -overloading dot__outer_world \<equiv> "(dot__outer_world::(\<cdot>Person) \<Rightarrow> _)" -begin - definition dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__outer_world : "(x::\<cdot>Person) .outer_world \<equiv> (eval_extract (x) ((deref_oid\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (in_post_state) ((select\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__outer_world ((select_object\<^sub>S\<^sub>e\<^sub>t ((select_object\<^sub>S\<^sub>e\<^sub>q ((deref_oid\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (in_post_state) (reconst_basetype))))))))))))" -end -overloading dot__wormholeat_pre \<equiv> "(dot__wormholeat_pre::(\<cdot>Person) \<Rightarrow> _)" -begin - definition dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__wormholeat_pre : "(x::\<cdot>Person) .wormhole@pre \<equiv> (eval_extract (x) ((deref_oid\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (in_pre_state) ((select\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__wormhole (reconst_basetype))))))" -end -overloading dot__weightat_pre \<equiv> "(dot__weightat_pre::(\<cdot>Person) \<Rightarrow> _)" -begin - definition dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__weightat_pre : "(x::\<cdot>Person) .weight@pre \<equiv> (eval_extract (x) ((deref_oid\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (in_pre_state) ((select\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__weight (reconst_basetype))))))" -end -overloading dot__soundat_pre \<equiv> "(dot__soundat_pre::(\<cdot>Person) \<Rightarrow> _)" -begin - definition dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__soundat_pre : "(x::\<cdot>Person) .sound@pre \<equiv> (eval_extract (x) ((deref_oid\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (in_pre_state) ((select\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__sound (reconst_basetype\<^sub>V\<^sub>o\<^sub>i\<^sub>d))))))" -end -overloading dot__movingat_pre \<equiv> "(dot__movingat_pre::(\<cdot>Person) \<Rightarrow> _)" -begin - definition dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__movingat_pre : "(x::\<cdot>Person) .moving@pre \<equiv> (eval_extract (x) ((deref_oid\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (in_pre_state) ((select\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__moving (reconst_basetype))))))" -end -overloading dot__outer_worldat_pre \<equiv> "(dot__outer_worldat_pre::(\<cdot>Person) \<Rightarrow> _)" -begin - definition dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__outer_worldat_pre : "(x::\<cdot>Person) .outer_world@pre \<equiv> (eval_extract (x) ((deref_oid\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (in_pre_state) ((select\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__outer_world ((select_object\<^sub>S\<^sub>e\<^sub>t ((select_object\<^sub>S\<^sub>e\<^sub>q ((deref_oid\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (in_pre_state) (reconst_basetype))))))))))))" -end -overloading dot__sound \<equiv> "(dot__sound::(\<cdot>Planet) \<Rightarrow> _)" -begin - definition dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__sound : "(x::\<cdot>Planet) .sound \<equiv> (eval_extract (x) ((deref_oid\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (in_post_state) ((select\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__sound (reconst_basetype\<^sub>V\<^sub>o\<^sub>i\<^sub>d))))))" -end -overloading dot__moving \<equiv> "(dot__moving::(\<cdot>Planet) \<Rightarrow> _)" -begin - definition dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__moving : "(x::\<cdot>Planet) .moving \<equiv> (eval_extract (x) ((deref_oid\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (in_post_state) ((select\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__moving (reconst_basetype))))))" -end -overloading dot__outer_world \<equiv> "(dot__outer_world::(\<cdot>Planet) \<Rightarrow> _)" -begin - definition dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__outer_world : "(x::\<cdot>Planet) .outer_world \<equiv> (eval_extract (x) ((deref_oid\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (in_post_state) ((select\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__outer_world ((select_object\<^sub>S\<^sub>e\<^sub>t ((select_object\<^sub>S\<^sub>e\<^sub>q ((deref_oid\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (in_post_state) (reconst_basetype))))))))))))" -end -overloading dot__soundat_pre \<equiv> "(dot__soundat_pre::(\<cdot>Planet) \<Rightarrow> _)" -begin - definition dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__soundat_pre : "(x::\<cdot>Planet) .sound@pre \<equiv> (eval_extract (x) ((deref_oid\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (in_pre_state) ((select\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__sound (reconst_basetype\<^sub>V\<^sub>o\<^sub>i\<^sub>d))))))" -end -overloading dot__movingat_pre \<equiv> "(dot__movingat_pre::(\<cdot>Planet) \<Rightarrow> _)" -begin - definition dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__movingat_pre : "(x::\<cdot>Planet) .moving@pre \<equiv> (eval_extract (x) ((deref_oid\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (in_pre_state) ((select\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__moving (reconst_basetype))))))" -end -overloading dot__outer_worldat_pre \<equiv> "(dot__outer_worldat_pre::(\<cdot>Planet) \<Rightarrow> _)" -begin - definition dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__outer_worldat_pre : "(x::\<cdot>Planet) .outer_world@pre \<equiv> (eval_extract (x) ((deref_oid\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (in_pre_state) ((select\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__outer_world ((select_object\<^sub>S\<^sub>e\<^sub>t ((select_object\<^sub>S\<^sub>e\<^sub>q ((deref_oid\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (in_pre_state) (reconst_basetype))))))))))))" -end - -(* 128 ************************************ 776 + 1 *) (* term Floor1_access.print_access_dot_lemmas_id *) -lemmas dot_accessor = dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_0___boss - dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__salary - dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_0___bossat_pre - dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__salaryat_pre - dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__wormhole - dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__weight - dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__wormholeat_pre - dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__weightat_pre - dot\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y__sound - dot\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y__moving - dot\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y__outer_world - dot\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y__soundat_pre - dot\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y__movingat_pre - dot\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y__outer_worldat_pre - dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__wormhole - dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__weight - dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__sound - dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__moving - dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__outer_world - dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__wormholeat_pre - dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__weightat_pre - dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__soundat_pre - dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__movingat_pre - dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__outer_worldat_pre - dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__sound - dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__moving - dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__outer_world - dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__soundat_pre - dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__movingat_pre - dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__outer_worldat_pre - -(* 129 ************************************ 777 + 1 *) -subsection \<open>Context Passing\<close> - -(* 130 ************************************ 778 + 1 *) (* term Floor1_access.print_access_dot_cp_lemmas *) -lemmas[simp,code_unfold] = eval_extract_def - -(* 131 ************************************ 779 + 30 *) (* term Floor1_access.print_access_dot_lemma_cp *) -lemma cp_dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_0___boss : "(cp ((\<lambda>X. (X::\<cdot>Person) .boss)))" -by(auto simp: dot_accessor cp_def) -lemma cp_dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__salary : "(cp ((\<lambda>X. (X::\<cdot>Person) .salary)))" -by(auto simp: dot_accessor cp_def) -lemma cp_dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_0___bossat_pre : "(cp ((\<lambda>X. (X::\<cdot>Person) .boss@pre)))" -by(auto simp: dot_accessor cp_def) -lemma cp_dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__salaryat_pre : "(cp ((\<lambda>X. (X::\<cdot>Person) .salary@pre)))" -by(auto simp: dot_accessor cp_def) -lemma cp_dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__wormhole : "(cp ((\<lambda>X. (X::\<cdot>Planet) .wormhole)))" -by(auto simp: dot_accessor cp_def) -lemma cp_dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__weight : "(cp ((\<lambda>X. (X::\<cdot>Planet) .weight)))" -by(auto simp: dot_accessor cp_def) -lemma cp_dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__wormholeat_pre : "(cp ((\<lambda>X. (X::\<cdot>Planet) .wormhole@pre)))" -by(auto simp: dot_accessor cp_def) -lemma cp_dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__weightat_pre : "(cp ((\<lambda>X. (X::\<cdot>Planet) .weight@pre)))" -by(auto simp: dot_accessor cp_def) -lemma cp_dot\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y__sound : "(cp ((\<lambda>X. (X::\<cdot>Galaxy) .sound)))" -by(auto simp: dot_accessor cp_def) -lemma cp_dot\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y__moving : "(cp ((\<lambda>X. (X::\<cdot>Galaxy) .moving)))" -by(auto simp: dot_accessor cp_def) -lemma cp_dot\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y__outer_world : "(cp ((\<lambda>X. (X::\<cdot>Galaxy) .outer_world)))" -by(auto simp: dot_accessor cp_def) -lemma cp_dot\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y__soundat_pre : "(cp ((\<lambda>X. (X::\<cdot>Galaxy) .sound@pre)))" -by(auto simp: dot_accessor cp_def) -lemma cp_dot\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y__movingat_pre : "(cp ((\<lambda>X. (X::\<cdot>Galaxy) .moving@pre)))" -by(auto simp: dot_accessor cp_def) -lemma cp_dot\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y__outer_worldat_pre : "(cp ((\<lambda>X. (X::\<cdot>Galaxy) .outer_world@pre)))" -by(auto simp: dot_accessor cp_def) -lemma cp_dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__wormhole : "(cp ((\<lambda>X. (X::\<cdot>Person) .wormhole)))" -by(auto simp: dot_accessor cp_def) -lemma cp_dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__weight : "(cp ((\<lambda>X. (X::\<cdot>Person) .weight)))" -by(auto simp: dot_accessor cp_def) -lemma cp_dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__sound : "(cp ((\<lambda>X. (X::\<cdot>Person) .sound)))" -by(auto simp: dot_accessor cp_def) -lemma cp_dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__moving : "(cp ((\<lambda>X. (X::\<cdot>Person) .moving)))" -by(auto simp: dot_accessor cp_def) -lemma cp_dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__outer_world : "(cp ((\<lambda>X. (X::\<cdot>Person) .outer_world)))" -by(auto simp: dot_accessor cp_def) -lemma cp_dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__wormholeat_pre : "(cp ((\<lambda>X. (X::\<cdot>Person) .wormhole@pre)))" -by(auto simp: dot_accessor cp_def) -lemma cp_dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__weightat_pre : "(cp ((\<lambda>X. (X::\<cdot>Person) .weight@pre)))" -by(auto simp: dot_accessor cp_def) -lemma cp_dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__soundat_pre : "(cp ((\<lambda>X. (X::\<cdot>Person) .sound@pre)))" -by(auto simp: dot_accessor cp_def) -lemma cp_dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__movingat_pre : "(cp ((\<lambda>X. (X::\<cdot>Person) .moving@pre)))" -by(auto simp: dot_accessor cp_def) -lemma cp_dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__outer_worldat_pre : "(cp ((\<lambda>X. (X::\<cdot>Person) .outer_world@pre)))" -by(auto simp: dot_accessor cp_def) -lemma cp_dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__sound : "(cp ((\<lambda>X. (X::\<cdot>Planet) .sound)))" -by(auto simp: dot_accessor cp_def) -lemma cp_dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__moving : "(cp ((\<lambda>X. (X::\<cdot>Planet) .moving)))" -by(auto simp: dot_accessor cp_def) -lemma cp_dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__outer_world : "(cp ((\<lambda>X. (X::\<cdot>Planet) .outer_world)))" -by(auto simp: dot_accessor cp_def) -lemma cp_dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__soundat_pre : "(cp ((\<lambda>X. (X::\<cdot>Planet) .sound@pre)))" -by(auto simp: dot_accessor cp_def) -lemma cp_dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__movingat_pre : "(cp ((\<lambda>X. (X::\<cdot>Planet) .moving@pre)))" -by(auto simp: dot_accessor cp_def) -lemma cp_dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__outer_worldat_pre : "(cp ((\<lambda>X. (X::\<cdot>Planet) .outer_world@pre)))" -by(auto simp: dot_accessor cp_def) - -(* 132 ************************************ 809 + 1 *) (* term Floor1_access.print_access_dot_lemmas_cp *) -lemmas[simp,code_unfold] = cp_dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_0___boss - cp_dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__salary - cp_dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_0___bossat_pre - cp_dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__salaryat_pre - cp_dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__wormhole - cp_dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__weight - cp_dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__wormholeat_pre - cp_dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__weightat_pre - cp_dot\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y__sound - cp_dot\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y__moving - cp_dot\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y__outer_world - cp_dot\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y__soundat_pre - cp_dot\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y__movingat_pre - cp_dot\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y__outer_worldat_pre - cp_dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__wormhole - cp_dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__weight - cp_dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__sound - cp_dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__moving - cp_dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__outer_world - cp_dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__wormholeat_pre - cp_dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__weightat_pre - cp_dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__soundat_pre - cp_dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__movingat_pre - cp_dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__outer_worldat_pre - cp_dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__sound - cp_dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__moving - cp_dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__outer_world - cp_dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__soundat_pre - cp_dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__movingat_pre - cp_dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__outer_worldat_pre - -(* 133 ************************************ 810 + 1 *) -subsection \<open>Execution with Invalid or Null as Argument\<close> - -(* 134 ************************************ 811 + 60 *) (* term Floor1_access.print_access_lemma_strict *) -lemma dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_0___boss_invalid : "(invalid::\<cdot>Person) .boss = invalid" -by(rule ext, simp add: dot_accessor bot_option_def invalid_def) -lemma dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_0___boss_null : "(null::\<cdot>Person) .boss = invalid" -by(rule ext, simp add: dot_accessor bot_option_def null_fun_def null_option_def) -lemma dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__salary_invalid : "(invalid::\<cdot>Person) .salary = invalid" -by(rule ext, simp add: dot_accessor bot_option_def invalid_def) -lemma dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__salary_null : "(null::\<cdot>Person) .salary = invalid" -by(rule ext, simp add: dot_accessor bot_option_def null_fun_def null_option_def) -lemma dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_0___bossat_pre_invalid : "(invalid::\<cdot>Person) .boss@pre = invalid" -by(rule ext, simp add: dot_accessor bot_option_def invalid_def) -lemma dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_0___bossat_pre_null : "(null::\<cdot>Person) .boss@pre = invalid" -by(rule ext, simp add: dot_accessor bot_option_def null_fun_def null_option_def) -lemma dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__salaryat_pre_invalid : "(invalid::\<cdot>Person) .salary@pre = invalid" -by(rule ext, simp add: dot_accessor bot_option_def invalid_def) -lemma dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__salaryat_pre_null : "(null::\<cdot>Person) .salary@pre = invalid" -by(rule ext, simp add: dot_accessor bot_option_def null_fun_def null_option_def) -lemma dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__wormhole_invalid : "(invalid::\<cdot>Planet) .wormhole = invalid" -by(rule ext, simp add: dot_accessor bot_option_def invalid_def) -lemma dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__wormhole_null : "(null::\<cdot>Planet) .wormhole = invalid" -by(rule ext, simp add: dot_accessor bot_option_def null_fun_def null_option_def) -lemma dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__weight_invalid : "(invalid::\<cdot>Planet) .weight = invalid" -by(rule ext, simp add: dot_accessor bot_option_def invalid_def) -lemma dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__weight_null : "(null::\<cdot>Planet) .weight = invalid" -by(rule ext, simp add: dot_accessor bot_option_def null_fun_def null_option_def) -lemma dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__wormholeat_pre_invalid : "(invalid::\<cdot>Planet) .wormhole@pre = invalid" -by(rule ext, simp add: dot_accessor bot_option_def invalid_def) -lemma dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__wormholeat_pre_null : "(null::\<cdot>Planet) .wormhole@pre = invalid" -by(rule ext, simp add: dot_accessor bot_option_def null_fun_def null_option_def) -lemma dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__weightat_pre_invalid : "(invalid::\<cdot>Planet) .weight@pre = invalid" -by(rule ext, simp add: dot_accessor bot_option_def invalid_def) -lemma dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__weightat_pre_null : "(null::\<cdot>Planet) .weight@pre = invalid" -by(rule ext, simp add: dot_accessor bot_option_def null_fun_def null_option_def) -lemma dot\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y__sound_invalid : "(invalid::\<cdot>Galaxy) .sound = invalid" -by(rule ext, simp add: dot_accessor bot_option_def invalid_def) -lemma dot\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y__sound_null : "(null::\<cdot>Galaxy) .sound = invalid" -by(rule ext, simp add: dot_accessor bot_option_def null_fun_def null_option_def) -lemma dot\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y__moving_invalid : "(invalid::\<cdot>Galaxy) .moving = invalid" -by(rule ext, simp add: dot_accessor bot_option_def invalid_def) -lemma dot\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y__moving_null : "(null::\<cdot>Galaxy) .moving = invalid" -by(rule ext, simp add: dot_accessor bot_option_def null_fun_def null_option_def) -lemma dot\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y__outer_world_invalid : "(invalid::\<cdot>Galaxy) .outer_world = invalid" -by(rule ext, simp add: dot_accessor bot_option_def invalid_def) -lemma dot\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y__outer_world_null : "(null::\<cdot>Galaxy) .outer_world = invalid" -by(rule ext, simp add: dot_accessor bot_option_def null_fun_def null_option_def) -lemma dot\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y__soundat_pre_invalid : "(invalid::\<cdot>Galaxy) .sound@pre = invalid" -by(rule ext, simp add: dot_accessor bot_option_def invalid_def) -lemma dot\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y__soundat_pre_null : "(null::\<cdot>Galaxy) .sound@pre = invalid" -by(rule ext, simp add: dot_accessor bot_option_def null_fun_def null_option_def) -lemma dot\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y__movingat_pre_invalid : "(invalid::\<cdot>Galaxy) .moving@pre = invalid" -by(rule ext, simp add: dot_accessor bot_option_def invalid_def) -lemma dot\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y__movingat_pre_null : "(null::\<cdot>Galaxy) .moving@pre = invalid" -by(rule ext, simp add: dot_accessor bot_option_def null_fun_def null_option_def) -lemma dot\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y__outer_worldat_pre_invalid : "(invalid::\<cdot>Galaxy) .outer_world@pre = invalid" -by(rule ext, simp add: dot_accessor bot_option_def invalid_def) -lemma dot\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y__outer_worldat_pre_null : "(null::\<cdot>Galaxy) .outer_world@pre = invalid" -by(rule ext, simp add: dot_accessor bot_option_def null_fun_def null_option_def) -lemma dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__wormhole_invalid : "(invalid::\<cdot>Person) .wormhole = invalid" -by(rule ext, simp add: dot_accessor bot_option_def invalid_def) -lemma dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__wormhole_null : "(null::\<cdot>Person) .wormhole = invalid" -by(rule ext, simp add: dot_accessor bot_option_def null_fun_def null_option_def) -lemma dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__weight_invalid : "(invalid::\<cdot>Person) .weight = invalid" -by(rule ext, simp add: dot_accessor bot_option_def invalid_def) -lemma dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__weight_null : "(null::\<cdot>Person) .weight = invalid" -by(rule ext, simp add: dot_accessor bot_option_def null_fun_def null_option_def) -lemma dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__sound_invalid : "(invalid::\<cdot>Person) .sound = invalid" -by(rule ext, simp add: dot_accessor bot_option_def invalid_def) -lemma dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__sound_null : "(null::\<cdot>Person) .sound = invalid" -by(rule ext, simp add: dot_accessor bot_option_def null_fun_def null_option_def) -lemma dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__moving_invalid : "(invalid::\<cdot>Person) .moving = invalid" -by(rule ext, simp add: dot_accessor bot_option_def invalid_def) -lemma dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__moving_null : "(null::\<cdot>Person) .moving = invalid" -by(rule ext, simp add: dot_accessor bot_option_def null_fun_def null_option_def) -lemma dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__outer_world_invalid : "(invalid::\<cdot>Person) .outer_world = invalid" -by(rule ext, simp add: dot_accessor bot_option_def invalid_def) -lemma dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__outer_world_null : "(null::\<cdot>Person) .outer_world = invalid" -by(rule ext, simp add: dot_accessor bot_option_def null_fun_def null_option_def) -lemma dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__wormholeat_pre_invalid : "(invalid::\<cdot>Person) .wormhole@pre = invalid" -by(rule ext, simp add: dot_accessor bot_option_def invalid_def) -lemma dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__wormholeat_pre_null : "(null::\<cdot>Person) .wormhole@pre = invalid" -by(rule ext, simp add: dot_accessor bot_option_def null_fun_def null_option_def) -lemma dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__weightat_pre_invalid : "(invalid::\<cdot>Person) .weight@pre = invalid" -by(rule ext, simp add: dot_accessor bot_option_def invalid_def) -lemma dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__weightat_pre_null : "(null::\<cdot>Person) .weight@pre = invalid" -by(rule ext, simp add: dot_accessor bot_option_def null_fun_def null_option_def) -lemma dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__soundat_pre_invalid : "(invalid::\<cdot>Person) .sound@pre = invalid" -by(rule ext, simp add: dot_accessor bot_option_def invalid_def) -lemma dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__soundat_pre_null : "(null::\<cdot>Person) .sound@pre = invalid" -by(rule ext, simp add: dot_accessor bot_option_def null_fun_def null_option_def) -lemma dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__movingat_pre_invalid : "(invalid::\<cdot>Person) .moving@pre = invalid" -by(rule ext, simp add: dot_accessor bot_option_def invalid_def) -lemma dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__movingat_pre_null : "(null::\<cdot>Person) .moving@pre = invalid" -by(rule ext, simp add: dot_accessor bot_option_def null_fun_def null_option_def) -lemma dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__outer_worldat_pre_invalid : "(invalid::\<cdot>Person) .outer_world@pre = invalid" -by(rule ext, simp add: dot_accessor bot_option_def invalid_def) -lemma dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__outer_worldat_pre_null : "(null::\<cdot>Person) .outer_world@pre = invalid" -by(rule ext, simp add: dot_accessor bot_option_def null_fun_def null_option_def) -lemma dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__sound_invalid : "(invalid::\<cdot>Planet) .sound = invalid" -by(rule ext, simp add: dot_accessor bot_option_def invalid_def) -lemma dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__sound_null : "(null::\<cdot>Planet) .sound = invalid" -by(rule ext, simp add: dot_accessor bot_option_def null_fun_def null_option_def) -lemma dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__moving_invalid : "(invalid::\<cdot>Planet) .moving = invalid" -by(rule ext, simp add: dot_accessor bot_option_def invalid_def) -lemma dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__moving_null : "(null::\<cdot>Planet) .moving = invalid" -by(rule ext, simp add: dot_accessor bot_option_def null_fun_def null_option_def) -lemma dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__outer_world_invalid : "(invalid::\<cdot>Planet) .outer_world = invalid" -by(rule ext, simp add: dot_accessor bot_option_def invalid_def) -lemma dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__outer_world_null : "(null::\<cdot>Planet) .outer_world = invalid" -by(rule ext, simp add: dot_accessor bot_option_def null_fun_def null_option_def) -lemma dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__soundat_pre_invalid : "(invalid::\<cdot>Planet) .sound@pre = invalid" -by(rule ext, simp add: dot_accessor bot_option_def invalid_def) -lemma dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__soundat_pre_null : "(null::\<cdot>Planet) .sound@pre = invalid" -by(rule ext, simp add: dot_accessor bot_option_def null_fun_def null_option_def) -lemma dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__movingat_pre_invalid : "(invalid::\<cdot>Planet) .moving@pre = invalid" -by(rule ext, simp add: dot_accessor bot_option_def invalid_def) -lemma dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__movingat_pre_null : "(null::\<cdot>Planet) .moving@pre = invalid" -by(rule ext, simp add: dot_accessor bot_option_def null_fun_def null_option_def) -lemma dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__outer_worldat_pre_invalid : "(invalid::\<cdot>Planet) .outer_world@pre = invalid" -by(rule ext, simp add: dot_accessor bot_option_def invalid_def) -lemma dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__outer_worldat_pre_null : "(null::\<cdot>Planet) .outer_world@pre = invalid" -by(rule ext, simp add: dot_accessor bot_option_def null_fun_def null_option_def) - -(* 135 ************************************ 871 + 1 *) -subsection \<open>Representation in States\<close> - -(* 136 ************************************ 872 + 30 *) (* term Floor1_access.print_access_def_mono *) -lemma defined_mono_dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_0___boss : "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Person) .boss)) \<Longrightarrow> \<tau> \<Turnstile> (\<delta> (X))" - apply(case_tac "\<tau> \<Turnstile> (X \<triangleq> invalid)", insert StrongEq_L_subst2[where P = "(\<lambda>x. (\<delta> (x .boss)))" and \<tau> = "\<tau>" and x = "X" and y = "invalid"], simp add: foundation16' dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_0___boss_invalid) - apply(case_tac "\<tau> \<Turnstile> (X \<triangleq> null)", insert StrongEq_L_subst2[where P = "(\<lambda>x. (\<delta> (x .boss)))" and \<tau> = "\<tau>" and x = "X" and y = "null"], simp add: foundation16' dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_0___boss_null) -by(simp add: defined_split) -lemma defined_mono_dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__salary : "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Person) .salary)) \<Longrightarrow> \<tau> \<Turnstile> (\<delta> (X))" - apply(case_tac "\<tau> \<Turnstile> (X \<triangleq> invalid)", insert StrongEq_L_subst2[where P = "(\<lambda>x. (\<delta> (x .salary)))" and \<tau> = "\<tau>" and x = "X" and y = "invalid"], simp add: foundation16' dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__salary_invalid) - apply(case_tac "\<tau> \<Turnstile> (X \<triangleq> null)", insert StrongEq_L_subst2[where P = "(\<lambda>x. (\<delta> (x .salary)))" and \<tau> = "\<tau>" and x = "X" and y = "null"], simp add: foundation16' dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__salary_null) -by(simp add: defined_split) -lemma defined_mono_dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_0___bossat_pre : "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Person) .boss@pre)) \<Longrightarrow> \<tau> \<Turnstile> (\<delta> (X))" - apply(case_tac "\<tau> \<Turnstile> (X \<triangleq> invalid)", insert StrongEq_L_subst2[where P = "(\<lambda>x. (\<delta> (x .boss@pre)))" and \<tau> = "\<tau>" and x = "X" and y = "invalid"], simp add: foundation16' dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_0___bossat_pre_invalid) - apply(case_tac "\<tau> \<Turnstile> (X \<triangleq> null)", insert StrongEq_L_subst2[where P = "(\<lambda>x. (\<delta> (x .boss@pre)))" and \<tau> = "\<tau>" and x = "X" and y = "null"], simp add: foundation16' dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_0___bossat_pre_null) -by(simp add: defined_split) -lemma defined_mono_dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__salaryat_pre : "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Person) .salary@pre)) \<Longrightarrow> \<tau> \<Turnstile> (\<delta> (X))" - apply(case_tac "\<tau> \<Turnstile> (X \<triangleq> invalid)", insert StrongEq_L_subst2[where P = "(\<lambda>x. (\<delta> (x .salary@pre)))" and \<tau> = "\<tau>" and x = "X" and y = "invalid"], simp add: foundation16' dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__salaryat_pre_invalid) - apply(case_tac "\<tau> \<Turnstile> (X \<triangleq> null)", insert StrongEq_L_subst2[where P = "(\<lambda>x. (\<delta> (x .salary@pre)))" and \<tau> = "\<tau>" and x = "X" and y = "null"], simp add: foundation16' dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__salaryat_pre_null) -by(simp add: defined_split) -lemma defined_mono_dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__wormhole : "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Planet) .wormhole)) \<Longrightarrow> \<tau> \<Turnstile> (\<delta> (X))" - apply(case_tac "\<tau> \<Turnstile> (X \<triangleq> invalid)", insert StrongEq_L_subst2[where P = "(\<lambda>x. (\<delta> (x .wormhole)))" and \<tau> = "\<tau>" and x = "X" and y = "invalid"], simp add: foundation16' dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__wormhole_invalid) - apply(case_tac "\<tau> \<Turnstile> (X \<triangleq> null)", insert StrongEq_L_subst2[where P = "(\<lambda>x. (\<delta> (x .wormhole)))" and \<tau> = "\<tau>" and x = "X" and y = "null"], simp add: foundation16' dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__wormhole_null) -by(simp add: defined_split) -lemma defined_mono_dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__weight : "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Planet) .weight)) \<Longrightarrow> \<tau> \<Turnstile> (\<delta> (X))" - apply(case_tac "\<tau> \<Turnstile> (X \<triangleq> invalid)", insert StrongEq_L_subst2[where P = "(\<lambda>x. (\<delta> (x .weight)))" and \<tau> = "\<tau>" and x = "X" and y = "invalid"], simp add: foundation16' dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__weight_invalid) - apply(case_tac "\<tau> \<Turnstile> (X \<triangleq> null)", insert StrongEq_L_subst2[where P = "(\<lambda>x. (\<delta> (x .weight)))" and \<tau> = "\<tau>" and x = "X" and y = "null"], simp add: foundation16' dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__weight_null) -by(simp add: defined_split) -lemma defined_mono_dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__wormholeat_pre : "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Planet) .wormhole@pre)) \<Longrightarrow> \<tau> \<Turnstile> (\<delta> (X))" - apply(case_tac "\<tau> \<Turnstile> (X \<triangleq> invalid)", insert StrongEq_L_subst2[where P = "(\<lambda>x. (\<delta> (x .wormhole@pre)))" and \<tau> = "\<tau>" and x = "X" and y = "invalid"], simp add: foundation16' dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__wormholeat_pre_invalid) - apply(case_tac "\<tau> \<Turnstile> (X \<triangleq> null)", insert StrongEq_L_subst2[where P = "(\<lambda>x. (\<delta> (x .wormhole@pre)))" and \<tau> = "\<tau>" and x = "X" and y = "null"], simp add: foundation16' dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__wormholeat_pre_null) -by(simp add: defined_split) -lemma defined_mono_dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__weightat_pre : "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Planet) .weight@pre)) \<Longrightarrow> \<tau> \<Turnstile> (\<delta> (X))" - apply(case_tac "\<tau> \<Turnstile> (X \<triangleq> invalid)", insert StrongEq_L_subst2[where P = "(\<lambda>x. (\<delta> (x .weight@pre)))" and \<tau> = "\<tau>" and x = "X" and y = "invalid"], simp add: foundation16' dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__weightat_pre_invalid) - apply(case_tac "\<tau> \<Turnstile> (X \<triangleq> null)", insert StrongEq_L_subst2[where P = "(\<lambda>x. (\<delta> (x .weight@pre)))" and \<tau> = "\<tau>" and x = "X" and y = "null"], simp add: foundation16' dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__weightat_pre_null) -by(simp add: defined_split) -lemma defined_mono_dot\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y__sound : "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Galaxy) .sound)) \<Longrightarrow> \<tau> \<Turnstile> (\<delta> (X))" - apply(case_tac "\<tau> \<Turnstile> (X \<triangleq> invalid)", insert StrongEq_L_subst2[where P = "(\<lambda>x. (\<delta> (x .sound)))" and \<tau> = "\<tau>" and x = "X" and y = "invalid"], simp add: foundation16' dot\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y__sound_invalid) - apply(case_tac "\<tau> \<Turnstile> (X \<triangleq> null)", insert StrongEq_L_subst2[where P = "(\<lambda>x. (\<delta> (x .sound)))" and \<tau> = "\<tau>" and x = "X" and y = "null"], simp add: foundation16' dot\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y__sound_null) -by(simp add: defined_split) -lemma defined_mono_dot\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y__moving : "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Galaxy) .moving)) \<Longrightarrow> \<tau> \<Turnstile> (\<delta> (X))" - apply(case_tac "\<tau> \<Turnstile> (X \<triangleq> invalid)", insert StrongEq_L_subst2[where P = "(\<lambda>x. (\<delta> (x .moving)))" and \<tau> = "\<tau>" and x = "X" and y = "invalid"], simp add: foundation16' dot\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y__moving_invalid) - apply(case_tac "\<tau> \<Turnstile> (X \<triangleq> null)", insert StrongEq_L_subst2[where P = "(\<lambda>x. (\<delta> (x .moving)))" and \<tau> = "\<tau>" and x = "X" and y = "null"], simp add: foundation16' dot\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y__moving_null) -by(simp add: defined_split) -lemma defined_mono_dot\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y__outer_world : "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Galaxy) .outer_world)) \<Longrightarrow> \<tau> \<Turnstile> (\<delta> (X))" - apply(case_tac "\<tau> \<Turnstile> (X \<triangleq> invalid)", insert StrongEq_L_subst2[where P = "(\<lambda>x. (\<delta> (x .outer_world)))" and \<tau> = "\<tau>" and x = "X" and y = "invalid"], simp add: foundation16' dot\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y__outer_world_invalid) - apply(case_tac "\<tau> \<Turnstile> (X \<triangleq> null)", insert StrongEq_L_subst2[where P = "(\<lambda>x. (\<delta> (x .outer_world)))" and \<tau> = "\<tau>" and x = "X" and y = "null"], simp add: foundation16' dot\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y__outer_world_null) -by(simp add: defined_split) -lemma defined_mono_dot\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y__soundat_pre : "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Galaxy) .sound@pre)) \<Longrightarrow> \<tau> \<Turnstile> (\<delta> (X))" - apply(case_tac "\<tau> \<Turnstile> (X \<triangleq> invalid)", insert StrongEq_L_subst2[where P = "(\<lambda>x. (\<delta> (x .sound@pre)))" and \<tau> = "\<tau>" and x = "X" and y = "invalid"], simp add: foundation16' dot\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y__soundat_pre_invalid) - apply(case_tac "\<tau> \<Turnstile> (X \<triangleq> null)", insert StrongEq_L_subst2[where P = "(\<lambda>x. (\<delta> (x .sound@pre)))" and \<tau> = "\<tau>" and x = "X" and y = "null"], simp add: foundation16' dot\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y__soundat_pre_null) -by(simp add: defined_split) -lemma defined_mono_dot\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y__movingat_pre : "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Galaxy) .moving@pre)) \<Longrightarrow> \<tau> \<Turnstile> (\<delta> (X))" - apply(case_tac "\<tau> \<Turnstile> (X \<triangleq> invalid)", insert StrongEq_L_subst2[where P = "(\<lambda>x. (\<delta> (x .moving@pre)))" and \<tau> = "\<tau>" and x = "X" and y = "invalid"], simp add: foundation16' dot\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y__movingat_pre_invalid) - apply(case_tac "\<tau> \<Turnstile> (X \<triangleq> null)", insert StrongEq_L_subst2[where P = "(\<lambda>x. (\<delta> (x .moving@pre)))" and \<tau> = "\<tau>" and x = "X" and y = "null"], simp add: foundation16' dot\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y__movingat_pre_null) -by(simp add: defined_split) -lemma defined_mono_dot\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y__outer_worldat_pre : "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Galaxy) .outer_world@pre)) \<Longrightarrow> \<tau> \<Turnstile> (\<delta> (X))" - apply(case_tac "\<tau> \<Turnstile> (X \<triangleq> invalid)", insert StrongEq_L_subst2[where P = "(\<lambda>x. (\<delta> (x .outer_world@pre)))" and \<tau> = "\<tau>" and x = "X" and y = "invalid"], simp add: foundation16' dot\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y__outer_worldat_pre_invalid) - apply(case_tac "\<tau> \<Turnstile> (X \<triangleq> null)", insert StrongEq_L_subst2[where P = "(\<lambda>x. (\<delta> (x .outer_world@pre)))" and \<tau> = "\<tau>" and x = "X" and y = "null"], simp add: foundation16' dot\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y__outer_worldat_pre_null) -by(simp add: defined_split) -lemma defined_mono_dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__wormhole : "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Person) .wormhole)) \<Longrightarrow> \<tau> \<Turnstile> (\<delta> (X))" - apply(case_tac "\<tau> \<Turnstile> (X \<triangleq> invalid)", insert StrongEq_L_subst2[where P = "(\<lambda>x. (\<delta> (x .wormhole)))" and \<tau> = "\<tau>" and x = "X" and y = "invalid"], simp add: foundation16' dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__wormhole_invalid) - apply(case_tac "\<tau> \<Turnstile> (X \<triangleq> null)", insert StrongEq_L_subst2[where P = "(\<lambda>x. (\<delta> (x .wormhole)))" and \<tau> = "\<tau>" and x = "X" and y = "null"], simp add: foundation16' dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__wormhole_null) -by(simp add: defined_split) -lemma defined_mono_dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__weight : "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Person) .weight)) \<Longrightarrow> \<tau> \<Turnstile> (\<delta> (X))" - apply(case_tac "\<tau> \<Turnstile> (X \<triangleq> invalid)", insert StrongEq_L_subst2[where P = "(\<lambda>x. (\<delta> (x .weight)))" and \<tau> = "\<tau>" and x = "X" and y = "invalid"], simp add: foundation16' dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__weight_invalid) - apply(case_tac "\<tau> \<Turnstile> (X \<triangleq> null)", insert StrongEq_L_subst2[where P = "(\<lambda>x. (\<delta> (x .weight)))" and \<tau> = "\<tau>" and x = "X" and y = "null"], simp add: foundation16' dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__weight_null) -by(simp add: defined_split) -lemma defined_mono_dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__sound : "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Person) .sound)) \<Longrightarrow> \<tau> \<Turnstile> (\<delta> (X))" - apply(case_tac "\<tau> \<Turnstile> (X \<triangleq> invalid)", insert StrongEq_L_subst2[where P = "(\<lambda>x. (\<delta> (x .sound)))" and \<tau> = "\<tau>" and x = "X" and y = "invalid"], simp add: foundation16' dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__sound_invalid) - apply(case_tac "\<tau> \<Turnstile> (X \<triangleq> null)", insert StrongEq_L_subst2[where P = "(\<lambda>x. (\<delta> (x .sound)))" and \<tau> = "\<tau>" and x = "X" and y = "null"], simp add: foundation16' dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__sound_null) -by(simp add: defined_split) -lemma defined_mono_dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__moving : "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Person) .moving)) \<Longrightarrow> \<tau> \<Turnstile> (\<delta> (X))" - apply(case_tac "\<tau> \<Turnstile> (X \<triangleq> invalid)", insert StrongEq_L_subst2[where P = "(\<lambda>x. (\<delta> (x .moving)))" and \<tau> = "\<tau>" and x = "X" and y = "invalid"], simp add: foundation16' dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__moving_invalid) - apply(case_tac "\<tau> \<Turnstile> (X \<triangleq> null)", insert StrongEq_L_subst2[where P = "(\<lambda>x. (\<delta> (x .moving)))" and \<tau> = "\<tau>" and x = "X" and y = "null"], simp add: foundation16' dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__moving_null) -by(simp add: defined_split) -lemma defined_mono_dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__outer_world : "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Person) .outer_world)) \<Longrightarrow> \<tau> \<Turnstile> (\<delta> (X))" - apply(case_tac "\<tau> \<Turnstile> (X \<triangleq> invalid)", insert StrongEq_L_subst2[where P = "(\<lambda>x. (\<delta> (x .outer_world)))" and \<tau> = "\<tau>" and x = "X" and y = "invalid"], simp add: foundation16' dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__outer_world_invalid) - apply(case_tac "\<tau> \<Turnstile> (X \<triangleq> null)", insert StrongEq_L_subst2[where P = "(\<lambda>x. (\<delta> (x .outer_world)))" and \<tau> = "\<tau>" and x = "X" and y = "null"], simp add: foundation16' dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__outer_world_null) -by(simp add: defined_split) -lemma defined_mono_dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__wormholeat_pre : "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Person) .wormhole@pre)) \<Longrightarrow> \<tau> \<Turnstile> (\<delta> (X))" - apply(case_tac "\<tau> \<Turnstile> (X \<triangleq> invalid)", insert StrongEq_L_subst2[where P = "(\<lambda>x. (\<delta> (x .wormhole@pre)))" and \<tau> = "\<tau>" and x = "X" and y = "invalid"], simp add: foundation16' dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__wormholeat_pre_invalid) - apply(case_tac "\<tau> \<Turnstile> (X \<triangleq> null)", insert StrongEq_L_subst2[where P = "(\<lambda>x. (\<delta> (x .wormhole@pre)))" and \<tau> = "\<tau>" and x = "X" and y = "null"], simp add: foundation16' dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__wormholeat_pre_null) -by(simp add: defined_split) -lemma defined_mono_dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__weightat_pre : "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Person) .weight@pre)) \<Longrightarrow> \<tau> \<Turnstile> (\<delta> (X))" - apply(case_tac "\<tau> \<Turnstile> (X \<triangleq> invalid)", insert StrongEq_L_subst2[where P = "(\<lambda>x. (\<delta> (x .weight@pre)))" and \<tau> = "\<tau>" and x = "X" and y = "invalid"], simp add: foundation16' dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__weightat_pre_invalid) - apply(case_tac "\<tau> \<Turnstile> (X \<triangleq> null)", insert StrongEq_L_subst2[where P = "(\<lambda>x. (\<delta> (x .weight@pre)))" and \<tau> = "\<tau>" and x = "X" and y = "null"], simp add: foundation16' dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__weightat_pre_null) -by(simp add: defined_split) -lemma defined_mono_dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__soundat_pre : "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Person) .sound@pre)) \<Longrightarrow> \<tau> \<Turnstile> (\<delta> (X))" - apply(case_tac "\<tau> \<Turnstile> (X \<triangleq> invalid)", insert StrongEq_L_subst2[where P = "(\<lambda>x. (\<delta> (x .sound@pre)))" and \<tau> = "\<tau>" and x = "X" and y = "invalid"], simp add: foundation16' dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__soundat_pre_invalid) - apply(case_tac "\<tau> \<Turnstile> (X \<triangleq> null)", insert StrongEq_L_subst2[where P = "(\<lambda>x. (\<delta> (x .sound@pre)))" and \<tau> = "\<tau>" and x = "X" and y = "null"], simp add: foundation16' dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__soundat_pre_null) -by(simp add: defined_split) -lemma defined_mono_dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__movingat_pre : "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Person) .moving@pre)) \<Longrightarrow> \<tau> \<Turnstile> (\<delta> (X))" - apply(case_tac "\<tau> \<Turnstile> (X \<triangleq> invalid)", insert StrongEq_L_subst2[where P = "(\<lambda>x. (\<delta> (x .moving@pre)))" and \<tau> = "\<tau>" and x = "X" and y = "invalid"], simp add: foundation16' dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__movingat_pre_invalid) - apply(case_tac "\<tau> \<Turnstile> (X \<triangleq> null)", insert StrongEq_L_subst2[where P = "(\<lambda>x. (\<delta> (x .moving@pre)))" and \<tau> = "\<tau>" and x = "X" and y = "null"], simp add: foundation16' dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__movingat_pre_null) -by(simp add: defined_split) -lemma defined_mono_dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__outer_worldat_pre : "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Person) .outer_world@pre)) \<Longrightarrow> \<tau> \<Turnstile> (\<delta> (X))" - apply(case_tac "\<tau> \<Turnstile> (X \<triangleq> invalid)", insert StrongEq_L_subst2[where P = "(\<lambda>x. (\<delta> (x .outer_world@pre)))" and \<tau> = "\<tau>" and x = "X" and y = "invalid"], simp add: foundation16' dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__outer_worldat_pre_invalid) - apply(case_tac "\<tau> \<Turnstile> (X \<triangleq> null)", insert StrongEq_L_subst2[where P = "(\<lambda>x. (\<delta> (x .outer_world@pre)))" and \<tau> = "\<tau>" and x = "X" and y = "null"], simp add: foundation16' dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__outer_worldat_pre_null) -by(simp add: defined_split) -lemma defined_mono_dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__sound : "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Planet) .sound)) \<Longrightarrow> \<tau> \<Turnstile> (\<delta> (X))" - apply(case_tac "\<tau> \<Turnstile> (X \<triangleq> invalid)", insert StrongEq_L_subst2[where P = "(\<lambda>x. (\<delta> (x .sound)))" and \<tau> = "\<tau>" and x = "X" and y = "invalid"], simp add: foundation16' dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__sound_invalid) - apply(case_tac "\<tau> \<Turnstile> (X \<triangleq> null)", insert StrongEq_L_subst2[where P = "(\<lambda>x. (\<delta> (x .sound)))" and \<tau> = "\<tau>" and x = "X" and y = "null"], simp add: foundation16' dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__sound_null) -by(simp add: defined_split) -lemma defined_mono_dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__moving : "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Planet) .moving)) \<Longrightarrow> \<tau> \<Turnstile> (\<delta> (X))" - apply(case_tac "\<tau> \<Turnstile> (X \<triangleq> invalid)", insert StrongEq_L_subst2[where P = "(\<lambda>x. (\<delta> (x .moving)))" and \<tau> = "\<tau>" and x = "X" and y = "invalid"], simp add: foundation16' dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__moving_invalid) - apply(case_tac "\<tau> \<Turnstile> (X \<triangleq> null)", insert StrongEq_L_subst2[where P = "(\<lambda>x. (\<delta> (x .moving)))" and \<tau> = "\<tau>" and x = "X" and y = "null"], simp add: foundation16' dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__moving_null) -by(simp add: defined_split) -lemma defined_mono_dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__outer_world : "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Planet) .outer_world)) \<Longrightarrow> \<tau> \<Turnstile> (\<delta> (X))" - apply(case_tac "\<tau> \<Turnstile> (X \<triangleq> invalid)", insert StrongEq_L_subst2[where P = "(\<lambda>x. (\<delta> (x .outer_world)))" and \<tau> = "\<tau>" and x = "X" and y = "invalid"], simp add: foundation16' dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__outer_world_invalid) - apply(case_tac "\<tau> \<Turnstile> (X \<triangleq> null)", insert StrongEq_L_subst2[where P = "(\<lambda>x. (\<delta> (x .outer_world)))" and \<tau> = "\<tau>" and x = "X" and y = "null"], simp add: foundation16' dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__outer_world_null) -by(simp add: defined_split) -lemma defined_mono_dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__soundat_pre : "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Planet) .sound@pre)) \<Longrightarrow> \<tau> \<Turnstile> (\<delta> (X))" - apply(case_tac "\<tau> \<Turnstile> (X \<triangleq> invalid)", insert StrongEq_L_subst2[where P = "(\<lambda>x. (\<delta> (x .sound@pre)))" and \<tau> = "\<tau>" and x = "X" and y = "invalid"], simp add: foundation16' dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__soundat_pre_invalid) - apply(case_tac "\<tau> \<Turnstile> (X \<triangleq> null)", insert StrongEq_L_subst2[where P = "(\<lambda>x. (\<delta> (x .sound@pre)))" and \<tau> = "\<tau>" and x = "X" and y = "null"], simp add: foundation16' dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__soundat_pre_null) -by(simp add: defined_split) -lemma defined_mono_dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__movingat_pre : "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Planet) .moving@pre)) \<Longrightarrow> \<tau> \<Turnstile> (\<delta> (X))" - apply(case_tac "\<tau> \<Turnstile> (X \<triangleq> invalid)", insert StrongEq_L_subst2[where P = "(\<lambda>x. (\<delta> (x .moving@pre)))" and \<tau> = "\<tau>" and x = "X" and y = "invalid"], simp add: foundation16' dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__movingat_pre_invalid) - apply(case_tac "\<tau> \<Turnstile> (X \<triangleq> null)", insert StrongEq_L_subst2[where P = "(\<lambda>x. (\<delta> (x .moving@pre)))" and \<tau> = "\<tau>" and x = "X" and y = "null"], simp add: foundation16' dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__movingat_pre_null) -by(simp add: defined_split) -lemma defined_mono_dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__outer_worldat_pre : "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Planet) .outer_world@pre)) \<Longrightarrow> \<tau> \<Turnstile> (\<delta> (X))" - apply(case_tac "\<tau> \<Turnstile> (X \<triangleq> invalid)", insert StrongEq_L_subst2[where P = "(\<lambda>x. (\<delta> (x .outer_world@pre)))" and \<tau> = "\<tau>" and x = "X" and y = "invalid"], simp add: foundation16' dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__outer_worldat_pre_invalid) - apply(case_tac "\<tau> \<Turnstile> (X \<triangleq> null)", insert StrongEq_L_subst2[where P = "(\<lambda>x. (\<delta> (x .outer_world@pre)))" and \<tau> = "\<tau>" and x = "X" and y = "null"], simp add: foundation16' dot\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t__outer_worldat_pre_null) -by(simp add: defined_split) - -(* 137 ************************************ 902 + 2 *) (* term Floor1_access.print_access_is_repr *) -lemma is_repr_dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_0___boss : -assumes def_dot: "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Person) .boss))" -shows "(is_represented_in_state (in_post_state) (X .boss) (Person) (\<tau>))" - apply(insert defined_mono_dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_0___boss[OF def_dot, simplified foundation16]) - apply(case_tac "(X (\<tau>))", simp add: bot_option_def) - proof - fix a0 show "(X (\<tau>)) = (Some (a0)) \<Longrightarrow> ?thesis" when "(X (\<tau>)) \<noteq> null" - apply(insert that, case_tac "a0", simp add: null_option_def bot_option_def, clarify) - proof - fix a show "(X (\<tau>)) = (Some ((Some (a)))) \<Longrightarrow> ?thesis" - apply(case_tac "(heap ((in_post_state (\<tau>))) ((oid_of (a))))", simp add: invalid_def bot_option_def) - apply(insert def_dot, simp add: dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_0___boss is_represented_in_state_def select\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__boss_def deref_oid\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_def in_post_state_def defined_def OclValid_def false_def true_def invalid_def bot_fun_def split: if_split_asm) - proof - fix b show "(X (\<tau>)) = (Some ((Some (a)))) \<Longrightarrow> (heap ((in_post_state (\<tau>))) ((oid_of (a)))) = (Some (b)) \<Longrightarrow> ?thesis" - apply(insert def_dot[simplified foundation16], auto simp: dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_0___boss is_represented_in_state_def deref_oid\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_def bot_option_def null_option_def) - apply(case_tac "b", simp_all add: invalid_def bot_option_def) - proof - fix r typeoid let ?t = "(Some ((Some (r)))) \<in> (Some o OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_\<AA>) ` (ran ((heap ((in_post_state (\<tau>))))))" - let ?sel_any = "(select_object_any\<^sub>S\<^sub>e\<^sub>t ((deref_oid\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (in_post_state) (reconst_basetype))))" show "(select\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__boss (?sel_any) (typeoid) (\<tau>)) = (Some ((Some (r)))) \<Longrightarrow> ?t" - apply(case_tac "typeoid", simp add: select\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__boss_def) - proof - fix opt show "(((case opt of None \<Rightarrow> null - | (Some (x)) \<Rightarrow> ((?sel_any) (x)))) (\<tau>)) = (Some ((Some (r)))) \<Longrightarrow> ?t" - apply(case_tac "opt", auto simp: null_fun_def null_option_def bot_option_def) - proof - fix aa show "((?sel_any) (aa) (\<tau>)) = (Some ((Some (r)))) \<Longrightarrow> ?t" when "\<tau> \<Turnstile> (\<delta> (((?sel_any) (aa))))" - apply(insert that, drule select_object_any_exec\<^sub>S\<^sub>e\<^sub>t[simplified foundation22], erule exE) - proof - fix e show "?t" when "((?sel_any) (aa) (\<tau>)) = (Some ((Some (r))))" "((?sel_any) (aa) (\<tau>)) = (deref_oid\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (in_post_state) (reconst_basetype) (e) (\<tau>))" - apply(insert that, simp add: deref_oid\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_def) - apply(case_tac "(heap ((in_post_state (\<tau>))) (e))", simp add: invalid_def bot_option_def, simp) - proof - fix aaa show "(case aaa of (in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (obj)) \<Rightarrow> (reconst_basetype (obj) (\<tau>)) - | _ \<Rightarrow> (invalid (\<tau>))) = (Some ((Some (r)))) \<Longrightarrow> (heap ((in_post_state (\<tau>))) (e)) = (Some (aaa)) \<Longrightarrow> ?t" - apply(case_tac "aaa", auto simp: invalid_def bot_option_def image_def ran_def) - apply(rule exI[where x = "(in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (r))"], simp add: OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_\<AA>_def Let_def reconst_basetype_def split: if_split_asm) -by(rule) qed - apply_end((blast)+) - qed - apply_end(simp add: foundation16 bot_option_def null_option_def) - qed qed qed qed qed - apply_end(simp_all) - qed -lemma is_repr_dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_0___bossat_pre : -assumes def_dot: "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>Person) .boss@pre))" -shows "(is_represented_in_state (in_pre_state) (X .boss@pre) (Person) (\<tau>))" - apply(insert defined_mono_dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_0___bossat_pre[OF def_dot, simplified foundation16]) - apply(case_tac "(X (\<tau>))", simp add: bot_option_def) - proof - fix a0 show "(X (\<tau>)) = (Some (a0)) \<Longrightarrow> ?thesis" when "(X (\<tau>)) \<noteq> null" - apply(insert that, case_tac "a0", simp add: null_option_def bot_option_def, clarify) - proof - fix a show "(X (\<tau>)) = (Some ((Some (a)))) \<Longrightarrow> ?thesis" - apply(case_tac "(heap ((in_pre_state (\<tau>))) ((oid_of (a))))", simp add: invalid_def bot_option_def) - apply(insert def_dot, simp add: dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_0___bossat_pre is_represented_in_state_def select\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__boss_def deref_oid\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_def in_pre_state_def defined_def OclValid_def false_def true_def invalid_def bot_fun_def split: if_split_asm) - proof - fix b show "(X (\<tau>)) = (Some ((Some (a)))) \<Longrightarrow> (heap ((in_pre_state (\<tau>))) ((oid_of (a)))) = (Some (b)) \<Longrightarrow> ?thesis" - apply(insert def_dot[simplified foundation16], auto simp: dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_0___bossat_pre is_represented_in_state_def deref_oid\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_def bot_option_def null_option_def) - apply(case_tac "b", simp_all add: invalid_def bot_option_def) - proof - fix r typeoid let ?t = "(Some ((Some (r)))) \<in> (Some o OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_\<AA>) ` (ran ((heap ((in_pre_state (\<tau>))))))" - let ?sel_any = "(select_object_any\<^sub>S\<^sub>e\<^sub>t ((deref_oid\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (in_pre_state) (reconst_basetype))))" show "(select\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__boss (?sel_any) (typeoid) (\<tau>)) = (Some ((Some (r)))) \<Longrightarrow> ?t" - apply(case_tac "typeoid", simp add: select\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n__boss_def) - proof - fix opt show "(((case opt of None \<Rightarrow> null - | (Some (x)) \<Rightarrow> ((?sel_any) (x)))) (\<tau>)) = (Some ((Some (r)))) \<Longrightarrow> ?t" - apply(case_tac "opt", auto simp: null_fun_def null_option_def bot_option_def) - proof - fix aa show "((?sel_any) (aa) (\<tau>)) = (Some ((Some (r)))) \<Longrightarrow> ?t" when "\<tau> \<Turnstile> (\<delta> (((?sel_any) (aa))))" - apply(insert that, drule select_object_any_exec\<^sub>S\<^sub>e\<^sub>t[simplified foundation22], erule exE) - proof - fix e show "?t" when "((?sel_any) (aa) (\<tau>)) = (Some ((Some (r))))" "((?sel_any) (aa) (\<tau>)) = (deref_oid\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (in_pre_state) (reconst_basetype) (e) (\<tau>))" - apply(insert that, simp add: deref_oid\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_def) - apply(case_tac "(heap ((in_pre_state (\<tau>))) (e))", simp add: invalid_def bot_option_def, simp) - proof - fix aaa show "(case aaa of (in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (obj)) \<Rightarrow> (reconst_basetype (obj) (\<tau>)) - | _ \<Rightarrow> (invalid (\<tau>))) = (Some ((Some (r)))) \<Longrightarrow> (heap ((in_pre_state (\<tau>))) (e)) = (Some (aaa)) \<Longrightarrow> ?t" - apply(case_tac "aaa", auto simp: invalid_def bot_option_def image_def ran_def) - apply(rule exI[where x = "(in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (r))"], simp add: OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_\<AA>_def Let_def reconst_basetype_def split: if_split_asm) -by(rule) qed - apply_end((blast)+) - qed - apply_end(simp add: foundation16 bot_option_def null_option_def) - qed qed qed qed qed - apply_end(simp_all) - qed - -(* 138 ************************************ 904 + 0 *) (* term Floor1_access.print_access_repr_allinst *) - -(* 139 ************************************ 904 + 1 *) -section \<open>Class Model: Towards the Object Instances\<close> - -(* 140 ************************************ 905 + 1 *) -text \<open> - -The example we are defining in this section comes from the \autoref{fig:Employee-DesignModel-UMLPart-generated-generatededm1_system-states}. -\<close> - -(* 141 ************************************ 906 + 1 *) -text_raw \<open> -\begin{figure} -\includegraphics[width=\textwidth]{figures/pre-post.pdf} -\caption{(a) pre-state $\sigma_1$ and - (b) post-state $\sigma_1'$.} -\label{fig:Employee-DesignModel-UMLPart-generated-generatededm1_system-states} -\end{figure} -\<close> - -(* 142 ************************************ 907 + 1 *) -text \<open>\<close> - -(* 143 ************************************ 908 + 1 *) -text_raw \<open>\<close> - -(* 144 ************************************ 909 + 1 *) (* term Floor1_examp.print_examp_def_st_defs *) -lemmas [simp,code_unfold] = state.defs - const_ss - -(* 145 ************************************ 910 + 1 *) (* term Floor1_astype.print_astype_lemmas_id2 *) -lemmas[simp,code_unfold] = OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Planet - OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Galaxy - OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny - OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Galaxy - OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_OclAny - OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person - OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_OclAny - OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person - OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Planet - OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person - OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Planet - OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Galaxy - -(* 146 ************************************ 911 + 1 *) -section \<open>Instance\<close> - -(* 147 ************************************ 912 + 2 *) (* term Floor1_examp.print_examp_instance_defassoc_typecheck_var *) -definition "(typecheck_instance_bad_head_on_lhs_P1_X0_X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9_X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n8_X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7_X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6_X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5_X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4_X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3_X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2_X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1 (P1) (X0) (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9) (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n8) (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7) (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6) (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5) (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4) (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3) (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2) (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1)) = ()" -definition "typecheck_instance_extra_variables_on_rhs_P1_X0_X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9_X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n8_X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7_X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6_X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5_X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4_X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3_X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2_X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1 = (\<lambda>P1 X0 X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9 X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n8 X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7 X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6 X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5 X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4 X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3 X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2 X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1. (P1 , P1 , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7 , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7 , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2 , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2))" - -(* 148 ************************************ 914 + 12 *) (* term Floor1_examp.print_examp_instance_defassoc *) -definition "oid1 = 1" -definition "oid2 = 2" -definition "oid3 = 3" -definition "oid4 = 4" -definition "oid5 = 5" -definition "oid6 = 6" -definition "oid7 = 7" -definition "oid8 = 8" -definition "oid9 = 9" -definition "oid10 = 10" -definition "oid11 = 11" -definition "inst_assoc1 = (\<lambda>oid_class to_from oid. ((case (deref_assocs_list ((to_from::oid list list \<Rightarrow> oid list \<times> oid list)) ((oid::oid)) ((the ((((map_of_list ([(oid\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_0___boss , (List.map ((\<lambda>(x , y). [x , y]) o switch\<^sub>2_01) ([[[oid7] , [oid7]] , [[oid6] , [oid7]] , [[oid2] , [oid2]] , [[oid1] , [oid2]]])))]))) ((oid_class::oid))))))) of Nil \<Rightarrow> None - | l \<Rightarrow> (Some (l)))::oid list option))" - -(* 149 ************************************ 926 + 22 *) (* term Floor1_examp.print_examp_instance *) -definition "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n inst_assoc = (mk\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n ((mk\<E>\<X>\<T>\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (oid1) (None) (None) (None) (None) (None))) (((inst_assoc) (oid\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_0___boss) (switch\<^sub>2_01) (oid1))) (\<lfloor>1300\<rfloor>))" -definition "(X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1::\<cdot>Person) = ((\<lambda>_. \<lfloor>\<lfloor>(X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (inst_assoc1))\<rfloor>\<rfloor>))" -definition "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n inst_assoc = (mk\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n ((mk\<E>\<X>\<T>\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (oid2) (None) (None) (None) (None) (None))) (((inst_assoc) (oid\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_0___boss) (switch\<^sub>2_01) (oid2))) (\<lfloor>1800\<rfloor>))" -definition "(X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2::\<cdot>Person) = ((\<lambda>_. \<lfloor>\<lfloor>(X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (inst_assoc1))\<rfloor>\<rfloor>))" -definition "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n inst_assoc = (mk\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n ((mk\<E>\<X>\<T>\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (oid3) (None) (None) (None) (None) (None))) (((inst_assoc) (oid\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_0___boss) (switch\<^sub>2_01) (oid3))) (None))" -definition "(X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3::\<cdot>Person) = ((\<lambda>_. \<lfloor>\<lfloor>(X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (inst_assoc1))\<rfloor>\<rfloor>))" -definition "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n inst_assoc = (mk\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n ((mk\<E>\<X>\<T>\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (oid4) (None) (None) (None) (None) (None))) (((inst_assoc) (oid\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_0___boss) (switch\<^sub>2_01) (oid4))) (\<lfloor>2900\<rfloor>))" -definition "(X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4::\<cdot>Person) = ((\<lambda>_. \<lfloor>\<lfloor>(X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (inst_assoc1))\<rfloor>\<rfloor>))" -definition "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n inst_assoc = (mk\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n ((mk\<E>\<X>\<T>\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (oid5) (None) (None) (None) (None) (None))) (((inst_assoc) (oid\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_0___boss) (switch\<^sub>2_01) (oid5))) (\<lfloor>3500\<rfloor>))" -definition "(X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5::\<cdot>Person) = ((\<lambda>_. \<lfloor>\<lfloor>(X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (inst_assoc1))\<rfloor>\<rfloor>))" -definition "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n inst_assoc = (mk\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n ((mk\<E>\<X>\<T>\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (oid6) (None) (None) (None) (None) (None))) (((inst_assoc) (oid\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_0___boss) (switch\<^sub>2_01) (oid6))) (\<lfloor>2500\<rfloor>))" -definition "(X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6::\<cdot>Person) = ((\<lambda>_. \<lfloor>\<lfloor>(X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (inst_assoc1))\<rfloor>\<rfloor>))" -definition "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y inst_assoc = (mk\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n ((mk\<E>\<X>\<T>\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (oid7) (None) (None) (None) (None) (None))) (((inst_assoc) (oid\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_0___boss) (switch\<^sub>2_01) (oid7))) (\<lfloor>3200\<rfloor>))" -definition "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7 = ((((\<lambda>_. \<lfloor>\<lfloor>(X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y (inst_assoc1))\<rfloor>\<rfloor>)::\<cdot>Person)) .oclAsType(OclAny))" -definition "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n8\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y inst_assoc = (mk\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y ((mk\<E>\<X>\<T>\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y (oid8))))" -definition "(X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n8::\<cdot>OclAny) = ((\<lambda>_. \<lfloor>\<lfloor>(X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n8\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y (inst_assoc1))\<rfloor>\<rfloor>))" -definition "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n inst_assoc = (mk\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n ((mk\<E>\<X>\<T>\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (oid9) (None) (None) (None) (None) (None))) (((inst_assoc) (oid\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_0___boss) (switch\<^sub>2_01) (oid9))) (\<lfloor>0\<rfloor>))" -definition "(X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9::\<cdot>Person) = ((\<lambda>_. \<lfloor>\<lfloor>(X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (inst_assoc1))\<rfloor>\<rfloor>))" -definition "X0\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n inst_assoc = (mk\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n ((mk\<E>\<X>\<T>\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (oid10) (None) (None) (None) (None) (\<lfloor>[[oid11]]\<rfloor>))) (((inst_assoc) (oid\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_0___boss) (switch\<^sub>2_01) (oid10))) (None))" -definition "(X0::\<cdot>Person) = ((\<lambda>_. \<lfloor>\<lfloor>(X0\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (inst_assoc1))\<rfloor>\<rfloor>))" -definition "P1\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t inst_assoc = (mk\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t ((mk\<E>\<X>\<T>\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (oid11) (None) (None) (\<lfloor>[[oid11] , [oid11]]\<rfloor>))) (None) (None))" -definition "(P1::\<cdot>Planet) = ((\<lambda>_. \<lfloor>\<lfloor>(P1\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (inst_assoc1))\<rfloor>\<rfloor>))" - -(* 150 ************************************ 948 + 1 *) (* term Floor1_examp.print_examp_instance_defassoc_typecheck *) -ML \<open>(Ty'.check ([(META.Writeln , "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1 .boss \<cong> Set{ X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2 }") , (META.Writeln , "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1 /* unnamed attribute */ \<cong> Set{}") , (META.Writeln , "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2 .boss \<cong> Set{ X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2 }") , (META.Writeln , "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2 /* unnamed attribute */ \<cong> Set{ X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1 , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2 }") , (META.Writeln , "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3 .boss \<cong> Set{}") , (META.Writeln , "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3 /* unnamed attribute */ \<cong> Set{}") , (META.Writeln , "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4 .boss \<cong> Set{}") , (META.Writeln , "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4 /* unnamed attribute */ \<cong> Set{}") , (META.Writeln , "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5 .boss \<cong> Set{}") , (META.Writeln , "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5 /* unnamed attribute */ \<cong> Set{}") , (META.Writeln , "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6 .boss \<cong> Set{ X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7 }") , (META.Writeln , "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6 /* unnamed attribute */ \<cong> Set{}") , (META.Writeln , "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7 .boss \<cong> Set{ X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7 }") , (META.Writeln , "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7 /* unnamed attribute */ \<cong> Set{ X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6 , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7 }") , (META.Writeln , "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9 .boss \<cong> Set{}") , (META.Writeln , "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9 /* unnamed attribute */ \<cong> Set{}") , (META.Writeln , "X0 .boss \<cong> Set{}") , (META.Writeln , "X0 /* unnamed attribute */ \<cong> Set{}")]) (" error(s)"))\<close> - -(* 151 ************************************ 949 + 1 *) -section \<open>Instance\<close> - -(* 152 ************************************ 950 + 2 *) (* term Floor1_examp.print_examp_instance_defassoc_typecheck_var *) -definition "(typecheck_instance_bad_head_on_lhs_\<sigma>\<^sub>1_object4_\<sigma>\<^sub>1_object2_\<sigma>\<^sub>1_object1_\<sigma>\<^sub>1_object0 (\<sigma>\<^sub>1_object4) (\<sigma>\<^sub>1_object2) (\<sigma>\<^sub>1_object1) (\<sigma>\<^sub>1_object0)) = ()" -definition "typecheck_instance_extra_variables_on_rhs_\<sigma>\<^sub>1_object4_\<sigma>\<^sub>1_object2_\<sigma>\<^sub>1_object1_\<sigma>\<^sub>1_object0 = (\<lambda>\<sigma>\<^sub>1_object4 \<sigma>\<^sub>1_object2 \<sigma>\<^sub>1_object1 \<sigma>\<^sub>1_object0. (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6 , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4 , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5 , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2 , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1))" - -(* 153 ************************************ 952 + 1 *) (* term Floor1_examp.print_examp_instance_defassoc *) -definition "inst_assoc12 = (\<lambda>oid_class to_from oid. ((case (deref_assocs_list ((to_from::oid list list \<Rightarrow> oid list \<times> oid list)) ((oid::oid)) ((the ((((map_of_list ([(oid\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_0___boss , (List.map ((\<lambda>(x , y). [x , y]) o switch\<^sub>2_01) ([[[oid6] , [oid4]] , [[oid4] , [oid5]] , [[oid1] , [oid2]]])))]))) ((oid_class::oid))))))) of Nil \<Rightarrow> None - | l \<Rightarrow> (Some (l)))::oid list option))" - -(* 154 ************************************ 953 + 8 *) (* term Floor1_examp.print_examp_instance *) -definition "\<sigma>\<^sub>1_object0\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n inst_assoc = (mk\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n ((mk\<E>\<X>\<T>\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (oid1) (None) (None) (None) (None) (None))) (((inst_assoc) (oid\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_0___boss) (switch\<^sub>2_01) (oid1))) (\<lfloor>1000\<rfloor>))" -definition "(\<sigma>\<^sub>1_object0::\<cdot>Person) = ((\<lambda>_. \<lfloor>\<lfloor>(\<sigma>\<^sub>1_object0\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (inst_assoc12))\<rfloor>\<rfloor>))" -definition "\<sigma>\<^sub>1_object1\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n inst_assoc = (mk\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n ((mk\<E>\<X>\<T>\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (oid2) (None) (None) (None) (None) (None))) (((inst_assoc) (oid\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_0___boss) (switch\<^sub>2_01) (oid2))) (\<lfloor>1200\<rfloor>))" -definition "(\<sigma>\<^sub>1_object1::\<cdot>Person) = ((\<lambda>_. \<lfloor>\<lfloor>(\<sigma>\<^sub>1_object1\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (inst_assoc12))\<rfloor>\<rfloor>))" -definition "\<sigma>\<^sub>1_object2\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n inst_assoc = (mk\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n ((mk\<E>\<X>\<T>\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (oid4) (None) (None) (None) (None) (None))) (((inst_assoc) (oid\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_0___boss) (switch\<^sub>2_01) (oid4))) (\<lfloor>2600\<rfloor>))" -definition "(\<sigma>\<^sub>1_object2::\<cdot>Person) = ((\<lambda>_. \<lfloor>\<lfloor>(\<sigma>\<^sub>1_object2\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (inst_assoc12))\<rfloor>\<rfloor>))" -definition "\<sigma>\<^sub>1_object4\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n inst_assoc = (mk\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n ((mk\<E>\<X>\<T>\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (oid6) (None) (None) (None) (None) (None))) (((inst_assoc) (oid\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_0___boss) (switch\<^sub>2_01) (oid6))) (\<lfloor>2300\<rfloor>))" -definition "(\<sigma>\<^sub>1_object4::\<cdot>Person) = ((\<lambda>_. \<lfloor>\<lfloor>(\<sigma>\<^sub>1_object4\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (inst_assoc12))\<rfloor>\<rfloor>))" - -(* 155 ************************************ 961 + 1 *) (* term Floor1_examp.print_examp_instance_defassoc_typecheck *) -ML \<open>(Ty'.check ([(META.Writeln , "\<sigma>\<^sub>1_object0 .boss \<cong> Set{ \<sigma>\<^sub>1_object1 }") , (META.Writeln , "\<sigma>\<^sub>1_object0 /* unnamed attribute */ \<cong> Set{}") , (META.Writeln , "\<sigma>\<^sub>1_object1 .boss \<cong> Set{}") , (META.Writeln , "\<sigma>\<^sub>1_object1 /* unnamed attribute */ \<cong> Set{ \<sigma>\<^sub>1_object0 }") , (META.Writeln , "\<sigma>\<^sub>1_object2 .boss \<cong> Set{ /*5*/ }") , (META.Writeln , "\<sigma>\<^sub>1_object2 /* unnamed attribute */ \<cong> Set{ \<sigma>\<^sub>1_object4 }") , (META.Writeln , "\<sigma>\<^sub>1_object4 .boss \<cong> Set{ \<sigma>\<^sub>1_object2 }") , (META.Writeln , "\<sigma>\<^sub>1_object4 /* unnamed attribute */ \<cong> Set{}")]) (" error(s)"))\<close> - -(* 156 ************************************ 962 + 1 *) -section \<open>State (Floor 2)\<close> - -(* 157 ************************************ 963 + 1 *) -locale state_\<sigma>\<^sub>1 = -fixes "oid1" :: "nat" -fixes "oid2" :: "nat" -fixes "oid4" :: "nat" -fixes "oid5" :: "nat" -fixes "oid6" :: "nat" -fixes "oid9" :: "nat" -assumes distinct_oid: "(distinct ([oid1 , oid2 , oid4 , oid5 , oid6 , oid9]))" -fixes "\<sigma>\<^sub>1_object0\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n" :: "ty\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n" -fixes "\<sigma>\<^sub>1_object0" :: "\<cdot>Person" -assumes \<sigma>\<^sub>1_object0_def: "\<sigma>\<^sub>1_object0 = (\<lambda>_. \<lfloor>\<lfloor>\<sigma>\<^sub>1_object0\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)" -fixes "\<sigma>\<^sub>1_object1\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n" :: "ty\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n" -fixes "\<sigma>\<^sub>1_object1" :: "\<cdot>Person" -assumes \<sigma>\<^sub>1_object1_def: "\<sigma>\<^sub>1_object1 = (\<lambda>_. \<lfloor>\<lfloor>\<sigma>\<^sub>1_object1\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)" -fixes "\<sigma>\<^sub>1_object2\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n" :: "ty\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n" -fixes "\<sigma>\<^sub>1_object2" :: "\<cdot>Person" -assumes \<sigma>\<^sub>1_object2_def: "\<sigma>\<^sub>1_object2 = (\<lambda>_. \<lfloor>\<lfloor>\<sigma>\<^sub>1_object2\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)" -fixes "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n" :: "ty\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n" -fixes "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5" :: "\<cdot>Person" -assumes X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5_def: "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5 = (\<lambda>_. \<lfloor>\<lfloor>X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)" -fixes "\<sigma>\<^sub>1_object4\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n" :: "ty\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n" -fixes "\<sigma>\<^sub>1_object4" :: "\<cdot>Person" -assumes \<sigma>\<^sub>1_object4_def: "\<sigma>\<^sub>1_object4 = (\<lambda>_. \<lfloor>\<lfloor>\<sigma>\<^sub>1_object4\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)" -fixes "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n" :: "ty\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n" -fixes "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9" :: "\<cdot>Person" -assumes X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9_def: "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9 = (\<lambda>_. \<lfloor>\<lfloor>X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)" -begin -definition "\<sigma>\<^sub>1 = (state.make ((Map.empty (oid1 \<mapsto> (in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (\<sigma>\<^sub>1_object0\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))) (oid2 \<mapsto> (in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (\<sigma>\<^sub>1_object1\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))) (oid4 \<mapsto> (in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (\<sigma>\<^sub>1_object2\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))) (oid5 \<mapsto> (in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))) (oid6 \<mapsto> (in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (\<sigma>\<^sub>1_object4\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))) (oid9 \<mapsto> (in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))))) ((map_of_list ([(oid\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_0___boss , (List.map ((\<lambda>(x , y). [x , y]) o switch\<^sub>2_01) ([[[oid1] , [oid2]] , [[oid4] , [oid5]] , [[oid6] , [oid4]]])))]))))" - -lemma dom_\<sigma>\<^sub>1 : "(dom ((heap (\<sigma>\<^sub>1)))) = {oid1 , oid2 , oid4 , oid5 , oid6 , oid9}" -by(auto simp: \<sigma>\<^sub>1_def) - -lemmas[simp,code_unfold] = dom_\<sigma>\<^sub>1 - -lemma perm_\<sigma>\<^sub>1 : "\<sigma>\<^sub>1 = (state.make ((Map.empty (oid9 \<mapsto> (in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))) (oid6 \<mapsto> (in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (\<sigma>\<^sub>1_object4\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))) (oid5 \<mapsto> (in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))) (oid4 \<mapsto> (in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (\<sigma>\<^sub>1_object2\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))) (oid2 \<mapsto> (in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (\<sigma>\<^sub>1_object1\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))) (oid1 \<mapsto> (in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (\<sigma>\<^sub>1_object0\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))))) ((assocs (\<sigma>\<^sub>1))))" - apply(simp add: \<sigma>\<^sub>1_def) - apply(subst (1) fun_upd_twist, metis distinct_oid distinct_length_2_or_more) - apply(subst (2) fun_upd_twist, metis distinct_oid distinct_length_2_or_more) - apply(subst (1) fun_upd_twist, metis distinct_oid distinct_length_2_or_more) - apply(subst (3) fun_upd_twist, metis distinct_oid distinct_length_2_or_more) - apply(subst (2) fun_upd_twist, metis distinct_oid distinct_length_2_or_more) - apply(subst (1) fun_upd_twist, metis distinct_oid distinct_length_2_or_more) - apply(subst (4) fun_upd_twist, metis distinct_oid distinct_length_2_or_more) - apply(subst (3) fun_upd_twist, metis distinct_oid distinct_length_2_or_more) - apply(subst (2) fun_upd_twist, metis distinct_oid distinct_length_2_or_more) - apply(subst (1) fun_upd_twist, metis distinct_oid distinct_length_2_or_more) - apply(subst (5) fun_upd_twist, metis distinct_oid distinct_length_2_or_more) - apply(subst (4) fun_upd_twist, metis distinct_oid distinct_length_2_or_more) - apply(subst (3) fun_upd_twist, metis distinct_oid distinct_length_2_or_more) - apply(subst (2) fun_upd_twist, metis distinct_oid distinct_length_2_or_more) - apply(subst (1) fun_upd_twist, metis distinct_oid distinct_length_2_or_more) -by(simp) - -lemma \<sigma>\<^sub>1_OclAllInstances_generic_exec_Person : -assumes [simp]: "(Person ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (\<sigma>\<^sub>1_object0\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(Person ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (\<sigma>\<^sub>1_object1\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(Person ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (\<sigma>\<^sub>1_object2\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(Person ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(Person ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (\<sigma>\<^sub>1_object4\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(Person ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(\<And>a. (pre_post ((mk (a)))) = a)" -shows "(mk (\<sigma>\<^sub>1)) \<Turnstile> (OclAllInstances_generic (pre_post) (Person)) \<doteq> Set{\<sigma>\<^sub>1_object0 , \<sigma>\<^sub>1_object1 , \<sigma>\<^sub>1_object2 , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5 , \<sigma>\<^sub>1_object4 , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9}" - apply(subst perm_\<sigma>\<^sub>1) - apply(simp only: state.make_def \<sigma>\<^sub>1_object0_def \<sigma>\<^sub>1_object1_def \<sigma>\<^sub>1_object2_def X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5_def \<sigma>\<^sub>1_object4_def X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9_def) - apply(subst state_update_vs_allInstances_generic_tc, simp, simp, (metis distinct_oid distinct_length_2_or_more)?, simp only: assms, blast, simp, rule const_StrictRefEq\<^sub>S\<^sub>e\<^sub>t_including, simp, simp, simp, rule OclIncluding_cong, (simp only: assms[symmetric ])?, simp add: valid_def OclValid_def bot_fun_def bot_option_def, (simp only: assms[symmetric ])?, simp add: valid_def OclValid_def bot_fun_def bot_option_def) - apply(subst state_update_vs_allInstances_generic_tc, simp, simp, (metis distinct_oid distinct_length_2_or_more)?, simp only: assms, blast, simp, rule const_StrictRefEq\<^sub>S\<^sub>e\<^sub>t_including, simp, simp, simp, rule OclIncluding_cong, (simp only: assms[symmetric ])?, simp add: valid_def OclValid_def bot_fun_def bot_option_def, (simp only: assms[symmetric ])?, simp add: valid_def OclValid_def bot_fun_def bot_option_def) - apply(subst state_update_vs_allInstances_generic_tc, simp, simp, (metis distinct_oid distinct_length_2_or_more)?, simp only: assms, blast, simp, rule const_StrictRefEq\<^sub>S\<^sub>e\<^sub>t_including, simp, simp, simp, rule OclIncluding_cong, (simp only: assms[symmetric ])?, simp add: valid_def OclValid_def bot_fun_def bot_option_def, (simp only: assms[symmetric ])?, simp add: valid_def OclValid_def bot_fun_def bot_option_def) - apply(subst state_update_vs_allInstances_generic_tc, simp, simp, (metis distinct_oid distinct_length_2_or_more)?, simp only: assms, blast, simp, rule const_StrictRefEq\<^sub>S\<^sub>e\<^sub>t_including, simp, simp, simp, rule OclIncluding_cong, (simp only: assms[symmetric ])?, simp add: valid_def OclValid_def bot_fun_def bot_option_def, (simp only: assms[symmetric ])?, simp add: valid_def OclValid_def bot_fun_def bot_option_def) - apply(subst state_update_vs_allInstances_generic_tc, simp, simp, (metis distinct_oid distinct_length_2_or_more)?, simp only: assms, blast, simp, rule const_StrictRefEq\<^sub>S\<^sub>e\<^sub>t_including, simp, simp, simp, rule OclIncluding_cong, (simp only: assms[symmetric ])?, simp add: valid_def OclValid_def bot_fun_def bot_option_def, (simp only: assms[symmetric ])?, simp add: valid_def OclValid_def bot_fun_def bot_option_def) - apply(subst state_update_vs_allInstances_generic_tc, simp, simp, (metis distinct_oid distinct_length_2_or_more)?, simp only: assms, blast, simp, rule const_StrictRefEq\<^sub>S\<^sub>e\<^sub>t_including, simp, simp, simp, rule OclIncluding_cong, (simp only: assms[symmetric ])?, simp add: valid_def OclValid_def bot_fun_def bot_option_def, (simp only: assms[symmetric ])?, simp add: valid_def OclValid_def bot_fun_def bot_option_def) - apply(rule state_update_vs_allInstances_generic_empty) -by(simp_all only: assms, (simp_all add: OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_\<AA>_def)?) - -lemma \<sigma>\<^sub>1_OclAllInstances_at_post_exec_Person : -assumes [simp]: "(Person ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (\<sigma>\<^sub>1_object0\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(Person ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (\<sigma>\<^sub>1_object1\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(Person ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (\<sigma>\<^sub>1_object2\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(Person ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(Person ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (\<sigma>\<^sub>1_object4\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(Person ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -shows "(st , \<sigma>\<^sub>1) \<Turnstile> (OclAllInstances_at_post (Person)) \<doteq> Set{\<sigma>\<^sub>1_object0 , \<sigma>\<^sub>1_object1 , \<sigma>\<^sub>1_object2 , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5 , \<sigma>\<^sub>1_object4 , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9}" - unfolding OclAllInstances_at_post_def -by(rule \<sigma>\<^sub>1_OclAllInstances_generic_exec_Person, simp_all only: assms, simp_all) - -lemma \<sigma>\<^sub>1_OclAllInstances_at_pre_exec_Person : -assumes [simp]: "(Person ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (\<sigma>\<^sub>1_object0\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(Person ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (\<sigma>\<^sub>1_object1\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(Person ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (\<sigma>\<^sub>1_object2\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(Person ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(Person ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (\<sigma>\<^sub>1_object4\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(Person ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -shows "(\<sigma>\<^sub>1 , st) \<Turnstile> (OclAllInstances_at_pre (Person)) \<doteq> Set{\<sigma>\<^sub>1_object0 , \<sigma>\<^sub>1_object1 , \<sigma>\<^sub>1_object2 , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5 , \<sigma>\<^sub>1_object4 , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9}" - unfolding OclAllInstances_at_pre_def -by(rule \<sigma>\<^sub>1_OclAllInstances_generic_exec_Person, simp_all only: assms, simp_all) - -lemma \<sigma>\<^sub>1_OclAllInstances_generic_exec_Planet : -assumes [simp]: "(Planet ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (\<sigma>\<^sub>1_object0\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(Planet ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (\<sigma>\<^sub>1_object1\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(Planet ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (\<sigma>\<^sub>1_object2\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(Planet ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(Planet ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (\<sigma>\<^sub>1_object4\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(Planet ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(\<lambda>_. \<lfloor>(Planet ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (\<sigma>\<^sub>1_object0\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))))\<rfloor>) = ((((\<lambda>_. \<lfloor>\<lfloor>\<sigma>\<^sub>1_object0\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)::\<cdot>Person)) .oclAsType(Planet))" -assumes [simp]: "(\<lambda>_. \<lfloor>(Planet ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (\<sigma>\<^sub>1_object1\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))))\<rfloor>) = ((((\<lambda>_. \<lfloor>\<lfloor>\<sigma>\<^sub>1_object1\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)::\<cdot>Person)) .oclAsType(Planet))" -assumes [simp]: "(\<lambda>_. \<lfloor>(Planet ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (\<sigma>\<^sub>1_object2\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))))\<rfloor>) = ((((\<lambda>_. \<lfloor>\<lfloor>\<sigma>\<^sub>1_object2\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)::\<cdot>Person)) .oclAsType(Planet))" -assumes [simp]: "(\<lambda>_. \<lfloor>(Planet ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))))\<rfloor>) = ((((\<lambda>_. \<lfloor>\<lfloor>X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)::\<cdot>Person)) .oclAsType(Planet))" -assumes [simp]: "(\<lambda>_. \<lfloor>(Planet ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (\<sigma>\<^sub>1_object4\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))))\<rfloor>) = ((((\<lambda>_. \<lfloor>\<lfloor>\<sigma>\<^sub>1_object4\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)::\<cdot>Person)) .oclAsType(Planet))" -assumes [simp]: "(\<lambda>_. \<lfloor>(Planet ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))))\<rfloor>) = ((((\<lambda>_. \<lfloor>\<lfloor>X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)::\<cdot>Person)) .oclAsType(Planet))" -assumes [simp]: "(\<And>a. (pre_post ((mk (a)))) = a)" -shows "(mk (\<sigma>\<^sub>1)) \<Turnstile> (OclAllInstances_generic (pre_post) (Planet)) \<doteq> Set{\<sigma>\<^sub>1_object0 .oclAsType(Planet) , \<sigma>\<^sub>1_object1 .oclAsType(Planet) , \<sigma>\<^sub>1_object2 .oclAsType(Planet) , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5 .oclAsType(Planet) , \<sigma>\<^sub>1_object4 .oclAsType(Planet) , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9 .oclAsType(Planet)}" - apply(subst perm_\<sigma>\<^sub>1) - apply(simp only: state.make_def \<sigma>\<^sub>1_object0_def \<sigma>\<^sub>1_object1_def \<sigma>\<^sub>1_object2_def X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5_def \<sigma>\<^sub>1_object4_def X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9_def) - apply(subst state_update_vs_allInstances_generic_tc, simp, simp, (metis distinct_oid distinct_length_2_or_more)?, simp only: assms, blast, simp, rule const_StrictRefEq\<^sub>S\<^sub>e\<^sub>t_including, simp del: OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person, simp del: OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person, simp, rule OclIncluding_cong, (simp only: assms[symmetric ])?, simp add: valid_def OclValid_def bot_fun_def bot_option_def, (simp only: assms[symmetric ])?, simp add: valid_def OclValid_def bot_fun_def bot_option_def) - apply(subst state_update_vs_allInstances_generic_tc, simp, simp, (metis distinct_oid distinct_length_2_or_more)?, simp only: assms, blast, simp, rule const_StrictRefEq\<^sub>S\<^sub>e\<^sub>t_including, simp del: OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person, simp del: OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person, simp, rule OclIncluding_cong, (simp only: assms[symmetric ])?, simp add: valid_def OclValid_def bot_fun_def bot_option_def, (simp only: assms[symmetric ])?, simp add: valid_def OclValid_def bot_fun_def bot_option_def) - apply(subst state_update_vs_allInstances_generic_tc, simp, simp, (metis distinct_oid distinct_length_2_or_more)?, simp only: assms, blast, simp, rule const_StrictRefEq\<^sub>S\<^sub>e\<^sub>t_including, simp del: OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person, simp del: OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person, simp, rule OclIncluding_cong, (simp only: assms[symmetric ])?, simp add: valid_def OclValid_def bot_fun_def bot_option_def, (simp only: assms[symmetric ])?, simp add: valid_def OclValid_def bot_fun_def bot_option_def) - apply(subst state_update_vs_allInstances_generic_tc, simp, simp, (metis distinct_oid distinct_length_2_or_more)?, simp only: assms, blast, simp, rule const_StrictRefEq\<^sub>S\<^sub>e\<^sub>t_including, simp del: OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person, simp del: OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person, simp, rule OclIncluding_cong, (simp only: assms[symmetric ])?, simp add: valid_def OclValid_def bot_fun_def bot_option_def, (simp only: assms[symmetric ])?, simp add: valid_def OclValid_def bot_fun_def bot_option_def) - apply(subst state_update_vs_allInstances_generic_tc, simp, simp, (metis distinct_oid distinct_length_2_or_more)?, simp only: assms, blast, simp, rule const_StrictRefEq\<^sub>S\<^sub>e\<^sub>t_including, simp del: OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person, simp del: OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person, simp, rule OclIncluding_cong, (simp only: assms[symmetric ])?, simp add: valid_def OclValid_def bot_fun_def bot_option_def, (simp only: assms[symmetric ])?, simp add: valid_def OclValid_def bot_fun_def bot_option_def) - apply(subst state_update_vs_allInstances_generic_tc, simp, simp, (metis distinct_oid distinct_length_2_or_more)?, simp only: assms, blast, simp, rule const_StrictRefEq\<^sub>S\<^sub>e\<^sub>t_including, simp del: OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person, simp del: OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person, simp, rule OclIncluding_cong, (simp only: assms[symmetric ])?, simp add: valid_def OclValid_def bot_fun_def bot_option_def, (simp only: assms[symmetric ])?, simp add: valid_def OclValid_def bot_fun_def bot_option_def) - apply(rule state_update_vs_allInstances_generic_empty) -by(simp_all only: assms, (simp_all add: OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_\<AA>_def)?) - -lemma \<sigma>\<^sub>1_OclAllInstances_at_post_exec_Planet : -assumes [simp]: "(Planet ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (\<sigma>\<^sub>1_object0\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(Planet ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (\<sigma>\<^sub>1_object1\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(Planet ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (\<sigma>\<^sub>1_object2\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(Planet ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(Planet ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (\<sigma>\<^sub>1_object4\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(Planet ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(\<lambda>_. \<lfloor>(Planet ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (\<sigma>\<^sub>1_object0\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))))\<rfloor>) = ((((\<lambda>_. \<lfloor>\<lfloor>\<sigma>\<^sub>1_object0\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)::\<cdot>Person)) .oclAsType(Planet))" -assumes [simp]: "(\<lambda>_. \<lfloor>(Planet ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (\<sigma>\<^sub>1_object1\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))))\<rfloor>) = ((((\<lambda>_. \<lfloor>\<lfloor>\<sigma>\<^sub>1_object1\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)::\<cdot>Person)) .oclAsType(Planet))" -assumes [simp]: "(\<lambda>_. \<lfloor>(Planet ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (\<sigma>\<^sub>1_object2\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))))\<rfloor>) = ((((\<lambda>_. \<lfloor>\<lfloor>\<sigma>\<^sub>1_object2\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)::\<cdot>Person)) .oclAsType(Planet))" -assumes [simp]: "(\<lambda>_. \<lfloor>(Planet ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))))\<rfloor>) = ((((\<lambda>_. \<lfloor>\<lfloor>X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)::\<cdot>Person)) .oclAsType(Planet))" -assumes [simp]: "(\<lambda>_. \<lfloor>(Planet ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (\<sigma>\<^sub>1_object4\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))))\<rfloor>) = ((((\<lambda>_. \<lfloor>\<lfloor>\<sigma>\<^sub>1_object4\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)::\<cdot>Person)) .oclAsType(Planet))" -assumes [simp]: "(\<lambda>_. \<lfloor>(Planet ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))))\<rfloor>) = ((((\<lambda>_. \<lfloor>\<lfloor>X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)::\<cdot>Person)) .oclAsType(Planet))" -shows "(st , \<sigma>\<^sub>1) \<Turnstile> (OclAllInstances_at_post (Planet)) \<doteq> Set{\<sigma>\<^sub>1_object0 .oclAsType(Planet) , \<sigma>\<^sub>1_object1 .oclAsType(Planet) , \<sigma>\<^sub>1_object2 .oclAsType(Planet) , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5 .oclAsType(Planet) , \<sigma>\<^sub>1_object4 .oclAsType(Planet) , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9 .oclAsType(Planet)}" - unfolding OclAllInstances_at_post_def -by(rule \<sigma>\<^sub>1_OclAllInstances_generic_exec_Planet, simp_all only: assms, simp_all) - -lemma \<sigma>\<^sub>1_OclAllInstances_at_pre_exec_Planet : -assumes [simp]: "(Planet ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (\<sigma>\<^sub>1_object0\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(Planet ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (\<sigma>\<^sub>1_object1\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(Planet ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (\<sigma>\<^sub>1_object2\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(Planet ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(Planet ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (\<sigma>\<^sub>1_object4\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(Planet ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(\<lambda>_. \<lfloor>(Planet ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (\<sigma>\<^sub>1_object0\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))))\<rfloor>) = ((((\<lambda>_. \<lfloor>\<lfloor>\<sigma>\<^sub>1_object0\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)::\<cdot>Person)) .oclAsType(Planet))" -assumes [simp]: "(\<lambda>_. \<lfloor>(Planet ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (\<sigma>\<^sub>1_object1\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))))\<rfloor>) = ((((\<lambda>_. \<lfloor>\<lfloor>\<sigma>\<^sub>1_object1\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)::\<cdot>Person)) .oclAsType(Planet))" -assumes [simp]: "(\<lambda>_. \<lfloor>(Planet ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (\<sigma>\<^sub>1_object2\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))))\<rfloor>) = ((((\<lambda>_. \<lfloor>\<lfloor>\<sigma>\<^sub>1_object2\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)::\<cdot>Person)) .oclAsType(Planet))" -assumes [simp]: "(\<lambda>_. \<lfloor>(Planet ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))))\<rfloor>) = ((((\<lambda>_. \<lfloor>\<lfloor>X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)::\<cdot>Person)) .oclAsType(Planet))" -assumes [simp]: "(\<lambda>_. \<lfloor>(Planet ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (\<sigma>\<^sub>1_object4\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))))\<rfloor>) = ((((\<lambda>_. \<lfloor>\<lfloor>\<sigma>\<^sub>1_object4\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)::\<cdot>Person)) .oclAsType(Planet))" -assumes [simp]: "(\<lambda>_. \<lfloor>(Planet ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))))\<rfloor>) = ((((\<lambda>_. \<lfloor>\<lfloor>X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)::\<cdot>Person)) .oclAsType(Planet))" -shows "(\<sigma>\<^sub>1 , st) \<Turnstile> (OclAllInstances_at_pre (Planet)) \<doteq> Set{\<sigma>\<^sub>1_object0 .oclAsType(Planet) , \<sigma>\<^sub>1_object1 .oclAsType(Planet) , \<sigma>\<^sub>1_object2 .oclAsType(Planet) , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5 .oclAsType(Planet) , \<sigma>\<^sub>1_object4 .oclAsType(Planet) , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9 .oclAsType(Planet)}" - unfolding OclAllInstances_at_pre_def -by(rule \<sigma>\<^sub>1_OclAllInstances_generic_exec_Planet, simp_all only: assms, simp_all) - -lemma \<sigma>\<^sub>1_OclAllInstances_generic_exec_Galaxy : -assumes [simp]: "(Galaxy ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (\<sigma>\<^sub>1_object0\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(Galaxy ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (\<sigma>\<^sub>1_object1\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(Galaxy ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (\<sigma>\<^sub>1_object2\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(Galaxy ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(Galaxy ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (\<sigma>\<^sub>1_object4\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(Galaxy ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(\<lambda>_. \<lfloor>(Galaxy ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (\<sigma>\<^sub>1_object0\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))))\<rfloor>) = ((((\<lambda>_. \<lfloor>\<lfloor>\<sigma>\<^sub>1_object0\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)::\<cdot>Person)) .oclAsType(Galaxy))" -assumes [simp]: "(\<lambda>_. \<lfloor>(Galaxy ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (\<sigma>\<^sub>1_object1\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))))\<rfloor>) = ((((\<lambda>_. \<lfloor>\<lfloor>\<sigma>\<^sub>1_object1\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)::\<cdot>Person)) .oclAsType(Galaxy))" -assumes [simp]: "(\<lambda>_. \<lfloor>(Galaxy ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (\<sigma>\<^sub>1_object2\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))))\<rfloor>) = ((((\<lambda>_. \<lfloor>\<lfloor>\<sigma>\<^sub>1_object2\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)::\<cdot>Person)) .oclAsType(Galaxy))" -assumes [simp]: "(\<lambda>_. \<lfloor>(Galaxy ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))))\<rfloor>) = ((((\<lambda>_. \<lfloor>\<lfloor>X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)::\<cdot>Person)) .oclAsType(Galaxy))" -assumes [simp]: "(\<lambda>_. \<lfloor>(Galaxy ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (\<sigma>\<^sub>1_object4\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))))\<rfloor>) = ((((\<lambda>_. \<lfloor>\<lfloor>\<sigma>\<^sub>1_object4\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)::\<cdot>Person)) .oclAsType(Galaxy))" -assumes [simp]: "(\<lambda>_. \<lfloor>(Galaxy ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))))\<rfloor>) = ((((\<lambda>_. \<lfloor>\<lfloor>X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)::\<cdot>Person)) .oclAsType(Galaxy))" -assumes [simp]: "(\<And>a. (pre_post ((mk (a)))) = a)" -shows "(mk (\<sigma>\<^sub>1)) \<Turnstile> (OclAllInstances_generic (pre_post) (Galaxy)) \<doteq> Set{\<sigma>\<^sub>1_object0 .oclAsType(Galaxy) , \<sigma>\<^sub>1_object1 .oclAsType(Galaxy) , \<sigma>\<^sub>1_object2 .oclAsType(Galaxy) , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5 .oclAsType(Galaxy) , \<sigma>\<^sub>1_object4 .oclAsType(Galaxy) , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9 .oclAsType(Galaxy)}" - apply(subst perm_\<sigma>\<^sub>1) - apply(simp only: state.make_def \<sigma>\<^sub>1_object0_def \<sigma>\<^sub>1_object1_def \<sigma>\<^sub>1_object2_def X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5_def \<sigma>\<^sub>1_object4_def X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9_def) - apply(subst state_update_vs_allInstances_generic_tc, simp, simp, (metis distinct_oid distinct_length_2_or_more)?, simp only: assms, blast, simp, rule const_StrictRefEq\<^sub>S\<^sub>e\<^sub>t_including, simp del: OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person, simp del: OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person, simp, rule OclIncluding_cong, (simp only: assms[symmetric ])?, simp add: valid_def OclValid_def bot_fun_def bot_option_def, (simp only: assms[symmetric ])?, simp add: valid_def OclValid_def bot_fun_def bot_option_def) - apply(subst state_update_vs_allInstances_generic_tc, simp, simp, (metis distinct_oid distinct_length_2_or_more)?, simp only: assms, blast, simp, rule const_StrictRefEq\<^sub>S\<^sub>e\<^sub>t_including, simp del: OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person, simp del: OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person, simp, rule OclIncluding_cong, (simp only: assms[symmetric ])?, simp add: valid_def OclValid_def bot_fun_def bot_option_def, (simp only: assms[symmetric ])?, simp add: valid_def OclValid_def bot_fun_def bot_option_def) - apply(subst state_update_vs_allInstances_generic_tc, simp, simp, (metis distinct_oid distinct_length_2_or_more)?, simp only: assms, blast, simp, rule const_StrictRefEq\<^sub>S\<^sub>e\<^sub>t_including, simp del: OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person, simp del: OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person, simp, rule OclIncluding_cong, (simp only: assms[symmetric ])?, simp add: valid_def OclValid_def bot_fun_def bot_option_def, (simp only: assms[symmetric ])?, simp add: valid_def OclValid_def bot_fun_def bot_option_def) - apply(subst state_update_vs_allInstances_generic_tc, simp, simp, (metis distinct_oid distinct_length_2_or_more)?, simp only: assms, blast, simp, rule const_StrictRefEq\<^sub>S\<^sub>e\<^sub>t_including, simp del: OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person, simp del: OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person, simp, rule OclIncluding_cong, (simp only: assms[symmetric ])?, simp add: valid_def OclValid_def bot_fun_def bot_option_def, (simp only: assms[symmetric ])?, simp add: valid_def OclValid_def bot_fun_def bot_option_def) - apply(subst state_update_vs_allInstances_generic_tc, simp, simp, (metis distinct_oid distinct_length_2_or_more)?, simp only: assms, blast, simp, rule const_StrictRefEq\<^sub>S\<^sub>e\<^sub>t_including, simp del: OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person, simp del: OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person, simp, rule OclIncluding_cong, (simp only: assms[symmetric ])?, simp add: valid_def OclValid_def bot_fun_def bot_option_def, (simp only: assms[symmetric ])?, simp add: valid_def OclValid_def bot_fun_def bot_option_def) - apply(subst state_update_vs_allInstances_generic_tc, simp, simp, (metis distinct_oid distinct_length_2_or_more)?, simp only: assms, blast, simp, rule const_StrictRefEq\<^sub>S\<^sub>e\<^sub>t_including, simp del: OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person, simp del: OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person, simp, rule OclIncluding_cong, (simp only: assms[symmetric ])?, simp add: valid_def OclValid_def bot_fun_def bot_option_def, (simp only: assms[symmetric ])?, simp add: valid_def OclValid_def bot_fun_def bot_option_def) - apply(rule state_update_vs_allInstances_generic_empty) -by(simp_all only: assms, (simp_all add: OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_\<AA>_def)?) - -lemma \<sigma>\<^sub>1_OclAllInstances_at_post_exec_Galaxy : -assumes [simp]: "(Galaxy ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (\<sigma>\<^sub>1_object0\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(Galaxy ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (\<sigma>\<^sub>1_object1\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(Galaxy ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (\<sigma>\<^sub>1_object2\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(Galaxy ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(Galaxy ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (\<sigma>\<^sub>1_object4\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(Galaxy ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(\<lambda>_. \<lfloor>(Galaxy ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (\<sigma>\<^sub>1_object0\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))))\<rfloor>) = ((((\<lambda>_. \<lfloor>\<lfloor>\<sigma>\<^sub>1_object0\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)::\<cdot>Person)) .oclAsType(Galaxy))" -assumes [simp]: "(\<lambda>_. \<lfloor>(Galaxy ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (\<sigma>\<^sub>1_object1\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))))\<rfloor>) = ((((\<lambda>_. \<lfloor>\<lfloor>\<sigma>\<^sub>1_object1\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)::\<cdot>Person)) .oclAsType(Galaxy))" -assumes [simp]: "(\<lambda>_. \<lfloor>(Galaxy ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (\<sigma>\<^sub>1_object2\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))))\<rfloor>) = ((((\<lambda>_. \<lfloor>\<lfloor>\<sigma>\<^sub>1_object2\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)::\<cdot>Person)) .oclAsType(Galaxy))" -assumes [simp]: "(\<lambda>_. \<lfloor>(Galaxy ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))))\<rfloor>) = ((((\<lambda>_. \<lfloor>\<lfloor>X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)::\<cdot>Person)) .oclAsType(Galaxy))" -assumes [simp]: "(\<lambda>_. \<lfloor>(Galaxy ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (\<sigma>\<^sub>1_object4\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))))\<rfloor>) = ((((\<lambda>_. \<lfloor>\<lfloor>\<sigma>\<^sub>1_object4\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)::\<cdot>Person)) .oclAsType(Galaxy))" -assumes [simp]: "(\<lambda>_. \<lfloor>(Galaxy ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))))\<rfloor>) = ((((\<lambda>_. \<lfloor>\<lfloor>X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)::\<cdot>Person)) .oclAsType(Galaxy))" -shows "(st , \<sigma>\<^sub>1) \<Turnstile> (OclAllInstances_at_post (Galaxy)) \<doteq> Set{\<sigma>\<^sub>1_object0 .oclAsType(Galaxy) , \<sigma>\<^sub>1_object1 .oclAsType(Galaxy) , \<sigma>\<^sub>1_object2 .oclAsType(Galaxy) , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5 .oclAsType(Galaxy) , \<sigma>\<^sub>1_object4 .oclAsType(Galaxy) , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9 .oclAsType(Galaxy)}" - unfolding OclAllInstances_at_post_def -by(rule \<sigma>\<^sub>1_OclAllInstances_generic_exec_Galaxy, simp_all only: assms, simp_all) - -lemma \<sigma>\<^sub>1_OclAllInstances_at_pre_exec_Galaxy : -assumes [simp]: "(Galaxy ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (\<sigma>\<^sub>1_object0\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(Galaxy ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (\<sigma>\<^sub>1_object1\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(Galaxy ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (\<sigma>\<^sub>1_object2\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(Galaxy ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(Galaxy ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (\<sigma>\<^sub>1_object4\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(Galaxy ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(\<lambda>_. \<lfloor>(Galaxy ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (\<sigma>\<^sub>1_object0\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))))\<rfloor>) = ((((\<lambda>_. \<lfloor>\<lfloor>\<sigma>\<^sub>1_object0\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)::\<cdot>Person)) .oclAsType(Galaxy))" -assumes [simp]: "(\<lambda>_. \<lfloor>(Galaxy ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (\<sigma>\<^sub>1_object1\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))))\<rfloor>) = ((((\<lambda>_. \<lfloor>\<lfloor>\<sigma>\<^sub>1_object1\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)::\<cdot>Person)) .oclAsType(Galaxy))" -assumes [simp]: "(\<lambda>_. \<lfloor>(Galaxy ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (\<sigma>\<^sub>1_object2\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))))\<rfloor>) = ((((\<lambda>_. \<lfloor>\<lfloor>\<sigma>\<^sub>1_object2\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)::\<cdot>Person)) .oclAsType(Galaxy))" -assumes [simp]: "(\<lambda>_. \<lfloor>(Galaxy ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))))\<rfloor>) = ((((\<lambda>_. \<lfloor>\<lfloor>X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)::\<cdot>Person)) .oclAsType(Galaxy))" -assumes [simp]: "(\<lambda>_. \<lfloor>(Galaxy ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (\<sigma>\<^sub>1_object4\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))))\<rfloor>) = ((((\<lambda>_. \<lfloor>\<lfloor>\<sigma>\<^sub>1_object4\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)::\<cdot>Person)) .oclAsType(Galaxy))" -assumes [simp]: "(\<lambda>_. \<lfloor>(Galaxy ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))))\<rfloor>) = ((((\<lambda>_. \<lfloor>\<lfloor>X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)::\<cdot>Person)) .oclAsType(Galaxy))" -shows "(\<sigma>\<^sub>1 , st) \<Turnstile> (OclAllInstances_at_pre (Galaxy)) \<doteq> Set{\<sigma>\<^sub>1_object0 .oclAsType(Galaxy) , \<sigma>\<^sub>1_object1 .oclAsType(Galaxy) , \<sigma>\<^sub>1_object2 .oclAsType(Galaxy) , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5 .oclAsType(Galaxy) , \<sigma>\<^sub>1_object4 .oclAsType(Galaxy) , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9 .oclAsType(Galaxy)}" - unfolding OclAllInstances_at_pre_def -by(rule \<sigma>\<^sub>1_OclAllInstances_generic_exec_Galaxy, simp_all only: assms, simp_all) - -lemma \<sigma>\<^sub>1_OclAllInstances_generic_exec_OclAny : -assumes [simp]: "(OclAny ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (\<sigma>\<^sub>1_object0\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(OclAny ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (\<sigma>\<^sub>1_object1\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(OclAny ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (\<sigma>\<^sub>1_object2\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(OclAny ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(OclAny ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (\<sigma>\<^sub>1_object4\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(OclAny ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(\<lambda>_. \<lfloor>(OclAny ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (\<sigma>\<^sub>1_object0\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))))\<rfloor>) = ((((\<lambda>_. \<lfloor>\<lfloor>\<sigma>\<^sub>1_object0\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)::\<cdot>Person)) .oclAsType(OclAny))" -assumes [simp]: "(\<lambda>_. \<lfloor>(OclAny ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (\<sigma>\<^sub>1_object1\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))))\<rfloor>) = ((((\<lambda>_. \<lfloor>\<lfloor>\<sigma>\<^sub>1_object1\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)::\<cdot>Person)) .oclAsType(OclAny))" -assumes [simp]: "(\<lambda>_. \<lfloor>(OclAny ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (\<sigma>\<^sub>1_object2\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))))\<rfloor>) = ((((\<lambda>_. \<lfloor>\<lfloor>\<sigma>\<^sub>1_object2\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)::\<cdot>Person)) .oclAsType(OclAny))" -assumes [simp]: "(\<lambda>_. \<lfloor>(OclAny ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))))\<rfloor>) = ((((\<lambda>_. \<lfloor>\<lfloor>X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)::\<cdot>Person)) .oclAsType(OclAny))" -assumes [simp]: "(\<lambda>_. \<lfloor>(OclAny ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (\<sigma>\<^sub>1_object4\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))))\<rfloor>) = ((((\<lambda>_. \<lfloor>\<lfloor>\<sigma>\<^sub>1_object4\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)::\<cdot>Person)) .oclAsType(OclAny))" -assumes [simp]: "(\<lambda>_. \<lfloor>(OclAny ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))))\<rfloor>) = ((((\<lambda>_. \<lfloor>\<lfloor>X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)::\<cdot>Person)) .oclAsType(OclAny))" -assumes [simp]: "(\<And>a. (pre_post ((mk (a)))) = a)" -shows "(mk (\<sigma>\<^sub>1)) \<Turnstile> (OclAllInstances_generic (pre_post) (OclAny)) \<doteq> Set{\<sigma>\<^sub>1_object0 .oclAsType(OclAny) , \<sigma>\<^sub>1_object1 .oclAsType(OclAny) , \<sigma>\<^sub>1_object2 .oclAsType(OclAny) , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5 .oclAsType(OclAny) , \<sigma>\<^sub>1_object4 .oclAsType(OclAny) , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9 .oclAsType(OclAny)}" - apply(subst perm_\<sigma>\<^sub>1) - apply(simp only: state.make_def \<sigma>\<^sub>1_object0_def \<sigma>\<^sub>1_object1_def \<sigma>\<^sub>1_object2_def X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5_def \<sigma>\<^sub>1_object4_def X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9_def) - apply(subst state_update_vs_allInstances_generic_tc, simp, simp, (metis distinct_oid distinct_length_2_or_more)?, simp only: assms, blast, simp, rule const_StrictRefEq\<^sub>S\<^sub>e\<^sub>t_including, simp del: OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person, simp del: OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person, simp, rule OclIncluding_cong, (simp only: assms[symmetric ])?, simp add: valid_def OclValid_def bot_fun_def bot_option_def, (simp only: assms[symmetric ])?, simp add: valid_def OclValid_def bot_fun_def bot_option_def) - apply(subst state_update_vs_allInstances_generic_tc, simp, simp, (metis distinct_oid distinct_length_2_or_more)?, simp only: assms, blast, simp, rule const_StrictRefEq\<^sub>S\<^sub>e\<^sub>t_including, simp del: OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person, simp del: OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person, simp, rule OclIncluding_cong, (simp only: assms[symmetric ])?, simp add: valid_def OclValid_def bot_fun_def bot_option_def, (simp only: assms[symmetric ])?, simp add: valid_def OclValid_def bot_fun_def bot_option_def) - apply(subst state_update_vs_allInstances_generic_tc, simp, simp, (metis distinct_oid distinct_length_2_or_more)?, simp only: assms, blast, simp, rule const_StrictRefEq\<^sub>S\<^sub>e\<^sub>t_including, simp del: OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person, simp del: OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person, simp, rule OclIncluding_cong, (simp only: assms[symmetric ])?, simp add: valid_def OclValid_def bot_fun_def bot_option_def, (simp only: assms[symmetric ])?, simp add: valid_def OclValid_def bot_fun_def bot_option_def) - apply(subst state_update_vs_allInstances_generic_tc, simp, simp, (metis distinct_oid distinct_length_2_or_more)?, simp only: assms, blast, simp, rule const_StrictRefEq\<^sub>S\<^sub>e\<^sub>t_including, simp del: OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person, simp del: OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person, simp, rule OclIncluding_cong, (simp only: assms[symmetric ])?, simp add: valid_def OclValid_def bot_fun_def bot_option_def, (simp only: assms[symmetric ])?, simp add: valid_def OclValid_def bot_fun_def bot_option_def) - apply(subst state_update_vs_allInstances_generic_tc, simp, simp, (metis distinct_oid distinct_length_2_or_more)?, simp only: assms, blast, simp, rule const_StrictRefEq\<^sub>S\<^sub>e\<^sub>t_including, simp del: OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person, simp del: OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person, simp, rule OclIncluding_cong, (simp only: assms[symmetric ])?, simp add: valid_def OclValid_def bot_fun_def bot_option_def, (simp only: assms[symmetric ])?, simp add: valid_def OclValid_def bot_fun_def bot_option_def) - apply(subst state_update_vs_allInstances_generic_tc, simp, simp, (metis distinct_oid distinct_length_2_or_more)?, simp only: assms, blast, simp, rule const_StrictRefEq\<^sub>S\<^sub>e\<^sub>t_including, simp del: OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person, simp del: OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person, simp, rule OclIncluding_cong, (simp only: assms[symmetric ])?, simp add: valid_def OclValid_def bot_fun_def bot_option_def, (simp only: assms[symmetric ])?, simp add: valid_def OclValid_def bot_fun_def bot_option_def) - apply(rule state_update_vs_allInstances_generic_empty) -by(simp_all only: assms, (simp_all add: OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_\<AA>_def)?) - -lemma \<sigma>\<^sub>1_OclAllInstances_at_post_exec_OclAny : -assumes [simp]: "(OclAny ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (\<sigma>\<^sub>1_object0\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(OclAny ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (\<sigma>\<^sub>1_object1\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(OclAny ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (\<sigma>\<^sub>1_object2\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(OclAny ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(OclAny ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (\<sigma>\<^sub>1_object4\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(OclAny ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(\<lambda>_. \<lfloor>(OclAny ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (\<sigma>\<^sub>1_object0\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))))\<rfloor>) = ((((\<lambda>_. \<lfloor>\<lfloor>\<sigma>\<^sub>1_object0\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)::\<cdot>Person)) .oclAsType(OclAny))" -assumes [simp]: "(\<lambda>_. \<lfloor>(OclAny ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (\<sigma>\<^sub>1_object1\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))))\<rfloor>) = ((((\<lambda>_. \<lfloor>\<lfloor>\<sigma>\<^sub>1_object1\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)::\<cdot>Person)) .oclAsType(OclAny))" -assumes [simp]: "(\<lambda>_. \<lfloor>(OclAny ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (\<sigma>\<^sub>1_object2\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))))\<rfloor>) = ((((\<lambda>_. \<lfloor>\<lfloor>\<sigma>\<^sub>1_object2\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)::\<cdot>Person)) .oclAsType(OclAny))" -assumes [simp]: "(\<lambda>_. \<lfloor>(OclAny ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))))\<rfloor>) = ((((\<lambda>_. \<lfloor>\<lfloor>X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)::\<cdot>Person)) .oclAsType(OclAny))" -assumes [simp]: "(\<lambda>_. \<lfloor>(OclAny ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (\<sigma>\<^sub>1_object4\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))))\<rfloor>) = ((((\<lambda>_. \<lfloor>\<lfloor>\<sigma>\<^sub>1_object4\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)::\<cdot>Person)) .oclAsType(OclAny))" -assumes [simp]: "(\<lambda>_. \<lfloor>(OclAny ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))))\<rfloor>) = ((((\<lambda>_. \<lfloor>\<lfloor>X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)::\<cdot>Person)) .oclAsType(OclAny))" -shows "(st , \<sigma>\<^sub>1) \<Turnstile> (OclAllInstances_at_post (OclAny)) \<doteq> Set{\<sigma>\<^sub>1_object0 .oclAsType(OclAny) , \<sigma>\<^sub>1_object1 .oclAsType(OclAny) , \<sigma>\<^sub>1_object2 .oclAsType(OclAny) , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5 .oclAsType(OclAny) , \<sigma>\<^sub>1_object4 .oclAsType(OclAny) , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9 .oclAsType(OclAny)}" - unfolding OclAllInstances_at_post_def -by(rule \<sigma>\<^sub>1_OclAllInstances_generic_exec_OclAny, simp_all only: assms, simp_all) - -lemma \<sigma>\<^sub>1_OclAllInstances_at_pre_exec_OclAny : -assumes [simp]: "(OclAny ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (\<sigma>\<^sub>1_object0\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(OclAny ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (\<sigma>\<^sub>1_object1\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(OclAny ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (\<sigma>\<^sub>1_object2\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(OclAny ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(OclAny ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (\<sigma>\<^sub>1_object4\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(OclAny ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(\<lambda>_. \<lfloor>(OclAny ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (\<sigma>\<^sub>1_object0\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))))\<rfloor>) = ((((\<lambda>_. \<lfloor>\<lfloor>\<sigma>\<^sub>1_object0\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)::\<cdot>Person)) .oclAsType(OclAny))" -assumes [simp]: "(\<lambda>_. \<lfloor>(OclAny ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (\<sigma>\<^sub>1_object1\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))))\<rfloor>) = ((((\<lambda>_. \<lfloor>\<lfloor>\<sigma>\<^sub>1_object1\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)::\<cdot>Person)) .oclAsType(OclAny))" -assumes [simp]: "(\<lambda>_. \<lfloor>(OclAny ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (\<sigma>\<^sub>1_object2\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))))\<rfloor>) = ((((\<lambda>_. \<lfloor>\<lfloor>\<sigma>\<^sub>1_object2\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)::\<cdot>Person)) .oclAsType(OclAny))" -assumes [simp]: "(\<lambda>_. \<lfloor>(OclAny ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))))\<rfloor>) = ((((\<lambda>_. \<lfloor>\<lfloor>X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)::\<cdot>Person)) .oclAsType(OclAny))" -assumes [simp]: "(\<lambda>_. \<lfloor>(OclAny ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (\<sigma>\<^sub>1_object4\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))))\<rfloor>) = ((((\<lambda>_. \<lfloor>\<lfloor>\<sigma>\<^sub>1_object4\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)::\<cdot>Person)) .oclAsType(OclAny))" -assumes [simp]: "(\<lambda>_. \<lfloor>(OclAny ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))))\<rfloor>) = ((((\<lambda>_. \<lfloor>\<lfloor>X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)::\<cdot>Person)) .oclAsType(OclAny))" -shows "(\<sigma>\<^sub>1 , st) \<Turnstile> (OclAllInstances_at_pre (OclAny)) \<doteq> Set{\<sigma>\<^sub>1_object0 .oclAsType(OclAny) , \<sigma>\<^sub>1_object1 .oclAsType(OclAny) , \<sigma>\<^sub>1_object2 .oclAsType(OclAny) , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5 .oclAsType(OclAny) , \<sigma>\<^sub>1_object4 .oclAsType(OclAny) , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9 .oclAsType(OclAny)}" - unfolding OclAllInstances_at_pre_def -by(rule \<sigma>\<^sub>1_OclAllInstances_generic_exec_OclAny, simp_all only: assms, simp_all) - -ML \<open>(Ty'.check ([]) (" error(s)"))\<close> -end - -(* 158 ************************************ 964 + 1 *) (* term Floor2_examp.print_examp_def_st_def_interp *) -definition "(state_interpretation_\<sigma>\<^sub>1 (\<tau>)) = (state_\<sigma>\<^sub>1 (oid1) (oid2) (oid4) (oid5) (oid6) (oid9) (\<lceil>\<lceil>(\<sigma>\<^sub>1_object0 (\<tau>))\<rceil>\<rceil>) (\<sigma>\<^sub>1_object0) (\<lceil>\<lceil>(\<sigma>\<^sub>1_object1 (\<tau>))\<rceil>\<rceil>) (\<sigma>\<^sub>1_object1) (\<lceil>\<lceil>(\<sigma>\<^sub>1_object2 (\<tau>))\<rceil>\<rceil>) (\<sigma>\<^sub>1_object2) (\<lceil>\<lceil>(X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5 (\<tau>))\<rceil>\<rceil>) (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5) (\<lceil>\<lceil>(\<sigma>\<^sub>1_object4 (\<tau>))\<rceil>\<rceil>) (\<sigma>\<^sub>1_object4) (\<lceil>\<lceil>(X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9 (\<tau>))\<rceil>\<rceil>) (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9))" - -(* 159 ************************************ 965 + 1 *) -section \<open>State (Floor 2)\<close> - -(* 160 ************************************ 966 + 1 *) -locale state_\<sigma>\<^sub>1' = -fixes "oid1" :: "nat" -fixes "oid2" :: "nat" -fixes "oid3" :: "nat" -fixes "oid4" :: "nat" -fixes "oid6" :: "nat" -fixes "oid7" :: "nat" -fixes "oid8" :: "nat" -fixes "oid9" :: "nat" -assumes distinct_oid: "(distinct ([oid1 , oid2 , oid3 , oid4 , oid6 , oid7 , oid8 , oid9]))" -fixes "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n" :: "ty\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n" -fixes "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1" :: "\<cdot>Person" -assumes X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1_def: "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1 = (\<lambda>_. \<lfloor>\<lfloor>X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)" -fixes "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n" :: "ty\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n" -fixes "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2" :: "\<cdot>Person" -assumes X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2_def: "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2 = (\<lambda>_. \<lfloor>\<lfloor>X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)" -fixes "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n" :: "ty\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n" -fixes "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3" :: "\<cdot>Person" -assumes X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3_def: "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3 = (\<lambda>_. \<lfloor>\<lfloor>X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)" -fixes "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n" :: "ty\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n" -fixes "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4" :: "\<cdot>Person" -assumes X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4_def: "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4 = (\<lambda>_. \<lfloor>\<lfloor>X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)" -fixes "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n" :: "ty\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n" -fixes "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6" :: "\<cdot>Person" -assumes X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6_def: "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6 = (\<lambda>_. \<lfloor>\<lfloor>X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)" -fixes "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y" :: "ty\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y" -fixes "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7" :: "\<cdot>OclAny" -assumes X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7_def: "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7 = (\<lambda>_. \<lfloor>\<lfloor>X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y\<rfloor>\<rfloor>)" -fixes "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n8\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y" :: "ty\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y" -fixes "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n8" :: "\<cdot>OclAny" -assumes X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n8_def: "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n8 = (\<lambda>_. \<lfloor>\<lfloor>X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n8\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y\<rfloor>\<rfloor>)" -fixes "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n" :: "ty\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n" -fixes "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9" :: "\<cdot>Person" -assumes X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9_def: "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9 = (\<lambda>_. \<lfloor>\<lfloor>X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)" -begin -definition "\<sigma>\<^sub>1' = (state.make ((Map.empty (oid1 \<mapsto> (in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))) (oid2 \<mapsto> (in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))) (oid3 \<mapsto> (in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))) (oid4 \<mapsto> (in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))) (oid6 \<mapsto> (in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))) (oid7 \<mapsto> (in\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y))) (oid8 \<mapsto> (in\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n8\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y))) (oid9 \<mapsto> (in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))))) ((map_of_list ([(oid\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_0___boss , (List.map ((\<lambda>(x , y). [x , y]) o switch\<^sub>2_01) ([[[oid1] , [oid2]] , [[oid2] , [oid2]] , [[oid6] , [oid7]] , [[oid7] , [oid7]]])))]))))" - -lemma dom_\<sigma>\<^sub>1' : "(dom ((heap (\<sigma>\<^sub>1')))) = {oid1 , oid2 , oid3 , oid4 , oid6 , oid7 , oid8 , oid9}" -by(auto simp: \<sigma>\<^sub>1'_def) - -lemmas[simp,code_unfold] = dom_\<sigma>\<^sub>1' - -lemma perm_\<sigma>\<^sub>1' : "\<sigma>\<^sub>1' = (state.make ((Map.empty (oid9 \<mapsto> (in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))) (oid8 \<mapsto> (in\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n8\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y))) (oid7 \<mapsto> (in\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y))) (oid6 \<mapsto> (in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))) (oid4 \<mapsto> (in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))) (oid3 \<mapsto> (in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))) (oid2 \<mapsto> (in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))) (oid1 \<mapsto> (in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))))) ((assocs (\<sigma>\<^sub>1'))))" - apply(simp add: \<sigma>\<^sub>1'_def) - apply(subst (1) fun_upd_twist, metis distinct_oid distinct_length_2_or_more) - apply(subst (2) fun_upd_twist, metis distinct_oid distinct_length_2_or_more) - apply(subst (1) fun_upd_twist, metis distinct_oid distinct_length_2_or_more) - apply(subst (3) fun_upd_twist, metis distinct_oid distinct_length_2_or_more) - apply(subst (2) fun_upd_twist, metis distinct_oid distinct_length_2_or_more) - apply(subst (1) fun_upd_twist, metis distinct_oid distinct_length_2_or_more) - apply(subst (4) fun_upd_twist, metis distinct_oid distinct_length_2_or_more) - apply(subst (3) fun_upd_twist, metis distinct_oid distinct_length_2_or_more) - apply(subst (2) fun_upd_twist, metis distinct_oid distinct_length_2_or_more) - apply(subst (1) fun_upd_twist, metis distinct_oid distinct_length_2_or_more) - apply(subst (5) fun_upd_twist, metis distinct_oid distinct_length_2_or_more) - apply(subst (4) fun_upd_twist, metis distinct_oid distinct_length_2_or_more) - apply(subst (3) fun_upd_twist, metis distinct_oid distinct_length_2_or_more) - apply(subst (2) fun_upd_twist, metis distinct_oid distinct_length_2_or_more) - apply(subst (1) fun_upd_twist, metis distinct_oid distinct_length_2_or_more) - apply(subst (6) fun_upd_twist, metis distinct_oid distinct_length_2_or_more) - apply(subst (5) fun_upd_twist, metis distinct_oid distinct_length_2_or_more) - apply(subst (4) fun_upd_twist, metis distinct_oid distinct_length_2_or_more) - apply(subst (3) fun_upd_twist, metis distinct_oid distinct_length_2_or_more) - apply(subst (2) fun_upd_twist, metis distinct_oid distinct_length_2_or_more) - apply(subst (1) fun_upd_twist, metis distinct_oid distinct_length_2_or_more) - apply(subst (7) fun_upd_twist, metis distinct_oid distinct_length_2_or_more) - apply(subst (6) fun_upd_twist, metis distinct_oid distinct_length_2_or_more) - apply(subst (5) fun_upd_twist, metis distinct_oid distinct_length_2_or_more) - apply(subst (4) fun_upd_twist, metis distinct_oid distinct_length_2_or_more) - apply(subst (3) fun_upd_twist, metis distinct_oid distinct_length_2_or_more) - apply(subst (2) fun_upd_twist, metis distinct_oid distinct_length_2_or_more) - apply(subst (1) fun_upd_twist, metis distinct_oid distinct_length_2_or_more) -by(simp) - -lemma \<sigma>\<^sub>1'_OclAllInstances_generic_exec_Person : -assumes [simp]: "(Person ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(Person ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(Person ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(Person ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(Person ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(Person ((in\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y)))) \<noteq> None" -assumes [simp]: "(Person ((in\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n8\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y)))) = None" -assumes [simp]: "(Person ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(\<lambda>_. \<lfloor>(Person ((in\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y))))\<rfloor>) = ((((\<lambda>_. \<lfloor>\<lfloor>X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y\<rfloor>\<rfloor>)::\<cdot>OclAny)) .oclAsType(Person))" -assumes [simp]: "(\<And>a. (pre_post ((mk (a)))) = a)" -shows "(mk (\<sigma>\<^sub>1')) \<Turnstile> (OclAllInstances_generic (pre_post) (Person)) \<doteq> Set{X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1 , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2 , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3 , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4 , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6 , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7 .oclAsType(Person) , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9}" - apply(subst perm_\<sigma>\<^sub>1') - apply(simp only: state.make_def X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1_def X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2_def X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3_def X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4_def X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6_def X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7_def X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9_def) - apply(subst state_update_vs_allInstances_generic_tc, simp, simp, (metis distinct_oid distinct_length_2_or_more)?, simp only: assms, blast, simp, rule const_StrictRefEq\<^sub>S\<^sub>e\<^sub>t_including, simp del: OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny, simp del: OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny, simp, rule OclIncluding_cong, (simp only: assms[symmetric ])?, simp add: valid_def OclValid_def bot_fun_def bot_option_def, (simp only: assms[symmetric ])?, simp add: valid_def OclValid_def bot_fun_def bot_option_def) - apply(subst state_update_vs_allInstances_generic_tc, simp, simp, (metis distinct_oid distinct_length_2_or_more)?, simp only: assms, blast, simp, rule const_StrictRefEq\<^sub>S\<^sub>e\<^sub>t_including, simp del: OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny, simp del: OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny, simp, rule OclIncluding_cong, (simp only: assms[symmetric ])?, simp add: valid_def OclValid_def bot_fun_def bot_option_def, (simp only: assms[symmetric ])?, simp add: valid_def OclValid_def bot_fun_def bot_option_def) - apply(subst state_update_vs_allInstances_generic_tc, simp, simp, (metis distinct_oid distinct_length_2_or_more)?, simp only: assms, blast, simp, rule const_StrictRefEq\<^sub>S\<^sub>e\<^sub>t_including, simp del: OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny, simp del: OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny, simp, rule OclIncluding_cong, (simp only: assms[symmetric ])?, simp add: valid_def OclValid_def bot_fun_def bot_option_def, (simp only: assms[symmetric ])?, simp add: valid_def OclValid_def bot_fun_def bot_option_def) - apply(subst state_update_vs_allInstances_generic_tc, simp, simp, (metis distinct_oid distinct_length_2_or_more)?, simp only: assms, blast, simp, rule const_StrictRefEq\<^sub>S\<^sub>e\<^sub>t_including, simp del: OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny, simp del: OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny, simp, rule OclIncluding_cong, (simp only: assms[symmetric ])?, simp add: valid_def OclValid_def bot_fun_def bot_option_def, (simp only: assms[symmetric ])?, simp add: valid_def OclValid_def bot_fun_def bot_option_def) - apply(subst state_update_vs_allInstances_generic_tc, simp, simp, (metis distinct_oid distinct_length_2_or_more)?, simp only: assms, blast, simp, rule const_StrictRefEq\<^sub>S\<^sub>e\<^sub>t_including, simp del: OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny, simp del: OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny, simp, rule OclIncluding_cong, (simp only: assms[symmetric ])?, simp add: valid_def OclValid_def bot_fun_def bot_option_def, (simp only: assms[symmetric ])?, simp add: valid_def OclValid_def bot_fun_def bot_option_def) - apply(subst state_update_vs_allInstances_generic_tc, simp, simp, (metis distinct_oid distinct_length_2_or_more)?, simp only: assms, blast, simp, rule const_StrictRefEq\<^sub>S\<^sub>e\<^sub>t_including, simp del: OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny, simp del: OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny, simp, rule OclIncluding_cong, (simp only: assms[symmetric ])?, simp add: valid_def OclValid_def bot_fun_def bot_option_def, (simp only: assms[symmetric ])?, simp add: valid_def OclValid_def bot_fun_def bot_option_def) - apply(subst state_update_vs_allInstances_generic_ntc, simp, simp, (metis distinct_oid distinct_length_2_or_more)?, simp only: assms, simp, rule const_StrictRefEq\<^sub>S\<^sub>e\<^sub>t_including, simp del: OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny, simp del: OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny, simp) - apply(subst state_update_vs_allInstances_generic_tc, simp, simp, (metis distinct_oid distinct_length_2_or_more)?, simp only: assms, blast, simp, rule const_StrictRefEq\<^sub>S\<^sub>e\<^sub>t_including, simp del: OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny, simp del: OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny, simp, rule OclIncluding_cong, (simp only: assms[symmetric ])?, simp add: valid_def OclValid_def bot_fun_def bot_option_def, (simp only: assms[symmetric ])?, simp add: valid_def OclValid_def bot_fun_def bot_option_def) - apply(rule state_update_vs_allInstances_generic_empty) -by(simp_all only: assms, (simp_all add: OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_\<AA>_def)?) - -lemma \<sigma>\<^sub>1'_OclAllInstances_at_post_exec_Person : -assumes [simp]: "(Person ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(Person ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(Person ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(Person ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(Person ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(Person ((in\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y)))) \<noteq> None" -assumes [simp]: "(Person ((in\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n8\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y)))) = None" -assumes [simp]: "(Person ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(\<lambda>_. \<lfloor>(Person ((in\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y))))\<rfloor>) = ((((\<lambda>_. \<lfloor>\<lfloor>X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y\<rfloor>\<rfloor>)::\<cdot>OclAny)) .oclAsType(Person))" -shows "(st , \<sigma>\<^sub>1') \<Turnstile> (OclAllInstances_at_post (Person)) \<doteq> Set{X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1 , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2 , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3 , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4 , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6 , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7 .oclAsType(Person) , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9}" - unfolding OclAllInstances_at_post_def -by(rule \<sigma>\<^sub>1'_OclAllInstances_generic_exec_Person, simp_all only: assms, simp_all) - -lemma \<sigma>\<^sub>1'_OclAllInstances_at_pre_exec_Person : -assumes [simp]: "(Person ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(Person ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(Person ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(Person ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(Person ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(Person ((in\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y)))) \<noteq> None" -assumes [simp]: "(Person ((in\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n8\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y)))) = None" -assumes [simp]: "(Person ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(\<lambda>_. \<lfloor>(Person ((in\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y))))\<rfloor>) = ((((\<lambda>_. \<lfloor>\<lfloor>X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y\<rfloor>\<rfloor>)::\<cdot>OclAny)) .oclAsType(Person))" -shows "(\<sigma>\<^sub>1' , st) \<Turnstile> (OclAllInstances_at_pre (Person)) \<doteq> Set{X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1 , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2 , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3 , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4 , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6 , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7 .oclAsType(Person) , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9}" - unfolding OclAllInstances_at_pre_def -by(rule \<sigma>\<^sub>1'_OclAllInstances_generic_exec_Person, simp_all only: assms, simp_all) - -lemma \<sigma>\<^sub>1'_OclAllInstances_generic_exec_Planet : -assumes [simp]: "(Planet ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(Planet ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(Planet ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(Planet ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(Planet ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(Planet ((in\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y)))) = None" -assumes [simp]: "(Planet ((in\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n8\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y)))) = None" -assumes [simp]: "(Planet ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(\<lambda>_. \<lfloor>(Planet ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))))\<rfloor>) = ((((\<lambda>_. \<lfloor>\<lfloor>X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)::\<cdot>Person)) .oclAsType(Planet))" -assumes [simp]: "(\<lambda>_. \<lfloor>(Planet ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))))\<rfloor>) = ((((\<lambda>_. \<lfloor>\<lfloor>X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)::\<cdot>Person)) .oclAsType(Planet))" -assumes [simp]: "(\<lambda>_. \<lfloor>(Planet ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))))\<rfloor>) = ((((\<lambda>_. \<lfloor>\<lfloor>X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)::\<cdot>Person)) .oclAsType(Planet))" -assumes [simp]: "(\<lambda>_. \<lfloor>(Planet ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))))\<rfloor>) = ((((\<lambda>_. \<lfloor>\<lfloor>X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)::\<cdot>Person)) .oclAsType(Planet))" -assumes [simp]: "(\<lambda>_. \<lfloor>(Planet ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))))\<rfloor>) = ((((\<lambda>_. \<lfloor>\<lfloor>X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)::\<cdot>Person)) .oclAsType(Planet))" -assumes [simp]: "(\<lambda>_. \<lfloor>(Planet ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))))\<rfloor>) = ((((\<lambda>_. \<lfloor>\<lfloor>X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)::\<cdot>Person)) .oclAsType(Planet))" -assumes [simp]: "(\<And>a. (pre_post ((mk (a)))) = a)" -shows "(mk (\<sigma>\<^sub>1')) \<Turnstile> (OclAllInstances_generic (pre_post) (Planet)) \<doteq> Set{X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1 .oclAsType(Planet) , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2 .oclAsType(Planet) , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3 .oclAsType(Planet) , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4 .oclAsType(Planet) , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6 .oclAsType(Planet) , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9 .oclAsType(Planet)}" - apply(subst perm_\<sigma>\<^sub>1') - apply(simp only: state.make_def X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1_def X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2_def X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3_def X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4_def X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6_def X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9_def) - apply(subst state_update_vs_allInstances_generic_tc, simp, simp, (metis distinct_oid distinct_length_2_or_more)?, simp only: assms, blast, simp, rule const_StrictRefEq\<^sub>S\<^sub>e\<^sub>t_including, simp del: OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person, simp del: OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person, simp, rule OclIncluding_cong, (simp only: assms[symmetric ])?, simp add: valid_def OclValid_def bot_fun_def bot_option_def, (simp only: assms[symmetric ])?, simp add: valid_def OclValid_def bot_fun_def bot_option_def) - apply(subst state_update_vs_allInstances_generic_tc, simp, simp, (metis distinct_oid distinct_length_2_or_more)?, simp only: assms, blast, simp, rule const_StrictRefEq\<^sub>S\<^sub>e\<^sub>t_including, simp del: OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person, simp del: OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person, simp, rule OclIncluding_cong, (simp only: assms[symmetric ])?, simp add: valid_def OclValid_def bot_fun_def bot_option_def, (simp only: assms[symmetric ])?, simp add: valid_def OclValid_def bot_fun_def bot_option_def) - apply(subst state_update_vs_allInstances_generic_tc, simp, simp, (metis distinct_oid distinct_length_2_or_more)?, simp only: assms, blast, simp, rule const_StrictRefEq\<^sub>S\<^sub>e\<^sub>t_including, simp del: OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person, simp del: OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person, simp, rule OclIncluding_cong, (simp only: assms[symmetric ])?, simp add: valid_def OclValid_def bot_fun_def bot_option_def, (simp only: assms[symmetric ])?, simp add: valid_def OclValid_def bot_fun_def bot_option_def) - apply(subst state_update_vs_allInstances_generic_tc, simp, simp, (metis distinct_oid distinct_length_2_or_more)?, simp only: assms, blast, simp, rule const_StrictRefEq\<^sub>S\<^sub>e\<^sub>t_including, simp del: OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person, simp del: OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person, simp, rule OclIncluding_cong, (simp only: assms[symmetric ])?, simp add: valid_def OclValid_def bot_fun_def bot_option_def, (simp only: assms[symmetric ])?, simp add: valid_def OclValid_def bot_fun_def bot_option_def) - apply(subst state_update_vs_allInstances_generic_tc, simp, simp, (metis distinct_oid distinct_length_2_or_more)?, simp only: assms, blast, simp, rule const_StrictRefEq\<^sub>S\<^sub>e\<^sub>t_including, simp del: OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person, simp del: OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person, simp, rule OclIncluding_cong, (simp only: assms[symmetric ])?, simp add: valid_def OclValid_def bot_fun_def bot_option_def, (simp only: assms[symmetric ])?, simp add: valid_def OclValid_def bot_fun_def bot_option_def) - apply(subst state_update_vs_allInstances_generic_ntc, simp, simp, (metis distinct_oid distinct_length_2_or_more)?, simp only: assms, simp, rule const_StrictRefEq\<^sub>S\<^sub>e\<^sub>t_including, simp del: OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person, simp del: OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person, simp) - apply(subst state_update_vs_allInstances_generic_ntc, simp, simp, (metis distinct_oid distinct_length_2_or_more)?, simp only: assms, simp, rule const_StrictRefEq\<^sub>S\<^sub>e\<^sub>t_including, simp del: OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person, simp del: OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person, simp) - apply(subst state_update_vs_allInstances_generic_tc, simp, simp, (metis distinct_oid distinct_length_2_or_more)?, simp only: assms, blast, simp, rule const_StrictRefEq\<^sub>S\<^sub>e\<^sub>t_including, simp del: OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person, simp del: OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_Person, simp, rule OclIncluding_cong, (simp only: assms[symmetric ])?, simp add: valid_def OclValid_def bot_fun_def bot_option_def, (simp only: assms[symmetric ])?, simp add: valid_def OclValid_def bot_fun_def bot_option_def) - apply(rule state_update_vs_allInstances_generic_empty) -by(simp_all only: assms, (simp_all add: OclAsType\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_\<AA>_def)?) - -lemma \<sigma>\<^sub>1'_OclAllInstances_at_post_exec_Planet : -assumes [simp]: "(Planet ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(Planet ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(Planet ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(Planet ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(Planet ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(Planet ((in\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y)))) = None" -assumes [simp]: "(Planet ((in\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n8\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y)))) = None" -assumes [simp]: "(Planet ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(\<lambda>_. \<lfloor>(Planet ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))))\<rfloor>) = ((((\<lambda>_. \<lfloor>\<lfloor>X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)::\<cdot>Person)) .oclAsType(Planet))" -assumes [simp]: "(\<lambda>_. \<lfloor>(Planet ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))))\<rfloor>) = ((((\<lambda>_. \<lfloor>\<lfloor>X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)::\<cdot>Person)) .oclAsType(Planet))" -assumes [simp]: "(\<lambda>_. \<lfloor>(Planet ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))))\<rfloor>) = ((((\<lambda>_. \<lfloor>\<lfloor>X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)::\<cdot>Person)) .oclAsType(Planet))" -assumes [simp]: "(\<lambda>_. \<lfloor>(Planet ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))))\<rfloor>) = ((((\<lambda>_. \<lfloor>\<lfloor>X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)::\<cdot>Person)) .oclAsType(Planet))" -assumes [simp]: "(\<lambda>_. \<lfloor>(Planet ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))))\<rfloor>) = ((((\<lambda>_. \<lfloor>\<lfloor>X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)::\<cdot>Person)) .oclAsType(Planet))" -assumes [simp]: "(\<lambda>_. \<lfloor>(Planet ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))))\<rfloor>) = ((((\<lambda>_. \<lfloor>\<lfloor>X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)::\<cdot>Person)) .oclAsType(Planet))" -shows "(st , \<sigma>\<^sub>1') \<Turnstile> (OclAllInstances_at_post (Planet)) \<doteq> Set{X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1 .oclAsType(Planet) , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2 .oclAsType(Planet) , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3 .oclAsType(Planet) , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4 .oclAsType(Planet) , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6 .oclAsType(Planet) , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9 .oclAsType(Planet)}" - unfolding OclAllInstances_at_post_def -by(rule \<sigma>\<^sub>1'_OclAllInstances_generic_exec_Planet, simp_all only: assms, simp_all) - -lemma \<sigma>\<^sub>1'_OclAllInstances_at_pre_exec_Planet : -assumes [simp]: "(Planet ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(Planet ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(Planet ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(Planet ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(Planet ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(Planet ((in\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y)))) = None" -assumes [simp]: "(Planet ((in\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n8\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y)))) = None" -assumes [simp]: "(Planet ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(\<lambda>_. \<lfloor>(Planet ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))))\<rfloor>) = ((((\<lambda>_. \<lfloor>\<lfloor>X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)::\<cdot>Person)) .oclAsType(Planet))" -assumes [simp]: "(\<lambda>_. \<lfloor>(Planet ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))))\<rfloor>) = ((((\<lambda>_. \<lfloor>\<lfloor>X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)::\<cdot>Person)) .oclAsType(Planet))" -assumes [simp]: "(\<lambda>_. \<lfloor>(Planet ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))))\<rfloor>) = ((((\<lambda>_. \<lfloor>\<lfloor>X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)::\<cdot>Person)) .oclAsType(Planet))" -assumes [simp]: "(\<lambda>_. \<lfloor>(Planet ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))))\<rfloor>) = ((((\<lambda>_. \<lfloor>\<lfloor>X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)::\<cdot>Person)) .oclAsType(Planet))" -assumes [simp]: "(\<lambda>_. \<lfloor>(Planet ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))))\<rfloor>) = ((((\<lambda>_. \<lfloor>\<lfloor>X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)::\<cdot>Person)) .oclAsType(Planet))" -assumes [simp]: "(\<lambda>_. \<lfloor>(Planet ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))))\<rfloor>) = ((((\<lambda>_. \<lfloor>\<lfloor>X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)::\<cdot>Person)) .oclAsType(Planet))" -shows "(\<sigma>\<^sub>1' , st) \<Turnstile> (OclAllInstances_at_pre (Planet)) \<doteq> Set{X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1 .oclAsType(Planet) , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2 .oclAsType(Planet) , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3 .oclAsType(Planet) , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4 .oclAsType(Planet) , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6 .oclAsType(Planet) , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9 .oclAsType(Planet)}" - unfolding OclAllInstances_at_pre_def -by(rule \<sigma>\<^sub>1'_OclAllInstances_generic_exec_Planet, simp_all only: assms, simp_all) - -lemma \<sigma>\<^sub>1'_OclAllInstances_generic_exec_Galaxy : -assumes [simp]: "(Galaxy ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(Galaxy ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(Galaxy ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(Galaxy ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(Galaxy ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(Galaxy ((in\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y)))) = None" -assumes [simp]: "(Galaxy ((in\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n8\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y)))) = None" -assumes [simp]: "(Galaxy ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(\<lambda>_. \<lfloor>(Galaxy ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))))\<rfloor>) = ((((\<lambda>_. \<lfloor>\<lfloor>X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)::\<cdot>Person)) .oclAsType(Galaxy))" -assumes [simp]: "(\<lambda>_. \<lfloor>(Galaxy ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))))\<rfloor>) = ((((\<lambda>_. \<lfloor>\<lfloor>X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)::\<cdot>Person)) .oclAsType(Galaxy))" -assumes [simp]: "(\<lambda>_. \<lfloor>(Galaxy ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))))\<rfloor>) = ((((\<lambda>_. \<lfloor>\<lfloor>X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)::\<cdot>Person)) .oclAsType(Galaxy))" -assumes [simp]: "(\<lambda>_. \<lfloor>(Galaxy ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))))\<rfloor>) = ((((\<lambda>_. \<lfloor>\<lfloor>X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)::\<cdot>Person)) .oclAsType(Galaxy))" -assumes [simp]: "(\<lambda>_. \<lfloor>(Galaxy ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))))\<rfloor>) = ((((\<lambda>_. \<lfloor>\<lfloor>X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)::\<cdot>Person)) .oclAsType(Galaxy))" -assumes [simp]: "(\<lambda>_. \<lfloor>(Galaxy ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))))\<rfloor>) = ((((\<lambda>_. \<lfloor>\<lfloor>X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)::\<cdot>Person)) .oclAsType(Galaxy))" -assumes [simp]: "(\<And>a. (pre_post ((mk (a)))) = a)" -shows "(mk (\<sigma>\<^sub>1')) \<Turnstile> (OclAllInstances_generic (pre_post) (Galaxy)) \<doteq> Set{X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1 .oclAsType(Galaxy) , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2 .oclAsType(Galaxy) , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3 .oclAsType(Galaxy) , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4 .oclAsType(Galaxy) , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6 .oclAsType(Galaxy) , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9 .oclAsType(Galaxy)}" - apply(subst perm_\<sigma>\<^sub>1') - apply(simp only: state.make_def X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1_def X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2_def X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3_def X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4_def X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6_def X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9_def) - apply(subst state_update_vs_allInstances_generic_tc, simp, simp, (metis distinct_oid distinct_length_2_or_more)?, simp only: assms, blast, simp, rule const_StrictRefEq\<^sub>S\<^sub>e\<^sub>t_including, simp del: OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person, simp del: OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person, simp, rule OclIncluding_cong, (simp only: assms[symmetric ])?, simp add: valid_def OclValid_def bot_fun_def bot_option_def, (simp only: assms[symmetric ])?, simp add: valid_def OclValid_def bot_fun_def bot_option_def) - apply(subst state_update_vs_allInstances_generic_tc, simp, simp, (metis distinct_oid distinct_length_2_or_more)?, simp only: assms, blast, simp, rule const_StrictRefEq\<^sub>S\<^sub>e\<^sub>t_including, simp del: OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person, simp del: OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person, simp, rule OclIncluding_cong, (simp only: assms[symmetric ])?, simp add: valid_def OclValid_def bot_fun_def bot_option_def, (simp only: assms[symmetric ])?, simp add: valid_def OclValid_def bot_fun_def bot_option_def) - apply(subst state_update_vs_allInstances_generic_tc, simp, simp, (metis distinct_oid distinct_length_2_or_more)?, simp only: assms, blast, simp, rule const_StrictRefEq\<^sub>S\<^sub>e\<^sub>t_including, simp del: OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person, simp del: OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person, simp, rule OclIncluding_cong, (simp only: assms[symmetric ])?, simp add: valid_def OclValid_def bot_fun_def bot_option_def, (simp only: assms[symmetric ])?, simp add: valid_def OclValid_def bot_fun_def bot_option_def) - apply(subst state_update_vs_allInstances_generic_tc, simp, simp, (metis distinct_oid distinct_length_2_or_more)?, simp only: assms, blast, simp, rule const_StrictRefEq\<^sub>S\<^sub>e\<^sub>t_including, simp del: OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person, simp del: OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person, simp, rule OclIncluding_cong, (simp only: assms[symmetric ])?, simp add: valid_def OclValid_def bot_fun_def bot_option_def, (simp only: assms[symmetric ])?, simp add: valid_def OclValid_def bot_fun_def bot_option_def) - apply(subst state_update_vs_allInstances_generic_tc, simp, simp, (metis distinct_oid distinct_length_2_or_more)?, simp only: assms, blast, simp, rule const_StrictRefEq\<^sub>S\<^sub>e\<^sub>t_including, simp del: OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person, simp del: OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person, simp, rule OclIncluding_cong, (simp only: assms[symmetric ])?, simp add: valid_def OclValid_def bot_fun_def bot_option_def, (simp only: assms[symmetric ])?, simp add: valid_def OclValid_def bot_fun_def bot_option_def) - apply(subst state_update_vs_allInstances_generic_ntc, simp, simp, (metis distinct_oid distinct_length_2_or_more)?, simp only: assms, simp, rule const_StrictRefEq\<^sub>S\<^sub>e\<^sub>t_including, simp del: OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person, simp del: OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person, simp) - apply(subst state_update_vs_allInstances_generic_ntc, simp, simp, (metis distinct_oid distinct_length_2_or_more)?, simp only: assms, simp, rule const_StrictRefEq\<^sub>S\<^sub>e\<^sub>t_including, simp del: OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person, simp del: OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person, simp) - apply(subst state_update_vs_allInstances_generic_tc, simp, simp, (metis distinct_oid distinct_length_2_or_more)?, simp only: assms, blast, simp, rule const_StrictRefEq\<^sub>S\<^sub>e\<^sub>t_including, simp del: OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person, simp del: OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_Person, simp, rule OclIncluding_cong, (simp only: assms[symmetric ])?, simp add: valid_def OclValid_def bot_fun_def bot_option_def, (simp only: assms[symmetric ])?, simp add: valid_def OclValid_def bot_fun_def bot_option_def) - apply(rule state_update_vs_allInstances_generic_empty) -by(simp_all only: assms, (simp_all add: OclAsType\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_\<AA>_def)?) - -lemma \<sigma>\<^sub>1'_OclAllInstances_at_post_exec_Galaxy : -assumes [simp]: "(Galaxy ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(Galaxy ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(Galaxy ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(Galaxy ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(Galaxy ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(Galaxy ((in\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y)))) = None" -assumes [simp]: "(Galaxy ((in\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n8\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y)))) = None" -assumes [simp]: "(Galaxy ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(\<lambda>_. \<lfloor>(Galaxy ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))))\<rfloor>) = ((((\<lambda>_. \<lfloor>\<lfloor>X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)::\<cdot>Person)) .oclAsType(Galaxy))" -assumes [simp]: "(\<lambda>_. \<lfloor>(Galaxy ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))))\<rfloor>) = ((((\<lambda>_. \<lfloor>\<lfloor>X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)::\<cdot>Person)) .oclAsType(Galaxy))" -assumes [simp]: "(\<lambda>_. \<lfloor>(Galaxy ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))))\<rfloor>) = ((((\<lambda>_. \<lfloor>\<lfloor>X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)::\<cdot>Person)) .oclAsType(Galaxy))" -assumes [simp]: "(\<lambda>_. \<lfloor>(Galaxy ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))))\<rfloor>) = ((((\<lambda>_. \<lfloor>\<lfloor>X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)::\<cdot>Person)) .oclAsType(Galaxy))" -assumes [simp]: "(\<lambda>_. \<lfloor>(Galaxy ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))))\<rfloor>) = ((((\<lambda>_. \<lfloor>\<lfloor>X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)::\<cdot>Person)) .oclAsType(Galaxy))" -assumes [simp]: "(\<lambda>_. \<lfloor>(Galaxy ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))))\<rfloor>) = ((((\<lambda>_. \<lfloor>\<lfloor>X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)::\<cdot>Person)) .oclAsType(Galaxy))" -shows "(st , \<sigma>\<^sub>1') \<Turnstile> (OclAllInstances_at_post (Galaxy)) \<doteq> Set{X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1 .oclAsType(Galaxy) , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2 .oclAsType(Galaxy) , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3 .oclAsType(Galaxy) , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4 .oclAsType(Galaxy) , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6 .oclAsType(Galaxy) , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9 .oclAsType(Galaxy)}" - unfolding OclAllInstances_at_post_def -by(rule \<sigma>\<^sub>1'_OclAllInstances_generic_exec_Galaxy, simp_all only: assms, simp_all) - -lemma \<sigma>\<^sub>1'_OclAllInstances_at_pre_exec_Galaxy : -assumes [simp]: "(Galaxy ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(Galaxy ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(Galaxy ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(Galaxy ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(Galaxy ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(Galaxy ((in\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y)))) = None" -assumes [simp]: "(Galaxy ((in\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n8\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y)))) = None" -assumes [simp]: "(Galaxy ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(\<lambda>_. \<lfloor>(Galaxy ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))))\<rfloor>) = ((((\<lambda>_. \<lfloor>\<lfloor>X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)::\<cdot>Person)) .oclAsType(Galaxy))" -assumes [simp]: "(\<lambda>_. \<lfloor>(Galaxy ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))))\<rfloor>) = ((((\<lambda>_. \<lfloor>\<lfloor>X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)::\<cdot>Person)) .oclAsType(Galaxy))" -assumes [simp]: "(\<lambda>_. \<lfloor>(Galaxy ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))))\<rfloor>) = ((((\<lambda>_. \<lfloor>\<lfloor>X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)::\<cdot>Person)) .oclAsType(Galaxy))" -assumes [simp]: "(\<lambda>_. \<lfloor>(Galaxy ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))))\<rfloor>) = ((((\<lambda>_. \<lfloor>\<lfloor>X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)::\<cdot>Person)) .oclAsType(Galaxy))" -assumes [simp]: "(\<lambda>_. \<lfloor>(Galaxy ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))))\<rfloor>) = ((((\<lambda>_. \<lfloor>\<lfloor>X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)::\<cdot>Person)) .oclAsType(Galaxy))" -assumes [simp]: "(\<lambda>_. \<lfloor>(Galaxy ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))))\<rfloor>) = ((((\<lambda>_. \<lfloor>\<lfloor>X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)::\<cdot>Person)) .oclAsType(Galaxy))" -shows "(\<sigma>\<^sub>1' , st) \<Turnstile> (OclAllInstances_at_pre (Galaxy)) \<doteq> Set{X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1 .oclAsType(Galaxy) , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2 .oclAsType(Galaxy) , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3 .oclAsType(Galaxy) , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4 .oclAsType(Galaxy) , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6 .oclAsType(Galaxy) , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9 .oclAsType(Galaxy)}" - unfolding OclAllInstances_at_pre_def -by(rule \<sigma>\<^sub>1'_OclAllInstances_generic_exec_Galaxy, simp_all only: assms, simp_all) - -lemma \<sigma>\<^sub>1'_OclAllInstances_generic_exec_OclAny : -assumes [simp]: "(OclAny ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(OclAny ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(OclAny ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(OclAny ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(OclAny ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(OclAny ((in\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y)))) \<noteq> None" -assumes [simp]: "(OclAny ((in\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n8\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y)))) \<noteq> None" -assumes [simp]: "(OclAny ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(\<lambda>_. \<lfloor>(OclAny ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))))\<rfloor>) = ((((\<lambda>_. \<lfloor>\<lfloor>X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)::\<cdot>Person)) .oclAsType(OclAny))" -assumes [simp]: "(\<lambda>_. \<lfloor>(OclAny ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))))\<rfloor>) = ((((\<lambda>_. \<lfloor>\<lfloor>X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)::\<cdot>Person)) .oclAsType(OclAny))" -assumes [simp]: "(\<lambda>_. \<lfloor>(OclAny ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))))\<rfloor>) = ((((\<lambda>_. \<lfloor>\<lfloor>X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)::\<cdot>Person)) .oclAsType(OclAny))" -assumes [simp]: "(\<lambda>_. \<lfloor>(OclAny ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))))\<rfloor>) = ((((\<lambda>_. \<lfloor>\<lfloor>X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)::\<cdot>Person)) .oclAsType(OclAny))" -assumes [simp]: "(\<lambda>_. \<lfloor>(OclAny ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))))\<rfloor>) = ((((\<lambda>_. \<lfloor>\<lfloor>X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)::\<cdot>Person)) .oclAsType(OclAny))" -assumes [simp]: "(\<lambda>_. \<lfloor>(OclAny ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))))\<rfloor>) = ((((\<lambda>_. \<lfloor>\<lfloor>X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)::\<cdot>Person)) .oclAsType(OclAny))" -assumes [simp]: "(\<And>a. (pre_post ((mk (a)))) = a)" -shows "(mk (\<sigma>\<^sub>1')) \<Turnstile> (OclAllInstances_generic (pre_post) (OclAny)) \<doteq> Set{X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1 .oclAsType(OclAny) , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2 .oclAsType(OclAny) , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3 .oclAsType(OclAny) , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4 .oclAsType(OclAny) , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6 .oclAsType(OclAny) , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7 , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n8 , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9 .oclAsType(OclAny)}" - apply(subst perm_\<sigma>\<^sub>1') - apply(simp only: state.make_def X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1_def X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2_def X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3_def X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4_def X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6_def X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7_def X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n8_def X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9_def) - apply(subst state_update_vs_allInstances_generic_tc, simp, simp, (metis distinct_oid distinct_length_2_or_more)?, simp only: assms, blast, simp, rule const_StrictRefEq\<^sub>S\<^sub>e\<^sub>t_including, simp del: OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person, simp del: OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person, simp, rule OclIncluding_cong, (simp only: assms[symmetric ])?, simp add: valid_def OclValid_def bot_fun_def bot_option_def, (simp only: assms[symmetric ])?, simp add: valid_def OclValid_def bot_fun_def bot_option_def) - apply(subst state_update_vs_allInstances_generic_tc, simp, simp, (metis distinct_oid distinct_length_2_or_more)?, simp only: assms, blast, simp, rule const_StrictRefEq\<^sub>S\<^sub>e\<^sub>t_including, simp del: OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person, simp del: OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person, simp, rule OclIncluding_cong, (simp only: assms[symmetric ])?, simp add: valid_def OclValid_def bot_fun_def bot_option_def, (simp only: assms[symmetric ])?, simp add: valid_def OclValid_def bot_fun_def bot_option_def) - apply(subst state_update_vs_allInstances_generic_tc, simp, simp, (metis distinct_oid distinct_length_2_or_more)?, simp only: assms, blast, simp, rule const_StrictRefEq\<^sub>S\<^sub>e\<^sub>t_including, simp del: OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person, simp del: OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person, simp, rule OclIncluding_cong, (simp only: assms[symmetric ])?, simp add: valid_def OclValid_def bot_fun_def bot_option_def, (simp only: assms[symmetric ])?, simp add: valid_def OclValid_def bot_fun_def bot_option_def) - apply(subst state_update_vs_allInstances_generic_tc, simp, simp, (metis distinct_oid distinct_length_2_or_more)?, simp only: assms, blast, simp, rule const_StrictRefEq\<^sub>S\<^sub>e\<^sub>t_including, simp del: OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person, simp del: OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person, simp, rule OclIncluding_cong, (simp only: assms[symmetric ])?, simp add: valid_def OclValid_def bot_fun_def bot_option_def, (simp only: assms[symmetric ])?, simp add: valid_def OclValid_def bot_fun_def bot_option_def) - apply(subst state_update_vs_allInstances_generic_tc, simp, simp, (metis distinct_oid distinct_length_2_or_more)?, simp only: assms, blast, simp, rule const_StrictRefEq\<^sub>S\<^sub>e\<^sub>t_including, simp del: OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person, simp del: OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person, simp, rule OclIncluding_cong, (simp only: assms[symmetric ])?, simp add: valid_def OclValid_def bot_fun_def bot_option_def, (simp only: assms[symmetric ])?, simp add: valid_def OclValid_def bot_fun_def bot_option_def) - apply(subst state_update_vs_allInstances_generic_tc, simp, simp, (metis distinct_oid distinct_length_2_or_more)?, simp only: assms, blast, simp, rule const_StrictRefEq\<^sub>S\<^sub>e\<^sub>t_including, simp del: OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person, simp del: OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person, simp, rule OclIncluding_cong, (simp only: assms[symmetric ])?, simp add: valid_def OclValid_def bot_fun_def bot_option_def, (simp only: assms[symmetric ])?, simp add: valid_def OclValid_def bot_fun_def bot_option_def) - apply(subst state_update_vs_allInstances_generic_tc, simp, simp, (metis distinct_oid distinct_length_2_or_more)?, simp only: assms, blast, simp, rule const_StrictRefEq\<^sub>S\<^sub>e\<^sub>t_including, simp del: OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person, simp del: OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person, simp, rule OclIncluding_cong, (simp only: assms[symmetric ])?, simp add: valid_def OclValid_def bot_fun_def bot_option_def, (simp only: assms[symmetric ])?, simp add: valid_def OclValid_def bot_fun_def bot_option_def) - apply(subst state_update_vs_allInstances_generic_tc, simp, simp, (metis distinct_oid distinct_length_2_or_more)?, simp only: assms, blast, simp, rule const_StrictRefEq\<^sub>S\<^sub>e\<^sub>t_including, simp del: OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person, simp del: OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person, simp, rule OclIncluding_cong, (simp only: assms[symmetric ])?, simp add: valid_def OclValid_def bot_fun_def bot_option_def, (simp only: assms[symmetric ])?, simp add: valid_def OclValid_def bot_fun_def bot_option_def) - apply(rule state_update_vs_allInstances_generic_empty) -by(simp_all only: assms, (simp_all add: OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_\<AA>_def)?) - -lemma \<sigma>\<^sub>1'_OclAllInstances_at_post_exec_OclAny : -assumes [simp]: "(OclAny ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(OclAny ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(OclAny ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(OclAny ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(OclAny ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(OclAny ((in\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y)))) \<noteq> None" -assumes [simp]: "(OclAny ((in\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n8\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y)))) \<noteq> None" -assumes [simp]: "(OclAny ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(\<lambda>_. \<lfloor>(OclAny ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))))\<rfloor>) = ((((\<lambda>_. \<lfloor>\<lfloor>X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)::\<cdot>Person)) .oclAsType(OclAny))" -assumes [simp]: "(\<lambda>_. \<lfloor>(OclAny ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))))\<rfloor>) = ((((\<lambda>_. \<lfloor>\<lfloor>X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)::\<cdot>Person)) .oclAsType(OclAny))" -assumes [simp]: "(\<lambda>_. \<lfloor>(OclAny ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))))\<rfloor>) = ((((\<lambda>_. \<lfloor>\<lfloor>X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)::\<cdot>Person)) .oclAsType(OclAny))" -assumes [simp]: "(\<lambda>_. \<lfloor>(OclAny ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))))\<rfloor>) = ((((\<lambda>_. \<lfloor>\<lfloor>X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)::\<cdot>Person)) .oclAsType(OclAny))" -assumes [simp]: "(\<lambda>_. \<lfloor>(OclAny ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))))\<rfloor>) = ((((\<lambda>_. \<lfloor>\<lfloor>X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)::\<cdot>Person)) .oclAsType(OclAny))" -assumes [simp]: "(\<lambda>_. \<lfloor>(OclAny ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))))\<rfloor>) = ((((\<lambda>_. \<lfloor>\<lfloor>X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)::\<cdot>Person)) .oclAsType(OclAny))" -shows "(st , \<sigma>\<^sub>1') \<Turnstile> (OclAllInstances_at_post (OclAny)) \<doteq> Set{X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1 .oclAsType(OclAny) , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2 .oclAsType(OclAny) , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3 .oclAsType(OclAny) , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4 .oclAsType(OclAny) , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6 .oclAsType(OclAny) , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7 , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n8 , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9 .oclAsType(OclAny)}" - unfolding OclAllInstances_at_post_def -by(rule \<sigma>\<^sub>1'_OclAllInstances_generic_exec_OclAny, simp_all only: assms, simp_all) - -lemma \<sigma>\<^sub>1'_OclAllInstances_at_pre_exec_OclAny : -assumes [simp]: "(OclAny ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(OclAny ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(OclAny ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(OclAny ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(OclAny ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(OclAny ((in\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y)))) \<noteq> None" -assumes [simp]: "(OclAny ((in\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n8\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y)))) \<noteq> None" -assumes [simp]: "(OclAny ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) \<noteq> None" -assumes [simp]: "(\<lambda>_. \<lfloor>(OclAny ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))))\<rfloor>) = ((((\<lambda>_. \<lfloor>\<lfloor>X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)::\<cdot>Person)) .oclAsType(OclAny))" -assumes [simp]: "(\<lambda>_. \<lfloor>(OclAny ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))))\<rfloor>) = ((((\<lambda>_. \<lfloor>\<lfloor>X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)::\<cdot>Person)) .oclAsType(OclAny))" -assumes [simp]: "(\<lambda>_. \<lfloor>(OclAny ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))))\<rfloor>) = ((((\<lambda>_. \<lfloor>\<lfloor>X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)::\<cdot>Person)) .oclAsType(OclAny))" -assumes [simp]: "(\<lambda>_. \<lfloor>(OclAny ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))))\<rfloor>) = ((((\<lambda>_. \<lfloor>\<lfloor>X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)::\<cdot>Person)) .oclAsType(OclAny))" -assumes [simp]: "(\<lambda>_. \<lfloor>(OclAny ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))))\<rfloor>) = ((((\<lambda>_. \<lfloor>\<lfloor>X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)::\<cdot>Person)) .oclAsType(OclAny))" -assumes [simp]: "(\<lambda>_. \<lfloor>(OclAny ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))))\<rfloor>) = ((((\<lambda>_. \<lfloor>\<lfloor>X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)::\<cdot>Person)) .oclAsType(OclAny))" -shows "(\<sigma>\<^sub>1' , st) \<Turnstile> (OclAllInstances_at_pre (OclAny)) \<doteq> Set{X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1 .oclAsType(OclAny) , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2 .oclAsType(OclAny) , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3 .oclAsType(OclAny) , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4 .oclAsType(OclAny) , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6 .oclAsType(OclAny) , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7 , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n8 , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9 .oclAsType(OclAny)}" - unfolding OclAllInstances_at_pre_def -by(rule \<sigma>\<^sub>1'_OclAllInstances_generic_exec_OclAny, simp_all only: assms, simp_all) - -ML \<open>(Ty'.check ([]) (" error(s)"))\<close> -end - -(* 161 ************************************ 967 + 1 *) (* term Floor2_examp.print_examp_def_st_def_interp *) -definition "(state_interpretation_\<sigma>\<^sub>1' (\<tau>)) = (state_\<sigma>\<^sub>1' (oid1) (oid2) (oid3) (oid4) (oid6) (oid7) (oid8) (oid9) (\<lceil>\<lceil>(X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1 (\<tau>))\<rceil>\<rceil>) (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1) (\<lceil>\<lceil>(X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2 (\<tau>))\<rceil>\<rceil>) (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2) (\<lceil>\<lceil>(X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3 (\<tau>))\<rceil>\<rceil>) (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3) (\<lceil>\<lceil>(X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4 (\<tau>))\<rceil>\<rceil>) (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4) (\<lceil>\<lceil>(X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6 (\<tau>))\<rceil>\<rceil>) (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6) (\<lceil>\<lceil>(X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7 (\<tau>))\<rceil>\<rceil>) (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7) (\<lceil>\<lceil>(X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n8 (\<tau>))\<rceil>\<rceil>) (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n8) (\<lceil>\<lceil>(X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9 (\<tau>))\<rceil>\<rceil>) (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9))" - -(* 162 ************************************ 968 + 1 *) -section \<open>Transition (Floor 2)\<close> - -(* 163 ************************************ 969 + 1 *) -locale transition_\<sigma>\<^sub>1_\<sigma>\<^sub>1' = -fixes "oid1" :: "nat" -fixes "oid2" :: "nat" -fixes "oid3" :: "nat" -fixes "oid4" :: "nat" -fixes "oid5" :: "nat" -fixes "oid6" :: "nat" -fixes "oid7" :: "nat" -fixes "oid8" :: "nat" -fixes "oid9" :: "nat" -assumes distinct_oid: "(distinct ([oid1 , oid2 , oid3 , oid4 , oid5 , oid6 , oid7 , oid8 , oid9]))" -fixes "\<sigma>\<^sub>1_object0\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n" :: "ty\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n" -fixes "\<sigma>\<^sub>1_object0" :: "\<cdot>Person" -assumes \<sigma>\<^sub>1_object0_def: "\<sigma>\<^sub>1_object0 = (\<lambda>_. \<lfloor>\<lfloor>\<sigma>\<^sub>1_object0\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)" -fixes "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n" :: "ty\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n" -fixes "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1" :: "\<cdot>Person" -assumes X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1_def: "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1 = (\<lambda>_. \<lfloor>\<lfloor>X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)" -fixes "\<sigma>\<^sub>1_object1\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n" :: "ty\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n" -fixes "\<sigma>\<^sub>1_object1" :: "\<cdot>Person" -assumes \<sigma>\<^sub>1_object1_def: "\<sigma>\<^sub>1_object1 = (\<lambda>_. \<lfloor>\<lfloor>\<sigma>\<^sub>1_object1\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)" -fixes "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n" :: "ty\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n" -fixes "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2" :: "\<cdot>Person" -assumes X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2_def: "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2 = (\<lambda>_. \<lfloor>\<lfloor>X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)" -fixes "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n" :: "ty\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n" -fixes "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3" :: "\<cdot>Person" -assumes X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3_def: "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3 = (\<lambda>_. \<lfloor>\<lfloor>X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)" -fixes "\<sigma>\<^sub>1_object2\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n" :: "ty\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n" -fixes "\<sigma>\<^sub>1_object2" :: "\<cdot>Person" -assumes \<sigma>\<^sub>1_object2_def: "\<sigma>\<^sub>1_object2 = (\<lambda>_. \<lfloor>\<lfloor>\<sigma>\<^sub>1_object2\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)" -fixes "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n" :: "ty\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n" -fixes "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4" :: "\<cdot>Person" -assumes X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4_def: "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4 = (\<lambda>_. \<lfloor>\<lfloor>X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)" -fixes "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n" :: "ty\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n" -fixes "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5" :: "\<cdot>Person" -assumes X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5_def: "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5 = (\<lambda>_. \<lfloor>\<lfloor>X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)" -fixes "\<sigma>\<^sub>1_object4\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n" :: "ty\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n" -fixes "\<sigma>\<^sub>1_object4" :: "\<cdot>Person" -assumes \<sigma>\<^sub>1_object4_def: "\<sigma>\<^sub>1_object4 = (\<lambda>_. \<lfloor>\<lfloor>\<sigma>\<^sub>1_object4\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)" -fixes "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n" :: "ty\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n" -fixes "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6" :: "\<cdot>Person" -assumes X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6_def: "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6 = (\<lambda>_. \<lfloor>\<lfloor>X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)" -fixes "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y" :: "ty\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y" -fixes "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7" :: "\<cdot>OclAny" -assumes X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7_def: "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7 = (\<lambda>_. \<lfloor>\<lfloor>X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y\<rfloor>\<rfloor>)" -fixes "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n8\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y" :: "ty\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y" -fixes "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n8" :: "\<cdot>OclAny" -assumes X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n8_def: "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n8 = (\<lambda>_. \<lfloor>\<lfloor>X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n8\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y\<rfloor>\<rfloor>)" -fixes "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n" :: "ty\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n" -fixes "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9" :: "\<cdot>Person" -assumes X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9_def: "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9 = (\<lambda>_. \<lfloor>\<lfloor>X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)" - -assumes \<sigma>\<^sub>1: "(state_\<sigma>\<^sub>1 (oid1) (oid2) (oid4) (oid5) (oid6) (oid9) (\<sigma>\<^sub>1_object0\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n) (\<sigma>\<^sub>1_object0) (\<sigma>\<^sub>1_object1\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n) (\<sigma>\<^sub>1_object1) (\<sigma>\<^sub>1_object2\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n) (\<sigma>\<^sub>1_object2) (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n) (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5) (\<sigma>\<^sub>1_object4\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n) (\<sigma>\<^sub>1_object4) (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n) (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9))" - -assumes \<sigma>\<^sub>1': "(state_\<sigma>\<^sub>1' (oid1) (oid2) (oid3) (oid4) (oid6) (oid7) (oid8) (oid9) (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n) (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1) (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n) (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2) (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n) (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3) (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n) (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4) (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n) (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6) (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y) (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7) (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n8\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y) (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n8) (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n) (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9))" -begin -interpretation state_\<sigma>\<^sub>1: state_\<sigma>\<^sub>1 "oid1" "oid2" "oid4" "oid5" "oid6" "oid9" "\<sigma>\<^sub>1_object0\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n" "\<sigma>\<^sub>1_object0" "\<sigma>\<^sub>1_object1\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n" "\<sigma>\<^sub>1_object1" "\<sigma>\<^sub>1_object2\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n" "\<sigma>\<^sub>1_object2" "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n" "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5" "\<sigma>\<^sub>1_object4\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n" "\<sigma>\<^sub>1_object4" "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n" "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9" -by(rule \<sigma>\<^sub>1) - -interpretation state_\<sigma>\<^sub>1': state_\<sigma>\<^sub>1' "oid1" "oid2" "oid3" "oid4" "oid6" "oid7" "oid8" "oid9" "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n" "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1" "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n" "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2" "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n" "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3" "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n" "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4" "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n" "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6" "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y" "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7" "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n8\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y" "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n8" "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n" "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9" -by(rule \<sigma>\<^sub>1') - -definition "\<sigma>\<^sub>1 = state_\<sigma>\<^sub>1.\<sigma>\<^sub>1" - -definition "\<sigma>\<^sub>1' = state_\<sigma>\<^sub>1'.\<sigma>\<^sub>1'" - -lemma basic_\<sigma>\<^sub>1_\<sigma>\<^sub>1'_wff : -assumes [simp]: "(oid_of ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (\<sigma>\<^sub>1_object0\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) = oid1" -assumes [simp]: "(oid_of ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) = oid1" -assumes [simp]: "(oid_of ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (\<sigma>\<^sub>1_object1\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) = oid2" -assumes [simp]: "(oid_of ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) = oid2" -assumes [simp]: "(oid_of ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) = oid3" -assumes [simp]: "(oid_of ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (\<sigma>\<^sub>1_object2\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) = oid4" -assumes [simp]: "(oid_of ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) = oid4" -assumes [simp]: "(oid_of ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) = oid5" -assumes [simp]: "(oid_of ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (\<sigma>\<^sub>1_object4\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) = oid6" -assumes [simp]: "(oid_of ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) = oid6" -assumes [simp]: "(oid_of ((in\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y)))) = oid7" -assumes [simp]: "(oid_of ((in\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n8\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y)))) = oid8" -assumes [simp]: "(oid_of ((in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)))) = oid9" -shows "(WFF ((state_\<sigma>\<^sub>1.\<sigma>\<^sub>1 , state_\<sigma>\<^sub>1'.\<sigma>\<^sub>1')))" - proof - have [simp]: "oid1 \<noteq> oid2" by(metis distinct_oid distinct_length_2_or_more) show ?thesis - proof - have [simp]: "oid1 \<noteq> oid3" by(metis distinct_oid distinct_length_2_or_more) show ?thesis - proof - have [simp]: "oid1 \<noteq> oid4" by(metis distinct_oid distinct_length_2_or_more) show ?thesis - proof - have [simp]: "oid1 \<noteq> oid5" by(metis distinct_oid distinct_length_2_or_more) show ?thesis - proof - have [simp]: "oid1 \<noteq> oid6" by(metis distinct_oid distinct_length_2_or_more) show ?thesis - proof - have [simp]: "oid1 \<noteq> oid7" by(metis distinct_oid distinct_length_2_or_more) show ?thesis - proof - have [simp]: "oid1 \<noteq> oid8" by(metis distinct_oid distinct_length_2_or_more) show ?thesis - proof - have [simp]: "oid1 \<noteq> oid9" by(metis distinct_oid distinct_length_2_or_more) show ?thesis - proof - have [simp]: "oid2 \<noteq> oid1" by(metis distinct_oid distinct_length_2_or_more) show ?thesis - proof - have [simp]: "oid2 \<noteq> oid3" by(metis distinct_oid distinct_length_2_or_more) show ?thesis - proof - have [simp]: "oid2 \<noteq> oid4" by(metis distinct_oid distinct_length_2_or_more) show ?thesis - proof - have [simp]: "oid2 \<noteq> oid5" by(metis distinct_oid distinct_length_2_or_more) show ?thesis - proof - have [simp]: "oid2 \<noteq> oid6" by(metis distinct_oid distinct_length_2_or_more) show ?thesis - proof - have [simp]: "oid2 \<noteq> oid7" by(metis distinct_oid distinct_length_2_or_more) show ?thesis - proof - have [simp]: "oid2 \<noteq> oid8" by(metis distinct_oid distinct_length_2_or_more) show ?thesis - proof - have [simp]: "oid2 \<noteq> oid9" by(metis distinct_oid distinct_length_2_or_more) show ?thesis - proof - have [simp]: "oid3 \<noteq> oid1" by(metis distinct_oid distinct_length_2_or_more) show ?thesis - proof - have [simp]: "oid3 \<noteq> oid2" by(metis distinct_oid distinct_length_2_or_more) show ?thesis - proof - have [simp]: "oid3 \<noteq> oid4" by(metis distinct_oid distinct_length_2_or_more) show ?thesis - proof - have [simp]: "oid3 \<noteq> oid5" by(metis distinct_oid distinct_length_2_or_more) show ?thesis - proof - have [simp]: "oid3 \<noteq> oid6" by(metis distinct_oid distinct_length_2_or_more) show ?thesis - proof - have [simp]: "oid3 \<noteq> oid7" by(metis distinct_oid distinct_length_2_or_more) show ?thesis - proof - have [simp]: "oid3 \<noteq> oid8" by(metis distinct_oid distinct_length_2_or_more) show ?thesis - proof - have [simp]: "oid3 \<noteq> oid9" by(metis distinct_oid distinct_length_2_or_more) show ?thesis - proof - have [simp]: "oid4 \<noteq> oid1" by(metis distinct_oid distinct_length_2_or_more) show ?thesis - proof - have [simp]: "oid4 \<noteq> oid2" by(metis distinct_oid distinct_length_2_or_more) show ?thesis - proof - have [simp]: "oid4 \<noteq> oid3" by(metis distinct_oid distinct_length_2_or_more) show ?thesis - proof - have [simp]: "oid4 \<noteq> oid5" by(metis distinct_oid distinct_length_2_or_more) show ?thesis - proof - have [simp]: "oid4 \<noteq> oid6" by(metis distinct_oid distinct_length_2_or_more) show ?thesis - proof - have [simp]: "oid4 \<noteq> oid7" by(metis distinct_oid distinct_length_2_or_more) show ?thesis - proof - have [simp]: "oid4 \<noteq> oid8" by(metis distinct_oid distinct_length_2_or_more) show ?thesis - proof - have [simp]: "oid4 \<noteq> oid9" by(metis distinct_oid distinct_length_2_or_more) show ?thesis - proof - have [simp]: "oid5 \<noteq> oid1" by(metis distinct_oid distinct_length_2_or_more) show ?thesis - proof - have [simp]: "oid5 \<noteq> oid2" by(metis distinct_oid distinct_length_2_or_more) show ?thesis - proof - have [simp]: "oid5 \<noteq> oid3" by(metis distinct_oid distinct_length_2_or_more) show ?thesis - proof - have [simp]: "oid5 \<noteq> oid4" by(metis distinct_oid distinct_length_2_or_more) show ?thesis - proof - have [simp]: "oid5 \<noteq> oid6" by(metis distinct_oid distinct_length_2_or_more) show ?thesis - proof - have [simp]: "oid5 \<noteq> oid7" by(metis distinct_oid distinct_length_2_or_more) show ?thesis - proof - have [simp]: "oid5 \<noteq> oid8" by(metis distinct_oid distinct_length_2_or_more) show ?thesis - proof - have [simp]: "oid5 \<noteq> oid9" by(metis distinct_oid distinct_length_2_or_more) show ?thesis - proof - have [simp]: "oid6 \<noteq> oid1" by(metis distinct_oid distinct_length_2_or_more) show ?thesis - proof - have [simp]: "oid6 \<noteq> oid2" by(metis distinct_oid distinct_length_2_or_more) show ?thesis - proof - have [simp]: "oid6 \<noteq> oid3" by(metis distinct_oid distinct_length_2_or_more) show ?thesis - proof - have [simp]: "oid6 \<noteq> oid4" by(metis distinct_oid distinct_length_2_or_more) show ?thesis - proof - have [simp]: "oid6 \<noteq> oid5" by(metis distinct_oid distinct_length_2_or_more) show ?thesis - proof - have [simp]: "oid6 \<noteq> oid7" by(metis distinct_oid distinct_length_2_or_more) show ?thesis - proof - have [simp]: "oid6 \<noteq> oid8" by(metis distinct_oid distinct_length_2_or_more) show ?thesis - proof - have [simp]: "oid6 \<noteq> oid9" by(metis distinct_oid distinct_length_2_or_more) show ?thesis - proof - have [simp]: "oid7 \<noteq> oid1" by(metis distinct_oid distinct_length_2_or_more) show ?thesis - proof - have [simp]: "oid7 \<noteq> oid2" by(metis distinct_oid distinct_length_2_or_more) show ?thesis - proof - have [simp]: "oid7 \<noteq> oid3" by(metis distinct_oid distinct_length_2_or_more) show ?thesis - proof - have [simp]: "oid7 \<noteq> oid4" by(metis distinct_oid distinct_length_2_or_more) show ?thesis - proof - have [simp]: "oid7 \<noteq> oid5" by(metis distinct_oid distinct_length_2_or_more) show ?thesis - proof - have [simp]: "oid7 \<noteq> oid6" by(metis distinct_oid distinct_length_2_or_more) show ?thesis - proof - have [simp]: "oid7 \<noteq> oid8" by(metis distinct_oid distinct_length_2_or_more) show ?thesis - proof - have [simp]: "oid7 \<noteq> oid9" by(metis distinct_oid distinct_length_2_or_more) show ?thesis - proof - have [simp]: "oid8 \<noteq> oid1" by(metis distinct_oid distinct_length_2_or_more) show ?thesis - proof - have [simp]: "oid8 \<noteq> oid2" by(metis distinct_oid distinct_length_2_or_more) show ?thesis - proof - have [simp]: "oid8 \<noteq> oid3" by(metis distinct_oid distinct_length_2_or_more) show ?thesis - proof - have [simp]: "oid8 \<noteq> oid4" by(metis distinct_oid distinct_length_2_or_more) show ?thesis - proof - have [simp]: "oid8 \<noteq> oid5" by(metis distinct_oid distinct_length_2_or_more) show ?thesis - proof - have [simp]: "oid8 \<noteq> oid6" by(metis distinct_oid distinct_length_2_or_more) show ?thesis - proof - have [simp]: "oid8 \<noteq> oid7" by(metis distinct_oid distinct_length_2_or_more) show ?thesis - proof - have [simp]: "oid8 \<noteq> oid9" by(metis distinct_oid distinct_length_2_or_more) show ?thesis - proof - have [simp]: "oid9 \<noteq> oid1" by(metis distinct_oid distinct_length_2_or_more) show ?thesis - proof - have [simp]: "oid9 \<noteq> oid2" by(metis distinct_oid distinct_length_2_or_more) show ?thesis - proof - have [simp]: "oid9 \<noteq> oid3" by(metis distinct_oid distinct_length_2_or_more) show ?thesis - proof - have [simp]: "oid9 \<noteq> oid4" by(metis distinct_oid distinct_length_2_or_more) show ?thesis - proof - have [simp]: "oid9 \<noteq> oid5" by(metis distinct_oid distinct_length_2_or_more) show ?thesis - proof - have [simp]: "oid9 \<noteq> oid6" by(metis distinct_oid distinct_length_2_or_more) show ?thesis - proof - have [simp]: "oid9 \<noteq> oid7" by(metis distinct_oid distinct_length_2_or_more) show ?thesis - proof - have [simp]: "oid9 \<noteq> oid8" by(metis distinct_oid distinct_length_2_or_more) show ?thesis -by(auto simp: WFF_def state_\<sigma>\<^sub>1.\<sigma>\<^sub>1_def state_\<sigma>\<^sub>1'.\<sigma>\<^sub>1'_def) qed qed qed qed qed qed qed qed qed qed qed qed qed qed qed qed qed qed qed qed qed qed qed qed qed qed qed qed qed qed qed qed qed qed qed qed qed qed qed qed qed qed qed qed qed qed qed qed qed qed qed qed qed qed qed qed qed qed qed qed qed qed qed qed qed qed qed qed qed qed qed qed - -lemma oid1\<sigma>\<^sub>1\<sigma>\<^sub>1'_\<sigma>\<^sub>1_OclIsMaintained : -assumes [simp]: "(oid_of (\<sigma>\<^sub>1_object0\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)) = oid1" -shows "(state_\<sigma>\<^sub>1.\<sigma>\<^sub>1 , state_\<sigma>\<^sub>1'.\<sigma>\<^sub>1') \<Turnstile> (OclIsMaintained (\<sigma>\<^sub>1_object0))" - apply(simp add: state_\<sigma>\<^sub>1.\<sigma>\<^sub>1_def state_\<sigma>\<^sub>1'.\<sigma>\<^sub>1'_def \<sigma>\<^sub>1_object0_def OclIsMaintained_def OclValid_def oid_of_option_def) -by((metis distinct_oid distinct_length_2_or_more)?) - -lemma oid1\<sigma>\<^sub>1\<sigma>\<^sub>1'_\<sigma>\<^sub>1'_OclIsMaintained : -assumes [simp]: "(oid_of (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)) = oid1" -shows "(state_\<sigma>\<^sub>1.\<sigma>\<^sub>1 , state_\<sigma>\<^sub>1'.\<sigma>\<^sub>1') \<Turnstile> (OclIsMaintained (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1))" - apply(simp add: state_\<sigma>\<^sub>1.\<sigma>\<^sub>1_def state_\<sigma>\<^sub>1'.\<sigma>\<^sub>1'_def X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1_def OclIsMaintained_def OclValid_def oid_of_option_def) -by((metis distinct_oid distinct_length_2_or_more)?) - -lemma oid2\<sigma>\<^sub>1\<sigma>\<^sub>1'_\<sigma>\<^sub>1_OclIsMaintained : -assumes [simp]: "(oid_of (\<sigma>\<^sub>1_object1\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)) = oid2" -shows "(state_\<sigma>\<^sub>1.\<sigma>\<^sub>1 , state_\<sigma>\<^sub>1'.\<sigma>\<^sub>1') \<Turnstile> (OclIsMaintained (\<sigma>\<^sub>1_object1))" - apply(simp add: state_\<sigma>\<^sub>1.\<sigma>\<^sub>1_def state_\<sigma>\<^sub>1'.\<sigma>\<^sub>1'_def \<sigma>\<^sub>1_object1_def OclIsMaintained_def OclValid_def oid_of_option_def) -by((metis distinct_oid distinct_length_2_or_more)?) - -lemma oid2\<sigma>\<^sub>1\<sigma>\<^sub>1'_\<sigma>\<^sub>1'_OclIsMaintained : -assumes [simp]: "(oid_of (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)) = oid2" -shows "(state_\<sigma>\<^sub>1.\<sigma>\<^sub>1 , state_\<sigma>\<^sub>1'.\<sigma>\<^sub>1') \<Turnstile> (OclIsMaintained (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2))" - apply(simp add: state_\<sigma>\<^sub>1.\<sigma>\<^sub>1_def state_\<sigma>\<^sub>1'.\<sigma>\<^sub>1'_def X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2_def OclIsMaintained_def OclValid_def oid_of_option_def) -by((metis distinct_oid distinct_length_2_or_more)?) - -lemma oid3\<sigma>\<^sub>1\<sigma>\<^sub>1'_\<sigma>\<^sub>1'_OclIsNew : -assumes [simp]: "(oid_of (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)) = oid3" -shows "(state_\<sigma>\<^sub>1.\<sigma>\<^sub>1 , state_\<sigma>\<^sub>1'.\<sigma>\<^sub>1') \<Turnstile> (OclIsNew (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3))" - apply(simp add: state_\<sigma>\<^sub>1.\<sigma>\<^sub>1_def state_\<sigma>\<^sub>1'.\<sigma>\<^sub>1'_def X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3_def OclIsNew_def OclValid_def oid_of_option_def) -by((metis distinct_oid distinct_length_2_or_more)?) - -lemma oid4\<sigma>\<^sub>1\<sigma>\<^sub>1'_\<sigma>\<^sub>1_OclIsMaintained : -assumes [simp]: "(oid_of (\<sigma>\<^sub>1_object2\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)) = oid4" -shows "(state_\<sigma>\<^sub>1.\<sigma>\<^sub>1 , state_\<sigma>\<^sub>1'.\<sigma>\<^sub>1') \<Turnstile> (OclIsMaintained (\<sigma>\<^sub>1_object2))" - apply(simp add: state_\<sigma>\<^sub>1.\<sigma>\<^sub>1_def state_\<sigma>\<^sub>1'.\<sigma>\<^sub>1'_def \<sigma>\<^sub>1_object2_def OclIsMaintained_def OclValid_def oid_of_option_def) -by((metis distinct_oid distinct_length_2_or_more)?) - -lemma oid4\<sigma>\<^sub>1\<sigma>\<^sub>1'_\<sigma>\<^sub>1'_OclIsMaintained : -assumes [simp]: "(oid_of (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)) = oid4" -shows "(state_\<sigma>\<^sub>1.\<sigma>\<^sub>1 , state_\<sigma>\<^sub>1'.\<sigma>\<^sub>1') \<Turnstile> (OclIsMaintained (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4))" - apply(simp add: state_\<sigma>\<^sub>1.\<sigma>\<^sub>1_def state_\<sigma>\<^sub>1'.\<sigma>\<^sub>1'_def X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4_def OclIsMaintained_def OclValid_def oid_of_option_def) -by((metis distinct_oid distinct_length_2_or_more)?) - -lemma oid5\<sigma>\<^sub>1\<sigma>\<^sub>1'_\<sigma>\<^sub>1_OclIsDeleted : -assumes [simp]: "(oid_of (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)) = oid5" -shows "(state_\<sigma>\<^sub>1.\<sigma>\<^sub>1 , state_\<sigma>\<^sub>1'.\<sigma>\<^sub>1') \<Turnstile> (OclIsDeleted (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5))" - apply(simp add: state_\<sigma>\<^sub>1.\<sigma>\<^sub>1_def state_\<sigma>\<^sub>1'.\<sigma>\<^sub>1'_def X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5_def OclIsDeleted_def OclValid_def oid_of_option_def) -by((metis distinct_oid distinct_length_2_or_more)?) - -lemma oid6\<sigma>\<^sub>1\<sigma>\<^sub>1'_\<sigma>\<^sub>1_OclIsMaintained : -assumes [simp]: "(oid_of (\<sigma>\<^sub>1_object4\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)) = oid6" -shows "(state_\<sigma>\<^sub>1.\<sigma>\<^sub>1 , state_\<sigma>\<^sub>1'.\<sigma>\<^sub>1') \<Turnstile> (OclIsMaintained (\<sigma>\<^sub>1_object4))" - apply(simp add: state_\<sigma>\<^sub>1.\<sigma>\<^sub>1_def state_\<sigma>\<^sub>1'.\<sigma>\<^sub>1'_def \<sigma>\<^sub>1_object4_def OclIsMaintained_def OclValid_def oid_of_option_def) -by((metis distinct_oid distinct_length_2_or_more)?) - -lemma oid6\<sigma>\<^sub>1\<sigma>\<^sub>1'_\<sigma>\<^sub>1'_OclIsMaintained : -assumes [simp]: "(oid_of (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)) = oid6" -shows "(state_\<sigma>\<^sub>1.\<sigma>\<^sub>1 , state_\<sigma>\<^sub>1'.\<sigma>\<^sub>1') \<Turnstile> (OclIsMaintained (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6))" - apply(simp add: state_\<sigma>\<^sub>1.\<sigma>\<^sub>1_def state_\<sigma>\<^sub>1'.\<sigma>\<^sub>1'_def X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6_def OclIsMaintained_def OclValid_def oid_of_option_def) -by((metis distinct_oid distinct_length_2_or_more)?) - -lemma oid7\<sigma>\<^sub>1\<sigma>\<^sub>1'_\<sigma>\<^sub>1'_OclIsNew : -assumes [simp]: "(oid_of (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y)) = oid7" -shows "(state_\<sigma>\<^sub>1.\<sigma>\<^sub>1 , state_\<sigma>\<^sub>1'.\<sigma>\<^sub>1') \<Turnstile> (OclIsNew (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7))" - apply(simp add: state_\<sigma>\<^sub>1.\<sigma>\<^sub>1_def state_\<sigma>\<^sub>1'.\<sigma>\<^sub>1'_def X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7_def OclIsNew_def OclValid_def oid_of_option_def) -by((metis distinct_oid distinct_length_2_or_more)?) - -lemma oid8\<sigma>\<^sub>1\<sigma>\<^sub>1'_\<sigma>\<^sub>1'_OclIsNew : -assumes [simp]: "(oid_of (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n8\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y)) = oid8" -shows "(state_\<sigma>\<^sub>1.\<sigma>\<^sub>1 , state_\<sigma>\<^sub>1'.\<sigma>\<^sub>1') \<Turnstile> (OclIsNew (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n8))" - apply(simp add: state_\<sigma>\<^sub>1.\<sigma>\<^sub>1_def state_\<sigma>\<^sub>1'.\<sigma>\<^sub>1'_def X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n8_def OclIsNew_def OclValid_def oid_of_option_def) -by((metis distinct_oid distinct_length_2_or_more)?) - -lemma oid9\<sigma>\<^sub>1\<sigma>\<^sub>1'_\<sigma>\<^sub>1_OclIsMaintained : -assumes [simp]: "(oid_of (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)) = oid9" -shows "(state_\<sigma>\<^sub>1.\<sigma>\<^sub>1 , state_\<sigma>\<^sub>1'.\<sigma>\<^sub>1') \<Turnstile> (OclIsMaintained (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9))" - apply(simp add: state_\<sigma>\<^sub>1.\<sigma>\<^sub>1_def state_\<sigma>\<^sub>1'.\<sigma>\<^sub>1'_def X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9_def OclIsMaintained_def OclValid_def oid_of_option_def) -by((metis distinct_oid distinct_length_2_or_more)?) - -lemma oid9\<sigma>\<^sub>1\<sigma>\<^sub>1'_\<sigma>\<^sub>1'_OclIsMaintained : -assumes [simp]: "(oid_of (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)) = oid9" -shows "(state_\<sigma>\<^sub>1.\<sigma>\<^sub>1 , state_\<sigma>\<^sub>1'.\<sigma>\<^sub>1') \<Turnstile> (OclIsMaintained (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9))" - apply(simp add: state_\<sigma>\<^sub>1.\<sigma>\<^sub>1_def state_\<sigma>\<^sub>1'.\<sigma>\<^sub>1'_def X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9_def OclIsMaintained_def OclValid_def oid_of_option_def) -by((metis distinct_oid distinct_length_2_or_more)?) -end - -(* 164 ************************************ 970 + 1 *) (* term Floor2_examp.print_transition_def_interp *) -definition "(pp_\<sigma>\<^sub>1_\<sigma>\<^sub>1' (\<tau>)) = (transition_\<sigma>\<^sub>1_\<sigma>\<^sub>1' (oid1) (oid2) (oid3) (oid4) (oid5) (oid6) (oid7) (oid8) (oid9) (\<lceil>\<lceil>(\<sigma>\<^sub>1_object0 (\<tau>))\<rceil>\<rceil>) (\<sigma>\<^sub>1_object0) (\<lceil>\<lceil>(X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1 (\<tau>))\<rceil>\<rceil>) (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1) (\<lceil>\<lceil>(\<sigma>\<^sub>1_object1 (\<tau>))\<rceil>\<rceil>) (\<sigma>\<^sub>1_object1) (\<lceil>\<lceil>(X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2 (\<tau>))\<rceil>\<rceil>) (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2) (\<lceil>\<lceil>(X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3 (\<tau>))\<rceil>\<rceil>) (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3) (\<lceil>\<lceil>(\<sigma>\<^sub>1_object2 (\<tau>))\<rceil>\<rceil>) (\<sigma>\<^sub>1_object2) (\<lceil>\<lceil>(X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4 (\<tau>))\<rceil>\<rceil>) (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4) (\<lceil>\<lceil>(X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5 (\<tau>))\<rceil>\<rceil>) (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5) (\<lceil>\<lceil>(\<sigma>\<^sub>1_object4 (\<tau>))\<rceil>\<rceil>) (\<sigma>\<^sub>1_object4) (\<lceil>\<lceil>(X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6 (\<tau>))\<rceil>\<rceil>) (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6) (\<lceil>\<lceil>(X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7 (\<tau>))\<rceil>\<rceil>) (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7) (\<lceil>\<lceil>(X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n8 (\<tau>))\<rceil>\<rceil>) (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n8) (\<lceil>\<lceil>(X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9 (\<tau>))\<rceil>\<rceil>) (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9))" - -(* 165 ************************************ 971 + 3 *) (* term Floor2_examp.print_transition_lemmas_oid *) -lemmas pp_oid_\<sigma>\<^sub>1_\<sigma>\<^sub>1' = oid1_def - oid2_def - oid3_def - oid4_def - oid5_def - oid6_def - oid7_def - oid8_def - oid9_def -lemmas pp_object_\<sigma>\<^sub>1_\<sigma>\<^sub>1' = \<sigma>\<^sub>1_object0_def - X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1_def - \<sigma>\<^sub>1_object1_def - X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2_def - X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3_def - \<sigma>\<^sub>1_object2_def - X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4_def - X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5_def - \<sigma>\<^sub>1_object4_def - X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6_def - X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7_def - X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n8_def - X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9_def -lemmas pp_object_ty_\<sigma>\<^sub>1_\<sigma>\<^sub>1' = \<sigma>\<^sub>1_object0\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_def - X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_def - \<sigma>\<^sub>1_object1\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_def - X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_def - X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_def - \<sigma>\<^sub>1_object2\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_def - X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_def - X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_def - \<sigma>\<^sub>1_object4\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_def - X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_def - X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_def - X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n8\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_def - X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_def - -(* 166 ************************************ 974 + 1 *) -section \<open>Context (Floor 2)\<close> - -(* 167 ************************************ 975 + 6 *) (* term Floor2_ctxt.print_ctxt_pre_post *) -axiomatization where dot__contents_Person_def: -"(self::\<cdot>Person) .contents() \<equiv> (\<lambda>\<tau>. (Eps ((\<lambda>result. (HOL.Let ((\<lambda>_. result)) ((\<lambda>result. (if ((\<tau> \<Turnstile> ((\<delta> (self))))) then (\<tau> \<Turnstile> ((((UML_Logic.false :: (((_, Product_Type.unit) UML_Types.state.state_ext \<times> (_, Product_Type.unit) UML_Types.state.state_ext) \<Rightarrow> ((HOL.bool) Option.option) Option.option)))))) \<and> (\<tau> \<Turnstile> ((((((UML_Logic.StrongEq :: ((((Employee_DesignModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext \<times> (Employee_DesignModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext) \<Rightarrow> (((Int.int) Option.option) Option.option) UML_Types.Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e) \<Rightarrow> ((((Employee_DesignModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext \<times> (Employee_DesignModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext) \<Rightarrow> (((Int.int) Option.option) Option.option) UML_Types.Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e) \<Rightarrow> (((Employee_DesignModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext \<times> (Employee_DesignModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext) \<Rightarrow> ((HOL.bool) Option.option) Option.option))))) (result)) (((((UML_Logic.OclIf :: ((((Employee_DesignModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext \<times> (Employee_DesignModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext) \<Rightarrow> ((HOL.bool) Option.option) Option.option) \<Rightarrow> ((((Employee_DesignModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext \<times> (Employee_DesignModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext) \<Rightarrow> (((Int.int) Option.option) Option.option) UML_Types.Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e) \<Rightarrow> ((((Employee_DesignModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext \<times> (Employee_DesignModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext) \<Rightarrow> (((Int.int) Option.option) Option.option) UML_Types.Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e) \<Rightarrow> (((Employee_DesignModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext \<times> (Employee_DesignModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext) \<Rightarrow> (((Int.int) Option.option) Option.option) UML_Types.Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e)))))) ((((UML_Logic.StrictRefEq :: ((((Employee_DesignModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext \<times> (Employee_DesignModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext) \<Rightarrow> ((Employee_DesignModel_UMLPart_generated.ty\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n) Option.option) Option.option) \<Rightarrow> ((((Employee_DesignModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext \<times> (Employee_DesignModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext) \<Rightarrow> ((Employee_DesignModel_UMLPart_generated.ty\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n) Option.option) Option.option) \<Rightarrow> (((Employee_DesignModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext \<times> (Employee_DesignModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext) \<Rightarrow> ((HOL.bool) Option.option) Option.option))))) (((Employee_DesignModel_UMLPart_generated.dot_0___boss :: ((((Employee_DesignModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext \<times> (Employee_DesignModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext) \<Rightarrow> _) \<Rightarrow> (((Employee_DesignModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext \<times> (Employee_DesignModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext) \<Rightarrow> ((Employee_DesignModel_UMLPart_generated.ty\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n) Option.option) Option.option)))) (self))) ((UML_Types.null_class.null :: (((Employee_DesignModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext \<times> (Employee_DesignModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext) \<Rightarrow> ((Employee_DesignModel_UMLPart_generated.ty\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n) Option.option) Option.option))))) ((((UML_Set.OclIncluding :: ((((Employee_DesignModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext \<times> (Employee_DesignModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext) \<Rightarrow> (((Int.int) Option.option) Option.option) UML_Types.Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e) \<Rightarrow> ((((Employee_DesignModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext \<times> (Employee_DesignModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext) \<Rightarrow> ((Int.int) Option.option) Option.option) \<Rightarrow> (((Employee_DesignModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext \<times> (Employee_DesignModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext) \<Rightarrow> (((Int.int) Option.option) Option.option) UML_Types.Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e))))) ((UML_Set.mtSet :: (((Employee_DesignModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext \<times> (Employee_DesignModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext) \<Rightarrow> (((Int.int) Option.option) Option.option) UML_Types.Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e)))) (((Employee_DesignModel_UMLPart_generated.dot__salary :: ((((Employee_DesignModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext \<times> (Employee_DesignModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext) \<Rightarrow> _) \<Rightarrow> (((Employee_DesignModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext \<times> (Employee_DesignModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext) \<Rightarrow> ((Int.int) Option.option) Option.option)))) (self)))) ((((UML_Set.OclIncluding :: ((((Employee_DesignModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext \<times> (Employee_DesignModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext) \<Rightarrow> (((Int.int) Option.option) Option.option) UML_Types.Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e) \<Rightarrow> ((((Employee_DesignModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext \<times> (Employee_DesignModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext) \<Rightarrow> ((Int.int) Option.option) Option.option) \<Rightarrow> (((Employee_DesignModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext \<times> (Employee_DesignModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext) \<Rightarrow> (((Int.int) Option.option) Option.option) UML_Types.Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e))))) (((Employee_DesignModel_UMLPart_generated.dot__contents :: ((((Employee_DesignModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext \<times> (Employee_DesignModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext) \<Rightarrow> ((Employee_DesignModel_UMLPart_generated.ty\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n) Option.option) Option.option) \<Rightarrow> (((Employee_DesignModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext \<times> (Employee_DesignModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext) \<Rightarrow> (((Int.int) Option.option) Option.option) UML_Types.Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e)))) (((Employee_DesignModel_UMLPart_generated.dot_0___boss :: ((((Employee_DesignModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext \<times> (Employee_DesignModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext) \<Rightarrow> _) \<Rightarrow> (((Employee_DesignModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext \<times> (Employee_DesignModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext) \<Rightarrow> ((Employee_DesignModel_UMLPart_generated.ty\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n) Option.option) Option.option)))) (self)))) (((Employee_DesignModel_UMLPart_generated.dot__salary :: ((((Employee_DesignModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext \<times> (Employee_DesignModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext) \<Rightarrow> _) \<Rightarrow> (((Employee_DesignModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext \<times> (Employee_DesignModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext) \<Rightarrow> ((Int.int) Option.option) Option.option)))) (self)))) and (UML_Logic.true :: (((_, Product_Type.unit) UML_Types.state.state_ext \<times> (_, Product_Type.unit) UML_Types.state.state_ext) \<Rightarrow> ((HOL.bool) Option.option) Option.option)))))) else (\<tau> \<Turnstile> (result \<triangleq> invalid))))))))))" -thm dot__contents_Person_def -overloading dot__contents \<equiv> "(dot__contents::(\<cdot>Planet) \<Rightarrow> _)" -begin - definition dot__contents_Planet : "(x::\<cdot>Planet) .contents() \<equiv> x .oclAsType(Person) .contents()" -end -overloading dot__contents \<equiv> "(dot__contents::(\<cdot>Galaxy) \<Rightarrow> _)" -begin - definition dot__contents_Galaxy : "(x::\<cdot>Galaxy) .contents() \<equiv> x .oclAsType(Person) .contents()" -end -overloading dot__contents \<equiv> "(dot__contents::(\<cdot>OclAny) \<Rightarrow> _)" -begin - definition dot__contents_OclAny : "(x::\<cdot>OclAny) .contents() \<equiv> x .oclAsType(Person) .contents()" -end -ML \<open>(Ty'.check ([]) (" error(s)"))\<close> - -(* 168 ************************************ 981 + 0 *) (* term Floor2_ctxt.print_ctxt_inv *) - -(* 169 ************************************ 981 + 0 *) (* term Floor2_ctxt.print_ctxt_thm *) - -(* 170 ************************************ 981 + 1 *) -section \<open>Context (Floor 2)\<close> - -(* 171 ************************************ 982 + 0 *) (* term Floor2_ctxt.print_ctxt_pre_post *) - -(* 172 ************************************ 982 + 3 *) (* term Floor2_ctxt.print_ctxt_inv *) -definition "Person_aat_pre = (\<lambda>\<tau>. (\<tau> \<Turnstile> (UML_Set.OclForall ((OclAllInstances_at_pre (Person))) ((\<lambda>self. (((UML_Logic.OclImplies :: ((((Employee_DesignModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext \<times> (Employee_DesignModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext) \<Rightarrow> ((HOL.bool) Option.option) Option.option) \<Rightarrow> ((((Employee_DesignModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext \<times> (Employee_DesignModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext) \<Rightarrow> ((HOL.bool) Option.option) Option.option) \<Rightarrow> (((Employee_DesignModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext \<times> (Employee_DesignModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext) \<Rightarrow> ((HOL.bool) Option.option) Option.option))))) (((UML_Logic.OclNot :: ((((Employee_DesignModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext \<times> (Employee_DesignModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext) \<Rightarrow> ((HOL.bool) Option.option) Option.option) \<Rightarrow> (((Employee_DesignModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext \<times> (Employee_DesignModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext) \<Rightarrow> ((HOL.bool) Option.option) Option.option)))) ((((UML_Logic.StrictRefEq :: ((((Employee_DesignModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext \<times> (Employee_DesignModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext) \<Rightarrow> ((Employee_DesignModel_UMLPart_generated.ty\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n) Option.option) Option.option) \<Rightarrow> ((((Employee_DesignModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext \<times> (Employee_DesignModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext) \<Rightarrow> ((Employee_DesignModel_UMLPart_generated.ty\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n) Option.option) Option.option) \<Rightarrow> (((Employee_DesignModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext \<times> (Employee_DesignModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext) \<Rightarrow> ((HOL.bool) Option.option) Option.option))))) (((Employee_DesignModel_UMLPart_generated.dot_0___bossat_pre :: ((((Employee_DesignModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext \<times> (Employee_DesignModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext) \<Rightarrow> _) \<Rightarrow> (((Employee_DesignModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext \<times> (Employee_DesignModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext) \<Rightarrow> ((Employee_DesignModel_UMLPart_generated.ty\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n) Option.option) Option.option)))) (self))) ((UML_Types.null_class.null :: (((Employee_DesignModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext \<times> (Employee_DesignModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext) \<Rightarrow> ((Employee_DesignModel_UMLPart_generated.ty\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n) Option.option) Option.option)))))) ((((UML_Logic.StrongEq :: ((((Employee_DesignModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext \<times> (Employee_DesignModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext) \<Rightarrow> ((Int.int) Option.option) Option.option) \<Rightarrow> ((((Employee_DesignModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext \<times> (Employee_DesignModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext) \<Rightarrow> ((Int.int) Option.option) Option.option) \<Rightarrow> (((Employee_DesignModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext \<times> (Employee_DesignModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext) \<Rightarrow> ((HOL.bool) Option.option) Option.option))))) (((Employee_DesignModel_UMLPart_generated.dot__salaryat_pre :: ((((Employee_DesignModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext \<times> (Employee_DesignModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext) \<Rightarrow> _) \<Rightarrow> (((Employee_DesignModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext \<times> (Employee_DesignModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext) \<Rightarrow> ((Int.int) Option.option) Option.option)))) (self))) (((Employee_DesignModel_UMLPart_generated.dot__salaryat_pre :: ((((Employee_DesignModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext \<times> (Employee_DesignModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext) \<Rightarrow> ((Employee_DesignModel_UMLPart_generated.ty\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n) Option.option) Option.option) \<Rightarrow> (((Employee_DesignModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext \<times> (Employee_DesignModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext) \<Rightarrow> ((Int.int) Option.option) Option.option)))) (((Employee_DesignModel_UMLPart_generated.dot_0___bossat_pre :: ((((Employee_DesignModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext \<times> (Employee_DesignModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext) \<Rightarrow> _) \<Rightarrow> (((Employee_DesignModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext \<times> (Employee_DesignModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext) \<Rightarrow> ((Employee_DesignModel_UMLPart_generated.ty\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n) Option.option) Option.option)))) (self)))))))))" -definition "Person_a = (\<lambda>\<tau>. (\<tau> \<Turnstile> (UML_Set.OclForall ((OclAllInstances_at_post (Person))) ((\<lambda>self. (((UML_Logic.OclImplies :: ((((Employee_DesignModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext \<times> (Employee_DesignModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext) \<Rightarrow> ((HOL.bool) Option.option) Option.option) \<Rightarrow> ((((Employee_DesignModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext \<times> (Employee_DesignModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext) \<Rightarrow> ((HOL.bool) Option.option) Option.option) \<Rightarrow> (((Employee_DesignModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext \<times> (Employee_DesignModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext) \<Rightarrow> ((HOL.bool) Option.option) Option.option))))) (((UML_Logic.OclNot :: ((((Employee_DesignModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext \<times> (Employee_DesignModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext) \<Rightarrow> ((HOL.bool) Option.option) Option.option) \<Rightarrow> (((Employee_DesignModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext \<times> (Employee_DesignModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext) \<Rightarrow> ((HOL.bool) Option.option) Option.option)))) ((((UML_Logic.StrictRefEq :: ((((Employee_DesignModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext \<times> (Employee_DesignModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext) \<Rightarrow> ((Employee_DesignModel_UMLPart_generated.ty\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n) Option.option) Option.option) \<Rightarrow> ((((Employee_DesignModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext \<times> (Employee_DesignModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext) \<Rightarrow> ((Employee_DesignModel_UMLPart_generated.ty\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n) Option.option) Option.option) \<Rightarrow> (((Employee_DesignModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext \<times> (Employee_DesignModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext) \<Rightarrow> ((HOL.bool) Option.option) Option.option))))) (((Employee_DesignModel_UMLPart_generated.dot_0___boss :: ((((Employee_DesignModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext \<times> (Employee_DesignModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext) \<Rightarrow> _) \<Rightarrow> (((Employee_DesignModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext \<times> (Employee_DesignModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext) \<Rightarrow> ((Employee_DesignModel_UMLPart_generated.ty\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n) Option.option) Option.option)))) (self))) ((UML_Types.null_class.null :: (((Employee_DesignModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext \<times> (Employee_DesignModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext) \<Rightarrow> ((Employee_DesignModel_UMLPart_generated.ty\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n) Option.option) Option.option)))))) ((((UML_Logic.StrongEq :: ((((Employee_DesignModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext \<times> (Employee_DesignModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext) \<Rightarrow> ((Int.int) Option.option) Option.option) \<Rightarrow> ((((Employee_DesignModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext \<times> (Employee_DesignModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext) \<Rightarrow> ((Int.int) Option.option) Option.option) \<Rightarrow> (((Employee_DesignModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext \<times> (Employee_DesignModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext) \<Rightarrow> ((HOL.bool) Option.option) Option.option))))) (((Employee_DesignModel_UMLPart_generated.dot__salary :: ((((Employee_DesignModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext \<times> (Employee_DesignModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext) \<Rightarrow> _) \<Rightarrow> (((Employee_DesignModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext \<times> (Employee_DesignModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext) \<Rightarrow> ((Int.int) Option.option) Option.option)))) (self))) (((Employee_DesignModel_UMLPart_generated.dot__salary :: ((((Employee_DesignModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext \<times> (Employee_DesignModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext) \<Rightarrow> ((Employee_DesignModel_UMLPart_generated.ty\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n) Option.option) Option.option) \<Rightarrow> (((Employee_DesignModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext \<times> (Employee_DesignModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext) \<Rightarrow> ((Int.int) Option.option) Option.option)))) (((Employee_DesignModel_UMLPart_generated.dot_0___boss :: ((((Employee_DesignModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext \<times> (Employee_DesignModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext) \<Rightarrow> _) \<Rightarrow> (((Employee_DesignModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext \<times> (Employee_DesignModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext) \<Rightarrow> ((Employee_DesignModel_UMLPart_generated.ty\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n) Option.option) Option.option)))) (self)))))))))" -ML \<open>(Ty'.check ([]) (" error(s)"))\<close> - -(* 173 ************************************ 985 + 1 *) (* term Floor2_ctxt.print_ctxt_thm *) -thm Person_aat_pre_def Person_a_def - -(* 174 ************************************ 986 + 1 *) -section \<open>Context (Floor 2)\<close> - -(* 175 ************************************ 987 + 0 *) (* term Floor2_ctxt.print_ctxt_pre_post *) - -(* 176 ************************************ 987 + 3 *) (* term Floor2_ctxt.print_ctxt_inv *) -definition "Planet_Aat_pre = (\<lambda>\<tau>. (\<tau> \<Turnstile> (UML_Set.OclForall ((OclAllInstances_at_pre (Planet))) ((\<lambda>self. (((UML_Logic.OclAnd :: ((((Employee_DesignModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext \<times> (Employee_DesignModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext) \<Rightarrow> ((HOL.bool) Option.option) Option.option) \<Rightarrow> ((((Employee_DesignModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext \<times> (Employee_DesignModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext) \<Rightarrow> ((HOL.bool) Option.option) Option.option) \<Rightarrow> (((Employee_DesignModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext \<times> (Employee_DesignModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext) \<Rightarrow> ((HOL.bool) Option.option) Option.option))))) ((UML_Logic.true :: (((Employee_DesignModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext \<times> (Employee_DesignModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext) \<Rightarrow> ((HOL.bool) Option.option) Option.option)))) ((((UML_Integer.OclLe\<^sub>I\<^sub>n\<^sub>t\<^sub>e\<^sub>g\<^sub>e\<^sub>r :: ((((Employee_DesignModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext \<times> (Employee_DesignModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext) \<Rightarrow> ((Int.int) Option.option) Option.option) \<Rightarrow> ((((Employee_DesignModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext \<times> (Employee_DesignModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext) \<Rightarrow> ((Int.int) Option.option) Option.option) \<Rightarrow> (((Employee_DesignModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext \<times> (Employee_DesignModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext) \<Rightarrow> ((HOL.bool) Option.option) Option.option))))) (((Employee_DesignModel_UMLPart_generated.dot__weightat_pre :: ((((Employee_DesignModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext \<times> (Employee_DesignModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext) \<Rightarrow> _) \<Rightarrow> (((Employee_DesignModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext \<times> (Employee_DesignModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext) \<Rightarrow> ((Int.int) Option.option) Option.option)))) (self))) ((UML_Integer.OclInt0 :: (((Employee_DesignModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext \<times> (Employee_DesignModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext) \<Rightarrow> ((Int.int) Option.option) Option.option)))))))))" -definition "Planet_A = (\<lambda>\<tau>. (\<tau> \<Turnstile> (UML_Set.OclForall ((OclAllInstances_at_post (Planet))) ((\<lambda>self. (((UML_Logic.OclAnd :: ((((Employee_DesignModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext \<times> (Employee_DesignModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext) \<Rightarrow> ((HOL.bool) Option.option) Option.option) \<Rightarrow> ((((Employee_DesignModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext \<times> (Employee_DesignModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext) \<Rightarrow> ((HOL.bool) Option.option) Option.option) \<Rightarrow> (((Employee_DesignModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext \<times> (Employee_DesignModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext) \<Rightarrow> ((HOL.bool) Option.option) Option.option))))) ((UML_Logic.true :: (((Employee_DesignModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext \<times> (Employee_DesignModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext) \<Rightarrow> ((HOL.bool) Option.option) Option.option)))) ((((UML_Integer.OclLe\<^sub>I\<^sub>n\<^sub>t\<^sub>e\<^sub>g\<^sub>e\<^sub>r :: ((((Employee_DesignModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext \<times> (Employee_DesignModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext) \<Rightarrow> ((Int.int) Option.option) Option.option) \<Rightarrow> ((((Employee_DesignModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext \<times> (Employee_DesignModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext) \<Rightarrow> ((Int.int) Option.option) Option.option) \<Rightarrow> (((Employee_DesignModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext \<times> (Employee_DesignModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext) \<Rightarrow> ((HOL.bool) Option.option) Option.option))))) (((Employee_DesignModel_UMLPart_generated.dot__weight :: ((((Employee_DesignModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext \<times> (Employee_DesignModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext) \<Rightarrow> _) \<Rightarrow> (((Employee_DesignModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext \<times> (Employee_DesignModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext) \<Rightarrow> ((Int.int) Option.option) Option.option)))) (self))) ((UML_Integer.OclInt0 :: (((Employee_DesignModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext \<times> (Employee_DesignModel_UMLPart_generated.\<AA>, Product_Type.unit) UML_Types.state.state_ext) \<Rightarrow> ((Int.int) Option.option) Option.option)))))))))" -ML \<open>(Ty'.check ([]) (" error(s)"))\<close> - -(* 177 ************************************ 990 + 1 *) (* term Floor2_ctxt.print_ctxt_thm *) -thm Planet_Aat_pre_def Planet_A_def - -end diff --git a/Citadelle/doc/Meta_C_generated.thy b/Citadelle/doc/Meta_C_generated.thy deleted file mode 100644 index 03b3938699a603fb5dfa0188e9a27d0e14271ac2..0000000000000000000000000000000000000000 --- a/Citadelle/doc/Meta_C_generated.thy +++ /dev/null @@ -1,978 +0,0 @@ -theory Meta_C_generated imports "FOCL.UML_Main" "FOCL.Static" "Citadelle_C_init.C_Model_init" begin - -(* 1 ************************************ 0 + 0 *) (* term Floor1_infra.print_infra_enum_synonym *) - -(* 2 ************************************ 0 + 1 *) -text \<open>\<close> - -(* 3 ************************************ 1 + 1 *) -text \<open> - \label{ex:Meta-C-generatedemployee-analysis:uml} \<close> - -(* 4 ************************************ 2 + 1 *) -section \<open>Class Model: Introduction\<close> - -(* 5 ************************************ 3 + 1 *) -text \<open> - - For certain concepts like classes and class-types, only a generic - definition for its resulting semantics can be given. Generic means, - there is a function outside \HOL that ``compiles'' a concrete, - closed-world class diagram into a ``theory'' of this data model, - consisting of a bunch of definitions for classes, accessors, method, - casts, and tests for actual types, as well as proofs for the - fundamental properties of these operations in this concrete data - model. \<close> - -(* 6 ************************************ 4 + 1 *) -text \<open> - Such generic function or ``compiler'' can be implemented in - Isabelle on the \ML level. This has been done, for a semantics - following the open-world assumption, for \UML 2.0 - in~\cite{brucker.ea:extensible:2008-b, brucker:interactive:2007}. In - this paper, we follow another approach for \UML 2.4: we define the - concepts of the compilation informally, and present a concrete - example which is verified in Isabelle/\HOL. \<close> - -(* 7 ************************************ 5 + 1 *) -subsection \<open>Outlining the Example\<close> - -(* 8 ************************************ 6 + 1 *) -text \<open>\<close> - -(* 9 ************************************ 7 + 1 *) -text \<open> - We are presenting here an ``analysis-model'' of the (slightly -modified) example Figure 7.3, page 20 of -the \OCL standard~\cite{omg:ocl:2012}. -Here, analysis model means that associations -were really represented as relation on objects on the state---as is -intended by the standard---rather by pointers between objects as is -done in our ``design model''. -To be precise, this theory contains the formalization of the data-part -covered by the \UML class model (see \autoref{fig:Meta-C-generatedperson-ana}):\<close> - -(* 10 ************************************ 8 + 1 *) -text_raw \<open>\<close> - -(* 11 ************************************ 9 + 1 *) -text_raw \<open> - -\begin{figure} - \centering\scalebox{.3}{\includegraphics{figures/person.png}}% - \caption{A simple \UML class model drawn from Figure 7.3, - page 20 of~\cite{omg:ocl:2012}. \label{fig:Meta-C-generatedperson-ana}} -\end{figure} -\<close> - -(* 12 ************************************ 10 + 1 *) -text \<open> - This means that the association (attached to the association class -\inlineocl{EmployeeRanking}) with the association ends \inlineocl+boss+ and \inlineocl+employees+ is implemented -by the attribute \inlineocl+boss+ and the operation \inlineocl+employees+ (to be discussed in the \OCL part -captured by the subsequent theory). -\<close> - -(* 13 ************************************ 11 + 1 *) -section \<open>Class Model: The Construction of the Object Universe\<close> - -(* 14 ************************************ 12 + 1 *) -text \<open> - Our data universe consists in the concrete class diagram just of node's, -and implicitly of the class object. Each class implies the existence of a class -type defined for the corresponding object representations as follows: \<close> - -(* 15 ************************************ 13 + 2 *) (* term Floor1_infra.print_infra_datatype_class_1 *) -datatype ty\<E>\<X>\<T>\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y = mk\<E>\<X>\<T>\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y "oid" -datatype ty\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y = mk\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y "ty\<E>\<X>\<T>\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y" - -(* 16 ************************************ 15 + 2 *) (* term Floor1_infra.print_infra_datatype_class_2 *) -datatype ty2\<E>\<X>\<T>\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y = mk2\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y -datatype ty2oid\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y = mk2oid\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y "oid" "ty2\<E>\<X>\<T>\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y" - -(* 17 ************************************ 17 + 2 *) (* term Floor1_infra.print_infra_datatype_equiv_2of1 *) -definition "class_ty_ext_equiv_2of1_aux\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y = (\<lambda>oid. (\<lambda> (mk2\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y ) \<Rightarrow> (mk\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y ((mk\<E>\<X>\<T>\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y (oid))))))" -definition "class_ty_ext_equiv_2of1\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y = (\<lambda> (mk2oid\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y (oid) (t)) \<Rightarrow> (class_ty_ext_equiv_2of1_aux\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y (oid) (t)))" - -(* 18 ************************************ 19 + 3 *) (* term Floor1_infra.print_infra_datatype_equiv_1of2 *) -definition "class_ty_ext_equiv_1of2_get_oid_inh\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y = (\<lambda> (mk\<E>\<X>\<T>\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y (oid)) \<Rightarrow> (oid))" -definition "class_ty_ext_equiv_1of2_aux\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y = (\<lambda> (mk\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y (t)) \<Rightarrow> (mk2\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y ))" -definition "class_ty_ext_equiv_1of2\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y = (\<lambda> (mk\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y (t)) \<Rightarrow> (case (class_ty_ext_equiv_1of2_get_oid_inh\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y (t)) of (oid) \<Rightarrow> (mk2oid\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y (oid) ((class_ty_ext_equiv_1of2_aux\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y ((mk\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y (t))))))))" - -(* 19 ************************************ 22 + 1 *) -text \<open> - Now, we construct a concrete ``universe of OclAny types'' by injection into a -sum type containing the class types. This type of OclAny will be used as instance -for all respective type-variables. \<close> - -(* 20 ************************************ 23 + 1 *) (* term Floor1_infra.print_infra_datatype_universe *) -datatype \<AA> = in\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y "ty\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y" - -(* 21 ************************************ 24 + 1 *) -text \<open> - Having fixed the object universe, we can introduce type synonyms that exactly correspond -to \OCL types. Again, we exploit that our representation of \OCL is a ``shallow embedding'' with a -one-to-one correspondance of \OCL-types to types of the meta-language \HOL. \<close> - -(* 22 ************************************ 25 + 7 *) (* term Floor1_infra.print_infra_type_synonym_class *) -type_synonym Void = "\<AA> Void" -type_synonym Boolean = "\<AA> Boolean" -type_synonym Integer = "\<AA> Integer" -type_synonym Real = "\<AA> Real" -type_synonym String = "\<AA> String" -type_synonym '\<alpha> val' = "(\<AA>, '\<alpha>) val" -type_notation val' ("\<cdot>(_)") - -(* 23 ************************************ 32 + 1 *) (* term Floor1_infra.print_infra_type_synonym_class_higher *) -type_synonym OclAny = "\<langle>\<langle>ty\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y\<rangle>\<^sub>\<bottom>\<rangle>\<^sub>\<bottom>" - -(* 24 ************************************ 33 + 0 *) (* term Floor1_infra.print_infra_type_synonym_class_rec *) - -(* 25 ************************************ 33 + 0 *) (* term Floor1_infra.print_infra_enum_syn *) - -(* 26 ************************************ 33 + 1 *) -text \<open> - To reuse key-elements of the library like referential equality, we have -to show that the object universe belongs to the type class ``oclany,'' \ie, - each class type has to provide a function @{term oid_of} yielding the Object ID (oid) of the object. \<close> - -(* 27 ************************************ 34 + 1 *) (* term Floor1_infra.print_infra_instantiation_class *) -instantiation ty\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y :: object -begin - definition oid_of_ty\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_def : "oid_of = (\<lambda> mk\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y t \<Rightarrow> (case t of (mk\<E>\<X>\<T>\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y (t)) \<Rightarrow> t))" - instance .. -end - -(* 28 ************************************ 35 + 1 *) (* term Floor1_infra.print_infra_instantiation_universe *) -instantiation \<AA> :: object -begin - definition oid_of_\<AA>_def : "oid_of = (\<lambda> in\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y OclAny \<Rightarrow> oid_of OclAny)" - instance .. -end - -(* 29 ************************************ 36 + 1 *) -section \<open>Class Model: Instantiation of the Generic Strict Equality\<close> - -(* 30 ************************************ 37 + 1 *) -text \<open> - We instantiate the referential equality -on @{text "Person"} and @{text "OclAny"} \<close> - -(* 31 ************************************ 38 + 1 *) (* term Floor1_infra.print_instantia_def_strictrefeq *) -overloading StrictRefEq \<equiv> "(StrictRefEq::(\<cdot>OclAny) \<Rightarrow> _ \<Rightarrow> _)" -begin - definition StrictRefEq\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y : "(x::\<cdot>OclAny) \<doteq> y \<equiv> StrictRefEq\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t x y" -end - -(* 32 ************************************ 39 + 1 *) (* term Floor1_infra.print_instantia_lemmas_strictrefeq *) -lemmas[simp,code_unfold] = StrictRefEq\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y - -(* 33 ************************************ 40 + 1 *) -text \<open> - For each Class \emph{C}, we will have a casting operation \inlineocl{.oclAsType($C$)}, - a test on the actual type \inlineocl{.oclIsTypeOf($C$)} as well as its relaxed form - \inlineocl{.oclIsKindOf($C$)} (corresponding exactly to Java's \verb+instanceof+-operator. -\<close> - -(* 34 ************************************ 41 + 1 *) -text \<open> - Thus, since we have two class-types in our concrete class hierarchy, we have -two operations to declare and to provide two overloading definitions for the two static types. -\<close> - -(* 35 ************************************ 42 + 1 *) -section \<open>Class Model: OclAsType\<close> - -(* 36 ************************************ 43 + 1 *) -subsection \<open>Definition\<close> - -(* 37 ************************************ 44 + 1 *) (* term Floor1_astype.print_astype_consts *) -consts OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y :: "'\<alpha> \<Rightarrow> \<cdot>OclAny" ("(_) .oclAsType'(OclAny')") - -(* 38 ************************************ 45 + 1 *) (* term Floor1_astype.print_astype_class *) -overloading OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y \<equiv> "(OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y::(\<cdot>OclAny) \<Rightarrow> _)" -begin - definition OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny : "(x::\<cdot>OclAny) .oclAsType(OclAny) \<equiv> x" -end - -(* 39 ************************************ 46 + 1 *) (* term Floor1_astype.print_astype_from_universe *) -definition "OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_\<AA> = Some o (\<lambda> (in\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y (OclAny)) \<Rightarrow> OclAny)" - -(* 40 ************************************ 47 + 1 *) (* term Floor1_astype.print_astype_lemmas_id *) -lemmas[simp,code_unfold] = OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny - -(* 41 ************************************ 48 + 1 *) -subsection \<open>Context Passing\<close> - -(* 42 ************************************ 49 + 1 *) (* term Floor1_astype.print_astype_lemma_cp *) -lemma cp_OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_OclAny : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>OclAny)))::\<cdot>OclAny) .oclAsType(OclAny)))))" -sorry - -(* 43 ************************************ 50 + 1 *) (* term Floor1_astype.print_astype_lemmas_cp *) -lemmas[simp,code_unfold] = cp_OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_OclAny - -(* 44 ************************************ 51 + 1 *) -subsection \<open>Execution with Invalid or Null as Argument\<close> - -(* 45 ************************************ 52 + 2 *) (* term Floor1_astype.print_astype_lemma_strict *) -lemma OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_invalid : "((invalid::\<cdot>OclAny) .oclAsType(OclAny)) = invalid" -sorry -lemma OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_null : "((null::\<cdot>OclAny) .oclAsType(OclAny)) = null" -sorry - -(* 46 ************************************ 54 + 1 *) (* term Floor1_astype.print_astype_lemmas_strict *) -lemmas[simp,code_unfold] = OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_invalid - OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_null - -(* 47 ************************************ 55 + 1 *) -subsection \<open>Validity and Definedness Properties\<close> - -(* 48 ************************************ 56 + 0 *) (* term Floor1_astype.print_astype_defined *) - -(* 49 ************************************ 56 + 1 *) -subsection \<open>Up Down Casting\<close> - -(* 50 ************************************ 57 + 0 *) (* term Floor1_astype.print_astype_up_d_cast0 *) - -(* 51 ************************************ 57 + 0 *) (* term Floor1_astype.print_astype_up_d_cast *) - -(* 52 ************************************ 57 + 0 *) (* term Floor1_astype.print_astype_d_up_cast *) - -(* 53 ************************************ 57 + 1 *) -subsection \<open>Const\<close> - -(* 54 ************************************ 58 + 1 *) (* term Floor1_astype.print_astype_lemma_const *) -lemma OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_const : "(const ((X::\<cdot>OclAny))) \<Longrightarrow> (const (X .oclAsType(OclAny)))" -sorry - -(* 55 ************************************ 59 + 1 *) (* term Floor1_astype.print_astype_lemmas_const *) -lemmas[simp,code_unfold] = OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_const - -(* 56 ************************************ 60 + 1 *) -section \<open>Class Model: OclIsTypeOf\<close> - -(* 57 ************************************ 61 + 1 *) -subsection \<open>Definition\<close> - -(* 58 ************************************ 62 + 1 *) (* term Floor1_istypeof.print_istypeof_consts *) -consts OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y :: "'\<alpha> \<Rightarrow> Boolean" ("(_) .oclIsTypeOf'(OclAny')") - -(* 59 ************************************ 63 + 1 *) (* term Floor1_istypeof.print_istypeof_class *) -overloading OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y \<equiv> "(OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y::(\<cdot>OclAny) \<Rightarrow> _)" -begin - definition OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny : "(x::\<cdot>OclAny) .oclIsTypeOf(OclAny) \<equiv> (\<lambda>\<tau>. (case (x (\<tau>)) of \<bottom> \<Rightarrow> (invalid (\<tau>)) - | \<lfloor>\<bottom>\<rfloor> \<Rightarrow> (true (\<tau>)) - | \<lfloor>\<lfloor>(mk\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y ((mk\<E>\<X>\<T>\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y (_))))\<rfloor>\<rfloor> \<Rightarrow> (true (\<tau>))))" -end - -(* 60 ************************************ 64 + 1 *) (* term Floor1_istypeof.print_istypeof_from_universe *) -definition "OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_\<AA> = (\<lambda> (in\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y (OclAny)) \<Rightarrow> (((((\<lambda>x _. \<lfloor>\<lfloor>x\<rfloor>\<rfloor>)) (OclAny))::\<cdot>OclAny) .oclIsTypeOf(OclAny)))" - -(* 61 ************************************ 65 + 1 *) (* term Floor1_istypeof.print_istypeof_lemmas_id *) -lemmas[simp,code_unfold] = OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny - -(* 62 ************************************ 66 + 1 *) -subsection \<open>Context Passing\<close> - -(* 63 ************************************ 67 + 1 *) (* term Floor1_istypeof.print_istypeof_lemma_cp *) -lemma cp_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_OclAny : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>OclAny)))::\<cdot>OclAny) .oclIsTypeOf(OclAny)))))" -sorry - -(* 64 ************************************ 68 + 1 *) (* term Floor1_istypeof.print_istypeof_lemmas_cp *) -lemmas[simp,code_unfold] = cp_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_OclAny - -(* 65 ************************************ 69 + 1 *) -subsection \<open>Execution with Invalid or Null as Argument\<close> - -(* 66 ************************************ 70 + 2 *) (* term Floor1_istypeof.print_istypeof_lemma_strict *) -lemma OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_invalid : "((invalid::\<cdot>OclAny) .oclIsTypeOf(OclAny)) = invalid" -sorry -lemma OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_null : "((null::\<cdot>OclAny) .oclIsTypeOf(OclAny)) = true" -sorry - -(* 67 ************************************ 72 + 1 *) (* term Floor1_istypeof.print_istypeof_lemmas_strict *) -lemmas[simp,code_unfold] = OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_invalid - OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_null - -(* 68 ************************************ 73 + 1 *) -subsection \<open>Validity and Definedness Properties\<close> - -(* 69 ************************************ 74 + 1 *) (* term Floor1_istypeof.print_istypeof_defined *) -lemma OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_defined : -assumes isdef: "\<tau> \<Turnstile> (\<upsilon> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>OclAny) .oclIsTypeOf(OclAny)))" -sorry - -(* 70 ************************************ 75 + 1 *) (* term Floor1_istypeof.print_istypeof_defined' *) -lemma OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_defined' : -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>OclAny) .oclIsTypeOf(OclAny)))" -sorry - -(* 71 ************************************ 76 + 1 *) -subsection \<open>Up Down Casting\<close> - -(* 72 ************************************ 77 + 0 *) (* term Floor1_istypeof.print_istypeof_up_larger *) - -(* 73 ************************************ 77 + 0 *) (* term Floor1_istypeof.print_istypeof_up_d_cast *) - -(* 74 ************************************ 77 + 1 *) -subsection \<open>Const\<close> - -(* 75 ************************************ 78 + 1 *) -section \<open>Class Model: OclIsKindOf\<close> - -(* 76 ************************************ 79 + 1 *) -subsection \<open>Definition\<close> - -(* 77 ************************************ 80 + 1 *) (* term Floor1_iskindof.print_iskindof_consts *) -consts OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y :: "'\<alpha> \<Rightarrow> Boolean" ("(_) .oclIsKindOf'(OclAny')") - -(* 78 ************************************ 81 + 1 *) (* term Floor1_iskindof.print_iskindof_class *) -overloading OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y \<equiv> "(OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y::(\<cdot>OclAny) \<Rightarrow> _)" -begin - definition OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny : "(x::\<cdot>OclAny) .oclIsKindOf(OclAny) \<equiv> (x .oclIsTypeOf(OclAny))" -end - -(* 79 ************************************ 82 + 1 *) (* term Floor1_iskindof.print_iskindof_from_universe *) -definition "OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_\<AA> = (\<lambda> (in\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y (OclAny)) \<Rightarrow> (((((\<lambda>x _. \<lfloor>\<lfloor>x\<rfloor>\<rfloor>)) (OclAny))::\<cdot>OclAny) .oclIsKindOf(OclAny)))" - -(* 80 ************************************ 83 + 1 *) (* term Floor1_iskindof.print_iskindof_lemmas_id *) -lemmas[simp,code_unfold] = OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny - -(* 81 ************************************ 84 + 1 *) -subsection \<open>Context Passing\<close> - -(* 82 ************************************ 85 + 1 *) (* term Floor1_iskindof.print_iskindof_lemma_cp *) -lemma cp_OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_OclAny : "(cp (p)) \<Longrightarrow> (cp ((\<lambda>x. (((p ((x::\<cdot>OclAny)))::\<cdot>OclAny) .oclIsKindOf(OclAny)))))" -sorry - -(* 83 ************************************ 86 + 1 *) (* term Floor1_iskindof.print_iskindof_lemmas_cp *) -lemmas[simp,code_unfold] = cp_OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_OclAny - -(* 84 ************************************ 87 + 1 *) -subsection \<open>Execution with Invalid or Null as Argument\<close> - -(* 85 ************************************ 88 + 2 *) (* term Floor1_iskindof.print_iskindof_lemma_strict *) -lemma OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_invalid : "((invalid::\<cdot>OclAny) .oclIsKindOf(OclAny)) = invalid" -sorry -lemma OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_null : "((null::\<cdot>OclAny) .oclIsKindOf(OclAny)) = true" -sorry - -(* 86 ************************************ 90 + 1 *) (* term Floor1_iskindof.print_iskindof_lemmas_strict *) -lemmas[simp,code_unfold] = OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_invalid - OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_null - -(* 87 ************************************ 91 + 1 *) -subsection \<open>Validity and Definedness Properties\<close> - -(* 88 ************************************ 92 + 1 *) (* term Floor1_iskindof.print_iskindof_defined *) -lemma OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_defined : -assumes isdef: "\<tau> \<Turnstile> (\<upsilon> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>OclAny) .oclIsKindOf(OclAny)))" -sorry - -(* 89 ************************************ 93 + 1 *) (* term Floor1_iskindof.print_iskindof_defined' *) -lemma OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_defined' : -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> (\<delta> ((X::\<cdot>OclAny) .oclIsKindOf(OclAny)))" -sorry - -(* 90 ************************************ 94 + 1 *) -subsection \<open>Up Down Casting\<close> - -(* 91 ************************************ 95 + 1 *) (* term Floor1_iskindof.print_iskindof_up_eq_asty *) -lemma actual_eq_static\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y : -assumes isdef: "\<tau> \<Turnstile> (\<delta> (X))" -shows "\<tau> \<Turnstile> ((X::\<cdot>OclAny) .oclIsKindOf(OclAny))" -sorry - -(* 92 ************************************ 96 + 0 *) (* term Floor1_iskindof.print_iskindof_up_larger *) - -(* 93 ************************************ 96 + 0 *) (* term Floor1_iskindof.print_iskindof_up_istypeof_unfold *) - -(* 94 ************************************ 96 + 0 *) (* term Floor1_iskindof.print_iskindof_up_istypeof *) - -(* 95 ************************************ 96 + 0 *) (* term Floor1_iskindof.print_iskindof_up_d_cast *) - -(* 96 ************************************ 96 + 1 *) -subsection \<open>Const\<close> - -(* 97 ************************************ 97 + 1 *) -section \<open>Class Model: OclAllInstances\<close> - -(* 98 ************************************ 98 + 1 *) -text \<open> - To denote \OCL-types occurring in \OCL expressions syntactically---as, for example, as -``argument'' of \inlineisar{oclAllInstances()}---we use the inverses of the injection -functions into the object universes; we show that this is sufficient ``characterization.'' \<close> - -(* 99 ************************************ 99 + 1 *) (* term Floor1_allinst.print_allinst_def_id *) -definition "OclAny = OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_\<AA>" - -(* 100 ************************************ 100 + 1 *) (* term Floor1_allinst.print_allinst_lemmas_id *) -lemmas[simp,code_unfold] = OclAny_def - -(* 101 ************************************ 101 + 1 *) (* term Floor1_allinst.print_allinst_astype *) -lemma OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_\<AA>_some : "(OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_\<AA> (x)) \<noteq> None" -sorry - -(* 102 ************************************ 102 + 3 *) (* term Floor1_allinst.print_allinst_exec *) -lemma OclAllInstances_generic\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_exec : -shows "(OclAllInstances_generic (pre_post) (OclAny)) = (\<lambda>\<tau>. (Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (\<lfloor>\<lfloor>Some ` OclAny ` (ran ((heap ((pre_post (\<tau>))))))\<rfloor>\<rfloor>)))" -sorry -lemma OclAllInstances_at_post\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_exec : -shows "(OclAllInstances_at_post (OclAny)) = (\<lambda>\<tau>. (Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (\<lfloor>\<lfloor>Some ` OclAny ` (ran ((heap ((snd (\<tau>))))))\<rfloor>\<rfloor>)))" -sorry -lemma OclAllInstances_at_pre\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_exec : -shows "(OclAllInstances_at_pre (OclAny)) = (\<lambda>\<tau>. (Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (\<lfloor>\<lfloor>Some ` OclAny ` (ran ((heap ((fst (\<tau>))))))\<rfloor>\<rfloor>)))" -sorry - -(* 103 ************************************ 105 + 1 *) -subsection \<open>OclIsTypeOf\<close> - -(* 104 ************************************ 106 + 2 *) (* term Floor1_allinst.print_allinst_istypeof_pre *) -lemma ex_ssubst : "(\<forall>x \<in> B. (s (x)) = (t (x))) \<Longrightarrow> (\<exists>x \<in> B. (P ((s (x))))) = (\<exists>x \<in> B. (P ((t (x)))))" -sorry -lemma ex_def : "x \<in> \<lceil>\<lceil>\<lfloor>\<lfloor>Some ` (X - {None})\<rfloor>\<rfloor>\<rceil>\<rceil> \<Longrightarrow> (\<exists>y. x = \<lfloor>\<lfloor>y\<rfloor>\<rfloor>)" -sorry - -(* 105 ************************************ 108 + 3 *) (* term Floor1_allinst.print_allinst_istypeof *) -lemma OclAny_OclAllInstances_generic_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y : "\<tau> \<Turnstile> (UML_Set.OclForall ((OclAllInstances_generic (pre_post) (OclAny))) (OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y))" -sorry -lemma OclAny_OclAllInstances_at_post_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y : -shows "\<tau> \<Turnstile> (UML_Set.OclForall ((OclAllInstances_at_post (OclAny))) (OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y))" -sorry -lemma OclAny_OclAllInstances_at_pre_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y : -shows "\<tau> \<Turnstile> (UML_Set.OclForall ((OclAllInstances_at_pre (OclAny))) (OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y))" -sorry - -(* 106 ************************************ 111 + 1 *) -subsection \<open>OclIsKindOf\<close> - -(* 107 ************************************ 112 + 3 *) (* term Floor1_allinst.print_allinst_iskindof_eq *) -lemma OclAny_OclAllInstances_generic_OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y : "\<tau> \<Turnstile> (UML_Set.OclForall ((OclAllInstances_generic (pre_post) (OclAny))) (OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y))" -sorry -lemma OclAny_OclAllInstances_at_post_OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y : -shows "\<tau> \<Turnstile> (UML_Set.OclForall ((OclAllInstances_at_post (OclAny))) (OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y))" -sorry -lemma OclAny_OclAllInstances_at_pre_OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y : -shows "\<tau> \<Turnstile> (UML_Set.OclForall ((OclAllInstances_at_pre (OclAny))) (OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y))" -sorry - -(* 108 ************************************ 115 + 0 *) (* term Floor1_allinst.print_allinst_iskindof_larger *) - -(* 109 ************************************ 115 + 1 *) -section \<open>Class Model: The Accessors\<close> - -(* 110 ************************************ 116 + 1 *) -text \<open>\<close> - -(* 111 ************************************ 117 + 1 *) -text \<open> - \label{sec:Meta-C-generatedeam-accessors}\<close> - -(* 112 ************************************ 118 + 1 *) -subsection \<open>Definition\<close> - -(* 113 ************************************ 119 + 1 *) -text \<open> - We start with a oid for the association; this oid can be used -in presence of association classes to represent the association inside an object, -pretty much similar to the \inlineisar+Employee_DesignModel_UMLPart+, where we stored -an \verb+oid+ inside the class as ``pointer.'' \<close> - -(* 114 ************************************ 120 + 0 *) (* term Floor1_access.print_access_oid_uniq_ml *) - -(* 115 ************************************ 120 + 0 *) (* term Floor1_access.print_access_oid_uniq *) - -(* 116 ************************************ 120 + 1 *) -text \<open> - From there on, we can already define an empty state which must contain -for $\mathit{oid}_{Person}\mathcal{BOSS}$ the empty relation (encoded as association list, since there are -associations with a Sequence-like structure).\<close> - -(* 117 ************************************ 121 + 5 *) (* term Floor1_access.print_access_eval_extract *) -definition "eval_extract x f = (\<lambda>\<tau>. (case x \<tau> of \<lfloor>\<lfloor>obj\<rfloor>\<rfloor> \<Rightarrow> (f ((oid_of (obj))) (\<tau>)) - | _ \<Rightarrow> invalid \<tau>))" -definition "in_pre_state = fst" -definition "in_post_state = snd" -definition "reconst_basetype = (\<lambda>x _. \<lfloor>\<lfloor>x\<rfloor>\<rfloor>)" -definition "reconst_basetype\<^sub>V\<^sub>o\<^sub>i\<^sub>d x = Abs_Void\<^sub>b\<^sub>a\<^sub>s\<^sub>e o (reconst_basetype (x))" - -(* 118 ************************************ 126 + 1 *) -text \<open> - The @{text pre_post}-parameter is configured with @{text fst} or -@{text snd}, the @{text to_from}-parameter either with the identity @{term id} or -the following combinator @{text switch}: \<close> - -(* 119 ************************************ 127 + 0 *) (* term Floor1_access.print_access_choose_ml *) - -(* 120 ************************************ 127 + 1 *) (* term Floor1_access.print_access_choose *) -definition "deref_assocs pre_post to_from assoc_oid f oid = (\<lambda>\<tau>. (case (assocs ((pre_post (\<tau>))) (assoc_oid)) of \<lfloor>S\<rfloor> \<Rightarrow> (f ((deref_assocs_list (to_from) (oid) (S))) (\<tau>)) - | _ \<Rightarrow> (invalid (\<tau>))))" - -(* 121 ************************************ 128 + 1 *) (* term Floor1_access.print_access_deref_oid *) -definition "deref_oid\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y fst_snd f oid = (\<lambda>\<tau>. (case (heap (fst_snd \<tau>) (oid)) of \<lfloor>in\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y obj\<rfloor> \<Rightarrow> f obj \<tau> - | _ \<Rightarrow> invalid \<tau>))" - -(* 122 ************************************ 129 + 0 *) (* term Floor1_access.print_access_deref_assocs *) - -(* 123 ************************************ 129 + 1 *) -text \<open> - pointer undefined in state or not referencing a type conform object representation \<close> - -(* 124 ************************************ 130 + 0 *) (* term Floor1_access.print_access_select *) - -(* 125 ************************************ 130 + 0 *) (* term Floor1_access.print_access_select_obj *) - -(* 126 ************************************ 130 + 0 *) (* term Floor1_access.print_access_dot_consts *) - -(* 127 ************************************ 130 + 0 *) (* term Floor1_access.print_access_dot *) - -(* 128 ************************************ 130 + 0 *) (* term Floor1_access.print_access_dot_lemmas_id *) - -(* 129 ************************************ 130 + 1 *) -subsection \<open>Context Passing\<close> - -(* 130 ************************************ 131 + 1 *) (* term Floor1_access.print_access_dot_cp_lemmas *) -lemmas[simp,code_unfold] = eval_extract_def - -(* 131 ************************************ 132 + 0 *) (* term Floor1_access.print_access_dot_lemma_cp *) - -(* 132 ************************************ 132 + 0 *) (* term Floor1_access.print_access_dot_lemmas_cp *) - -(* 133 ************************************ 132 + 1 *) -subsection \<open>Execution with Invalid or Null as Argument\<close> - -(* 134 ************************************ 133 + 0 *) (* term Floor1_access.print_access_lemma_strict *) - -(* 135 ************************************ 133 + 1 *) -subsection \<open>Representation in States\<close> - -(* 136 ************************************ 134 + 0 *) (* term Floor1_access.print_access_def_mono *) - -(* 137 ************************************ 134 + 0 *) (* term Floor1_access.print_access_is_repr *) - -(* 138 ************************************ 134 + 0 *) (* term Floor1_access.print_access_repr_allinst *) - -(* 139 ************************************ 134 + 1 *) -section \<open>Class Model: Towards the Object Instances\<close> - -(* 140 ************************************ 135 + 1 *) -text \<open>\<close> - -(* 141 ************************************ 136 + 1 *) -text_raw \<open>\<close> - -(* 142 ************************************ 137 + 1 *) -text \<open> - -The example we are defining in this section comes from the \autoref{fig:Meta-C-generatedeam1_system-states}. -\<close> - -(* 143 ************************************ 138 + 1 *) -text_raw \<open> -\begin{figure} -\includegraphics[width=\textwidth]{figures/pre-post.pdf} -\caption{(a) pre-state $\sigma_1$ and - (b) post-state $\sigma_1'$.} -\label{fig:Meta-C-generatedeam1_system-states} -\end{figure} -\<close> - -(* 144 ************************************ 139 + 1 *) (* term Floor1_examp.print_examp_def_st_defs *) -lemmas [simp,code_unfold] = state.defs - const_ss - -(* 145 ************************************ 140 + 0 *) (* term Floor1_astype.print_astype_lemmas_id2 *) - -(* 146 ************************************ 140 + 1 *) -section \<open>Haskell\<close> - -(* 147 ************************************ 141 + 230 *) (* term Floor1_haskabelle.print_haskell *) -old_datatype Position = Position0 "int" "string" "int" "int" - | NoPosition0 - | BuiltinPosition0 - | InternalPosition0 -definition "Position = Position0" -definition "NoPosition = NoPosition0" -definition "BuiltinPosition = BuiltinPosition0" -definition "InternalPosition = InternalPosition0" -type_synonym PosLength = "(Position, int) Product_Type.prod" -old_datatype Name = Name0 "int" -definition "Name = Name0" -old_datatype NodeInfo = OnlyPos0 "Position" "PosLength" - | NodeInfo0 "Position" "PosLength" "Name" -definition "OnlyPos = OnlyPos0" -definition "NodeInfo = NodeInfo0" -old_datatype Ident = Ident0 "string" "int" "NodeInfo" -definition "Ident = Ident0" -old_datatype SUERef = AnonymousRef0 "Name" - | NamedRef0 "Ident" -definition "AnonymousRef = AnonymousRef0" -definition "NamedRef = NamedRef0" -old_datatype CChar = CChar0 "char" "HOL.bool" - | CChars0 "char List.list" "HOL.bool" -definition "CChar = CChar0" -definition "CChars = CChars0" -old_datatype CIntRepr = DecRepr0 - | HexRepr0 - | OctalRepr0 -definition "DecRepr = DecRepr0" -definition "HexRepr = HexRepr0" -definition "OctalRepr = OctalRepr0" -old_datatype CIntFlag = FlagUnsigned0 - | FlagLong0 - | FlagLongLong0 - | FlagImag0 -definition "FlagUnsigned = FlagUnsigned0" -definition "FlagLong = FlagLong0" -definition "FlagLongLong = FlagLongLong0" -definition "FlagImag = FlagImag0" -old_datatype CFloat = CFloat0 "string" -definition "CFloat = CFloat0" -old_datatype ClangCVersion = ClangCVersion0 "string" -definition "ClangCVersion = ClangCVersion0" -old_datatype CString = CString0 "string" "HOL.bool" -definition "CString = CString0" -old_datatype 'f Flags = Flags0 "int" -definition "Flags = Flags0" -old_datatype CInteger = CInteger0 "int" "CIntRepr" "CIntFlag Flags" -definition "CInteger = CInteger0" -old_datatype CAssignOp = CAssignOp0 - | CMulAssOp0 - | CDivAssOp0 - | CRmdAssOp0 - | CAddAssOp0 - | CSubAssOp0 - | CShlAssOp0 - | CShrAssOp0 - | CAndAssOp0 - | CXorAssOp0 - | COrAssOp0 -definition "CAssignOp = CAssignOp0" -definition "CMulAssOp = CMulAssOp0" -definition "CDivAssOp = CDivAssOp0" -definition "CRmdAssOp = CRmdAssOp0" -definition "CAddAssOp = CAddAssOp0" -definition "CSubAssOp = CSubAssOp0" -definition "CShlAssOp = CShlAssOp0" -definition "CShrAssOp = CShrAssOp0" -definition "CAndAssOp = CAndAssOp0" -definition "CXorAssOp = CXorAssOp0" -definition "COrAssOp = COrAssOp0" -old_datatype CBinaryOp = CMulOp0 - | CDivOp0 - | CRmdOp0 - | CAddOp0 - | CSubOp0 - | CShlOp0 - | CShrOp0 - | CLeOp0 - | CGrOp0 - | CLeqOp0 - | CGeqOp0 - | CEqOp0 - | CNeqOp0 - | CAndOp0 - | CXorOp0 - | COrOp0 - | CLndOp0 - | CLorOp0 -definition "CMulOp = CMulOp0" -definition "CDivOp = CDivOp0" -definition "CRmdOp = CRmdOp0" -definition "CAddOp = CAddOp0" -definition "CSubOp = CSubOp0" -definition "CShlOp = CShlOp0" -definition "CShrOp = CShrOp0" -definition "CLeOp = CLeOp0" -definition "CGrOp = CGrOp0" -definition "CLeqOp = CLeqOp0" -definition "CGeqOp = CGeqOp0" -definition "CEqOp = CEqOp0" -definition "CNeqOp = CNeqOp0" -definition "CAndOp = CAndOp0" -definition "CXorOp = CXorOp0" -definition "COrOp = COrOp0" -definition "CLndOp = CLndOp0" -definition "CLorOp = CLorOp0" -old_datatype CUnaryOp = CPreIncOp0 - | CPreDecOp0 - | CPostIncOp0 - | CPostDecOp0 - | CAdrOp0 - | CIndOp0 - | CPlusOp0 - | CMinOp0 - | CCompOp0 - | CNegOp0 -definition "CPreIncOp = CPreIncOp0" -definition "CPreDecOp = CPreDecOp0" -definition "CPostIncOp = CPostIncOp0" -definition "CPostDecOp = CPostDecOp0" -definition "CAdrOp = CAdrOp0" -definition "CIndOp = CIndOp0" -definition "CPlusOp = CPlusOp0" -definition "CMinOp = CMinOp0" -definition "CCompOp = CCompOp0" -definition "CNegOp = CNegOp0" -old_datatype 'a CStorageSpecifier = CAuto0 "'a" - | CRegister0 "'a" - | CStatic0 "'a" - | CExtern0 "'a" - | CTypedef0 "'a" - | CThread0 "'a" -definition "CAuto = CAuto0" -definition "CRegister = CRegister0" -definition "CStatic = CStatic0" -definition "CExtern = CExtern0" -definition "CTypedef = CTypedef0" -definition "CThread = CThread0" -type_synonym CStorageSpec = "NodeInfo CStorageSpecifier" -old_datatype 'a CFunctionSpecifier = CInlineQual0 "'a" - | CNoreturnQual0 "'a" -definition "CInlineQual = CInlineQual0" -definition "CNoreturnQual = CNoreturnQual0" -type_synonym CFunSpec = "NodeInfo CFunctionSpecifier" -old_datatype CStructTag = CStructTag0 - | CUnionTag0 -definition "CStructTag = CStructTag0" -definition "CUnionTag = CUnionTag0" -old_datatype 'a CConstant = CIntConst0 "CInteger" "'a" - | CCharConst0 "CChar" "'a" - | CFloatConst0 "CFloat" "'a" - | CStrConst0 "CString" "'a" -definition "CIntConst = CIntConst0" -definition "CCharConst = CCharConst0" -definition "CFloatConst = CFloatConst0" -definition "CStrConst = CStrConst0" -type_synonym CConst = "NodeInfo CConstant" -old_datatype 'a CStringLiteral = CStrLit0 "CString" "'a" -definition "CStrLit = CStrLit0" -old_datatype 'a CFunctionDef = CFunDef0 "'a CDeclarationSpecifier List.list" "'a CDeclarator" "'a CDeclaration List.list" "'a CStatement" "'a" -and 'a CDeclaration = CDecl0 "'a CDeclarationSpecifier List.list" "(('a CDeclarator C_Model_init.option, 'a CInitializer C_Model_init.option) Product_Type.prod, 'a CExpression C_Model_init.option) Product_Type.prod List.list" "'a" - | CStaticAssert0 "'a CExpression" "'a CStringLiteral" "'a" -and 'a CDeclarator = CDeclr0 "Ident C_Model_init.option" "'a CDerivedDeclarator List.list" "'a CStringLiteral C_Model_init.option" "'a CAttribute List.list" "'a" -and 'a CDerivedDeclarator = CPtrDeclr0 "'a CTypeQualifier List.list" "'a" - | CArrDeclr0 "'a CTypeQualifier List.list" "'a CArraySize" "'a" - | CFunDeclr0 "(Ident List.list, ('a CDeclaration List.list, HOL.bool) Product_Type.prod) C_Model_init.Either" "'a CAttribute List.list" "'a" -and 'a CArraySize = CNoArrSize0 "HOL.bool" - | CArrSize0 "HOL.bool" "'a CExpression" -and 'a CStatement = CLabel0 "Ident" "'a CStatement" "'a CAttribute List.list" "'a" - | CCase0 "'a CExpression" "'a CStatement" "'a" - | CCases0 "'a CExpression" "'a CExpression" "'a CStatement" "'a" - | CDefault0 "'a CStatement" "'a" - | CExpr0 "'a CExpression C_Model_init.option" "'a" - | CCompound0 "Ident List.list" "'a CCompoundBlockItem List.list" "'a" - | CIf0 "'a CExpression" "'a CStatement" "'a CStatement C_Model_init.option" "'a" - | CSwitch0 "'a CExpression" "'a CStatement" "'a" - | CWhile0 "'a CExpression" "'a CStatement" "HOL.bool" "'a" - | CFor0 "('a CExpression C_Model_init.option, 'a CDeclaration) C_Model_init.Either" "'a CExpression C_Model_init.option" "'a CExpression C_Model_init.option" "'a CStatement" "'a" - | CGoto0 "Ident" "'a" - | CGotoPtr0 "'a CExpression" "'a" - | CCont0 "'a" - | CBreak0 "'a" - | CReturn0 "'a CExpression C_Model_init.option" "'a" - | CAsm0 "'a CAssemblyStatement" "'a" -and 'a CAssemblyStatement = CAsmStmt0 "'a CTypeQualifier C_Model_init.option" "'a CStringLiteral" "'a CAssemblyOperand List.list" "'a CAssemblyOperand List.list" "'a CStringLiteral List.list" "'a" -and 'a CAssemblyOperand = CAsmOperand0 "Ident C_Model_init.option" "'a CStringLiteral" "'a CExpression" "'a" -and 'a CCompoundBlockItem = CBlockStmt0 "'a CStatement" - | CBlockDecl0 "'a CDeclaration" - | CNestedFunDef0 "'a CFunctionDef" -and 'a CDeclarationSpecifier = CStorageSpec0 "'a CStorageSpecifier" - | CTypeSpec0 "'a CTypeSpecifier" - | CTypeQual0 "'a CTypeQualifier" - | CFunSpec0 "'a CFunctionSpecifier" - | CAlignSpec0 "'a CAlignmentSpecifier" -and 'a CTypeSpecifier = CVoidType0 "'a" - | CCharType0 "'a" - | CShortType0 "'a" - | CIntType0 "'a" - | CLongType0 "'a" - | CFloatType0 "'a" - | CDoubleType0 "'a" - | CSignedType0 "'a" - | CUnsigType0 "'a" - | CBoolType0 "'a" - | CComplexType0 "'a" - | CInt128Type0 "'a" - | CSUType0 "'a CStructureUnion" "'a" - | CEnumType0 "'a CEnumeration" "'a" - | CTypeDef0 "Ident" "'a" - | CTypeOfExpr0 "'a CExpression" "'a" - | CTypeOfType0 "'a CDeclaration" "'a" - | CAtomicType0 "'a CDeclaration" "'a" -and 'a CTypeQualifier = CConstQual0 "'a" - | CVolatQual0 "'a" - | CRestrQual0 "'a" - | CAtomicQual0 "'a" - | CAttrQual0 "'a CAttribute" - | CNullableQual0 "'a" - | CNonnullQual0 "'a" -and 'a CAlignmentSpecifier = CAlignAsType0 "'a CDeclaration" "'a" - | CAlignAsExpr0 "'a CExpression" "'a" -and 'a CStructureUnion = CStruct0 "CStructTag" "Ident C_Model_init.option" "'a CDeclaration List.list C_Model_init.option" "'a CAttribute List.list" "'a" -and 'a CEnumeration = CEnum0 "Ident C_Model_init.option" "(Ident, 'a CExpression C_Model_init.option) Product_Type.prod List.list C_Model_init.option" "'a CAttribute List.list" "'a" -and 'a CInitializer = CInitExpr0 "'a CExpression" "'a" - | CInitList0 "('a CPartDesignator List.list, 'a CInitializer) Product_Type.prod List.list" "'a" -and 'a CPartDesignator = CArrDesig0 "'a CExpression" "'a" - | CMemberDesig0 "Ident" "'a" - | CRangeDesig0 "'a CExpression" "'a CExpression" "'a" -and 'a CAttribute = CAttr0 "Ident" "'a CExpression List.list" "'a" -and 'a CExpression = CComma0 "'a CExpression List.list" "'a" - | CAssign0 "CAssignOp" "'a CExpression" "'a CExpression" "'a" - | CCond0 "'a CExpression" "'a CExpression C_Model_init.option" "'a CExpression" "'a" - | CBinary0 "CBinaryOp" "'a CExpression" "'a CExpression" "'a" - | CCast0 "'a CDeclaration" "'a CExpression" "'a" - | CUnary0 "CUnaryOp" "'a CExpression" "'a" - | CSizeofExpr0 "'a CExpression" "'a" - | CSizeofType0 "'a CDeclaration" "'a" - | CAlignofExpr0 "'a CExpression" "'a" - | CAlignofType0 "'a CDeclaration" "'a" - | CComplexReal0 "'a CExpression" "'a" - | CComplexImag0 "'a CExpression" "'a" - | CIndex0 "'a CExpression" "'a CExpression" "'a" - | CCall0 "'a CExpression" "'a CExpression List.list" "'a" - | CMember0 "'a CExpression" "Ident" "HOL.bool" "'a" - | CVar0 "Ident" "'a" - | CConst0 "'a CConstant" - | CCompoundLit0 "'a CDeclaration" "('a CPartDesignator List.list, 'a CInitializer) Product_Type.prod List.list" "'a" - | CGenericSelection0 "'a CExpression" "('a CDeclaration C_Model_init.option, 'a CExpression) Product_Type.prod List.list" "'a" - | CStatExpr0 "'a CStatement" "'a" - | CLabAddrExpr0 "Ident" "'a" - | CBuiltinExpr0 "'a CBuiltinThing" -and 'a CBuiltinThing = CBuiltinVaArg0 "'a CExpression" "'a CDeclaration" "'a" - | CBuiltinOffsetOf0 "'a CDeclaration" "'a CPartDesignator List.list" "'a" - | CBuiltinTypesCompatible0 "'a CDeclaration" "'a CDeclaration" "'a" -definition "CFunDef = CFunDef0" -definition "CDecl = CDecl0" -definition "CStaticAssert = CStaticAssert0" -definition "CDeclr = CDeclr0" -definition "CPtrDeclr = CPtrDeclr0" -definition "CArrDeclr = CArrDeclr0" -definition "CFunDeclr = CFunDeclr0" -definition "CNoArrSize = CNoArrSize0" -definition "CArrSize = CArrSize0" -definition "CLabel = CLabel0" -definition "CCase = CCase0" -definition "CCases = CCases0" -definition "CDefault = CDefault0" -definition "CExpr = CExpr0" -definition "CCompound = CCompound0" -definition "CIf = CIf0" -definition "CSwitch = CSwitch0" -definition "CWhile = CWhile0" -definition "CFor = CFor0" -definition "CGoto = CGoto0" -definition "CGotoPtr = CGotoPtr0" -definition "CCont = CCont0" -definition "CBreak = CBreak0" -definition "CReturn = CReturn0" -definition "CAsm = CAsm0" -definition "CAsmStmt = CAsmStmt0" -definition "CAsmOperand = CAsmOperand0" -definition "CBlockStmt = CBlockStmt0" -definition "CBlockDecl = CBlockDecl0" -definition "CNestedFunDef = CNestedFunDef0" -definition "CStorageSpec = CStorageSpec0" -definition "CTypeSpec = CTypeSpec0" -definition "CTypeQual = CTypeQual0" -definition "CFunSpec = CFunSpec0" -definition "CAlignSpec = CAlignSpec0" -definition "CVoidType = CVoidType0" -definition "CCharType = CCharType0" -definition "CShortType = CShortType0" -definition "CIntType = CIntType0" -definition "CLongType = CLongType0" -definition "CFloatType = CFloatType0" -definition "CDoubleType = CDoubleType0" -definition "CSignedType = CSignedType0" -definition "CUnsigType = CUnsigType0" -definition "CBoolType = CBoolType0" -definition "CComplexType = CComplexType0" -definition "CInt128Type = CInt128Type0" -definition "CSUType = CSUType0" -definition "CEnumType = CEnumType0" -definition "CTypeDef = CTypeDef0" -definition "CTypeOfExpr = CTypeOfExpr0" -definition "CTypeOfType = CTypeOfType0" -definition "CAtomicType = CAtomicType0" -definition "CConstQual = CConstQual0" -definition "CVolatQual = CVolatQual0" -definition "CRestrQual = CRestrQual0" -definition "CAtomicQual = CAtomicQual0" -definition "CAttrQual = CAttrQual0" -definition "CNullableQual = CNullableQual0" -definition "CNonnullQual = CNonnullQual0" -definition "CAlignAsType = CAlignAsType0" -definition "CAlignAsExpr = CAlignAsExpr0" -definition "CStruct = CStruct0" -definition "CEnum = CEnum0" -definition "CInitExpr = CInitExpr0" -definition "CInitList = CInitList0" -definition "CArrDesig = CArrDesig0" -definition "CMemberDesig = CMemberDesig0" -definition "CRangeDesig = CRangeDesig0" -definition "CAttr = CAttr0" -definition "CComma = CComma0" -definition "CAssign = CAssign0" -definition "CCond = CCond0" -definition "CBinary = CBinary0" -definition "CCast = CCast0" -definition "CUnary = CUnary0" -definition "CSizeofExpr = CSizeofExpr0" -definition "CSizeofType = CSizeofType0" -definition "CAlignofExpr = CAlignofExpr0" -definition "CAlignofType = CAlignofType0" -definition "CComplexReal = CComplexReal0" -definition "CComplexImag = CComplexImag0" -definition "CIndex = CIndex0" -definition "CCall = CCall0" -definition "CMember = CMember0" -definition "CVar = CVar0" -definition "CConst = CConst0" -definition "CCompoundLit = CCompoundLit0" -definition "CGenericSelection = CGenericSelection0" -definition "CStatExpr = CStatExpr0" -definition "CLabAddrExpr = CLabAddrExpr0" -definition "CBuiltinExpr = CBuiltinExpr0" -definition "CBuiltinVaArg = CBuiltinVaArg0" -definition "CBuiltinOffsetOf = CBuiltinOffsetOf0" -definition "CBuiltinTypesCompatible = CBuiltinTypesCompatible0" -type_synonym 'a CInitializerList = "('a CPartDesignator List.list, 'a CInitializer) Product_Type.prod List.list" -old_datatype 'a CExternalDeclaration = CDeclExt0 "'a CDeclaration" - | CFDefExt0 "'a CFunctionDef" - | CAsmExt0 "'a CStringLiteral" "'a" -definition "CDeclExt = CDeclExt0" -definition "CFDefExt = CFDefExt0" -definition "CAsmExt = CAsmExt0" -old_datatype 'a CTranslationUnit = CTranslUnit0 "'a CExternalDeclaration List.list" "'a" -definition "CTranslUnit = CTranslUnit0" -type_synonym CTranslUnit = "NodeInfo CTranslationUnit" -type_synonym CExtDecl = "NodeInfo CExternalDeclaration" -type_synonym CFunDef = "NodeInfo CFunctionDef" -type_synonym CDecl = "NodeInfo CDeclaration" -type_synonym CDeclr = "NodeInfo CDeclarator" -type_synonym CDerivedDeclr = "NodeInfo CDerivedDeclarator" -type_synonym CArrSize = "NodeInfo CArraySize" -type_synonym CStat = "NodeInfo CStatement" -type_synonym CAsmStmt = "NodeInfo CAssemblyStatement" -type_synonym CAsmOperand = "NodeInfo CAssemblyOperand" -type_synonym CBlockItem = "NodeInfo CCompoundBlockItem" -type_synonym CDeclSpec = "NodeInfo CDeclarationSpecifier" -type_synonym CTypeSpec = "NodeInfo CTypeSpecifier" -type_synonym CTypeQual = "NodeInfo CTypeQualifier" -type_synonym CAlignSpec = "NodeInfo CAlignmentSpecifier" -type_synonym CStructUnion = "NodeInfo CStructureUnion" -type_synonym CEnum = "NodeInfo CEnumeration" -type_synonym CInit = "NodeInfo CInitializer" -type_synonym CInitList = "NodeInfo CInitializerList" -type_synonym CDesignator = "NodeInfo CPartDesignator" -type_synonym CAttr = "NodeInfo CAttribute" -type_synonym CExpr = "NodeInfo CExpression" -type_synonym CBuiltin = "NodeInfo CBuiltinThing" -type_synonym CStrLit = "NodeInfo CStringLiteral" - -end diff --git a/Citadelle/examples/AbstractList.thy b/Citadelle/examples/AbstractList.thy deleted file mode 100644 index 0c862d10fe018f18f3c5c8fe9461d788b7c3c7a8..0000000000000000000000000000000000000000 --- a/Citadelle/examples/AbstractList.thy +++ /dev/null @@ -1,87 +0,0 @@ -(****************************************************************************** - * 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{* Example: Abstract List *} - -theory - AbstractList -imports - FOCL.UML_OCL -begin - -generation_syntax [ shallow ] - -section{* The Class Model *} - - -Class List - Attributes content : Sequence(Integer) -End! - -section{* ... and its Annotation by OCL Constraints *} - -Context List - Inv asc : "Integer ->forAll\<^sub>S\<^sub>e\<^sub>t(i | (\<zero><\<^sub>i\<^sub>n\<^sub>t i and i <\<^sub>i\<^sub>n\<^sub>t (self .content ->size\<^sub>S\<^sub>e\<^sub>q())) implies - (self .content ->at\<^sub>S\<^sub>e\<^sub>q(i) <\<^sub>i\<^sub>n\<^sub>t self .content ->at\<^sub>S\<^sub>e\<^sub>q(i +\<^sub>i\<^sub>n\<^sub>t \<one>)))" - - -Context List :: insert(x:Integer) : Void - Post : "if (self .content \<doteq> null) - then (self .content) \<triangleq> Sequence{x} - else (self .content) \<triangleq> (self .content@pre) - endif" - -section{* Instances and States of the Class Model *} - -Instance l1 :: List = [ content = [1,3] ] - l2 :: List = [ content = [1,2,3] ] - - -State \<sigma>\<^sub>1 = [ l1 ] -State \<sigma>\<^sub>1' = [ l1, l2 ] - -Transition \<sigma>\<^sub>1 \<sigma>\<^sub>1' - -section{* Proof of State-Consistency and Implementability of ``insert'' *} - -lemmas [simp,code_unfold] = dot_accessor - -end diff --git a/Citadelle/examples/Bank_Model.thy b/Citadelle/examples/Bank_Model.thy deleted file mode 100644 index dd6d2c1a3629c2ead193ef82949197602ad92589..0000000000000000000000000000000000000000 --- a/Citadelle/examples/Bank_Model.thy +++ /dev/null @@ -1,135 +0,0 @@ -(****************************************************************************** - * 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_Model -imports - FOCL.UML_OCL -begin - -Class Bank - Attributes name : String - -Class Client - Attributes clientname : String - address : String - age : Integer - -term id - -Class Account - Attributes id : Integer - balance : Currency - -Association clients - Between Bank [1 \<bullet>\<bullet> *] Role banks - Client [1 \<bullet>\<bullet> *] Role clients - -Association owner - Between Account [1 \<bullet>\<bullet> *] Role c_accounts - Client [1] Role owner - -Association bank - Between Account [1 \<bullet>\<bullet> *] Role b_accounts - Bank [1] Role bank - -term max - -Class Savings < Account - Attributes max : Currency - -Class Current < Account - Attributes overdraft : Currency - -Class Currency = Real - -Instance Saving1 = ([ max = 2000 ] :: Savings) \<rightarrow> oclAsType( Account ) - and Client1 :: Client = [ c_accounts = Saving1 , banks = Bank1 ] - and Account1 :: Account = [ id = 250 , owner = Client1 ] - and Bank1 :: Bank = [ b_accounts = [ Saving1 , Account1 ], name = "\<infinity>\<heartsuit> \<Longleftrightarrow> \<infinity>\<epsilon>" (* (* TODO latex *) \<euro> *) ] - -State \<sigma>\<^sub>1' = - [ Account1, Client1, Bank1, Saving1 ] - -State ss = [] - -Transition ss \<sigma>\<^sub>1' - -BaseType [ 25, 250.0 ] - -Context c: Savings - Inv "\<zero>.\<zero> <\<^sub>r\<^sub>e\<^sub>a\<^sub>l (c .max)" - Inv "c .balance \<le>\<^sub>r\<^sub>e\<^sub>a\<^sub>l (c .max) and \<zero>.\<zero> \<le>\<^sub>r\<^sub>e\<^sub>a\<^sub>l (c .balance)" - -Context c: Current - Inv "\<two>\<five> \<le>\<^sub>i\<^sub>n\<^sub>t (c .owner .age) implies (c .overdraft \<doteq> \<two>\<five>\<zero>.\<zero>)" - Inv "c .owner .age <\<^sub>i\<^sub>n\<^sub>t \<two>\<five> implies (c .overdraft \<doteq> \<zero>.\<zero>)" - -Context c: Client - Inv "c .banks ->forAll\<^sub>S\<^sub>e\<^sub>t(b | b .b_accounts ->select\<^sub>S\<^sub>e\<^sub>t(a | (a .owner \<doteq> c) and - (a .oclIsTypeOf(Current))) - ->size\<^sub>S\<^sub>e\<^sub>t() \<le>\<^sub>i\<^sub>n\<^sub>t \<one>)" - -Context Bank :: create_client (clientname : String, age : Integer, bank : Bank) : Integer - Pre "bank .clients ->forAll\<^sub>S\<^sub>e\<^sub>t(c | c .clientname <> clientname or (c .age <> age))" - Post "bank .clients ->exists\<^sub>S\<^sub>e\<^sub>t(c | c .clientname \<doteq> clientname and (c .age \<doteq> age))" - - -Context Account :: get_balance (c : String, no : Integer) : Real - Pre "self .id \<doteq> no and ((self .owner .clientname) \<doteq> c)" - Post "result \<doteq> (self .balance)" - -Context Account :: deposit (c : String, no : Integer, amount:Real) : Real - Pre "self .id \<doteq> no and ((self .owner .clientname) \<doteq> c) and (\<zero>.\<zero> \<le>\<^sub>r\<^sub>e\<^sub>a\<^sub>l amount)" - Post "self .balance \<doteq> (self .balance@pre +\<^sub>r\<^sub>e\<^sub>a\<^sub>l amount)" - -Context Account :: withdraw (c : String, no : Integer, amount:Real) : Real - Pre "self .id \<doteq> no and ((self .owner .clientname) \<doteq> c) and (\<zero>.\<zero> \<le>\<^sub>r\<^sub>e\<^sub>a\<^sub>l amount)" - Post "self .balance \<doteq> (self .balance@pre -\<^sub>r\<^sub>e\<^sub>a\<^sub>l amount)" - - -(*generation_syntax deep flush_all*) - -lemmas [simp,code_unfold] = dot_accessor - -end diff --git a/Citadelle/examples/Bank_Test_Model.thy b/Citadelle/examples/Bank_Test_Model.thy deleted file mode 100644 index 77aa3174d01cb22aaec5dce1449668797859ab76..0000000000000000000000000000000000000000 --- a/Citadelle/examples/Bank_Test_Model.thy +++ /dev/null @@ -1,238 +0,0 @@ -(****************************************************************************** - * 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 diff --git a/Citadelle/examples/C_Model_core.thy b/Citadelle/examples/C_Model_core.thy deleted file mode 100644 index d189c20eb744f5ce92c8e2ebc8eea48e1f1777b1..0000000000000000000000000000000000000000 --- a/Citadelle/examples/C_Model_core.thy +++ /dev/null @@ -1,96 +0,0 @@ -(****************************************************************************** - * A Meta-Model for the Language.C Haskell Library - * - * Copyright (c) 2016-2017 Nanyang Technological University, Singapore - * 2017-2018 Virginia Tech, USA - * 2018-2019 Université Paris-Saclay, Univ. Paris-Sud, France - * - * 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 C_Model_core - imports "$HASKABELLE_HOME_USER/default/Prelude" - "FOCL.UML_Main" - "Citadelle.Generator_dynamic_concurrent" - "Citadelle_C_init.C_Model_init" -begin - -section \<open>Acknowledgements\<close> - -text \<open>\<^url>\<open>https://hackage.haskell.org/package/language-c\<close>\<close> -text \<open>\<^url>\<open>https://hackage.haskell.org/package/language-c-comments\<close>\<close> -text \<open>\<^file>\<open>$HASKABELLE_HOME/ex/language-c/AUTHORS.c2hs\<close>\<close> -text \<open>\<^file>\<open>$HASKABELLE_HOME/ex/language-c/AUTHORS\<close>\<close> - -section \<open>Initialization of the generator\<close> - -declare [[syntax_ambiguity_warning = false]] - -generation_syntax [ deep - (THEORY Meta_C_generated) - (IMPORTS ["FOCL.UML_Main", "FOCL.Static", "Citadelle_C_init.C_Model_init"] - "Citadelle.Generator_dynamic_concurrent") - SECTION - SORRY - [ in self ] - (output_directory "../doc") - , shallow SORRY ] - -section \<open>Type definition\<close> - -End! - -text \<open> \<^file>\<open>$HASKABELLE_HOME/ex/language-c/src/Language/C/Data/Name.hs\<close> - \<^file>\<open>$HASKABELLE_HOME/ex/language-c/src/Language/C/Data/Position.hs\<close> - \<^file>\<open>$HASKABELLE_HOME/ex/language-c/src/Language/C/Data/Node.hs\<close> - \<^file>\<open>$HASKABELLE_HOME/ex/language-c/src/Language/C/Data/Ident.hs\<close> - \<^file>\<open>$HASKABELLE_HOME/ex/language-c/src/Language/C/Syntax/Ops.hs\<close> - \<^file>\<open>$HASKABELLE_HOME/ex/language-c/src/Language/C/Syntax/Constants.hs\<close> \<close> - -hide_const (open) Name - -Haskell_file datatype_old try_import only_types concat_modules - base_path "$HASKABELLE_HOME/ex/language-c/src" - [Prelude \<rightharpoonup> C_Model_init, Int, String, Option \<rightharpoonup> C_Model_init] - (**) - "$HASKABELLE_HOME/ex/language-c/src/Language/C/Syntax/AST.hs" - -text \<open>@{typ CTranslUnit}\<close> - -datatype CommentFormat = SingleLine | MultiLine -datatype Comment = Comment Position string CommentFormat - -section \<open>Garbage Collection of Notations\<close> - -hide_type (open) int -hide_type (open) string - -end diff --git a/Citadelle/examples/C_Model_ex_hol.thy b/Citadelle/examples/C_Model_ex_hol.thy deleted file mode 100644 index 15d3b0fd5d913f7be143226f1ff0a29d595eea0d..0000000000000000000000000000000000000000 --- a/Citadelle/examples/C_Model_ex_hol.thy +++ /dev/null @@ -1,137 +0,0 @@ -(****************************************************************************** - * A Meta-Model for the Language.C Haskell Library - * - * Copyright (c) 2016-2017 Nanyang Technological University, Singapore - * 2017-2018 Virginia Tech, USA - * 2018-2019 Université Paris-Saclay, Univ. Paris-Sud, France - * - * 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 C_Model_ex_hol - imports "Citadelle_C_shallow-dirty.C_Model_core" -begin - -section \<open>Type definition (at ML level)\<close> - -meta_command' \<comment>\<open>\<^theory_text>\<open>code_reflect' open META2 functions SingleLine MultiLine Comment\<close>\<close> \<open> -let - open META - fun meta_command {shallow, deep = _, syntax_print = _} = - [(META_semi_theories o Theories_one o Theory_code_reflect) - (Code_reflect - ( true - , From.string "META2" - , map From.string [ "SingleLine", "MultiLine", "Comment" ] - @ (shallow - |> hd - |> fst - |> d_hsk_constr - |> map (flattenb (From.string "C_Model_core.") o to_String))))] -in meta_command -end -\<close> - -meta_command'\<open> -let - open META - fun b s = SML_basic [s] - fun meta_command {shallow, deep = _, syntax_print = _} = - [(META_semi_theories o Theories_one o Theory_ML o SMLa o SML_top) - (shallow - |> hd - |> fst - |> d_hsk_constr - |> map_filter - (fn s => - let val s' = s |> to_String |> To_string0 in - if List.exists (fn s0 => s0 = s') ["ClangCVersion", "CString"] then NONE - else - SOME - (SML_val_fun - ( SOME Sval - , SML_rewrite ( b (to_String s) - , From.string "=" - , b (case String.explode s' of - c :: s => c :: s |> String.implode |> (fn x => "META2." ^ x ^ "0") |> From.string)))) - end))] -in meta_command -end -\<close> - -ML\<open>open META2\<close> - -section \<open>Initialization of the parsing code\<close> - -meta_language C - base_path "../src/compiler_generic/isabelle_home/contrib/haskabelle" - [Prelude \<rightharpoonup> C_Model_init, Option \<rightharpoonup> C_Model_init] - where imports \<open>Language.C\<close> - (load \<open>Importer.Conversion.Haskell\<close>) - (load \<open>Importer.Conversion.Haskell.C\<close>) - where defines \<open>\s -> do { (r, acc) <- parseC' (inputStreamFromString s) ; return (gshows r "", acc) }\<close> - -section \<open>Parsing\<close> - -language increment_method :: C where \<open>/* ASSUMES \<open>\<guillemotleft>a\<guillemotright> >\<^sub>u 0\<close> */ f () { - int x = 0; - /* INVAR \<open>\<guillemotleft>a\<guillemotright> >\<^sub>u 0 \<and> \<guillemotleft>a\<guillemotright> \<ge>\<^sub>u &x\<close> - VRT \<open>(measure o Rep_uexpr) (\<guillemotleft>a\<guillemotright> - &x)\<close> */ - while (x < a) { - x = x + 1; - } -} /* ENSURES \<open>\<guillemotleft>a\<guillemotright> =\<^sub>u &x\<close> */\<close> - -language even_count_gen :: C where \<open>/* ASSUMES \<open>\<guillemotleft>a\<guillemotright> >\<^sub>u 0\<close> */ f () { - int i = 0; - int j = 0; - /* INVAR \<open>&j =\<^sub>u (&i + 1) div \<guillemotleft>2\<guillemotright> \<and> &i \<le>\<^sub>u \<guillemotleft>a\<guillemotright>\<close> - VRT \<open>measure (nat o (Rep_uexpr (\<guillemotleft>a\<guillemotright> - &i)))\<close> */ - while (i < a) { - if (i % 2 == 0) { - j = j + 1; - } else skip; - i = i + 1; - } -} /* ENSURES \<open>&j =\<^sub>u (\<guillemotleft>a\<guillemotright> + 1)div \<guillemotleft>2\<guillemotright>\<close> */\<close> - -language max_program_correct :: C where \<open>/* ASSUMES \<open>uop length \<guillemotleft>a\<guillemotright> \<ge>\<^sub>u1 \<and> &i =\<^sub>u 1 \<and> &r =\<^sub>u bop nth \<guillemotleft>a:: int list\<guillemotright> 0\<close> */ f () { - /* INVAR \<open>0 <\<^sub>u &i \<and> &i \<le>\<^sub>u uop length \<guillemotleft>a\<guillemotright> \<and> &r =\<^sub>u uop Max (uop set (bop take (&i) \<guillemotleft>a\<guillemotright>))\<close> - VRT \<open>measure (Rep_uexpr (uop length \<guillemotleft>a\<guillemotright> - (&i)))\<close> */ - while (! (i < length(a))) { - if (r < nth(a, i)) { - r = nth(a, i); - } else skip; - i = i + 1; - } -} /* ENSURES \<open>&r =\<^sub>u uop Max (uop set \<guillemotleft>a\<guillemotright>)\<close> */\<close> - -end diff --git a/Citadelle/examples/C_Model_ex_meta.thy b/Citadelle/examples/C_Model_ex_meta.thy deleted file mode 100644 index 21be53ad31a24cb1ac52aa8c176146e14db0a74c..0000000000000000000000000000000000000000 --- a/Citadelle/examples/C_Model_ex_meta.thy +++ /dev/null @@ -1,137 +0,0 @@ -(****************************************************************************** - * A Meta-Model for the Language.C Haskell Library - * - * Copyright (c) 2016-2017 Nanyang Technological University, Singapore - * 2017-2018 Virginia Tech, USA - * 2018-2019 Université Paris-Saclay, Univ. Paris-Sud, France - * - * 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 C_Model_ex_meta - imports "Citadelle_C_shallow-dirty.C_Model_core" -begin - -section \<open>Type definition (at ML level)\<close> - -meta_command' \<comment>\<open>\<^theory_text>\<open>code_reflect' open META2 functions SingleLine MultiLine Comment\<close>\<close> \<open> -let - open META - fun meta_command {shallow, deep = _, syntax_print = _} = - [(META_semi_theories o Theories_one o Theory_code_reflect) - (Code_reflect - ( true - , From.string "META2" - , map From.string [ "SingleLine", "MultiLine", "Comment" ] - @ (shallow - |> hd - |> fst - |> d_hsk_constr - |> map (flattenb (From.string "C_Model_core.") o to_String))))] -in meta_command -end -\<close> - -meta_command'\<open> -let - open META - fun b s = SML_basic [s] - fun meta_command {shallow, deep = _, syntax_print = _} = - [(META_semi_theories o Theories_one o Theory_ML o SMLa o SML_top) - (shallow - |> hd - |> fst - |> d_hsk_constr - |> map_filter - (fn s => - let val s' = s |> to_String |> To_string0 in - if List.exists (fn s0 => s0 = s') ["ClangCVersion", "CString"] then NONE - else - SOME - (SML_val_fun - ( SOME Sval - , SML_rewrite ( b (to_String s) - , From.string "=" - , b (case String.explode s' of - c :: s => c :: s |> String.implode |> (fn x => "META2." ^ x ^ "0") |> From.string)))) - end))] -in meta_command -end -\<close> - -ML\<open>open META2\<close> - -section \<open>Initialization of the parsing code\<close> - -meta_language C - base_path "../src/compiler_generic/isabelle_home/contrib/haskabelle" - [Prelude, Option] - where imports \<open>Language.C\<close> - (load \<open>Importer.Conversion.Haskell\<close>) - (load \<open>Importer.Conversion.Haskell.C\<close>) - where defines \<open>\s -> do { (r, acc) <- parseC' (inputStreamFromString s) ; return (gshows r "", acc) }\<close> - -section \<open>Parsing\<close> - -language meta increment_method :: C where \<open>/* ASSUMES \<open>\<guillemotleft>a\<guillemotright> >\<^sub>u 0\<close> */ f () { - int x = 0; - /* INVAR \<open>\<guillemotleft>a\<guillemotright> >\<^sub>u 0 \<and> \<guillemotleft>a\<guillemotright> \<ge>\<^sub>u &x\<close> - VRT \<open>(measure o Rep_uexpr) (\<guillemotleft>a\<guillemotright> - &x)\<close> */ - while (x < a) { - x = x + 1; - } -} /* ENSURES \<open>\<guillemotleft>a\<guillemotright> =\<^sub>u &x\<close> */\<close> - -language meta even_count_gen :: C where \<open>/* ASSUMES \<open>\<guillemotleft>a\<guillemotright> >\<^sub>u 0\<close> */ f () { - int i = 0; - int j = 0; - /* INVAR \<open>&j =\<^sub>u (&i + 1) div \<guillemotleft>2\<guillemotright> \<and> &i \<le>\<^sub>u \<guillemotleft>a\<guillemotright>\<close> - VRT \<open>measure (nat o (Rep_uexpr (\<guillemotleft>a\<guillemotright> - &i)))\<close> */ - while (i < a) { - if (i % 2 == 0) { - j = j + 1; - } else skip; - i = i + 1; - } -} /* ENSURES \<open>&j =\<^sub>u (\<guillemotleft>a\<guillemotright> + 1)div \<guillemotleft>2\<guillemotright>\<close> */\<close> - -language meta max_program_correct :: C where \<open>/* ASSUMES \<open>uop length \<guillemotleft>a\<guillemotright> \<ge>\<^sub>u1 \<and> &i =\<^sub>u 1 \<and> &r =\<^sub>u bop nth \<guillemotleft>a:: int list\<guillemotright> 0\<close> */ f () { - /* INVAR \<open>0 <\<^sub>u &i \<and> &i \<le>\<^sub>u uop length \<guillemotleft>a\<guillemotright> \<and> &r =\<^sub>u uop Max (uop set (bop take (&i) \<guillemotleft>a\<guillemotright>))\<close> - VRT \<open>measure (Rep_uexpr (uop length \<guillemotleft>a\<guillemotright> - (&i)))\<close> */ - while (! (i < length(a))) { - if (r < nth(a, i)) { - r = nth(a, i); - } else skip; - i = i + 1; - } -} /* ENSURES \<open>&r =\<^sub>u uop Max (uop set \<guillemotleft>a\<guillemotright>)\<close> */\<close> - -end diff --git a/Citadelle/examples/C_Model_init.thy b/Citadelle/examples/C_Model_init.thy deleted file mode 100644 index 968b2e95898791be2a14e3832aa16e2de9b2a571..0000000000000000000000000000000000000000 --- a/Citadelle/examples/C_Model_init.thy +++ /dev/null @@ -1,60 +0,0 @@ -(****************************************************************************** - * A Meta-Model for the Language.C Haskell Library - * - * Copyright (c) 2016-2017 Nanyang Technological University, Singapore - * 2017-2018 Virginia Tech, USA - * 2018-2019 Université Paris-Saclay, Univ. Paris-Sud, France - * - * 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 C_Model_init - imports "FOCL.Printer_init" - "FOCL.Old_Datatype" -begin - -type_synonym int = integer -type_synonym string = abr_string -notation Some ("Just") -notation None ("Nothing") - -old_datatype 'a option = None | Some 'a -old_datatype ('a, 'b) Either = Left 'a | Right 'b - -hide_type (open) option -hide_const (open) None Some - -hide_type (open) Either -hide_const (open) Left Right - -declare [[cartouche_type' = "abr_string"]] - -end diff --git a/Citadelle/examples/C_Model_ml.thy b/Citadelle/examples/C_Model_ml.thy deleted file mode 100644 index 68d3dfc2e18c9456ae77b807e580ca01cd3543ee..0000000000000000000000000000000000000000 --- a/Citadelle/examples/C_Model_ml.thy +++ /dev/null @@ -1,112 +0,0 @@ -(****************************************************************************** - * A Meta-Model for the Language.C Haskell Library - * - * Copyright (c) 2016-2017 Nanyang Technological University, Singapore - * 2017-2018 Virginia Tech, USA - * 2018-2019 Université Paris-Saclay, Univ. Paris-Sud, France - * - * 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 C_Model_ml - imports "Citadelle_C_shallow-dirty.C_Model_core" -begin - -section \<open>Convert\<close> - -definition translation_unit :: "CTranslUnit \<times> Comment list \<times> integer list \<Rightarrow> unit" where - "translation_unit _ = ()" - -section \<open>Run\<close> - -definition "main = translation_unit" - -declare [[default_code_width = 236]] - -code_reserved SML Ident error - -meta_command' \<comment>\<open>\<^theory_text>\<open>code_reflect' open C_Ast functions main String.to_list S.flatten\<close>\<close> \<open> -let - open META - fun meta_command {shallow, deep = _, syntax_print = _} = - [(META_semi_theories o Theories_one o Theory_code_reflect) - (Code_reflect - ( true - , From.string "C_Ast" - , map From.string [ "main", "String.to_list", "S.flatten" ] - @ (shallow - |> hd - |> fst - |> d_hsk_constr - |> map (flattenb (From.string "C_Model_core.") o to_String))))] -in meta_command -end -\<close> - -ML\<open> -structure C_Ast = struct - open C_Ast - val Ident = Ident0 -end -\<close> - -section \<open>Language.C Haskell parsing in ML\<close> - -ML\<open>open C_Ast\<close> - -meta_command'\<open> -let - open META - fun b s = SML_basic [s] - fun meta_command {shallow, deep = _, syntax_print = _} = - [(META_semi_theories o Theories_one o Theory_ML o SMLa o SML_top) - (shallow - |> hd - |> fst - |> d_hsk_constr - |> map_filter - (fn s => - let val s' = s |> to_String |> To_string0 in - if List.exists (fn s0 => s0 = s') ["Ident", "ClangCVersion", "CString"] then NONE - else - SOME - (SML_val_fun - ( SOME Sval - , SML_rewrite ( b (to_String s) - , From.string "=" - , b (case String.explode s' of - c :: s => Char.toLower c :: s |> String.implode |> (fn x => "C_Ast." ^ x) |> From.string)))) - end))] -in meta_command -end -\<close> - -end diff --git a/Citadelle/examples/Clocks_Lib_Model.thy b/Citadelle/examples/Clocks_Lib_Model.thy deleted file mode 100644 index 2d7894d03a4cfdfd3827e4be419ca157f54dfa95..0000000000000000000000000000000000000000 --- a/Citadelle/examples/Clocks_Lib_Model.thy +++ /dev/null @@ -1,99 +0,0 @@ -(****************************************************************************** - * 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 Clocks_Lib_Model -imports - FOCL.UML_OCL -begin - -Class Clock - Attributes created_at : Real - Operations after(c : Clock) : Boolean - Operations equal(c : Clock) : Boolean - -Class WorldClock < Clock - Operations elapse() - Pre : "true" - -Class DiscreteClock < Clock - Operations create\<^sub>D\<^sub>i\<^sub>s\<^sub>c\<^sub>r\<^sub>e\<^sub>t\<^sub>e() - Post: "self .oclIsNew() and - (self .created_at \<doteq> (WorldClock .allInstances() ->any\<^sub>S\<^sub>e\<^sub>t() .created_at))" - Operations get_time\<^sub>D\<^sub>i\<^sub>s\<^sub>c\<^sub>r\<^sub>e\<^sub>t\<^sub>e() : Integer - Post: "result \<doteq> (WorldClock .allInstances() ->any\<^sub>S\<^sub>e\<^sub>t() .created_at ->oclAsType\<^sub>R\<^sub>e\<^sub>a\<^sub>l(Integer)) - -\<^sub>i\<^sub>n\<^sub>t - (self .created_at ->oclAsType\<^sub>R\<^sub>e\<^sub>a\<^sub>l(Integer))" - -Class PeriodicDiscreteClock < DiscreteClock - Attributes period\<^sub>D\<^sub>i\<^sub>s\<^sub>c\<^sub>r\<^sub>e\<^sub>t\<^sub>e : Integer - Operations create_period_clock\<^sub>D\<^sub>i\<^sub>s\<^sub>c\<^sub>r\<^sub>e\<^sub>t\<^sub>e(p : Integer) - Pre : "\<zero> \<le>\<^sub>i\<^sub>n\<^sub>t p" - Post: "self .period\<^sub>D\<^sub>i\<^sub>s\<^sub>c\<^sub>r\<^sub>e\<^sub>t\<^sub>e \<doteq> p" - -Class ContClock < Clock - Operations create\<^sub>C\<^sub>o\<^sub>n\<^sub>t() - Post: "self .oclIsNew() and - (self .created_at \<doteq> (WorldClock .allInstances() ->any\<^sub>S\<^sub>e\<^sub>t() .created_at))" - Operations get_time\<^sub>C\<^sub>o\<^sub>n\<^sub>t() : Real - Post: "result \<doteq> (WorldClock .allInstances() ->any\<^sub>S\<^sub>e\<^sub>t() .created_at) - -\<^sub>r\<^sub>e\<^sub>a\<^sub>l - (self .created_at)" - -Class PeriodicContClock < Clock - Attributes period\<^sub>C\<^sub>o\<^sub>n\<^sub>t : Real - Operations create_period_clock\<^sub>C\<^sub>o\<^sub>n\<^sub>t(p : Real) - Pre : "\<zero>.\<zero> \<le>\<^sub>r\<^sub>e\<^sub>a\<^sub>l p" - Post: "self .period\<^sub>C\<^sub>o\<^sub>n\<^sub>t \<doteq> p" - -End! - - - -Context c: Clock - Inv "(Clock .allInstances()) ->size\<^sub>S\<^sub>e\<^sub>t() \<doteq> \<one>" - - - -lemmas [simp,code_unfold] = dot_accessor - -end diff --git a/Citadelle/examples/Employee_Model/Analysis/Analysis_OCL.thy b/Citadelle/examples/Employee_Model/Analysis/Analysis_OCL.thy deleted file mode 100644 index 4d3109423baeb4a5a7510ed21c0d4805283d4c35..0000000000000000000000000000000000000000 --- a/Citadelle/examples/Employee_Model/Analysis/Analysis_OCL.thy +++ /dev/null @@ -1,372 +0,0 @@ -(****************************************************************************** - * 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 - Analysis_OCL -imports - Analysis_UML (* Testing *) -begin -text {* \label{ex:employee-analysis:ocl} *} -(* Ideally, these definitions are automatically generated from the class model. *) - -section{* OCL Part: Invariant *} -text{* These recursive predicates can be defined conservatively -by greatest fix-point -constructions---automatically. See~\cite{brucker.ea:hol-ocl-book:2006,brucker:interactive:2007} -for details. For the purpose of this example, we state them as axioms -here. - -\begin{ocl} -context Person - inv label : self .boss <> null implies (self .salary \<le> ((self .boss) .salary)) -\end{ocl} -*} - -definition Person_label\<^sub>i\<^sub>n\<^sub>v :: "Person \<Rightarrow> Boolean" -where "Person_label\<^sub>i\<^sub>n\<^sub>v (self) \<equiv> - (self .boss <> null implies (self .salary \<le>\<^sub>i\<^sub>n\<^sub>t ((self .boss) .salary)))" - - -definition Person_label\<^sub>i\<^sub>n\<^sub>v\<^sub>A\<^sub>T\<^sub>p\<^sub>r\<^sub>e :: "Person \<Rightarrow> Boolean" -where "Person_label\<^sub>i\<^sub>n\<^sub>v\<^sub>A\<^sub>T\<^sub>p\<^sub>r\<^sub>e (self) \<equiv> - (self .boss@pre <> null implies (self .salary@pre \<le>\<^sub>i\<^sub>n\<^sub>t ((self .boss@pre) .salary@pre)))" - -definition Person_label\<^sub>g\<^sub>l\<^sub>o\<^sub>b\<^sub>a\<^sub>l\<^sub>i\<^sub>n\<^sub>v :: "Boolean" -where "Person_label\<^sub>g\<^sub>l\<^sub>o\<^sub>b\<^sub>a\<^sub>l\<^sub>i\<^sub>n\<^sub>v \<equiv> (Person .allInstances()->forAll\<^sub>S\<^sub>e\<^sub>t(x | Person_label\<^sub>i\<^sub>n\<^sub>v (x)) and - (Person .allInstances@pre()->forAll\<^sub>S\<^sub>e\<^sub>t(x | Person_label\<^sub>i\<^sub>n\<^sub>v\<^sub>A\<^sub>T\<^sub>p\<^sub>r\<^sub>e (x))))" - - -lemma "\<tau> \<Turnstile> \<delta> (X .boss) \<Longrightarrow> \<tau> \<Turnstile> Person .allInstances()->includes\<^sub>S\<^sub>e\<^sub>t(X .boss) \<and> - \<tau> \<Turnstile> Person .allInstances()->includes\<^sub>S\<^sub>e\<^sub>t(X) " -oops (* should be: sorry *) -(* To be generated generically ... hard, but crucial lemma that should hold. - It means that X and it successor are object representation that actually - occur in the state. *) - -lemma REC_pre : "\<tau> \<Turnstile> Person_label\<^sub>g\<^sub>l\<^sub>o\<^sub>b\<^sub>a\<^sub>l\<^sub>i\<^sub>n\<^sub>v - \<Longrightarrow> \<tau> \<Turnstile> Person .allInstances()->includes\<^sub>S\<^sub>e\<^sub>t(X) \<comment> \<open>\<open>X\<close> represented object in state\<close> - \<Longrightarrow> \<exists> REC. \<tau> \<Turnstile> REC(X) \<triangleq> (Person_label\<^sub>i\<^sub>n\<^sub>v (X) and (X .boss <> null implies REC(X .boss)))" -oops (* should be sorry - Attempt to allegiate the burden of he following axiomatizations: could be - a witness for a constant specification ...*) - -text{* This allows to state a predicate: *} - -axiomatization inv\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<^sub>_\<^sub>l\<^sub>a\<^sub>b\<^sub>e\<^sub>l :: "Person \<Rightarrow> Boolean" -where inv\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<^sub>_\<^sub>l\<^sub>a\<^sub>b\<^sub>e\<^sub>l_def: -"(\<tau> \<Turnstile> Person .allInstances()->includes\<^sub>S\<^sub>e\<^sub>t(self)) \<Longrightarrow> - (\<tau> \<Turnstile> (inv\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<^sub>_\<^sub>l\<^sub>a\<^sub>b\<^sub>e\<^sub>l(self) \<triangleq> (self .boss <> null implies - (self .salary \<le>\<^sub>i\<^sub>n\<^sub>t ((self .boss) .salary)) and - inv\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<^sub>_\<^sub>l\<^sub>a\<^sub>b\<^sub>e\<^sub>l(self .boss))))" - -axiomatization inv\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<^sub>_\<^sub>l\<^sub>a\<^sub>b\<^sub>e\<^sub>l\<^sub>A\<^sub>T\<^sub>p\<^sub>r\<^sub>e :: "Person \<Rightarrow> Boolean" -where inv\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<^sub>_\<^sub>l\<^sub>a\<^sub>b\<^sub>e\<^sub>l\<^sub>A\<^sub>T\<^sub>p\<^sub>r\<^sub>e_def: -"(\<tau> \<Turnstile> Person .allInstances@pre()->includes\<^sub>S\<^sub>e\<^sub>t(self)) \<Longrightarrow> - (\<tau> \<Turnstile> (inv\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<^sub>_\<^sub>l\<^sub>a\<^sub>b\<^sub>e\<^sub>l\<^sub>A\<^sub>T\<^sub>p\<^sub>r\<^sub>e(self) \<triangleq> (self .boss@pre <> null implies - (self .salary@pre \<le>\<^sub>i\<^sub>n\<^sub>t ((self .boss@pre) .salary@pre)) and - inv\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<^sub>_\<^sub>l\<^sub>a\<^sub>b\<^sub>e\<^sub>l\<^sub>A\<^sub>T\<^sub>p\<^sub>r\<^sub>e(self .boss@pre))))" - - -lemma inv_1 : -"(\<tau> \<Turnstile> Person .allInstances()->includes\<^sub>S\<^sub>e\<^sub>t(self)) \<Longrightarrow> - (\<tau> \<Turnstile> inv\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<^sub>_\<^sub>l\<^sub>a\<^sub>b\<^sub>e\<^sub>l(self) = ((\<tau> \<Turnstile> (self .boss \<doteq> null)) \<or> - ( \<tau> \<Turnstile> (self .boss <> null) \<and> - \<tau> \<Turnstile> ((self .salary) \<le>\<^sub>i\<^sub>n\<^sub>t (self .boss .salary)) \<and> - \<tau> \<Turnstile> (inv\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<^sub>_\<^sub>l\<^sub>a\<^sub>b\<^sub>e\<^sub>l(self .boss))))) " -oops (* should be: sorry *) (* Let's hope that this holds ... *) - - -lemma inv_2 : -"(\<tau> \<Turnstile> Person .allInstances@pre()->includes\<^sub>S\<^sub>e\<^sub>t(self)) \<Longrightarrow> - (\<tau> \<Turnstile> inv\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<^sub>_\<^sub>l\<^sub>a\<^sub>b\<^sub>e\<^sub>l\<^sub>A\<^sub>T\<^sub>p\<^sub>r\<^sub>e(self)) = ((\<tau> \<Turnstile> (self .boss@pre \<doteq> null)) \<or> - (\<tau> \<Turnstile> (self .boss@pre <> null) \<and> - (\<tau> \<Turnstile> (self .boss@pre .salary@pre \<le>\<^sub>i\<^sub>n\<^sub>t self .salary@pre)) \<and> - (\<tau> \<Turnstile> (inv\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<^sub>_\<^sub>l\<^sub>a\<^sub>b\<^sub>e\<^sub>l\<^sub>A\<^sub>T\<^sub>p\<^sub>r\<^sub>e(self .boss@pre)))))" -oops (* should be: sorry *) (* Let's hope that this holds ... *) - -text{* A very first attempt to characterize the axiomatization by an inductive -definition - this can not be the last word since too weak (should be equality!) *} -coinductive inv :: "Person \<Rightarrow> (\<AA>)st \<Rightarrow> bool" where - "(\<tau> \<Turnstile> (\<delta> self)) \<Longrightarrow> ((\<tau> \<Turnstile> (self .boss \<doteq> null)) \<or> - (\<tau> \<Turnstile> (self .boss <> null) \<and> (\<tau> \<Turnstile> (self .boss .salary \<le>\<^sub>i\<^sub>n\<^sub>t self .salary)) \<and> - ( (inv(self .boss))\<tau> ))) - \<Longrightarrow> ( inv self \<tau>)" - - -section{* OCL Part: The Contract of a Recursive Query *} -text{* The original specification of a recursive query : -\begin{ocl} -context Person::contents():Set(Integer) -pre: true -post: result = if self.boss = null - then Set{i} - else self.boss.contents()->including(i) - endif -\end{ocl} *} - -(* -consts dot_contents :: "Person \<Rightarrow> Set_Integer" ("(1(_).contents'('))" 50) -*) - - -text{* For the case of recursive queries, we use at present just axiomatizations: *} - -axiomatization contents :: "Person \<Rightarrow> Set_Integer" ("(1(_).contents'('))" 50) -where contents_def: -"(self .contents()) = (\<lambda> \<tau>. SOME res. let res = \<lambda> _. res in - if \<tau> \<Turnstile> (\<delta> self) - then ((\<tau> \<Turnstile> true) \<and> - (\<tau> \<Turnstile> res \<triangleq> if (self .boss \<doteq> null) - then (Set{self .salary}) - else (self .boss .contents() - ->including\<^sub>S\<^sub>e\<^sub>t(self .salary)) - endif)) - else \<tau> \<Turnstile> res \<triangleq> invalid)" -and cp0_contents:"(X .contents()) \<tau> = ((\<lambda>_. X \<tau>) .contents()) \<tau>" - -interpretation contents : contract0 "contents" "\<lambda> self. true" - "\<lambda> self res. res \<triangleq> if (self .boss \<doteq> null) - then (Set{self .salary}) - else (self .boss .contents() - ->including\<^sub>S\<^sub>e\<^sub>t(self .salary)) - endif" - proof (unfold_locales) - show "\<And>self \<tau>. true \<tau> = true \<tau>" by auto - next - show "\<And>self. \<forall>\<sigma> \<sigma>' \<sigma>''. ((\<sigma>, \<sigma>') \<Turnstile> true) = ((\<sigma>, \<sigma>'') \<Turnstile> true)" by auto - next - show "\<And>self. self .contents() \<equiv> - \<lambda> \<tau>. SOME res. let res = \<lambda> _. res in - if \<tau> \<Turnstile> (\<delta> self) - then ((\<tau> \<Turnstile> true) \<and> - (\<tau> \<Turnstile> res \<triangleq> if (self .boss \<doteq> null) - then (Set{self .salary}) - else (self .boss .contents() - ->including\<^sub>S\<^sub>e\<^sub>t(self .salary)) - endif)) - else \<tau> \<Turnstile> res \<triangleq> invalid" - by(auto simp: contents_def ) - next - have A:"\<And>self \<tau>. ((\<lambda>_. self \<tau>) .boss \<doteq> null) \<tau> = (\<lambda>_. (self .boss \<doteq> null) \<tau>) \<tau>" - by (metis (no_types) StrictRefEq\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n cp_StrictRefEq\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t cp_dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<B>\<O>\<S>\<S>) - have B:"\<And>self \<tau>. (\<lambda>_. Set{(\<lambda>_. self \<tau>) .salary} \<tau>) = (\<lambda>_. Set{self .salary} \<tau>)" - apply(subst UML_Set.OclIncluding.cp0) - apply(subst (2) UML_Set.OclIncluding.cp0) - apply(subst (2) Analysis_UML.cp_dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<S>\<A>\<L>\<A>\<R>\<Y>) by simp - have C:"\<And>self \<tau>. ((\<lambda>_. self \<tau>).boss .contents()->including\<^sub>S\<^sub>e\<^sub>t((\<lambda>_. self \<tau>).salary) \<tau>) = - (self .boss .contents() ->including\<^sub>S\<^sub>e\<^sub>t(self .salary) \<tau>)" - apply(subst UML_Set.OclIncluding.cp0) apply(subst (2) UML_Set.OclIncluding.cp0) - apply(subst (2) Analysis_UML.cp_dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<S>\<A>\<L>\<A>\<R>\<Y>) - apply(subst cp0_contents) apply(subst (2) cp0_contents) - apply(subst (2) cp_dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<B>\<O>\<S>\<S>) by simp - show "\<And>self res \<tau>. - (res \<triangleq> if (self .boss) \<doteq> null then Set{self .salary} - else self .boss .contents()->including\<^sub>S\<^sub>e\<^sub>t(self .salary) endif) \<tau> = - ((\<lambda>_. res \<tau>) \<triangleq> if (\<lambda>_. self \<tau>) .boss \<doteq> null then Set{(\<lambda>_. self \<tau>) .salary} - else(\<lambda>_. self \<tau>) .boss .contents()->including\<^sub>S\<^sub>e\<^sub>t((\<lambda>_. self \<tau>) .salary) endif) \<tau>" - apply(subst cp_StrongEq) - apply(subst (2) cp_StrongEq) - apply(subst cp_OclIf) - apply(subst (2)cp_OclIf) - by(simp add: A B C) - qed - - -text{* Specializing @{thm contents.unfold2}, one gets the following more practical rewrite -rule that is amenable to symbolic evaluation: *} -theorem unfold_contents : - assumes "cp E" - and "\<tau> \<Turnstile> \<delta> self" - shows "(\<tau> \<Turnstile> E (self .contents())) = - (\<tau> \<Turnstile> E (if self .boss \<doteq> null - then Set{self .salary} - else self .boss .contents()->including\<^sub>S\<^sub>e\<^sub>t(self .salary) endif))" -by(rule contents.unfold2[of _ _ _ "\<lambda> X. true"], simp_all add: assms) - - -text{* Since we have only one interpretation function, we need the corresponding -operation on the pre-state: *} - -consts contentsATpre :: "Person \<Rightarrow> Set_Integer" ("(1(_).contents@pre'('))" 50) - -axiomatization where contentsATpre_def: -" (self).contents@pre() = (\<lambda> \<tau>. - SOME res. let res = \<lambda> _. res in - if \<tau> \<Turnstile> (\<delta> self) - then ((\<tau> \<Turnstile> true) \<and> \<comment> \<open>pre\<close> - (\<tau> \<Turnstile> (res \<triangleq> if (self).boss@pre \<doteq> null \<comment> \<open>post\<close> - then Set{(self).salary@pre} - else (self).boss@pre .contents@pre() - ->including\<^sub>S\<^sub>e\<^sub>t(self .salary@pre) - endif))) - else \<tau> \<Turnstile> res \<triangleq> invalid)" -and cp0_contents_at_pre:"(X .contents@pre()) \<tau> = ((\<lambda>_. X \<tau>) .contents@pre()) \<tau>" - -interpretation contentsATpre : contract0 "contentsATpre" "\<lambda> self. true" - "\<lambda> self res. res \<triangleq> if (self .boss@pre \<doteq> null) - then (Set{self .salary@pre}) - else (self .boss@pre .contents@pre() - ->including\<^sub>S\<^sub>e\<^sub>t(self .salary@pre)) - endif" - proof (unfold_locales) - show "\<And>self \<tau>. true \<tau> = true \<tau>" by auto - next - show "\<And>self. \<forall>\<sigma> \<sigma>' \<sigma>''. ((\<sigma>, \<sigma>') \<Turnstile> true) = ((\<sigma>, \<sigma>'') \<Turnstile> true)" by auto - next - show "\<And>self. self .contents@pre() \<equiv> - \<lambda>\<tau>. SOME res. let res = \<lambda> _. res in - if \<tau> \<Turnstile> \<delta> self - then \<tau> \<Turnstile> true \<and> - \<tau> \<Turnstile> res \<triangleq> (if self .boss@pre \<doteq> null then Set{self .salary@pre} - else self .boss@pre .contents@pre()->including\<^sub>S\<^sub>e\<^sub>t(self .salary@pre) - endif) - else \<tau> \<Turnstile> res \<triangleq> invalid" - by(auto simp: contentsATpre_def) - next - have A:"\<And>self \<tau>. ((\<lambda>_. self \<tau>) .boss@pre \<doteq> null) \<tau> = (\<lambda>_. (self .boss@pre \<doteq> null) \<tau>) \<tau>" - by (metis StrictRefEq\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n cp_StrictRefEq\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t cp_dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<B>\<O>\<S>\<S>_at_pre) - have B:"\<And>self \<tau>. (\<lambda>_. Set{(\<lambda>_. self \<tau>) .salary@pre} \<tau>) = (\<lambda>_. Set{self .salary@pre} \<tau>)" - apply(subst UML_Set.OclIncluding.cp0) - apply(subst (2) UML_Set.OclIncluding.cp0) - apply(subst (2) Analysis_UML.cp_dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<S>\<A>\<L>\<A>\<R>\<Y>_at_pre) by simp - have C:"\<And>self \<tau>. ((\<lambda>_. self \<tau>).boss@pre .contents@pre()->including\<^sub>S\<^sub>e\<^sub>t((\<lambda>_. self \<tau>).salary@pre) \<tau>) = - (self .boss@pre .contents@pre() ->including\<^sub>S\<^sub>e\<^sub>t(self .salary@pre) \<tau>)" - apply(subst UML_Set.OclIncluding.cp0) apply(subst (2) UML_Set.OclIncluding.cp0) - apply(subst (2) Analysis_UML.cp_dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<S>\<A>\<L>\<A>\<R>\<Y>_at_pre) - apply(subst cp0_contents_at_pre) apply(subst (2) cp0_contents_at_pre) - apply(subst (2) cp_dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<B>\<O>\<S>\<S>_at_pre) by simp - show "\<And>self res \<tau>. - (res \<triangleq> if (self .boss@pre) \<doteq> null then Set{self .salary@pre} - else self .boss@pre .contents@pre()->including\<^sub>S\<^sub>e\<^sub>t(self .salary@pre) endif) \<tau> = - ((\<lambda>_. res \<tau>) \<triangleq> if (\<lambda>_. self \<tau>) .boss@pre \<doteq> null then Set{(\<lambda>_. self \<tau>) .salary@pre} - else(\<lambda>_. self \<tau>) .boss@pre .contents@pre()->including\<^sub>S\<^sub>e\<^sub>t((\<lambda>_. self \<tau>) .salary@pre) endif) \<tau>" - apply(subst cp_StrongEq) - apply(subst (2) cp_StrongEq) - apply(subst cp_OclIf) - apply(subst (2)cp_OclIf) - by(simp add: A B C) - qed - -text{* Again, we derive via @{thm [source] contents.unfold2} a Knaster-Tarski like Fixpoint rule -that is amenable to symbolic evaluation: *} -theorem unfold_contentsATpre : - assumes "cp E" - and "\<tau> \<Turnstile> \<delta> self" - shows "(\<tau> \<Turnstile> E (self .contents@pre())) = - (\<tau> \<Turnstile> E (if self .boss@pre \<doteq> null - then Set{self .salary@pre} - else self .boss@pre .contents@pre()->including\<^sub>S\<^sub>e\<^sub>t(self .salary@pre) endif))" -by(rule contentsATpre.unfold2[of _ _ _ "\<lambda> X. true"], simp_all add: assms) - - -text{* Note that these \inlineocl{@pre} variants on methods are only available on queries, \ie, -operations without side-effect. *} - -(* Missing: Properties on Casts, type-tests, and equality vs. projections. *) - -section{* OCL Part: The Contract of a User-defined Method *} -text{* -The example specification in high-level OCL input syntax reads as follows: -\begin{ocl} -context Person::insert(x:Integer) -pre: true -post: contents():Set(Integer) -contents() = contents@pre()->including(x) -\end{ocl} - -This boils down to: -*} - -definition insert :: "Person \<Rightarrow>Integer \<Rightarrow> Void" ("(1(_).insert'(_'))" 50) -where "self .insert(x) \<equiv> - (\<lambda> \<tau>. SOME res. let res = \<lambda> _. res in - if (\<tau> \<Turnstile> (\<delta> self)) \<and> (\<tau> \<Turnstile> \<upsilon> x) - then (\<tau> \<Turnstile> true \<and> - (\<tau> \<Turnstile> ((self).contents() \<triangleq> (self).contents@pre()->including\<^sub>S\<^sub>e\<^sub>t(x)))) - else \<tau> \<Turnstile> res \<triangleq> invalid)" - -text{* The semantic consequences of this definition were computed inside this locale interpretation:*} -interpretation insert : contract1 "insert" "\<lambda> self x. true" - "\<lambda> self x res. ((self .contents()) \<triangleq> - (self .contents@pre()->including\<^sub>S\<^sub>e\<^sub>t(x)))" - apply unfold_locales apply(auto simp:insert_def) - apply(subst cp_StrongEq) apply(subst (2) cp_StrongEq) - apply(subst contents.cp0) - apply(subst UML_Set.OclIncluding.cp0) - apply(subst (2) UML_Set.OclIncluding.cp0) - apply(subst contentsATpre.cp0) - by(simp) (* an extremely hacky proof that cries for reformulation and automation - bu *) - - -text{* The result of this locale interpretation for our @{term insert} contract is the following -set of properties, which serves as basis for automated deduction on them: - -\begin{table}[htbp] - \centering - \begin{tabu}{lX[,c,]} - \toprule - Name & Theorem \\ - \midrule - @{thm [source] insert.strict0} & @{thm [display=false] insert.strict0} \\ - @{thm [source] insert.nullstrict0} & @{thm [display=false] insert.nullstrict0} \\ - @{thm [source] insert.strict1} & @{thm [display=false] insert.strict1} \\ - @{thm [source] insert.cp\<^sub>P\<^sub>R\<^sub>E} & @{thm [display=false] insert.cp\<^sub>P\<^sub>R\<^sub>E} \\ - @{thm [source] insert.cp\<^sub>P\<^sub>O\<^sub>S\<^sub>T} & @{thm [display=false] insert.cp\<^sub>P\<^sub>O\<^sub>S\<^sub>T} \\ - @{thm [source] insert.cp_pre} & @{thm [display=false] insert.cp_pre} \\ - @{thm [source] insert.cp_post} & @{thm [display=false] insert.cp_post} \\ - @{thm [source] insert.cp} & @{thm [display=false] insert.cp} \\ - @{thm [source] insert.cp0} & @{thm [display=false] insert.cp0} \\ - @{thm [source] insert.def_scheme} & @{thm [display=false] insert.def_scheme} \\ - @{thm [source] insert.unfold} & @{thm [display=false] insert.unfold} \\ - @{thm [source] insert.unfold2} & @{thm [display=false] insert.unfold2} \\ - \bottomrule - \end{tabu} - \caption{Semantic properties resulting from a user-defined operation contract.} - \label{tab:sem_operation_contract} -\end{table} - -*} - -end diff --git a/Citadelle/examples/Employee_Model/Analysis/Analysis_UML.thy b/Citadelle/examples/Employee_Model/Analysis/Analysis_UML.thy deleted file mode 100644 index 213bd268028e14b4f3d783876880d5bf9bb0e773..0000000000000000000000000000000000000000 --- a/Citadelle/examples/Employee_Model/Analysis/Analysis_UML.thy +++ /dev/null @@ -1,1395 +0,0 @@ -(****************************************************************************** - * 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. - ******************************************************************************) - -chapter{* Example: The Employee Analysis Model *} (* UML part *) - -(* This example is not yet balanced. Some parts of should go to - Part V : State Operations and Objects *) - -theory - Analysis_UML -imports - "../../../src/UML_Main" -begin - -text {* \label{ex:employee-analysis:uml} *} - -section{* Introduction *} -text{* - For certain concepts like classes and class-types, only a generic - definition for its resulting semantics can be given. Generic means, - there is a function outside HOL that ``compiles'' a concrete, - closed-world class diagram into a ``theory'' of this data model, - consisting of a bunch of definitions for classes, accessors, method, - casts, and tests for actual types, as well as proofs for the - fundamental properties of these operations in this concrete data - model. *} - -text{* Such generic function or ``compiler'' can be implemented in - Isabelle on the ML level. This has been done, for a semantics - following the open-world assumption, for UML 2.0 - in~\cite{brucker.ea:extensible:2008-b, brucker:interactive:2007}. In - this paper, we follow another approach for UML 2.4: we define the - concepts of the compilation informally, and present a concrete - example which is verified in Isabelle/HOL. *} - -subsection{* Outlining the Example *} - -text{* We are presenting here an ``analysis-model'' of the (slightly -modified) example Figure 7.3, page 20 of -the OCL standard~\cite{omg:ocl:2012}. -Here, analysis model means that associations -were really represented as relation on objects on the state---as is -intended by the standard---rather by pointers between objects as is -done in our ``design model'' -\isatagafp -(see \autoref{ex:employee-design:uml}). -\endisatagafp -\isatagannexa -(see \url{http://afp.sourceforge.net/entries/Featherweight_OCL.shtml}). -\endisatagannexa -To be precise, this theory contains the formalization of the data-part -covered by the UML class model (see \autoref{fig:person-ana}):*} - -text{* -\begin{figure} - \centering\scalebox{.3}{\includegraphics{figures/person.png}}% - \caption{A simple UML class model drawn from Figure 7.3, - page 20 of~\cite{omg:ocl:2012}. \label{fig:person-ana}} -\end{figure} -*} - -text{* This means that the association (attached to the association class -\inlineocl{EmployeeRanking}) with the association ends \inlineocl+boss+ and \inlineocl+employees+ is implemented -by the attribute \inlineocl+boss+ and the operation \inlineocl+employees+ (to be discussed in the OCL part -captured by the subsequent theory). -*} - -section{* Example Data-Universe and its Infrastructure *} -text{* Ideally, the following is generated automatically from a UML class model. *} - -(* @{text "'\<AA>"} -- \mathfrak{A} *) -text{* Our data universe consists in the concrete class diagram just of node's, -and implicitly of the class object. Each class implies the existence of a class -type defined for the corresponding object representations as follows: *} - -datatype type\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n = mk\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n oid (* the oid to the person itself *) - "int option" (* the attribute "salary" or null *) - - -datatype type\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y = mk\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y oid (* the oid to the oclany itself *) - "(int option) option" - (* the extensions to "person"; used to denote - objects of actual type "person" casted to "oclany"; - in case of existence of several subclasses - of oclany, sums of extensions have to be provided. *) - -text{* Now, we construct a concrete ``universe of OclAny types'' by injection into a -sum type containing the class types. This type of OclAny will be used as instance -for all respective type-variables. *} - -datatype \<AA> = in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n type\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n | in\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y type\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y - -text{* Having fixed the object universe, we can introduce type synonyms that exactly correspond -to OCL types. Again, we exploit that our representation of OCL is a ``shallow embedding'' with a -one-to-one correspondance of OCL-types to types of the meta-language HOL. *} -type_synonym Boolean = " \<AA> Boolean" -type_synonym Integer = " \<AA> Integer" -type_synonym Void = " \<AA> Void" -type_synonym OclAny = "(\<AA>, type\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y option option) val" -type_synonym Person = "(\<AA>, type\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n option option) val" -type_synonym Set_Integer = "(\<AA>, int option option) Set" -type_synonym Set_Person = "(\<AA>, type\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n option option) Set" - -text{* Just a little check: *} -typ "Boolean" - -text{* To reuse key-elements of the library like referential equality, we have -to show that the object universe belongs to the type class ``oclany,'' \ie, - each class type has to provide a function @{term oid_of} yielding the object id (oid) of the object. *} -instantiation type\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n :: object -begin - definition oid_of_type\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_def: "oid_of x = (case x of mk\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n oid _ \<Rightarrow> oid)" - instance .. -end - -instantiation type\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y :: object -begin - definition oid_of_type\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_def: "oid_of x = (case x of mk\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y oid _ \<Rightarrow> oid)" - instance .. -end - -instantiation \<AA> :: object -begin - definition oid_of_\<AA>_def: "oid_of x = (case x of - in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n person \<Rightarrow> oid_of person - | in\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y oclany \<Rightarrow> oid_of oclany)" - instance .. -end - - - - -section{* Instantiation of the Generic Strict Equality *} -text{* We instantiate the referential equality -on @{text "Person"} and @{text "OclAny"} *} - -overloading StrictRefEq \<equiv> "StrictRefEq :: [Person,Person] \<Rightarrow> Boolean" -begin - definition StrictRefEq\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n : "(x::Person) \<doteq> y \<equiv> StrictRefEq\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t x y" -end - -overloading StrictRefEq \<equiv> "StrictRefEq :: [OclAny,OclAny] \<Rightarrow> Boolean" -begin - definition StrictRefEq\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y : "(x::OclAny) \<doteq> y \<equiv> StrictRefEq\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t x y" -end - -lemmas cps23 = - cp_StrictRefEq\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t[of "x::Person" "y::Person" "\<tau>", - simplified StrictRefEq\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n[symmetric]] - cp_intro(9) [of "P::Person \<Rightarrow>Person""Q::Person \<Rightarrow>Person", - simplified StrictRefEq\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n[symmetric] ] - StrictRefEq\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_def [of "x::Person" "y::Person", - simplified StrictRefEq\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n[symmetric]] - StrictRefEq\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_defargs [of _ "x::Person" "y::Person", - simplified StrictRefEq\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n[symmetric]] - StrictRefEq\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_strict1 - [of "x::Person", - simplified StrictRefEq\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n[symmetric]] - StrictRefEq\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_strict2 - [of "x::Person", - simplified StrictRefEq\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n[symmetric]] - for x y \<tau> P Q - -(* TODO: Analogue for object. *) - -text{* For each Class \emph{C}, we will have a casting operation \inlineocl{.oclAsType($C$)}, - a test on the actual type \inlineocl{.oclIsTypeOf($C$)} as well as its relaxed form - \inlineocl{.oclIsKindOf($C$)} (corresponding exactly to Java's \verb+instanceof+-operator. -*} -text{* Thus, since we have two class-types in our concrete class hierarchy, we have -two operations to declare and to provide two overloading definitions for the two static types. -*} - - -section{* OclAsType *} -subsection{* Definition *} - -consts OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y :: "'\<alpha> \<Rightarrow> OclAny" ("(_) .oclAsType'(OclAny')") -consts OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n :: "'\<alpha> \<Rightarrow> Person" ("(_) .oclAsType'(Person')") - -definition "OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_\<AA> = (\<lambda>u. \<lfloor>case u of in\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y a \<Rightarrow> a - | in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (mk\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n oid a) \<Rightarrow> mk\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y oid \<lfloor>a\<rfloor>\<rfloor>)" - -lemma OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_\<AA>_some: "OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_\<AA> x \<noteq> None" -by(simp add: OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_\<AA>_def) - -overloading OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y \<equiv> "OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y :: OclAny \<Rightarrow> OclAny" -begin - definition OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny: - "(X::OclAny) .oclAsType(OclAny) \<equiv> X" -end - -overloading OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y \<equiv> "OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y :: Person \<Rightarrow> OclAny" -begin - definition OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person: - "(X::Person) .oclAsType(OclAny) \<equiv> - (\<lambda>\<tau>. case X \<tau> of - \<bottom> \<Rightarrow> invalid \<tau> - | \<lfloor>\<bottom>\<rfloor> \<Rightarrow> null \<tau> - | \<lfloor>\<lfloor>mk\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n oid a \<rfloor>\<rfloor> \<Rightarrow> \<lfloor>\<lfloor> (mk\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y oid \<lfloor>a\<rfloor>) \<rfloor>\<rfloor>)" -end - -definition "OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_\<AA> = - (\<lambda>u. case u of in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n p \<Rightarrow> \<lfloor>p\<rfloor> - | in\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y (mk\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y oid \<lfloor>a\<rfloor>) \<Rightarrow> \<lfloor>mk\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n oid a\<rfloor> - | _ \<Rightarrow> None)" - -overloading OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n \<equiv> "OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n :: OclAny \<Rightarrow> Person" -begin - definition OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny: - "(X::OclAny) .oclAsType(Person) \<equiv> - (\<lambda>\<tau>. case X \<tau> of - \<bottom> \<Rightarrow> invalid \<tau> - | \<lfloor>\<bottom>\<rfloor> \<Rightarrow> null \<tau> - | \<lfloor>\<lfloor>mk\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y oid \<bottom> \<rfloor>\<rfloor> \<Rightarrow> invalid \<tau> \<comment> \<open>down-cast exception\<close> - | \<lfloor>\<lfloor>mk\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y oid \<lfloor>a\<rfloor> \<rfloor>\<rfloor> \<Rightarrow> \<lfloor>\<lfloor>mk\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n oid a\<rfloor>\<rfloor>)" -end - -overloading OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n \<equiv> "OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n :: Person \<Rightarrow> Person" -begin - definition OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person: - "(X::Person) .oclAsType(Person) \<equiv> X " (* to avoid identity for null ? *) -end - -text_raw{* \isatagafp *} - -lemmas [simp] = - OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny - OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person -subsection{* Context Passing *} - -lemma cp_OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_Person: "cp P \<Longrightarrow> cp(\<lambda>X. (P (X::Person)::Person) .oclAsType(OclAny))" -by(rule cpI1, simp_all add: OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person) -lemma cp_OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_OclAny: "cp P \<Longrightarrow> cp(\<lambda>X. (P (X::OclAny)::OclAny) .oclAsType(OclAny))" -by(rule cpI1, simp_all add: OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny) -lemma cp_OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_Person: "cp P \<Longrightarrow> cp(\<lambda>X. (P (X::Person)::Person) .oclAsType(Person))" -by(rule cpI1, simp_all add: OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person) -lemma cp_OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_OclAny: "cp P \<Longrightarrow> cp(\<lambda>X. (P (X::OclAny)::OclAny) .oclAsType(Person))" -by(rule cpI1, simp_all add: OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny) - -lemma cp_OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_OclAny: "cp P \<Longrightarrow> cp(\<lambda>X. (P (X::Person)::OclAny) .oclAsType(OclAny))" -by(rule cpI1, simp_all add: OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny) -lemma cp_OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_Person: "cp P \<Longrightarrow> cp(\<lambda>X. (P (X::OclAny)::Person) .oclAsType(OclAny))" -by(rule cpI1, simp_all add: OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person) -lemma cp_OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_OclAny: "cp P \<Longrightarrow> cp(\<lambda>X. (P (X::Person)::OclAny) .oclAsType(Person))" -by(rule cpI1, simp_all add: OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny) -lemma cp_OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_Person: "cp P \<Longrightarrow> cp(\<lambda>X. (P (X::OclAny)::Person) .oclAsType(Person))" -by(rule cpI1, simp_all add: OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person) - -lemmas [simp] = - cp_OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_Person - cp_OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_OclAny - cp_OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_Person - cp_OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_OclAny - - cp_OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_OclAny - cp_OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_Person - cp_OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_OclAny - cp_OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_Person - -text_raw{* \endisatagafp*} - -subsection{* Execution with Invalid or Null as Argument *} - -lemma OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_strict : "(invalid::OclAny) .oclAsType(OclAny) = invalid" by(simp) -lemma OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_nullstrict : "(null::OclAny) .oclAsType(OclAny) = null" by(simp) -lemma OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_strict[simp] : "(invalid::Person) .oclAsType(OclAny) = invalid" - by(rule ext, simp add: bot_option_def invalid_def OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person) -lemma OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_nullstrict[simp] : "(null::Person) .oclAsType(OclAny) = null" - by(rule ext, simp add: null_fun_def null_option_def bot_option_def OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person) -lemma OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_strict[simp] : "(invalid::OclAny) .oclAsType(Person) = invalid" - by(rule ext, simp add: bot_option_def invalid_def OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny) -lemma OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_nullstrict[simp] : "(null::OclAny) .oclAsType(Person) = null" - by(rule ext, simp add: null_fun_def null_option_def bot_option_def OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny) -lemma OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_strict : "(invalid::Person) .oclAsType(Person) = invalid" by(simp) -lemma OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_nullstrict : "(null::Person) .oclAsType(Person) = null" by(simp) - -section{* OclIsTypeOf *} - -subsection{* Definition *} - -consts OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y :: "'\<alpha> \<Rightarrow> Boolean" ("(_).oclIsTypeOf'(OclAny')") -consts OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n :: "'\<alpha> \<Rightarrow> Boolean" ("(_).oclIsTypeOf'(Person')") - -overloading OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y \<equiv> "OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y :: OclAny \<Rightarrow> Boolean" -begin - definition OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny: - "(X::OclAny) .oclIsTypeOf(OclAny) \<equiv> - (\<lambda>\<tau>. case X \<tau> of - \<bottom> \<Rightarrow> invalid \<tau> - | \<lfloor>\<bottom>\<rfloor> \<Rightarrow> true \<tau> \<comment> \<open>invalid ??\<close> - | \<lfloor>\<lfloor>mk\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y oid \<bottom> \<rfloor>\<rfloor> \<Rightarrow> true \<tau> - | \<lfloor>\<lfloor>mk\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y oid \<lfloor>_\<rfloor> \<rfloor>\<rfloor> \<Rightarrow> false \<tau>)" -end - -lemma OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny': - "(X::OclAny) .oclIsTypeOf(OclAny) = - (\<lambda> \<tau>. if \<tau> \<Turnstile> \<upsilon> X then (case X \<tau> of - \<lfloor>\<bottom>\<rfloor> \<Rightarrow> true \<tau> \<comment> \<open>invalid ??\<close> - | \<lfloor>\<lfloor>mk\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y oid \<bottom> \<rfloor>\<rfloor> \<Rightarrow> true \<tau> - | \<lfloor>\<lfloor>mk\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y oid \<lfloor>_\<rfloor> \<rfloor>\<rfloor> \<Rightarrow> false \<tau>) - else invalid \<tau>)" - apply(rule ext, simp add: OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny) - by(case_tac "\<tau> \<Turnstile> \<upsilon> X", auto simp: foundation18' bot_option_def) - -interpretation OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny : - profile_mono_schemeV - "OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y::OclAny \<Rightarrow> Boolean" - "\<lambda> X. (case X of - \<lfloor>None\<rfloor> \<Rightarrow> \<lfloor>\<lfloor>True\<rfloor>\<rfloor> \<comment> \<open>invalid ??\<close> - | \<lfloor>\<lfloor>mk\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y oid None \<rfloor>\<rfloor> \<Rightarrow> \<lfloor>\<lfloor>True\<rfloor>\<rfloor> - | \<lfloor>\<lfloor>mk\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y oid \<lfloor>_\<rfloor> \<rfloor>\<rfloor> \<Rightarrow> \<lfloor>\<lfloor>False\<rfloor>\<rfloor>)" - apply(unfold_locales, simp add: atomize_eq, rule ext) - by(auto simp: OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny' OclValid_def true_def false_def - split: option.split type\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y.split) - -overloading OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y \<equiv> "OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y :: Person \<Rightarrow> Boolean" -begin - definition OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person: - "(X::Person) .oclIsTypeOf(OclAny) \<equiv> - (\<lambda>\<tau>. case X \<tau> of - \<bottom> \<Rightarrow> invalid \<tau> - | \<lfloor>\<bottom>\<rfloor> \<Rightarrow> true \<tau> \<comment> \<open>invalid ??\<close> - | \<lfloor>\<lfloor> _ \<rfloor>\<rfloor> \<Rightarrow> false \<tau> \<comment> \<open>must have actual type \<open>Person\<close> otherwise\<close>)" -end - -overloading OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n \<equiv> "OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n :: OclAny \<Rightarrow> Boolean" -begin - definition OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny: - "(X::OclAny) .oclIsTypeOf(Person) \<equiv> - (\<lambda>\<tau>. case X \<tau> of - \<bottom> \<Rightarrow> invalid \<tau> - | \<lfloor>\<bottom>\<rfloor> \<Rightarrow> true \<tau> - | \<lfloor>\<lfloor>mk\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y oid \<bottom> \<rfloor>\<rfloor> \<Rightarrow> false \<tau> - | \<lfloor>\<lfloor>mk\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y oid \<lfloor>_\<rfloor> \<rfloor>\<rfloor> \<Rightarrow> true \<tau>)" -end - -overloading OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n \<equiv> "OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n :: Person \<Rightarrow> Boolean" -begin - definition OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person: - "(X::Person) .oclIsTypeOf(Person) \<equiv> - (\<lambda>\<tau>. case X \<tau> of - \<bottom> \<Rightarrow> invalid \<tau> - | _ \<Rightarrow> true \<tau>)" (* for (* \<lfloor>\<lfloor> _ \<rfloor>\<rfloor> \<Rightarrow> true \<tau> *) : must have actual type Node otherwise *) -end -text_raw{* \isatagafp *} -subsection{* Context Passing *} - -lemma cp_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_Person: "cp P \<Longrightarrow> cp(\<lambda>X.(P(X::Person)::Person).oclIsTypeOf(OclAny))" -by(rule cpI1, simp_all add: OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person) -lemma cp_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_OclAny: "cp P \<Longrightarrow> cp(\<lambda>X.(P(X::OclAny)::OclAny).oclIsTypeOf(OclAny))" -by(rule cpI1, simp_all add: OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny) -lemma cp_OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_Person: "cp P \<Longrightarrow> cp(\<lambda>X.(P(X::Person)::Person).oclIsTypeOf(Person))" -by(rule cpI1, simp_all add: OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person) -lemma cp_OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_OclAny: "cp P \<Longrightarrow> cp(\<lambda>X.(P(X::OclAny)::OclAny).oclIsTypeOf(Person))" -by(rule cpI1, simp_all add: OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny) - - -lemma cp_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_OclAny: "cp P \<Longrightarrow> cp(\<lambda>X.(P(X::Person)::OclAny).oclIsTypeOf(OclAny))" -by(rule cpI1, simp_all add: OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny) -lemma cp_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_Person: "cp P \<Longrightarrow> cp(\<lambda>X.(P(X::OclAny)::Person).oclIsTypeOf(OclAny))" -by(rule cpI1, simp_all add: OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person) -lemma cp_OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_OclAny: "cp P \<Longrightarrow> cp(\<lambda>X.(P(X::Person)::OclAny).oclIsTypeOf(Person))" -by(rule cpI1, simp_all add: OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny) -lemma cp_OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_Person: "cp P \<Longrightarrow> cp(\<lambda>X.(P(X::OclAny)::Person).oclIsTypeOf(Person))" -by(rule cpI1, simp_all add: OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person) - -lemmas [simp] = - cp_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_Person - cp_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_OclAny - cp_OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_Person - cp_OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_OclAny - - cp_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_OclAny - cp_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_Person - cp_OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_OclAny - cp_OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_Person -text_raw{* \endisatagafp *} - -subsection{* Execution with Invalid or Null as Argument *} - -lemma OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_strict1[simp]: - "(invalid::OclAny) .oclIsTypeOf(OclAny) = invalid" -by(rule ext, simp add: null_fun_def null_option_def bot_option_def null_def invalid_def - OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny) -lemma OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_strict2[simp]: - "(null::OclAny) .oclIsTypeOf(OclAny) = true" -by(rule ext, simp add: null_fun_def null_option_def bot_option_def null_def invalid_def - OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny) -lemma OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_strict1[simp]: - "(invalid::Person) .oclIsTypeOf(OclAny) = invalid" -by(rule ext, simp add: null_fun_def null_option_def bot_option_def null_def invalid_def - OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person) -lemma OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_strict2[simp]: - "(null::Person) .oclIsTypeOf(OclAny) = true" -by(rule ext, simp add: null_fun_def null_option_def bot_option_def null_def invalid_def - OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person) -lemma OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_strict1[simp]: - "(invalid::OclAny) .oclIsTypeOf(Person) = invalid" -by(rule ext, simp add: null_fun_def null_option_def bot_option_def null_def invalid_def - OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny) -lemma OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_strict2[simp]: - "(null::OclAny) .oclIsTypeOf(Person) = true" -by(rule ext, simp add: null_fun_def null_option_def bot_option_def null_def invalid_def - OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny) -lemma OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_strict1[simp]: - "(invalid::Person) .oclIsTypeOf(Person) = invalid" -by(rule ext, simp add: null_fun_def null_option_def bot_option_def null_def invalid_def - OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person) -lemma OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_strict2[simp]: - "(null::Person) .oclIsTypeOf(Person) = true" -by(rule ext, simp add: null_fun_def null_option_def bot_option_def null_def invalid_def - OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person) - -subsection{* Up Down Casting *} - -lemma actualType_larger_staticType: -assumes isdef: "\<tau> \<Turnstile> (\<delta> X)" -shows "\<tau> \<Turnstile> (X::Person) .oclIsTypeOf(OclAny) \<triangleq> false" -using isdef -by(auto simp : null_option_def bot_option_def - OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person foundation22 foundation16) - -lemma down_cast_type: -assumes isOclAny: "\<tau> \<Turnstile> (X::OclAny) .oclIsTypeOf(OclAny)" -and non_null: "\<tau> \<Turnstile> (\<delta> X)" -shows "\<tau> \<Turnstile> (X .oclAsType(Person)) \<triangleq> invalid" -using isOclAny non_null -apply(auto simp : bot_fun_def null_fun_def null_option_def bot_option_def null_def invalid_def - OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny foundation22 foundation16 - split: option.split type\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y.split type\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n.split) -by(simp add: OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny OclValid_def false_def true_def) - -lemma down_cast_type': -assumes isOclAny: "\<tau> \<Turnstile> (X::OclAny) .oclIsTypeOf(OclAny)" -and non_null: "\<tau> \<Turnstile> (\<delta> X)" -shows "\<tau> \<Turnstile> not (\<upsilon> (X .oclAsType(Person)))" -by(rule foundation15[THEN iffD1], simp add: down_cast_type[OF assms]) - -lemma up_down_cast : -assumes isdef: "\<tau> \<Turnstile> (\<delta> X)" -shows "\<tau> \<Turnstile> ((X::Person) .oclAsType(OclAny) .oclAsType(Person) \<triangleq> X)" -using isdef -by(auto simp : null_fun_def null_option_def bot_option_def null_def invalid_def - OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny foundation22 foundation16 - split: option.split type\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n.split) - - -lemma up_down_cast_Person_OclAny_Person [simp]: -shows "((X::Person) .oclAsType(OclAny) .oclAsType(Person) = X)" - apply(rule ext, rename_tac \<tau>) - apply(rule foundation22[THEN iffD1]) - apply(case_tac "\<tau> \<Turnstile> (\<delta> X)", simp add: up_down_cast) - apply(simp add: defined_split, elim disjE) - apply(erule StrongEq_L_subst2_rev, simp, simp)+ -done - -lemma up_down_cast_Person_OclAny_Person': -assumes "\<tau> \<Turnstile> \<upsilon> X" -shows "\<tau> \<Turnstile> (((X :: Person) .oclAsType(OclAny) .oclAsType(Person)) \<doteq> X)" - apply(simp only: up_down_cast_Person_OclAny_Person StrictRefEq\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n) -by(rule StrictRefEq\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_sym, simp add: assms) - -lemma up_down_cast_Person_OclAny_Person'': -assumes "\<tau> \<Turnstile> \<upsilon> (X :: Person)" -shows "\<tau> \<Turnstile> (X .oclIsTypeOf(Person) implies (X .oclAsType(OclAny) .oclAsType(Person)) \<doteq> X)" - apply(simp add: OclValid_def) - apply(subst cp_OclImplies) - apply(simp add: StrictRefEq\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n StrictRefEq\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_sym[OF assms, simplified OclValid_def]) - apply(subst cp_OclImplies[symmetric]) -by simp - - -section{* OclIsKindOf *} -subsection{* Definition *} - -consts OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y :: "'\<alpha> \<Rightarrow> Boolean" ("(_).oclIsKindOf'(OclAny')") -consts OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n :: "'\<alpha> \<Rightarrow> Boolean" ("(_).oclIsKindOf'(Person')") - -overloading OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y \<equiv> "OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y :: OclAny \<Rightarrow> Boolean" -begin - definition OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny: - "(X::OclAny) .oclIsKindOf(OclAny) \<equiv> - (\<lambda>\<tau>. case X \<tau> of - \<bottom> \<Rightarrow> invalid \<tau> - | _ \<Rightarrow> true \<tau>)" -end - -overloading OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y \<equiv> "OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y :: Person \<Rightarrow> Boolean" -begin - definition OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person: - "(X::Person) .oclIsKindOf(OclAny) \<equiv> - (\<lambda>\<tau>. case X \<tau> of - \<bottom> \<Rightarrow> invalid \<tau> - | _\<Rightarrow> true \<tau>)" -(* for (* \<lfloor>\<lfloor>mk\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n e oid _ \<rfloor>\<rfloor> \<Rightarrow> true \<tau> *) : must have actual type Person otherwise *) -end - -overloading OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n \<equiv> "OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n :: OclAny \<Rightarrow> Boolean" -begin - definition OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny: - "(X::OclAny) .oclIsKindOf(Person) \<equiv> - (\<lambda>\<tau>. case X \<tau> of - \<bottom> \<Rightarrow> invalid \<tau> - | \<lfloor>\<bottom>\<rfloor> \<Rightarrow> true \<tau> - | \<lfloor>\<lfloor>mk\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y oid \<bottom> \<rfloor>\<rfloor> \<Rightarrow> false \<tau> - | \<lfloor>\<lfloor>mk\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y oid \<lfloor>_\<rfloor> \<rfloor>\<rfloor> \<Rightarrow> true \<tau>)" -end - -overloading OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n \<equiv> "OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n :: Person \<Rightarrow> Boolean" -begin - definition OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person: - "(X::Person) .oclIsKindOf(Person) \<equiv> - (\<lambda>\<tau>. case X \<tau> of - \<bottom> \<Rightarrow> invalid \<tau> - | _ \<Rightarrow> true \<tau>)" -end -text_raw{* \isatagafp *} -subsection{* Context Passing *} - -lemma cp_OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_Person: "cp P \<Longrightarrow> cp(\<lambda>X.(P(X::Person)::Person).oclIsKindOf(OclAny))" -by(rule cpI1, simp_all add: OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person) -lemma cp_OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_OclAny: "cp P \<Longrightarrow> cp(\<lambda>X.(P(X::OclAny)::OclAny).oclIsKindOf(OclAny))" -by(rule cpI1, simp_all add: OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny) -lemma cp_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_Person: "cp P \<Longrightarrow> cp(\<lambda>X.(P(X::Person)::Person).oclIsKindOf(Person))" -by(rule cpI1, simp_all add: OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person) -lemma cp_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_OclAny: "cp P \<Longrightarrow> cp(\<lambda>X.(P(X::OclAny)::OclAny).oclIsKindOf(Person))" -by(rule cpI1, simp_all add: OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny) - -lemma cp_OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_OclAny: "cp P \<Longrightarrow> cp(\<lambda>X.(P(X::Person)::OclAny).oclIsKindOf(OclAny))" -by(rule cpI1, simp_all add: OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny) -lemma cp_OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_Person: "cp P \<Longrightarrow> cp(\<lambda>X.(P(X::OclAny)::Person).oclIsKindOf(OclAny))" -by(rule cpI1, simp_all add: OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person) -lemma cp_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_OclAny: "cp P \<Longrightarrow> cp(\<lambda>X.(P(X::Person)::OclAny).oclIsKindOf(Person))" -by(rule cpI1, simp_all add: OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny) -lemma cp_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_Person: "cp P \<Longrightarrow> cp(\<lambda>X.(P(X::OclAny)::Person).oclIsKindOf(Person))" -by(rule cpI1, simp_all add: OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person) - -lemmas [simp] = - cp_OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_Person - cp_OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_OclAny - cp_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_Person - cp_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_OclAny - - cp_OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_OclAny - cp_OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_Person - cp_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_OclAny - cp_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_Person -text_raw{* \endisatagafp *} -subsection{* Execution with Invalid or Null as Argument *} - -lemma OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_strict1[simp] : "(invalid::OclAny) .oclIsKindOf(OclAny) = invalid" -by(rule ext, simp add: invalid_def bot_option_def - OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny) -lemma OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_strict2[simp] : "(null::OclAny) .oclIsKindOf(OclAny) = true" -by(rule ext, simp add: null_fun_def null_option_def - OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny) -lemma OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_strict1[simp] : "(invalid::Person) .oclIsKindOf(OclAny) = invalid" -by(rule ext, simp add: bot_option_def invalid_def - OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person) -lemma OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_strict2[simp] : "(null::Person) .oclIsKindOf(OclAny) = true" -by(rule ext, simp add: null_fun_def null_option_def bot_option_def - OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person) -lemma OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_strict1[simp]: "(invalid::OclAny) .oclIsKindOf(Person) = invalid" -by(rule ext, simp add: null_fun_def null_option_def bot_option_def null_def invalid_def - OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny) -lemma OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_strict2[simp]: "(null::OclAny) .oclIsKindOf(Person) = true" -by(rule ext, simp add: null_fun_def null_option_def bot_option_def null_def invalid_def - OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny) -lemma OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_strict1[simp]: "(invalid::Person) .oclIsKindOf(Person) = invalid" -by(rule ext, simp add: null_fun_def null_option_def bot_option_def null_def invalid_def - OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person) -lemma OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_strict2[simp]: "(null::Person) .oclIsKindOf(Person) = true" -by(rule ext, simp add: null_fun_def null_option_def bot_option_def null_def invalid_def - OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person) - -subsection{* Up Down Casting *} - -lemma actualKind_larger_staticKind: -assumes isdef: "\<tau> \<Turnstile> (\<delta> X)" -shows "\<tau> \<Turnstile> ((X::Person) .oclIsKindOf(OclAny) \<triangleq> true)" -using isdef -by(auto simp : bot_option_def - OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person foundation22 foundation16) - -lemma down_cast_kind: -assumes isOclAny: "\<not> (\<tau> \<Turnstile> ((X::OclAny).oclIsKindOf(Person)))" -and non_null: "\<tau> \<Turnstile> (\<delta> X)" -shows "\<tau> \<Turnstile> ((X .oclAsType(Person)) \<triangleq> invalid)" -using isOclAny non_null -apply(auto simp : bot_fun_def null_fun_def null_option_def bot_option_def null_def invalid_def - OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny foundation22 foundation16 - split: option.split type\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y.split type\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n.split) -by(simp add: OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny OclValid_def false_def true_def) - -section{* OclAllInstances *} - -text{* To denote OCL-types occurring in OCL expressions syntactically---as, for example, as -``argument'' of \inlineisar{oclAllInstances()}---we use the inverses of the injection -functions into the object universes; we show that this is sufficient ``characterization.'' *} - -definition "Person \<equiv> OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_\<AA>" -definition "OclAny \<equiv> OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_\<AA>" -lemmas [simp] = Person_def OclAny_def - -lemma OclAllInstances_generic\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_exec: "OclAllInstances_generic pre_post OclAny = - (\<lambda>\<tau>. Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e \<lfloor>\<lfloor> Some ` OclAny ` ran (heap (pre_post \<tau>)) \<rfloor>\<rfloor>)" -proof - - let ?S1 = "\<lambda>\<tau>. OclAny ` ran (heap (pre_post \<tau>))" - let ?S2 = "\<lambda>\<tau>. ?S1 \<tau> - {None}" - have B : "\<And>\<tau>. ?S2 \<tau> \<subseteq> ?S1 \<tau>" by auto - have C : "\<And>\<tau>. ?S1 \<tau> \<subseteq> ?S2 \<tau>" by(auto simp: OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_\<AA>_some) - - show ?thesis by(insert equalityI[OF B C], simp) -qed - -lemma OclAllInstances_at_post\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_exec: "OclAny .allInstances() = - (\<lambda>\<tau>. Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e \<lfloor>\<lfloor> Some ` OclAny ` ran (heap (snd \<tau>)) \<rfloor>\<rfloor>)" -unfolding OclAllInstances_at_post_def -by(rule OclAllInstances_generic\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_exec) - -lemma OclAllInstances_at_pre\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_exec: "OclAny .allInstances@pre() = - (\<lambda>\<tau>. Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e \<lfloor>\<lfloor> Some ` OclAny ` ran (heap (fst \<tau>)) \<rfloor>\<rfloor>) " -unfolding OclAllInstances_at_pre_def -by(rule OclAllInstances_generic\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_exec) - -subsection{* OclIsTypeOf *} - -lemma OclAny_allInstances_generic_oclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y1: -assumes [simp]: "\<And>x. pre_post (x, x) = x" -shows "\<exists>\<tau>. (\<tau> \<Turnstile> ((OclAllInstances_generic pre_post OclAny)->forAll\<^sub>S\<^sub>e\<^sub>t(X|X .oclIsTypeOf(OclAny))))" - apply(rule_tac x = \<tau>\<^sub>0 in exI, simp add: \<tau>\<^sub>0_def OclValid_def del: OclAllInstances_generic_def) - apply(simp only: assms UML_Set.OclForall_def refl if_True - OclAllInstances_generic_defined[simplified OclValid_def]) - apply(simp only: OclAllInstances_generic_def) - apply(subst (1 2 3) Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inverse, simp add: bot_option_def) -by(simp add: OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny) - -lemma OclAny_allInstances_at_post_oclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y1: -"\<exists>\<tau>. (\<tau> \<Turnstile> (OclAny .allInstances()->forAll\<^sub>S\<^sub>e\<^sub>t(X|X .oclIsTypeOf(OclAny))))" -unfolding OclAllInstances_at_post_def -by(rule OclAny_allInstances_generic_oclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y1, simp) - -lemma OclAny_allInstances_at_pre_oclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y1: -"\<exists>\<tau>. (\<tau> \<Turnstile> (OclAny .allInstances@pre()->forAll\<^sub>S\<^sub>e\<^sub>t(X|X .oclIsTypeOf(OclAny))))" -unfolding OclAllInstances_at_pre_def -by(rule OclAny_allInstances_generic_oclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y1, simp) - -lemma OclAny_allInstances_generic_oclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y2: -assumes [simp]: "\<And>x. pre_post (x, x) = x" -shows "\<exists>\<tau>. (\<tau> \<Turnstile> not ((OclAllInstances_generic pre_post OclAny)->forAll\<^sub>S\<^sub>e\<^sub>t(X|X .oclIsTypeOf(OclAny))))" -proof - fix oid a let ?t0 = "\<lparr>heap = Map.empty(oid \<mapsto> in\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y (mk\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y oid \<lfloor>a\<rfloor>)), - assocs = Map.empty\<rparr>" show ?thesis - apply(rule_tac x = "(?t0, ?t0)" in exI, simp add: OclValid_def del: OclAllInstances_generic_def) - apply(simp only: UML_Set.OclForall_def refl if_True - OclAllInstances_generic_defined[simplified OclValid_def]) - apply(simp only: OclAllInstances_generic_def OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_\<AA>_def) - apply(subst (1 2 3) Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inverse, simp add: bot_option_def) - by(simp add: OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny OclNot_def OclAny_def) -qed - -lemma OclAny_allInstances_at_post_oclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y2: -"\<exists>\<tau>. (\<tau> \<Turnstile> not (OclAny .allInstances()->forAll\<^sub>S\<^sub>e\<^sub>t(X|X .oclIsTypeOf(OclAny))))" -unfolding OclAllInstances_at_post_def -by(rule OclAny_allInstances_generic_oclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y2, simp) - -lemma OclAny_allInstances_at_pre_oclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y2: -"\<exists>\<tau>. (\<tau> \<Turnstile> not (OclAny .allInstances@pre()->forAll\<^sub>S\<^sub>e\<^sub>t(X|X .oclIsTypeOf(OclAny))))" -unfolding OclAllInstances_at_pre_def -by(rule OclAny_allInstances_generic_oclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y2, simp) - -lemma Person_allInstances_generic_oclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n: -"\<tau> \<Turnstile> ((OclAllInstances_generic pre_post Person)->forAll\<^sub>S\<^sub>e\<^sub>t(X|X .oclIsTypeOf(Person)))" - apply(simp add: OclValid_def del: OclAllInstances_generic_def) - apply(simp only: UML_Set.OclForall_def refl if_True - OclAllInstances_generic_defined[simplified OclValid_def]) - apply(simp only: OclAllInstances_generic_def) - apply(subst (1 2 3) Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inverse, simp add: bot_option_def) -by(simp add: OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person) - -lemma Person_allInstances_at_post_oclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n: -"\<tau> \<Turnstile> (Person .allInstances()->forAll\<^sub>S\<^sub>e\<^sub>t(X|X .oclIsTypeOf(Person)))" -unfolding OclAllInstances_at_post_def -by(rule Person_allInstances_generic_oclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n) - -lemma Person_allInstances_at_pre_oclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n: -"\<tau> \<Turnstile> (Person .allInstances@pre()->forAll\<^sub>S\<^sub>e\<^sub>t(X|X .oclIsTypeOf(Person)))" -unfolding OclAllInstances_at_pre_def -by(rule Person_allInstances_generic_oclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n) - -subsection{* OclIsKindOf *} -lemma OclAny_allInstances_generic_oclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y: -"\<tau> \<Turnstile> ((OclAllInstances_generic pre_post OclAny)->forAll\<^sub>S\<^sub>e\<^sub>t(X|X .oclIsKindOf(OclAny)))" - apply(simp add: OclValid_def del: OclAllInstances_generic_def) - apply(simp only: UML_Set.OclForall_def refl if_True - OclAllInstances_generic_defined[simplified OclValid_def]) - apply(simp only: OclAllInstances_generic_def) - apply(subst (1 2 3) Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inverse, simp add: bot_option_def) -by(simp add: OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny) - -lemma OclAny_allInstances_at_post_oclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y: -"\<tau> \<Turnstile> (OclAny .allInstances()->forAll\<^sub>S\<^sub>e\<^sub>t(X|X .oclIsKindOf(OclAny)))" -unfolding OclAllInstances_at_post_def -by(rule OclAny_allInstances_generic_oclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y) - -lemma OclAny_allInstances_at_pre_oclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y: -"\<tau> \<Turnstile> (OclAny .allInstances@pre()->forAll\<^sub>S\<^sub>e\<^sub>t(X|X .oclIsKindOf(OclAny)))" -unfolding OclAllInstances_at_pre_def -by(rule OclAny_allInstances_generic_oclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y) - -lemma Person_allInstances_generic_oclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y: -"\<tau> \<Turnstile> ((OclAllInstances_generic pre_post Person)->forAll\<^sub>S\<^sub>e\<^sub>t(X|X .oclIsKindOf(OclAny)))" - apply(simp add: OclValid_def del: OclAllInstances_generic_def) - apply(simp only: UML_Set.OclForall_def refl if_True - OclAllInstances_generic_defined[simplified OclValid_def]) - apply(simp only: OclAllInstances_generic_def) - apply(subst (1 2 3) Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inverse, simp add: bot_option_def) -by(simp add: OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person) - -lemma Person_allInstances_at_post_oclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y: -"\<tau> \<Turnstile> (Person .allInstances()->forAll\<^sub>S\<^sub>e\<^sub>t(X|X .oclIsKindOf(OclAny)))" -unfolding OclAllInstances_at_post_def -by(rule Person_allInstances_generic_oclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y) - -lemma Person_allInstances_at_pre_oclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y: -"\<tau> \<Turnstile> (Person .allInstances@pre()->forAll\<^sub>S\<^sub>e\<^sub>t(X|X .oclIsKindOf(OclAny)))" -unfolding OclAllInstances_at_pre_def -by(rule Person_allInstances_generic_oclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y) - -lemma Person_allInstances_generic_oclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n: -"\<tau> \<Turnstile> ((OclAllInstances_generic pre_post Person)->forAll\<^sub>S\<^sub>e\<^sub>t(X|X .oclIsKindOf(Person)))" - apply(simp add: OclValid_def del: OclAllInstances_generic_def) - apply(simp only: UML_Set.OclForall_def refl if_True - OclAllInstances_generic_defined[simplified OclValid_def]) - apply(simp only: OclAllInstances_generic_def) - apply(subst (1 2 3) Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inverse, simp add: bot_option_def) -by(simp add: OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person) - -lemma Person_allInstances_at_post_oclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n: -"\<tau> \<Turnstile> (Person .allInstances()->forAll\<^sub>S\<^sub>e\<^sub>t(X|X .oclIsKindOf(Person)))" -unfolding OclAllInstances_at_post_def -by(rule Person_allInstances_generic_oclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n) - -lemma Person_allInstances_at_pre_oclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n: -"\<tau> \<Turnstile> (Person .allInstances@pre()->forAll\<^sub>S\<^sub>e\<^sub>t(X|X .oclIsKindOf(Person)))" -unfolding OclAllInstances_at_pre_def -by(rule Person_allInstances_generic_oclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n) - -section{* The Accessors (any, boss, salary) *} -text{*\label{sec:eam-accessors}*} -text{* Should be generated entirely from a class-diagram. *} - - -subsection{* Definition (of the association Employee-Boss) *} - -text{* We start with a oid for the association; this oid can be used -in presence of association classes to represent the association inside an object, -pretty much similar to the \inlineisar+Design_UML+, where we stored -an \verb+oid+ inside the class as ``pointer.'' *} - -definition oid\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<B>\<O>\<S>\<S> ::"oid" where "oid\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<B>\<O>\<S>\<S> = 10" - -text{* From there on, we can already define an empty state which must contain -for $\mathit{oid}_{Person}\mathcal{BOSS}$ the empty relation (encoded as association list, since there are -associations with a Sequence-like structure).*} - - -definition eval_extract :: "('\<AA>,('a::object) option option) val - \<Rightarrow> (oid \<Rightarrow> ('\<AA>,'c::null) val) - \<Rightarrow> ('\<AA>,'c::null) val" -where "eval_extract X f = (\<lambda> \<tau>. case X \<tau> of - \<bottom> \<Rightarrow> invalid \<tau> \<comment> \<open>exception propagation\<close> - | \<lfloor> \<bottom> \<rfloor> \<Rightarrow> invalid \<tau> \<comment> \<open>dereferencing null pointer\<close> - | \<lfloor>\<lfloor> obj \<rfloor>\<rfloor> \<Rightarrow> f (oid_of obj) \<tau>)" -(* TODO: rephrasing as if-then-else and shifting to OCL_state. *) - -definition "choose\<^sub>2_1 = fst" -definition "choose\<^sub>2_2 = snd" - -definition "List_flatten = (\<lambda>l. (foldl ((\<lambda>acc. (\<lambda>l. (foldl ((\<lambda>acc. (\<lambda>l. (Cons (l) (acc))))) (acc) ((rev (l))))))) (Nil) ((rev (l)))))" -definition "deref_assocs\<^sub>2" :: "('\<AA> state \<times> '\<AA> state \<Rightarrow> '\<AA> state) - \<Rightarrow> (oid list list \<Rightarrow> oid list \<times> oid list) - \<Rightarrow> oid - \<Rightarrow> (oid list \<Rightarrow> ('\<AA>,'f)val) - \<Rightarrow> oid - \<Rightarrow> ('\<AA>, 'f::null)val" -where "deref_assocs\<^sub>2 pre_post to_from assoc_oid f oid = - (\<lambda>\<tau>. case (assocs (pre_post \<tau>)) assoc_oid of - \<lfloor> S \<rfloor> \<Rightarrow> f (List_flatten (map (choose\<^sub>2_2 \<circ> to_from) - (filter (\<lambda> p. List.member (choose\<^sub>2_1 (to_from p)) oid) S))) - \<tau> - | _ \<Rightarrow> invalid \<tau>)" - - -text{* The @{text pre_post}-parameter is configured with @{text fst} or -@{text snd}, the @{text to_from}-parameter either with the identity @{term id} or -the following combinator @{text switch}: *} -definition "switch\<^sub>2_1 = (\<lambda>[x,y]\<Rightarrow> (x,y))" -definition "switch\<^sub>2_2 = (\<lambda>[x,y]\<Rightarrow> (y,x))" -definition "switch\<^sub>3_1 = (\<lambda>[x,y,z]\<Rightarrow> (x,y))" -definition "switch\<^sub>3_2 = (\<lambda>[x,y,z]\<Rightarrow> (x,z))" -definition "switch\<^sub>3_3 = (\<lambda>[x,y,z]\<Rightarrow> (y,x))" -definition "switch\<^sub>3_4 = (\<lambda>[x,y,z]\<Rightarrow> (y,z))" -definition "switch\<^sub>3_5 = (\<lambda>[x,y,z]\<Rightarrow> (z,x))" -definition "switch\<^sub>3_6 = (\<lambda>[x,y,z]\<Rightarrow> (z,y))" - -definition deref_oid\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n :: "(\<AA> state \<times> \<AA> state \<Rightarrow> \<AA> state) - \<Rightarrow> (type\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n \<Rightarrow> (\<AA>, 'c::null)val) - \<Rightarrow> oid - \<Rightarrow> (\<AA>, 'c::null)val" -where "deref_oid\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n fst_snd f oid = (\<lambda>\<tau>. case (heap (fst_snd \<tau>)) oid of - \<lfloor> in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n obj \<rfloor> \<Rightarrow> f obj \<tau> - | _ \<Rightarrow> invalid \<tau>)" - - - -definition deref_oid\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y :: "(\<AA> state \<times> \<AA> state \<Rightarrow> \<AA> state) - \<Rightarrow> (type\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y \<Rightarrow> (\<AA>, 'c::null)val) - \<Rightarrow> oid - \<Rightarrow> (\<AA>, 'c::null)val" -where "deref_oid\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y fst_snd f oid = (\<lambda>\<tau>. case (heap (fst_snd \<tau>)) oid of - \<lfloor> in\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y obj \<rfloor> \<Rightarrow> f obj \<tau> - | _ \<Rightarrow> invalid \<tau>)" - -text{* pointer undefined in state or not referencing a type conform object representation *} - - -definition "select\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y\<A>\<N>\<Y> f = (\<lambda> X. case X of - (mk\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y _ \<bottom>) \<Rightarrow> null - | (mk\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y _ \<lfloor>any\<rfloor>) \<Rightarrow> f (\<lambda>x _. \<lfloor>\<lfloor>x\<rfloor>\<rfloor>) any)" - - -definition "select\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<B>\<O>\<S>\<S> f = select_object mtSet UML_Set.OclIncluding UML_Set.OclANY (f (\<lambda>x _. \<lfloor>\<lfloor>x\<rfloor>\<rfloor>))" - - -definition "select\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<S>\<A>\<L>\<A>\<R>\<Y> f = (\<lambda> X. case X of - (mk\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n _ \<bottom>) \<Rightarrow> null - | (mk\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n _ \<lfloor>salary\<rfloor>) \<Rightarrow> f (\<lambda>x _. \<lfloor>\<lfloor>x\<rfloor>\<rfloor>) salary)" - - -definition "deref_assocs\<^sub>2\<B>\<O>\<S>\<S> fst_snd f = (\<lambda> mk\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n oid _ \<Rightarrow> - deref_assocs\<^sub>2 fst_snd switch\<^sub>2_1 oid\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<B>\<O>\<S>\<S> f oid)" - -definition "in_pre_state = fst" -definition "in_post_state = snd" - -definition "reconst_basetype = (\<lambda> convert x. convert x)" - -definition dot\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y\<A>\<N>\<Y> :: "OclAny \<Rightarrow> _" ("(1(_).any)" 50) - where "(X).any = eval_extract X - (deref_oid\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y in_post_state - (select\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y\<A>\<N>\<Y> - reconst_basetype))" - -definition dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<B>\<O>\<S>\<S> :: "Person \<Rightarrow> Person" ("(1(_).boss)" 50) - where "(X).boss = eval_extract X - (deref_oid\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n in_post_state - (deref_assocs\<^sub>2\<B>\<O>\<S>\<S> in_post_state - (select\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<B>\<O>\<S>\<S> - (deref_oid\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n in_post_state))))" - -definition dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<S>\<A>\<L>\<A>\<R>\<Y> :: "Person \<Rightarrow> Integer" ("(1(_).salary)" 50) - where "(X).salary = eval_extract X - (deref_oid\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n in_post_state - (select\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<S>\<A>\<L>\<A>\<R>\<Y> - reconst_basetype))" - -definition dot\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y\<A>\<N>\<Y>_at_pre :: "OclAny \<Rightarrow> _" ("(1(_).any@pre)" 50) - where "(X).any@pre = eval_extract X - (deref_oid\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y in_pre_state - (select\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y\<A>\<N>\<Y> - reconst_basetype))" - -definition dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<B>\<O>\<S>\<S>_at_pre:: "Person \<Rightarrow> Person" ("(1(_).boss@pre)" 50) - where "(X).boss@pre = eval_extract X - (deref_oid\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n in_pre_state - (deref_assocs\<^sub>2\<B>\<O>\<S>\<S> in_pre_state - (select\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<B>\<O>\<S>\<S> - (deref_oid\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n in_pre_state))))" - -definition dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<S>\<A>\<L>\<A>\<R>\<Y>_at_pre:: "Person \<Rightarrow> Integer" ("(1(_).salary@pre)" 50) - where "(X).salary@pre = eval_extract X - (deref_oid\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n in_pre_state - (select\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<S>\<A>\<L>\<A>\<R>\<Y> - reconst_basetype))" - -lemmas dot_accessor = - dot\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y\<A>\<N>\<Y>_def - dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<B>\<O>\<S>\<S>_def - dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<S>\<A>\<L>\<A>\<R>\<Y>_def - dot\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y\<A>\<N>\<Y>_at_pre_def - dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<B>\<O>\<S>\<S>_at_pre_def - dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<S>\<A>\<L>\<A>\<R>\<Y>_at_pre_def - -subsection{* Context Passing *} - -lemmas [simp] = eval_extract_def - -lemma cp_dot\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y\<A>\<N>\<Y>: "((X).any) \<tau> = ((\<lambda>_. X \<tau>).any) \<tau>" by (simp add: dot_accessor) -lemma cp_dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<B>\<O>\<S>\<S>: "((X).boss) \<tau> = ((\<lambda>_. X \<tau>).boss) \<tau>" by (simp add: dot_accessor) -lemma cp_dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<S>\<A>\<L>\<A>\<R>\<Y>: "((X).salary) \<tau> = ((\<lambda>_. X \<tau>).salary) \<tau>" by (simp add: dot_accessor) - -lemma cp_dot\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y\<A>\<N>\<Y>_at_pre: "((X).any@pre) \<tau> = ((\<lambda>_. X \<tau>).any@pre) \<tau>" by (simp add: dot_accessor) -lemma cp_dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<B>\<O>\<S>\<S>_at_pre: "((X).boss@pre) \<tau> = ((\<lambda>_. X \<tau>).boss@pre) \<tau>" by (simp add: dot_accessor) -lemma cp_dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<S>\<A>\<L>\<A>\<R>\<Y>_at_pre: "((X).salary@pre) \<tau> = ((\<lambda>_. X \<tau>).salary@pre) \<tau>" by (simp add: dot_accessor) - -lemmas cp_dot\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y\<A>\<N>\<Y>_I [simp, intro!]= - cp_dot\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y\<A>\<N>\<Y>[THEN allI[THEN allI], - of "\<lambda> X _. X" "\<lambda> _ \<tau>. \<tau>", THEN cpI1] -lemmas cp_dot\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y\<A>\<N>\<Y>_at_pre_I [simp, intro!]= - cp_dot\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y\<A>\<N>\<Y>_at_pre[THEN allI[THEN allI], - of "\<lambda> X _. X" "\<lambda> _ \<tau>. \<tau>", THEN cpI1] - -lemmas cp_dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<B>\<O>\<S>\<S>_I [simp, intro!]= - cp_dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<B>\<O>\<S>\<S>[THEN allI[THEN allI], - of "\<lambda> X _. X" "\<lambda> _ \<tau>. \<tau>", THEN cpI1] -lemmas cp_dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<B>\<O>\<S>\<S>_at_pre_I [simp, intro!]= - cp_dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<B>\<O>\<S>\<S>_at_pre[THEN allI[THEN allI], - of "\<lambda> X _. X" "\<lambda> _ \<tau>. \<tau>", THEN cpI1] - -lemmas cp_dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<S>\<A>\<L>\<A>\<R>\<Y>_I [simp, intro!]= - cp_dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<S>\<A>\<L>\<A>\<R>\<Y>[THEN allI[THEN allI], - of "\<lambda> X _. X" "\<lambda> _ \<tau>. \<tau>", THEN cpI1] -lemmas cp_dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<S>\<A>\<L>\<A>\<R>\<Y>_at_pre_I [simp, intro!]= - cp_dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<S>\<A>\<L>\<A>\<R>\<Y>_at_pre[THEN allI[THEN allI], - of "\<lambda> X _. X" "\<lambda> _ \<tau>. \<tau>", THEN cpI1] - -subsection{* Execution with Invalid or Null as Argument *} - -lemma dot\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y\<A>\<N>\<Y>_nullstrict [simp]: "(null).any = invalid" -by(rule ext, simp add: dot_accessor null_fun_def null_option_def bot_option_def null_def invalid_def) -lemma dot\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y\<A>\<N>\<Y>_at_pre_nullstrict [simp] : "(null).any@pre = invalid" -by(rule ext, simp add: dot_accessor null_fun_def null_option_def bot_option_def null_def invalid_def) -lemma dot\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y\<A>\<N>\<Y>_strict [simp] : "(invalid).any = invalid" -by(rule ext, simp add: dot_accessor null_fun_def null_option_def bot_option_def null_def invalid_def) -lemma dot\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y\<A>\<N>\<Y>_at_pre_strict [simp] : "(invalid).any@pre = invalid" -by(rule ext, simp add: dot_accessor null_fun_def null_option_def bot_option_def null_def invalid_def) - - -lemma dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<B>\<O>\<S>\<S>_nullstrict [simp]: "(null).boss = invalid" -by(rule ext, simp add: dot_accessor null_fun_def null_option_def bot_option_def null_def invalid_def) -lemma dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<B>\<O>\<S>\<S>_at_pre_nullstrict [simp] : "(null).boss@pre = invalid" -by(rule ext, simp add: dot_accessor null_fun_def null_option_def bot_option_def null_def invalid_def) -lemma dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<B>\<O>\<S>\<S>_strict [simp] : "(invalid).boss = invalid" -by(rule ext, simp add: dot_accessor null_fun_def null_option_def bot_option_def null_def invalid_def) -lemma dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<B>\<O>\<S>\<S>_at_pre_strict [simp] : "(invalid).boss@pre = invalid" -by(rule ext, simp add: dot_accessor null_fun_def null_option_def bot_option_def null_def invalid_def) - - -lemma dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<S>\<A>\<L>\<A>\<R>\<Y>_nullstrict [simp]: "(null).salary = invalid" -by(rule ext, simp add: dot_accessor null_fun_def null_option_def bot_option_def null_def invalid_def) -lemma dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<S>\<A>\<L>\<A>\<R>\<Y>_at_pre_nullstrict [simp] : "(null).salary@pre = invalid" -by(rule ext, simp add: dot_accessor null_fun_def null_option_def bot_option_def null_def invalid_def) -lemma dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<S>\<A>\<L>\<A>\<R>\<Y>_strict [simp] : "(invalid).salary = invalid" -by(rule ext, simp add: dot_accessor null_fun_def null_option_def bot_option_def null_def invalid_def) -lemma dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<S>\<A>\<L>\<A>\<R>\<Y>_at_pre_strict [simp] : "(invalid).salary@pre = invalid" -by(rule ext, simp add: dot_accessor null_fun_def null_option_def bot_option_def null_def invalid_def) - -subsection{* Representation in States *} - -lemma dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<B>\<O>\<S>\<S>_def_mono:"\<tau> \<Turnstile> \<delta>(X .boss) \<Longrightarrow> \<tau> \<Turnstile> \<delta>(X)" - apply(case_tac "\<tau> \<Turnstile> (X \<triangleq> invalid)", insert StrongEq_L_subst2[where P = "(\<lambda>x. (\<delta> (x .boss)))" and \<tau> = "\<tau>" and x = "X" and y = "invalid"], simp add: foundation16') - apply(case_tac "\<tau> \<Turnstile> (X \<triangleq> null)", insert StrongEq_L_subst2[where P = "(\<lambda>x. (\<delta> (x .boss)))" and \<tau> = "\<tau>" and x = "X" and y = "null"], simp add: foundation16') -by(simp add: defined_split) - -lemma repr_boss: -assumes A : "\<tau> \<Turnstile> \<delta>(x .boss)" -shows "is_represented_in_state in_post_state (x .boss) Person \<tau>" - apply(insert A[simplified foundation16] - A[THEN dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<B>\<O>\<S>\<S>_def_mono, simplified foundation16]) - unfolding is_represented_in_state_def - dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<B>\<O>\<S>\<S>_def eval_extract_def select\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<B>\<O>\<S>\<S>_def in_post_state_def - oops - -lemma repr_bossX : -assumes A: "\<tau> \<Turnstile> \<delta>(x .boss)" -shows "\<tau> \<Turnstile> ((Person .allInstances()) ->includes\<^sub>S\<^sub>e\<^sub>t(x .boss))" -oops - -section{* A Little Infra-structure on Example States *} - -text{* -The example we are defining in this section comes from the figure~\ref{fig:eam1_system-states}. -\begin{figure} -\includegraphics[width=\textwidth]{figures/pre-post.pdf} -\caption{(a) pre-state $\sigma_1$ and - (b) post-state $\sigma_1'$.} -\label{fig:eam1_system-states} -\end{figure} -*} - -text_raw{* \isatagafp*} - -definition OclInt1000 ("\<one>\<zero>\<zero>\<zero>") where "OclInt1000 = (\<lambda> _ . \<lfloor>\<lfloor>1000\<rfloor>\<rfloor>)" -definition OclInt1200 ("\<one>\<two>\<zero>\<zero>") where "OclInt1200 = (\<lambda> _ . \<lfloor>\<lfloor>1200\<rfloor>\<rfloor>)" -definition OclInt1300 ("\<one>\<three>\<zero>\<zero>") where "OclInt1300 = (\<lambda> _ . \<lfloor>\<lfloor>1300\<rfloor>\<rfloor>)" -definition OclInt1800 ("\<one>\<eight>\<zero>\<zero>") where "OclInt1800 = (\<lambda> _ . \<lfloor>\<lfloor>1800\<rfloor>\<rfloor>)" -definition OclInt2600 ("\<two>\<six>\<zero>\<zero>") where "OclInt2600 = (\<lambda> _ . \<lfloor>\<lfloor>2600\<rfloor>\<rfloor>)" -definition OclInt2900 ("\<two>\<nine>\<zero>\<zero>") where "OclInt2900 = (\<lambda> _ . \<lfloor>\<lfloor>2900\<rfloor>\<rfloor>)" -definition OclInt3200 ("\<three>\<two>\<zero>\<zero>") where "OclInt3200 = (\<lambda> _ . \<lfloor>\<lfloor>3200\<rfloor>\<rfloor>)" -definition OclInt3500 ("\<three>\<five>\<zero>\<zero>") where "OclInt3500 = (\<lambda> _ . \<lfloor>\<lfloor>3500\<rfloor>\<rfloor>)" - -definition "oid0 \<equiv> 0" -definition "oid1 \<equiv> 1" -definition "oid2 \<equiv> 2" -definition "oid3 \<equiv> 3" -definition "oid4 \<equiv> 4" -definition "oid5 \<equiv> 5" -definition "oid6 \<equiv> 6" -definition "oid7 \<equiv> 7" -definition "oid8 \<equiv> 8" - -definition "person1 \<equiv> mk\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n oid0 \<lfloor>1300\<rfloor>" -definition "person2 \<equiv> mk\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n oid1 \<lfloor>1800\<rfloor>" -definition "person3 \<equiv> mk\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n oid2 None" -definition "person4 \<equiv> mk\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n oid3 \<lfloor>2900\<rfloor>" -definition "person5 \<equiv> mk\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n oid4 \<lfloor>3500\<rfloor>" -definition "person6 \<equiv> mk\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n oid5 \<lfloor>2500\<rfloor>" -definition "person7 \<equiv> mk\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y oid6 \<lfloor>\<lfloor>3200\<rfloor>\<rfloor>" -definition "person8 \<equiv> mk\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y oid7 None" -definition "person9 \<equiv> mk\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n oid8 \<lfloor>0\<rfloor>" - -text_raw{* \endisatagafp*} - -definition - "\<sigma>\<^sub>1 \<equiv> \<lparr> heap = Map.empty(oid0 \<mapsto> in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (mk\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n oid0 \<lfloor>1000\<rfloor>)) - (oid1 \<mapsto> in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (mk\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n oid1 \<lfloor>1200\<rfloor>)) - \<^cancel>\<open>oid2\<close> - (oid3 \<mapsto> in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (mk\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n oid3 \<lfloor>2600\<rfloor>)) - (oid4 \<mapsto> in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n person5) - (oid5 \<mapsto> in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (mk\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n oid5 \<lfloor>2300\<rfloor>)) - \<^cancel>\<open>oid6\<close> - \<^cancel>\<open>oid7\<close> - (oid8 \<mapsto> in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n person9), - assocs = Map.empty(oid\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<B>\<O>\<S>\<S> \<mapsto> [[[oid0],[oid1]],[[oid3],[oid4]],[[oid5],[oid3]]]) \<rparr>" - -definition - "\<sigma>\<^sub>1' \<equiv> \<lparr> heap = Map.empty(oid0 \<mapsto> in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n person1) - (oid1 \<mapsto> in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n person2) - (oid2 \<mapsto> in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n person3) - (oid3 \<mapsto> in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n person4) - \<^cancel>\<open>oid4\<close> - (oid5 \<mapsto> in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n person6) - (oid6 \<mapsto> in\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y person7) - (oid7 \<mapsto> in\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y person8) - (oid8 \<mapsto> in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n person9), - assocs = Map.empty(oid\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<B>\<O>\<S>\<S> \<mapsto> [[[oid0],[oid1]],[[oid1],[oid1]],[[oid5],[oid6]],[[oid6],[oid6]]]) \<rparr>" - -definition "\<sigma>\<^sub>0 \<equiv> \<lparr> heap = Map.empty, assocs = Map.empty \<rparr>" - - -lemma basic_\<tau>_wff: "WFF(\<sigma>\<^sub>1,\<sigma>\<^sub>1')" -by(auto simp: WFF_def \<sigma>\<^sub>1_def \<sigma>\<^sub>1'_def - oid0_def oid1_def oid2_def oid3_def oid4_def oid5_def oid6_def oid7_def oid8_def - oid_of_\<AA>_def oid_of_type\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_def oid_of_type\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_def - person1_def person2_def person3_def person4_def - person5_def person6_def person7_def person8_def person9_def) - -lemma [simp,code_unfold]: "dom (heap \<sigma>\<^sub>1) = {oid0,oid1\<^cancel>\<open>,oid2\<close>,oid3,oid4,oid5\<^cancel>\<open>,oid6,oid7\<close>,oid8}" -by(auto simp: \<sigma>\<^sub>1_def) - -lemma [simp,code_unfold]: "dom (heap \<sigma>\<^sub>1') = {oid0,oid1,oid2,oid3\<^cancel>\<open>,oid4\<close>,oid5,oid6,oid7,oid8}" -by(auto simp: \<sigma>\<^sub>1'_def) - -text_raw{* \isatagafp *} - -definition "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1 :: Person \<equiv> \<lambda> _ .\<lfloor>\<lfloor> person1 \<rfloor>\<rfloor>" -definition "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2 :: Person \<equiv> \<lambda> _ .\<lfloor>\<lfloor> person2 \<rfloor>\<rfloor>" -definition "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3 :: Person \<equiv> \<lambda> _ .\<lfloor>\<lfloor> person3 \<rfloor>\<rfloor>" -definition "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4 :: Person \<equiv> \<lambda> _ .\<lfloor>\<lfloor> person4 \<rfloor>\<rfloor>" -definition "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5 :: Person \<equiv> \<lambda> _ .\<lfloor>\<lfloor> person5 \<rfloor>\<rfloor>" -definition "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6 :: Person \<equiv> \<lambda> _ .\<lfloor>\<lfloor> person6 \<rfloor>\<rfloor>" -definition "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7 :: OclAny \<equiv> \<lambda> _ .\<lfloor>\<lfloor> person7 \<rfloor>\<rfloor>" -definition "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n8 :: OclAny \<equiv> \<lambda> _ .\<lfloor>\<lfloor> person8 \<rfloor>\<rfloor>" -definition "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9 :: Person \<equiv> \<lambda> _ .\<lfloor>\<lfloor> person9 \<rfloor>\<rfloor>" - -lemma [code_unfold]: "((x::Person) \<doteq> y) = StrictRefEq\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t x y" by(simp only: StrictRefEq\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n) -lemma [code_unfold]: "((x::OclAny) \<doteq> y) = StrictRefEq\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t x y" by(simp only: StrictRefEq\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y) - -lemmas [simp,code_unfold] = - OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny - OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person - OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny - OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person - - OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny - OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person - OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny - OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person - - OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny - OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person - OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny - OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person -text_raw{* \endisatagafp *} - -Assert "\<And>s\<^sub>p\<^sub>r\<^sub>e . (s\<^sub>p\<^sub>r\<^sub>e,\<sigma>\<^sub>1') \<Turnstile> (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1 .salary <> \<one>\<zero>\<zero>\<zero>)" -Assert "\<And>s\<^sub>p\<^sub>r\<^sub>e . (s\<^sub>p\<^sub>r\<^sub>e,\<sigma>\<^sub>1') \<Turnstile> (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1 .salary \<doteq> \<one>\<three>\<zero>\<zero>)" -Assert "\<And> s\<^sub>p\<^sub>o\<^sub>s\<^sub>t. (\<sigma>\<^sub>1,s\<^sub>p\<^sub>o\<^sub>s\<^sub>t) \<Turnstile> (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1 .salary@pre \<doteq> \<one>\<zero>\<zero>\<zero>)" -Assert "\<And> s\<^sub>p\<^sub>o\<^sub>s\<^sub>t. (\<sigma>\<^sub>1,s\<^sub>p\<^sub>o\<^sub>s\<^sub>t) \<Turnstile> (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1 .salary@pre <> \<one>\<three>\<zero>\<zero>)" -(*Assert "\<And>s\<^sub>p\<^sub>r\<^sub>e . (s\<^sub>p\<^sub>r\<^sub>e,\<sigma>\<^sub>1') \<Turnstile> (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1 .boss <> X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1)" -Assert "\<And>s\<^sub>p\<^sub>r\<^sub>e . (s\<^sub>p\<^sub>r\<^sub>e,\<sigma>\<^sub>1') \<Turnstile> (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1 .boss .salary \<doteq> \<one>\<eight>\<zero>\<zero>)" -Assert "\<And>s\<^sub>p\<^sub>r\<^sub>e . (s\<^sub>p\<^sub>r\<^sub>e,\<sigma>\<^sub>1') \<Turnstile> (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1 .boss .boss <> X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1)" -Assert "\<And>s\<^sub>p\<^sub>r\<^sub>e . (s\<^sub>p\<^sub>r\<^sub>e,\<sigma>\<^sub>1') \<Turnstile> (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1 .boss .boss \<doteq> X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2)" -Assert " (\<sigma>\<^sub>1,\<sigma>\<^sub>1') \<Turnstile> (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1 .boss@pre .salary \<doteq> \<one>\<eight>\<zero>\<zero>)" -Assert "\<And> s\<^sub>p\<^sub>o\<^sub>s\<^sub>t. (\<sigma>\<^sub>1,s\<^sub>p\<^sub>o\<^sub>s\<^sub>t) \<Turnstile> (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1 .boss@pre .salary@pre \<doteq> \<one>\<two>\<zero>\<zero>)" -Assert "\<And> s\<^sub>p\<^sub>o\<^sub>s\<^sub>t. (\<sigma>\<^sub>1,s\<^sub>p\<^sub>o\<^sub>s\<^sub>t) \<Turnstile> (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1 .boss@pre .salary@pre <> \<one>\<eight>\<zero>\<zero>)" -Assert "\<And> s\<^sub>p\<^sub>o\<^sub>s\<^sub>t. (\<sigma>\<^sub>1,s\<^sub>p\<^sub>o\<^sub>s\<^sub>t) \<Turnstile> (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1 .boss@pre \<doteq> X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2)" -Assert " (\<sigma>\<^sub>1,\<sigma>\<^sub>1') \<Turnstile> (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1 .boss@pre .boss \<doteq> X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2)" -Assert "\<And> s\<^sub>p\<^sub>o\<^sub>s\<^sub>t. (\<sigma>\<^sub>1,s\<^sub>p\<^sub>o\<^sub>s\<^sub>t) \<Turnstile> (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1 .boss@pre .boss@pre \<doteq> null)" -Assert "\<And> s\<^sub>p\<^sub>o\<^sub>s\<^sub>t. (\<sigma>\<^sub>1,s\<^sub>p\<^sub>o\<^sub>s\<^sub>t) \<Turnstile> not(\<upsilon>(X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1 .boss@pre .boss@pre .boss@pre))" -*) -lemma " (\<sigma>\<^sub>1,\<sigma>\<^sub>1') \<Turnstile> (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1 .oclIsMaintained())" -by(simp add: OclValid_def OclIsMaintained_def - \<sigma>\<^sub>1_def \<sigma>\<^sub>1'_def - X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1_def person1_def - oid0_def oid1_def oid2_def oid3_def oid4_def oid5_def oid6_def - oid_of_option_def oid_of_type\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_def) - -lemma "\<And>s\<^sub>p\<^sub>r\<^sub>e s\<^sub>p\<^sub>o\<^sub>s\<^sub>t. (s\<^sub>p\<^sub>r\<^sub>e,s\<^sub>p\<^sub>o\<^sub>s\<^sub>t) \<Turnstile> ((X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1 .oclAsType(OclAny) .oclAsType(Person)) \<doteq> X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1)" -by(rule up_down_cast_Person_OclAny_Person', simp add: X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1_def) -Assert "\<And>s\<^sub>p\<^sub>r\<^sub>e s\<^sub>p\<^sub>o\<^sub>s\<^sub>t. (s\<^sub>p\<^sub>r\<^sub>e,s\<^sub>p\<^sub>o\<^sub>s\<^sub>t) \<Turnstile> (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1 .oclIsTypeOf(Person))" -Assert "\<And>s\<^sub>p\<^sub>r\<^sub>e s\<^sub>p\<^sub>o\<^sub>s\<^sub>t. (s\<^sub>p\<^sub>r\<^sub>e,s\<^sub>p\<^sub>o\<^sub>s\<^sub>t) \<Turnstile> not(X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1 .oclIsTypeOf(OclAny))" -Assert "\<And>s\<^sub>p\<^sub>r\<^sub>e s\<^sub>p\<^sub>o\<^sub>s\<^sub>t. (s\<^sub>p\<^sub>r\<^sub>e,s\<^sub>p\<^sub>o\<^sub>s\<^sub>t) \<Turnstile> (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1 .oclIsKindOf(Person))" -Assert "\<And>s\<^sub>p\<^sub>r\<^sub>e s\<^sub>p\<^sub>o\<^sub>s\<^sub>t. (s\<^sub>p\<^sub>r\<^sub>e,s\<^sub>p\<^sub>o\<^sub>s\<^sub>t) \<Turnstile> (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1 .oclIsKindOf(OclAny))" -Assert "\<And>s\<^sub>p\<^sub>r\<^sub>e s\<^sub>p\<^sub>o\<^sub>s\<^sub>t. (s\<^sub>p\<^sub>r\<^sub>e,s\<^sub>p\<^sub>o\<^sub>s\<^sub>t) \<Turnstile> not(X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1 .oclAsType(OclAny) .oclIsTypeOf(OclAny))" - - -Assert "\<And>s\<^sub>p\<^sub>r\<^sub>e . (s\<^sub>p\<^sub>r\<^sub>e,\<sigma>\<^sub>1') \<Turnstile> (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2 .salary \<doteq> \<one>\<eight>\<zero>\<zero>)" -Assert "\<And> s\<^sub>p\<^sub>o\<^sub>s\<^sub>t. (\<sigma>\<^sub>1,s\<^sub>p\<^sub>o\<^sub>s\<^sub>t) \<Turnstile> (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2 .salary@pre \<doteq> \<one>\<two>\<zero>\<zero>)" -(*Assert "\<And>s\<^sub>p\<^sub>r\<^sub>e . (s\<^sub>p\<^sub>r\<^sub>e,\<sigma>\<^sub>1') \<Turnstile> (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2 .boss \<doteq> X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2)" -Assert " (\<sigma>\<^sub>1,\<sigma>\<^sub>1') \<Turnstile> (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2 .boss .salary@pre \<doteq> \<one>\<two>\<zero>\<zero>)" -Assert " (\<sigma>\<^sub>1,\<sigma>\<^sub>1') \<Turnstile> (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2 .boss .boss@pre \<doteq> null)" -Assert "\<And> s\<^sub>p\<^sub>o\<^sub>s\<^sub>t. (\<sigma>\<^sub>1,s\<^sub>p\<^sub>o\<^sub>s\<^sub>t) \<Turnstile> (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2 .boss@pre \<doteq> null)" -Assert "\<And> s\<^sub>p\<^sub>o\<^sub>s\<^sub>t. (\<sigma>\<^sub>1,s\<^sub>p\<^sub>o\<^sub>s\<^sub>t) \<Turnstile> (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2 .boss@pre <> X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2)" -Assert " (\<sigma>\<^sub>1,\<sigma>\<^sub>1') \<Turnstile> (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2 .boss@pre <> (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2 .boss))" -Assert "\<And> s\<^sub>p\<^sub>o\<^sub>s\<^sub>t. (\<sigma>\<^sub>1,s\<^sub>p\<^sub>o\<^sub>s\<^sub>t) \<Turnstile> not(\<upsilon>(X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2 .boss@pre .boss))" -Assert "\<And> s\<^sub>p\<^sub>o\<^sub>s\<^sub>t. (\<sigma>\<^sub>1,s\<^sub>p\<^sub>o\<^sub>s\<^sub>t) \<Turnstile> not(\<upsilon>(X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2 .boss@pre .salary@pre))" -*) -lemma " (\<sigma>\<^sub>1,\<sigma>\<^sub>1') \<Turnstile> (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2 .oclIsMaintained())" -by(simp add: OclValid_def OclIsMaintained_def \<sigma>\<^sub>1_def \<sigma>\<^sub>1'_def X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2_def person2_def - oid0_def oid1_def oid2_def oid3_def oid4_def oid5_def oid6_def - oid_of_option_def oid_of_type\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_def) - -Assert "\<And>s\<^sub>p\<^sub>r\<^sub>e . (s\<^sub>p\<^sub>r\<^sub>e,\<sigma>\<^sub>1') \<Turnstile> (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3 .salary \<doteq> null)" -Assert "\<And> s\<^sub>p\<^sub>o\<^sub>s\<^sub>t. (\<sigma>\<^sub>1,s\<^sub>p\<^sub>o\<^sub>s\<^sub>t) \<Turnstile> not(\<upsilon>(X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3 .salary@pre))" -(*Assert "\<And>s\<^sub>p\<^sub>r\<^sub>e . (s\<^sub>p\<^sub>r\<^sub>e,\<sigma>\<^sub>1') \<Turnstile> (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3 .boss \<doteq> null)" -Assert "\<And>s\<^sub>p\<^sub>r\<^sub>e . (s\<^sub>p\<^sub>r\<^sub>e,\<sigma>\<^sub>1') \<Turnstile> not(\<upsilon>(X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3 .boss .salary))" -Assert "\<And> s\<^sub>p\<^sub>o\<^sub>s\<^sub>t. (\<sigma>\<^sub>1,s\<^sub>p\<^sub>o\<^sub>s\<^sub>t) \<Turnstile> not(\<upsilon>(X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3 .boss@pre))" -*)lemma " (\<sigma>\<^sub>1,\<sigma>\<^sub>1') \<Turnstile> (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3 .oclIsNew())" -by(simp add: OclValid_def OclIsNew_def \<sigma>\<^sub>1_def \<sigma>\<^sub>1'_def X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3_def person3_def - oid0_def oid1_def oid2_def oid3_def oid4_def oid5_def oid6_def oid8_def - oid_of_option_def oid_of_type\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_def) - - -(*Assert "\<And> s\<^sub>p\<^sub>o\<^sub>s\<^sub>t. (\<sigma>\<^sub>1,s\<^sub>p\<^sub>o\<^sub>s\<^sub>t) \<Turnstile> (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4 .boss@pre \<doteq> X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5)" -Assert " (\<sigma>\<^sub>1,\<sigma>\<^sub>1') \<Turnstile> not(\<upsilon>(X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4 .boss@pre .salary))" -Assert "\<And> s\<^sub>p\<^sub>o\<^sub>s\<^sub>t. (\<sigma>\<^sub>1,s\<^sub>p\<^sub>o\<^sub>s\<^sub>t) \<Turnstile> (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4 .boss@pre .salary@pre \<doteq> \<three>\<five>\<zero>\<zero>)" -*) -lemma " (\<sigma>\<^sub>1,\<sigma>\<^sub>1') \<Turnstile> (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4 .oclIsMaintained())" -by(simp add: OclValid_def OclIsMaintained_def \<sigma>\<^sub>1_def \<sigma>\<^sub>1'_def X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4_def person4_def - oid0_def oid1_def oid2_def oid3_def oid4_def oid5_def oid6_def - oid_of_option_def oid_of_type\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_def) - -Assert "\<And>s\<^sub>p\<^sub>r\<^sub>e . (s\<^sub>p\<^sub>r\<^sub>e,\<sigma>\<^sub>1') \<Turnstile> not(\<upsilon>(X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5 .salary))" -Assert "\<And> s\<^sub>p\<^sub>o\<^sub>s\<^sub>t. (\<sigma>\<^sub>1,s\<^sub>p\<^sub>o\<^sub>s\<^sub>t) \<Turnstile> (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5 .salary@pre \<doteq> \<three>\<five>\<zero>\<zero>)" -(*Assert "\<And>s\<^sub>p\<^sub>r\<^sub>e . (s\<^sub>p\<^sub>r\<^sub>e,\<sigma>\<^sub>1') \<Turnstile> not(\<upsilon>(X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5 .boss))" -*) -lemma " (\<sigma>\<^sub>1,\<sigma>\<^sub>1') \<Turnstile> (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5 .oclIsDeleted())" -by(simp add: OclNot_def OclValid_def OclIsDeleted_def \<sigma>\<^sub>1_def \<sigma>\<^sub>1'_def X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5_def person5_def - oid0_def oid1_def oid2_def oid3_def oid4_def oid5_def oid6_def oid7_def oid8_def - oid_of_option_def oid_of_type\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_def) - -(* (* access to an oclany object not yet supported *) Assert " (\<sigma>\<^sub>1,\<sigma>\<^sub>1') \<Turnstile> ((X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6 .boss .salary) \<doteq> \<three>\<two>\<zero>\<zero> )"*) -(*Assert "\<And>s\<^sub>p\<^sub>r\<^sub>e . (s\<^sub>p\<^sub>r\<^sub>e,\<sigma>\<^sub>1') \<Turnstile> not(\<upsilon>(X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6 .boss .salary@pre))" -Assert "\<And> s\<^sub>p\<^sub>o\<^sub>s\<^sub>t. (\<sigma>\<^sub>1,s\<^sub>p\<^sub>o\<^sub>s\<^sub>t) \<Turnstile> (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6 .boss@pre \<doteq> X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4)" -Assert " (\<sigma>\<^sub>1,\<sigma>\<^sub>1') \<Turnstile> (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6 .boss@pre .salary \<doteq> \<two>\<nine>\<zero>\<zero>)" -Assert "\<And> s\<^sub>p\<^sub>o\<^sub>s\<^sub>t. (\<sigma>\<^sub>1,s\<^sub>p\<^sub>o\<^sub>s\<^sub>t) \<Turnstile> (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6 .boss@pre .salary@pre \<doteq> \<two>\<six>\<zero>\<zero>)" -Assert "\<And> s\<^sub>p\<^sub>o\<^sub>s\<^sub>t. (\<sigma>\<^sub>1,s\<^sub>p\<^sub>o\<^sub>s\<^sub>t) \<Turnstile> (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6 .boss@pre .boss@pre \<doteq> X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5)" -*) -lemma " (\<sigma>\<^sub>1,\<sigma>\<^sub>1') \<Turnstile> (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6 .oclIsMaintained())" -by(simp add: OclValid_def OclIsMaintained_def \<sigma>\<^sub>1_def \<sigma>\<^sub>1'_def X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6_def person6_def - oid0_def oid1_def oid2_def oid3_def oid4_def oid5_def oid6_def - oid_of_option_def oid_of_type\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_def) - -(* (* access to an oclany object not yet supported *) Assert " (\<sigma>\<^sub>1,\<sigma>\<^sub>1') \<Turnstile> ((X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7 .oclAsType(Person) \<doteq> (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6 .boss)))" *) -(* (* access to an oclany object not yet supported *) Assert " (\<sigma>\<^sub>1,\<sigma>\<^sub>1') \<Turnstile> ((X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7 .oclAsType(Person) .boss) \<doteq> (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7 .oclAsType(Person)) )" *) -(* (* access to an oclany object not yet supported *) Assert " (\<sigma>\<^sub>1,\<sigma>\<^sub>1') \<Turnstile> ((X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7 .oclAsType(Person) .boss .salary) \<doteq> \<three>\<two>\<zero>\<zero> )" *) -Assert "\<And>s\<^sub>p\<^sub>r\<^sub>e s\<^sub>p\<^sub>o\<^sub>s\<^sub>t. (s\<^sub>p\<^sub>r\<^sub>e,s\<^sub>p\<^sub>o\<^sub>s\<^sub>t) \<Turnstile> \<upsilon>(X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7 .oclAsType(Person))" -(*Assert "\<And> s\<^sub>p\<^sub>o\<^sub>s\<^sub>t. (\<sigma>\<^sub>1,s\<^sub>p\<^sub>o\<^sub>s\<^sub>t) \<Turnstile> not(\<upsilon>(X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7 .oclAsType(Person) .boss@pre))" -*) -lemma "\<And>s\<^sub>p\<^sub>r\<^sub>e s\<^sub>p\<^sub>o\<^sub>s\<^sub>t. (s\<^sub>p\<^sub>r\<^sub>e,s\<^sub>p\<^sub>o\<^sub>s\<^sub>t) \<Turnstile> ((X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7 .oclAsType(Person) .oclAsType(OclAny) - .oclAsType(Person)) - \<doteq> (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7 .oclAsType(Person)))" -by(rule up_down_cast_Person_OclAny_Person', simp add: X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7_def OclValid_def valid_def person7_def) -lemma " (\<sigma>\<^sub>1,\<sigma>\<^sub>1') \<Turnstile> (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7 .oclIsNew())" -by(simp add: OclValid_def OclIsNew_def \<sigma>\<^sub>1_def \<sigma>\<^sub>1'_def X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7_def person7_def - oid0_def oid1_def oid2_def oid3_def oid4_def oid5_def oid6_def oid8_def - oid_of_option_def oid_of_type\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_def) - -Assert "\<And>s\<^sub>p\<^sub>r\<^sub>e s\<^sub>p\<^sub>o\<^sub>s\<^sub>t. (s\<^sub>p\<^sub>r\<^sub>e,s\<^sub>p\<^sub>o\<^sub>s\<^sub>t) \<Turnstile> (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n8 <> X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7)" -Assert "\<And>s\<^sub>p\<^sub>r\<^sub>e s\<^sub>p\<^sub>o\<^sub>s\<^sub>t. (s\<^sub>p\<^sub>r\<^sub>e,s\<^sub>p\<^sub>o\<^sub>s\<^sub>t) \<Turnstile> not(\<upsilon>(X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n8 .oclAsType(Person)))" -Assert "\<And>s\<^sub>p\<^sub>r\<^sub>e s\<^sub>p\<^sub>o\<^sub>s\<^sub>t. (s\<^sub>p\<^sub>r\<^sub>e,s\<^sub>p\<^sub>o\<^sub>s\<^sub>t) \<Turnstile> (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n8 .oclIsTypeOf(OclAny))" -Assert "\<And>s\<^sub>p\<^sub>r\<^sub>e s\<^sub>p\<^sub>o\<^sub>s\<^sub>t. (s\<^sub>p\<^sub>r\<^sub>e,s\<^sub>p\<^sub>o\<^sub>s\<^sub>t) \<Turnstile> not(X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n8 .oclIsTypeOf(Person))" -Assert "\<And>s\<^sub>p\<^sub>r\<^sub>e s\<^sub>p\<^sub>o\<^sub>s\<^sub>t. (s\<^sub>p\<^sub>r\<^sub>e,s\<^sub>p\<^sub>o\<^sub>s\<^sub>t) \<Turnstile> not(X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n8 .oclIsKindOf(Person))" -Assert "\<And>s\<^sub>p\<^sub>r\<^sub>e s\<^sub>p\<^sub>o\<^sub>s\<^sub>t. (s\<^sub>p\<^sub>r\<^sub>e,s\<^sub>p\<^sub>o\<^sub>s\<^sub>t) \<Turnstile> (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n8 .oclIsKindOf(OclAny))" - -lemma \<sigma>_modifiedonly: "(\<sigma>\<^sub>1,\<sigma>\<^sub>1') \<Turnstile> (Set{ X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1 .oclAsType(OclAny) - , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2 .oclAsType(OclAny) - \<^cancel>\<open>, X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3 .oclAsType(OclAny)\<close> - , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4 .oclAsType(OclAny) - \<^cancel>\<open>, X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5 .oclAsType(OclAny)\<close> - , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6 .oclAsType(OclAny) - \<^cancel>\<open>, X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7 .oclAsType(OclAny)\<close> - \<^cancel>\<open>, X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n8 .oclAsType(OclAny)\<close> - \<^cancel>\<open>, X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9 .oclAsType(OclAny)\<close>}->oclIsModifiedOnly())" - apply(simp add: OclIsModifiedOnly_def OclValid_def - oid0_def oid1_def oid2_def oid3_def oid4_def oid5_def oid6_def oid7_def oid8_def - X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1_def X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2_def X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3_def X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4_def - X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5_def X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6_def X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7_def X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n8_def X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9_def - person1_def person2_def person3_def person4_def - person5_def person6_def person7_def person8_def person9_def - image_def) - apply(simp add: OclIncluding_rep_set mtSet_rep_set null_option_def bot_option_def) - apply(simp add: oid_of_option_def oid_of_type\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_def, clarsimp) - apply(simp add: \<sigma>\<^sub>1_def \<sigma>\<^sub>1'_def - oid0_def oid1_def oid2_def oid3_def oid4_def oid5_def oid6_def oid7_def oid8_def) -done - -lemma "(\<sigma>\<^sub>1,\<sigma>\<^sub>1') \<Turnstile> ((X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9 @pre (\<lambda>x. \<lfloor>OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_\<AA> x\<rfloor>)) \<triangleq> X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9)" -by(simp add: OclSelf_at_pre_def \<sigma>\<^sub>1_def oid_of_option_def oid_of_type\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_def - X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9_def person9_def oid8_def OclValid_def StrongEq_def OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_\<AA>_def) - -lemma "(\<sigma>\<^sub>1,\<sigma>\<^sub>1') \<Turnstile> ((X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9 @post (\<lambda>x. \<lfloor>OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_\<AA> x\<rfloor>)) \<triangleq> X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9)" -by(simp add: OclSelf_at_post_def \<sigma>\<^sub>1'_def oid_of_option_def oid_of_type\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_def - X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9_def person9_def oid8_def OclValid_def StrongEq_def OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_\<AA>_def) - -lemma "(\<sigma>\<^sub>1,\<sigma>\<^sub>1') \<Turnstile> (((X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9 .oclAsType(OclAny)) @pre (\<lambda>x. \<lfloor>OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_\<AA> x\<rfloor>)) \<triangleq> - ((X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9 .oclAsType(OclAny)) @post (\<lambda>x. \<lfloor>OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_\<AA> x\<rfloor>)))" -proof - - - have including4 : "\<And>a b c d \<tau>. - Set{\<lambda>\<tau>. \<lfloor>\<lfloor>a\<rfloor>\<rfloor>, \<lambda>\<tau>. \<lfloor>\<lfloor>b\<rfloor>\<rfloor>, \<lambda>\<tau>. \<lfloor>\<lfloor>c\<rfloor>\<rfloor>, \<lambda>\<tau>. \<lfloor>\<lfloor>d\<rfloor>\<rfloor>} \<tau> = Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e \<lfloor>\<lfloor> {\<lfloor>\<lfloor>a\<rfloor>\<rfloor>, \<lfloor>\<lfloor>b\<rfloor>\<rfloor>, \<lfloor>\<lfloor>c\<rfloor>\<rfloor>, \<lfloor>\<lfloor>d\<rfloor>\<rfloor>} \<rfloor>\<rfloor>" - apply(subst abs_rep_simp'[symmetric], simp) - apply(simp add: OclIncluding_rep_set mtSet_rep_set) - by(rule arg_cong[of _ _ "\<lambda>x. (Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e(\<lfloor>\<lfloor> x \<rfloor>\<rfloor>))"], auto) - - have excluding1: "\<And>S a b c d e \<tau>. - (\<lambda>_. Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e \<lfloor>\<lfloor> {\<lfloor>\<lfloor>a\<rfloor>\<rfloor>, \<lfloor>\<lfloor>b\<rfloor>\<rfloor>, \<lfloor>\<lfloor>c\<rfloor>\<rfloor>, \<lfloor>\<lfloor>d\<rfloor>\<rfloor>} \<rfloor>\<rfloor>)->excluding\<^sub>S\<^sub>e\<^sub>t(\<lambda>\<tau>. \<lfloor>\<lfloor>e\<rfloor>\<rfloor>) \<tau> = - Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e \<lfloor>\<lfloor> {\<lfloor>\<lfloor>a\<rfloor>\<rfloor>, \<lfloor>\<lfloor>b\<rfloor>\<rfloor>, \<lfloor>\<lfloor>c\<rfloor>\<rfloor>, \<lfloor>\<lfloor>d\<rfloor>\<rfloor>} - {\<lfloor>\<lfloor>e\<rfloor>\<rfloor>} \<rfloor>\<rfloor>" - apply(simp add: UML_Set.OclExcluding_def) - apply(simp add: defined_def OclValid_def false_def true_def - bot_fun_def bot_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def null_fun_def null_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def) - apply(rule conjI) - apply(rule impI, subst (asm) Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inject) apply( simp add: bot_option_def)+ - apply(rule conjI) - apply(rule impI, subst (asm) Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inject) apply( simp add: bot_option_def null_option_def)+ - apply(subst Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inverse, simp add: bot_option_def, simp) - done - - show ?thesis - apply(rule framing[where X = "Set{ X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1 .oclAsType(OclAny) - , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2 .oclAsType(OclAny) - \<^cancel>\<open>, X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3 .oclAsType(OclAny)\<close> - , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4 .oclAsType(OclAny) - \<^cancel>\<open>, X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5 .oclAsType(OclAny)\<close> - , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6 .oclAsType(OclAny) - \<^cancel>\<open>, X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7 .oclAsType(OclAny)\<close> - \<^cancel>\<open>, X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n8 .oclAsType(OclAny)\<close> - \<^cancel>\<open>, X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9 .oclAsType(OclAny)\<close>}"]) - apply(cut_tac \<sigma>_modifiedonly) - apply(simp only: OclValid_def - X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1_def X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2_def X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3_def X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4_def - X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5_def X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6_def X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7_def X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n8_def X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9_def - person1_def person2_def person3_def person4_def - person5_def person6_def person7_def person8_def person9_def - OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person) - apply(subst cp_OclIsModifiedOnly, subst UML_Set.OclExcluding.cp0, - subst (asm) cp_OclIsModifiedOnly, simp add: including4 excluding1) - - apply(simp only: X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1_def X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2_def X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3_def X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4_def - X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5_def X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6_def X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7_def X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n8_def X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9_def - person1_def person2_def person3_def person4_def - person5_def person6_def person7_def person8_def person9_def) - apply(simp add: OclIncluding_rep_set mtSet_rep_set - oid0_def oid1_def oid2_def oid3_def oid4_def oid5_def oid6_def oid7_def oid8_def) - apply(simp add: StrictRefEq\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_def oid_of_option_def oid_of_type\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_def OclNot_def OclValid_def - null_option_def bot_option_def) - done -qed - -lemma perm_\<sigma>\<^sub>1' : "\<sigma>\<^sub>1' = \<lparr> heap = Map.empty - (oid8 \<mapsto> in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n person9) - (oid7 \<mapsto> in\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y person8) - (oid6 \<mapsto> in\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y person7) - (oid5 \<mapsto> in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n person6) - \<^cancel>\<open>(oid4 \<mapsto> in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n person5)\<close> - (oid3 \<mapsto> in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n person4) - (oid2 \<mapsto> in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n person3) - (oid1 \<mapsto> in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n person2) - (oid0 \<mapsto> in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n person1) - , assocs = assocs \<sigma>\<^sub>1' \<rparr>" -proof - - note P = fun_upd_twist - show ?thesis - apply(simp add: \<sigma>\<^sub>1'_def - oid0_def oid1_def oid2_def oid3_def oid4_def oid5_def oid6_def oid7_def oid8_def) - apply(subst (1) P, simp) - apply(subst (2) P, simp) apply(subst (1) P, simp) - apply(subst (3) P, simp) apply(subst (2) P, simp) apply(subst (1) P, simp) - apply(subst (4) P, simp) apply(subst (3) P, simp) apply(subst (2) P, simp) apply(subst (1) P, simp) - apply(subst (5) P, simp) apply(subst (4) P, simp) apply(subst (3) P, simp) apply(subst (2) P, simp) apply(subst (1) P, simp) - apply(subst (6) P, simp) apply(subst (5) P, simp) apply(subst (4) P, simp) apply(subst (3) P, simp) apply(subst (2) P, simp) apply(subst (1) P, simp) - apply(subst (7) P, simp) apply(subst (6) P, simp) apply(subst (5) P, simp) apply(subst (4) P, simp) apply(subst (3) P, simp) apply(subst (2) P, simp) apply(subst (1) P, simp) - by(simp) -qed - -declare const_ss [simp] - -lemma "\<And>\<sigma>\<^sub>1. - (\<sigma>\<^sub>1,\<sigma>\<^sub>1') \<Turnstile> (Person .allInstances() \<doteq> Set{ X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1, X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2, X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3, X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4, \<^cancel>\<open>X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5,\<close> X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6, - X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7 .oclAsType(Person), \<^cancel>\<open>X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n8,\<close> X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9 })" - apply(subst perm_\<sigma>\<^sub>1') - apply(simp only: oid0_def oid1_def oid2_def oid3_def oid4_def oid5_def oid6_def oid7_def oid8_def - X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1_def X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2_def X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3_def X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4_def - X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5_def X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6_def X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7_def X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n8_def X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9_def - person7_def) - apply(subst state_update_vs_allInstances_at_post_tc, simp, simp add: OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_\<AA>_def, simp, rule const_StrictRefEq\<^sub>S\<^sub>e\<^sub>t_including, simp, simp, simp, rule OclIncluding_cong, simp, simp) - apply(subst state_update_vs_allInstances_at_post_tc, simp, simp add: OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_\<AA>_def, simp, rule const_StrictRefEq\<^sub>S\<^sub>e\<^sub>t_including, simp, simp, simp, rule OclIncluding_cong, simp, simp) - apply(subst state_update_vs_allInstances_at_post_tc, simp, simp add: OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_\<AA>_def, simp, rule const_StrictRefEq\<^sub>S\<^sub>e\<^sub>t_including, simp, simp, simp, rule OclIncluding_cong, simp, simp) - apply(subst state_update_vs_allInstances_at_post_tc, simp, simp add: OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_\<AA>_def, simp, rule const_StrictRefEq\<^sub>S\<^sub>e\<^sub>t_including, simp, simp, simp, rule OclIncluding_cong, simp, simp) - apply(subst state_update_vs_allInstances_at_post_tc, simp, simp add: OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_\<AA>_def, simp, rule const_StrictRefEq\<^sub>S\<^sub>e\<^sub>t_including, simp, simp, simp, rule OclIncluding_cong, simp, simp) - apply(subst state_update_vs_allInstances_at_post_tc, simp, simp add: OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_\<AA>_def, simp, rule const_StrictRefEq\<^sub>S\<^sub>e\<^sub>t_including, simp, simp, simp, rule OclIncluding_cong, simp, simp) - apply(subst state_update_vs_allInstances_at_post_ntc, simp, simp add: OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_\<AA>_def - person8_def, simp, rule const_StrictRefEq\<^sub>S\<^sub>e\<^sub>t_including, simp, simp, simp) - apply(subst state_update_vs_allInstances_at_post_tc, simp, simp add: OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_\<AA>_def, simp, rule const_StrictRefEq\<^sub>S\<^sub>e\<^sub>t_including, simp, simp, simp, rule OclIncluding_cong, simp, simp) - apply(rule state_update_vs_allInstances_at_post_empty) -by(simp_all add: OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_\<AA>_def) - -lemma "\<And>\<sigma>\<^sub>1. - (\<sigma>\<^sub>1,\<sigma>\<^sub>1') \<Turnstile> (OclAny .allInstances() \<doteq> Set{ X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1 .oclAsType(OclAny), X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2 .oclAsType(OclAny), - X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3 .oclAsType(OclAny), X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4 .oclAsType(OclAny), - \<^cancel>\<open>X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5,\<close> X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6 .oclAsType(OclAny), - X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7, X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n8, X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9 .oclAsType(OclAny) })" - apply(subst perm_\<sigma>\<^sub>1') - apply(simp only: oid0_def oid1_def oid2_def oid3_def oid4_def oid5_def oid6_def oid7_def oid8_def - X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1_def X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2_def X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3_def X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4_def X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5_def X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6_def X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7_def X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n8_def X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9_def - person1_def person2_def person3_def person4_def person5_def person6_def person9_def) - apply(subst state_update_vs_allInstances_at_post_tc, simp, simp add: OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_\<AA>_def, simp, rule const_StrictRefEq\<^sub>S\<^sub>e\<^sub>t_including, simp, simp, simp, rule OclIncluding_cong, simp, simp)+ - apply(rule state_update_vs_allInstances_at_post_empty) -by(simp_all add: OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_\<AA>_def) - -end diff --git a/Citadelle/examples/Employee_Model/Analysis_deep.thy b/Citadelle/examples/Employee_Model/Analysis_deep.thy deleted file mode 100644 index 54d60dbecac2a2ac21d605ee447dd43f966f53ce..0000000000000000000000000000000000000000 --- a/Citadelle/examples/Employee_Model/Analysis_deep.thy +++ /dev/null @@ -1,143 +0,0 @@ -(****************************************************************************** - * 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 - Analysis_deep -imports - "../../src/compiler/Generator_dynamic_sequential" -begin - -generation_syntax [ deep - (generation_semantics [ analysis (*, oid_start 10*) ]) - (THEORY Employee_AnalysisModel_UMLPart_generated) - (IMPORTS ["OCL.UML_Main", "FOCL.Static"] - "FOCL.Generator_dynamic_sequential") - SECTION - (*SORRY*) (*no_dirty*) - [ (* in Haskell *) - (* in OCaml module_name M *) - (* in Scala module_name M *) - (* in SML module_name M *) - in self ] - (output_directory "../../doc") - (*, syntax_print*) ] - -Class Person < Planet - Attributes salary : Integer (*\<acute>int\<acute>*) -End - -Association boss - Between Person [*] - Person [0 \<bullet>\<bullet> 1] Role boss -End - -Class Planet < Galaxy - Attributes wormhole : UnlimitedNatural - weight : Integer -End - -Class Galaxy - Attributes sound : Void - moving : Boolean - outer_world : Set(Sequence(Planet)) -End - -Instance X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1 :: Person = [ salary = 1300 , boss = X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2 ] - and X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2 :: Person = [ salary = 1800 , boss = X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2 ] - and X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3 :: Person = [] - and X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4 :: Person = [ salary = 2900 ] - and X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5 :: Person = [ salary = 3500 ] - and X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6 :: Person = [ salary = 2500 , boss = X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7 ] - and X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7 = ([ salary = 3200 , boss = X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7 ] :: Person) \<rightarrow>oclAsType( OclAny ) - and X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n8 :: OclAny = [] - and X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9 :: Person = [ salary = 0 ] - and X0 :: Person = [ outer_world = [ [ P1 ] ] ] - and P1 :: Planet = [ outer_world = [ [ P1 ] , [ self 10 ] ] ] - -State \<sigma>\<^sub>1 = - [ ([ X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1 with_only salary = 1000 , boss = self 1 ] :: Person) - , ([ X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2 with_only salary = 1200 ] :: Person) - (* *) - , ([ X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4 with_only salary = 2600 , boss = self 3 ] :: Person) - , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5 - , ([ X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6 with_only salary = 2300 , boss = self 2 ] :: Person) - (* *) - (* *) - , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9 ] - -State \<sigma>\<^sub>1' = - [ X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1 - , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2 - , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3 - , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4 - (* *) - , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6 - , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7 - , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n8 - , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9 ] - -(*State \<sigma>\<^sub>0 = []*) - -Transition \<sigma>\<^sub>1 \<sigma>\<^sub>1' - -Context Person :: contents () : Set(Integer) - Post : "result \<triangleq> if (self .boss \<doteq> null) - then (Set{}->including\<^sub>S\<^sub>e\<^sub>t(self .salary)) - else (self .boss .contents()->including\<^sub>S\<^sub>e\<^sub>t(self .salary)) - endif" - Post : "true" - Pre : "false" - -Context Person - Inv a: "self .boss <> null implies (self .salary \<triangleq> ((self .boss) .salary))" - -Context Planet - Inv A : "true and (self .weight \<le>\<^sub>i\<^sub>n\<^sub>t \<zero>)" - -(*BaseType [ 1000, 1200, 1300, 1800, 2600, 2900, 3200, 3500 - , 3.14159265 - , "abc", "\<AA>\<BB>\<CC>\<DD>\<EE>\<FF>" ]*) - -(*generation_syntax deep flush_all*) - -end diff --git a/Citadelle/examples/Employee_Model/Analysis_shallow.thy b/Citadelle/examples/Employee_Model/Analysis_shallow.thy deleted file mode 100644 index 628fe2371b6994469545d6ae2788cdb7665927e9..0000000000000000000000000000000000000000 --- a/Citadelle/examples/Employee_Model/Analysis_shallow.thy +++ /dev/null @@ -1,134 +0,0 @@ -(****************************************************************************** - * 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 - Analysis_shallow -imports - OCL.UML_Main - FOCL.Static - FOCL.Generator_dynamic_sequential -begin - -generation_syntax [ shallow (generation_semantics [ analysis ]) - (*SORRY*) (*no_dirty*) - (*, syntax_print*) ] - -Class Person < Planet - Attributes salary : Integer (*\<acute>int\<acute>*) -End - -Association boss - Between Person [*] - Person [0 \<bullet>\<bullet> 1] Role boss -End - -Class Planet < Galaxy - Attributes wormhole : UnlimitedNatural - weight : Integer -End - -Class Galaxy - Attributes sound : Void - moving : Boolean - outer_world : Set(Sequence(Planet)) -End - -Instance X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1 :: Person = [ salary = 1300 , boss = X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2 ] - and X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2 :: Person = [ salary = 1800 , boss = X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2 ] - and X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3 :: Person = [] - and X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4 :: Person = [ salary = 2900 ] - and X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5 :: Person = [ salary = 3500 ] - and X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6 :: Person = [ salary = 2500 , boss = X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7 ] - and X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7 = ([ salary = 3200 , boss = X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7 ] :: Person) \<rightarrow>oclAsType( OclAny ) - and X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n8 :: OclAny = [] - and X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9 :: Person = [ salary = 0 ] - and X0 :: Person = [ outer_world = [ [ P1 ] ] ] - and P1 :: Planet = [ outer_world = [ [ P1 ] , [ self 10 ] ] ] - -State \<sigma>\<^sub>1 = - [ ([ X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1 with_only salary = 1000 , boss = self 1 ] :: Person) - , ([ X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2 with_only salary = 1200 ] :: Person) - (* *) - , ([ X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4 with_only salary = 2600 , boss = self 3 ] :: Person) - , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5 - , ([ X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6 with_only salary = 2300 , boss = self 2 ] :: Person) - (* *) - (* *) - , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9 ] - -State \<sigma>\<^sub>1' = - [ X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1 - , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2 - , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3 - , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4 - (* *) - , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6 - , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7 - , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n8 - , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9 ] - -(*State \<sigma>\<^sub>0 = []*) - -Transition \<sigma>\<^sub>1 \<sigma>\<^sub>1' - -Context Person :: contents () : Set(Integer) - Post : "result \<triangleq> if (self .boss \<doteq> null) - then (Set{}->including\<^sub>S\<^sub>e\<^sub>t(self .salary)) - else (self .boss .contents()->including\<^sub>S\<^sub>e\<^sub>t(self .salary)) - endif" - Post : "true" - Pre : "false" - -Context Person - Inv a: "self .boss <> null implies (self .salary \<triangleq> ((self .boss) .salary))" - -Context Planet - Inv A : "true and (self .weight \<le>\<^sub>i\<^sub>n\<^sub>t \<zero>)" - -(*BaseType [ 1000, 1200, 1300, 1800, 2600, 2900, 3200, 3500 - , 3.14159265 - , "abc", "\<AA>\<BB>\<CC>\<DD>\<EE>\<FF>" ]*) - -lemmas [simp,code_unfold] = dot_accessor - -end diff --git a/Citadelle/examples/Employee_Model/Design/Design_OCL.thy b/Citadelle/examples/Employee_Model/Design/Design_OCL.thy deleted file mode 100644 index a2619340a6fe8b3fea7d0c33734e545ae67f7b4e..0000000000000000000000000000000000000000 --- a/Citadelle/examples/Employee_Model/Design/Design_OCL.thy +++ /dev/null @@ -1,142 +0,0 @@ -(****************************************************************************** - * 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 - Design_OCL -imports - Design_UML (* Testing *) -begin -text {* \label{ex:employee-design:ocl} *} -(* Ideally, these definitions are automatically generated from the class model. *) - -section{* OCL Part: Invariant *} -text{* These recursive predicates can be defined conservatively -by greatest fix-point -constructions---automatically. See~\cite{brucker.ea:hol-ocl-book:2006,brucker:interactive:2007} -for details. For the purpose of this example, we state them as axioms -here. - -\begin{ocl} -context Person - inv label : self .boss <> null implies (self .salary \<le> ((self .boss) .salary)) -\end{ocl} -*} - -definition Person_label\<^sub>i\<^sub>n\<^sub>v :: "Person \<Rightarrow> Boolean" -where "Person_label\<^sub>i\<^sub>n\<^sub>v (self) \<equiv> - (self .boss <> null implies (self .salary \<le>\<^sub>i\<^sub>n\<^sub>t ((self .boss) .salary)))" - - -definition Person_label\<^sub>i\<^sub>n\<^sub>v\<^sub>A\<^sub>T\<^sub>p\<^sub>r\<^sub>e :: "Person \<Rightarrow> Boolean" -where "Person_label\<^sub>i\<^sub>n\<^sub>v\<^sub>A\<^sub>T\<^sub>p\<^sub>r\<^sub>e (self) \<equiv> - (self .boss@pre <> null implies (self .salary@pre \<le>\<^sub>i\<^sub>n\<^sub>t ((self .boss@pre) .salary@pre)))" - -definition Person_label\<^sub>g\<^sub>l\<^sub>o\<^sub>b\<^sub>a\<^sub>l\<^sub>i\<^sub>n\<^sub>v :: "Boolean" -where "Person_label\<^sub>g\<^sub>l\<^sub>o\<^sub>b\<^sub>a\<^sub>l\<^sub>i\<^sub>n\<^sub>v \<equiv> (Person .allInstances()->forAll\<^sub>S\<^sub>e\<^sub>t(x | Person_label\<^sub>i\<^sub>n\<^sub>v (x)) and - (Person .allInstances@pre()->forAll\<^sub>S\<^sub>e\<^sub>t(x | Person_label\<^sub>i\<^sub>n\<^sub>v\<^sub>A\<^sub>T\<^sub>p\<^sub>r\<^sub>e (x))))" - - -lemma "\<tau> \<Turnstile> \<delta> (X .boss) \<Longrightarrow> \<tau> \<Turnstile> Person .allInstances()->includes\<^sub>S\<^sub>e\<^sub>t(X .boss) \<and> - \<tau> \<Turnstile> Person .allInstances()->includes\<^sub>S\<^sub>e\<^sub>t(X) " -oops (* should be: sorry *) -(* To be generated generically ... hard, but crucial lemma that should hold. - It means that X and it successor are object representation that actually - occur in the state. *) - -lemma REC_pre : "\<tau> \<Turnstile> Person_label\<^sub>g\<^sub>l\<^sub>o\<^sub>b\<^sub>a\<^sub>l\<^sub>i\<^sub>n\<^sub>v - \<Longrightarrow> \<tau> \<Turnstile> Person .allInstances()->includes\<^sub>S\<^sub>e\<^sub>t(X) \<comment> \<open>\<open>X\<close> represented object in state\<close> - \<Longrightarrow> \<exists> REC. \<tau> \<Turnstile> REC(X) \<triangleq> (Person_label\<^sub>i\<^sub>n\<^sub>v (X) and (X .boss <> null implies REC(X .boss)))" -oops (* should be sorry - Attempt to allegiate the burden of he following axiomatizations: could be - a witness for a constant specification ...*) - -text{* This allows to state a predicate: *} - -axiomatization inv\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<^sub>_\<^sub>l\<^sub>a\<^sub>b\<^sub>e\<^sub>l :: "Person \<Rightarrow> Boolean" -where inv\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<^sub>_\<^sub>l\<^sub>a\<^sub>b\<^sub>e\<^sub>l_def: -"(\<tau> \<Turnstile> Person .allInstances()->includes\<^sub>S\<^sub>e\<^sub>t(self)) \<Longrightarrow> - (\<tau> \<Turnstile> (inv\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<^sub>_\<^sub>l\<^sub>a\<^sub>b\<^sub>e\<^sub>l(self) \<triangleq> (self .boss <> null implies - (self .salary \<le>\<^sub>i\<^sub>n\<^sub>t ((self .boss) .salary)) and - inv\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<^sub>_\<^sub>l\<^sub>a\<^sub>b\<^sub>e\<^sub>l(self .boss))))" - -axiomatization inv\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<^sub>_\<^sub>l\<^sub>a\<^sub>b\<^sub>e\<^sub>l\<^sub>A\<^sub>T\<^sub>p\<^sub>r\<^sub>e :: "Person \<Rightarrow> Boolean" -where inv\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<^sub>_\<^sub>l\<^sub>a\<^sub>b\<^sub>e\<^sub>l\<^sub>A\<^sub>T\<^sub>p\<^sub>r\<^sub>e_def: -"(\<tau> \<Turnstile> Person .allInstances@pre()->includes\<^sub>S\<^sub>e\<^sub>t(self)) \<Longrightarrow> - (\<tau> \<Turnstile> (inv\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<^sub>_\<^sub>l\<^sub>a\<^sub>b\<^sub>e\<^sub>l\<^sub>A\<^sub>T\<^sub>p\<^sub>r\<^sub>e(self) \<triangleq> (self .boss@pre <> null implies - (self .salary@pre \<le>\<^sub>i\<^sub>n\<^sub>t ((self .boss@pre) .salary@pre)) and - inv\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<^sub>_\<^sub>l\<^sub>a\<^sub>b\<^sub>e\<^sub>l\<^sub>A\<^sub>T\<^sub>p\<^sub>r\<^sub>e(self .boss@pre))))" - - -lemma inv_1 : -"(\<tau> \<Turnstile> Person .allInstances()->includes\<^sub>S\<^sub>e\<^sub>t(self)) \<Longrightarrow> - (\<tau> \<Turnstile> inv\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<^sub>_\<^sub>l\<^sub>a\<^sub>b\<^sub>e\<^sub>l(self) = ((\<tau> \<Turnstile> (self .boss \<doteq> null)) \<or> - ( \<tau> \<Turnstile> (self .boss <> null) \<and> - \<tau> \<Turnstile> ((self .salary) \<le>\<^sub>i\<^sub>n\<^sub>t (self .boss .salary)) \<and> - \<tau> \<Turnstile> (inv\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<^sub>_\<^sub>l\<^sub>a\<^sub>b\<^sub>e\<^sub>l(self .boss))))) " -oops (* should be: sorry *) (* Let's hope that this holds ... *) - - -lemma inv_2 : -"(\<tau> \<Turnstile> Person .allInstances@pre()->includes\<^sub>S\<^sub>e\<^sub>t(self)) \<Longrightarrow> - (\<tau> \<Turnstile> inv\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<^sub>_\<^sub>l\<^sub>a\<^sub>b\<^sub>e\<^sub>l\<^sub>A\<^sub>T\<^sub>p\<^sub>r\<^sub>e(self)) = ((\<tau> \<Turnstile> (self .boss@pre \<doteq> null)) \<or> - (\<tau> \<Turnstile> (self .boss@pre <> null) \<and> - (\<tau> \<Turnstile> (self .boss@pre .salary@pre \<le>\<^sub>i\<^sub>n\<^sub>t self .salary@pre)) \<and> - (\<tau> \<Turnstile> (inv\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<^sub>_\<^sub>l\<^sub>a\<^sub>b\<^sub>e\<^sub>l\<^sub>A\<^sub>T\<^sub>p\<^sub>r\<^sub>e(self .boss@pre)))))" -oops (* should be: sorry *) (* Let's hope that this holds ... *) - -text{* A very first attempt to characterize the axiomatization by an inductive -definition - this can not be the last word since too weak (should be equality!) *} -coinductive inv :: "Person \<Rightarrow> (\<AA>)st \<Rightarrow> bool" where - "(\<tau> \<Turnstile> (\<delta> self)) \<Longrightarrow> ((\<tau> \<Turnstile> (self .boss \<doteq> null)) \<or> - (\<tau> \<Turnstile> (self .boss <> null) \<and> (\<tau> \<Turnstile> (self .boss .salary \<le>\<^sub>i\<^sub>n\<^sub>t self .salary)) \<and> - ( (inv(self .boss))\<tau> ))) - \<Longrightarrow> ( inv self \<tau>)" - - -section{* OCL Part: The Contract of a Recursive Query *} -text{* This part is analogous to the Analysis Model and skipped here. *} - - -end diff --git a/Citadelle/examples/Employee_Model/Design/Design_UML.thy b/Citadelle/examples/Employee_Model/Design/Design_UML.thy deleted file mode 100644 index 829747774b62fa52c593f29bb003c8e14c27f3f0..0000000000000000000000000000000000000000 --- a/Citadelle/examples/Employee_Model/Design/Design_UML.thy +++ /dev/null @@ -1,1348 +0,0 @@ -(****************************************************************************** - * 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. - ******************************************************************************) - -chapter{* Example: The Employee Design Model *} (* UML part *) - -(* This example is not yet balanced. Some parts of should go to - Part VI : State Operations and Objects *) - -theory - Design_UML -imports - "../../../src/UML_Main" -begin - -text {* \label{ex:employee-design:uml} *} - -section{* Introduction *} -text{* - For certain concepts like classes and class-types, only a generic - definition for its resulting semantics can be given. Generic means, - there is a function outside HOL that ``compiles'' a concrete, - closed-world class diagram into a ``theory'' of this data model, - consisting of a bunch of definitions for classes, accessors, method, - casts, and tests for actual types, as well as proofs for the - fundamental properties of these operations in this concrete data - model. *} - -text{* Such generic function or ``compiler'' can be implemented in - Isabelle on the ML level. This has been done, for a semantics - following the open-world assumption, for UML 2.0 - in~\cite{brucker.ea:extensible:2008-b, brucker:interactive:2007}. In - this paper, we follow another approach for UML 2.4: we define the - concepts of the compilation informally, and present a concrete - example which is verified in Isabelle/HOL. *} - -subsection{* Outlining the Example *} - -text{* We are presenting here a ``design-model'' of the (slightly -modified) example Figure 7.3, page 20 of -the OCL standard~\cite{omg:ocl:2012}. To be precise, this theory contains the formalization of -the data-part covered by the UML class model (see \autoref{fig:person}):*} - -text{* -\begin{figure} - \centering\scalebox{.3}{\includegraphics{figures/person.png}}% - \caption{A simple UML class model drawn from Figure 7.3, - page 20 of~\cite{omg:ocl:2012}. \label{fig:person}} -\end{figure} -*} - -text{* This means that the association (attached to the association class -\inlineocl{EmployeeRanking}) with the association ends \inlineocl+boss+ and \inlineocl+employees+ is implemented -by the attribute \inlineocl+boss+ and the operation \inlineocl+employees+ (to be discussed in the OCL part -captured by the subsequent theory). -*} - -section{* Example Data-Universe and its Infrastructure *} -text{* Ideally, the following is generated automatically from a UML class model. *} - -(* @{text "'\<AA>"} -- \mathfrak{A} *) -text{* Our data universe consists in the concrete class diagram just of node's, -and implicitly of the class object. Each class implies the existence of a class -type defined for the corresponding object representations as follows: *} - -datatype type\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n = mk\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n oid (* the oid to the person itself *) - "int option" (* the attribute "salary" or null *) - "oid option" (* the attribute "boss" or null *) - - -datatype type\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y = mk\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y oid (* the oid to the oclany itself *) - "(int option \<times> oid option) option" - (* the extensions to "person"; used to denote - objects of actual type "person" casted to "oclany"; - in case of existence of several subclasses - of oclany, sums of extensions have to be provided. *) - -text{* Now, we construct a concrete ``universe of OclAny types'' by injection into a -sum type containing the class types. This type of OclAny will be used as instance -for all respective type-variables. *} - -datatype \<AA> = in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n type\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n | in\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y type\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y - -text{* Having fixed the object universe, we can introduce type synonyms that exactly correspond -to OCL types. Again, we exploit that our representation of OCL is a ``shallow embedding'' with a -one-to-one correspondance of OCL-types to types of the meta-language HOL. *} -type_synonym Boolean = " \<AA> Boolean" -type_synonym Integer = " \<AA> Integer" -type_synonym Void = " \<AA> Void" -type_synonym OclAny = "(\<AA>, type\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y option option) val" -type_synonym Person = "(\<AA>, type\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n option option) val" -type_synonym Set_Integer = "(\<AA>, int option option) Set" -type_synonym Set_Person = "(\<AA>, type\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n option option) Set" - -text{* Just a little check: *} -typ "Boolean" - -text{* To reuse key-elements of the library like referential equality, we have -to show that the object universe belongs to the type class ``oclany,'' \ie, - each class type has to provide a function @{term oid_of} yielding the object id (oid) of the object. *} -instantiation type\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n :: object -begin - definition oid_of_type\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_def: "oid_of x = (case x of mk\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n oid _ _ \<Rightarrow> oid)" - instance .. -end - -instantiation type\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y :: object -begin - definition oid_of_type\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_def: "oid_of x = (case x of mk\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y oid _ \<Rightarrow> oid)" - instance .. -end - -instantiation \<AA> :: object -begin - definition oid_of_\<AA>_def: "oid_of x = (case x of - in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n person \<Rightarrow> oid_of person - | in\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y oclany \<Rightarrow> oid_of oclany)" - instance .. -end - - - - -section{* Instantiation of the Generic Strict Equality *} -text{* We instantiate the referential equality -on @{text "Person"} and @{text "OclAny"} *} - -overloading StrictRefEq \<equiv> "StrictRefEq :: [Person,Person] \<Rightarrow> Boolean" -begin - definition StrictRefEq\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n : "(x::Person) \<doteq> y \<equiv> StrictRefEq\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t x y" -end - -overloading StrictRefEq \<equiv> "StrictRefEq :: [OclAny,OclAny] \<Rightarrow> Boolean" -begin - definition StrictRefEq\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y : "(x::OclAny) \<doteq> y \<equiv> StrictRefEq\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t x y" -end - -lemmas cps23 = - cp_StrictRefEq\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t[of "x::Person" "y::Person" "\<tau>", - simplified StrictRefEq\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n[symmetric]] - cp_intro(9) [of "P::Person \<Rightarrow>Person""Q::Person \<Rightarrow>Person", - simplified StrictRefEq\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n[symmetric] ] - StrictRefEq\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_def [of "x::Person" "y::Person", - simplified StrictRefEq\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n[symmetric]] - StrictRefEq\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_defargs [of _ "x::Person" "y::Person", - simplified StrictRefEq\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n[symmetric]] - StrictRefEq\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_strict1 - [of "x::Person", - simplified StrictRefEq\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n[symmetric]] - StrictRefEq\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_strict2 - [of "x::Person", - simplified StrictRefEq\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n[symmetric]] - for x y \<tau> P Q - -(* TODO: Analogue for object. *) - -text{* For each Class \emph{C}, we will have a casting operation \inlineocl{.oclAsType($C$)}, - a test on the actual type \inlineocl{.oclIsTypeOf($C$)} as well as its relaxed form - \inlineocl{.oclIsKindOf($C$)} (corresponding exactly to Java's \verb+instanceof+-operator. -*} -text{* Thus, since we have two class-types in our concrete class hierarchy, we have -two operations to declare and to provide two overloading definitions for the two static types. -*} - - -section{* OclAsType *} -subsection{* Definition *} - -consts OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y :: "'\<alpha> \<Rightarrow> OclAny" ("(_) .oclAsType'(OclAny')") -consts OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n :: "'\<alpha> \<Rightarrow> Person" ("(_) .oclAsType'(Person')") - -definition "OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_\<AA> = (\<lambda>u. \<lfloor>case u of in\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y a \<Rightarrow> a - | in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (mk\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n oid a b) \<Rightarrow> mk\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y oid \<lfloor>(a,b)\<rfloor>\<rfloor>)" - -lemma OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_\<AA>_some: "OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_\<AA> x \<noteq> None" -by(simp add: OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_\<AA>_def) - -overloading OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y \<equiv> "OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y :: OclAny \<Rightarrow> OclAny" -begin - definition OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny: - "(X::OclAny) .oclAsType(OclAny) \<equiv> X" -end - -overloading OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y \<equiv> "OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y :: Person \<Rightarrow> OclAny" -begin - definition OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person: - "(X::Person) .oclAsType(OclAny) \<equiv> - (\<lambda>\<tau>. case X \<tau> of - \<bottom> \<Rightarrow> invalid \<tau> - | \<lfloor>\<bottom>\<rfloor> \<Rightarrow> null \<tau> - | \<lfloor>\<lfloor>mk\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n oid a b \<rfloor>\<rfloor> \<Rightarrow> \<lfloor>\<lfloor> (mk\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y oid \<lfloor>(a,b)\<rfloor>) \<rfloor>\<rfloor>)" -end - -definition "OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_\<AA> = - (\<lambda>u. case u of in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n p \<Rightarrow> \<lfloor>p\<rfloor> - | in\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y (mk\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y oid \<lfloor>(a,b)\<rfloor>) \<Rightarrow> \<lfloor>mk\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n oid a b\<rfloor> - | _ \<Rightarrow> None)" - -overloading OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n \<equiv> "OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n :: OclAny \<Rightarrow> Person" -begin - definition OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny: - "(X::OclAny) .oclAsType(Person) \<equiv> - (\<lambda>\<tau>. case X \<tau> of - \<bottom> \<Rightarrow> invalid \<tau> - | \<lfloor>\<bottom>\<rfloor> \<Rightarrow> null \<tau> - | \<lfloor>\<lfloor>mk\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y oid \<bottom> \<rfloor>\<rfloor> \<Rightarrow> invalid \<tau> \<comment> \<open>down-cast exception\<close> - | \<lfloor>\<lfloor>mk\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y oid \<lfloor>(a,b)\<rfloor> \<rfloor>\<rfloor> \<Rightarrow> \<lfloor>\<lfloor>mk\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n oid a b \<rfloor>\<rfloor>)" -end - -overloading OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n \<equiv> "OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n :: Person \<Rightarrow> Person" -begin - definition OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person: - "(X::Person) .oclAsType(Person) \<equiv> X " (* to avoid identity for null ? *) -end -text_raw{* \isatagafp *} - -lemmas [simp] = - OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny - OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person -subsection{* Context Passing *} - -lemma cp_OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_Person: "cp P \<Longrightarrow> cp(\<lambda>X. (P (X::Person)::Person) .oclAsType(OclAny))" -by(rule cpI1, simp_all add: OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person) -lemma cp_OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_OclAny: "cp P \<Longrightarrow> cp(\<lambda>X. (P (X::OclAny)::OclAny) .oclAsType(OclAny))" -by(rule cpI1, simp_all add: OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny) -lemma cp_OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_Person: "cp P \<Longrightarrow> cp(\<lambda>X. (P (X::Person)::Person) .oclAsType(Person))" -by(rule cpI1, simp_all add: OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person) -lemma cp_OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_OclAny: "cp P \<Longrightarrow> cp(\<lambda>X. (P (X::OclAny)::OclAny) .oclAsType(Person))" -by(rule cpI1, simp_all add: OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny) - -lemma cp_OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_OclAny: "cp P \<Longrightarrow> cp(\<lambda>X. (P (X::Person)::OclAny) .oclAsType(OclAny))" -by(rule cpI1, simp_all add: OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny) -lemma cp_OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_Person: "cp P \<Longrightarrow> cp(\<lambda>X. (P (X::OclAny)::Person) .oclAsType(OclAny))" -by(rule cpI1, simp_all add: OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person) -lemma cp_OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_OclAny: "cp P \<Longrightarrow> cp(\<lambda>X. (P (X::Person)::OclAny) .oclAsType(Person))" -by(rule cpI1, simp_all add: OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny) -lemma cp_OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_Person: "cp P \<Longrightarrow> cp(\<lambda>X. (P (X::OclAny)::Person) .oclAsType(Person))" -by(rule cpI1, simp_all add: OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person) - -lemmas [simp] = - cp_OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_Person - cp_OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_OclAny - cp_OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_Person - cp_OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_OclAny - - cp_OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_OclAny - cp_OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_Person - cp_OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_OclAny - cp_OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_Person - -text_raw{* \endisatagafp*} - -subsection{* Execution with Invalid or Null as Argument *} - -lemma OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_strict : "(invalid::OclAny) .oclAsType(OclAny) = invalid" by(simp) -lemma OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_nullstrict : "(null::OclAny) .oclAsType(OclAny) = null" by(simp) -lemma OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_strict[simp] : "(invalid::Person) .oclAsType(OclAny) = invalid" - by(rule ext, simp add: bot_option_def invalid_def OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person) -lemma OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_nullstrict[simp] : "(null::Person) .oclAsType(OclAny) = null" - by(rule ext, simp add: null_fun_def null_option_def bot_option_def OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person) -lemma OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_strict[simp] : "(invalid::OclAny) .oclAsType(Person) = invalid" - by(rule ext, simp add: bot_option_def invalid_def OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny) -lemma OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_nullstrict[simp] : "(null::OclAny) .oclAsType(Person) = null" - by(rule ext, simp add: null_fun_def null_option_def bot_option_def OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny) -lemma OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_strict : "(invalid::Person) .oclAsType(Person) = invalid" by(simp) -lemma OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_nullstrict : "(null::Person) .oclAsType(Person) = null" by(simp) - -section{* OclIsTypeOf *} - -subsection{* Definition *} - -consts OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y :: "'\<alpha> \<Rightarrow> Boolean" ("(_).oclIsTypeOf'(OclAny')") -consts OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n :: "'\<alpha> \<Rightarrow> Boolean" ("(_).oclIsTypeOf'(Person')") - -overloading OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y \<equiv> "OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y :: OclAny \<Rightarrow> Boolean" -begin - definition OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny: - "(X::OclAny) .oclIsTypeOf(OclAny) \<equiv> - (\<lambda>\<tau>. case X \<tau> of - \<bottom> \<Rightarrow> invalid \<tau> - | \<lfloor>\<bottom>\<rfloor> \<Rightarrow> true \<tau> \<comment> \<open>invalid ??\<close> - | \<lfloor>\<lfloor>mk\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y oid \<bottom> \<rfloor>\<rfloor> \<Rightarrow> true \<tau> - | \<lfloor>\<lfloor>mk\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y oid \<lfloor>_\<rfloor> \<rfloor>\<rfloor> \<Rightarrow> false \<tau>)" -end - -lemma OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny': - "(X::OclAny) .oclIsTypeOf(OclAny) = - (\<lambda> \<tau>. if \<tau> \<Turnstile> \<upsilon> X then (case X \<tau> of - \<lfloor>\<bottom>\<rfloor> \<Rightarrow> true \<tau> \<comment> \<open>invalid ??\<close> - | \<lfloor>\<lfloor>mk\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y oid \<bottom> \<rfloor>\<rfloor> \<Rightarrow> true \<tau> - | \<lfloor>\<lfloor>mk\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y oid \<lfloor>_\<rfloor> \<rfloor>\<rfloor> \<Rightarrow> false \<tau>) - else invalid \<tau>)" - apply(rule ext, simp add: OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny) - by(case_tac "\<tau> \<Turnstile> \<upsilon> X", auto simp: foundation18' bot_option_def) - -interpretation OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny : - profile_mono_schemeV - "OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y::OclAny \<Rightarrow> Boolean" - "\<lambda> X. (case X of - \<lfloor>None\<rfloor> \<Rightarrow> \<lfloor>\<lfloor>True\<rfloor>\<rfloor> \<comment> \<open>invalid ??\<close> - | \<lfloor>\<lfloor>mk\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y oid None \<rfloor>\<rfloor> \<Rightarrow> \<lfloor>\<lfloor>True\<rfloor>\<rfloor> - | \<lfloor>\<lfloor>mk\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y oid \<lfloor>_\<rfloor> \<rfloor>\<rfloor> \<Rightarrow> \<lfloor>\<lfloor>False\<rfloor>\<rfloor>)" - apply(unfold_locales, simp add: atomize_eq, rule ext) - by(auto simp: OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny' OclValid_def true_def false_def - split: option.split type\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y.split) - -overloading OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y \<equiv> "OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y :: Person \<Rightarrow> Boolean" -begin - definition OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person: - "(X::Person) .oclIsTypeOf(OclAny) \<equiv> - (\<lambda>\<tau>. case X \<tau> of - \<bottom> \<Rightarrow> invalid \<tau> - | \<lfloor>\<bottom>\<rfloor> \<Rightarrow> true \<tau> \<comment> \<open>invalid ??\<close> - | \<lfloor>\<lfloor> _ \<rfloor>\<rfloor> \<Rightarrow> false \<tau> \<comment> \<open>must have actual type \<open>Person\<close> otherwise\<close>)" -end - -overloading OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n \<equiv> "OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n :: OclAny \<Rightarrow> Boolean" -begin - definition OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny: - "(X::OclAny) .oclIsTypeOf(Person) \<equiv> - (\<lambda>\<tau>. case X \<tau> of - \<bottom> \<Rightarrow> invalid \<tau> - | \<lfloor>\<bottom>\<rfloor> \<Rightarrow> true \<tau> - | \<lfloor>\<lfloor>mk\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y oid \<bottom> \<rfloor>\<rfloor> \<Rightarrow> false \<tau> - | \<lfloor>\<lfloor>mk\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y oid \<lfloor>_\<rfloor> \<rfloor>\<rfloor> \<Rightarrow> true \<tau>)" -end - -overloading OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n \<equiv> "OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n :: Person \<Rightarrow> Boolean" -begin - definition OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person: - "(X::Person) .oclIsTypeOf(Person) \<equiv> - (\<lambda>\<tau>. case X \<tau> of - \<bottom> \<Rightarrow> invalid \<tau> - | _ \<Rightarrow> true \<tau>)" (* for (* \<lfloor>\<lfloor> _ \<rfloor>\<rfloor> \<Rightarrow> true \<tau> *) : must have actual type Node otherwise *) -end -text_raw{* \isatagafp *} -subsection{* Context Passing *} - -lemma cp_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_Person: "cp P \<Longrightarrow> cp(\<lambda>X.(P(X::Person)::Person).oclIsTypeOf(OclAny))" -by(rule cpI1, simp_all add: OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person) -lemma cp_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_OclAny: "cp P \<Longrightarrow> cp(\<lambda>X.(P(X::OclAny)::OclAny).oclIsTypeOf(OclAny))" -by(rule cpI1, simp_all add: OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny) -lemma cp_OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_Person: "cp P \<Longrightarrow> cp(\<lambda>X.(P(X::Person)::Person).oclIsTypeOf(Person))" -by(rule cpI1, simp_all add: OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person) -lemma cp_OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_OclAny: "cp P \<Longrightarrow> cp(\<lambda>X.(P(X::OclAny)::OclAny).oclIsTypeOf(Person))" -by(rule cpI1, simp_all add: OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny) - - -lemma cp_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_OclAny: "cp P \<Longrightarrow> cp(\<lambda>X.(P(X::Person)::OclAny).oclIsTypeOf(OclAny))" -by(rule cpI1, simp_all add: OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny) -lemma cp_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_Person: "cp P \<Longrightarrow> cp(\<lambda>X.(P(X::OclAny)::Person).oclIsTypeOf(OclAny))" -by(rule cpI1, simp_all add: OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person) -lemma cp_OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_OclAny: "cp P \<Longrightarrow> cp(\<lambda>X.(P(X::Person)::OclAny).oclIsTypeOf(Person))" -by(rule cpI1, simp_all add: OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny) -lemma cp_OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_Person: "cp P \<Longrightarrow> cp(\<lambda>X.(P(X::OclAny)::Person).oclIsTypeOf(Person))" -by(rule cpI1, simp_all add: OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person) - -lemmas [simp] = - cp_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_Person - cp_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_OclAny - cp_OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_Person - cp_OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_OclAny - - cp_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_OclAny - cp_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_Person - cp_OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_OclAny - cp_OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_Person -text_raw{* \endisatagafp *} - -subsection{* Execution with Invalid or Null as Argument *} - -lemma OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_strict1[simp]: - "(invalid::OclAny) .oclIsTypeOf(OclAny) = invalid" -by(rule ext, simp add: null_fun_def null_option_def bot_option_def null_def invalid_def - OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny) -lemma OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_strict2[simp]: - "(null::OclAny) .oclIsTypeOf(OclAny) = true" -by(rule ext, simp add: null_fun_def null_option_def bot_option_def null_def invalid_def - OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny) -lemma OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_strict1[simp]: - "(invalid::Person) .oclIsTypeOf(OclAny) = invalid" -by(rule ext, simp add: null_fun_def null_option_def bot_option_def null_def invalid_def - OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person) -lemma OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_strict2[simp]: - "(null::Person) .oclIsTypeOf(OclAny) = true" -by(rule ext, simp add: null_fun_def null_option_def bot_option_def null_def invalid_def - OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person) -lemma OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_strict1[simp]: - "(invalid::OclAny) .oclIsTypeOf(Person) = invalid" -by(rule ext, simp add: null_fun_def null_option_def bot_option_def null_def invalid_def - OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny) -lemma OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_strict2[simp]: - "(null::OclAny) .oclIsTypeOf(Person) = true" -by(rule ext, simp add: null_fun_def null_option_def bot_option_def null_def invalid_def - OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny) -lemma OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_strict1[simp]: - "(invalid::Person) .oclIsTypeOf(Person) = invalid" -by(rule ext, simp add: null_fun_def null_option_def bot_option_def null_def invalid_def - OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person) -lemma OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_strict2[simp]: - "(null::Person) .oclIsTypeOf(Person) = true" -by(rule ext, simp add: null_fun_def null_option_def bot_option_def null_def invalid_def - OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person) - -subsection{* Up Down Casting *} - -lemma actualType_larger_staticType: -assumes isdef: "\<tau> \<Turnstile> (\<delta> X)" -shows "\<tau> \<Turnstile> (X::Person) .oclIsTypeOf(OclAny) \<triangleq> false" -using isdef -by(auto simp : null_option_def bot_option_def - OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person foundation22 foundation16) - -lemma down_cast_type: -assumes isOclAny: "\<tau> \<Turnstile> (X::OclAny) .oclIsTypeOf(OclAny)" -and non_null: "\<tau> \<Turnstile> (\<delta> X)" -shows "\<tau> \<Turnstile> (X .oclAsType(Person)) \<triangleq> invalid" -using isOclAny non_null -apply(auto simp : bot_fun_def null_fun_def null_option_def bot_option_def null_def invalid_def - OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny foundation22 foundation16 - split: option.split type\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y.split type\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n.split) -by(simp add: OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny OclValid_def false_def true_def) - -lemma down_cast_type': -assumes isOclAny: "\<tau> \<Turnstile> (X::OclAny) .oclIsTypeOf(OclAny)" -and non_null: "\<tau> \<Turnstile> (\<delta> X)" -shows "\<tau> \<Turnstile> not (\<upsilon> (X .oclAsType(Person)))" -by(rule foundation15[THEN iffD1], simp add: down_cast_type[OF assms]) - -lemma up_down_cast : -assumes isdef: "\<tau> \<Turnstile> (\<delta> X)" -shows "\<tau> \<Turnstile> ((X::Person) .oclAsType(OclAny) .oclAsType(Person) \<triangleq> X)" -using isdef -by(auto simp : null_fun_def null_option_def bot_option_def null_def invalid_def - OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny foundation22 foundation16 - split: option.split type\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n.split) - - -lemma up_down_cast_Person_OclAny_Person [simp]: -shows "((X::Person) .oclAsType(OclAny) .oclAsType(Person) = X)" - apply(rule ext, rename_tac \<tau>) - apply(rule foundation22[THEN iffD1]) - apply(case_tac "\<tau> \<Turnstile> (\<delta> X)", simp add: up_down_cast) - apply(simp add: defined_split, elim disjE) - apply(erule StrongEq_L_subst2_rev, simp, simp)+ -done - -lemma up_down_cast_Person_OclAny_Person': -assumes "\<tau> \<Turnstile> \<upsilon> X" -shows "\<tau> \<Turnstile> (((X :: Person) .oclAsType(OclAny) .oclAsType(Person)) \<doteq> X)" - apply(simp only: up_down_cast_Person_OclAny_Person StrictRefEq\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n) -by(rule StrictRefEq\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_sym, simp add: assms) - -lemma up_down_cast_Person_OclAny_Person'': -assumes "\<tau> \<Turnstile> \<upsilon> (X :: Person)" -shows "\<tau> \<Turnstile> (X .oclIsTypeOf(Person) implies (X .oclAsType(OclAny) .oclAsType(Person)) \<doteq> X)" - apply(simp add: OclValid_def) - apply(subst cp_OclImplies) - apply(simp add: StrictRefEq\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n StrictRefEq\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_sym[OF assms, simplified OclValid_def]) - apply(subst cp_OclImplies[symmetric]) -by simp - - -section{* OclIsKindOf *} -subsection{* Definition *} - -consts OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y :: "'\<alpha> \<Rightarrow> Boolean" ("(_).oclIsKindOf'(OclAny')") -consts OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n :: "'\<alpha> \<Rightarrow> Boolean" ("(_).oclIsKindOf'(Person')") - -overloading OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y \<equiv> "OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y :: OclAny \<Rightarrow> Boolean" -begin - definition OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny: - "(X::OclAny) .oclIsKindOf(OclAny) \<equiv> - (\<lambda>\<tau>. case X \<tau> of - \<bottom> \<Rightarrow> invalid \<tau> - | _ \<Rightarrow> true \<tau>)" -end - -overloading OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y \<equiv> "OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y :: Person \<Rightarrow> Boolean" -begin - definition OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person: - "(X::Person) .oclIsKindOf(OclAny) \<equiv> - (\<lambda>\<tau>. case X \<tau> of - \<bottom> \<Rightarrow> invalid \<tau> - | _\<Rightarrow> true \<tau>)" -(* for (* \<lfloor>\<lfloor>mk\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n e oid _ \<rfloor>\<rfloor> \<Rightarrow> true \<tau> *) : must have actual type Person otherwise *) -end - -overloading OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n \<equiv> "OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n :: OclAny \<Rightarrow> Boolean" -begin - definition OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny: - "(X::OclAny) .oclIsKindOf(Person) \<equiv> - (\<lambda>\<tau>. case X \<tau> of - \<bottom> \<Rightarrow> invalid \<tau> - | \<lfloor>\<bottom>\<rfloor> \<Rightarrow> true \<tau> - | \<lfloor>\<lfloor>mk\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y oid \<bottom> \<rfloor>\<rfloor> \<Rightarrow> false \<tau> - | \<lfloor>\<lfloor>mk\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y oid \<lfloor>_\<rfloor> \<rfloor>\<rfloor> \<Rightarrow> true \<tau>)" -end - -overloading OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n \<equiv> "OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n :: Person \<Rightarrow> Boolean" -begin - definition OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person: - "(X::Person) .oclIsKindOf(Person) \<equiv> - (\<lambda>\<tau>. case X \<tau> of - \<bottom> \<Rightarrow> invalid \<tau> - | _ \<Rightarrow> true \<tau>)" -end -text_raw{* \isatagafp *} -subsection{* Context Passing *} - -lemma cp_OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_Person: "cp P \<Longrightarrow> cp(\<lambda>X.(P(X::Person)::Person).oclIsKindOf(OclAny))" -by(rule cpI1, simp_all add: OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person) -lemma cp_OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_OclAny: "cp P \<Longrightarrow> cp(\<lambda>X.(P(X::OclAny)::OclAny).oclIsKindOf(OclAny))" -by(rule cpI1, simp_all add: OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny) -lemma cp_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_Person: "cp P \<Longrightarrow> cp(\<lambda>X.(P(X::Person)::Person).oclIsKindOf(Person))" -by(rule cpI1, simp_all add: OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person) -lemma cp_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_OclAny: "cp P \<Longrightarrow> cp(\<lambda>X.(P(X::OclAny)::OclAny).oclIsKindOf(Person))" -by(rule cpI1, simp_all add: OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny) - -lemma cp_OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_OclAny: "cp P \<Longrightarrow> cp(\<lambda>X.(P(X::Person)::OclAny).oclIsKindOf(OclAny))" -by(rule cpI1, simp_all add: OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny) -lemma cp_OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_Person: "cp P \<Longrightarrow> cp(\<lambda>X.(P(X::OclAny)::Person).oclIsKindOf(OclAny))" -by(rule cpI1, simp_all add: OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person) -lemma cp_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_OclAny: "cp P \<Longrightarrow> cp(\<lambda>X.(P(X::Person)::OclAny).oclIsKindOf(Person))" -by(rule cpI1, simp_all add: OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny) -lemma cp_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_Person: "cp P \<Longrightarrow> cp(\<lambda>X.(P(X::OclAny)::Person).oclIsKindOf(Person))" -by(rule cpI1, simp_all add: OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person) - -lemmas [simp] = - cp_OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_Person - cp_OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_OclAny - cp_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_Person - cp_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_OclAny - - cp_OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_OclAny - cp_OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_Person - cp_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_OclAny - cp_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_Person -text_raw{* \endisatagafp *} -subsection{* Execution with Invalid or Null as Argument *} - -lemma OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_strict1[simp] : "(invalid::OclAny) .oclIsKindOf(OclAny) = invalid" -by(rule ext, simp add: invalid_def bot_option_def - OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny) -lemma OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_strict2[simp] : "(null::OclAny) .oclIsKindOf(OclAny) = true" -by(rule ext, simp add: null_fun_def null_option_def - OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny) -lemma OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_strict1[simp] : "(invalid::Person) .oclIsKindOf(OclAny) = invalid" -by(rule ext, simp add: bot_option_def invalid_def - OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person) -lemma OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_strict2[simp] : "(null::Person) .oclIsKindOf(OclAny) = true" -by(rule ext, simp add: null_fun_def null_option_def bot_option_def - OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person) -lemma OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_strict1[simp]: "(invalid::OclAny) .oclIsKindOf(Person) = invalid" -by(rule ext, simp add: null_fun_def null_option_def bot_option_def null_def invalid_def - OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny) -lemma OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_strict2[simp]: "(null::OclAny) .oclIsKindOf(Person) = true" -by(rule ext, simp add: null_fun_def null_option_def bot_option_def null_def invalid_def - OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny) -lemma OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_strict1[simp]: "(invalid::Person) .oclIsKindOf(Person) = invalid" -by(rule ext, simp add: null_fun_def null_option_def bot_option_def null_def invalid_def - OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person) -lemma OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_strict2[simp]: "(null::Person) .oclIsKindOf(Person) = true" -by(rule ext, simp add: null_fun_def null_option_def bot_option_def null_def invalid_def - OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person) - -subsection{* Up Down Casting *} - -lemma actualKind_larger_staticKind: -assumes isdef: "\<tau> \<Turnstile> (\<delta> X)" -shows "\<tau> \<Turnstile> ((X::Person) .oclIsKindOf(OclAny) \<triangleq> true)" -using isdef -by(auto simp : bot_option_def - OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person foundation22 foundation16) - -lemma down_cast_kind: -assumes isOclAny: "\<not> (\<tau> \<Turnstile> ((X::OclAny).oclIsKindOf(Person)))" -and non_null: "\<tau> \<Turnstile> (\<delta> X)" -shows "\<tau> \<Turnstile> ((X .oclAsType(Person)) \<triangleq> invalid)" -using isOclAny non_null -apply(auto simp : bot_fun_def null_fun_def null_option_def bot_option_def null_def invalid_def - OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny foundation22 foundation16 - split: option.split type\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y.split type\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n.split) -by(simp add: OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny OclValid_def false_def true_def) - -section{* OclAllInstances *} - -text{* To denote OCL-types occurring in OCL expressions syntactically---as, for example, as -``argument'' of \inlineisar{oclAllInstances()}---we use the inverses of the injection -functions into the object universes; we show that this is sufficient ``characterization.'' *} - -definition "Person \<equiv> OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_\<AA>" -definition "OclAny \<equiv> OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_\<AA>" -lemmas [simp] = Person_def OclAny_def - -lemma OclAllInstances_generic\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_exec: "OclAllInstances_generic pre_post OclAny = - (\<lambda>\<tau>. Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e \<lfloor>\<lfloor> Some ` OclAny ` ran (heap (pre_post \<tau>)) \<rfloor>\<rfloor>)" -proof - - let ?S1 = "\<lambda>\<tau>. OclAny ` ran (heap (pre_post \<tau>))" - let ?S2 = "\<lambda>\<tau>. ?S1 \<tau> - {None}" - have B : "\<And>\<tau>. ?S2 \<tau> \<subseteq> ?S1 \<tau>" by auto - have C : "\<And>\<tau>. ?S1 \<tau> \<subseteq> ?S2 \<tau>" by(auto simp: OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_\<AA>_some) - - show ?thesis by(insert equalityI[OF B C], simp) -qed - -lemma OclAllInstances_at_post\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_exec: "OclAny .allInstances() = - (\<lambda>\<tau>. Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e \<lfloor>\<lfloor> Some ` OclAny ` ran (heap (snd \<tau>)) \<rfloor>\<rfloor>)" -unfolding OclAllInstances_at_post_def -by(rule OclAllInstances_generic\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_exec) - -lemma OclAllInstances_at_pre\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_exec: "OclAny .allInstances@pre() = - (\<lambda>\<tau>. Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e \<lfloor>\<lfloor> Some ` OclAny ` ran (heap (fst \<tau>)) \<rfloor>\<rfloor>) " -unfolding OclAllInstances_at_pre_def -by(rule OclAllInstances_generic\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_exec) - -subsection{* OclIsTypeOf *} - -lemma OclAny_allInstances_generic_oclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y1: -assumes [simp]: "\<And>x. pre_post (x, x) = x" -shows "\<exists>\<tau>. (\<tau> \<Turnstile> ((OclAllInstances_generic pre_post OclAny)->forAll\<^sub>S\<^sub>e\<^sub>t(X|X .oclIsTypeOf(OclAny))))" - apply(rule_tac x = \<tau>\<^sub>0 in exI, simp add: \<tau>\<^sub>0_def OclValid_def del: OclAllInstances_generic_def) - apply(simp only: assms UML_Set.OclForall_def refl if_True - OclAllInstances_generic_defined[simplified OclValid_def]) - apply(simp only: OclAllInstances_generic_def) - apply(subst (1 2 3) Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inverse, simp add: bot_option_def) -by(simp add: OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny) - -lemma OclAny_allInstances_at_post_oclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y1: -"\<exists>\<tau>. (\<tau> \<Turnstile> (OclAny .allInstances()->forAll\<^sub>S\<^sub>e\<^sub>t(X|X .oclIsTypeOf(OclAny))))" -unfolding OclAllInstances_at_post_def -by(rule OclAny_allInstances_generic_oclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y1, simp) - -lemma OclAny_allInstances_at_pre_oclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y1: -"\<exists>\<tau>. (\<tau> \<Turnstile> (OclAny .allInstances@pre()->forAll\<^sub>S\<^sub>e\<^sub>t(X|X .oclIsTypeOf(OclAny))))" -unfolding OclAllInstances_at_pre_def -by(rule OclAny_allInstances_generic_oclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y1, simp) - -lemma OclAny_allInstances_generic_oclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y2: -assumes [simp]: "\<And>x. pre_post (x, x) = x" -shows "\<exists>\<tau>. (\<tau> \<Turnstile> not ((OclAllInstances_generic pre_post OclAny)->forAll\<^sub>S\<^sub>e\<^sub>t(X|X .oclIsTypeOf(OclAny))))" -proof - fix oid a let ?t0 = "\<lparr>heap = Map.empty(oid \<mapsto> in\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y (mk\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y oid \<lfloor>a\<rfloor>)), - assocs = Map.empty\<rparr>" show ?thesis - apply(rule_tac x = "(?t0, ?t0)" in exI, simp add: OclValid_def del: OclAllInstances_generic_def) - apply(simp only: UML_Set.OclForall_def refl if_True - OclAllInstances_generic_defined[simplified OclValid_def]) - apply(simp only: OclAllInstances_generic_def OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_\<AA>_def) - apply(subst (1 2 3) Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inverse, simp add: bot_option_def) - by(simp add: OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny OclNot_def OclAny_def) -qed - -lemma OclAny_allInstances_at_post_oclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y2: -"\<exists>\<tau>. (\<tau> \<Turnstile> not (OclAny .allInstances()->forAll\<^sub>S\<^sub>e\<^sub>t(X|X .oclIsTypeOf(OclAny))))" -unfolding OclAllInstances_at_post_def -by(rule OclAny_allInstances_generic_oclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y2, simp) - -lemma OclAny_allInstances_at_pre_oclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y2: -"\<exists>\<tau>. (\<tau> \<Turnstile> not (OclAny .allInstances@pre()->forAll\<^sub>S\<^sub>e\<^sub>t(X|X .oclIsTypeOf(OclAny))))" -unfolding OclAllInstances_at_pre_def -by(rule OclAny_allInstances_generic_oclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y2, simp) - -lemma Person_allInstances_generic_oclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n: -"\<tau> \<Turnstile> ((OclAllInstances_generic pre_post Person)->forAll\<^sub>S\<^sub>e\<^sub>t(X|X .oclIsTypeOf(Person)))" - apply(simp add: OclValid_def del: OclAllInstances_generic_def) - apply(simp only: UML_Set.OclForall_def refl if_True - OclAllInstances_generic_defined[simplified OclValid_def]) - apply(simp only: OclAllInstances_generic_def) - apply(subst (1 2 3) Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inverse, simp add: bot_option_def) -by(simp add: OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person) - -lemma Person_allInstances_at_post_oclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n: -"\<tau> \<Turnstile> (Person .allInstances()->forAll\<^sub>S\<^sub>e\<^sub>t(X|X .oclIsTypeOf(Person)))" -unfolding OclAllInstances_at_post_def -by(rule Person_allInstances_generic_oclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n) - -lemma Person_allInstances_at_pre_oclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n: -"\<tau> \<Turnstile> (Person .allInstances@pre()->forAll\<^sub>S\<^sub>e\<^sub>t(X|X .oclIsTypeOf(Person)))" -unfolding OclAllInstances_at_pre_def -by(rule Person_allInstances_generic_oclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n) - -subsection{* OclIsKindOf *} -lemma OclAny_allInstances_generic_oclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y: -"\<tau> \<Turnstile> ((OclAllInstances_generic pre_post OclAny)->forAll\<^sub>S\<^sub>e\<^sub>t(X|X .oclIsKindOf(OclAny)))" - apply(simp add: OclValid_def del: OclAllInstances_generic_def) - apply(simp only: UML_Set.OclForall_def refl if_True - OclAllInstances_generic_defined[simplified OclValid_def]) - apply(simp only: OclAllInstances_generic_def) - apply(subst (1 2 3) Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inverse, simp add: bot_option_def) -by(simp add: OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny) - -lemma OclAny_allInstances_at_post_oclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y: -"\<tau> \<Turnstile> (OclAny .allInstances()->forAll\<^sub>S\<^sub>e\<^sub>t(X|X .oclIsKindOf(OclAny)))" -unfolding OclAllInstances_at_post_def -by(rule OclAny_allInstances_generic_oclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y) - -lemma OclAny_allInstances_at_pre_oclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y: -"\<tau> \<Turnstile> (OclAny .allInstances@pre()->forAll\<^sub>S\<^sub>e\<^sub>t(X|X .oclIsKindOf(OclAny)))" -unfolding OclAllInstances_at_pre_def -by(rule OclAny_allInstances_generic_oclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y) - -lemma Person_allInstances_generic_oclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y: -"\<tau> \<Turnstile> ((OclAllInstances_generic pre_post Person)->forAll\<^sub>S\<^sub>e\<^sub>t(X|X .oclIsKindOf(OclAny)))" - apply(simp add: OclValid_def del: OclAllInstances_generic_def) - apply(simp only: UML_Set.OclForall_def refl if_True - OclAllInstances_generic_defined[simplified OclValid_def]) - apply(simp only: OclAllInstances_generic_def) - apply(subst (1 2 3) Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inverse, simp add: bot_option_def) -by(simp add: OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person) - -lemma Person_allInstances_at_post_oclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y: -"\<tau> \<Turnstile> (Person .allInstances()->forAll\<^sub>S\<^sub>e\<^sub>t(X|X .oclIsKindOf(OclAny)))" -unfolding OclAllInstances_at_post_def -by(rule Person_allInstances_generic_oclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y) - -lemma Person_allInstances_at_pre_oclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y: -"\<tau> \<Turnstile> (Person .allInstances@pre()->forAll\<^sub>S\<^sub>e\<^sub>t(X|X .oclIsKindOf(OclAny)))" -unfolding OclAllInstances_at_pre_def -by(rule Person_allInstances_generic_oclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y) - -lemma Person_allInstances_generic_oclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n: -"\<tau> \<Turnstile> ((OclAllInstances_generic pre_post Person)->forAll\<^sub>S\<^sub>e\<^sub>t(X|X .oclIsKindOf(Person)))" - apply(simp add: OclValid_def del: OclAllInstances_generic_def) - apply(simp only: UML_Set.OclForall_def refl if_True - OclAllInstances_generic_defined[simplified OclValid_def]) - apply(simp only: OclAllInstances_generic_def) - apply(subst (1 2 3) Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inverse, simp add: bot_option_def) -by(simp add: OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person) - -lemma Person_allInstances_at_post_oclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n: -"\<tau> \<Turnstile> (Person .allInstances()->forAll\<^sub>S\<^sub>e\<^sub>t(X|X .oclIsKindOf(Person)))" -unfolding OclAllInstances_at_post_def -by(rule Person_allInstances_generic_oclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n) - -lemma Person_allInstances_at_pre_oclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n: -"\<tau> \<Turnstile> (Person .allInstances@pre()->forAll\<^sub>S\<^sub>e\<^sub>t(X|X .oclIsKindOf(Person)))" -unfolding OclAllInstances_at_pre_def -by(rule Person_allInstances_generic_oclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n) - -section{* The Accessors (any, boss, salary) *} -text{*\label{sec:edm-accessors}*} -text{* Should be generated entirely from a class-diagram. *} - - -subsection{* Definition *} - -definition eval_extract :: "('\<AA>,('a::object) option option) val - \<Rightarrow> (oid \<Rightarrow> ('\<AA>,'c::null) val) - \<Rightarrow> ('\<AA>,'c::null) val" -where "eval_extract X f = (\<lambda> \<tau>. case X \<tau> of - \<bottom> \<Rightarrow> invalid \<tau> \<comment> \<open>exception propagation\<close> - | \<lfloor> \<bottom> \<rfloor> \<Rightarrow> invalid \<tau> \<comment> \<open>dereferencing null pointer\<close> - | \<lfloor>\<lfloor> obj \<rfloor>\<rfloor> \<Rightarrow> f (oid_of obj) \<tau>)" -(* TODO: rephrasing as if-then-else and shifting to OCL_state. *) - - -definition deref_oid\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n :: "(\<AA> state \<times> \<AA> state \<Rightarrow> \<AA> state) - \<Rightarrow> (type\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n \<Rightarrow> (\<AA>, 'c::null)val) - \<Rightarrow> oid - \<Rightarrow> (\<AA>, 'c::null)val" -where "deref_oid\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n fst_snd f oid = (\<lambda>\<tau>. case (heap (fst_snd \<tau>)) oid of - \<lfloor> in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n obj \<rfloor> \<Rightarrow> f obj \<tau> - | _ \<Rightarrow> invalid \<tau>)" - - - -definition deref_oid\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y :: "(\<AA> state \<times> \<AA> state \<Rightarrow> \<AA> state) - \<Rightarrow> (type\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y \<Rightarrow> (\<AA>, 'c::null)val) - \<Rightarrow> oid - \<Rightarrow> (\<AA>, 'c::null)val" -where "deref_oid\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y fst_snd f oid = (\<lambda>\<tau>. case (heap (fst_snd \<tau>)) oid of - \<lfloor> in\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y obj \<rfloor> \<Rightarrow> f obj \<tau> - | _ \<Rightarrow> invalid \<tau>)" - -text{* pointer undefined in state or not referencing a type conform object representation *} - - -definition "select\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y\<A>\<N>\<Y> f = (\<lambda> X. case X of - (mk\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y _ \<bottom>) \<Rightarrow> null - | (mk\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y _ \<lfloor>any\<rfloor>) \<Rightarrow> f (\<lambda>x _. \<lfloor>\<lfloor>x\<rfloor>\<rfloor>) any)" - - -definition "select\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<B>\<O>\<S>\<S> f = (\<lambda> X. case X of - (mk\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n _ _ \<bottom>) \<Rightarrow> null \<comment> \<open>object contains null pointer\<close> - | (mk\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n _ _ \<lfloor>boss\<rfloor>) \<Rightarrow> f (\<lambda>x _. \<lfloor>\<lfloor>x\<rfloor>\<rfloor>) boss)" - - -definition "select\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<S>\<A>\<L>\<A>\<R>\<Y> f = (\<lambda> X. case X of - (mk\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n _ \<bottom> _) \<Rightarrow> null - | (mk\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n _ \<lfloor>salary\<rfloor> _) \<Rightarrow> f (\<lambda>x _. \<lfloor>\<lfloor>x\<rfloor>\<rfloor>) salary)" - - -definition "in_pre_state = fst" -definition "in_post_state = snd" - -definition "reconst_basetype = (\<lambda> convert x. convert x)" - -definition dot\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y\<A>\<N>\<Y> :: "OclAny \<Rightarrow> _" ("(1(_).any)" 50) - where "(X).any = eval_extract X - (deref_oid\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y in_post_state - (select\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y\<A>\<N>\<Y> - reconst_basetype))" - -definition dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<B>\<O>\<S>\<S> :: "Person \<Rightarrow> Person" ("(1(_).boss)" 50) - where "(X).boss = eval_extract X - (deref_oid\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n in_post_state - (select\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<B>\<O>\<S>\<S> - (deref_oid\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n in_post_state)))" - -definition dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<S>\<A>\<L>\<A>\<R>\<Y> :: "Person \<Rightarrow> Integer" ("(1(_).salary)" 50) - where "(X).salary = eval_extract X - (deref_oid\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n in_post_state - (select\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<S>\<A>\<L>\<A>\<R>\<Y> - reconst_basetype))" - -definition dot\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y\<A>\<N>\<Y>_at_pre :: "OclAny \<Rightarrow> _" ("(1(_).any@pre)" 50) - where "(X).any@pre = eval_extract X - (deref_oid\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y in_pre_state - (select\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y\<A>\<N>\<Y> - reconst_basetype))" - -definition dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<B>\<O>\<S>\<S>_at_pre:: "Person \<Rightarrow> Person" ("(1(_).boss@pre)" 50) - where "(X).boss@pre = eval_extract X - (deref_oid\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n in_pre_state - (select\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<B>\<O>\<S>\<S> - (deref_oid\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n in_pre_state)))" - -definition dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<S>\<A>\<L>\<A>\<R>\<Y>_at_pre:: "Person \<Rightarrow> Integer" ("(1(_).salary@pre)" 50) - where "(X).salary@pre = eval_extract X - (deref_oid\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n in_pre_state - (select\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<S>\<A>\<L>\<A>\<R>\<Y> - reconst_basetype))" - -lemmas dot_accessor = - dot\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y\<A>\<N>\<Y>_def - dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<B>\<O>\<S>\<S>_def - dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<S>\<A>\<L>\<A>\<R>\<Y>_def - dot\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y\<A>\<N>\<Y>_at_pre_def - dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<B>\<O>\<S>\<S>_at_pre_def - dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<S>\<A>\<L>\<A>\<R>\<Y>_at_pre_def - -subsection{* Context Passing *} - -lemmas [simp] = eval_extract_def - -lemma cp_dot\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y\<A>\<N>\<Y>: "((X).any) \<tau> = ((\<lambda>_. X \<tau>).any) \<tau>" by (simp add: dot_accessor) -lemma cp_dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<B>\<O>\<S>\<S>: "((X).boss) \<tau> = ((\<lambda>_. X \<tau>).boss) \<tau>" by (simp add: dot_accessor) -lemma cp_dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<S>\<A>\<L>\<A>\<R>\<Y>: "((X).salary) \<tau> = ((\<lambda>_. X \<tau>).salary) \<tau>" by (simp add: dot_accessor) - -lemma cp_dot\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y\<A>\<N>\<Y>_at_pre: "((X).any@pre) \<tau> = ((\<lambda>_. X \<tau>).any@pre) \<tau>" by (simp add: dot_accessor) -lemma cp_dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<B>\<O>\<S>\<S>_at_pre: "((X).boss@pre) \<tau> = ((\<lambda>_. X \<tau>).boss@pre) \<tau>" by (simp add: dot_accessor) -lemma cp_dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<S>\<A>\<L>\<A>\<R>\<Y>_at_pre: "((X).salary@pre) \<tau> = ((\<lambda>_. X \<tau>).salary@pre) \<tau>" by (simp add: dot_accessor) - -lemmas cp_dot\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y\<A>\<N>\<Y>_I [simp, intro!]= - cp_dot\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y\<A>\<N>\<Y>[THEN allI[THEN allI], - of "\<lambda> X _. X" "\<lambda> _ \<tau>. \<tau>", THEN cpI1] -lemmas cp_dot\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y\<A>\<N>\<Y>_at_pre_I [simp, intro!]= - cp_dot\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y\<A>\<N>\<Y>_at_pre[THEN allI[THEN allI], - of "\<lambda> X _. X" "\<lambda> _ \<tau>. \<tau>", THEN cpI1] - -lemmas cp_dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<B>\<O>\<S>\<S>_I [simp, intro!]= - cp_dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<B>\<O>\<S>\<S>[THEN allI[THEN allI], - of "\<lambda> X _. X" "\<lambda> _ \<tau>. \<tau>", THEN cpI1] -lemmas cp_dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<B>\<O>\<S>\<S>_at_pre_I [simp, intro!]= - cp_dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<B>\<O>\<S>\<S>_at_pre[THEN allI[THEN allI], - of "\<lambda> X _. X" "\<lambda> _ \<tau>. \<tau>", THEN cpI1] - -lemmas cp_dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<S>\<A>\<L>\<A>\<R>\<Y>_I [simp, intro!]= - cp_dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<S>\<A>\<L>\<A>\<R>\<Y>[THEN allI[THEN allI], - of "\<lambda> X _. X" "\<lambda> _ \<tau>. \<tau>", THEN cpI1] -lemmas cp_dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<S>\<A>\<L>\<A>\<R>\<Y>_at_pre_I [simp, intro!]= - cp_dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<S>\<A>\<L>\<A>\<R>\<Y>_at_pre[THEN allI[THEN allI], - of "\<lambda> X _. X" "\<lambda> _ \<tau>. \<tau>", THEN cpI1] - -subsection{* Execution with Invalid or Null as Argument *} - -lemma dot\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y\<A>\<N>\<Y>_nullstrict [simp]: "(null).any = invalid" -by(rule ext, simp add: dot_accessor null_fun_def null_option_def bot_option_def null_def invalid_def) -lemma dot\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y\<A>\<N>\<Y>_at_pre_nullstrict [simp] : "(null).any@pre = invalid" -by(rule ext, simp add: dot_accessor null_fun_def null_option_def bot_option_def null_def invalid_def) -lemma dot\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y\<A>\<N>\<Y>_strict [simp] : "(invalid).any = invalid" -by(rule ext, simp add: dot_accessor null_fun_def null_option_def bot_option_def null_def invalid_def) -lemma dot\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y\<A>\<N>\<Y>_at_pre_strict [simp] : "(invalid).any@pre = invalid" -by(rule ext, simp add: dot_accessor null_fun_def null_option_def bot_option_def null_def invalid_def) - - -lemma dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<B>\<O>\<S>\<S>_nullstrict [simp]: "(null).boss = invalid" -by(rule ext, simp add: dot_accessor null_fun_def null_option_def bot_option_def null_def invalid_def) -lemma dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<B>\<O>\<S>\<S>_at_pre_nullstrict [simp] : "(null).boss@pre = invalid" -by(rule ext, simp add: dot_accessor null_fun_def null_option_def bot_option_def null_def invalid_def) -lemma dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<B>\<O>\<S>\<S>_strict [simp] : "(invalid).boss = invalid" -by(rule ext, simp add: dot_accessor null_fun_def null_option_def bot_option_def null_def invalid_def) -lemma dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<B>\<O>\<S>\<S>_at_pre_strict [simp] : "(invalid).boss@pre = invalid" -by(rule ext, simp add: dot_accessor null_fun_def null_option_def bot_option_def null_def invalid_def) - - -lemma dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<S>\<A>\<L>\<A>\<R>\<Y>_nullstrict [simp]: "(null).salary = invalid" -by(rule ext, simp add: dot_accessor null_fun_def null_option_def bot_option_def null_def invalid_def) -lemma dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<S>\<A>\<L>\<A>\<R>\<Y>_at_pre_nullstrict [simp] : "(null).salary@pre = invalid" -by(rule ext, simp add: dot_accessor null_fun_def null_option_def bot_option_def null_def invalid_def) -lemma dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<S>\<A>\<L>\<A>\<R>\<Y>_strict [simp] : "(invalid).salary = invalid" -by(rule ext, simp add: dot_accessor null_fun_def null_option_def bot_option_def null_def invalid_def) -lemma dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<S>\<A>\<L>\<A>\<R>\<Y>_at_pre_strict [simp] : "(invalid).salary@pre = invalid" -by(rule ext, simp add: dot_accessor null_fun_def null_option_def bot_option_def null_def invalid_def) - -subsection{* Representation in States *} - -lemma dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<B>\<O>\<S>\<S>_def_mono:"\<tau> \<Turnstile> \<delta>(X .boss) \<Longrightarrow> \<tau> \<Turnstile> \<delta>(X)" - apply(case_tac "\<tau> \<Turnstile> (X \<triangleq> invalid)", insert StrongEq_L_subst2[where P = "(\<lambda>x. (\<delta> (x .boss)))" and \<tau> = "\<tau>" and x = "X" and y = "invalid"], simp add: foundation16') - apply(case_tac "\<tau> \<Turnstile> (X \<triangleq> null)", insert StrongEq_L_subst2[where P = "(\<lambda>x. (\<delta> (x .boss)))" and \<tau> = "\<tau>" and x = "X" and y = "null"], simp add: foundation16') -by(simp add: defined_split) - -lemma repr_boss: -assumes A : "\<tau> \<Turnstile> \<delta>(x .boss)" -shows "is_represented_in_state in_post_state (x .boss) Person \<tau>" - apply(insert A[simplified foundation16] - A[THEN dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<B>\<O>\<S>\<S>_def_mono, simplified foundation16]) - unfolding is_represented_in_state_def - dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<B>\<O>\<S>\<S>_def eval_extract_def select\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<B>\<O>\<S>\<S>_def in_post_state_def - by(auto simp: deref_oid\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_def bot_fun_def bot_option_def null_option_def null_fun_def invalid_def - OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_\<AA>_def image_def ran_def - split: type\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n.split option.split \<AA>.split) - -lemma repr_bossX : -assumes A: "\<tau> \<Turnstile> \<delta>(x .boss)" -shows "\<tau> \<Turnstile> ((Person .allInstances()) ->includes\<^sub>S\<^sub>e\<^sub>t(x .boss))" -proof - - have B : "\<And>S f. (x .boss) \<tau> \<in> (Some ` f ` S) \<Longrightarrow> - (x .boss) \<tau> \<in> (Some ` (f ` S - {None}))" - apply(auto simp: image_def ran_def, metis) - by(insert A[simplified foundation16], simp add: null_option_def bot_option_def) - show ?thesis - apply(insert repr_boss[OF A] OclAllInstances_at_post_defined[where H = Person and \<tau> = \<tau>]) - unfolding is_represented_in_state_def OclValid_def - OclAllInstances_at_post_def OclAllInstances_generic_def OclIncludes_def - in_post_state_def - apply(simp add: A[THEN foundation20, simplified OclValid_def]) - apply(subst Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inverse, simp, metis bot_option_def option.distinct(1)) - by(simp add: image_comp B true_def) -qed - -section{* A Little Infra-structure on Example States *} - -text{* -The example we are defining in this section comes from the figure~\ref{fig:edm1_system-states}. -\begin{figure} -\includegraphics[width=\textwidth]{figures/pre-post.pdf} -\caption{(a) pre-state $\sigma_1$ and - (b) post-state $\sigma_1'$.} -\label{fig:edm1_system-states} -\end{figure} -*} - -text_raw{* \isatagafp*} - -definition OclInt1000 ("\<one>\<zero>\<zero>\<zero>") where "OclInt1000 = (\<lambda> _ . \<lfloor>\<lfloor>1000\<rfloor>\<rfloor>)" -definition OclInt1200 ("\<one>\<two>\<zero>\<zero>") where "OclInt1200 = (\<lambda> _ . \<lfloor>\<lfloor>1200\<rfloor>\<rfloor>)" -definition OclInt1300 ("\<one>\<three>\<zero>\<zero>") where "OclInt1300 = (\<lambda> _ . \<lfloor>\<lfloor>1300\<rfloor>\<rfloor>)" -definition OclInt1800 ("\<one>\<eight>\<zero>\<zero>") where "OclInt1800 = (\<lambda> _ . \<lfloor>\<lfloor>1800\<rfloor>\<rfloor>)" -definition OclInt2600 ("\<two>\<six>\<zero>\<zero>") where "OclInt2600 = (\<lambda> _ . \<lfloor>\<lfloor>2600\<rfloor>\<rfloor>)" -definition OclInt2900 ("\<two>\<nine>\<zero>\<zero>") where "OclInt2900 = (\<lambda> _ . \<lfloor>\<lfloor>2900\<rfloor>\<rfloor>)" -definition OclInt3200 ("\<three>\<two>\<zero>\<zero>") where "OclInt3200 = (\<lambda> _ . \<lfloor>\<lfloor>3200\<rfloor>\<rfloor>)" -definition OclInt3500 ("\<three>\<five>\<zero>\<zero>") where "OclInt3500 = (\<lambda> _ . \<lfloor>\<lfloor>3500\<rfloor>\<rfloor>)" - -definition "oid0 \<equiv> 0" -definition "oid1 \<equiv> 1" -definition "oid2 \<equiv> 2" -definition "oid3 \<equiv> 3" -definition "oid4 \<equiv> 4" -definition "oid5 \<equiv> 5" -definition "oid6 \<equiv> 6" -definition "oid7 \<equiv> 7" -definition "oid8 \<equiv> 8" - -definition "person1 \<equiv> mk\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n oid0 \<lfloor>1300\<rfloor> \<lfloor>oid1\<rfloor>" -definition "person2 \<equiv> mk\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n oid1 \<lfloor>1800\<rfloor> \<lfloor>oid1\<rfloor>" -definition "person3 \<equiv> mk\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n oid2 None None" -definition "person4 \<equiv> mk\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n oid3 \<lfloor>2900\<rfloor> None" -definition "person5 \<equiv> mk\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n oid4 \<lfloor>3500\<rfloor> None" -definition "person6 \<equiv> mk\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n oid5 \<lfloor>2500\<rfloor> \<lfloor>oid6\<rfloor>" -definition "person7 \<equiv> mk\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y oid6 \<lfloor>(\<lfloor>3200\<rfloor>, \<lfloor>oid6\<rfloor>)\<rfloor>" -definition "person8 \<equiv> mk\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y oid7 None" -definition "person9 \<equiv> mk\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n oid8 \<lfloor>0\<rfloor> None" - -definition - "\<sigma>\<^sub>1 \<equiv> \<lparr> heap = Map.empty(oid0 \<mapsto> in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (mk\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n oid0 \<lfloor>1000\<rfloor> \<lfloor>oid1\<rfloor>)) - (oid1 \<mapsto> in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (mk\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n oid1 \<lfloor>1200\<rfloor> None)) - \<^cancel>\<open>oid2\<close> - (oid3 \<mapsto> in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (mk\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n oid3 \<lfloor>2600\<rfloor> \<lfloor>oid4\<rfloor>)) - (oid4 \<mapsto> in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n person5) - (oid5 \<mapsto> in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (mk\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n oid5 \<lfloor>2300\<rfloor> \<lfloor>oid3\<rfloor>)) - \<^cancel>\<open>oid6\<close> - \<^cancel>\<open>oid7\<close> - (oid8 \<mapsto> in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n person9), - assocs = Map.empty \<rparr>" - -definition - "\<sigma>\<^sub>1' \<equiv> \<lparr> heap = Map.empty(oid0 \<mapsto> in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n person1) - (oid1 \<mapsto> in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n person2) - (oid2 \<mapsto> in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n person3) - (oid3 \<mapsto> in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n person4) - \<^cancel>\<open>oid4\<close> - (oid5 \<mapsto> in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n person6) - (oid6 \<mapsto> in\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y person7) - (oid7 \<mapsto> in\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y person8) - (oid8 \<mapsto> in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n person9), - assocs = Map.empty \<rparr>" - -definition "\<sigma>\<^sub>0 \<equiv> \<lparr> heap = Map.empty, assocs = Map.empty \<rparr>" - - -lemma basic_\<tau>_wff: "WFF(\<sigma>\<^sub>1,\<sigma>\<^sub>1')" -by(auto simp: WFF_def \<sigma>\<^sub>1_def \<sigma>\<^sub>1'_def - oid0_def oid1_def oid2_def oid3_def oid4_def oid5_def oid6_def oid7_def oid8_def - oid_of_\<AA>_def oid_of_type\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_def oid_of_type\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_def - person1_def person2_def person3_def person4_def - person5_def person6_def person7_def person8_def person9_def) - -lemma [simp,code_unfold]: "dom (heap \<sigma>\<^sub>1) = {oid0,oid1\<^cancel>\<open>,oid2\<close>,oid3,oid4,oid5\<^cancel>\<open>,oid6,oid7\<close>,oid8}" -by(auto simp: \<sigma>\<^sub>1_def) - -lemma [simp,code_unfold]: "dom (heap \<sigma>\<^sub>1') = {oid0,oid1,oid2,oid3\<^cancel>\<open>,oid4\<close>,oid5,oid6,oid7,oid8}" -by(auto simp: \<sigma>\<^sub>1'_def) - -text_raw{* \isatagafp *} - -definition "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1 :: Person \<equiv> \<lambda> _ .\<lfloor>\<lfloor> person1 \<rfloor>\<rfloor>" -definition "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2 :: Person \<equiv> \<lambda> _ .\<lfloor>\<lfloor> person2 \<rfloor>\<rfloor>" -definition "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3 :: Person \<equiv> \<lambda> _ .\<lfloor>\<lfloor> person3 \<rfloor>\<rfloor>" -definition "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4 :: Person \<equiv> \<lambda> _ .\<lfloor>\<lfloor> person4 \<rfloor>\<rfloor>" -definition "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5 :: Person \<equiv> \<lambda> _ .\<lfloor>\<lfloor> person5 \<rfloor>\<rfloor>" -definition "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6 :: Person \<equiv> \<lambda> _ .\<lfloor>\<lfloor> person6 \<rfloor>\<rfloor>" -definition "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7 :: OclAny \<equiv> \<lambda> _ .\<lfloor>\<lfloor> person7 \<rfloor>\<rfloor>" -definition "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n8 :: OclAny \<equiv> \<lambda> _ .\<lfloor>\<lfloor> person8 \<rfloor>\<rfloor>" -definition "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9 :: Person \<equiv> \<lambda> _ .\<lfloor>\<lfloor> person9 \<rfloor>\<rfloor>" - -lemma [code_unfold]: "((x::Person) \<doteq> y) = StrictRefEq\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t x y" by(simp only: StrictRefEq\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n) -lemma [code_unfold]: "((x::OclAny) \<doteq> y) = StrictRefEq\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t x y" by(simp only: StrictRefEq\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y) - -lemmas [simp,code_unfold] = - OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny - OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person - OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny - OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person - - OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny - OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person - OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny - OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person - - OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny - OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person - OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny - OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person -text_raw{* \endisatagafp *} - -Assert "\<And>s\<^sub>p\<^sub>r\<^sub>e . (s\<^sub>p\<^sub>r\<^sub>e,\<sigma>\<^sub>1') \<Turnstile> (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1 .salary <> \<one>\<zero>\<zero>\<zero>)" -Assert "\<And>s\<^sub>p\<^sub>r\<^sub>e . (s\<^sub>p\<^sub>r\<^sub>e,\<sigma>\<^sub>1') \<Turnstile> (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1 .salary \<doteq> \<one>\<three>\<zero>\<zero>)" -Assert "\<And> s\<^sub>p\<^sub>o\<^sub>s\<^sub>t. (\<sigma>\<^sub>1,s\<^sub>p\<^sub>o\<^sub>s\<^sub>t) \<Turnstile> (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1 .salary@pre \<doteq> \<one>\<zero>\<zero>\<zero>)" -Assert "\<And> s\<^sub>p\<^sub>o\<^sub>s\<^sub>t. (\<sigma>\<^sub>1,s\<^sub>p\<^sub>o\<^sub>s\<^sub>t) \<Turnstile> (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1 .salary@pre <> \<one>\<three>\<zero>\<zero>)" -Assert "\<And>s\<^sub>p\<^sub>r\<^sub>e . (s\<^sub>p\<^sub>r\<^sub>e,\<sigma>\<^sub>1') \<Turnstile> (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1 .boss <> X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1)" -Assert "\<And>s\<^sub>p\<^sub>r\<^sub>e . (s\<^sub>p\<^sub>r\<^sub>e,\<sigma>\<^sub>1') \<Turnstile> (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1 .boss .salary \<doteq> \<one>\<eight>\<zero>\<zero>)" -Assert "\<And>s\<^sub>p\<^sub>r\<^sub>e . (s\<^sub>p\<^sub>r\<^sub>e,\<sigma>\<^sub>1') \<Turnstile> (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1 .boss .boss <> X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1)" -Assert "\<And>s\<^sub>p\<^sub>r\<^sub>e . (s\<^sub>p\<^sub>r\<^sub>e,\<sigma>\<^sub>1') \<Turnstile> (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1 .boss .boss \<doteq> X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2)" -Assert " (\<sigma>\<^sub>1,\<sigma>\<^sub>1') \<Turnstile> (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1 .boss@pre .salary \<doteq> \<one>\<eight>\<zero>\<zero>)" -Assert "\<And> s\<^sub>p\<^sub>o\<^sub>s\<^sub>t. (\<sigma>\<^sub>1,s\<^sub>p\<^sub>o\<^sub>s\<^sub>t) \<Turnstile> (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1 .boss@pre .salary@pre \<doteq> \<one>\<two>\<zero>\<zero>)" -Assert "\<And> s\<^sub>p\<^sub>o\<^sub>s\<^sub>t. (\<sigma>\<^sub>1,s\<^sub>p\<^sub>o\<^sub>s\<^sub>t) \<Turnstile> (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1 .boss@pre .salary@pre <> \<one>\<eight>\<zero>\<zero>)" -Assert "\<And> s\<^sub>p\<^sub>o\<^sub>s\<^sub>t. (\<sigma>\<^sub>1,s\<^sub>p\<^sub>o\<^sub>s\<^sub>t) \<Turnstile> (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1 .boss@pre \<doteq> X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2)" -Assert " (\<sigma>\<^sub>1,\<sigma>\<^sub>1') \<Turnstile> (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1 .boss@pre .boss \<doteq> X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2)" -Assert "\<And> s\<^sub>p\<^sub>o\<^sub>s\<^sub>t. (\<sigma>\<^sub>1,s\<^sub>p\<^sub>o\<^sub>s\<^sub>t) \<Turnstile> (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1 .boss@pre .boss@pre \<doteq> null)" -Assert "\<And> s\<^sub>p\<^sub>o\<^sub>s\<^sub>t. (\<sigma>\<^sub>1,s\<^sub>p\<^sub>o\<^sub>s\<^sub>t) \<Turnstile> not(\<upsilon>(X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1 .boss@pre .boss@pre .boss@pre))" - -lemma " (\<sigma>\<^sub>1,\<sigma>\<^sub>1') \<Turnstile> (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1 .oclIsMaintained())" -by(simp add: OclValid_def OclIsMaintained_def - \<sigma>\<^sub>1_def \<sigma>\<^sub>1'_def - X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1_def person1_def - oid0_def oid1_def oid2_def oid3_def oid4_def oid5_def oid6_def - oid_of_option_def oid_of_type\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_def) - -lemma "\<And>s\<^sub>p\<^sub>r\<^sub>e s\<^sub>p\<^sub>o\<^sub>s\<^sub>t. (s\<^sub>p\<^sub>r\<^sub>e,s\<^sub>p\<^sub>o\<^sub>s\<^sub>t) \<Turnstile> ((X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1 .oclAsType(OclAny) .oclAsType(Person)) \<doteq> X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1)" -by(rule up_down_cast_Person_OclAny_Person', simp add: X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1_def) -Assert "\<And>s\<^sub>p\<^sub>r\<^sub>e s\<^sub>p\<^sub>o\<^sub>s\<^sub>t. (s\<^sub>p\<^sub>r\<^sub>e,s\<^sub>p\<^sub>o\<^sub>s\<^sub>t) \<Turnstile> (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1 .oclIsTypeOf(Person))" -Assert "\<And>s\<^sub>p\<^sub>r\<^sub>e s\<^sub>p\<^sub>o\<^sub>s\<^sub>t. (s\<^sub>p\<^sub>r\<^sub>e,s\<^sub>p\<^sub>o\<^sub>s\<^sub>t) \<Turnstile> not(X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1 .oclIsTypeOf(OclAny))" -Assert "\<And>s\<^sub>p\<^sub>r\<^sub>e s\<^sub>p\<^sub>o\<^sub>s\<^sub>t. (s\<^sub>p\<^sub>r\<^sub>e,s\<^sub>p\<^sub>o\<^sub>s\<^sub>t) \<Turnstile> (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1 .oclIsKindOf(Person))" -Assert "\<And>s\<^sub>p\<^sub>r\<^sub>e s\<^sub>p\<^sub>o\<^sub>s\<^sub>t. (s\<^sub>p\<^sub>r\<^sub>e,s\<^sub>p\<^sub>o\<^sub>s\<^sub>t) \<Turnstile> (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1 .oclIsKindOf(OclAny))" -Assert "\<And>s\<^sub>p\<^sub>r\<^sub>e s\<^sub>p\<^sub>o\<^sub>s\<^sub>t. (s\<^sub>p\<^sub>r\<^sub>e,s\<^sub>p\<^sub>o\<^sub>s\<^sub>t) \<Turnstile> not(X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1 .oclAsType(OclAny) .oclIsTypeOf(OclAny))" - - -Assert "\<And>s\<^sub>p\<^sub>r\<^sub>e . (s\<^sub>p\<^sub>r\<^sub>e,\<sigma>\<^sub>1') \<Turnstile> (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2 .salary \<doteq> \<one>\<eight>\<zero>\<zero>)" -Assert "\<And> s\<^sub>p\<^sub>o\<^sub>s\<^sub>t. (\<sigma>\<^sub>1,s\<^sub>p\<^sub>o\<^sub>s\<^sub>t) \<Turnstile> (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2 .salary@pre \<doteq> \<one>\<two>\<zero>\<zero>)" -Assert "\<And>s\<^sub>p\<^sub>r\<^sub>e . (s\<^sub>p\<^sub>r\<^sub>e,\<sigma>\<^sub>1') \<Turnstile> (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2 .boss \<doteq> X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2)" -Assert " (\<sigma>\<^sub>1,\<sigma>\<^sub>1') \<Turnstile> (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2 .boss .salary@pre \<doteq> \<one>\<two>\<zero>\<zero>)" -Assert " (\<sigma>\<^sub>1,\<sigma>\<^sub>1') \<Turnstile> (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2 .boss .boss@pre \<doteq> null)" -Assert "\<And> s\<^sub>p\<^sub>o\<^sub>s\<^sub>t. (\<sigma>\<^sub>1,s\<^sub>p\<^sub>o\<^sub>s\<^sub>t) \<Turnstile> (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2 .boss@pre \<doteq> null)" -Assert "\<And> s\<^sub>p\<^sub>o\<^sub>s\<^sub>t. (\<sigma>\<^sub>1,s\<^sub>p\<^sub>o\<^sub>s\<^sub>t) \<Turnstile> (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2 .boss@pre <> X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2)" -Assert " (\<sigma>\<^sub>1,\<sigma>\<^sub>1') \<Turnstile> (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2 .boss@pre <> (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2 .boss))" -Assert "\<And> s\<^sub>p\<^sub>o\<^sub>s\<^sub>t. (\<sigma>\<^sub>1,s\<^sub>p\<^sub>o\<^sub>s\<^sub>t) \<Turnstile> not(\<upsilon>(X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2 .boss@pre .boss))" -Assert "\<And> s\<^sub>p\<^sub>o\<^sub>s\<^sub>t. (\<sigma>\<^sub>1,s\<^sub>p\<^sub>o\<^sub>s\<^sub>t) \<Turnstile> not(\<upsilon>(X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2 .boss@pre .salary@pre))" -lemma " (\<sigma>\<^sub>1,\<sigma>\<^sub>1') \<Turnstile> (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2 .oclIsMaintained())" -by(simp add: OclValid_def OclIsMaintained_def \<sigma>\<^sub>1_def \<sigma>\<^sub>1'_def X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2_def person2_def - oid0_def oid1_def oid2_def oid3_def oid4_def oid5_def oid6_def - oid_of_option_def oid_of_type\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_def) - -Assert "\<And>s\<^sub>p\<^sub>r\<^sub>e . (s\<^sub>p\<^sub>r\<^sub>e,\<sigma>\<^sub>1') \<Turnstile> (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3 .salary \<doteq> null)" -Assert "\<And> s\<^sub>p\<^sub>o\<^sub>s\<^sub>t. (\<sigma>\<^sub>1,s\<^sub>p\<^sub>o\<^sub>s\<^sub>t) \<Turnstile> not(\<upsilon>(X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3 .salary@pre))" -Assert "\<And>s\<^sub>p\<^sub>r\<^sub>e . (s\<^sub>p\<^sub>r\<^sub>e,\<sigma>\<^sub>1') \<Turnstile> (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3 .boss \<doteq> null)" -Assert "\<And>s\<^sub>p\<^sub>r\<^sub>e . (s\<^sub>p\<^sub>r\<^sub>e,\<sigma>\<^sub>1') \<Turnstile> not(\<upsilon>(X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3 .boss .salary))" -Assert "\<And> s\<^sub>p\<^sub>o\<^sub>s\<^sub>t. (\<sigma>\<^sub>1,s\<^sub>p\<^sub>o\<^sub>s\<^sub>t) \<Turnstile> not(\<upsilon>(X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3 .boss@pre))" -lemma " (\<sigma>\<^sub>1,\<sigma>\<^sub>1') \<Turnstile> (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3 .oclIsNew())" -by(simp add: OclValid_def OclIsNew_def \<sigma>\<^sub>1_def \<sigma>\<^sub>1'_def X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3_def person3_def - oid0_def oid1_def oid2_def oid3_def oid4_def oid5_def oid6_def oid8_def - oid_of_option_def oid_of_type\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_def) - - -Assert "\<And> s\<^sub>p\<^sub>o\<^sub>s\<^sub>t. (\<sigma>\<^sub>1,s\<^sub>p\<^sub>o\<^sub>s\<^sub>t) \<Turnstile> (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4 .boss@pre \<doteq> X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5)" -Assert " (\<sigma>\<^sub>1,\<sigma>\<^sub>1') \<Turnstile> not(\<upsilon>(X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4 .boss@pre .salary))" -Assert "\<And> s\<^sub>p\<^sub>o\<^sub>s\<^sub>t. (\<sigma>\<^sub>1,s\<^sub>p\<^sub>o\<^sub>s\<^sub>t) \<Turnstile> (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4 .boss@pre .salary@pre \<doteq> \<three>\<five>\<zero>\<zero>)" -lemma " (\<sigma>\<^sub>1,\<sigma>\<^sub>1') \<Turnstile> (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4 .oclIsMaintained())" -by(simp add: OclValid_def OclIsMaintained_def \<sigma>\<^sub>1_def \<sigma>\<^sub>1'_def X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4_def person4_def - oid0_def oid1_def oid2_def oid3_def oid4_def oid5_def oid6_def - oid_of_option_def oid_of_type\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_def) - -Assert "\<And>s\<^sub>p\<^sub>r\<^sub>e . (s\<^sub>p\<^sub>r\<^sub>e,\<sigma>\<^sub>1') \<Turnstile> not(\<upsilon>(X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5 .salary))" -Assert "\<And> s\<^sub>p\<^sub>o\<^sub>s\<^sub>t. (\<sigma>\<^sub>1,s\<^sub>p\<^sub>o\<^sub>s\<^sub>t) \<Turnstile> (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5 .salary@pre \<doteq> \<three>\<five>\<zero>\<zero>)" -Assert "\<And>s\<^sub>p\<^sub>r\<^sub>e . (s\<^sub>p\<^sub>r\<^sub>e,\<sigma>\<^sub>1') \<Turnstile> not(\<upsilon>(X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5 .boss))" -lemma " (\<sigma>\<^sub>1,\<sigma>\<^sub>1') \<Turnstile> (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5 .oclIsDeleted())" -by(simp add: OclNot_def OclValid_def OclIsDeleted_def \<sigma>\<^sub>1_def \<sigma>\<^sub>1'_def X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5_def person5_def - oid0_def oid1_def oid2_def oid3_def oid4_def oid5_def oid6_def oid7_def oid8_def - oid_of_option_def oid_of_type\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_def) - -(* (* access to an oclany object not yet supported *) Assert " (\<sigma>\<^sub>1,\<sigma>\<^sub>1') \<Turnstile> ((X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6 .boss .salary) \<doteq> \<three>\<two>\<zero>\<zero> )"*) -Assert "\<And>s\<^sub>p\<^sub>r\<^sub>e . (s\<^sub>p\<^sub>r\<^sub>e,\<sigma>\<^sub>1') \<Turnstile> not(\<upsilon>(X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6 .boss .salary@pre))" -Assert "\<And> s\<^sub>p\<^sub>o\<^sub>s\<^sub>t. (\<sigma>\<^sub>1,s\<^sub>p\<^sub>o\<^sub>s\<^sub>t) \<Turnstile> (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6 .boss@pre \<doteq> X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4)" -Assert " (\<sigma>\<^sub>1,\<sigma>\<^sub>1') \<Turnstile> (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6 .boss@pre .salary \<doteq> \<two>\<nine>\<zero>\<zero>)" -Assert "\<And> s\<^sub>p\<^sub>o\<^sub>s\<^sub>t. (\<sigma>\<^sub>1,s\<^sub>p\<^sub>o\<^sub>s\<^sub>t) \<Turnstile> (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6 .boss@pre .salary@pre \<doteq> \<two>\<six>\<zero>\<zero>)" -Assert "\<And> s\<^sub>p\<^sub>o\<^sub>s\<^sub>t. (\<sigma>\<^sub>1,s\<^sub>p\<^sub>o\<^sub>s\<^sub>t) \<Turnstile> (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6 .boss@pre .boss@pre \<doteq> X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5)" -lemma " (\<sigma>\<^sub>1,\<sigma>\<^sub>1') \<Turnstile> (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6 .oclIsMaintained())" -by(simp add: OclValid_def OclIsMaintained_def \<sigma>\<^sub>1_def \<sigma>\<^sub>1'_def X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6_def person6_def - oid0_def oid1_def oid2_def oid3_def oid4_def oid5_def oid6_def - oid_of_option_def oid_of_type\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_def) - -(* (* access to an oclany object not yet supported *) Assert " (\<sigma>\<^sub>1,\<sigma>\<^sub>1') \<Turnstile> ((X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7 .oclAsType(Person) \<doteq> (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6 .boss)))" *) -(* (* access to an oclany object not yet supported *) Assert " (\<sigma>\<^sub>1,\<sigma>\<^sub>1') \<Turnstile> ((X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7 .oclAsType(Person) .boss) \<doteq> (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7 .oclAsType(Person)) )" *) -(* (* access to an oclany object not yet supported *) Assert " (\<sigma>\<^sub>1,\<sigma>\<^sub>1') \<Turnstile> ((X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7 .oclAsType(Person) .boss .salary) \<doteq> \<three>\<two>\<zero>\<zero> )" *) -Assert "\<And>s\<^sub>p\<^sub>r\<^sub>e s\<^sub>p\<^sub>o\<^sub>s\<^sub>t. (s\<^sub>p\<^sub>r\<^sub>e,s\<^sub>p\<^sub>o\<^sub>s\<^sub>t) \<Turnstile> \<upsilon>(X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7 .oclAsType(Person))" -Assert "\<And> s\<^sub>p\<^sub>o\<^sub>s\<^sub>t. (\<sigma>\<^sub>1,s\<^sub>p\<^sub>o\<^sub>s\<^sub>t) \<Turnstile> not(\<upsilon>(X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7 .oclAsType(Person) .boss@pre))" -lemma "\<And>s\<^sub>p\<^sub>r\<^sub>e s\<^sub>p\<^sub>o\<^sub>s\<^sub>t. (s\<^sub>p\<^sub>r\<^sub>e,s\<^sub>p\<^sub>o\<^sub>s\<^sub>t) \<Turnstile> ((X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7 .oclAsType(Person) .oclAsType(OclAny) - .oclAsType(Person)) - \<doteq> (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7 .oclAsType(Person)))" -by(rule up_down_cast_Person_OclAny_Person', simp add: X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7_def OclValid_def valid_def person7_def) -lemma " (\<sigma>\<^sub>1,\<sigma>\<^sub>1') \<Turnstile> (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7 .oclIsNew())" -by(simp add: OclValid_def OclIsNew_def \<sigma>\<^sub>1_def \<sigma>\<^sub>1'_def X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7_def person7_def - oid0_def oid1_def oid2_def oid3_def oid4_def oid5_def oid6_def oid8_def - oid_of_option_def oid_of_type\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_def) - -Assert "\<And>s\<^sub>p\<^sub>r\<^sub>e s\<^sub>p\<^sub>o\<^sub>s\<^sub>t. (s\<^sub>p\<^sub>r\<^sub>e,s\<^sub>p\<^sub>o\<^sub>s\<^sub>t) \<Turnstile> (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n8 <> X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7)" -Assert "\<And>s\<^sub>p\<^sub>r\<^sub>e s\<^sub>p\<^sub>o\<^sub>s\<^sub>t. (s\<^sub>p\<^sub>r\<^sub>e,s\<^sub>p\<^sub>o\<^sub>s\<^sub>t) \<Turnstile> not(\<upsilon>(X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n8 .oclAsType(Person)))" -Assert "\<And>s\<^sub>p\<^sub>r\<^sub>e s\<^sub>p\<^sub>o\<^sub>s\<^sub>t. (s\<^sub>p\<^sub>r\<^sub>e,s\<^sub>p\<^sub>o\<^sub>s\<^sub>t) \<Turnstile> (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n8 .oclIsTypeOf(OclAny))" -Assert "\<And>s\<^sub>p\<^sub>r\<^sub>e s\<^sub>p\<^sub>o\<^sub>s\<^sub>t. (s\<^sub>p\<^sub>r\<^sub>e,s\<^sub>p\<^sub>o\<^sub>s\<^sub>t) \<Turnstile> not(X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n8 .oclIsTypeOf(Person))" -Assert "\<And>s\<^sub>p\<^sub>r\<^sub>e s\<^sub>p\<^sub>o\<^sub>s\<^sub>t. (s\<^sub>p\<^sub>r\<^sub>e,s\<^sub>p\<^sub>o\<^sub>s\<^sub>t) \<Turnstile> not(X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n8 .oclIsKindOf(Person))" -Assert "\<And>s\<^sub>p\<^sub>r\<^sub>e s\<^sub>p\<^sub>o\<^sub>s\<^sub>t. (s\<^sub>p\<^sub>r\<^sub>e,s\<^sub>p\<^sub>o\<^sub>s\<^sub>t) \<Turnstile> (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n8 .oclIsKindOf(OclAny))" - -lemma \<sigma>_modifiedonly: "(\<sigma>\<^sub>1,\<sigma>\<^sub>1') \<Turnstile> (Set{ X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1 .oclAsType(OclAny) - , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2 .oclAsType(OclAny) - \<^cancel>\<open>, X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3 .oclAsType(OclAny)\<close> - , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4 .oclAsType(OclAny) - \<^cancel>\<open>, X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5 .oclAsType(OclAny)\<close> - , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6 .oclAsType(OclAny) - \<^cancel>\<open>, X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7 .oclAsType(OclAny)\<close> - \<^cancel>\<open>, X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n8 .oclAsType(OclAny)\<close> - \<^cancel>\<open>, X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9 .oclAsType(OclAny)\<close>}->oclIsModifiedOnly())" - apply(simp add: OclIsModifiedOnly_def OclValid_def - oid0_def oid1_def oid2_def oid3_def oid4_def oid5_def oid6_def oid7_def oid8_def - X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1_def X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2_def X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3_def X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4_def - X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5_def X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6_def X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7_def X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n8_def X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9_def - person1_def person2_def person3_def person4_def - person5_def person6_def person7_def person8_def person9_def - image_def) - apply(simp add: OclIncluding_rep_set mtSet_rep_set null_option_def bot_option_def) - apply(simp add: oid_of_option_def oid_of_type\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_def, clarsimp) - apply(simp add: \<sigma>\<^sub>1_def \<sigma>\<^sub>1'_def - oid0_def oid1_def oid2_def oid3_def oid4_def oid5_def oid6_def oid7_def oid8_def) -done - -lemma "(\<sigma>\<^sub>1,\<sigma>\<^sub>1') \<Turnstile> ((X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9 @pre (\<lambda>x. \<lfloor>OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_\<AA> x\<rfloor>)) \<triangleq> X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9)" -by(simp add: OclSelf_at_pre_def \<sigma>\<^sub>1_def oid_of_option_def oid_of_type\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_def - X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9_def person9_def oid8_def OclValid_def StrongEq_def OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_\<AA>_def) - -lemma "(\<sigma>\<^sub>1,\<sigma>\<^sub>1') \<Turnstile> ((X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9 @post (\<lambda>x. \<lfloor>OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_\<AA> x\<rfloor>)) \<triangleq> X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9)" -by(simp add: OclSelf_at_post_def \<sigma>\<^sub>1'_def oid_of_option_def oid_of_type\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_def - X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9_def person9_def oid8_def OclValid_def StrongEq_def OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_\<AA>_def) - -lemma "(\<sigma>\<^sub>1,\<sigma>\<^sub>1') \<Turnstile> (((X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9 .oclAsType(OclAny)) @pre (\<lambda>x. \<lfloor>OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_\<AA> x\<rfloor>)) \<triangleq> - ((X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9 .oclAsType(OclAny)) @post (\<lambda>x. \<lfloor>OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_\<AA> x\<rfloor>)))" -proof - - - have including4 : "\<And>a b c d \<tau>. - Set{\<lambda>\<tau>. \<lfloor>\<lfloor>a\<rfloor>\<rfloor>, \<lambda>\<tau>. \<lfloor>\<lfloor>b\<rfloor>\<rfloor>, \<lambda>\<tau>. \<lfloor>\<lfloor>c\<rfloor>\<rfloor>, \<lambda>\<tau>. \<lfloor>\<lfloor>d\<rfloor>\<rfloor>} \<tau> = Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e \<lfloor>\<lfloor> {\<lfloor>\<lfloor>a\<rfloor>\<rfloor>, \<lfloor>\<lfloor>b\<rfloor>\<rfloor>, \<lfloor>\<lfloor>c\<rfloor>\<rfloor>, \<lfloor>\<lfloor>d\<rfloor>\<rfloor>} \<rfloor>\<rfloor>" - apply(subst abs_rep_simp'[symmetric], simp) - apply(simp add: OclIncluding_rep_set mtSet_rep_set) - by(rule arg_cong[of _ _ "\<lambda>x. (Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e(\<lfloor>\<lfloor> x \<rfloor>\<rfloor>))"], auto) - - have excluding1: "\<And>S a b c d e \<tau>. - (\<lambda>_. Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e \<lfloor>\<lfloor> {\<lfloor>\<lfloor>a\<rfloor>\<rfloor>, \<lfloor>\<lfloor>b\<rfloor>\<rfloor>, \<lfloor>\<lfloor>c\<rfloor>\<rfloor>, \<lfloor>\<lfloor>d\<rfloor>\<rfloor>} \<rfloor>\<rfloor>)->excluding\<^sub>S\<^sub>e\<^sub>t(\<lambda>\<tau>. \<lfloor>\<lfloor>e\<rfloor>\<rfloor>) \<tau> = - Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e \<lfloor>\<lfloor> {\<lfloor>\<lfloor>a\<rfloor>\<rfloor>, \<lfloor>\<lfloor>b\<rfloor>\<rfloor>, \<lfloor>\<lfloor>c\<rfloor>\<rfloor>, \<lfloor>\<lfloor>d\<rfloor>\<rfloor>} - {\<lfloor>\<lfloor>e\<rfloor>\<rfloor>} \<rfloor>\<rfloor>" - apply(simp add: UML_Set.OclExcluding_def) - apply(simp add: defined_def OclValid_def false_def true_def - bot_fun_def bot_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def null_fun_def null_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def) - apply(rule conjI) - apply(rule impI, subst (asm) Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inject) apply( simp add: bot_option_def)+ - apply(rule conjI) - apply(rule impI, subst (asm) Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inject) apply( simp add: bot_option_def null_option_def)+ - apply(subst Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inverse, simp add: bot_option_def, simp) - done - - show ?thesis - apply(rule framing[where X = "Set{ X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1 .oclAsType(OclAny) - , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2 .oclAsType(OclAny) - \<^cancel>\<open>, X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3 .oclAsType(OclAny)\<close> - , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4 .oclAsType(OclAny) - \<^cancel>\<open>, X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5 .oclAsType(OclAny)\<close> - , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6 .oclAsType(OclAny) - \<^cancel>\<open>, X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7 .oclAsType(OclAny)\<close> - \<^cancel>\<open>, X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n8 .oclAsType(OclAny)\<close> - \<^cancel>\<open>, X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9 .oclAsType(OclAny)\<close>}"]) - apply(cut_tac \<sigma>_modifiedonly) - apply(simp only: OclValid_def - X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1_def X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2_def X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3_def X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4_def - X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5_def X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6_def X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7_def X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n8_def X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9_def - person1_def person2_def person3_def person4_def - person5_def person6_def person7_def person8_def person9_def - OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person) - apply(subst cp_OclIsModifiedOnly, subst UML_Set.OclExcluding.cp0, - subst (asm) cp_OclIsModifiedOnly, simp add: including4 excluding1) - - apply(simp only: X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1_def X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2_def X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3_def X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4_def - X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5_def X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6_def X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7_def X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n8_def X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9_def - person1_def person2_def person3_def person4_def - person5_def person6_def person7_def person8_def person9_def) - apply(simp add: OclIncluding_rep_set mtSet_rep_set - oid0_def oid1_def oid2_def oid3_def oid4_def oid5_def oid6_def oid7_def oid8_def) - apply(simp add: StrictRefEq\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_def oid_of_option_def oid_of_type\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_def OclNot_def OclValid_def - null_option_def bot_option_def) - done -qed - -lemma perm_\<sigma>\<^sub>1' : "\<sigma>\<^sub>1' = \<lparr> heap = Map.empty - (oid8 \<mapsto> in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n person9) - (oid7 \<mapsto> in\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y person8) - (oid6 \<mapsto> in\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y person7) - (oid5 \<mapsto> in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n person6) - \<^cancel>\<open>(oid4 \<mapsto> in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n person5)\<close> - (oid3 \<mapsto> in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n person4) - (oid2 \<mapsto> in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n person3) - (oid1 \<mapsto> in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n person2) - (oid0 \<mapsto> in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n person1) - , assocs = assocs \<sigma>\<^sub>1' \<rparr>" -proof - - note P = fun_upd_twist - show ?thesis - apply(simp add: \<sigma>\<^sub>1'_def - oid0_def oid1_def oid2_def oid3_def oid4_def oid5_def oid6_def oid7_def oid8_def) - apply(subst (1) P, simp) - apply(subst (2) P, simp) apply(subst (1) P, simp) - apply(subst (3) P, simp) apply(subst (2) P, simp) apply(subst (1) P, simp) - apply(subst (4) P, simp) apply(subst (3) P, simp) apply(subst (2) P, simp) apply(subst (1) P, simp) - apply(subst (5) P, simp) apply(subst (4) P, simp) apply(subst (3) P, simp) apply(subst (2) P, simp) apply(subst (1) P, simp) - apply(subst (6) P, simp) apply(subst (5) P, simp) apply(subst (4) P, simp) apply(subst (3) P, simp) apply(subst (2) P, simp) apply(subst (1) P, simp) - apply(subst (7) P, simp) apply(subst (6) P, simp) apply(subst (5) P, simp) apply(subst (4) P, simp) apply(subst (3) P, simp) apply(subst (2) P, simp) apply(subst (1) P, simp) - by(simp) -qed - -declare const_ss [simp] - -lemma "\<And>\<sigma>\<^sub>1. - (\<sigma>\<^sub>1,\<sigma>\<^sub>1') \<Turnstile> (Person .allInstances() \<doteq> Set{ X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1, X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2, X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3, X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4, \<^cancel>\<open>X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5,\<close> X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6, - X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7 .oclAsType(Person), \<^cancel>\<open>X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n8,\<close> X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9 })" - apply(subst perm_\<sigma>\<^sub>1') - apply(simp only: oid0_def oid1_def oid2_def oid3_def oid4_def oid5_def oid6_def oid7_def oid8_def - X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1_def X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2_def X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3_def X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4_def - X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5_def X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6_def X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7_def X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n8_def X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9_def - person7_def) - apply(subst state_update_vs_allInstances_at_post_tc, simp, simp add: OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_\<AA>_def, simp, rule const_StrictRefEq\<^sub>S\<^sub>e\<^sub>t_including, simp, simp, simp, rule OclIncluding_cong, simp, simp) - apply(subst state_update_vs_allInstances_at_post_tc, simp, simp add: OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_\<AA>_def, simp, rule const_StrictRefEq\<^sub>S\<^sub>e\<^sub>t_including, simp, simp, simp, rule OclIncluding_cong, simp, simp) - apply(subst state_update_vs_allInstances_at_post_tc, simp, simp add: OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_\<AA>_def, simp, rule const_StrictRefEq\<^sub>S\<^sub>e\<^sub>t_including, simp, simp, simp, rule OclIncluding_cong, simp, simp) - apply(subst state_update_vs_allInstances_at_post_tc, simp, simp add: OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_\<AA>_def, simp, rule const_StrictRefEq\<^sub>S\<^sub>e\<^sub>t_including, simp, simp, simp, rule OclIncluding_cong, simp, simp) - apply(subst state_update_vs_allInstances_at_post_tc, simp, simp add: OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_\<AA>_def, simp, rule const_StrictRefEq\<^sub>S\<^sub>e\<^sub>t_including, simp, simp, simp, rule OclIncluding_cong, simp, simp) - apply(subst state_update_vs_allInstances_at_post_tc, simp, simp add: OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_\<AA>_def, simp, rule const_StrictRefEq\<^sub>S\<^sub>e\<^sub>t_including, simp, simp, simp, rule OclIncluding_cong, simp, simp) - apply(subst state_update_vs_allInstances_at_post_ntc, simp, simp add: OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_\<AA>_def - person8_def, simp, rule const_StrictRefEq\<^sub>S\<^sub>e\<^sub>t_including, simp, simp, simp) - apply(subst state_update_vs_allInstances_at_post_tc, simp, simp add: OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_\<AA>_def, simp, rule const_StrictRefEq\<^sub>S\<^sub>e\<^sub>t_including, simp, simp, simp, rule OclIncluding_cong, simp, simp) - apply(rule state_update_vs_allInstances_at_post_empty) -by(simp_all add: OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_\<AA>_def) - -lemma "\<And>\<sigma>\<^sub>1. - (\<sigma>\<^sub>1,\<sigma>\<^sub>1') \<Turnstile> (OclAny .allInstances() \<doteq> Set{ X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1 .oclAsType(OclAny), X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2 .oclAsType(OclAny), - X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3 .oclAsType(OclAny), X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4 .oclAsType(OclAny), - \<^cancel>\<open>X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5,\<close> X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6 .oclAsType(OclAny), - X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7, X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n8, X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9 .oclAsType(OclAny) })" - apply(subst perm_\<sigma>\<^sub>1') - apply(simp only: oid0_def oid1_def oid2_def oid3_def oid4_def oid5_def oid6_def oid7_def oid8_def - X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1_def X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2_def X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3_def X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4_def X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5_def X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6_def X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7_def X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n8_def X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9_def - person1_def person2_def person3_def person4_def person5_def person6_def person9_def) - apply(subst state_update_vs_allInstances_at_post_tc, simp, simp add: OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_\<AA>_def, simp, rule const_StrictRefEq\<^sub>S\<^sub>e\<^sub>t_including, simp, simp, simp, rule OclIncluding_cong, simp, simp)+ - apply(rule state_update_vs_allInstances_at_post_empty) -by(simp_all add: OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_\<AA>_def) - -end diff --git a/Citadelle/examples/Employee_Model/Design_deep.thy b/Citadelle/examples/Employee_Model/Design_deep.thy deleted file mode 100644 index a78c8b99c678f11e363962d86222def5dce99bf3..0000000000000000000000000000000000000000 --- a/Citadelle/examples/Employee_Model/Design_deep.thy +++ /dev/null @@ -1,143 +0,0 @@ -(****************************************************************************** - * 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 - Design_deep -imports - "../../src/compiler/Generator_dynamic_sequential" -begin - -generation_syntax [ deep - (generation_semantics [ design (*, oid_start 10*) ]) - (THEORY Employee_DesignModel_UMLPart_generated) - (IMPORTS ["OCL.UML_Main", "FOCL.Static"] - "FOCL.Generator_dynamic_sequential") - SECTION - (*SORRY*) (*no_dirty*) - [ (* in Haskell *) - (* in OCaml module_name M *) - (* in Scala module_name M *) - (* in SML module_name M *) - in self ] - (output_directory "../../doc") - (*, syntax_print*) ] - -Class Person < Planet - Attributes salary : Integer (*\<acute>int\<acute>*) -End - -Association boss - Between Person [*] - Person [0 \<bullet>\<bullet> 1] Role boss -End - -Class Planet < Galaxy - Attributes wormhole : UnlimitedNatural - weight : Integer -End - -Class Galaxy - Attributes sound : Void - moving : Boolean - outer_world : Set(Sequence(Planet)) -End - -Instance X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1 :: Person = [ salary = 1300 , boss = X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2 ] - and X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2 :: Person = [ salary = 1800 , boss = X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2 ] - and X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3 :: Person = [] - and X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4 :: Person = [ salary = 2900 ] - and X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5 :: Person = [ salary = 3500 ] - and X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6 :: Person = [ salary = 2500 , boss = X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7 ] - and X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7 = ([ salary = 3200 , boss = X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7 ] :: Person) \<rightarrow>oclAsType( OclAny ) - and X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n8 :: OclAny = [] - and X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9 :: Person = [ salary = 0 ] - and X0 :: Person = [ outer_world = [ [ P1 ] ] ] - and P1 :: Planet = [ outer_world = [ [ P1 ] , [ self 10 ] ] ] - -State \<sigma>\<^sub>1 = - [ ([ X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1 with_only salary = 1000 , boss = self 1 ] :: Person) - , ([ X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2 with_only salary = 1200 ] :: Person) - (* *) - , ([ X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4 with_only salary = 2600 , boss = self 3 ] :: Person) - , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5 - , ([ X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6 with_only salary = 2300 , boss = self 2 ] :: Person) - (* *) - (* *) - , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9 ] - -State \<sigma>\<^sub>1' = - [ X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1 - , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2 - , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3 - , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4 - (* *) - , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6 - , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7 - , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n8 - , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9 ] - -(*State \<sigma>\<^sub>0 = []*) - -Transition \<sigma>\<^sub>1 \<sigma>\<^sub>1' - -Context Person :: contents () : Set(Integer) - Post : "result \<triangleq> if (self .boss \<doteq> null) - then (Set{}->including\<^sub>S\<^sub>e\<^sub>t(self .salary)) - else (self .boss .contents()->including\<^sub>S\<^sub>e\<^sub>t(self .salary)) - endif" - Post : "true" - Pre : "false" - -Context Person - Inv a: "self .boss <> null implies (self .salary \<triangleq> ((self .boss) .salary))" - -Context Planet - Inv A : "true and (self .weight \<le>\<^sub>i\<^sub>n\<^sub>t \<zero>)" - -(*BaseType [ 1000, 1200, 1300, 1800, 2600, 2900, 3200, 3500 - , 3.14159265 - , "abc", "\<AA>\<BB>\<CC>\<DD>\<EE>\<FF>" ]*) - -(*generation_syntax deep flush_all*) - -end diff --git a/Citadelle/examples/Employee_Model/Design_shallow.thy b/Citadelle/examples/Employee_Model/Design_shallow.thy deleted file mode 100644 index 8a348f6aef27ea37f3284cea82f4e16322942f83..0000000000000000000000000000000000000000 --- a/Citadelle/examples/Employee_Model/Design_shallow.thy +++ /dev/null @@ -1,134 +0,0 @@ -(****************************************************************************** - * 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 - Design_shallow -imports - OCL.UML_Main - FOCL.Static - FOCL.Generator_dynamic_sequential -begin - -generation_syntax [ shallow (generation_semantics [ design ]) - (*SORRY*) (*no_dirty*) - (*, syntax_print*) ] - -Class Person < Planet - Attributes salary : Integer (*\<acute>int\<acute>*) -End - -Association boss - Between Person [*] - Person [0 \<bullet>\<bullet> 1] Role boss -End - -Class Planet < Galaxy - Attributes wormhole : UnlimitedNatural - weight : Integer -End - -Class Galaxy - Attributes sound : Void - moving : Boolean - outer_world : Set(Sequence(Planet)) -End - -Instance X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1 :: Person = [ salary = 1300 , boss = X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2 ] - and X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2 :: Person = [ salary = 1800 , boss = X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2 ] - and X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3 :: Person = [] - and X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4 :: Person = [ salary = 2900 ] - and X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5 :: Person = [ salary = 3500 ] - and X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6 :: Person = [ salary = 2500 , boss = X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7 ] - and X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7 = ([ salary = 3200 , boss = X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7 ] :: Person) \<rightarrow>oclAsType( OclAny ) - and X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n8 :: OclAny = [] - and X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9 :: Person = [ salary = 0 ] - and X0 :: Person = [ outer_world = [ [ P1 ] ] ] - and P1 :: Planet = [ outer_world = [ [ P1 ] , [ self 10 ] ] ] - -State \<sigma>\<^sub>1 = - [ ([ X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1 with_only salary = 1000 , boss = self 1 ] :: Person) - , ([ X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2 with_only salary = 1200 ] :: Person) - (* *) - , ([ X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4 with_only salary = 2600 , boss = self 3 ] :: Person) - , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5 - , ([ X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6 with_only salary = 2300 , boss = self 2 ] :: Person) - (* *) - (* *) - , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9 ] - -State \<sigma>\<^sub>1' = - [ X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1 - , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2 - , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3 - , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4 - (* *) - , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6 - , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7 - , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n8 - , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9 ] - -(*State \<sigma>\<^sub>0 = []*) - -Transition \<sigma>\<^sub>1 \<sigma>\<^sub>1' - -Context Person :: contents () : Set(Integer) - Post : "result \<triangleq> if (self .boss \<doteq> null) - then (Set{}->including\<^sub>S\<^sub>e\<^sub>t(self .salary)) - else (self .boss .contents()->including\<^sub>S\<^sub>e\<^sub>t(self .salary)) - endif" - Post : "true" - Pre : "false" - -Context Person - Inv a: "self .boss <> null implies (self .salary \<triangleq> ((self .boss) .salary))" - -Context Planet - Inv A : "true and (self .weight \<le>\<^sub>i\<^sub>n\<^sub>t \<zero>)" - -(*BaseType [ 1000, 1200, 1300, 1800, 2600, 2900, 3200, 3500 - , 3.14159265 - , "abc", "\<AA>\<BB>\<CC>\<DD>\<EE>\<FF>" ]*) - -lemmas [simp,code_unfold] = dot_accessor - -end diff --git a/Citadelle/examples/Flight_Model.thy b/Citadelle/examples/Flight_Model.thy deleted file mode 100644 index a67f6be29da73566bbb02566e350af21f3e23879..0000000000000000000000000000000000000000 --- a/Citadelle/examples/Flight_Model.thy +++ /dev/null @@ -1,780 +0,0 @@ -(****************************************************************************** - * 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. - ******************************************************************************) - -theory - Flight_Model -imports - FOCL.UML_OCL -begin - -subsection\<open> Class Model \<close> - -find_theorems (350) name:"Client" - -text\<open>This part corresponds to the writing in Isabelle of the -code shown in \autoref{fig:code-data}.\<close> - -Class Flight - Attributes - seats : Integer - "from" : String - to : String -End - -lemma "id = (\<lambda>x. x)" -by (rule id_def) -text\<open>As remark, we are checking for example that the constant @{term id} already exists, -and that one can also use this name in the following attribute: -no conflict will happen.\<close> - -Class Reservation - Attributes - id : Integer - date : Week -End - -Class Person - Attributes - name : String -End - -Class Client < Person - Attributes - address : String -End - -Class Staff < Person -End - -Association passengers - Between Person [*] - Role passengers - Flight [*] - Role flights -End - -Aggregation flights - Between Flight [1] - Role flight - Reservation [*] - Role fl_res Sequence_ -End - -Association reservations - Between Client [1] - Role client - Reservation [*] - Role cl_res -End - -Association connection - Between Reservation [0 \<bullet>\<bullet> 1] - Role "next" - Reservation [0 \<bullet>\<bullet> 1] - Role prev -End - -text\<open> In complement to \autoref{fig:code-data}, we define an enumeration type.\<close> -Enum Week - [ Mon, Tue, Wed, Thu, Fri, Sat, Sun ] -End! - -find_theorems (350) name:"Client" - -(* -(* Illustration of a wrong model transition: *) -Instance R00 :: Reservation = [ id = 00, flight = [ F1 ], "next" = R11 ] - and R11 :: Reservation = [ id = 11, flight = [ F1, F2 ], "next" = R00 ] - and R22 :: Reservation = [ id = 22, "next" = [ R00, R11, R22 ] ] - and F1 :: Flight = [ seats = 120, "from" = "Valencia", to = "Miami" ] - and F2 :: Flight = [ seats = 370, "from" = "Miami", to = "Ottawa" ] -(* -R00 .flight = Set{ F1 } -R00 .client = Set{} // minimum constraint [1] not satisfied -R00 .prev = Set{ R11 , R22 } // maximum constraint [0 .. 1] not satisfied -R00 .next = Set{ R11 } -R11 .flight = Set{ F1 , F2 } // maximum constraint [1] not satisfied -R11 .client = Set{} // minimum constraint [1] not satisfied -R11 .prev = Set{ R00 , R22 } // maximum constraint [0 .. 1] not satisfied -R11 .next = Set{ R00 } -R22 .flight = Set{} // minimum constraint [1] not satisfied -R22 .client = Set{} // minimum constraint [1] not satisfied -R22 .prev = Set{ R22 } -R22 .next = Set{ R00 , R11 , R22 } // maximum constraint [0 .. 1] not satisfied -F1 .passengers = Set{} -F1 .fl_res = Set{ R00 , R11 } -F2 .passengers = Set{} -F2 .fl_res = Set{ R11 } -8 error(s) in multiplicity constraints -*) -*) - -subsection\<open> Two State Instances of the Class Model \<close> - -text\<open> The creation of (typed) object instances is performed in \HOCL -with the command $\Instance$: \<close> -Instance S1 :: Staff = [ name = "Merlin" , flights = F1 ] - and C1 :: Client = [ name = "Bertha" , address = "Miami" , flights = F1 , cl_res = R11 ] - and C2 :: Client = [ name = "Arthur" , address = "Valencia" , flights = F1 , cl_res = R21 ] - and R11 :: Reservation = [ id = 12345 , flight = F1 , date = Mon ] - and R21 :: Reservation = [ id = 98765 , flight = F1 ] - and F1 :: Flight = [ seats = 120 , "from" = "Valencia" , to = "Miami" ] - and F2 :: Flight = [ seats = 370 , "from" = "Miami" , to = "Ottawa" ] -text\<open> -The notion of object instances comes before that of states. -Currently, we have only created the object instances @{const S1}, -@{const C1}, @{const C2}, @{const R11}, @{const R21}, @{const F1} and @{const F2}. -They will need to be ``registered'' in a state later. -$\Instance$ verifies that all objects being created - are respecting the multiplicities declared above in classes (in the bidirectional sense). -For example, after the type-checking stage, we have -correctly that @{term "R21 .client"} \<open>\<cong>\<close> @{term "Set{ C2 }"}, since @{const R21} appears as one reservation of -@{const C2}, and where ``\<open>X \<cong> Y\<close>'' -stands as a synonym for @{term "\<forall>\<tau>. (\<tau> \<Turnstile> \<delta> X) \<longrightarrow> (\<tau> \<Turnstile> \<delta> Y) \<longrightarrow> (\<tau> \<Turnstile> (X \<triangleq> Y))"}.\footnotemark -As remark, the order of attributes and objects -declarations is not important: mutually recursive constructions become -de-facto supported. As illustration, we can include here the text displayed in the output window after evaluating -the above $\Instance$ -(we have manually pasted the text from the output window in Isabelle/jEdit): -@{text [display] \<open> -S1 .flights \<cong> Set{ F1 } -C1 .flights \<cong> Set{ F1 } -C1 .cl_res \<cong> Set{ R11 } -C2 .flights \<cong> Set{ F1 } -C2 .cl_res \<cong> Set{ R21 } -R11 .flight \<cong> Set{ F1 } -R11 .client \<cong> Set{ C1 } -R11 .prev \<cong> Set{} -R11 .next \<cong> Set{} -R21 .flight \<cong> Set{ F1 } -R21 .client \<cong> Set{ C2 } -R21 .prev \<cong> Set{} -R21 .next \<cong> Set{} -F1 .passengers \<cong> Set{ S1 , C1 , C2 } -F1 .fl_res \<cong> Set{ R11 , R21 } -F2 .passengers \<cong> Set{} -F2 .fl_res \<cong> Set{} -\<close>} -\<close> -text_raw\<open>\footnotetext{ -Although such rule schemata may be explicitly generated by $\Instance$ (for most \OCL expressions), -they can also not be: -at the time of writing, the complete type-checking process is at least -fully executed from an extracted \HOL function -(as one consequence, the type-checking process terminates). -This is feasible because for the moment, $\Instance$ only accepts ``grounds objects'' -as arguments (the reader is referred to its syntax diagram detailed in \autoref{app:oltg-rail}).}\<close> - -text\<open> We can check that @{const S1} indeed exists and has the expected \OCL type. \<close> -term "S1 ::\<cdot> Staff" - -text\<open> Once objects are constructed with $\Instance$, it becomes possible to -regroup them together into a state. This is what the next command $\State$ is doing by creating -a state named \<open>\<sigma>\<^sub>1\<close>, corresponding to the pre-state of \autoref{fig:system-states}.\<close> -State \<sigma>\<^sub>1 = [ S1, C1, C2, R11, R21, F1, F2 ] - -text\<open> -This generates a number of theorems from it, \eg: -@{text [display] \<open> -\<And>\<sigma>. (\<sigma>\<^sub>1, \<sigma>) \<Turnstile> Staff .allInstances@pre() \<triangleq> Set{S1} -\<And>\<sigma>. (\<sigma>\<^sub>1, \<sigma>) \<Turnstile> Client .allInstances@pre() \<triangleq> Set{C1,C2} -\<And>\<sigma>. (\<sigma>\<^sub>1, \<sigma>) \<Turnstile> Reservation .allInstances@pre() \<triangleq> Set{R11,R12} -\<And>\<sigma>. (\<sigma>\<^sub>1, \<sigma>) \<Turnstile> Flight .allInstances@pre() \<triangleq> Set{F1,F2} -\<close>} - -At this point, it is not yet sure that @{text \<sigma>\<^sub>1} will be used in the pre-state or post-state. -In any case, the above command also generates the following symmetric lemmas: -@{text [display] \<open> -\<And>\<sigma>. (\<sigma>, \<sigma>\<^sub>1) \<Turnstile> Staff .allInstances() \<triangleq> Set{S1} -\<And>\<sigma>. (\<sigma>, \<sigma>\<^sub>1) \<Turnstile> Client .allInstances() \<triangleq> Set{C1,C2} -\<And>\<sigma>. (\<sigma>, \<sigma>\<^sub>1) \<Turnstile> Reservation .allInstances() \<triangleq> Set{R11,R12} -\<And>\<sigma>. (\<sigma>, \<sigma>\<^sub>1) \<Turnstile> Flight .allInstances() \<triangleq> Set{F1,F2} -\<close>} - -Because all these lemmas are stated under the precondition that all object instances are -defined entities, lemmas generated by $\State$ are actually proved in a particular -$\holoclthykeywordstyle\operatorname{locale}$~\cite{DBLP:journals/jar/Ballarin14,isabelle-locale} \<open>state_\<sigma>\<^sub>1\<close>. -Thus the header of \<open>state_\<sigma>\<^sub>1\<close> regroups these (mandatory) definedness assumptions, -that have to be all satisfied before being able to use the rules defined in its body. -\<close> - -text\<open> The next statement illustrates \autoref{sec:focl-front-end}. It -shows for instance that object instances can also be generated -by $\State$ on the fly. Fresh variables are created meanwhile if needed, like \<open>\<sigma>\<^sub>2_object1\<close>.\<close> -State \<sigma>\<^sub>2 = - [ S1 - , ([ C1 with_only name = "Bertha", address = "Saint-Malo" , flights = F1 , cl_res = R11 ] :: Client) - , ([ C2 with_only name = "Arthur",address = "Valencia",flights=[F1,F2],cl_res=[self 4,self 7]]::Client) - , R11 - , ([ R21 with_only id = 98765 , flight = F1 , "next" = self 7] :: Reservation) - , F1 - , F2 - , ([ id = 19283 , flight = F2 ] :: Reservation) ] -text\<open> -Similarly as with $\Instance$, we can paste in the following what is currently being -displayed in the output window (where ``\<open>/*8*/\<close>'' means the object having an $\oid$ equal to -8).\footnotemark -@{text [display] \<open> -\<sigma>\<^sub>2_object1 .flights \<cong> Set{ /*8*/ } -\<sigma>\<^sub>2_object1 .cl_res \<cong> Set{ /*6*/ } -\<sigma>\<^sub>2_object2 .flights \<cong> Set{ /*8*/ , /*9*/ } -\<sigma>\<^sub>2_object2 .cl_res \<cong> Set{ \<sigma>\<^sub>2_object4 , \<sigma>\<^sub>2_object7 } -\<sigma>\<^sub>2_object4 .flight \<cong> Set{ /*8*/ } -\<sigma>\<^sub>2_object4 .client \<cong> Set{ \<sigma>\<^sub>2_object2 } -\<sigma>\<^sub>2_object4 .prev \<cong> Set{} -\<sigma>\<^sub>2_object4 .next \<cong> Set{ \<sigma>\<^sub>2_object7 } -\<sigma>\<^sub>2_object7 .flight \<cong> Set{ /*9*/ } -\<sigma>\<^sub>2_object7 .client \<cong> Set{ \<sigma>\<^sub>2_object2 } -\<sigma>\<^sub>2_object7 .prev \<cong> Set{ \<sigma>\<^sub>2_object4 } -\<sigma>\<^sub>2_object7 .next \<cong> Set{} -\<close>} - -Note that there is a mechanism to reference objects via the (invented) keyword -$\greenkeywordstyle\operatorname{self}$ (it has no particular relation -with the one used in \autoref{sec:focl-front-end}), -which takes a number designating the index of a particular object instance occurring -in the list of declarations (the index starts with 0 as first position). - -Similarly as for \<open>state_\<sigma>\<^sub>1\<close>, we obtain another $\holoclthykeywordstyle\operatorname{locale}$ -called \<open>state_\<sigma>\<^sub>2\<close>, representing the post-state of \autoref{fig:system-states}. -\<close> -text_raw\<open>\footnotetext{As future work, it is plan for $\Instance$ to support the writing of -arbitrary \OCL expressions, including the assignment of potentially infinite collection types -(for example ``a set of sequence of bag of objects''). -In particular, besides the cardinality of the manipulated collection types, -the sole information required for checking multiplicities -appears to be the $\oid$ of objects.}\<close> - -text\<open> The $\Transition$ command relates the two states together. \<close> -Transition \<sigma>\<^sub>1 \<sigma>\<^sub>2 -text\<open> -The first state is intended to be understood as the pre-state, -and the second state as the post-state. In particular, we do not obtain similar proved theorems -if we write \<^theory_text>\<open>Transition \<sigma>\<^sub>1 \<sigma>\<^sub>2\<close> or \<^theory_text>\<open>Transition \<sigma>\<^sub>2 \<sigma>\<^sub>1\<close> (assuming \<open>\<sigma>\<^sub>1\<close> and \<open>\<sigma>\<^sub>2\<close> -are different). Generally, $\Transition$ establishes for a pair of a pre- and a post state -(i.e. a state transition) that a number of -crucial properties are satisfied. -For instance, the well-formedness of the two given states is proven: \<open>WFF(\<sigma>\<^sub>1, \<sigma>\<^sub>2)\<close>. - -Furthermore, for each object \<open>X\<close> additional lemmas are generated to situate \<open>X\<close> -as an object existing in \<open>\<sigma>\<^sub>1\<close>, \<open>\<sigma>\<^sub>2\<close>, both, or in any permutations of -\<open>\<sigma>\<^sub>1\<close> and \<open>\<sigma>\<^sub>2\<close>. -Such lemmas typically resemble as: - \<^item> \<open>(\<sigma>\<^sub>1, \<sigma>\<^sub>2) \<Turnstile> X .oclIsNew()\<close>, or - \<^item> \<open>(\<sigma>\<^sub>1, \<sigma>\<^sub>2) \<Turnstile> X .oclIsDeleted()\<close>, or - \<^item> \<open>(\<sigma>\<^sub>1, \<sigma>\<^sub>2) \<Turnstile> X .oclIsAbsent()\<close>, or - \<^item> \<open>(\<sigma>\<^sub>1, \<sigma>\<^sub>2) \<Turnstile> X .oclIsMaintained()\<close> - -where the latter only means that the $\oid$ of \<open>X\<close> exists both in \<open>\<sigma>\<^sub>1\<close> and -\<open>\<sigma>\<^sub>2\<close>, in particular the values of the attribute fields of \<open>X\<close> have also not changed. - -As completeness property, we can state the following lemma covering all disjunction case -(for any \<open>X\<close> and -\<open>\<tau>\<close>)~\cite{brucker.ea:featherweight:2014}: @{thm state_split} - -Finally $\Transition$ proceeds as $\State$: it builds a new -$\holoclthykeywordstyle\operatorname{locale}$, called \<open>transition_\<sigma>\<^sub>1_\<sigma>\<^sub>2\<close>, - by particularly instantiating the two locales -\<open>state_\<sigma>\<^sub>1\<close> and \<open>state_\<sigma>\<^sub>2\<close>. -\<close> - -text\<open> The following lemma establishes that the generated object presentations - (like @{thm "S1_def"}, @{thm "C1_def"}, etc.) satisfy the requirements - of the locale \<open>state_\<sigma>\<^sub>1\<close>. In particular, it has to be shown that the - chosen object representations are defined and have distinct $\oid$s. - Proving this lemma gives access to the already defined properties in this - locale. \<close> -lemma \<sigma>\<^sub>1: "state_interpretation_\<sigma>\<^sub>1 \<tau>" -by(simp add: state_interpretation_\<sigma>\<^sub>1_def, - standard, simp add: pp_oid_\<sigma>\<^sub>1_\<sigma>\<^sub>2, - (simp add: pp_object_\<sigma>\<^sub>1_\<sigma>\<^sub>2)+) - -text\<open> This instance proof goes analogously. \<close> - -lemma \<sigma>\<^sub>2: "state_interpretation_\<sigma>\<^sub>2 \<tau>" -by(simp add: state_interpretation_\<sigma>\<^sub>2_def, - standard, simp add: pp_oid_\<sigma>\<^sub>1_\<sigma>\<^sub>2, - (simp add: pp_object_\<sigma>\<^sub>1_\<sigma>\<^sub>2)+) - -text\<open> The latter proof gives access to the locale \<open>transition_\<sigma>\<^sub>1_\<sigma>\<^sub>2\<close>. \<close> - -lemma \<sigma>\<^sub>1_\<sigma>\<^sub>2: "pp_\<sigma>\<^sub>1_\<sigma>\<^sub>2 \<tau>" -by(simp add: pp_\<sigma>\<^sub>1_\<sigma>\<^sub>2_def, - standard, simp add: pp_oid_\<sigma>\<^sub>1_\<sigma>\<^sub>2, - (simp add: pp_object_\<sigma>\<^sub>1_\<sigma>\<^sub>2)+, - (simp add: pp_oid_\<sigma>\<^sub>1_\<sigma>\<^sub>2)+) - - -text\<open> For convenience, one can introduce the empty state here \<close> -definition \<sigma>\<^sub>0 :: "\<AA> state" where "\<sigma>\<^sub>0 = state.make Map.empty Map.empty" - -text\<open> so that the following abbreviations can be written \<close> -definition "\<sigma>\<^sub>t\<^sub>1 = transition_\<sigma>\<^sub>1_\<sigma>\<^sub>2.\<sigma>\<^sub>1 oid3 oid4 oid5 oid6 oid7 oid8 oid9 - \<lceil>\<lceil>S1 (\<sigma>\<^sub>0, \<sigma>\<^sub>0)\<rceil>\<rceil> \<lceil>\<lceil>C1 (\<sigma>\<^sub>0, \<sigma>\<^sub>0)\<rceil>\<rceil> \<lceil>\<lceil>C2 (\<sigma>\<^sub>0, \<sigma>\<^sub>0)\<rceil>\<rceil> \<lceil>\<lceil>R11 (\<sigma>\<^sub>0, \<sigma>\<^sub>0)\<rceil>\<rceil> - \<lceil>\<lceil>R21 (\<sigma>\<^sub>0, \<sigma>\<^sub>0)\<rceil>\<rceil> \<lceil>\<lceil>F1 (\<sigma>\<^sub>0, \<sigma>\<^sub>0)\<rceil>\<rceil> \<lceil>\<lceil>F2 (\<sigma>\<^sub>0, \<sigma>\<^sub>0)\<rceil>\<rceil>" - -definition "\<sigma>\<^sub>t\<^sub>2 = transition_\<sigma>\<^sub>1_\<sigma>\<^sub>2.\<sigma>\<^sub>2 oid3 oid4 oid5 oid6 oid7 oid8 oid9 oid10 - \<lceil>\<lceil>S1 (\<sigma>\<^sub>0, \<sigma>\<^sub>0)\<rceil>\<rceil> \<lceil>\<lceil>\<sigma>\<^sub>2_object1 (\<sigma>\<^sub>0, \<sigma>\<^sub>0)\<rceil>\<rceil> \<lceil>\<lceil>\<sigma>\<^sub>2_object2 (\<sigma>\<^sub>0, \<sigma>\<^sub>0)\<rceil>\<rceil> \<lceil>\<lceil>R11 (\<sigma>\<^sub>0, \<sigma>\<^sub>0)\<rceil>\<rceil> - \<lceil>\<lceil>\<sigma>\<^sub>2_object4 (\<sigma>\<^sub>0, \<sigma>\<^sub>0)\<rceil>\<rceil> \<lceil>\<lceil>F1 (\<sigma>\<^sub>0, \<sigma>\<^sub>0)\<rceil>\<rceil> \<lceil>\<lceil>F2 (\<sigma>\<^sub>0, \<sigma>\<^sub>0)\<rceil>\<rceil> - \<lceil>\<lceil>\<sigma>\<^sub>2_object7 (\<sigma>\<^sub>0, \<sigma>\<^sub>0)\<rceil>\<rceil>" - -definition "\<sigma>\<^sub>s\<^sub>1 = state_\<sigma>\<^sub>1.\<sigma>\<^sub>1 oid3 oid4 oid5 oid6 oid7 oid8 oid9 - \<lceil>\<lceil>S1 (\<sigma>\<^sub>0, \<sigma>\<^sub>0)\<rceil>\<rceil> \<lceil>\<lceil>C1 (\<sigma>\<^sub>0, \<sigma>\<^sub>0)\<rceil>\<rceil> \<lceil>\<lceil>C2 (\<sigma>\<^sub>0, \<sigma>\<^sub>0)\<rceil>\<rceil> \<lceil>\<lceil>R11 (\<sigma>\<^sub>0, \<sigma>\<^sub>0)\<rceil>\<rceil> - \<lceil>\<lceil>R21 (\<sigma>\<^sub>0, \<sigma>\<^sub>0)\<rceil>\<rceil> \<lceil>\<lceil>F1 (\<sigma>\<^sub>0, \<sigma>\<^sub>0)\<rceil>\<rceil> \<lceil>\<lceil>F2 (\<sigma>\<^sub>0, \<sigma>\<^sub>0)\<rceil>\<rceil>" - -definition "\<sigma>\<^sub>s\<^sub>2 = state_\<sigma>\<^sub>2.\<sigma>\<^sub>2 oid3 oid4 oid5 oid6 oid7 oid8 oid9 oid10 - \<lceil>\<lceil>S1 (\<sigma>\<^sub>0, \<sigma>\<^sub>0)\<rceil>\<rceil> \<lceil>\<lceil>\<sigma>\<^sub>2_object1 (\<sigma>\<^sub>0, \<sigma>\<^sub>0)\<rceil>\<rceil> \<lceil>\<lceil>\<sigma>\<^sub>2_object2 (\<sigma>\<^sub>0, \<sigma>\<^sub>0)\<rceil>\<rceil> \<lceil>\<lceil>R11 (\<sigma>\<^sub>0, \<sigma>\<^sub>0)\<rceil>\<rceil> - \<lceil>\<lceil>\<sigma>\<^sub>2_object4 (\<sigma>\<^sub>0, \<sigma>\<^sub>0)\<rceil>\<rceil> \<lceil>\<lceil>F1 (\<sigma>\<^sub>0, \<sigma>\<^sub>0)\<rceil>\<rceil> \<lceil>\<lceil>F2 (\<sigma>\<^sub>0, \<sigma>\<^sub>0)\<rceil>\<rceil> - \<lceil>\<lceil>\<sigma>\<^sub>2_object7 (\<sigma>\<^sub>0, \<sigma>\<^sub>0)\<rceil>\<rceil>" - -text\<open> Both formats are, fortunately, equivalent; this means that for these states, we -can access properties from both state and transition locales, in which the -object representations are ``wired'' in the same way. \<close> - -lemma \<sigma>\<^sub>t\<^sub>1_\<sigma>\<^sub>s\<^sub>1: "\<sigma>\<^sub>t\<^sub>1 = \<sigma>\<^sub>s\<^sub>1" -unfolding \<sigma>\<^sub>t\<^sub>1_def \<sigma>\<^sub>s\<^sub>1_def - apply(subst transition_\<sigma>\<^sub>1_\<sigma>\<^sub>2.\<sigma>\<^sub>1_def) -by(rule \<sigma>\<^sub>1_\<sigma>\<^sub>2[simplified pp_\<sigma>\<^sub>1_\<sigma>\<^sub>2_def], simp) - - -lemma \<sigma>\<^sub>t\<^sub>2_\<sigma>\<^sub>s\<^sub>2: "\<sigma>\<^sub>t\<^sub>2 = \<sigma>\<^sub>s\<^sub>2" -unfolding \<sigma>\<^sub>t\<^sub>2_def \<sigma>\<^sub>s\<^sub>2_def - apply(subst transition_\<sigma>\<^sub>1_\<sigma>\<^sub>2.\<sigma>\<^sub>2_def) -by(rule \<sigma>\<^sub>1_\<sigma>\<^sub>2[simplified pp_\<sigma>\<^sub>1_\<sigma>\<^sub>2_def], simp) - - -text\<open> The next lemma becomes a shortcut of the one generated by $\Transition$, - but explicitly instantiated. \<close> - -(* TODO : this should be done at the level of states, not transitions... *) -lemma "WFF (\<sigma>\<^sub>t\<^sub>1, \<sigma>\<^sub>t\<^sub>2)" -unfolding \<sigma>\<^sub>t\<^sub>1_\<sigma>\<^sub>s\<^sub>1 \<sigma>\<^sub>t\<^sub>2_\<sigma>\<^sub>s\<^sub>2 \<sigma>\<^sub>s\<^sub>1_def \<sigma>\<^sub>s\<^sub>2_def - apply(rule transition_\<sigma>\<^sub>1_\<sigma>\<^sub>2.basic_\<sigma>\<^sub>1_\<sigma>\<^sub>2_wff) - apply(rule \<sigma>\<^sub>1_\<sigma>\<^sub>2[simplified pp_\<sigma>\<^sub>1_\<sigma>\<^sub>2_def]) -by(simp_all add: pp_oid_\<sigma>\<^sub>1_\<sigma>\<^sub>2 pp_object_\<sigma>\<^sub>1_\<sigma>\<^sub>2 - (* *) - oid_of_\<AA>_def oid_of_ty\<^sub>S\<^sub>t\<^sub>a\<^sub>f\<^sub>f_def oid_of_ty\<^sub>C\<^sub>l\<^sub>i\<^sub>e\<^sub>n\<^sub>t_def oid_of_ty\<^sub>R\<^sub>e\<^sub>s\<^sub>e\<^sub>r\<^sub>v\<^sub>a\<^sub>t\<^sub>i\<^sub>o\<^sub>n_def oid_of_ty\<^sub>F\<^sub>l\<^sub>i\<^sub>g\<^sub>h\<^sub>t_def - (* *) - S1\<^sub>S\<^sub>t\<^sub>a\<^sub>f\<^sub>f_def C1\<^sub>C\<^sub>l\<^sub>i\<^sub>e\<^sub>n\<^sub>t_def C2\<^sub>C\<^sub>l\<^sub>i\<^sub>e\<^sub>n\<^sub>t_def R11\<^sub>R\<^sub>e\<^sub>s\<^sub>e\<^sub>r\<^sub>v\<^sub>a\<^sub>t\<^sub>i\<^sub>o\<^sub>n_def R21\<^sub>R\<^sub>e\<^sub>s\<^sub>e\<^sub>r\<^sub>v\<^sub>a\<^sub>t\<^sub>i\<^sub>o\<^sub>n_def F1\<^sub>F\<^sub>l\<^sub>i\<^sub>g\<^sub>h\<^sub>t_def F2\<^sub>F\<^sub>l\<^sub>i\<^sub>g\<^sub>h\<^sub>t_def - \<sigma>\<^sub>2_object1\<^sub>C\<^sub>l\<^sub>i\<^sub>e\<^sub>n\<^sub>t_def \<sigma>\<^sub>2_object2\<^sub>C\<^sub>l\<^sub>i\<^sub>e\<^sub>n\<^sub>t_def \<sigma>\<^sub>2_object4\<^sub>R\<^sub>e\<^sub>s\<^sub>e\<^sub>r\<^sub>v\<^sub>a\<^sub>t\<^sub>i\<^sub>o\<^sub>n_def \<sigma>\<^sub>2_object7\<^sub>R\<^sub>e\<^sub>s\<^sub>e\<^sub>r\<^sub>v\<^sub>a\<^sub>t\<^sub>i\<^sub>o\<^sub>n_def) - - -(* TODO : the following low-level properties on the states @{term \<sigma>\<^sub>s\<^sub>1} ... should also - be proven automatically. This is stuff from the object and state presentation that - should be hidden away from the user. *) - -lemma F1_val_seatsATpre: "(\<sigma>\<^sub>s\<^sub>1, \<sigma>) \<Turnstile> F1 .seats@pre \<triangleq> \<guillemotleft>120\<guillemotright>" - proof(simp add: UML_Logic.foundation22 k_def ) - show "F1 .seats@pre (\<sigma>\<^sub>s\<^sub>1, \<sigma>) = \<lfloor>\<lfloor>120\<rfloor>\<rfloor>" - proof - note S1 = \<sigma>\<^sub>1[simplified state_interpretation_\<sigma>\<^sub>1_def, of "(\<sigma>\<^sub>0, \<sigma>\<^sub>0)"] - show ?thesis - apply(simp add: dot\<^sub>F\<^sub>l\<^sub>i\<^sub>g\<^sub>h\<^sub>t__seatsat_pre F1_def deref_oid\<^sub>F\<^sub>l\<^sub>i\<^sub>g\<^sub>h\<^sub>t_def in_pre_state_def - F1\<^sub>F\<^sub>l\<^sub>i\<^sub>g\<^sub>h\<^sub>t_def oid_of_ty\<^sub>F\<^sub>l\<^sub>i\<^sub>g\<^sub>h\<^sub>t_def oid8_def) - apply(subst (8) \<sigma>\<^sub>s\<^sub>1_def, simp add: state_\<sigma>\<^sub>1.\<sigma>\<^sub>1_def[OF S1], simp add: pp_oid_\<sigma>\<^sub>1_\<sigma>\<^sub>2) - apply(simp add: select\<^sub>F\<^sub>l\<^sub>i\<^sub>g\<^sub>h\<^sub>t__seats_def F1_def F1\<^sub>F\<^sub>l\<^sub>i\<^sub>g\<^sub>h\<^sub>t_def) - by(simp add: reconst_basetype_def) - qed - qed - -lemma F1_val_seatsATpre': "\<sigma>\<^sub>s\<^sub>1 \<Turnstile>\<^sub>p\<^sub>r\<^sub>e F1 .seats@pre \<triangleq> \<guillemotleft>120\<guillemotright>" -by(simp add: OclValid_at_pre_def F1_val_seatsATpre) - -lemma F2_val_seatsATpre: "(\<sigma>\<^sub>s\<^sub>1, \<sigma>) \<Turnstile> F2 .seats@pre \<triangleq> \<guillemotleft>370\<guillemotright>" - proof(simp add: UML_Logic.foundation22 k_def ) - show "F2 .seats@pre (\<sigma>\<^sub>s\<^sub>1, \<sigma>) = \<lfloor>\<lfloor>370\<rfloor>\<rfloor>" - proof - note S1 = \<sigma>\<^sub>1[simplified state_interpretation_\<sigma>\<^sub>1_def, of "(\<sigma>\<^sub>0, \<sigma>\<^sub>0)"] - show ?thesis - apply(simp add: dot\<^sub>F\<^sub>l\<^sub>i\<^sub>g\<^sub>h\<^sub>t__seatsat_pre F2_def deref_oid\<^sub>F\<^sub>l\<^sub>i\<^sub>g\<^sub>h\<^sub>t_def in_pre_state_def - F2\<^sub>F\<^sub>l\<^sub>i\<^sub>g\<^sub>h\<^sub>t_def oid_of_ty\<^sub>F\<^sub>l\<^sub>i\<^sub>g\<^sub>h\<^sub>t_def oid9_def) - apply(subst (8) \<sigma>\<^sub>s\<^sub>1_def, simp add: state_\<sigma>\<^sub>1.\<sigma>\<^sub>1_def[OF S1], simp add: pp_oid_\<sigma>\<^sub>1_\<sigma>\<^sub>2) - apply(simp add: select\<^sub>F\<^sub>l\<^sub>i\<^sub>g\<^sub>h\<^sub>t__seats_def F2_def F2\<^sub>F\<^sub>l\<^sub>i\<^sub>g\<^sub>h\<^sub>t_def) - by(simp add: reconst_basetype_def) - qed - qed - -lemma F2_val_seatsATpre': "\<sigma>\<^sub>s\<^sub>1 \<Turnstile>\<^sub>p\<^sub>r\<^sub>e F2 .seats@pre \<triangleq> \<guillemotleft>370\<guillemotright>" -by(simp add: OclValid_at_pre_def F2_val_seatsATpre) - -lemma F1_val_seats: "(\<sigma>, \<sigma>\<^sub>s\<^sub>2) \<Turnstile> F1 .seats \<triangleq> \<guillemotleft>120\<guillemotright>" -proof(simp add: UML_Logic.foundation22 k_def ) - show "F1 .seats (\<sigma>, \<sigma>\<^sub>s\<^sub>2) = \<lfloor>\<lfloor>120\<rfloor>\<rfloor>" - proof - note S2 = \<sigma>\<^sub>2[simplified state_interpretation_\<sigma>\<^sub>2_def, of "(\<sigma>\<^sub>0, \<sigma>\<^sub>0)"] - show ?thesis - apply(simp add: dot\<^sub>F\<^sub>l\<^sub>i\<^sub>g\<^sub>h\<^sub>t__seats F1_def deref_oid\<^sub>F\<^sub>l\<^sub>i\<^sub>g\<^sub>h\<^sub>t_def in_post_state_def F1\<^sub>F\<^sub>l\<^sub>i\<^sub>g\<^sub>h\<^sub>t_def - oid_of_ty\<^sub>F\<^sub>l\<^sub>i\<^sub>g\<^sub>h\<^sub>t_def oid8_def) - apply(subst (8) \<sigma>\<^sub>s\<^sub>2_def, simp add: state_\<sigma>\<^sub>2.\<sigma>\<^sub>2_def[OF S2], simp add: pp_oid_\<sigma>\<^sub>1_\<sigma>\<^sub>2) - apply(simp add: select\<^sub>F\<^sub>l\<^sub>i\<^sub>g\<^sub>h\<^sub>t__seats_def F1_def F1\<^sub>F\<^sub>l\<^sub>i\<^sub>g\<^sub>h\<^sub>t_def) - by(simp add: reconst_basetype_def) - qed -qed - -lemma F1_val_seats': "\<sigma>\<^sub>s\<^sub>2 \<Turnstile>\<^sub>p\<^sub>o\<^sub>s\<^sub>t F1 .seats \<triangleq> \<guillemotleft>120\<guillemotright>" -by(simp add: OclValid_at_post_def F1_val_seats) - -lemma F2_val_seats: "(\<sigma>, \<sigma>\<^sub>s\<^sub>2) \<Turnstile> F2 .seats \<triangleq> \<guillemotleft>370\<guillemotright>" -proof(simp add: UML_Logic.foundation22 k_def ) - show "F2 .seats (\<sigma>, \<sigma>\<^sub>s\<^sub>2) = \<lfloor>\<lfloor>370\<rfloor>\<rfloor>" - proof - note S2 = \<sigma>\<^sub>2[simplified state_interpretation_\<sigma>\<^sub>2_def, of "(\<sigma>\<^sub>0, \<sigma>\<^sub>0)"] - show ?thesis - apply(simp add: dot\<^sub>F\<^sub>l\<^sub>i\<^sub>g\<^sub>h\<^sub>t__seats F2_def deref_oid\<^sub>F\<^sub>l\<^sub>i\<^sub>g\<^sub>h\<^sub>t_def in_post_state_def F2\<^sub>F\<^sub>l\<^sub>i\<^sub>g\<^sub>h\<^sub>t_def - oid_of_ty\<^sub>F\<^sub>l\<^sub>i\<^sub>g\<^sub>h\<^sub>t_def oid9_def) - apply(subst (8) \<sigma>\<^sub>s\<^sub>2_def, simp add: state_\<sigma>\<^sub>2.\<sigma>\<^sub>2_def[OF S2], simp add: pp_oid_\<sigma>\<^sub>1_\<sigma>\<^sub>2) - apply(simp add: select\<^sub>F\<^sub>l\<^sub>i\<^sub>g\<^sub>h\<^sub>t__seats_def F2_def F2\<^sub>F\<^sub>l\<^sub>i\<^sub>g\<^sub>h\<^sub>t_def) - by(simp add: reconst_basetype_def) - qed -qed - -lemma F2_val_seats': "\<sigma>\<^sub>s\<^sub>2 \<Turnstile>\<^sub>p\<^sub>o\<^sub>s\<^sub>t F2 .seats \<triangleq> \<guillemotleft>370\<guillemotright>" -by(simp add: OclValid_at_post_def F2_val_seats) - -lemma C1_valid: "(\<sigma>\<^sub>s\<^sub>1, \<sigma>') \<Turnstile> (\<upsilon> C1)" -by(simp add: OclValid_def C1_def) - -lemma R11_val_clientATpre: "(\<sigma>\<^sub>s\<^sub>1, \<sigma>') \<Turnstile> R11 .client@pre \<triangleq> C1" - proof(simp add: foundation22) - - have C1_deref_val: "(\<sigma>\<^sub>s\<^sub>1, \<sigma>') \<Turnstile> deref_oid\<^sub>C\<^sub>l\<^sub>i\<^sub>e\<^sub>n\<^sub>t fst reconst_basetype 4 \<triangleq> C1" - proof(simp add: foundation22) - show "deref_oid\<^sub>C\<^sub>l\<^sub>i\<^sub>e\<^sub>n\<^sub>t fst reconst_basetype 4 (\<sigma>\<^sub>s\<^sub>1, \<sigma>') = C1 (\<sigma>\<^sub>s\<^sub>1, \<sigma>')" - proof - note S1 = \<sigma>\<^sub>1[simplified state_interpretation_\<sigma>\<^sub>1_def, of "(\<sigma>\<^sub>0, \<sigma>\<^sub>0)"] - show ?thesis - apply(simp add: deref_oid\<^sub>C\<^sub>l\<^sub>i\<^sub>e\<^sub>n\<^sub>t_def) - apply(subst (8) \<sigma>\<^sub>s\<^sub>1_def, simp add: state_\<sigma>\<^sub>1.\<sigma>\<^sub>1_def[OF S1], simp add: pp_oid_\<sigma>\<^sub>1_\<sigma>\<^sub>2) - by(simp add: reconst_basetype_def C1_def) - qed - qed - - have C1_val: "(\<sigma>\<^sub>s\<^sub>1, \<sigma>') \<Turnstile> \<upsilon> deref_oid\<^sub>C\<^sub>l\<^sub>i\<^sub>e\<^sub>n\<^sub>t fst reconst_basetype 4" - apply(simp add: OclValid_def) - apply(subst cp_valid) - using C1_deref_val[simplified OclValid_def StrongEq_def true_def] - by(simp, subst cp_valid[symmetric], simp add: C1_valid[simplified OclValid_def]) - - show "R11 .client@pre (\<sigma>\<^sub>s\<^sub>1, \<sigma>') = C1 (\<sigma>\<^sub>s\<^sub>1, \<sigma>')" - proof - note S1 = \<sigma>\<^sub>1[simplified state_interpretation_\<sigma>\<^sub>1_def, of "(\<sigma>\<^sub>0, \<sigma>\<^sub>0)"] - show ?thesis - apply(simp add: dot\<^sub>R\<^sub>e\<^sub>s\<^sub>e\<^sub>r\<^sub>v\<^sub>a\<^sub>t\<^sub>i\<^sub>o\<^sub>n_1___clientat_pre R11_def deref_oid\<^sub>R\<^sub>e\<^sub>s\<^sub>e\<^sub>r\<^sub>v\<^sub>a\<^sub>t\<^sub>i\<^sub>o\<^sub>n_def in_pre_state_def - R11\<^sub>R\<^sub>e\<^sub>s\<^sub>e\<^sub>r\<^sub>v\<^sub>a\<^sub>t\<^sub>i\<^sub>o\<^sub>n_def oid_of_ty\<^sub>R\<^sub>e\<^sub>s\<^sub>e\<^sub>r\<^sub>v\<^sub>a\<^sub>t\<^sub>i\<^sub>o\<^sub>n_def oid6_def) - apply(subst (8) \<sigma>\<^sub>s\<^sub>1_def, simp add: state_\<sigma>\<^sub>1.\<sigma>\<^sub>1_def[OF S1], simp add: pp_oid_\<sigma>\<^sub>1_\<sigma>\<^sub>2) - apply(simp add: deref_assocs\<^sub>R\<^sub>e\<^sub>s\<^sub>e\<^sub>r\<^sub>v\<^sub>a\<^sub>t\<^sub>i\<^sub>o\<^sub>n_1___client_def deref_assocs_def oid\<^sub>R\<^sub>e\<^sub>s\<^sub>e\<^sub>r\<^sub>v\<^sub>a\<^sub>t\<^sub>i\<^sub>o\<^sub>n_1___client_def) - apply(subst (3) \<sigma>\<^sub>s\<^sub>1_def, simp add: state_\<sigma>\<^sub>1.\<sigma>\<^sub>1_def[OF S1] map_of_list_def - oid\<^sub>C\<^sub>l\<^sub>i\<^sub>e\<^sub>n\<^sub>t_0___flights_def oid\<^sub>S\<^sub>t\<^sub>a\<^sub>f\<^sub>f_0___flights_def oid\<^sub>C\<^sub>l\<^sub>i\<^sub>e\<^sub>n\<^sub>t_0___cl_res_def) - apply(simp add: switch\<^sub>2_01_def switch\<^sub>2_10_def choose_0_def choose_1_def deref_assocs_list_def - pp_oid_\<sigma>\<^sub>1_\<sigma>\<^sub>2 R11_def R11\<^sub>R\<^sub>e\<^sub>s\<^sub>e\<^sub>r\<^sub>v\<^sub>a\<^sub>t\<^sub>i\<^sub>o\<^sub>n_def oid_of_ty\<^sub>R\<^sub>e\<^sub>s\<^sub>e\<^sub>r\<^sub>v\<^sub>a\<^sub>t\<^sub>i\<^sub>o\<^sub>n_def List.member_def) - apply(simp add: select\<^sub>R\<^sub>e\<^sub>s\<^sub>e\<^sub>r\<^sub>v\<^sub>a\<^sub>t\<^sub>i\<^sub>o\<^sub>n__client_def select_object_any\<^sub>S\<^sub>e\<^sub>t_def select_object\<^sub>S\<^sub>e\<^sub>t_def) - apply(subgoal_tac "(let s = Set{deref_oid\<^sub>C\<^sub>l\<^sub>i\<^sub>e\<^sub>n\<^sub>t fst reconst_basetype 4} in - if s->size\<^sub>S\<^sub>e\<^sub>t() \<triangleq> \<zero> then null else if s->size\<^sub>S\<^sub>e\<^sub>t() \<triangleq> \<one> then s->any\<^sub>S\<^sub>e\<^sub>t() else \<bottom> endif endif) (\<sigma>\<^sub>s\<^sub>1, \<sigma>') = C1 (\<sigma>\<^sub>s\<^sub>1, \<sigma>')") - apply(subgoal_tac "Set{deref_oid\<^sub>C\<^sub>l\<^sub>i\<^sub>e\<^sub>n\<^sub>t fst reconst_basetype 4} = - select_object Set{} UML_Set.OclIncluding id (deref_oid\<^sub>C\<^sub>l\<^sub>i\<^sub>e\<^sub>n\<^sub>t fst reconst_basetype) [4]") - apply(simp only: Let_def) - apply(simp add: select_object_def) - apply(simp only: Let_def) - apply(subst OclIf_false') - apply(rule StrongEq_L_trans_not[OF OclSize_singleton[OF C1_val]], normalization) - apply(subst cp_OclIf, subst OclSize_singleton[OF C1_val, simplified OclValid_def]) - using C1_deref_val[simplified OclValid_def StrongEq_def true_def] - by(subst cp_OclIf[symmetric], simp) - qed -qed - -subsection\<open> Annotations of the Class Model in OCL \<close> - -text\<open> Subsequently, we state a desired class invariant for $\mocl{Flight}$'s in the - usual \OCL syntax: \<close> -Context f: Flight - Inv A : "\<zero> <\<^sub>i\<^sub>n\<^sub>t (f .seats)" - Inv B : "f .fl_res ->size\<^sub>S\<^sub>e\<^sub>q() \<le>\<^sub>i\<^sub>n\<^sub>t (f .seats)" - Inv C : "f .passengers ->select\<^sub>S\<^sub>e\<^sub>t(p | p .oclIsTypeOf(Client)) - \<doteq> ((f .fl_res)->collect\<^sub>S\<^sub>e\<^sub>q(c | c .client .oclAsType(Person))->asSet\<^sub>S\<^sub>e\<^sub>q())" - -(* TODO : the following low-level properties should also - be proven automatically. *) - -definition "Flight_A\<^sub>p\<^sub>r\<^sub>e = (\<lambda>\<sigma>. \<sigma> \<Turnstile>\<^sub>p\<^sub>r\<^sub>e Flight .allInstances@pre()->forAll\<^sub>S\<^sub>e\<^sub>t(self|Flight .allInstances@pre()->forAll\<^sub>S\<^sub>e\<^sub>t(f|\<zero> <\<^sub>i\<^sub>n\<^sub>t f .seats@pre)))" -definition "Flight_A\<^sub>p\<^sub>o\<^sub>s\<^sub>t = (\<lambda>\<sigma>. \<sigma> \<Turnstile>\<^sub>p\<^sub>o\<^sub>s\<^sub>t Flight .allInstances()->forAll\<^sub>S\<^sub>e\<^sub>t(self|Flight .allInstances()->forAll\<^sub>S\<^sub>e\<^sub>t(f|\<zero> <\<^sub>i\<^sub>n\<^sub>t f .seats)))" - -(* This lemma would be highly desirable, but well ... *) -lemma Flight_A_prepost_transfer: "Flight_Aat_pre (\<sigma>, \<sigma>') = Flight_A (\<sigma>'', \<sigma>)" -oops - -lemma Flight_A_prepost_transfer' : "Flight_A\<^sub>p\<^sub>o\<^sub>s\<^sub>t = Flight_A\<^sub>p\<^sub>r\<^sub>e" -unfolding Flight_A\<^sub>p\<^sub>r\<^sub>e_def Flight_A\<^sub>p\<^sub>o\<^sub>s\<^sub>t_def OclValid_at_pre_def OclValid_at_post_def -apply(rule ext, auto) -apply(erule_tac x="\<sigma>" in allE) -prefer 2 -apply(erule_tac x="\<sigma>" in allE) -oops - -subsection\<open> Model Analysis: A satisfiability proof of the invariants \<close> - -text\<open> We wish to analyse our class model and show that the entire set of invariants can -be satisfied, \ie{} there exist legal states that satisfy all constraints imposed -by the class invariants. \<close> - - -lemma Flight_consistent: "\<exists> \<tau>. Flight_Aat_pre \<tau> \<and> Flight_A \<tau>" -proof (rule_tac x="(\<sigma>\<^sub>t\<^sub>1, \<sigma>\<^sub>t\<^sub>2)" in exI, rule conjI) - txt\<open> The following auxiliary fact establishes that @{thm OclForall_body_trivial} from the - library is applicable since @{term "OclAsType\<^sub>F\<^sub>l\<^sub>i\<^sub>g\<^sub>h\<^sub>t_\<AA> .allInstances@pre()"} - is indeed defined. \<close> - have forall_trivial: "\<And>\<tau> P. let S = OclAsType\<^sub>F\<^sub>l\<^sub>i\<^sub>g\<^sub>h\<^sub>t_\<AA> .allInstances@pre() in - (\<tau> \<Turnstile> (S->forAll\<^sub>S\<^sub>e\<^sub>t(X|P) \<triangleq> (S \<triangleq> Set{} or P)))" - unfolding Let_def by(rule OclForall_body_trivial, rule OclAllInstances_at_pre_defined) - show "Flight_Aat_pre (\<sigma>\<^sub>t\<^sub>1, \<sigma>\<^sub>t\<^sub>2)" - proof - - have *: "(\<sigma>\<^sub>t\<^sub>1, \<sigma>\<^sub>t\<^sub>2) \<Turnstile> (\<zero> <\<^sub>i\<^sub>n\<^sub>t (F1 .seats@pre))" - apply(subst UML_Logic.StrongEq_L_subst3_rev[OF F1_val_seatsATpre, - simplified \<sigma>\<^sub>t\<^sub>1_\<sigma>\<^sub>s\<^sub>1[symmetric]],simp) - by(simp add: OclInt0') - have **: "(\<sigma>\<^sub>t\<^sub>1, \<sigma>\<^sub>t\<^sub>2) \<Turnstile> (\<zero> <\<^sub>i\<^sub>n\<^sub>t (F2 .seats@pre))" - apply(subst UML_Logic.StrongEq_L_subst3_rev[OF F2_val_seatsATpre, - simplified \<sigma>\<^sub>t\<^sub>1_\<sigma>\<^sub>s\<^sub>1[symmetric]],simp) - by(simp add: OclInt0') - - txt\<open> Now we calculate: \<close> - - have "((\<sigma>\<^sub>t\<^sub>1, \<sigma>\<^sub>t\<^sub>2) \<Turnstile> Flight .allInstances@pre()->forAll\<^sub>S\<^sub>e\<^sub>t(self| - Flight .allInstances@pre()->forAll\<^sub>S\<^sub>e\<^sub>t(f|\<zero> <\<^sub>i\<^sub>n\<^sub>t f .seats@pre))) = - ((\<sigma>\<^sub>t\<^sub>1, \<sigma>\<^sub>t\<^sub>2) \<Turnstile> Flight .allInstances@pre() \<triangleq> Set{} or - Flight .allInstances@pre()->forAll\<^sub>S\<^sub>e\<^sub>t(f| \<zero> <\<^sub>i\<^sub>n\<^sub>t f .seats@pre))" - by(simp add: StrongEq_L_subst3[OF _ forall_trivial[simplified Let_def], - where P = "\<lambda>x. x"]) - also - have "... = ((\<sigma>\<^sub>t\<^sub>1, \<sigma>\<^sub>t\<^sub>2) \<Turnstile> ((Set{F1, F2} \<triangleq> Set{}) or - (Set{F1, F2}->forAll\<^sub>S\<^sub>e\<^sub>t(f| \<zero> <\<^sub>i\<^sub>n\<^sub>t f .seats@pre))))" - unfolding Flight_def - apply(subst StrongEq_L_subst3[where x="OclAsType\<^sub>F\<^sub>l\<^sub>i\<^sub>g\<^sub>h\<^sub>t_\<AA> .allInstances@pre()"], - simp, simp add: \<sigma>\<^sub>t\<^sub>1_def \<sigma>\<^sub>t\<^sub>1_\<sigma>\<^sub>s\<^sub>1[simplified \<sigma>\<^sub>t\<^sub>1_def \<sigma>\<^sub>s\<^sub>1_def]) - apply(rule StrictRefEq\<^sub>S\<^sub>e\<^sub>t.StrictRefEq_vs_StrongEq' - [THEN iffD1, OF _ _ state_\<sigma>\<^sub>1.\<sigma>\<^sub>1_OclAllInstances_at_pre_exec_Flight - [OF \<sigma>\<^sub>1[simplified state_interpretation_\<sigma>\<^sub>1_def], - simplified Flight_def]]) - apply(rule OclAllInstances_at_pre_valid) - apply(simp add: F1_def F2_def) - by(simp add: OclAsType\<^sub>F\<^sub>l\<^sub>i\<^sub>g\<^sub>h\<^sub>t_\<AA>_def)+ - also - have "... = ((\<sigma>\<^sub>t\<^sub>1, \<sigma>\<^sub>t\<^sub>2) \<Turnstile> Set{F1, F2} \<triangleq> Set{} or - (\<zero> <\<^sub>i\<^sub>n\<^sub>t (F2 .seats@pre)) and (\<zero> <\<^sub>i\<^sub>n\<^sub>t (F1 .seats@pre)))" - apply(simp, simp add: OclValid_def, subst (1 2) cp_OclOr, - subst cp_OclIf, subst (1 2 3) cp_OclAnd, subst cp_OclIf) - by(simp add: F1_def F2_def OclIf_def) - also - have "... = True" - by(simp,rule foundation25', simp add: foundation10' * ** ) - finally show ?thesis - unfolding Flight_Aat_pre_def by simp - qed -next - txt\<open> Analogously for the first part, the following auxiliary fact establishes - that @{thm OclForall_body_trivial} from the library is applicable since - @{term "OclAsType\<^sub>F\<^sub>l\<^sub>i\<^sub>g\<^sub>h\<^sub>t_\<AA> .allInstances()"} is indeed defined. \<close> - have forall_trivial: "\<And>\<tau> P. let S = OclAsType\<^sub>F\<^sub>l\<^sub>i\<^sub>g\<^sub>h\<^sub>t_\<AA> .allInstances() in - (\<tau> \<Turnstile> (S->forAll\<^sub>S\<^sub>e\<^sub>t(X|P) \<triangleq> (S \<triangleq> Set{} or P)))" - by(simp add: Let_def, rule OclForall_body_trivial, rule OclAllInstances_at_post_defined) - show "Flight_A (\<sigma>\<^sub>t\<^sub>1, \<sigma>\<^sub>t\<^sub>2)" - proof - - have *: "(\<sigma>\<^sub>t\<^sub>1, \<sigma>\<^sub>t\<^sub>2) \<Turnstile> \<zero> <\<^sub>i\<^sub>n\<^sub>t F1 .seats" - apply(subst UML_Logic.StrongEq_L_subst3_rev[OF F1_val_seats, - simplified \<sigma>\<^sub>t\<^sub>2_\<sigma>\<^sub>s\<^sub>2[symmetric]],simp) - by(simp add: OclInt0') - have**: "(\<sigma>\<^sub>t\<^sub>1, \<sigma>\<^sub>t\<^sub>2) \<Turnstile> \<zero> <\<^sub>i\<^sub>n\<^sub>t F2 .seats" - apply(subst UML_Logic.StrongEq_L_subst3_rev[OF F2_val_seats, - simplified \<sigma>\<^sub>t\<^sub>2_\<sigma>\<^sub>s\<^sub>2[symmetric]],simp) - by(simp add: OclInt0') - have "((\<sigma>\<^sub>t\<^sub>1, \<sigma>\<^sub>t\<^sub>2) \<Turnstile> Flight .allInstances()->forAll\<^sub>S\<^sub>e\<^sub>t(self| - Flight .allInstances()->forAll\<^sub>S\<^sub>e\<^sub>t(f|\<zero> <\<^sub>i\<^sub>n\<^sub>t f .seats))) = - ((\<sigma>\<^sub>t\<^sub>1, \<sigma>\<^sub>t\<^sub>2) \<Turnstile> Flight .allInstances() \<triangleq> Set{} or - Flight .allInstances()->forAll\<^sub>S\<^sub>e\<^sub>t(f| \<zero> <\<^sub>i\<^sub>n\<^sub>t f .seats))" - by(simp add: StrongEq_L_subst3[OF _ forall_trivial[simplified Let_def], - where P = "\<lambda>x. x"]) - also - have " ... = ((\<sigma>\<^sub>t\<^sub>1, \<sigma>\<^sub>t\<^sub>2) \<Turnstile> Set{F1,F2} \<triangleq> Set{} or - Set{F1,F2}->forAll\<^sub>S\<^sub>e\<^sub>t(f| \<zero> <\<^sub>i\<^sub>n\<^sub>t f .seats))" - unfolding Flight_def - apply(subst StrongEq_L_subst3[where x = "OclAsType\<^sub>F\<^sub>l\<^sub>i\<^sub>g\<^sub>h\<^sub>t_\<AA> .allInstances()"], - simp, simp add: \<sigma>\<^sub>t\<^sub>2_def \<sigma>\<^sub>t\<^sub>2_\<sigma>\<^sub>s\<^sub>2[simplified \<sigma>\<^sub>t\<^sub>2_def \<sigma>\<^sub>s\<^sub>2_def]) - apply(rule StrictRefEq\<^sub>S\<^sub>e\<^sub>t.StrictRefEq_vs_StrongEq' - [THEN iffD1, OF _ _ state_\<sigma>\<^sub>2.\<sigma>\<^sub>2_OclAllInstances_at_post_exec_Flight - [OF \<sigma>\<^sub>2[simplified state_interpretation_\<sigma>\<^sub>2_def], - simplified Flight_def]]) - apply(rule OclAllInstances_at_post_valid) - apply(simp add: F1_def F2_def) - by(simp add: OclAsType\<^sub>F\<^sub>l\<^sub>i\<^sub>g\<^sub>h\<^sub>t_\<AA>_def)+ - also - have "... = ((\<sigma>\<^sub>t\<^sub>1, \<sigma>\<^sub>t\<^sub>2) \<Turnstile> Set{F1, F2} \<triangleq> Set{} or - (\<zero> <\<^sub>i\<^sub>n\<^sub>t (F2 .seats)) and (\<zero> <\<^sub>i\<^sub>n\<^sub>t (F1 .seats)))" - apply(simp, simp add: OclValid_def, subst (1 2) cp_OclOr, - subst cp_OclIf, subst (1 2 3) cp_OclAnd, subst cp_OclIf) - by(simp add: F1_def F2_def OclIf_def) - also - have "... = True" - by(simp,rule foundation25', simp add: foundation10' * ** ) - finally show ?thesis - unfolding Flight_A_def by simp - qed -qed - -lemma Flight_consistent': "(\<exists> \<sigma>\<^sub>p\<^sub>r\<^sub>e. Flight_A\<^sub>p\<^sub>r\<^sub>e \<sigma>\<^sub>p\<^sub>r\<^sub>e) \<and> (\<exists> \<sigma>\<^sub>p\<^sub>o\<^sub>s\<^sub>t. Flight_A\<^sub>p\<^sub>o\<^sub>s\<^sub>t \<sigma>\<^sub>p\<^sub>o\<^sub>s\<^sub>t)" -oops - -Context r: Reservation - Inv A : "\<zero> <\<^sub>i\<^sub>n\<^sub>t (r .id)" - Inv B : "r .next <> null implies (r .flight .to \<doteq> r .next .flight .from)" - Inv C : "r .next <> null implies (r .client \<doteq> r .next .client)" - - -Context Client :: book (f : Flight) - Pre : "f .passengers ->excludes\<^sub>S\<^sub>e\<^sub>t(self .oclAsType(Person)) - and (f .fl_res ->size\<^sub>S\<^sub>e\<^sub>q() <\<^sub>i\<^sub>n\<^sub>t (f .seats))" - Post: "f .passengers \<doteq> (f .passengers@pre ->including\<^sub>S\<^sub>e\<^sub>t(self .oclAsType(Person))) - and (let r = self .cl_res ->select\<^sub>S\<^sub>e\<^sub>t(r | r .flight \<doteq> f)->any\<^sub>S\<^sub>e\<^sub>t() in - (r .oclIsNew()) - and (r .prev \<doteq> null) - and (r .next \<doteq> null))" - -Context Client :: booknext (f : Flight, r : Reservation) - Pre : "f .passengers ->excludes\<^sub>S\<^sub>e\<^sub>t(self .oclAsType(Person)) - and (f .fl_res ->size\<^sub>S\<^sub>e\<^sub>q() <\<^sub>i\<^sub>n\<^sub>t (f .seats)) - and (r .client \<doteq> self) - and (f .from \<doteq> (r .flight .to))" - Post: "f .passengers \<doteq> (f .passengers@pre ->including\<^sub>S\<^sub>e\<^sub>t(self .oclAsType(Person))) - and (let r = self .cl_res ->select\<^sub>S\<^sub>e\<^sub>t(r | r .flight \<doteq> f)->any\<^sub>S\<^sub>e\<^sub>t() in - (r .oclIsNew()) - and (r .prev \<doteq> r) - and (r .next \<doteq> null))" - - -Context Client :: cancel (r : Reservation) - Pre : "r .client \<doteq> self" - Post: "self .cl_res ->select\<^sub>S\<^sub>e\<^sub>t(res | res .flight \<doteq> r .flight@pre) - ->isEmpty\<^sub>S\<^sub>e\<^sub>t()" - -(* example for a recursive query *) -Context Reservation :: connections () : Set(Integer) - Post : "result \<triangleq> if (self .next \<doteq> null) - then (Set{}->including\<^sub>S\<^sub>e\<^sub>t(self .id)) - else (self .next .connections()->including\<^sub>S\<^sub>e\<^sub>t(self .id)) - endif" - Pre : "true" - -subsection\<open> Proving the Implementability of Operations \<close> -text\<open> An operation contract is said to be non-blocking, if and only if there exist input and input - states where the pre-condition is satisfied. - Moreover, a contract is said to be implementable, if and only if for all inputs satisfying the - pre-condition output data exists that satisfies the post-condition. -\<close> - - -definition cancel\<^sub>p\<^sub>r\<^sub>e :: "(\<cdot>Client) \<Rightarrow> (\<cdot>Reservation) \<Rightarrow> \<cdot>Boolean\<^sub>b\<^sub>a\<^sub>s\<^sub>e" -where "cancel\<^sub>p\<^sub>r\<^sub>e self r \<equiv> (r .client@pre) \<doteq> self" - -definition cancel\<^sub>p\<^sub>o\<^sub>s\<^sub>t :: "(\<cdot>Client) \<Rightarrow> (\<cdot>Reservation) \<Rightarrow> (\<cdot>Void\<^sub>b\<^sub>a\<^sub>s\<^sub>e) \<Rightarrow> \<cdot>Boolean\<^sub>b\<^sub>a\<^sub>s\<^sub>e" -where "cancel\<^sub>p\<^sub>o\<^sub>s\<^sub>t self r result \<equiv> self .cl_res->select\<^sub>S\<^sub>e\<^sub>t(res|res .flight \<doteq> r .flight@pre)->isEmpty\<^sub>S\<^sub>e\<^sub>t()" - -lemma cancel\<^sub>n\<^sub>o\<^sub>n\<^sub>b\<^sub>l\<^sub>o\<^sub>c\<^sub>k\<^sub>i\<^sub>n\<^sub>g : "\<exists> self r \<sigma>. (\<sigma>, \<sigma>') \<Turnstile> (cancel\<^sub>p\<^sub>r\<^sub>e self r)" - apply(rule exI[where x = "C1"], rule exI[where x = "R11"], rule exI[where x = "\<sigma>\<^sub>t\<^sub>1"]) - using R11_val_clientATpre[simplified OclValid_def StrongEq_def true_def \<sigma>\<^sub>t\<^sub>1_\<sigma>\<^sub>s\<^sub>1[symmetric], of \<sigma>'] - apply(simp add: cancel\<^sub>p\<^sub>r\<^sub>e_def StrictRefEq\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_\<^sub>R\<^sub>e\<^sub>s\<^sub>e\<^sub>r\<^sub>v\<^sub>a\<^sub>t\<^sub>i\<^sub>o\<^sub>n StrictRefEq\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_def OclValid_def) -by(subst cp_valid, simp, subst cp_valid[symmetric], - simp add: C1_valid[simplified OclValid_def \<sigma>\<^sub>t\<^sub>1_\<sigma>\<^sub>s\<^sub>1[symmetric]]) - -lemma cancel\<^sub>n\<^sub>o\<^sub>n\<^sub>b\<^sub>l\<^sub>o\<^sub>c\<^sub>k\<^sub>i\<^sub>n\<^sub>g_\<^sub>p\<^sub>r\<^sub>e : "\<exists> self r \<sigma>. \<sigma> \<Turnstile>\<^sub>p\<^sub>r\<^sub>e (cancel\<^sub>p\<^sub>r\<^sub>e self r)" - apply(rule exI[where x = "C1"], rule exI[where x = "R11"], rule exI[where x = "\<sigma>\<^sub>t\<^sub>1"]) - apply(simp add: OclValid_at_pre_def, intro allI) - proof - fix \<sigma>' show "(\<sigma>\<^sub>t\<^sub>1, \<sigma>') \<Turnstile> cancel\<^sub>p\<^sub>r\<^sub>e C1 R11" - using R11_val_clientATpre[simplified OclValid_def StrongEq_def true_def \<sigma>\<^sub>t\<^sub>1_\<sigma>\<^sub>s\<^sub>1[symmetric], of \<sigma>'] - apply(simp add: cancel\<^sub>p\<^sub>r\<^sub>e_def StrictRefEq\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_\<^sub>R\<^sub>e\<^sub>s\<^sub>e\<^sub>r\<^sub>v\<^sub>a\<^sub>t\<^sub>i\<^sub>o\<^sub>n StrictRefEq\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_def OclValid_at_pre_def OclValid_def) - by(subst cp_valid, simp, subst cp_valid[symmetric], - simp add: C1_valid[simplified OclValid_def \<sigma>\<^sub>t\<^sub>1_\<sigma>\<^sub>s\<^sub>1[symmetric]]) -qed - -lemma cancel\<^sub>i\<^sub>m\<^sub>p\<^sub>l\<^sub>e\<^sub>m\<^sub>e\<^sub>n\<^sub>t\<^sub>a\<^sub>b\<^sub>l\<^sub>e : - assumes pre_satisfied: "\<sigma> \<Turnstile>\<^sub>p\<^sub>r\<^sub>e (cancel\<^sub>p\<^sub>r\<^sub>e self r)" - shows "\<exists> \<sigma>' result. ((\<sigma>, \<sigma>') \<Turnstile> \<delta> self) \<longrightarrow> - ((\<sigma>, \<sigma>') \<Turnstile> \<upsilon> r) \<longrightarrow> - ((\<sigma>, \<sigma>') \<Turnstile> (cancel\<^sub>p\<^sub>o\<^sub>s\<^sub>t self r result))" -proof - - define \<sigma>'' where "\<sigma>'' \<equiv> \<lparr> heap = K \<lfloor>in\<^sub>C\<^sub>l\<^sub>i\<^sub>e\<^sub>n\<^sub>t (mk\<^sub>C\<^sub>l\<^sub>i\<^sub>e\<^sub>n\<^sub>t (mk\<E>\<X>\<T>\<^sub>C\<^sub>l\<^sub>i\<^sub>e\<^sub>n\<^sub>t 0 None) None)\<rfloor> - , assocs = Map.empty (oid\<^sub>C\<^sub>l\<^sub>i\<^sub>e\<^sub>n\<^sub>t_0___cl_res \<mapsto> []) \<rparr>" - - have self_definition: "\<And>\<tau>. \<tau> \<Turnstile> \<delta> self \<Longrightarrow> \<exists>ta xa x. self \<tau> = \<lfloor>\<lfloor>mk\<^sub>C\<^sub>l\<^sub>i\<^sub>e\<^sub>n\<^sub>t (mk\<E>\<X>\<T>\<^sub>C\<^sub>l\<^sub>i\<^sub>e\<^sub>n\<^sub>t ta xa) x\<rfloor>\<rfloor>" - apply(simp add:OclValid_def defined_def true_def false_def split: if_split_asm) - proof - fix \<tau> show "self \<tau> \<noteq> \<bottom> \<tau> \<and> self \<tau> \<noteq> null \<tau> \<Longrightarrow> - \<exists>ta xa x. self \<tau> = \<lfloor>\<lfloor>mk\<^sub>C\<^sub>l\<^sub>i\<^sub>e\<^sub>n\<^sub>t (mk\<E>\<X>\<T>\<^sub>C\<^sub>l\<^sub>i\<^sub>e\<^sub>n\<^sub>t ta xa) x\<rfloor>\<rfloor>" - apply(case_tac "self \<tau>", simp add: bot_option_def bot_fun_def, simp) - proof - fix a show "\<lfloor>a\<rfloor> \<noteq> \<bottom> \<tau> \<and> \<lfloor>a\<rfloor> \<noteq> null \<tau> \<Longrightarrow> - self \<tau> = \<lfloor>a\<rfloor> \<Longrightarrow> \<exists>ta xa x. a = \<lfloor>mk\<^sub>C\<^sub>l\<^sub>i\<^sub>e\<^sub>n\<^sub>t (mk\<E>\<X>\<T>\<^sub>C\<^sub>l\<^sub>i\<^sub>e\<^sub>n\<^sub>t ta xa) x\<rfloor>" - apply(case_tac "a", simp add: null_fun_def null_option_def bot_option_def, simp) - proof - fix aa show " \<lfloor>\<lfloor>aa\<rfloor>\<rfloor> \<noteq> \<bottom> \<tau> \<and> \<lfloor>\<lfloor>aa\<rfloor>\<rfloor> \<noteq> null \<tau> \<Longrightarrow> - self \<tau> = \<lfloor>\<lfloor>aa\<rfloor>\<rfloor> \<Longrightarrow> - a = \<lfloor>aa\<rfloor> \<Longrightarrow> \<exists>ta xa x. aa = mk\<^sub>C\<^sub>l\<^sub>i\<^sub>e\<^sub>n\<^sub>t (mk\<E>\<X>\<T>\<^sub>C\<^sub>l\<^sub>i\<^sub>e\<^sub>n\<^sub>t ta xa) x" - apply(case_tac aa, simp) - proof - fix x1 x2 show " self \<tau> = \<lfloor>\<lfloor>mk\<^sub>C\<^sub>l\<^sub>i\<^sub>e\<^sub>n\<^sub>t x1 x2\<rfloor>\<rfloor> \<Longrightarrow> \<exists>ta xa. x1 = mk\<E>\<X>\<T>\<^sub>C\<^sub>l\<^sub>i\<^sub>e\<^sub>n\<^sub>t ta xa" - by(case_tac x1, simp) - qed qed qed qed - - have self_empty: "(\<sigma>, \<sigma>'') \<Turnstile> \<delta> self \<Longrightarrow> (\<sigma>, \<sigma>'') \<Turnstile> (self .cl_res \<triangleq> Set{})" - apply(drule self_definition, elim exE) - apply(simp add: OclValid_def StrongEq_def dot\<^sub>C\<^sub>l\<^sub>i\<^sub>e\<^sub>n\<^sub>t_0___cl_res) - apply(simp add: deref_oid\<^sub>C\<^sub>l\<^sub>i\<^sub>e\<^sub>n\<^sub>t_def in_post_state_def, subst (8) \<sigma>''_def) - apply(simp add: Let_def K_def oid_of_option_def deref_assocs\<^sub>C\<^sub>l\<^sub>i\<^sub>e\<^sub>n\<^sub>t_0___cl_res_def deref_assocs_def) - apply(subst (3) \<sigma>''_def, simp add: select\<^sub>C\<^sub>l\<^sub>i\<^sub>e\<^sub>n\<^sub>t__cl_res_def) - by(simp add: oid_of_ty\<^sub>C\<^sub>l\<^sub>i\<^sub>e\<^sub>n\<^sub>t_def deref_assocs_list_def switch\<^sub>2_01_def select_object\<^sub>S\<^sub>e\<^sub>t_def select_object_def) - - show "?thesis" - apply(rule exI[where x = \<sigma>''], rule exI[where x = "null"], intro impI) - apply(simp add: cancel\<^sub>p\<^sub>o\<^sub>s\<^sub>t_def) - apply(subst StrongEq_L_subst3[OF _ self_empty]) - apply(rule UML_Set.cp_intro''\<^sub>S\<^sub>e\<^sub>t(2)) - apply(simp only: cp_def) - apply(rule exI[where x = "\<lambda>X \<tau>. (\<lambda>_. X)->select\<^sub>S\<^sub>e\<^sub>t(res|StrictRefEq\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t res .flight r .flight@pre) \<tau>"], - subst cp_OclSelect, simp) - by(simp+) -qed -text\<open> As remark, the pre-condition @{term "\<sigma> \<Turnstile>\<^sub>p\<^sub>r\<^sub>e (cancel\<^sub>p\<^sub>r\<^sub>e self r)"} has not been used; - in the special case of the -operation ``cancel'', the post-condition is satisfiable for \<^emph>\<open>arbitrary\<close> defined and valid input, -even input that does not satisfy the pre-condition. \<close> - - -lemmas [simp,code_unfold] = dot_accessor - -end diff --git a/Citadelle/examples/LinkedList.thy b/Citadelle/examples/LinkedList.thy deleted file mode 100644 index 4f0e392f4cb1347a2db075e9df4aa1ff15e54221..0000000000000000000000000000000000000000 --- a/Citadelle/examples/LinkedList.thy +++ /dev/null @@ -1,104 +0,0 @@ -(****************************************************************************** - * 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. - ******************************************************************************) - -(* - * OCL Contracts and Example drawn from - * "A Specification-Based Test Case Generation Method for UML/OCL" - * (Brucker, Krieger, Longuet, and Wolff) - *) - -chapter{* Example: Linked List *} - -theory - LinkedList -imports - FOCL.UML_OCL -begin - -generation_syntax [ shallow ] - -section{* The Class Model *} - -Class Node - Attributes i : Integer - "next" : Node -End - -Class List - Attributes content : Node -End! - -section{* ... and its Annotation by OCL Constraints *} - -Context Node - Inv asc : "self .next <> null implies (self .i \<le>\<^sub>i\<^sub>n\<^sub>t self .next .i) " - Inv pos : "\<zero> \<le>\<^sub>i\<^sub>n\<^sub>t (self .i)" - -Context Node :: contents() : Set(Integer) - Post : "result \<triangleq> if (self .next \<doteq> null) - then (Set{}->including\<^sub>S\<^sub>e\<^sub>t(self .i)) - else (self .next .contents() ->including\<^sub>S\<^sub>e\<^sub>t(self .i)) - endif" - -Context List :: insert(x:Integer) : Void - Post : "if (self .content \<doteq> null) - then self .content .contents() \<triangleq> Set{x} - else self .content .contents() \<triangleq> (self .content@pre .contents@pre()) - endif" - -section{* Instances and States of the Class Model *} - -Instance n1 :: Node = [ i = 2, "next" = n2 ] - and n2 :: Node = [ i = 5, "next" = null ] - and n3 :: Node = [ i = 3, "next" = n2 ] - and l1 :: List = [ content = n1 ] - - -State \<sigma>\<^sub>1 = [ n1, n2, l1 ] -State \<sigma>\<^sub>1' = [ ([ n1 with_only i = 2, "next" = n3 ] :: Node), n2, n3, l1 ] - -Transition \<sigma>\<^sub>1 \<sigma>\<^sub>1' - -section{* Proof of State-Consistency and Implementability of ``insert'' *} - -lemmas [simp,code_unfold] = dot_accessor - -end diff --git a/Citadelle/examples/ListRefinement.thy b/Citadelle/examples/ListRefinement.thy deleted file mode 100644 index d5ada0527efcd196a28f33bbcd4c24749a5ccac7..0000000000000000000000000000000000000000 --- a/Citadelle/examples/ListRefinement.thy +++ /dev/null @@ -1,57 +0,0 @@ -(****************************************************************************** - * 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 ListRefinement -imports LinkedList AbstractList -begin - -text{* Since both imported theories generate syntax for \verb$.content$, we have to disactivate - one of the two notations in order to avoid syntactic ambiguities; the original internal name - remains as alternative. *} -no_notation LinkedList.dot__content ("(_) .content") - -term "X .content" - -term "LinkedList.dot__content X" - -end \ No newline at end of file diff --git a/Citadelle/examples/archive/Flight_Model_compact.thy b/Citadelle/examples/archive/Flight_Model_compact.thy deleted file mode 100644 index 0dca21775e05872eb952756af93588edad79b356..0000000000000000000000000000000000000000 --- a/Citadelle/examples/archive/Flight_Model_compact.thy +++ /dev/null @@ -1,580 +0,0 @@ -(****************************************************************************** - * 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. - ******************************************************************************) - -theory - Flight_Model_compact -imports - FOCL.UML_OCL -begin - -subsection\<open> Class Model \<close> - -text\<open>This part corresponds to the writing in Isabelle of the -code shown in \autoref{fig:code-data}.\<close> - -Class Flight - Attributes - seats : Integer - "from" : String - to : String -End - -lemma "id = (\<lambda>x. x)" -by (rule id_def) -text\<open>As remark, we are checking for example that the constant @{term id} already exists, -and that one can also use this name in the following attribute: -no conflict will happen.\<close> - -Class Reservation - Attributes - id : Integer - date : Week -End - -Class Person - Attributes - name : String -End - -Class Client < Person - Attributes - address : String -End - -Class Staff < Person -End - -Association passengers - Between Person [*] - Role passengers - Flight [*] - Role flights -End - -Aggregation flights - Between Flight [1] - Role flight - Reservation [*] - Role fl_res Sequence_ -End - -Association reservations - Between Client [1] - Role client - Reservation [*] - Role cl_res -End - -Association connection - Between Reservation [0 \<bullet>\<bullet> 1] - Role "next" - Reservation [0 \<bullet>\<bullet> 1] - Role prev -End - -text\<open> In complement to \autoref{fig:code-data}, we define an enumeration type.\<close> -Enum Week - [ Mon, Tue, Wed, Thu, Fri, Sat, Sun ] -End! - -(* -(* Illustration of a wrong model transition: *) -Instance R00 :: Reservation = [ id = 00, flight = [ F1 ], "next" = R11 ] - and R11 :: Reservation = [ id = 11, flight = [ F1, F2 ], "next" = R00 ] - and R22 :: Reservation = [ id = 22, "next" = [ R00, R11, R22 ] ] - and F1 :: Flight = [ seats = 120, "from" = "Valencia", to = "Miami" ] - and F2 :: Flight = [ seats = 370, "from" = "Miami", to = "Ottawa" ] -(* -R00 .flight = Set{ F1 } -R00 .client = Set{} // minimum constraint [1] not satisfied -R00 .prev = Set{ R11 , R22 } // maximum constraint [0 .. 1] not satisfied -R00 .next = Set{ R11 } -R11 .flight = Set{ F1 , F2 } // maximum constraint [1] not satisfied -R11 .client = Set{} // minimum constraint [1] not satisfied -R11 .prev = Set{ R00 , R22 } // maximum constraint [0 .. 1] not satisfied -R11 .next = Set{ R00 } -R22 .flight = Set{} // minimum constraint [1] not satisfied -R22 .client = Set{} // minimum constraint [1] not satisfied -R22 .prev = Set{ R22 } -R22 .next = Set{ R00 , R11 , R22 } // maximum constraint [0 .. 1] not satisfied -F1 .passengers = Set{} -F1 .fl_res = Set{ R00 , R11 } -F2 .passengers = Set{} -F2 .fl_res = Set{ R11 } -8 error(s) in multiplicity constraints -*) -*) - -subsection\<open> Two State Instances of the Class Model \<close> - -text\<open> The creation of (typed) object instances is performed in \HOCL -with the command $\Instance$: \<close> -Instance S1 :: Staff = [ name = "Merlin" , flights = F1 ] - and C1 :: Client = [ name = "Bertha" , address = "Miami" , flights = F1 , cl_res = R11 ] - and C2 :: Client = [ name = "Arthur" , address = "Valencia" , flights = F1 , cl_res = R21 ] - and R11 :: Reservation = [ id = 12345 , flight = F1 , date = Mon ] - and R21 :: Reservation = [ id = 98765 , flight = F1 ] - and F1 :: Flight = [ seats = 120 , "from" = "Valencia" , to = "Miami" ] - and F2 :: Flight = [ seats = 370 , "from" = "Miami" , to = "Ottawa" ] -text\<open> -The notion of object instances comes before that of states. -Currently, we have only created the object instances @{const S1}, -@{const C1}, @{const C2}, @{const R11}, @{const R21}, @{const F1} and @{const F2}. -They will need to be ``registered'' in a state later. -$\Instance$ verifies that all objects being created - are respecting the multiplicities declared above in classes (in the bidirectional sense). -For example, after the type-checking stage, we have -correctly that @{term "R21 .client"} \<open>\<cong>\<close> @{term "Set{ C2 }"}, since @{const R21} appears as one reservation of -@{const C2}, and where ``\<open>X \<cong> Y\<close>'' -stands as a synonym for @{term "\<forall>\<tau>. (\<tau> \<Turnstile> \<delta> X) \<longrightarrow> (\<tau> \<Turnstile> \<delta> Y) \<longrightarrow> (\<tau> \<Turnstile> (X \<triangleq> Y))"}.\footnotemark -As remark, the order of attributes and objects -declarations is not important: mutually recursive constructions become -de-facto supported. As illustration, we can include here the text displayed in the output window after evaluating -the above $\Instance$ -(we have manually pasted the text from the output window in Isabelle/jEdit): -@{text [display] \<open> -S1 .flights \<cong> Set{ F1 } -C1 .flights \<cong> Set{ F1 } -C1 .cl_res \<cong> Set{ R11 } -C2 .flights \<cong> Set{ F1 } -C2 .cl_res \<cong> Set{ R21 } -R11 .flight \<cong> Set{ F1 } -R11 .client \<cong> Set{ C1 } -R11 .prev \<cong> Set{} -R11 .next \<cong> Set{} -R21 .flight \<cong> Set{ F1 } -R21 .client \<cong> Set{ C2 } -R21 .prev \<cong> Set{} -R21 .next \<cong> Set{} -F1 .passengers \<cong> Set{ S1 , C1 , C2 } -F1 .fl_res \<cong> Set{ R11 , R21 } -F2 .passengers \<cong> Set{} -F2 .fl_res \<cong> Set{} -\<close>} -\<close> -text_raw\<open>\footnotetext{ -Although such rule schemata may be explicitly generated by $\Instance$ (for most \OCL expressions), -they can also not be: -at the time of writing, the complete type-checking process is at least -fully executed from an extracted \HOL function -(as one consequence, the type-checking process terminates). -This is feasible because for the moment, $\Instance$ only accepts ``grounds objects'' -as arguments (the reader is referred to its syntax diagram detailed in \autoref{app:oltg-rail}).}\<close> - -text\<open> We can check that @{const S1} indeed exists and has the expected \OCL type. \<close> -term "S1 ::\<cdot> Staff" - -text\<open> Once objects are constructed with $\Instance$, it becomes possible to -regroup them together into a state. This is what the next command $\State$ is doing by creating -a state named \<open>\<sigma>\<^sub>1\<close>, corresponding to the pre-state of \autoref{fig:system-states}.\<close> -State \<sigma>\<^sub>1 = [ S1, C1, C2, R11, R21, F1, F2 ] - -text\<open> -This generates a number of theorems from it, \eg: -@{text [display] \<open> -\<And>\<sigma>. (\<sigma>\<^sub>1, \<sigma>) \<Turnstile> Staff .allInstances@pre() \<triangleq> Set{S1} -\<And>\<sigma>. (\<sigma>\<^sub>1, \<sigma>) \<Turnstile> Client .allInstances@pre() \<triangleq> Set{C1,C2} -\<And>\<sigma>. (\<sigma>\<^sub>1, \<sigma>) \<Turnstile> Reservation .allInstances@pre() \<triangleq> Set{R11,R12} -\<And>\<sigma>. (\<sigma>\<^sub>1, \<sigma>) \<Turnstile> Flight .allInstances@pre() \<triangleq> Set{F1,F2} -\<close>} - -At this point, it is not yet sure that @{text \<sigma>\<^sub>1} will be used in the pre-state or post-state. -In any case, the above command also generates the following symmetric lemmas: -@{text [display] \<open> -\<And>\<sigma>. (\<sigma>, \<sigma>\<^sub>1) \<Turnstile> Staff .allInstances() \<triangleq> Set{S1} -\<And>\<sigma>. (\<sigma>, \<sigma>\<^sub>1) \<Turnstile> Client .allInstances() \<triangleq> Set{C1,C2} -\<And>\<sigma>. (\<sigma>, \<sigma>\<^sub>1) \<Turnstile> Reservation .allInstances() \<triangleq> Set{R11,R12} -\<And>\<sigma>. (\<sigma>, \<sigma>\<^sub>1) \<Turnstile> Flight .allInstances() \<triangleq> Set{F1,F2} -\<close>} - -Because all these lemmas are stated under the precondition that all object instances are -defined entities, lemmas generated by $\State$ are actually proved in a particular -$\holoclthykeywordstyle\operatorname{locale}$~\cite{DBLP:journals/jar/Ballarin14,isabelle-locale} \<open>state_\<sigma>\<^sub>1\<close>. -Thus the header of \<open>state_\<sigma>\<^sub>1\<close> regroups these (mandatory) definedness assumptions, -that have to be all satisfied before being able to use the rules defined in its body. -\<close> - -text\<open> The next statement illustrates \autoref{sec:focl-front-end}. It -shows for instance that object instances can also be generated -by $\State$ on the fly. Fresh variables are created meanwhile if needed, like \<open>\<sigma>\<^sub>2_object1\<close>.\<close> -State \<sigma>\<^sub>2 = - [ S1 - , ([ C1 with_only name = "Bertha", address = "Saint-Malo" , flights = F1 , cl_res = R11 ] :: Client) - , ([ C2 with_only name = "Arthur",address = "Valencia",flights=[F1,F2],cl_res=[self 4,self 7]]::Client) - , R11 - , ([ R21 with_only id = 98765 , flight = F1 , "next" = self 7] :: Reservation) - , F1 - , F2 - , ([ id = 19283 , flight = F2 ] :: Reservation) ] -text\<open> -Similarly as with $\Instance$, we can paste in the following what is currently being -displayed in the output window (where ``\<open>/*8*/\<close>'' means the object having an $\oid$ equal to -8).\footnotemark -@{text [display] \<open> -\<sigma>\<^sub>2_object1 .flights \<cong> Set{ /*8*/ } -\<sigma>\<^sub>2_object1 .cl_res \<cong> Set{ /*6*/ } -\<sigma>\<^sub>2_object2 .flights \<cong> Set{ /*8*/ , /*9*/ } -\<sigma>\<^sub>2_object2 .cl_res \<cong> Set{ \<sigma>\<^sub>2_object4 , \<sigma>\<^sub>2_object7 } -\<sigma>\<^sub>2_object4 .flight \<cong> Set{ /*8*/ } -\<sigma>\<^sub>2_object4 .client \<cong> Set{ \<sigma>\<^sub>2_object2 } -\<sigma>\<^sub>2_object4 .prev \<cong> Set{} -\<sigma>\<^sub>2_object4 .next \<cong> Set{ \<sigma>\<^sub>2_object7 } -\<sigma>\<^sub>2_object7 .flight \<cong> Set{ /*9*/ } -\<sigma>\<^sub>2_object7 .client \<cong> Set{ \<sigma>\<^sub>2_object2 } -\<sigma>\<^sub>2_object7 .prev \<cong> Set{ \<sigma>\<^sub>2_object4 } -\<sigma>\<^sub>2_object7 .next \<cong> Set{} -\<close>} - -Note that there is a mechanism to reference objects via the (invented) keyword -$\greenkeywordstyle\operatorname{self}$ (it has no particular relation -with the one used in \autoref{sec:focl-front-end}), -which takes a number designating the index of a particular object instance occurring -in the list of declarations (the index starts with 0 as first position). - -Similarly as for \<open>state_\<sigma>\<^sub>1\<close>, we obtain another $\holoclthykeywordstyle\operatorname{locale}$ -called \<open>state_\<sigma>\<^sub>2\<close>, representing the post-state of \autoref{fig:system-states}. -\<close> -text_raw\<open>\footnotetext{As future work, it is plan for $\Instance$ to support the writing of -arbitrary \OCL expressions, including the assignment of potentially infinite collection types -(for example ``a set of sequence of bag of objects''). -In particular, besides the cardinality of the manipulated collection types, -the sole information required for checking multiplicities -appears to be the $\oid$ of objects.}\<close> - -text\<open> The $\Transition$ command relates the two states together. \<close> -Transition \<sigma>\<^sub>1 \<sigma>\<^sub>2 -text\<open> -The first state is intended to be understood as the pre-state, -and the second state as the post-state. In particular, we do not obtain similar proved theorems -if we write \<^theory_text>\<open>Transition \<sigma>\<^sub>1 \<sigma>\<^sub>2\<close> or \<^theory_text>\<open>Transition \<sigma>\<^sub>2 \<sigma>\<^sub>1\<close> (assuming \<open>\<sigma>\<^sub>1\<close> and \<open>\<sigma>\<^sub>2\<close> -are different). Generally, $\Transition$ establishes for a pair of a pre- and a post state -(i.e. a state transition) that a number of -crucial properties are satisfied. -For instance, the well-formedness of the two given states is proven: \<open>WFF(\<sigma>\<^sub>1, \<sigma>\<^sub>2)\<close>. - -Furthermore, for each object \<open>X\<close> additional lemmas are generated to situate \<open>X\<close> -as an object existing in \<open>\<sigma>\<^sub>1\<close>, \<open>\<sigma>\<^sub>2\<close>, both, or in any permutations of -\<open>\<sigma>\<^sub>1\<close> and \<open>\<sigma>\<^sub>2\<close>. -Such lemmas typically resemble as: - \<^item> \<open>(\<sigma>\<^sub>1, \<sigma>\<^sub>2) \<Turnstile> X .oclIsNew()\<close>, or - \<^item> \<open>(\<sigma>\<^sub>1, \<sigma>\<^sub>2) \<Turnstile> X .oclIsDeleted()\<close>, or - \<^item> \<open>(\<sigma>\<^sub>1, \<sigma>\<^sub>2) \<Turnstile> X .oclIsAbsent()\<close>, or - \<^item> \<open>(\<sigma>\<^sub>1, \<sigma>\<^sub>2) \<Turnstile> X .oclIsMaintained()\<close> - -where the latter only means that the $\oid$ of \<open>X\<close> exists both in \<open>\<sigma>\<^sub>1\<close> and -\<open>\<sigma>\<^sub>2\<close>, in particular the values of the attribute fields of \<open>X\<close> have also not changed. - -As completeness property, we can state the following lemma covering all disjunction case -(for any \<open>X\<close> and -\<open>\<tau>\<close>)~\cite{brucker.ea:featherweight:2014}: @{thm state_split} - -Finally $\Transition$ proceeds as $\State$: it builds a new -$\holoclthykeywordstyle\operatorname{locale}$, called \<open>transition_\<sigma>\<^sub>1_\<sigma>\<^sub>2\<close>, - by particularly instantiating the two locales -\<open>state_\<sigma>\<^sub>1\<close> and \<open>state_\<sigma>\<^sub>2\<close>. -\<close> - -locale TRANSITION_\<sigma>\<^sub>1_\<sigma>\<^sub>2 -begin -lemma \<sigma>\<^sub>1: "state_interpretation_\<sigma>\<^sub>1 \<tau>" -by(simp add: state_interpretation_\<sigma>\<^sub>1_def, - standard, - simp add: pp_oid_\<sigma>\<^sub>1_\<sigma>\<^sub>2, - (simp add: pp_object_\<sigma>\<^sub>1_\<sigma>\<^sub>2)+) - -text\<open> This instance proof goes analogously. \<close> - -lemma \<sigma>\<^sub>2: "state_interpretation_\<sigma>\<^sub>2 \<tau>" -by(simp add: state_interpretation_\<sigma>\<^sub>2_def, - standard, - simp add: pp_oid_\<sigma>\<^sub>1_\<sigma>\<^sub>2, - (simp add: pp_object_\<sigma>\<^sub>1_\<sigma>\<^sub>2)+) - -text\<open> The latter proof gives access to the locale \<open>transition_\<sigma>\<^sub>1_\<sigma>\<^sub>2\<close>. \<close> - -lemma \<sigma>\<^sub>1_\<sigma>\<^sub>2: "pp_\<sigma>\<^sub>1_\<sigma>\<^sub>2 \<tau>" -by(simp add: pp_\<sigma>\<^sub>1_\<sigma>\<^sub>2_def, - standard, - simp add: pp_oid_\<sigma>\<^sub>1_\<sigma>\<^sub>2, - (simp add: pp_object_\<sigma>\<^sub>1_\<sigma>\<^sub>2)+, - (simp add: pp_oid_\<sigma>\<^sub>1_\<sigma>\<^sub>2)+) - - -text\<open> For convenience, one can introduce the empty state here \<close> -definition \<sigma>\<^sub>0 :: "\<AA> state" where "\<sigma>\<^sub>0 = state.make Map.empty Map.empty" - -text\<open> so that the following abbreviations can be written \<close> -definition "\<sigma>\<^sub>t\<^sub>1 = transition_\<sigma>\<^sub>1_\<sigma>\<^sub>2.\<sigma>\<^sub>1 oid3 oid4 oid5 oid6 oid7 oid8 oid9 - \<lceil>\<lceil>S1 (\<sigma>\<^sub>0, \<sigma>\<^sub>0)\<rceil>\<rceil> \<lceil>\<lceil>C1 (\<sigma>\<^sub>0, \<sigma>\<^sub>0)\<rceil>\<rceil> \<lceil>\<lceil>C2 (\<sigma>\<^sub>0, \<sigma>\<^sub>0)\<rceil>\<rceil> \<lceil>\<lceil>R11 (\<sigma>\<^sub>0, \<sigma>\<^sub>0)\<rceil>\<rceil> - \<lceil>\<lceil>R21 (\<sigma>\<^sub>0, \<sigma>\<^sub>0)\<rceil>\<rceil> \<lceil>\<lceil>F1 (\<sigma>\<^sub>0, \<sigma>\<^sub>0)\<rceil>\<rceil> \<lceil>\<lceil>F2 (\<sigma>\<^sub>0, \<sigma>\<^sub>0)\<rceil>\<rceil>" - -definition "\<sigma>\<^sub>t\<^sub>2 = transition_\<sigma>\<^sub>1_\<sigma>\<^sub>2.\<sigma>\<^sub>2 oid3 oid4 oid5 oid6 oid7 oid8 oid9 oid10 - \<lceil>\<lceil>S1 (\<sigma>\<^sub>0, \<sigma>\<^sub>0)\<rceil>\<rceil> \<lceil>\<lceil>\<sigma>\<^sub>2_object1 (\<sigma>\<^sub>0, \<sigma>\<^sub>0)\<rceil>\<rceil> \<lceil>\<lceil>\<sigma>\<^sub>2_object2 (\<sigma>\<^sub>0, \<sigma>\<^sub>0)\<rceil>\<rceil> \<lceil>\<lceil>R11 (\<sigma>\<^sub>0, \<sigma>\<^sub>0)\<rceil>\<rceil> - \<lceil>\<lceil>\<sigma>\<^sub>2_object4 (\<sigma>\<^sub>0, \<sigma>\<^sub>0)\<rceil>\<rceil> \<lceil>\<lceil>F1 (\<sigma>\<^sub>0, \<sigma>\<^sub>0)\<rceil>\<rceil> \<lceil>\<lceil>F2 (\<sigma>\<^sub>0, \<sigma>\<^sub>0)\<rceil>\<rceil> - \<lceil>\<lceil>\<sigma>\<^sub>2_object7 (\<sigma>\<^sub>0, \<sigma>\<^sub>0)\<rceil>\<rceil>" - -definition "\<sigma>\<^sub>s\<^sub>1 = state_\<sigma>\<^sub>1.\<sigma>\<^sub>1 oid3 oid4 oid5 oid6 oid7 oid8 oid9 - \<lceil>\<lceil>S1 (\<sigma>\<^sub>0, \<sigma>\<^sub>0)\<rceil>\<rceil> \<lceil>\<lceil>C1 (\<sigma>\<^sub>0, \<sigma>\<^sub>0)\<rceil>\<rceil> \<lceil>\<lceil>C2 (\<sigma>\<^sub>0, \<sigma>\<^sub>0)\<rceil>\<rceil> \<lceil>\<lceil>R11 (\<sigma>\<^sub>0, \<sigma>\<^sub>0)\<rceil>\<rceil> - \<lceil>\<lceil>R21 (\<sigma>\<^sub>0, \<sigma>\<^sub>0)\<rceil>\<rceil> \<lceil>\<lceil>F1 (\<sigma>\<^sub>0, \<sigma>\<^sub>0)\<rceil>\<rceil> \<lceil>\<lceil>F2 (\<sigma>\<^sub>0, \<sigma>\<^sub>0)\<rceil>\<rceil>" - -definition "\<sigma>\<^sub>s\<^sub>2 = state_\<sigma>\<^sub>2.\<sigma>\<^sub>2 oid3 oid4 oid5 oid6 oid7 oid8 oid9 oid10 - \<lceil>\<lceil>S1 (\<sigma>\<^sub>0, \<sigma>\<^sub>0)\<rceil>\<rceil> \<lceil>\<lceil>\<sigma>\<^sub>2_object1 (\<sigma>\<^sub>0, \<sigma>\<^sub>0)\<rceil>\<rceil> \<lceil>\<lceil>\<sigma>\<^sub>2_object2 (\<sigma>\<^sub>0, \<sigma>\<^sub>0)\<rceil>\<rceil> \<lceil>\<lceil>R11 (\<sigma>\<^sub>0, \<sigma>\<^sub>0)\<rceil>\<rceil> - \<lceil>\<lceil>\<sigma>\<^sub>2_object4 (\<sigma>\<^sub>0, \<sigma>\<^sub>0)\<rceil>\<rceil> \<lceil>\<lceil>F1 (\<sigma>\<^sub>0, \<sigma>\<^sub>0)\<rceil>\<rceil> \<lceil>\<lceil>F2 (\<sigma>\<^sub>0, \<sigma>\<^sub>0)\<rceil>\<rceil> - \<lceil>\<lceil>\<sigma>\<^sub>2_object7 (\<sigma>\<^sub>0, \<sigma>\<^sub>0)\<rceil>\<rceil>" - -text\<open> Both formats are, fortunately, equivalent; this means that for these states, we -can access properties from both state and transition locales, in which the -object representations are ``wired'' in the same way. \<close> - -lemma \<sigma>\<^sub>t\<^sub>1_\<sigma>\<^sub>s\<^sub>1: "\<sigma>\<^sub>t\<^sub>1 = \<sigma>\<^sub>s\<^sub>1" -unfolding \<sigma>\<^sub>t\<^sub>1_def \<sigma>\<^sub>s\<^sub>1_def - apply(subst transition_\<sigma>\<^sub>1_\<sigma>\<^sub>2.\<sigma>\<^sub>1_def) -by(rule \<sigma>\<^sub>1_\<sigma>\<^sub>2[simplified pp_\<sigma>\<^sub>1_\<sigma>\<^sub>2_def], simp) - - -lemma \<sigma>\<^sub>t\<^sub>2_\<sigma>\<^sub>s\<^sub>2: "\<sigma>\<^sub>t\<^sub>2 = \<sigma>\<^sub>s\<^sub>2" -unfolding \<sigma>\<^sub>t\<^sub>2_def \<sigma>\<^sub>s\<^sub>2_def - apply(subst transition_\<sigma>\<^sub>1_\<sigma>\<^sub>2.\<sigma>\<^sub>2_def) -by(rule \<sigma>\<^sub>1_\<sigma>\<^sub>2[simplified pp_\<sigma>\<^sub>1_\<sigma>\<^sub>2_def], simp) - - -text\<open> The next lemma becomes a shortcut of the one generated by $\Transition$, - but explicitly instantiated. \<close> - -(* TODO : this should be done at the level of states, not transitions... *) -lemma "WFF (\<sigma>\<^sub>t\<^sub>1, \<sigma>\<^sub>t\<^sub>2)" -unfolding \<sigma>\<^sub>t\<^sub>1_\<sigma>\<^sub>s\<^sub>1 \<sigma>\<^sub>t\<^sub>2_\<sigma>\<^sub>s\<^sub>2 \<sigma>\<^sub>s\<^sub>1_def \<sigma>\<^sub>s\<^sub>2_def - apply(rule transition_\<sigma>\<^sub>1_\<sigma>\<^sub>2.basic_\<sigma>\<^sub>1_\<sigma>\<^sub>2_wff) - apply(rule \<sigma>\<^sub>1_\<sigma>\<^sub>2[simplified pp_\<sigma>\<^sub>1_\<sigma>\<^sub>2_def]) -by(simp_all add: pp_oid_\<sigma>\<^sub>1_\<sigma>\<^sub>2 pp_object_\<sigma>\<^sub>1_\<sigma>\<^sub>2 - (* *) - oid_of_\<AA>_def oid_of_ty\<^sub>S\<^sub>t\<^sub>a\<^sub>f\<^sub>f_def oid_of_ty\<^sub>C\<^sub>l\<^sub>i\<^sub>e\<^sub>n\<^sub>t_def oid_of_ty\<^sub>R\<^sub>e\<^sub>s\<^sub>e\<^sub>r\<^sub>v\<^sub>a\<^sub>t\<^sub>i\<^sub>o\<^sub>n_def oid_of_ty\<^sub>F\<^sub>l\<^sub>i\<^sub>g\<^sub>h\<^sub>t_def - (* *) - S1\<^sub>S\<^sub>t\<^sub>a\<^sub>f\<^sub>f_def C1\<^sub>C\<^sub>l\<^sub>i\<^sub>e\<^sub>n\<^sub>t_def C2\<^sub>C\<^sub>l\<^sub>i\<^sub>e\<^sub>n\<^sub>t_def R11\<^sub>R\<^sub>e\<^sub>s\<^sub>e\<^sub>r\<^sub>v\<^sub>a\<^sub>t\<^sub>i\<^sub>o\<^sub>n_def R21\<^sub>R\<^sub>e\<^sub>s\<^sub>e\<^sub>r\<^sub>v\<^sub>a\<^sub>t\<^sub>i\<^sub>o\<^sub>n_def F1\<^sub>F\<^sub>l\<^sub>i\<^sub>g\<^sub>h\<^sub>t_def F2\<^sub>F\<^sub>l\<^sub>i\<^sub>g\<^sub>h\<^sub>t_def - \<sigma>\<^sub>2_object1\<^sub>C\<^sub>l\<^sub>i\<^sub>e\<^sub>n\<^sub>t_def \<sigma>\<^sub>2_object2\<^sub>C\<^sub>l\<^sub>i\<^sub>e\<^sub>n\<^sub>t_def \<sigma>\<^sub>2_object4\<^sub>R\<^sub>e\<^sub>s\<^sub>e\<^sub>r\<^sub>v\<^sub>a\<^sub>t\<^sub>i\<^sub>o\<^sub>n_def \<sigma>\<^sub>2_object7\<^sub>R\<^sub>e\<^sub>s\<^sub>e\<^sub>r\<^sub>v\<^sub>a\<^sub>t\<^sub>i\<^sub>o\<^sub>n_def) - -end - - -section{* Annotations of the Class Model in OCL *} - -text{* Subsequently, we state a desired class invariant for \verb$Flight$'s in the usual -OCL syntax: *} -Context f: Flight - Inv A : "\<zero> <\<^sub>i\<^sub>n\<^sub>t (f .seats)" - Inv B : "f .fl_res ->size\<^sub>S\<^sub>e\<^sub>q() \<le>\<^sub>i\<^sub>n\<^sub>t (f .seats)" - Inv C : "f .passengers ->select\<^sub>S\<^sub>e\<^sub>t(p | p .oclIsTypeOf(Client)) - \<doteq> ((f .fl_res)->collect\<^sub>S\<^sub>e\<^sub>q(c | c .client .oclAsType(Person))->asSet\<^sub>S\<^sub>e\<^sub>q())" - - - -section{* Model Analysis I: A satisfiability proof of the invariants. *} - -text{* We wish to analyse our class model and show that the entire set of invariants can -be satisfied, \ie{} there exists legal states that satisfy all constraints imposed -by the class invariants. *} - -context transition_\<sigma>\<^sub>1_\<sigma>\<^sub>2 -begin - -lemma Flight_at_pre_sat: "let \<tau> = (\<sigma>\<^sub>1,\<sigma>\<^sub>2) in - (\<tau> \<Turnstile> (\<zero> <\<^sub>i\<^sub>n\<^sub>t (F1 .seats@pre))) \<longrightarrow> - (\<tau> \<Turnstile> (\<zero> <\<^sub>i\<^sub>n\<^sub>t (F2 .seats@pre))) \<longrightarrow> - Flight_Aat_pre \<tau>" -proof - - have forall_trivial: "\<And>\<tau> P. let S = OclAsType\<^sub>F\<^sub>l\<^sub>i\<^sub>g\<^sub>h\<^sub>t_\<AA> .allInstances@pre() in - (\<tau> \<Turnstile> (S->forAll\<^sub>S\<^sub>e\<^sub>t(X|P) \<triangleq> (S \<triangleq> Set{} or P)))" - by(simp add: Let_def, rule OclForall_body_trivial, rule OclAllInstances_at_pre_defined) - show ?thesis - apply(simp add: Let_def, intro impI) - apply(simp add: Flight_Aat_pre_def StrongEq_L_subst3[OF _ forall_trivial[simplified Let_def], where P = "\<lambda>x. x"]) - apply(subst StrongEq_L_subst3[where x = "OclAsType\<^sub>F\<^sub>l\<^sub>i\<^sub>g\<^sub>h\<^sub>t_\<AA> .allInstances@pre()"], simp, simp add: \<sigma>\<^sub>1_def) - apply(rule StrictRefEq\<^sub>S\<^sub>e\<^sub>t.StrictRefEq_vs_StrongEq'[THEN iffD1, OF _ _ state_\<sigma>\<^sub>1.\<sigma>\<^sub>1_OclAllInstances_at_pre_exec_Flight[OF \<sigma>\<^sub>1, simplified Flight_def]]) - apply(rule OclAllInstances_at_pre_valid) - apply(simp add: F1_def F2_def) - apply(simp add: OclAsType\<^sub>F\<^sub>l\<^sub>i\<^sub>g\<^sub>h\<^sub>t_\<AA>_def)+ - apply(simp add: OclValid_def, subst cp_OclOr, subst cp_OclIf, subst (1 2) cp_OclAnd, subst cp_OclIf) - by(simp add: F1_def F2_def OclIf_def, fold true_def, simp add: OclOr_true2) -qed - -lemma Flight_at_pre_sat': "\<exists> \<tau>. - (\<tau> \<Turnstile> (\<zero> <\<^sub>i\<^sub>n\<^sub>t (F1 .seats@pre))) \<longrightarrow> - (\<tau> \<Turnstile> (\<zero> <\<^sub>i\<^sub>n\<^sub>t (F2 .seats@pre))) \<longrightarrow> - Flight_Aat_pre \<tau>" -by(rule exI[where x = "(\<sigma>\<^sub>1,\<sigma>\<^sub>2)"], rule Flight_at_pre_sat[simplified Let_def]) - -lemma Flight_at_post_sat: "let \<tau> = (\<sigma>\<^sub>1,\<sigma>\<^sub>2) in - (\<tau> \<Turnstile> (\<zero> <\<^sub>i\<^sub>n\<^sub>t (F1 .seats))) \<longrightarrow> - (\<tau> \<Turnstile> (\<zero> <\<^sub>i\<^sub>n\<^sub>t (F2 .seats))) \<longrightarrow> - Flight_A \<tau>" -proof - - have forall_trivial: "\<And>\<tau> P. let S = OclAsType\<^sub>F\<^sub>l\<^sub>i\<^sub>g\<^sub>h\<^sub>t_\<AA> .allInstances() in - (\<tau> \<Turnstile> (S->forAll\<^sub>S\<^sub>e\<^sub>t(X|P) \<triangleq> (S \<triangleq> Set{} or P)))" - by(simp add: Let_def, rule OclForall_body_trivial, rule OclAllInstances_at_post_defined) - show ?thesis - apply(simp add: Let_def, intro impI) - apply(simp add: Flight_A_def StrongEq_L_subst3[OF _ forall_trivial[simplified Let_def], where P = "\<lambda>x. x"]) - apply(subst StrongEq_L_subst3[where x = "OclAsType\<^sub>F\<^sub>l\<^sub>i\<^sub>g\<^sub>h\<^sub>t_\<AA> .allInstances()"], simp, simp add: \<sigma>\<^sub>2_def) - apply(rule StrictRefEq\<^sub>S\<^sub>e\<^sub>t.StrictRefEq_vs_StrongEq'[THEN iffD1, OF _ _ state_\<sigma>\<^sub>2.\<sigma>\<^sub>2_OclAllInstances_at_post_exec_Flight[OF \<sigma>\<^sub>2, simplified Flight_def]]) - apply(rule OclAllInstances_at_post_valid) - apply(simp add: F1_def F2_def) - apply(simp add: OclAsType\<^sub>F\<^sub>l\<^sub>i\<^sub>g\<^sub>h\<^sub>t_\<AA>_def)+ - apply(simp add: OclValid_def, subst cp_OclOr, subst cp_OclIf, subst (1 2) cp_OclAnd, subst cp_OclIf) - by(simp add: F1_def F2_def OclIf_def, fold true_def, simp add: OclOr_true2) -qed - -lemma Flight_at_post_sat': "\<exists> \<tau>. - (\<tau> \<Turnstile> (\<zero> <\<^sub>i\<^sub>n\<^sub>t (F1 .seats))) \<longrightarrow> - (\<tau> \<Turnstile> (\<zero> <\<^sub>i\<^sub>n\<^sub>t (F2 .seats))) \<longrightarrow> - Flight_A \<tau>" -by(rule exI[where x = "(\<sigma>\<^sub>1,\<sigma>\<^sub>2)"], rule Flight_at_post_sat[simplified Let_def]) - -end - -context TRANSITION_\<sigma>\<^sub>1_\<sigma>\<^sub>2 -begin -lemma Flight_at_pre_sat: "\<exists> \<tau>. Flight_Aat_pre \<tau>" -proof - - note S1 = \<sigma>\<^sub>1[simplified state_interpretation_\<sigma>\<^sub>1_def, of "(\<sigma>\<^sub>0,\<sigma>\<^sub>0)"] - note PP = \<sigma>\<^sub>1_\<sigma>\<^sub>2[of "(\<sigma>\<^sub>0,\<sigma>\<^sub>0)", simplified pp_\<sigma>\<^sub>1_\<sigma>\<^sub>2_def] - - have F1_val: "F1 .seats@pre (\<sigma>\<^sub>s\<^sub>1, \<sigma>\<^sub>s\<^sub>2) = (\<lambda>_. \<lfloor>\<lfloor>120\<rfloor>\<rfloor>) (\<sigma>\<^sub>s\<^sub>1, \<sigma>\<^sub>s\<^sub>2)" - apply(simp add: dot\<^sub>F\<^sub>l\<^sub>i\<^sub>g\<^sub>h\<^sub>t__seatsat_pre F1_def deref_oid\<^sub>F\<^sub>l\<^sub>i\<^sub>g\<^sub>h\<^sub>t_def in_pre_state_def F1\<^sub>F\<^sub>l\<^sub>i\<^sub>g\<^sub>h\<^sub>t_def oid_of_ty\<^sub>F\<^sub>l\<^sub>i\<^sub>g\<^sub>h\<^sub>t_def oid8_def) - apply(subst (8) \<sigma>\<^sub>s\<^sub>1_def, simp add: state_\<sigma>\<^sub>1.\<sigma>\<^sub>1_def[OF S1], simp add: pp_oid_\<sigma>\<^sub>1_\<sigma>\<^sub>2) - apply(simp add: select\<^sub>F\<^sub>l\<^sub>i\<^sub>g\<^sub>h\<^sub>t__seats_def F1_def F1\<^sub>F\<^sub>l\<^sub>i\<^sub>g\<^sub>h\<^sub>t_def) - by(simp add: reconst_basetype_def) - - have F2_val: "F2 .seats@pre (\<sigma>\<^sub>s\<^sub>1, \<sigma>\<^sub>s\<^sub>2) = (\<lambda>_. \<lfloor>\<lfloor>370\<rfloor>\<rfloor>) (\<sigma>\<^sub>s\<^sub>1, \<sigma>\<^sub>s\<^sub>2)" - apply(simp add: dot\<^sub>F\<^sub>l\<^sub>i\<^sub>g\<^sub>h\<^sub>t__seatsat_pre F2_def deref_oid\<^sub>F\<^sub>l\<^sub>i\<^sub>g\<^sub>h\<^sub>t_def in_pre_state_def F2\<^sub>F\<^sub>l\<^sub>i\<^sub>g\<^sub>h\<^sub>t_def oid_of_ty\<^sub>F\<^sub>l\<^sub>i\<^sub>g\<^sub>h\<^sub>t_def oid9_def) - apply(subst (8) \<sigma>\<^sub>s\<^sub>1_def, simp add: state_\<sigma>\<^sub>1.\<sigma>\<^sub>1_def[OF S1], simp add: pp_oid_\<sigma>\<^sub>1_\<sigma>\<^sub>2) - apply(simp add: select\<^sub>F\<^sub>l\<^sub>i\<^sub>g\<^sub>h\<^sub>t__seats_def F2_def F2\<^sub>F\<^sub>l\<^sub>i\<^sub>g\<^sub>h\<^sub>t_def) - by(simp add: reconst_basetype_def) - - show ?thesis - apply(rule exI[where x = "(\<sigma>\<^sub>t\<^sub>1,\<sigma>\<^sub>t\<^sub>2)"], simp add: \<sigma>\<^sub>t\<^sub>1_def \<sigma>\<^sub>t\<^sub>2_def) - apply(rule transition_\<sigma>\<^sub>1_\<sigma>\<^sub>2.Flight_at_pre_sat[OF PP, simplified Let_def, THEN mp, THEN mp]) - apply(simp add: transition_\<sigma>\<^sub>1_\<sigma>\<^sub>2.\<sigma>\<^sub>1_def[OF PP] transition_\<sigma>\<^sub>1_\<sigma>\<^sub>2.\<sigma>\<^sub>2_def[OF PP], fold \<sigma>\<^sub>s\<^sub>1_def, fold \<sigma>\<^sub>s\<^sub>2_def) - apply(simp add: OclValid_def) - apply(subst OclLess\<^sub>I\<^sub>n\<^sub>t\<^sub>e\<^sub>g\<^sub>e\<^sub>r.cp0, simp add: F1_val OclInt0_def OclLess\<^sub>I\<^sub>n\<^sub>t\<^sub>e\<^sub>g\<^sub>e\<^sub>r_def) - - apply(simp add: transition_\<sigma>\<^sub>1_\<sigma>\<^sub>2.\<sigma>\<^sub>1_def[OF PP] transition_\<sigma>\<^sub>1_\<sigma>\<^sub>2.\<sigma>\<^sub>2_def[OF PP], fold \<sigma>\<^sub>s\<^sub>1_def, fold \<sigma>\<^sub>s\<^sub>2_def) - apply(simp add: OclValid_def) - apply(subst OclLess\<^sub>I\<^sub>n\<^sub>t\<^sub>e\<^sub>g\<^sub>e\<^sub>r.cp0, simp add: F2_val OclInt0_def OclLess\<^sub>I\<^sub>n\<^sub>t\<^sub>e\<^sub>g\<^sub>e\<^sub>r_def) - done -qed - -lemma Flight_at_post_sat: "\<exists> \<tau>. Flight_A \<tau>" -proof - - note S2 = \<sigma>\<^sub>2[simplified state_interpretation_\<sigma>\<^sub>2_def, of "(\<sigma>\<^sub>0,\<sigma>\<^sub>0)"] - note PP = \<sigma>\<^sub>1_\<sigma>\<^sub>2[of "(\<sigma>\<^sub>0,\<sigma>\<^sub>0)", simplified pp_\<sigma>\<^sub>1_\<sigma>\<^sub>2_def] - - have F1_val: "F1 .seats (\<sigma>\<^sub>s\<^sub>1, \<sigma>\<^sub>s\<^sub>2) = (\<lambda>_. \<lfloor>\<lfloor>120\<rfloor>\<rfloor>) (\<sigma>\<^sub>s\<^sub>1, \<sigma>\<^sub>s\<^sub>2)" - apply(simp add: dot\<^sub>F\<^sub>l\<^sub>i\<^sub>g\<^sub>h\<^sub>t__seats F1_def deref_oid\<^sub>F\<^sub>l\<^sub>i\<^sub>g\<^sub>h\<^sub>t_def in_post_state_def F1\<^sub>F\<^sub>l\<^sub>i\<^sub>g\<^sub>h\<^sub>t_def oid_of_ty\<^sub>F\<^sub>l\<^sub>i\<^sub>g\<^sub>h\<^sub>t_def oid8_def) - apply(subst (8) \<sigma>\<^sub>s\<^sub>2_def, simp add: state_\<sigma>\<^sub>2.\<sigma>\<^sub>2_def[OF S2], simp add: pp_oid_\<sigma>\<^sub>1_\<sigma>\<^sub>2) - apply(simp add: select\<^sub>F\<^sub>l\<^sub>i\<^sub>g\<^sub>h\<^sub>t__seats_def F1_def F1\<^sub>F\<^sub>l\<^sub>i\<^sub>g\<^sub>h\<^sub>t_def) - by(simp add: reconst_basetype_def) - - have F2_val: "F2 .seats (\<sigma>\<^sub>s\<^sub>1, \<sigma>\<^sub>s\<^sub>2) = (\<lambda>_. \<lfloor>\<lfloor>370\<rfloor>\<rfloor>) (\<sigma>\<^sub>s\<^sub>1, \<sigma>\<^sub>s\<^sub>2)" - apply(simp add: dot\<^sub>F\<^sub>l\<^sub>i\<^sub>g\<^sub>h\<^sub>t__seats F2_def deref_oid\<^sub>F\<^sub>l\<^sub>i\<^sub>g\<^sub>h\<^sub>t_def in_post_state_def F2\<^sub>F\<^sub>l\<^sub>i\<^sub>g\<^sub>h\<^sub>t_def oid_of_ty\<^sub>F\<^sub>l\<^sub>i\<^sub>g\<^sub>h\<^sub>t_def oid8_def) - apply(subst (8) \<sigma>\<^sub>s\<^sub>2_def, simp add: state_\<sigma>\<^sub>2.\<sigma>\<^sub>2_def[OF S2], simp add: pp_oid_\<sigma>\<^sub>1_\<sigma>\<^sub>2) - apply(simp add: select\<^sub>F\<^sub>l\<^sub>i\<^sub>g\<^sub>h\<^sub>t__seats_def F2_def F2\<^sub>F\<^sub>l\<^sub>i\<^sub>g\<^sub>h\<^sub>t_def) - by(simp add: reconst_basetype_def) - - show ?thesis - apply(rule exI[where x = "(\<sigma>\<^sub>t\<^sub>1,\<sigma>\<^sub>t\<^sub>2)"], simp add: \<sigma>\<^sub>t\<^sub>1_def \<sigma>\<^sub>t\<^sub>2_def) - apply(rule transition_\<sigma>\<^sub>1_\<sigma>\<^sub>2.Flight_at_post_sat[OF PP, simplified Let_def, THEN mp, THEN mp]) - apply(simp add: transition_\<sigma>\<^sub>1_\<sigma>\<^sub>2.\<sigma>\<^sub>1_def[OF PP] transition_\<sigma>\<^sub>1_\<sigma>\<^sub>2.\<sigma>\<^sub>2_def[OF PP], fold \<sigma>\<^sub>s\<^sub>1_def, fold \<sigma>\<^sub>s\<^sub>2_def) - apply(simp add: OclValid_def) - apply(subst OclLess\<^sub>I\<^sub>n\<^sub>t\<^sub>e\<^sub>g\<^sub>e\<^sub>r.cp0, simp add: F1_val OclInt0_def OclLess\<^sub>I\<^sub>n\<^sub>t\<^sub>e\<^sub>g\<^sub>e\<^sub>r_def) - - apply(simp add: transition_\<sigma>\<^sub>1_\<sigma>\<^sub>2.\<sigma>\<^sub>1_def[OF PP] transition_\<sigma>\<^sub>1_\<sigma>\<^sub>2.\<sigma>\<^sub>2_def[OF PP], fold \<sigma>\<^sub>s\<^sub>1_def, fold \<sigma>\<^sub>s\<^sub>2_def) - apply(simp add: OclValid_def) - apply(subst OclLess\<^sub>I\<^sub>n\<^sub>t\<^sub>e\<^sub>g\<^sub>e\<^sub>r.cp0, simp add: F2_val OclInt0_def OclLess\<^sub>I\<^sub>n\<^sub>t\<^sub>e\<^sub>g\<^sub>e\<^sub>r_def) - done -qed -end - -thm TRANSITION_\<sigma>\<^sub>1_\<sigma>\<^sub>2.Flight_at_pre_sat[simplified Flight_Aat_pre_def] -thm TRANSITION_\<sigma>\<^sub>1_\<sigma>\<^sub>2.Flight_at_post_sat[simplified Flight_A_def] - -Context r: Reservation - Inv A : "\<zero> <\<^sub>i\<^sub>n\<^sub>t (r .id)" - Inv B : "r .next <> null implies (r .flight .to \<doteq> r .next .flight .from)" - Inv C : "r .next <> null implies (r .client \<doteq> r .next .client)" - -Context Client :: book (f : Flight) - Pre : "f .passengers ->excludes\<^sub>S\<^sub>e\<^sub>t(self .oclAsType(Person)) - and (f .fl_res ->size\<^sub>S\<^sub>e\<^sub>q() <\<^sub>i\<^sub>n\<^sub>t (f .seats))" - Post: "f .passengers \<doteq> (f .passengers@pre ->including\<^sub>S\<^sub>e\<^sub>t(self .oclAsType(Person))) - and (let r = self .cl_res ->select\<^sub>S\<^sub>e\<^sub>t(r | r .flight \<doteq> f)->any\<^sub>S\<^sub>e\<^sub>t() in - (r .oclIsNew()) - and (r .prev \<doteq> null) - and (r .next \<doteq> null))" - -Context Client :: booknext (f : Flight, r : Reservation) - Pre : "f .passengers ->excludes\<^sub>S\<^sub>e\<^sub>t(self .oclAsType(Person)) - and (f .fl_res ->size\<^sub>S\<^sub>e\<^sub>q() <\<^sub>i\<^sub>n\<^sub>t (f .seats)) - and (r .client \<doteq> self) - and (f .from \<doteq> (r .flight .to))" - Post: "f .passengers \<doteq> (f .passengers@pre ->including\<^sub>S\<^sub>e\<^sub>t(self .oclAsType(Person))) - and (let r = self .cl_res ->select\<^sub>S\<^sub>e\<^sub>t(r | r .flight \<doteq> f)->any\<^sub>S\<^sub>e\<^sub>t() in - (r .oclIsNew()) - and (r .prev \<doteq> r) - and (r .next \<doteq> null))" - - -Context Client :: cancel (r : Reservation) - Pre : "r .client \<doteq> self" - Post: "self .cl_res ->select\<^sub>S\<^sub>e\<^sub>t(res | res .flight \<doteq> r .flight@pre) - ->isEmpty\<^sub>S\<^sub>e\<^sub>t()" - -(* example for a recursive query *) -Context Reservation :: connections () : Set(Integer) - Post : "result \<triangleq> if (self .next \<doteq> null) - then (Set{}->including\<^sub>S\<^sub>e\<^sub>t(self .id)) - else (self .next .connections()->including\<^sub>S\<^sub>e\<^sub>t(self .id)) - endif" - Pre : "true" - -find_theorems (350) name:"Client" -lemmas [simp,code_unfold] = dot_accessor - -end diff --git a/Citadelle/examples/archive/Isabelle_Finite_Set.thy b/Citadelle/examples/archive/Isabelle_Finite_Set.thy deleted file mode 100644 index 224ea0a3622552aa4dd6c85a6ed4dccedd77597f..0000000000000000000000000000000000000000 --- a/Citadelle/examples/archive/Isabelle_Finite_Set.thy +++ /dev/null @@ -1,1171 +0,0 @@ -(****************************************************************************** - * 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. - ******************************************************************************) - -chapter{* Gogolla's challenge on Sets *} - -theory - Isabelle_Finite_Set -imports - OCL.UML_Set -begin - -no_notation None ("\<bottom>") - -section{* Introduction *} - -definition "is_int x \<equiv> \<forall> \<tau>. \<tau> \<Turnstile> \<upsilon> x \<and> (\<forall>\<tau>0. x \<tau> = x \<tau>0)" - -lemma int_is_valid : "is_int x \<Longrightarrow> \<tau> \<Turnstile> \<upsilon> x" -by (metis foundation18' is_int_def) - -lemma int_is_const : "is_int x \<Longrightarrow> const x" -by(simp add: is_int_def const_def) - -definition "all_int_set S \<equiv> finite S \<and> (\<forall>x\<in>S. is_int x)" -definition "all_int \<tau> S \<equiv> (\<tau> \<Turnstile> \<delta> S) \<and> all_int_set \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil>" -definition "all_defined_set \<tau> S \<equiv> finite S \<and> (\<forall>x\<in>S. (\<tau> \<Turnstile> \<upsilon> (\<lambda>_. x)))" -definition "all_defined_set' \<tau> S \<equiv> finite S" -definition "all_defined \<tau> S \<equiv> (\<tau> \<Turnstile> \<delta> S) \<and> all_defined_set' \<tau> \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil>" - -lemma all_def_to_all_int : "\<And>\<tau>. all_defined \<tau> S \<Longrightarrow> - all_int_set ((\<lambda>a \<tau>. a) ` \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil>)" - apply(simp add: all_defined_def, erule conjE, frule Set_inv_lemma) - apply(simp add: all_defined_def all_defined_set'_def all_int_set_def is_int_def defined_def OclValid_def) -by (metis (no_types) OclValid_def foundation18' true_def Set_inv_lemma') - -term "all_defined \<tau> (f \<zero> Set{\<zero>}) = (all_defined \<tau> Set{\<zero>})" - (* we check here that all_defined could at least be applied to some useful value - (i.e. we examine the type of all_defined) *) - -lemma int_trivial : "is_int (\<lambda>_. \<lfloor>a\<rfloor>)" by(simp add: is_int_def OclValid_def valid_def bot_fun_def bot_option_def) - -lemma EQ_sym : "(x::(_, _) Set) = y \<Longrightarrow> \<tau> \<Turnstile> \<upsilon> x \<Longrightarrow> \<tau> \<Turnstile> (x \<doteq> y)" -by (metis (hide_lams, no_types) OclIf_true' OclValid_def StrictRefEq\<^sub>S\<^sub>e\<^sub>t.refl_ext) - -lemma cp_all_def : "all_defined \<tau> f = all_defined \<tau>' (\<lambda>_. f \<tau>)" - apply(simp add: all_defined_def all_defined_set'_def OclValid_def) - apply(subst cp_defined) -by (metis (no_types) OclValid_def foundation16) - -lemma cp_all_def' : "(\<forall>\<tau>. all_defined \<tau> f) = (\<forall>\<tau> \<tau>'. all_defined \<tau>' (\<lambda>_. f \<tau>))" - apply(rule iffI) - apply(rule allI) apply(erule_tac x = \<tau> in allE) apply(rule allI) - apply(simp add: cp_all_def[THEN iffD1]) - apply(subst cp_all_def, blast) -done - -lemma destruct_int' : "const i \<Longrightarrow> \<exists>! j. i = (\<lambda>_. j)" - proof - fix \<tau> assume "const i" thus ?thesis - apply(rule_tac a = "i \<tau>" in ex1I) - by(rule ext, (simp add: const_def)+) -qed - -lemma destruct_int : "is_int i \<Longrightarrow> \<exists>! j. i = (\<lambda>_. j)" -by(rule destruct_int', simp add: int_is_const) - -section{* Definition: comp fun commute *} - -text{* This part develops an Isabelle locale similar as @{term comp_fun_commute}, -but containing additional properties on arguments such as definedness, finiteness, non-emptiness... *} - -subsection{* Main *} - -text{* The iteration with @{term UML_Set.OclIterate} (performed internally through @{term Finite_Set.fold_graph}) -accepts any OCL expressions in its polymorphic arguments. -However for @{term UML_Set.OclIterate} to be a congruence where rewriting could cross -several nested @{term UML_Set.OclIterate}, -we only focus on a particular class of OCL expressions: ground sets with well-defined properties -like validity, not emptiness, finiteness... -Since the first hypothesis of @{text comp_fun_commute.fold_insert} is too general, -in order to replace it by another weaker locale we have the choice between -reusing the @{term comp_fun_commute} locale or whether completely defining a new locale. -Because elements occurring in the type of @{term Finite_Set.fold_graph} are represented in polymorphic form, -the folding on a value-proposition couple would be possible in a type system with dependent types. -But without the dependent typing facility, we choose to give the well-defined properties -to each functions in a duplicated version of @{term comp_fun_commute}. *} - -text{* A first attempt for defining such locale would then be: -\begin{verbatim} -locale EQ_comp_fun_commute = - fixes f :: "('a state \<times> 'a state \<Rightarrow> int option option) - \<Rightarrow> ('a state \<times> 'a state \<Rightarrow> int option option Set_0) - \<Rightarrow> ('a state \<times> 'a state \<Rightarrow> int option option Set_0)" - assumes cp_S : "\<And>x. cp (f x)" - assumes cp_x : "\<And>S. cp (\<lambda>x. f x S)" - assumes cp_gen : "\<And>x S \<tau>1 \<tau>2. is_int x \<Longrightarrow> (\<And>\<tau>. all_defined \<tau> S) \<Longrightarrow> S \<tau>1 = S \<tau>2 \<Longrightarrow> f x S \<tau>1 = f x S \<tau>2" - assumes notempty : "\<And>x S \<tau>. (\<And>\<tau>. all_defined \<tau> S) \<Longrightarrow> \<tau> \<Turnstile> \<upsilon> x \<Longrightarrow> \<lceil>\<lceil>@{text "Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e"} (S \<tau>)\<rceil>\<rceil> \<noteq> {} \<Longrightarrow> \<lceil>\<lceil>@{text "Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e"} (f x S \<tau>)\<rceil>\<rceil> \<noteq> {}" - assumes all_def: "\<And>(x:: 'a state \<times> 'a state \<Rightarrow> int option option) y. all_defined \<tau> (f x y) = (\<tau> \<Turnstile> \<upsilon> x \<and> all_defined \<tau> y)" - assumes commute: " - \<tau> \<Turnstile> \<upsilon> x \<Longrightarrow> - \<tau> \<Turnstile> \<upsilon> y \<Longrightarrow> - all_defined \<tau> S \<Longrightarrow> - f y (f x S) \<tau> = f x (f y S) \<tau>" -\end{verbatim} % from r9710 - -The important hypotheses are the last two. - -\begin{itemize} -\item @{term commute} is the commutativity property similar as -@{thm comp_fun_commute.comp_fun_commute} (from @{text comp_fun_commute.comp_fun_commute}), -except that the commuting relation is established on OCL terms -(the \verb|\<tau>| state being visible on both sides of the equality) and -finally all arguments contain a preliminary check of validity or ground situation. - -\item @{term all_def} is precisely used for inverting an inductive term of the form @{term "fold_graph f z A y"} -by following the same structure of the proof detailed in @{text comp_fun_commute.fold_graph_insertE_aux}. -As a rewriting rule, @{term all_def} permits the inversion -to preserve the @{term all_defined} property on sets. -\end{itemize} -*} - -text{* The resolution of Gogolla's challenge is composed of two separate steps: -\begin{enumerate} -\item Finding the list of rewriting rules to apply from the initial OCL term to the normal form. -\item Every rewriting rules that rewrite under a nested @{term "\<lambda>S A. UML_Set.OclIterate S A F"} term (that rewrite in @{term F}) imply to have proved -the associated @{term "EQ_comp_fun_commute F"} in order to preserve the well-defined properties -while crossing @{term UML_Set.OclIterate} -(@{term F} may contain another @{term UML_Set.OclIterate}). -So this part deals with the proof of every @{term "EQ_comp_fun_commute F"} -appearing as precondition in every rewriting rule of the first step. -\end{enumerate} -More generally, every rewriting rules of step 1 can be decomposed into atomic rules. -By atomic rules, we mean rules where at most one @{term UML_Set.OclIterate} exists -in the left hand side (hence right hand side) of the equation. -Ideally the closure of atomic rules would cover -the necessary space for solving an arbitrary nested @{term UML_Set.OclIterate} expression. - -In step 2, for each rewriting rule of step 1, -there is an associated @{term "EQ_comp_fun_commute F"} lemma to prove. -The @{term F} function is precisely the left hand side of -the associated rewriting rule. -So the architecture of this part 2 looks similar as the part 1. -In particular every @{term "EQ_comp_fun_commute"} lemmas could be decomposed into atomic lemmas of the form -@{term "EQ_comp_fun_commute F \<Longrightarrow> EQ_comp_fun_commute (g F)"} -with @{term g} a function containing at most one @{term UML_Set.OclIterate} combinator. - -However one corner case arises while proving this last formula. -The naive definition of the @{term "EQ_comp_fun_commute"} locale -we made earlier contains hypotheses where free variables are underspecified. -Indeed, when attempting to prove -@{term "\<And>x y \<tau>. all_defined \<tau> (f x y) \<Longrightarrow> (\<tau> \<Turnstile> \<upsilon> x \<and> all_defined \<tau> y)"} -(that comes from @{term all_def}), -we remark for instance that the validity of @{term x} could not be established directly. -*} - -text{* -As summary, by introducing @{term "EQ_comp_fun_commute"} -we have initially replaced @{term comp_fun_commute} in order to preserve -the well-defined properties across @{term UML_Set.OclIterate}, -however here the same well-defined properties should also be preserved -while proving @{term "EQ_comp_fun_commute"} atomic lemmas. -As solution we propose to refine every hypotheses of @{term "EQ_comp_fun_commute"} -where variables appear. -For instance, for @{term all_def} it means to suppose instead -@{term "\<And>x' y. (\<forall>\<tau>. all_defined \<tau> (f x' y)) = (is_int (\<lambda>(_::'a state \<times> 'a state). x') \<and> (\<forall>\<tau>. all_defined \<tau> y))"}. - -The curried form of the @{term x} variable ignoring its state implies to change the type of @{term f}: -we have no more an OCL expression as first argument in @{term f}. - -The other difference between the previous @{term all_def} and the current is -the scope of the \verb|\<tau>| quantification. -Indeed, @{text comp_fun_commute.fold_insert} depends on @{text comp_fun_commute.fold_graph_fold} -but this last needs an equality of the form @{term "P = Q"} -with @{term P} and @{term Q} two OCL expressions. -Since OCL expressions are described as functions in our shallow embedding representation, -the previous equality can only be obtained under a particular assumption. -For instance, this oops-unterminated lemma can not be proved: *} -lemma assumes "P \<tau> = R \<tau>" - assumes "Q \<tau> = R \<tau>" - shows "P = Q" oops -text{* whereas this one can be (using the extensionality rule): *} -lemma assumes "\<forall>\<tau>. P \<tau> = R \<tau>" - assumes "\<forall>\<tau>. Q \<tau> = R \<tau>" - shows "P = Q" by (metis assms(1) assms(2) ext) - -(* -(* TODO add some comment on comparison with inductively constructed OCL term *) -(* -inductive EQ1_fold_graph :: "(('\<AA>, _) val - \<Rightarrow> ('\<AA>, _) Set - \<Rightarrow> ('\<AA>, _) Set) \<Rightarrow> ('\<AA>, _) Set \<Rightarrow> ('\<AA>, _) Set \<Rightarrow> ('\<AA>, _) Set \<Rightarrow> bool" - for f and z where - EQ1_emptyI [intro]: "EQ1_fold_graph f z Set{} z" | - EQ1_insertI [intro]: "\<not> (\<tau> \<Turnstile> A->includes(x)) \<Longrightarrow> \<tau> \<Turnstile> \<delta> (\<lambda>_. x) \<Longrightarrow> all_defined \<tau> A \<Longrightarrow> EQ1_fold_graph f z A y - \<Longrightarrow> EQ1_fold_graph f z (A->including\<^sub>S\<^sub>e\<^sub>t(x)) (f x y)" - -inductive_cases EQ1_empty_fold_graphE [elim!]: "EQ1_fold_graph f z Set{} x" -*) - -(* -inductive EQ_fold_graph :: "(('\<AA>, _) val - \<Rightarrow> ('\<AA>, _) Set - \<Rightarrow> ('\<AA>, _) Set) - \<Rightarrow> ('\<AA>, _) Set - \<Rightarrow> ('\<AA>, _) val set - \<Rightarrow> ('\<AA>, _) Set - \<Rightarrow> bool" - for f and z where - EQ_emptyI [intro]: "EQ_fold_graph f z {} z" | - EQ_insertI [intro]: "(\<lambda>_. x) \<notin> A \<Longrightarrow> \<tau> \<Turnstile> \<delta> (\<lambda>_. x) \<Longrightarrow> EQ_fold_graph f z A y - \<Longrightarrow> EQ_fold_graph f z (insert (\<lambda>_. x) A) (f (\<lambda>_. x) y)" - -thm EQ_fold_graph_def -thm EQ_insertI -*) -(* -inductive_cases EQ_empty_fold_graphE [elim!]: "EQ_fold_graph f z {} x" -*) -*) - -text{* We can now propose a locale generic enough -to represent both at the same time the previous @{term EQ_comp_fun_commute} -and the curried form of variables -(@{term f000} represents the parametrization): *} - -locale EQ_comp_fun_commute0_gen0_bis'' = - fixes f000 :: "'b \<Rightarrow> 'c" - fixes is_i :: "'\<AA> st \<Rightarrow> 'c \<Rightarrow> bool" - fixes is_i' :: "'\<AA> st \<Rightarrow> 'c \<Rightarrow> bool" - fixes all_i_set :: "'c set \<Rightarrow> bool" - - fixes f :: "'c - \<Rightarrow> ('\<AA>, 'a option option) Set - \<Rightarrow> ('\<AA>, 'a option option) Set" - assumes i_set : "\<And>x A. all_i_set (insert x A) \<Longrightarrow> ((\<forall>\<tau>. is_i \<tau> x) \<and> all_i_set A)" - assumes i_set' : "\<And>x A. ((\<forall>\<tau>. is_i \<tau> (f000 x)) \<and> all_i_set A) \<Longrightarrow> all_i_set (insert (f000 x) A)" - assumes i_set'' : "\<And>x A. ((\<forall>\<tau>. is_i \<tau> (f000 x)) \<and> all_i_set A) \<Longrightarrow> all_i_set (A - {f000 x})" - assumes i_set_finite : "\<And>A. all_i_set A \<Longrightarrow> finite A" - assumes i_val : "\<And>x \<tau>. is_i \<tau> x \<Longrightarrow> is_i' \<tau> x" - assumes f000_inj : "\<And>x y. x \<noteq> y \<Longrightarrow> f000 x \<noteq> f000 y" - - assumes cp_set : "\<And>x S \<tau>. \<forall>\<tau>. all_defined \<tau> S \<Longrightarrow> f (f000 x) S \<tau> = f (f000 x) (\<lambda>_. S \<tau>) \<tau>" - assumes all_def: "\<And>x y. (\<forall>\<tau>. all_defined \<tau> (f (f000 x) y)) = ((\<forall>\<tau>. is_i' \<tau> (f000 x)) \<and> (\<forall>\<tau>. all_defined \<tau> y))" - assumes commute: "\<And>x y S. - (\<And>\<tau>. is_i' \<tau> (f000 x)) \<Longrightarrow> - (\<And>\<tau>. is_i' \<tau> (f000 y)) \<Longrightarrow> - (\<And>\<tau>. all_defined \<tau> S) \<Longrightarrow> - f (f000 y) (f (f000 x) S) = f (f000 x) (f (f000 y) S)" - -text{* In the previous definition of the @{term EQ_comp_fun_commute} Isabelle locale, -it would be possible to write the associated Isabelle context -by following the contents of @{term comp_fun_commute}, -and in particular there would be no need to change -the inductive definition of @{term fold_graph}. - -However in order to perform inversion proofs transparently under @{term f000}, -we replace now @{term fold_graph} by an other inductive definition -where @{term f000} appears as a protecting guard: *} - -inductive EQG_fold_graph :: "('b \<Rightarrow> 'c) - \<Rightarrow> ('c - \<Rightarrow> ('\<AA>, 'a) Set - \<Rightarrow> ('\<AA>, 'a) Set) - \<Rightarrow> ('\<AA>, 'a) Set - \<Rightarrow> 'c set - \<Rightarrow> ('\<AA>, 'a) Set - \<Rightarrow> bool" - for is_i and F and z where - EQG_emptyI [intro]: "EQG_fold_graph is_i F z {} z" | - EQG_insertI [intro]: "is_i x \<notin> A \<Longrightarrow> - EQG_fold_graph is_i F z A y \<Longrightarrow> - EQG_fold_graph is_i F z (insert (is_i x) A) (F (is_i x) y)" - -inductive_cases EQG_empty_fold_graphE [elim!]: "EQG_fold_graph is_i f z {} x" -definition "foldG is_i f z A = (if finite A then (THE y. EQG_fold_graph is_i f z A y) else z)" - -text{* Then the conversion from a @{term fold_graph} expression - to a @{term EQG_fold_graph} expression always remembers its original image. *} - -lemma eqg_fold_of_fold : - assumes fold_g : "fold_graph F z (f000 ` A) y" - shows "EQG_fold_graph f000 F z (f000 ` A) y" - apply(insert fold_g) - apply(subgoal_tac "\<And>A'. fold_graph F z A' y \<Longrightarrow> A' \<subseteq> f000 ` A \<Longrightarrow> EQG_fold_graph f000 F z A' y") - apply(simp) - proof - fix A' show "fold_graph F z A' y \<Longrightarrow> A' \<subseteq> f000 ` A \<Longrightarrow> EQG_fold_graph f000 F z A' y" - apply(induction set: fold_graph) - apply(rule EQG_emptyI) - apply(simp, erule conjE) - apply(drule imageE) prefer 2 apply assumption - apply(simp) - apply(rule EQG_insertI, simp, simp) - done -qed - -text{* In particular, the identity function is used when there is no choice. *} -lemma - assumes fold_g : "fold_graph F z A y" - shows "EQG_fold_graph (\<lambda>x. x) F z A y" -by (metis (mono_tags) eqg_fold_of_fold fold_g image_ident) - -text{* Going from @{term EQG_fold_graph} to @{term fold_graph} provides the bijectivity. *} - -lemma fold_of_eqg_fold : - assumes fold_g : "EQG_fold_graph f000 F z A y" - shows "fold_graph F z A y" - apply(insert fold_g) - apply(induction set: EQG_fold_graph) - apply(rule emptyI) - apply(simp add: insertI) -done - -text{* Finally, the entire definition of the @{term EQ_comp_fun_commute0_gen0_bis''} context -could now depend uniquely on @{term EQG_fold_graph}. *} - -context EQ_comp_fun_commute0_gen0_bis'' -begin - - lemma fold_graph_insertE_aux: - assumes y_defined : "\<And>\<tau>. all_defined \<tau> y" - assumes a_valid : "\<forall>\<tau>. is_i' \<tau> (f000 a)" - shows - "EQG_fold_graph f000 f z A y \<Longrightarrow> (f000 a) \<in> A \<Longrightarrow> \<exists>y'. y = f (f000 a) y' \<and> (\<forall>\<tau>. all_defined \<tau> y') \<and> EQG_fold_graph f000 f z (A - {(f000 a)}) y'" - apply(insert y_defined) - proof (induct set: EQG_fold_graph) - case (EQG_insertI x A y) - assume "\<And>\<tau>. all_defined \<tau> (f (f000 x) y)" - then show "?case" when "\<forall>\<tau>. is_i' \<tau> (f000 x)" "(\<And>\<tau>. all_defined \<tau> y)" - proof (insert that, cases "x = a") assume "x = a" with EQG_insertI show "(\<And>\<tau>. all_defined \<tau> y) \<Longrightarrow> ?case" by (metis Diff_insert_absorb all_def) - next apply_end(simp) - - assume "f000 x \<noteq> f000 a \<and> (\<forall>\<tau>. all_defined \<tau> y)" - then obtain y' where y: "y = f (f000 a) y'" and "(\<forall>\<tau>. all_defined \<tau> y')" and y': "EQG_fold_graph f000 f z (A - {(f000 a)}) y'" - using EQG_insertI by (metis insert_iff) - have "(\<And>\<tau>. all_defined \<tau> y) \<Longrightarrow> (\<And>\<tau>. all_defined \<tau> y')" - apply(subgoal_tac "\<forall>\<tau>. is_i' \<tau> (f000 a) \<and> (\<forall>\<tau>. all_defined \<tau> y')") apply(simp only:) - apply(subst (asm) cp_all_def) unfolding y apply(subst (asm) cp_all_def[symmetric]) - apply(insert all_def[where x = "a" and y = y', THEN iffD1], blast) - done - moreover have "\<forall>\<tau>. is_i' \<tau> (f000 x) \<Longrightarrow> \<forall>\<tau>. is_i' \<tau> (f000 a) \<Longrightarrow> (\<And>\<tau>. all_defined \<tau> y') \<Longrightarrow> f (f000 x) y = f (f000 a) (f (f000 x) y')" - unfolding y - by(rule commute, blast+) - moreover have "EQG_fold_graph f000 f z (insert (f000 x) A - {f000 a}) (f (f000 x) y')" - using y' and `f000 x \<noteq> f000 a \<and> (\<forall>\<tau>. all_defined \<tau> y)` and `f000 x \<notin> A` - apply (simp add: insert_Diff_if Isabelle_Finite_Set.EQG_insertI) - done - apply_end(subgoal_tac "f000 x \<noteq> f000 a \<and> (\<forall>\<tau>. all_defined \<tau> y) \<Longrightarrow> \<exists>y'. f (f000 x) y = f (f000 a) y' \<and> (\<forall>\<tau>. all_defined \<tau> y') \<and> EQG_fold_graph f000 f z (insert (f000 x) A - {(f000 a)}) y'") - ultimately show "?case" when "(\<forall>\<tau>. is_i' \<tau> (f000 x)) \<and> f000 x \<noteq> f000 a \<and> (\<forall>\<tau>. all_defined \<tau> y)" apply(auto simp: a_valid) - by (metis (mono_tags) `\<And>\<tau>. all_defined \<tau> (f (f000 x) y)` all_def) - apply_end(drule f000_inj, blast)+ - qed simp - apply_end simp - - fix x y - show "(\<And>\<tau>. all_defined \<tau> (f (f000 x) y)) \<Longrightarrow> \<forall>\<tau>. is_i' \<tau> (f000 x)" - apply(rule all_def[where x = x and y = y, THEN iffD1, THEN conjunct1], simp) done - - fix x y \<tau> - show "(\<And>\<tau>. all_defined \<tau> (f (f000 x) y)) \<Longrightarrow> all_defined \<tau> y" - apply(rule all_def[where x = x, THEN iffD1, THEN conjunct2, THEN spec], simp) done - - qed - - lemma fold_graph_insertE: - assumes v_defined : "\<And>\<tau>. all_defined \<tau> v" - and x_valid : "\<forall>\<tau>. is_i' \<tau> (f000 x)" - and "EQG_fold_graph f000 f z (insert (f000 x) A) v" and "(f000 x) \<notin> A" - obtains y where "v = f (f000 x) y" and "is_i' \<tau> (f000 x)" and "\<And>\<tau>. all_defined \<tau> y" and "EQG_fold_graph f000 f z A y" - apply(insert fold_graph_insertE_aux[OF v_defined x_valid `EQG_fold_graph f000 f z (insert (f000 x) A) v` insertI1] x_valid `(f000 x) \<notin> A`) - apply(drule exE) prefer 2 apply assumption - apply(drule Diff_insert_absorb, simp only:) - done - - lemma fold_graph_determ: - assumes x_defined : "\<And>\<tau>. all_defined \<tau> x" - and y_defined : "\<And>\<tau>. all_defined \<tau> y" - shows "EQG_fold_graph f000 f z A x \<Longrightarrow> EQG_fold_graph f000 f z A y \<Longrightarrow> y = x" - apply(insert x_defined y_defined) - proof (induct arbitrary: y set: EQG_fold_graph) - case (EQG_insertI x A y v) - from `\<And>\<tau>. all_defined \<tau> (f (f000 x) y)` - have "\<forall>\<tau>. is_i' \<tau> (f000 x)" by(metis all_def) - from `\<And>\<tau>. all_defined \<tau> v` and `\<forall>\<tau>. is_i' \<tau> (f000 x)` and `EQG_fold_graph f000 f z (insert (f000 x) A) v` and `(f000 x) \<notin> A` - obtain y' where "v = f (f000 x) y'" and "\<And>\<tau>. all_defined \<tau> y'" and "EQG_fold_graph f000 f z A y'" - by (rule fold_graph_insertE, simp) - from EQG_insertI have "\<And>\<tau>. all_defined \<tau> y" by (metis all_def) - from `\<And>\<tau>. all_defined \<tau> y` and `\<And>\<tau>. all_defined \<tau> y'` and `EQG_fold_graph f000 f z A y'` have "y' = y" by (metis EQG_insertI.hyps(3)) - with `v = f (f000 x) y'` show "v = f (f000 x) y" by (simp) - apply_end(rule_tac f = f in EQG_empty_fold_graphE, auto) - qed - - lemma det_init2 : - assumes z_defined : "\<forall>(\<tau> :: '\<AA> st). all_defined \<tau> z" - and A_int : "all_i_set A" - shows "EQG_fold_graph f000 f z A x \<Longrightarrow> \<forall>\<tau>. all_defined \<tau> x" - apply(insert z_defined A_int) - proof (induct set: EQG_fold_graph) - apply_end(simp) - apply_end(subst all_def, drule i_set, auto, rule i_val, blast) - qed - - lemma fold_graph_determ3 : (* WARNING \<forall> \<tau> is implicit *) - assumes z_defined : "\<And>\<tau>. all_defined \<tau> z" - and A_int : "all_i_set A" - shows "EQG_fold_graph f000 f z A x \<Longrightarrow> EQG_fold_graph f000 f z A y \<Longrightarrow> y = x" - apply(insert z_defined A_int) - apply(rule fold_graph_determ) - apply(rule det_init2[THEN spec]) apply(blast)+ - apply(rule det_init2[THEN spec]) apply(blast)+ - done - - lemma fold_graph_fold: - assumes z_int : "\<And>\<tau>. all_defined \<tau> z" - and A_int : "all_i_set (f000 ` A)" - shows "EQG_fold_graph f000 f z (f000 ` A) (foldG f000 f z (f000 ` A))" - proof - - from A_int have "finite (f000 ` A)" by (simp add: i_set_finite) - then have "\<exists>x. fold_graph f z (f000 ` A) x" by (rule finite_imp_fold_graph) - then have "\<exists>x. EQG_fold_graph f000 f z (f000 ` A) x" by (metis eqg_fold_of_fold) - moreover note fold_graph_determ3[OF z_int A_int] - ultimately have "\<exists>!x. EQG_fold_graph f000 f z (f000 ` A) x" by(rule ex_ex1I) - then have "EQG_fold_graph f000 f z (f000 ` A) (The (EQG_fold_graph f000 f z (f000 ` A)))" by (rule theI') - then show ?thesis by(simp add: `finite (f000 \` A)` foldG_def) - qed - - lemma fold_equality: - assumes z_defined : "\<And>\<tau>. all_defined \<tau> z" - and A_int : "all_i_set (f000 ` A)" - shows "EQG_fold_graph f000 f z (f000 ` A) y \<Longrightarrow> foldG f000 f z (f000 ` A) = y" - apply(rule fold_graph_determ3[OF z_defined A_int], simp) - apply(rule fold_graph_fold[OF z_defined A_int]) - done - - lemma fold_insert: - assumes z_defined : "\<And>\<tau>. all_defined \<tau> z" - and A_int : "all_i_set (f000 ` A)" - and x_int : "\<forall>\<tau>. is_i \<tau> (f000 x)" - and x_nA : "f000 x \<notin> f000 ` A" - shows "foldG f000 f z (f000 ` (insert x A)) = f (f000 x) (foldG f000 f z (f000 ` A))" - proof (rule fold_equality) - have "EQG_fold_graph f000 f z (f000 `A) (foldG f000 f z (f000 `A))" by (rule fold_graph_fold[OF z_defined A_int]) - with x_nA show "EQG_fold_graph f000 f z (f000 `(insert x A)) (f (f000 x) (foldG f000 f z (f000 `A)))" apply(simp add: image_insert) by(rule EQG_insertI, simp, simp) - apply_end (simp add: z_defined) - apply_end (simp only: image_insert) - apply_end(rule i_set', simp add: x_int A_int) - qed - - lemma fold_insert': - assumes z_defined : "\<And>\<tau>. all_defined \<tau> z" - and A_int : "all_i_set (f000 ` A)" - and x_int : "\<forall>\<tau>. is_i \<tau> (f000 x)" - and x_nA : "x \<notin> A" - shows "Finite_Set.fold f z (f000 ` insert x A) = f (f000 x) (Finite_Set.fold f z (f000 ` A))" - proof - - have eq_f : "\<And>A. Finite_Set.fold f z (f000 ` A) = foldG f000 f z (f000 ` A)" - apply(simp add: Finite_Set.fold_def foldG_def) - by (rule impI, metis eqg_fold_of_fold fold_of_eqg_fold) - - have x_nA : "f000 x \<notin> f000 ` A" - apply(simp add: image_iff) - by (metis x_nA f000_inj) - - have "foldG f000 f z (f000 ` insert x A) = f (f000 x) (foldG f000 f z (f000 ` A))" - apply(rule fold_insert) apply(simp add: assms x_nA)+ - done - - thus ?thesis by (subst (1 2) eq_f, simp) - qed - - lemma all_int_induct : - assumes i_fin : "all_i_set (f000 ` F)" - assumes "P {}" - and insert: "\<And>x F. all_i_set (f000 ` F) \<Longrightarrow> \<forall>\<tau>. is_i \<tau> (f000 x) \<Longrightarrow> x \<notin> F \<Longrightarrow> P (f000 ` F) \<Longrightarrow> P (f000 ` (insert x F))" - shows "P (f000 ` F)" - proof - - from i_fin have "finite (f000 ` F)" by (simp add: i_set_finite) - then have "finite F" apply(rule finite_imageD) apply(simp add: inj_on_def, insert f000_inj, blast) done - show "?thesis" - using `finite F` and i_fin - proof induct - apply_end(simp) - show "P {}" by fact - apply_end(simp add: i_set) - apply_end(rule insert[simplified], simp add: i_set, simp add: i_set) - apply_end(simp, simp) - qed - qed - - lemma all_defined_fold_rec : - assumes A_defined : "\<And>\<tau>. all_defined \<tau> A" - and x_notin : "x \<notin> Fa" - shows " - all_i_set (f000 ` insert x Fa) \<Longrightarrow> - (\<And>\<tau>. all_defined \<tau> (Finite_Set.fold f A (f000 ` Fa))) \<Longrightarrow> - all_defined \<tau> (Finite_Set.fold f A (f000 ` insert x Fa))" - apply(subst (asm) image_insert) - apply(frule i_set[THEN conjunct1]) - apply(subst fold_insert'[OF A_defined]) - apply(rule i_set[THEN conjunct2], simp) - apply(simp) - apply(simp add: x_notin) - apply(rule all_def[THEN iffD2, THEN spec]) - apply(simp add: i_val) - done - - lemma fold_def : - assumes z_def : "\<And>\<tau>. all_defined \<tau> z" - assumes F_int : "all_i_set (f000 ` F)" - shows "all_defined \<tau> (Finite_Set.fold f z (f000 ` F))" - apply(subgoal_tac "\<forall>\<tau>. all_defined \<tau> (Finite_Set.fold f z (f000 ` F))", blast) - proof (induct rule: all_int_induct[OF F_int]) - apply_end(simp add:z_def) - apply_end(rule allI) - apply_end(rule all_defined_fold_rec[OF z_def], simp, simp add: i_set', blast) - qed - - lemma fold_fun_comm: - assumes z_def : "\<And>\<tau>. all_defined \<tau> z" - assumes A_int : "all_i_set (f000 ` A)" - and x_val : "\<And>\<tau>. is_i' \<tau> (f000 x)" - shows "f (f000 x) (Finite_Set.fold f z (f000 ` A)) = Finite_Set.fold f (f (f000 x) z) (f000 ` A)" - proof - - have fxz_def: "\<And>\<tau>. all_defined \<tau> (f (f000 x) z)" - by(rule all_def[THEN iffD2, THEN spec], simp add: z_def x_val) - - show ?thesis - proof (induct rule: all_int_induct[OF A_int]) - apply_end(simp) - apply_end(rename_tac x' F) - apply_end(subst fold_insert'[OF z_def], simp, simp, simp) - apply_end(subst fold_insert'[OF fxz_def], simp, simp, simp) - apply_end(subst commute[symmetric]) - apply_end(simp add: x_val) - apply_end(rule i_val, blast) - apply_end(subst fold_def[OF z_def], simp_all) - qed - qed - - lemma fold_rec: - assumes z_defined : "\<And>\<tau>. all_defined \<tau> z" - and A_int : "all_i_set (f000 ` A)" - and x_int : "\<forall>\<tau>. is_i \<tau> (f000 x)" - and "x \<in> A" - shows "Finite_Set.fold f z (f000 ` A) = f (f000 x) (Finite_Set.fold f z (f000 ` (A - {x})))" - proof - - have f_inj : "inj f000" by (simp add: inj_on_def, insert f000_inj, blast) - from A_int have A_int: "all_i_set (f000 ` (A - {x}))" apply(subst image_set_diff[OF f_inj]) apply(simp, rule i_set'', simp add: x_int) done - have A: "f000 ` A = insert (f000 x) (f000 ` (A - {x}))" using `x \<in> A` by blast - then have "Finite_Set.fold f z (f000 ` A) = Finite_Set.fold f z (insert (f000 x) (f000 ` (A - {x})))" by simp - also have "\<dots> = f (f000 x) (Finite_Set.fold f z (f000 ` (A - {x})))" by(simp only: image_insert[symmetric], rule fold_insert'[OF z_defined A_int x_int], simp) - finally show ?thesis . - qed - - lemma fold_insert_remove: - assumes z_defined : "\<And>\<tau>. all_defined \<tau> z" - and A_int : "all_i_set (f000 ` A)" - and x_int : "\<forall>\<tau>. is_i \<tau> (f000 x)" - shows "Finite_Set.fold f z (f000 ` insert x A) = f (f000 x) (Finite_Set.fold f z (f000 ` (A - {x})))" - proof - - from A_int have "finite (f000 ` A)" by (simp add: i_set_finite) - then have "finite (f000 ` insert x A)" by auto - moreover have "x \<in> insert x A" by auto - moreover from A_int have A_int: "all_i_set (f000 ` insert x A)" by (simp, subst i_set', simp_all add: x_int) - ultimately have "Finite_Set.fold f z (f000 ` insert x A) = f (f000 x) (Finite_Set.fold f z (f000 ` (insert x A - {x})))" - by (subst fold_rec[OF z_defined A_int x_int], simp_all) - then show ?thesis by simp - qed - - lemma finite_fold_insert : - assumes z_defined : "\<And>\<tau>. all_defined \<tau> z" - and A_int : "all_i_set (f000 ` A)" - and x_int : "\<forall>\<tau>. is_i \<tau> (f000 x)" - and "x \<notin> A" - shows "finite \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (Finite_Set.fold f z (f000 ` insert x A) \<tau>)\<rceil>\<rceil> = finite \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (f (f000 x) (Finite_Set.fold f z (f000 ` A)) \<tau>)\<rceil>\<rceil>" - apply(subst fold_insert', simp_all add: assms) - done - - lemma (*c_fun_commute:*) - assumes s_not_def : "\<And>x S. \<not> (\<forall>\<tau>. (\<tau> \<Turnstile> \<delta> S)) \<Longrightarrow> f x S = \<bottom>" - assumes s_not_fin : "\<And>x S \<tau>. \<not> finite \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil> \<Longrightarrow> f x S = \<bottom>" - assumes x_not_i : "\<And>x S. \<not> (\<forall>\<tau>. is_i' \<tau> x) \<Longrightarrow> f x S = \<bottom>" - assumes s_bot : "\<And>x. f x \<bottom> = \<bottom>" - shows "comp_fun_commute (f o f000)" - proof - - have s_not_fin : "\<And>x S. \<not> (\<forall>\<tau>. finite \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil>) \<Longrightarrow> f x S = \<bottom>" by (metis s_not_fin) - show ?thesis - apply(standard, simp add: comp_def) - apply(rule ext, rename_tac S) - apply(rule ext, rename_tac \<tau>) - apply(case_tac "\<not> (\<forall>\<tau>. (\<tau> \<Turnstile> \<delta> S))", simp add: s_not_def s_bot) - apply(case_tac "\<not> (\<forall>\<tau>. all_defined \<tau> S)", simp add: all_defined_def all_defined_set'_def s_not_fin s_bot) - apply(case_tac "\<not> (\<forall>\<tau>. is_i' \<tau> (f000 x))", simp add: x_not_i s_bot) - apply(case_tac "\<not> (\<forall>\<tau>. is_i' \<tau> (f000 y))", simp add: x_not_i s_bot) - by(subst commute, blast+) - qed -end - -lemma (*comp_to_EQ_comp_fun_commute0_gen0_bis'' :*) - assumes f_comm: "comp_fun_commute f" - - assumes i_set : "\<And>x A. all_i_set (insert x A) \<Longrightarrow> ((\<forall>\<tau>. is_i \<tau> x) \<and> all_i_set A)" - assumes i_set' : "\<And>x A. ((\<forall>\<tau>. is_i \<tau> (f000 x)) \<and> all_i_set A) \<Longrightarrow> all_i_set (insert (f000 x) A)" - assumes i_set'' : "\<And>x A. ((\<forall>\<tau>. is_i \<tau> (f000 x)) \<and> all_i_set A) \<Longrightarrow> all_i_set (A - {f000 x})" - assumes i_set_finite : "\<And>A. all_i_set A \<Longrightarrow> finite A" - assumes i_val : "\<And>x \<tau>. is_i \<tau> x \<Longrightarrow> is_i' \<tau> x" - assumes f000_inj : "\<And>x y. x \<noteq> y \<Longrightarrow> f000 x \<noteq> f000 y" - assumes cp_set : "\<And>x S \<tau>. \<forall>\<tau>. all_defined \<tau> S \<Longrightarrow> f (f000 x) S \<tau> = f (f000 x) (\<lambda>_. S \<tau>) \<tau>" - assumes all_def: "\<And>x y. (\<forall>\<tau>. all_defined \<tau> (f (f000 x) y)) = ((\<forall>\<tau>. is_i' \<tau> (f000 x)) \<and> (\<forall>\<tau>. all_defined \<tau> y))" - - shows "EQ_comp_fun_commute0_gen0_bis'' f000 is_i is_i' all_i_set f" -proof - interpret comp_fun_commute f by (rule f_comm) show ?thesis - apply(standard) - apply(rule i_set, blast+) - apply(rule i_set', blast+) - apply(rule i_set'', blast+) - apply(rule i_set_finite, blast+) - apply(rule i_val, blast+) - apply(rule f000_inj, blast+) - apply(rule cp_set, blast+) - apply(rule all_def) - apply(rule fun_left_comm) - done -qed - -locale EQ_comp_fun_commute0_gen0_bis' = EQ_comp_fun_commute0_gen0_bis'' + - assumes cp_gen : "\<And>x S \<tau>1 \<tau>2. \<forall>\<tau>. is_i \<tau> (f000 x) \<Longrightarrow> (\<And>\<tau>. all_defined \<tau> S) \<Longrightarrow> S \<tau>1 = S \<tau>2 \<Longrightarrow> f (f000 x) S \<tau>1 = f (f000 x) S \<tau>2" - assumes notempty : "\<And>x S \<tau>. \<forall>\<tau>. all_defined \<tau> S \<Longrightarrow> \<forall>\<tau>. is_i \<tau> (f000 x) \<Longrightarrow> \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil> \<noteq> {} \<Longrightarrow> \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (f (f000 x) S \<tau>)\<rceil>\<rceil> \<noteq> {}" - -context EQ_comp_fun_commute0_gen0_bis' -begin - lemma downgrade_up : "EQ_comp_fun_commute0_gen0_bis'' f000 is_i is_i' all_i_set f" by standard - lemma downgrade : "EQ_comp_fun_commute0_gen0_bis' f000 is_i is_i' all_i_set f" by standard -end - - lemma fold_cong''' : - assumes f_comm : "EQ_comp_fun_commute0_gen0_bis' f000 is_i is_i' all_i_set f" - and g_comm : "EQ_comp_fun_commute0_gen0_bis' f000 is_i is_i' all_i_set g" - and a_def : "all_i_set (f000 ` A)" - and s_def : "\<And>\<tau>. all_defined \<tau> s" - and t_def : "\<And>\<tau>. all_defined \<tau> t" - and cong : "(\<And>x s. \<forall>\<tau>. is_i \<tau> (f000 x) \<Longrightarrow> P s \<tau> \<Longrightarrow> f (f000 x) s \<tau> = g (f000 x) s \<tau>)" - and ab : "A = B" - and st : "s \<tau> = t \<tau>'" - and P0 : "P s \<tau>" - and Prec : "\<And>x F. - all_i_set (f000 ` F) \<Longrightarrow> - \<forall>\<tau>. is_i \<tau> (f000 x) \<Longrightarrow> - x \<notin> F \<Longrightarrow> - P (Finite_Set.fold f s (f000 ` F)) \<tau> \<Longrightarrow> P (Finite_Set.fold f s (f000 ` insert x F)) \<tau>" - shows "Finite_Set.fold f s (f000 ` A) \<tau> = Finite_Set.fold g t (f000 ` B) \<tau>'" - proof - - interpret EQ_comp_fun_commute0_gen0_bis' f000 is_i is_i' all_i_set f by (rule f_comm) - note g_comm_down = g_comm[THEN EQ_comp_fun_commute0_gen0_bis'.downgrade_up] - note g_fold_insert' = EQ_comp_fun_commute0_gen0_bis''.fold_insert'[OF g_comm_down] - note g_cp_set = EQ_comp_fun_commute0_gen0_bis''.cp_set[OF g_comm_down] - note g_fold_def = EQ_comp_fun_commute0_gen0_bis''.fold_def[OF g_comm_down] - note g_cp_gen = EQ_comp_fun_commute0_gen0_bis'.cp_gen[OF g_comm] - have "Finite_Set.fold f s (f000 ` A) \<tau> = Finite_Set.fold g t (f000 ` A) \<tau>'" - apply(rule all_int_induct[OF a_def], simp add: st) - apply(subst fold_insert', simp add: s_def, simp, simp, simp) - apply(subst g_fold_insert', simp add: t_def, simp, simp, simp) - apply(subst g_cp_set, rule allI, rule g_fold_def, simp add: t_def, simp) - apply(drule sym, simp) - apply(subst g_cp_gen[of _ _ _ \<tau>], simp, subst cp_all_def[where \<tau>' = \<tau>], subst cp_all_def[symmetric], rule fold_def, simp add: s_def, simp, simp) - apply(subst g_cp_set[symmetric], rule allI, rule fold_def, simp add: s_def, simp) - apply(rule cong, simp) - (* *) - apply(rule all_int_induct, simp, simp add: P0, simp add: st[symmetric] P0) - apply(rule Prec[simplified], simp_all) - done - thus ?thesis by (simp add: st[symmetric] ab[symmetric]) - qed - - lemma fold_cong'' : - assumes f_comm : "EQ_comp_fun_commute0_gen0_bis' f000 is_i is_i' all_i_set f" - and g_comm : "EQ_comp_fun_commute0_gen0_bis' f000 is_i is_i' all_i_set g" - and a_def : "all_i_set (f000 ` A)" - and s_def : "\<And>\<tau>. all_defined \<tau> s" - and cong : "(\<And>x s. \<forall>\<tau>. is_i \<tau> (f000 x) \<Longrightarrow> P s \<tau> \<Longrightarrow> f (f000 x) s \<tau> = g (f000 x) s \<tau>)" - and ab : "A = B" - and st : "s = t" - and stau : "s \<tau> = s \<tau>'" - and P0 : "P s \<tau>" - and Prec : "\<And>x F. - all_i_set (f000 ` F) \<Longrightarrow> - \<forall>\<tau>. is_i \<tau> (f000 x) \<Longrightarrow> - x \<notin> F \<Longrightarrow> - P (Finite_Set.fold f s (f000 ` F)) \<tau> \<Longrightarrow> P (Finite_Set.fold f s (f000 ` insert x F)) \<tau>" - shows "Finite_Set.fold f s (f000 ` A) \<tau> = Finite_Set.fold g t (f000 ` B) \<tau>'" - proof - - interpret EQ_comp_fun_commute0_gen0_bis' f000 is_i is_i' all_i_set f by (rule f_comm) - note g_comm_down = g_comm[THEN EQ_comp_fun_commute0_gen0_bis'.downgrade_up] - note g_fold_insert' = EQ_comp_fun_commute0_gen0_bis''.fold_insert'[OF g_comm_down] - note g_cp_set = EQ_comp_fun_commute0_gen0_bis''.cp_set[OF g_comm_down] - note g_fold_def = EQ_comp_fun_commute0_gen0_bis''.fold_def[OF g_comm_down] - note g_cp_gen = EQ_comp_fun_commute0_gen0_bis'.cp_gen[OF g_comm] - have "Finite_Set.fold g s (f000 ` A) \<tau>' = Finite_Set.fold f s (f000 ` A) \<tau>" - apply(rule all_int_induct[OF a_def], simp add: stau) - apply(subst fold_insert', simp add: s_def, simp, simp, simp) - apply(subst g_fold_insert', simp add: s_def, simp, simp, simp) - apply(subst g_cp_set, rule allI, rule g_fold_def, simp add: s_def, simp) - apply(simp, subst g_cp_set[symmetric], rule allI, subst cp_all_def[where \<tau>' = \<tau>], subst cp_all_def[symmetric], rule fold_def, simp add: s_def, simp) - apply(subst g_cp_gen[of _ _ _ \<tau>], simp, subst cp_all_def[where \<tau>' = \<tau>], subst cp_all_def[symmetric], rule fold_def, simp add: s_def, simp, simp) - apply(subst g_cp_set[symmetric], rule allI, subst cp_all_def[where \<tau>' = \<tau>], subst cp_all_def[symmetric], rule fold_def, simp add: s_def, simp) - apply(rule cong[symmetric], simp) - (* *) - apply(rule all_int_induct, simp, simp add: P0, simp add: st[symmetric] P0) - apply(rule Prec[simplified], simp_all) - done - thus ?thesis by (simp add: st[symmetric] ab[symmetric]) - qed - - lemma fold_cong' : - assumes f_comm : "EQ_comp_fun_commute0_gen0_bis' f000 is_i is_i' all_i_set f" - and g_comm : "EQ_comp_fun_commute0_gen0_bis' f000 is_i is_i' all_i_set g" - and a_def : "all_i_set (f000 ` A)" - and s_def : "\<And>\<tau>. all_defined \<tau> s" - and cong : "(\<And>x s. \<forall>\<tau>. is_i \<tau> (f000 x) \<Longrightarrow> P s \<tau> \<Longrightarrow> f (f000 x) s \<tau> = g (f000 x) s \<tau>)" - and ab : "A = B" - and st : "s = t" - and P0 : "P s \<tau>" - and Prec : "\<And>x F. - all_i_set (f000 ` F) \<Longrightarrow> - \<forall>\<tau>. is_i \<tau> (f000 x) \<Longrightarrow> - x \<notin> F \<Longrightarrow> - P (Finite_Set.fold f s (f000 ` F)) \<tau> \<Longrightarrow> P (Finite_Set.fold f s (f000 ` insert x F)) \<tau>" - shows "Finite_Set.fold f s (f000 ` A) \<tau> = Finite_Set.fold g t (f000 ` B) \<tau>" - by(rule fold_cong''[OF f_comm g_comm a_def s_def cong ab st], simp, simp, simp, rule P0, rule Prec, blast+) - - lemma fold_cong : - assumes f_comm : "EQ_comp_fun_commute0_gen0_bis' f000 is_i is_i' all_i_set f" - and g_comm : "EQ_comp_fun_commute0_gen0_bis' f000 is_i is_i' all_i_set g" - and a_def : "all_i_set (f000 ` A)" - and s_def : "\<And>\<tau>. all_defined \<tau> s" - and cong : "(\<And>x s. \<forall>\<tau>. is_i \<tau> (f000 x) \<Longrightarrow> P s \<Longrightarrow> f (f000 x) s = g (f000 x) s)" - and ab : "A = B" - and st : "s = t" - and P0 : "P s" - and Prec : "\<And>x F. - all_i_set (f000 ` F) \<Longrightarrow> - \<forall>\<tau>. is_i \<tau> (f000 x) \<Longrightarrow> - x \<notin> F \<Longrightarrow> - P (Finite_Set.fold f s (f000 ` F)) \<Longrightarrow> P (Finite_Set.fold f s (f000 ` insert x F))" - shows "Finite_Set.fold f s (f000 ` A) = Finite_Set.fold g t (f000 ` B)" - apply(rule ext, rule fold_cong'[OF f_comm g_comm a_def s_def]) - apply(subst cong, simp, simp, simp, rule ab, rule st, rule P0) - apply(rule Prec, simp_all) - done - - -subsection{* Sublocale *} - -locale EQ_comp_fun_commute = - fixes f :: "('\<AA>, 'a option option) val - \<Rightarrow> ('\<AA>, 'a option option) Set - \<Rightarrow> ('\<AA>, 'a option option) Set" - assumes cp_x : "\<And>x S \<tau>. f x S \<tau> = f (\<lambda>_. x \<tau>) S \<tau>" - assumes cp_set : "\<And>x S \<tau>. f x S \<tau> = f x (\<lambda>_. S \<tau>) \<tau>" - assumes cp_gen : "\<And>x S \<tau>1 \<tau>2. is_int x \<Longrightarrow> (\<And>\<tau>. all_defined \<tau> S) \<Longrightarrow> S \<tau>1 = S \<tau>2 \<Longrightarrow> f x S \<tau>1 = f x S \<tau>2" - assumes notempty : "\<And>x S \<tau>. (\<And>\<tau>. all_defined \<tau> S) \<Longrightarrow> \<tau> \<Turnstile> \<upsilon> x \<Longrightarrow> \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil> \<noteq> {} \<Longrightarrow> \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (f x S \<tau>)\<rceil>\<rceil> \<noteq> {}" - assumes all_def: "\<And>x y \<tau>. all_defined \<tau> (f x y) = (\<tau> \<Turnstile> \<upsilon> x \<and> all_defined \<tau> y)" - assumes commute: "\<And>x y S \<tau>. - \<tau> \<Turnstile> \<upsilon> x \<Longrightarrow> - \<tau> \<Turnstile> \<upsilon> y \<Longrightarrow> - all_defined \<tau> S \<Longrightarrow> - f y (f x S) \<tau> = f x (f y S) \<tau>" - -lemma (*comp_to_EQ_comp_fun_commute :*) - assumes f_comm: "comp_fun_commute f" - - assumes cp_x : "\<And>x S \<tau>. f x S \<tau> = f (\<lambda>_. x \<tau>) S \<tau>" - assumes cp_set : "\<And>x S \<tau>. f x S \<tau> = f x (\<lambda>_. S \<tau>) \<tau>" - assumes cp_gen : "\<And>x S \<tau>1 \<tau>2. is_int x \<Longrightarrow> (\<And>\<tau>. all_defined \<tau> S) \<Longrightarrow> S \<tau>1 = S \<tau>2 \<Longrightarrow> f x S \<tau>1 = f x S \<tau>2" - assumes notempty : "\<And>x S \<tau>. (\<And>\<tau>. all_defined \<tau> S) \<Longrightarrow> \<tau> \<Turnstile> \<upsilon> x \<Longrightarrow> \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil> \<noteq> {} \<Longrightarrow> \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (f x S \<tau>)\<rceil>\<rceil> \<noteq> {}" - assumes all_def: "\<And>x y \<tau>. all_defined \<tau> (f x y) = (\<tau> \<Turnstile> \<upsilon> x \<and> all_defined \<tau> y)" - - shows "EQ_comp_fun_commute f" - proof - interpret comp_fun_commute f by (rule f_comm) show ?thesis - apply(standard) - apply(rule cp_x) - apply(rule cp_set) - apply(rule cp_gen, assumption+) - apply(rule notempty, blast+) - apply(rule all_def) - by(subst fun_left_comm, simp) -qed - -sublocale EQ_comp_fun_commute < EQ_comp_fun_commute0_gen0_bis' "\<lambda>x. x" "\<lambda>_. is_int" "\<lambda>\<tau> x. \<tau> \<Turnstile> \<upsilon> x" all_int_set - apply(standard) - apply(simp add: all_int_set_def) apply(simp add: all_int_set_def) apply(simp add: all_int_set_def is_int_def) - apply(simp add: all_int_set_def) - apply(simp add: int_is_valid, simp) - apply(rule cp_set) - apply(rule iffI) - apply(rule conjI) apply(rule allI) apply(drule_tac x = \<tau> in allE) prefer 2 apply assumption apply(rule all_def[THEN iffD1, THEN conjunct1], blast) - apply(rule allI) apply(drule allE) prefer 2 apply assumption apply(rule all_def[THEN iffD1, THEN conjunct2], blast) - apply(erule conjE) apply(rule allI) apply(rule all_def[THEN iffD2], blast) - apply(rule ext, rename_tac \<tau>) - apply(rule commute) apply(blast)+ - apply(rule cp_gen, simp, blast, simp) - apply(rule notempty, blast, simp add: int_is_valid, simp) -done - -locale EQ_comp_fun_commute0_gen0 = - fixes f000 :: "'b \<Rightarrow> ('\<AA>, 'a option option) val" - fixes all_def_set :: "'\<AA> st \<Rightarrow> 'b set \<Rightarrow> bool" - fixes f :: "'b - \<Rightarrow> ('\<AA>, 'a option option) Set - \<Rightarrow> ('\<AA>, 'a option option) Set" - assumes def_set : "\<And>x A. (\<forall>\<tau>. all_def_set \<tau> (insert x A)) = (is_int (f000 x) \<and> (\<forall>\<tau>. all_def_set \<tau> A))" - assumes def_set' : "\<And>x A. (is_int (f000 x) \<and> (\<forall>\<tau>. all_def_set \<tau> A)) \<Longrightarrow> \<forall>\<tau>. all_def_set \<tau> (A - {x})" - assumes def_set_finite : "\<forall>\<tau>. all_def_set \<tau> A \<Longrightarrow> finite A" - assumes all_i_set_to_def : "all_int_set (f000 ` F) \<Longrightarrow> \<forall>\<tau>. all_def_set \<tau> F" - - assumes f000_inj : "\<And>x y. x \<noteq> y \<Longrightarrow> f000 x \<noteq> f000 y" - - assumes cp_gen' : "\<And>x S \<tau>1 \<tau>2. is_int (f000 x) \<Longrightarrow> \<forall>\<tau>. all_defined \<tau> S \<Longrightarrow> S \<tau>1 = S \<tau>2 \<Longrightarrow> f x S \<tau>1 = f x S \<tau>2" - assumes notempty' : "\<And>x S \<tau>. \<forall>\<tau>. all_defined \<tau> S \<Longrightarrow> is_int (f000 x) \<Longrightarrow> \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil> \<noteq> {} \<Longrightarrow> \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (f x S \<tau>)\<rceil>\<rceil> \<noteq> {}" - - assumes cp_set : "\<And>x S \<tau>. \<forall>\<tau>. all_defined \<tau> S \<Longrightarrow> f x S \<tau> = f x (\<lambda>_. S \<tau>) \<tau>" - assumes all_def: "\<And>x y. (\<forall>\<tau>. all_defined \<tau> (f x y)) = (is_int (f000 x) \<and> (\<forall>\<tau>. all_defined \<tau> y))" - assumes commute: "\<And>x y S. - is_int (f000 x) \<Longrightarrow> - is_int (f000 y) \<Longrightarrow> - (\<And>\<tau>. all_defined \<tau> S) \<Longrightarrow> - f y (f x S) = f x (f y S)" - -sublocale EQ_comp_fun_commute0_gen0 < EQ_comp_fun_commute0_gen0_bis' "\<lambda>x. x" "\<lambda>_ x. is_int (f000 x)" "\<lambda>_ x. is_int (f000 x)" "\<lambda>x. \<forall>\<tau>. all_def_set \<tau> x" - apply standard - apply(drule def_set[THEN iffD1], blast) - apply(simp add: def_set[THEN iffD2]) - apply(simp add: def_set') - apply(simp add: def_set_finite) - apply(simp) - apply(simp) - apply(rule cp_set, simp) - apply(insert all_def, blast) - apply(rule commute, blast+) - apply(rule cp_gen', blast+) - apply(rule notempty', blast+) -done - -locale EQ_comp_fun_commute0 = - fixes f :: "'a option option - \<Rightarrow> ('\<AA>, 'a option option) Set - \<Rightarrow> ('\<AA>, 'a option option) Set" - assumes cp_set : "\<And>x S \<tau>. \<forall>\<tau>. all_defined \<tau> S \<Longrightarrow> f x S \<tau> = f x (\<lambda>_. S \<tau>) \<tau>" - assumes cp_gen' : "\<And>x S \<tau>1 \<tau>2. is_int (\<lambda>(_::'\<AA> st). x) \<Longrightarrow> \<forall>\<tau>. all_defined \<tau> S \<Longrightarrow> S \<tau>1 = S \<tau>2 \<Longrightarrow> f x S \<tau>1 = f x S \<tau>2" - assumes notempty' : "\<And>x S \<tau>. \<forall>\<tau>. all_defined \<tau> S \<Longrightarrow> is_int (\<lambda>(_::'\<AA> st). x) \<Longrightarrow> \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil> \<noteq> {} \<Longrightarrow> \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (f x S \<tau>)\<rceil>\<rceil> \<noteq> {}" - assumes all_def: "\<And>x y. (\<forall>\<tau>. all_defined \<tau> (f x y)) = (is_int (\<lambda>(_::'\<AA> st). x) \<and> (\<forall>\<tau>. all_defined \<tau> y))" - assumes commute: "\<And>x y S. - is_int (\<lambda>(_::'\<AA> st). x) \<Longrightarrow> - is_int (\<lambda>(_::'\<AA> st). y) \<Longrightarrow> - (\<And>\<tau>. all_defined \<tau> S) \<Longrightarrow> - f y (f x S) = f x (f y S)" - -sublocale EQ_comp_fun_commute0 < EQ_comp_fun_commute0_gen0 "\<lambda>x (_::'\<AA> st). x" all_defined_set - apply standard - apply(rule iffI) - apply(simp add: all_defined_set_def is_int_def) - apply(simp add: all_defined_set_def is_int_def) - apply(simp add: all_defined_set_def is_int_def) - apply(simp add: all_defined_set_def) - apply(simp add: all_int_set_def all_defined_set_def int_is_valid) - apply(rule finite_imageD, blast, metis inj_onI) - apply metis - apply(rule cp_gen', simp, simp, simp) - apply(rule notempty', simp, simp, simp) - apply(rule cp_set, simp) - apply(rule all_def) - apply(rule commute, simp, simp, blast) -done - -locale EQ_comp_fun_commute000 = - fixes f :: "('\<AA>, 'a option option) val - \<Rightarrow> ('\<AA>, 'a option option) Set - \<Rightarrow> ('\<AA>, 'a option option) Set" - assumes cp_set : "\<And>x S \<tau>. \<forall>\<tau>. all_defined \<tau> S \<Longrightarrow> f (\<lambda>(_::'\<AA> st). x) S \<tau> = f (\<lambda>(_::'\<AA> st). x) (\<lambda>_. S \<tau>) \<tau>" - assumes all_def: "\<And>x y. (\<forall>\<tau>. all_defined \<tau> (f (\<lambda>(_::'\<AA> st). x) y)) = (is_int (\<lambda>(_ :: '\<AA> st). x) \<and> (\<forall>\<tau>. all_defined \<tau> y))" - assumes commute: "\<And>x y S. - is_int (\<lambda>(_::'\<AA> st). x) \<Longrightarrow> - is_int (\<lambda>(_::'\<AA> st). y) \<Longrightarrow> - (\<And>\<tau>. all_defined \<tau> S) \<Longrightarrow> - f (\<lambda>(_::'\<AA> st). y) (f (\<lambda>(_::'\<AA> st). x) S) = f (\<lambda>(_::'\<AA> st). x) (f (\<lambda>(_::'\<AA> st). y) S)" - -sublocale EQ_comp_fun_commute000 < EQ_comp_fun_commute0_gen0_bis'' "\<lambda>x (_::'\<AA> st). x" "\<lambda>_. is_int" "\<lambda>_. is_int" all_int_set - apply standard - apply(simp add: all_int_set_def is_int_def) - apply(simp add: all_int_set_def is_int_def) - apply(simp add: all_int_set_def) - apply(simp add: all_int_set_def) - apply(simp) - apply(metis) - apply(rule cp_set, simp) - apply(insert all_def, blast) - apply(rule commute, simp, simp, blast) -done - -lemma c0_of_c : - assumes f_comm : "EQ_comp_fun_commute f" - shows "EQ_comp_fun_commute0 (\<lambda>x. f (\<lambda>_. x))" -proof - interpret EQ_comp_fun_commute f by (rule f_comm) show ?thesis - apply standard - apply(rule cp_set) - apply(subst cp_gen, simp, blast, simp, simp) - apply(rule notempty, blast, simp add: int_is_valid, simp) - apply (metis (mono_tags) all_def is_int_def) - - apply(rule ext, rename_tac \<tau>) - apply(subst commute) - apply (metis is_int_def)+ - done -qed - -lemma c000_of_c0 : - assumes f_comm : "EQ_comp_fun_commute0 (\<lambda>x. f (\<lambda>_. x))" - shows "EQ_comp_fun_commute000 f" -proof - interpret EQ_comp_fun_commute0 "\<lambda>x. f (\<lambda>_. x)" by (rule f_comm) show ?thesis - apply standard - apply(rule cp_set, simp) - apply(rule all_def) - apply(rule commute) - apply(blast)+ - done -qed - -locale EQ_comp_fun_commute0' = - fixes f :: "'a option - \<Rightarrow> ('\<AA>, 'a option option) Set - \<Rightarrow> ('\<AA>, 'a option option) Set" - assumes cp_set : "\<And>x S \<tau>. \<forall>\<tau>. all_defined \<tau> S \<Longrightarrow> f x S \<tau> = f x (\<lambda>_. S \<tau>) \<tau>" - assumes cp_gen' : "\<And>x S \<tau>1 \<tau>2. is_int (\<lambda>(_::'\<AA> st). \<lfloor>x\<rfloor>) \<Longrightarrow> \<forall>\<tau>. all_defined \<tau> S \<Longrightarrow> S \<tau>1 = S \<tau>2 \<Longrightarrow> f x S \<tau>1 = f x S \<tau>2" - assumes notempty' : "\<And>x S \<tau>. \<forall>\<tau>. all_defined \<tau> S \<Longrightarrow> is_int (\<lambda>(_::'\<AA> st). \<lfloor>x\<rfloor>) \<Longrightarrow> \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil> \<noteq> {} \<Longrightarrow> \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (f x S \<tau>)\<rceil>\<rceil> \<noteq> {}" - assumes all_def: "\<And>x y. (\<forall>\<tau>. all_defined \<tau> (f x y)) = (is_int (\<lambda>(_::'\<AA> st). \<lfloor>x\<rfloor>) \<and> (\<forall>\<tau>. all_defined \<tau> y))" - assumes commute: "\<And>x y S. - is_int (\<lambda>(_::'\<AA> st). \<lfloor>x\<rfloor>) \<Longrightarrow> - is_int (\<lambda>(_::'\<AA> st). \<lfloor>y\<rfloor>) \<Longrightarrow> - (\<And>\<tau>. all_defined \<tau> S) \<Longrightarrow> - f y (f x S) = f x (f y S)" - -sublocale EQ_comp_fun_commute0' < EQ_comp_fun_commute0_gen0 "\<lambda>x (_::'\<AA> st). \<lfloor>x\<rfloor>" all_defined_set' - apply standard - apply(rule iffI) - apply(simp add: all_defined_set'_def is_int_def, metis bot_option_def foundation18' option.distinct(1)) - apply(simp add: all_defined_set'_def is_int_def) - apply(simp add: all_defined_set'_def is_int_def) - apply(simp add: all_defined_set'_def) - apply(simp add: all_int_set_def all_defined_set'_def int_is_valid) - apply(rule finite_imageD, blast, metis (full_types) UNIV_I inj_Some inj_fun subsetI subset_inj_on) - apply (metis option.inject) - apply(rule cp_gen', simp, simp, simp) - apply(rule notempty', simp, simp, simp) - apply(rule cp_set, simp) - apply(rule all_def) - apply(rule commute, simp, simp, blast) -done - -locale EQ_comp_fun_commute000' = - fixes f :: "('\<AA>, 'a option option) val - \<Rightarrow> ('\<AA>, 'a option option) Set - \<Rightarrow> ('\<AA>, 'a option option) Set" - assumes cp_set : "\<And>x S \<tau>. \<forall>\<tau>. all_defined \<tau> S \<Longrightarrow> f (\<lambda>_. \<lfloor>x\<rfloor>) S \<tau> = f (\<lambda>_. \<lfloor>x\<rfloor>) (\<lambda>_. S \<tau>) \<tau>" - assumes all_def: "\<And>x y (\<tau> :: '\<AA> st). (\<forall>(\<tau> :: '\<AA> st). all_defined \<tau> (f (\<lambda>(_ :: '\<AA> st). \<lfloor>x\<rfloor>) y)) = (\<tau> \<Turnstile> \<upsilon> (\<lambda>(_ :: '\<AA> st). \<lfloor>x\<rfloor>) \<and> (\<forall>(\<tau> :: '\<AA> st). all_defined \<tau> y))" - assumes commute: "\<And>x y S (\<tau> :: '\<AA> st). - \<tau> \<Turnstile> \<upsilon> (\<lambda>_. \<lfloor>x\<rfloor>) \<Longrightarrow> - \<tau> \<Turnstile> \<upsilon> (\<lambda>_. \<lfloor>y\<rfloor>) \<Longrightarrow> - (\<And>\<tau>. all_defined \<tau> S) \<Longrightarrow> - f (\<lambda>_. \<lfloor>y\<rfloor>) (f (\<lambda>_. \<lfloor>x\<rfloor>) S) = f (\<lambda>_. \<lfloor>x\<rfloor>) (f (\<lambda>_. \<lfloor>y\<rfloor>) S)" - -sublocale EQ_comp_fun_commute000' < EQ_comp_fun_commute0_gen0_bis'' "\<lambda>x (_::'\<AA> st). \<lfloor>x\<rfloor>" "\<lambda>\<tau> x. \<tau> \<Turnstile> \<upsilon> x" "\<lambda>\<tau> x. \<tau> \<Turnstile> \<upsilon> x" all_int_set - apply standard - apply(simp add: all_int_set_def is_int_def) - apply(simp add: all_int_set_def is_int_def) - apply(simp add: all_int_set_def) - apply(simp add: all_int_set_def) - apply(simp) - apply (metis option.inject) - apply(rule cp_set, simp) - apply(rule iffI) - apply(rule conjI, rule allI) - apply(rule all_def[THEN iffD1, THEN conjunct1], blast) - apply(rule all_def[THEN iffD1, THEN conjunct2], blast) - apply(rule all_def[THEN iffD2], blast) - apply(rule commute, blast+) -done - -lemma c0'_of_c0 : - assumes "EQ_comp_fun_commute0 (\<lambda>x. f (\<lambda>_. x))" - shows "EQ_comp_fun_commute0' (\<lambda>x. f (\<lambda>_. \<lfloor>x\<rfloor>))" -proof - - interpret EQ_comp_fun_commute0 "\<lambda>x. f (\<lambda>_. x)" by (rule assms) show ?thesis - apply standard - apply(rule cp_set, simp) - apply(rule cp_gen', simp, simp, simp) - apply(rule notempty', simp, simp, simp) - apply(rule all_def) - apply(rule commute) apply(blast)+ - done -qed - -lemma c000'_of_c0' : - assumes f_comm : "EQ_comp_fun_commute0' (\<lambda>x. f (\<lambda>_. \<lfloor>x\<rfloor>))" - shows "EQ_comp_fun_commute000' f" -proof - interpret EQ_comp_fun_commute0' "\<lambda>x. f (\<lambda>_. \<lfloor>x\<rfloor>)" by (rule f_comm) show ?thesis - apply standard - apply(rule cp_set, simp) - apply(subst all_def, simp only: is_int_def valid_def OclValid_def bot_fun_def false_def true_def, blast) - apply(rule commute) - apply(simp add: int_trivial)+ - done -qed - -context EQ_comp_fun_commute -begin - lemmas F_cp = cp_x - lemmas F_cp_set = cp_set - lemmas fold_fun_comm = fold_fun_comm[simplified] - lemmas fold_insert_remove = fold_insert_remove[simplified] - lemmas fold_insert = fold_insert'[simplified] - lemmas all_int_induct = all_int_induct[simplified] - lemmas all_defined_fold_rec = all_defined_fold_rec[simplified image_ident] - lemmas downgrade = downgrade -end - -context EQ_comp_fun_commute000 -begin - lemma fold_insert': - assumes z_defined : "\<And>\<tau>. all_defined \<tau> z" - and A_int : "all_int_set ((\<lambda>a (\<tau> :: '\<AA> st). a) ` A)" - and x_int : "is_int (\<lambda>(_ :: '\<AA> st). x)" - and x_nA : "x \<notin> A" - shows "Finite_Set.fold f z ((\<lambda>a (\<tau> :: '\<AA> st). a) ` (insert x A)) = f (\<lambda>(_ :: '\<AA> st). x) (Finite_Set.fold f z ((\<lambda>a (\<tau> :: '\<AA> st). a) ` A))" - apply(rule fold_insert', simp_all add: assms) - done - - lemmas all_defined_fold_rec = all_defined_fold_rec[simplified] - lemmas fold_def = fold_def -end - -context EQ_comp_fun_commute000' -begin - lemma fold_insert': - assumes z_defined : "\<And>\<tau>. all_defined \<tau> z" - and A_int : "all_int_set ((\<lambda>a (\<tau> :: '\<AA> st). \<lfloor>a\<rfloor>) ` A)" - and x_int : "is_int (\<lambda>(_ :: '\<AA> st). \<lfloor>x\<rfloor>)" - and x_nA : "x \<notin> A" - shows "Finite_Set.fold f z ((\<lambda>a (\<tau> :: '\<AA> st). \<lfloor>a\<rfloor>) ` (insert x A)) = f (\<lambda>(_ :: '\<AA> st). \<lfloor>x\<rfloor>) (Finite_Set.fold f z ((\<lambda>a (\<tau> :: '\<AA> st). \<lfloor>a\<rfloor>) ` A))" - apply(rule fold_insert', simp_all only: assms) - apply(insert x_int[simplified is_int_def], auto) - done - - lemmas fold_def = fold_def -end - -context EQ_comp_fun_commute0_gen0 -begin - lemma fold_insert: - assumes z_defined : "\<forall>(\<tau> :: '\<AA> st). all_defined \<tau> z" - and A_int : "\<forall>(\<tau> :: '\<AA> st). all_def_set \<tau> A" - and x_int : "is_int (f000 x)" - and "x \<notin> A" - shows "Finite_Set.fold f z (insert x A) = f x (Finite_Set.fold f z A)" - by(rule fold_insert'[simplified], simp_all add: assms) - - lemmas downgrade = downgrade -end - -context EQ_comp_fun_commute0 -begin - lemmas fold_insert = fold_insert - lemmas all_defined_fold_rec = all_defined_fold_rec[simplified image_ident] -end - -context EQ_comp_fun_commute0' -begin - lemmas fold_insert = fold_insert - lemmas all_defined_fold_rec = all_defined_fold_rec[simplified image_ident] -end - -subsection{* Misc *} - -lemma img_fold : - assumes g_comm : "EQ_comp_fun_commute0_gen0 f000 all_def_set (\<lambda>x. G (f000 x))" - and a_def : "\<forall>\<tau>. all_defined \<tau> A" - and fini : "all_int_set (f000 ` Fa)" - and g_fold_insert : "\<And>x F. x \<notin> F \<Longrightarrow> is_int (f000 x) \<Longrightarrow> all_int_set (f000 ` F) \<Longrightarrow> Finite_Set.fold G A (insert (f000 x) (f000 ` F)) = G (f000 x) (Finite_Set.fold G A (f000 ` F))" - shows "Finite_Set.fold (G :: ('\<AA>, _) val - \<Rightarrow> ('\<AA>, _) Set - \<Rightarrow> ('\<AA>, _) Set) A (f000 ` Fa) = - Finite_Set.fold (\<lambda>x. G (f000 x)) A Fa" -proof - - have invert_all_int_set : "\<And>x S. all_int_set (insert x S) \<Longrightarrow> - all_int_set S" - by(simp add: all_int_set_def) - have invert_int : "\<And>x S. all_int_set (insert x S) \<Longrightarrow> - is_int x" - by(simp add: all_int_set_def) - - interpret EQ_comp_fun_commute0_gen0 f000 all_def_set "\<lambda>x. G (f000 x)" by (rule g_comm) - show ?thesis - apply(rule finite_induct[where P = "\<lambda>set. let set' = f000 ` set in - all_int_set set' \<longrightarrow> - Finite_Set.fold G A set' = Finite_Set.fold (\<lambda>x. G (f000 x)) A set" - and F = Fa, simplified Let_def, THEN mp]) - apply(insert fini[simplified all_int_set_def, THEN conjunct1], rule finite_imageD, assumption) - apply (metis f000_inj inj_onI) - apply(simp) - apply(rule impI)+ - - apply(subgoal_tac "all_int_set (f000 ` F)", simp) - - apply(subst EQ_comp_fun_commute0_gen0.fold_insert[OF g_comm]) - apply(simp add: a_def) - apply(simp add: all_i_set_to_def) - apply(simp add: invert_int) - apply(simp) - apply(drule sym, simp only:) - apply(subst g_fold_insert, simp, simp add: invert_int, simp) - apply(simp) - - apply(rule invert_all_int_set, simp) - apply(simp add: fini) - done -qed - -context EQ_comp_fun_commute0_gen0 begin lemma downgrade' : "EQ_comp_fun_commute0_gen0 f000 all_def_set f" by standard end -context EQ_comp_fun_commute0 begin lemmas downgrade' = downgrade' end -context EQ_comp_fun_commute0' begin lemmas downgrade' = downgrade' end - -end diff --git a/Citadelle/examples/archive/Monads.thy b/Citadelle/examples/archive/Monads.thy deleted file mode 100644 index 9f5eddbdc0fc1722836104cbebf4ba3efe1b2e7d..0000000000000000000000000000000000000000 --- a/Citadelle/examples/archive/Monads.thy +++ /dev/null @@ -1,1003 +0,0 @@ -(****************************************************************************** - * HOL-TestGen --- theorem-prover based test case generation - * http://www.brucker.ch/projects/hol-testgen/ - * - * Monads.thy --- a base testing theory for sequential computations. - * This file is part of HOL-TestGen. - * - * Copyright (c) 2005-2007 ETH Zurich, Switzerland - * 2009 B. Wolff, Univ. Paris-Saclay, Univ. Paris-Sud, France - * 2009,2012 Achim D. Brucker, Germany - * 2013-2016 Université Paris-Saclay, Univ. Paris-Sud, France - * 2013-2016 IRT SystemX, France - * - * 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 {* Basic Monad Theory for Sequential Computations *} - -theory Monads imports Main -begin - - -section{*General Framework for Monad-based Sequence-Test *} -text{* As such, Higher-order Logic as a purely functional specification - formalism has no built-in mechanism for state and state-transitions. - Forms of testing involving state require therefore explicit mechanisms - for their treatment inside the logic; a well-known technique to model - states inside purely functional languages are \emph{monads} made popular - by Wadler and Moggi and extensively used in Haskell. \HOL is powerful - enough to represent the most important standard monads; - however, it is not possible to represent monads as such due to well-known - limitations of the Hindley-Milner type-system. *} - -text{* Here is a variant for state-exception monads, that models precisely - transition functions with preconditions. Next, we declare the - state-backtrack-monad. In all of them, our concept of i/o stepping - functions can be formulated; these are functions mapping input - to a given monad. Later on, we will build the usual concepts of: - \begin{enumerate} - \item deterministic i/o automata, - \item non-deterministic i/o automata, and - \item labelled transition systems (LTS) - \end{enumerate} -*} - -subsection{* Standard State Exception Monads *} -type_synonym ('o, '\<sigma>) MON\<^sub>S\<^sub>E = "'\<sigma> \<rightharpoonup> ('o \<times> '\<sigma>)" (* = '\<sigma> \<Rightarrow> ('o \<times> '\<sigma>)option *) - - -definition bind_SE :: "('o,'\<sigma>)MON\<^sub>S\<^sub>E \<Rightarrow> ('o \<Rightarrow> ('o','\<sigma>)MON\<^sub>S\<^sub>E) \<Rightarrow> ('o','\<sigma>)MON\<^sub>S\<^sub>E" -where "bind_SE f g = (\<lambda>\<sigma>. case f \<sigma> of None \<Rightarrow> None - | Some (out, \<sigma>') \<Rightarrow> g out \<sigma>')" - -notation bind_SE ("bind\<^sub>S\<^sub>E") - -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 _ \<leftarrow> _; _)" [5,8,8]8) -translations - "x \<leftarrow> f; g" == "CONST bind_SE f (% x . g)" - - -definition unit_SE :: "'o \<Rightarrow> ('o, '\<sigma>)MON\<^sub>S\<^sub>E" ("(return _)" 8) -where "unit_SE e = (\<lambda>\<sigma>. Some(e,\<sigma>))" -notation unit_SE ("unit\<^sub>S\<^sub>E") - -definition fail_SE :: "('o, '\<sigma>)MON\<^sub>S\<^sub>E" -where "fail_SE = (\<lambda>\<sigma>. None)" -notation fail_SE ("fail\<^sub>S\<^sub>E") - -definition assert_SE :: "('\<sigma> \<Rightarrow> bool) \<Rightarrow> (bool, '\<sigma>)MON\<^sub>S\<^sub>E" -where "assert_SE P = (\<lambda>\<sigma>. if P \<sigma> then Some(True,\<sigma>) else None)" -notation assert_SE ("assert\<^sub>S\<^sub>E") - -definition assume_SE :: "('\<sigma> \<Rightarrow> bool) \<Rightarrow> (unit, '\<sigma>)MON\<^sub>S\<^sub>E" -where "assume_SE P = (\<lambda>\<sigma>. if \<exists>\<sigma> . P \<sigma> then Some((), SOME \<sigma> . P \<sigma>) else None)" -notation assume_SE ("assume\<^sub>S\<^sub>E") - -text{* The standard monad theorems about unit and associativity: *} - -lemma bind_left_unit [simp]: "(x \<leftarrow> return c; P x) = P c" - by (simp add: unit_SE_def bind_SE_def) - - -lemma bind_left_fail_SE[simp] : "(x \<leftarrow> fail\<^sub>S\<^sub>E; P x) = fail\<^sub>S\<^sub>E" - by (simp add: fail_SE_def bind_SE_def) - - -lemma bind_right_unit[simp]: "(x \<leftarrow> m; return x) = m" - apply (simp add: unit_SE_def bind_SE_def) - apply (rule ext) - apply (case_tac "m \<sigma>", simp_all) - done - -lemma bind_assoc[simp]: "(y \<leftarrow> (x \<leftarrow> m; k x); h y) = (x \<leftarrow> m; (y \<leftarrow> k x; h y))" - apply (simp add: unit_SE_def bind_SE_def, rule ext) - apply (case_tac "m \<sigma>", simp_all) - apply (case_tac "a", simp_all) - done - - -text{* The bind-operator in the state-exception monad yields already - a semantics for the concept of an input sequence on the meta-level: *} -lemma syntax_test: "(o1 \<leftarrow> f1 ; o2 \<leftarrow> f2; return (post o1 o2)) = X" -oops - - - -subsection {* "Pipe-free" - variant of the bind. *} - -definition seq_SE :: "[('\<alpha>, '\<sigma>)MON\<^sub>S\<^sub>E, ('\<beta>, '\<sigma>)MON\<^sub>S\<^sub>E] \<Rightarrow> ('\<beta>, '\<sigma>)MON\<^sub>S\<^sub>E" (infixl ";-" 65) -where "f ;- g = (_ \<leftarrow> f ; g)" - - - -subsection {* Monadic If *} - -definition if_SE :: "['\<sigma> \<Rightarrow> bool, ('\<alpha>, '\<sigma>)MON\<^sub>S\<^sub>E, ('\<alpha>, '\<sigma>)MON\<^sub>S\<^sub>E] \<Rightarrow> ('\<alpha>, '\<sigma>)MON\<^sub>S\<^sub>E" -where "if_SE c E F = (\<lambda>\<sigma>. if c \<sigma> then E \<sigma> else F \<sigma>)" - -syntax (xsymbols) - "_if_SE" :: "['\<sigma> \<Rightarrow> bool,('o,'\<sigma>)MON\<^sub>S\<^sub>E,('o','\<sigma>)MON\<^sub>S\<^sub>E] \<Rightarrow> ('o','\<sigma>)MON\<^sub>S\<^sub>E" - ("(if\<^sub>S\<^sub>E _ then _ else _fi)" [5,8,8]8) -translations - "(if\<^sub>S\<^sub>E cond then T1 else T2 fi)" == "CONST if_SE cond T1 T2" - - - -subsubsection{* Theory of a Monadic While *} - -text{* First Step : Establishing an embedding between partial functions and relations *} -(* plongement *) -definition Mon2Rel :: "(unit, '\<sigma>)MON\<^sub>S\<^sub>E \<Rightarrow> ('\<sigma> \<times> '\<sigma>) set" -where "Mon2Rel f = {(x, y). (f x = Some((), y))}" -(* ressortir *) -definition Rel2Mon :: " ('\<sigma> \<times> '\<sigma>) set \<Rightarrow> (unit, '\<sigma>)MON\<^sub>S\<^sub>E " -where "Rel2Mon S = (\<lambda> \<sigma>. if \<exists>\<sigma>'. (\<sigma>, \<sigma>') \<in> S then Some((), SOME \<sigma>'. (\<sigma>, \<sigma>') \<in> S) else None)" - -lemma Mon2Rel_Rel2Mon_id: assumes det:"single_valued R" shows "(Mon2Rel \<circ> Rel2Mon) R = R" -apply (simp add: comp_def Mon2Rel_def Rel2Mon_def,auto) -apply (case_tac "\<exists>\<sigma>'. (a, \<sigma>') \<in> R", auto) -apply (subst some_eq_ex) back -apply (insert det[simplified single_valued_def]) -apply (auto) -done - -lemma Rel2Mon_Id: "(Rel2Mon \<circ> Mon2Rel) x = x" -apply (rule ext) -apply (auto simp: comp_def Mon2Rel_def Rel2Mon_def) -apply (erule contrapos_pp, drule HOL.not_sym, simp) -done - -lemma single_valued_Mon2Rel: "single_valued (Mon2Rel B)" -by (auto simp: single_valued_def Mon2Rel_def) - -text{* Second Step : Proving an induction principle allowing to establish that lfp remains - deterministic *} - - -(* Due to Tobias Nipkow *) -definition chain :: "(nat => 'a set) => bool" -where "chain S = (\<forall>i. S i \<subseteq> S(Suc i))" - -lemma chain_total: "chain S ==> S i \<le> S j \<or> S j \<le> S i" -by (metis chain_def le_cases lift_Suc_mono_le) - -definition cont :: "('a set => 'b set) => bool" -where "cont f = (\<forall>S. chain S \<longrightarrow> f(UN n. S n) = (UN n. f(S n)))" - -lemma mono_if_cont: fixes f :: "'a set => 'b set" - assumes "cont f" shows "mono f" -proof - fix a b :: "'a set" assume "a \<subseteq> b" - let ?S = "\<lambda>n::nat. if n=0 then a else b" - have "chain ?S" using `a \<subseteq> b` by(auto simp: chain_def) - hence "f(UN n. ?S n) = (UN n. f(?S n))" - using assms by(simp add: cont_def) - moreover have "(UN n. ?S n) = b" using `a \<subseteq> b` by (auto split: if_splits) - moreover have "(UN n. f(?S n)) = f a \<union> f b" by (auto split: if_splits) - ultimately show "f a \<subseteq> f b" by (metis Un_upper1) -qed - -lemma chain_iterates: fixes f :: "'a set => 'a set" - assumes "mono f" shows "chain(\<lambda>n. (f^^n) {})" -proof- - { fix n have "(f ^^ n) {} \<subseteq> (f ^^ Suc n) {}" using assms - by(induction n) (auto simp: mono_def) } - thus ?thesis by(auto simp: chain_def) -qed - -theorem lfp_if_cont: - assumes "cont f" shows "lfp f = (UN n. (f^^n) {})" (is "_ = ?U") -proof - show "lfp f \<subseteq> ?U" - proof (rule lfp_lowerbound) - have "f ?U = (UN n. (f^^Suc n){})" - using chain_iterates[OF mono_if_cont[OF assms]] assms - by(simp add: cont_def) - also have "\<dots> = (f^^0){} \<union> \<dots>" by simp - also have "\<dots> = ?U" - by(auto simp del: funpow.simps) (metis empty_iff funpow_0 old.nat.exhaust) - finally show "f ?U \<subseteq> ?U" by simp - qed -next - { fix n p assume "f p \<subseteq> p" - have "(f^^n){} \<subseteq> p" - proof(induction n) - case 0 show ?case by simp - next - case Suc - from monoD[OF mono_if_cont[OF assms] Suc] `f p \<subseteq> p` - show ?case by simp - qed - } - thus "?U \<subseteq> lfp f" by(auto simp: lfp_def) -qed - - -lemma single_valued_UN_chain: - assumes "chain S" "(!!n. single_valued (S n))" - shows "single_valued(UN n. S n)" -proof(auto simp: single_valued_def) - fix m n x y z assume "(x, y) \<in> S m" "(x, z) \<in> S n" - with chain_total[OF assms(1), of m n] assms(2) - show "y = z" by (auto simp: single_valued_def) -qed - -lemma single_valued_lfp: -fixes f :: "('a \<times> 'a) set => ('a \<times> 'a) set" -assumes "cont f" "\<And>r. single_valued r \<Longrightarrow> single_valued (f r)" -shows "single_valued(lfp f)" -unfolding lfp_if_cont[OF assms(1)] -proof(rule single_valued_UN_chain[OF chain_iterates[OF mono_if_cont[OF assms(1)]]]) - fix n show "single_valued ((f ^^ n) {})" - by(induction n)(auto simp: assms(2)) -qed - - -text{* Third Step: Definition of the Monadic While *} -definition \<Gamma> :: "['\<sigma> \<Rightarrow> bool,('\<sigma> \<times> '\<sigma>) set] \<Rightarrow> (('\<sigma> \<times> '\<sigma>) set \<Rightarrow> ('\<sigma> \<times> '\<sigma>) set)" -where "\<Gamma> b cd = (\<lambda>cw. {(s,t). if b s then (s, t) \<in> cd O cw else s = t})" - - -definition while_SE :: "['\<sigma> \<Rightarrow> bool, (unit, '\<sigma>)MON\<^sub>S\<^sub>E] \<Rightarrow> (unit, '\<sigma>)MON\<^sub>S\<^sub>E" -where "while_SE c B \<equiv> (Rel2Mon(lfp(\<Gamma> c (Mon2Rel B))))" - -syntax (xsymbols) - "_while_SE" :: "['\<sigma> \<Rightarrow> bool, (unit, '\<sigma>)MON\<^sub>S\<^sub>E] \<Rightarrow> (unit, '\<sigma>)MON\<^sub>S\<^sub>E" - ("(while\<^sub>S\<^sub>E _ do _ od)" [8,8]8) -translations - "while\<^sub>S\<^sub>E c do b od" == "CONST while_SE c b" - -lemma cont_\<Gamma>: "cont (\<Gamma> c b)" -by (auto simp: cont_def \<Gamma>_def) - -text{* The fixpoint theory now allows us to establish that the lfp constructed over - @{term Mon2Rel} remains deterministic *} - -theorem single_valued_lfp_Mon2Rel: "single_valued (lfp(\<Gamma> c (Mon2Rel B)))" -apply(rule single_valued_lfp, simp_all add: cont_\<Gamma>) -apply(auto simp: \<Gamma>_def single_valued_def) -apply(metis single_valued_Mon2Rel[of "B"] single_valued_def) -done - - -lemma Rel2Mon_if: - "Rel2Mon {(s, t). if b s then (s, t) \<in> Mon2Rel c O lfp (\<Gamma> b (Mon2Rel c)) else s = t} \<sigma> = - (if b \<sigma> then Rel2Mon (Mon2Rel c O lfp (\<Gamma> b (Mon2Rel c))) \<sigma> else Some ((), \<sigma>))" -by (simp add: Rel2Mon_def) - -lemma Rel2Mon_homomorphism: - assumes determ_X: "single_valued X" and determ_Y: "single_valued Y" - shows "Rel2Mon (X O Y) = (Rel2Mon X) ;- (Rel2Mon Y)" -proof - - have relational_partial_next_in_O: "!!x E F. (\<exists>y. (x, y) \<in> (E O F)) \<Longrightarrow> (\<exists>y. (x, y) \<in> E)" - by (auto) - have some_eq_intro: "\<And>X x y . single_valued X \<Longrightarrow> (x, y) \<in> X \<Longrightarrow> (SOME y. (x, y) \<in> X) = y" - by (auto simp: single_valued_def) - -show ?thesis -apply (simp add: Rel2Mon_def seq_SE_def bind_SE_def) -apply (rule ext, rename_tac "\<sigma>") -apply (case_tac " \<exists>\<sigma>'. (\<sigma>, \<sigma>') \<in> X O Y") -apply (simp only: HOL.if_True) -apply (frule relational_partial_next_in_O) -apply (auto) -apply (insert determ_X determ_Y) - -apply (subgoal_tac "(SOME \<sigma>'. (x, \<sigma>') \<in> X) = y") -apply (simp) - apply (subgoal_tac "(SOME \<sigma>'. (y, \<sigma>') \<in> Y) = z") - apply (simp) - apply (subgoal_tac "(SOME \<sigma>'. (x, \<sigma>') \<in> X O Y) = z") - apply (simp) - apply (auto simp: single_valued_def) -apply (subgoal_tac "(SOME \<sigma>'. (x, \<sigma>') \<in> X) = ya") - apply (simp_all) -apply (subgoal_tac "(SOME \<sigma>'. (ya, \<sigma>') \<in> Y) = \<sigma>''") - apply (simp_all) -apply (subgoal_tac "(SOME \<sigma>'. (x, \<sigma>') \<in> X O Y) = \<sigma>''") - apply (assumption) -apply (subgoal_tac "single_valued (X O Y)") - apply (fold single_valued_def) - apply (subgoal_tac "(x, \<sigma>'') \<in> X O Y") - apply (auto, rule some_eq_intro) - apply (auto, rule Relation.relcomp.relcompI Relation.single_valued_relcomp, auto) - -apply (rule_tac x=z in exI) -apply (rule someI2) -apply (assumption)+ -apply (simp add: single_valued_def) -apply (metis) - -apply (erule contrapos_pp) -apply (simp) -apply (rule_tac x=\<sigma>' in exI) - apply (subgoal_tac "(SOME \<sigma>'. (\<sigma>, \<sigma>') \<in> X) = \<sigma>''") - apply (auto) - apply (auto simp: single_valued_def) -done -qed - -text{* Putting everything together, the theory of embedding and the invariance of - determinism of the while-body, gives us the usual unfold-theorem: *} -theorem "(while\<^sub>S\<^sub>E b do c od) = (if\<^sub>S\<^sub>E b then (c ;- (while\<^sub>S\<^sub>E b do c od)) else return () fi)" -apply (simp add: if_SE_def seq_SE_def while_SE_def unit_SE_def) -apply (subst lfp_unfold [OF mono_if_cont, OF cont_\<Gamma>]) -apply (rule ext) -apply (subst \<Gamma>_def) -apply (auto simp: Rel2Mon_if Rel2Mon_homomorphism seq_SE_def Rel2Mon_Id [simplified comp_def] - single_valued_Mon2Rel single_valued_lfp_Mon2Rel ) -done - - - -subsection{* Multi-binds *} - -text{* In order to express test-sequences also on the object-level and -to make our theory amenable to formal reasoning over test-sequences, -we represent them as lists of input and generalize the bind-operator -of the state-exception monad accordingly. The approach is straightforward, -but comes with a price: we have to encapsulate all input and output data -into one type. Assume that we have a typed interface to a module with -the operations $op_1$, $op_2$, \ldots, $op_n$ with the inputs -$\iota_1$, $\iota_2$, \ldots, $\iota_n$ (outputs are treated analogously). -Then we can encode for this interface the general input - type: -\begin{displaymath} -\texttt{datatype}\ \texttt{in}\ =\ op_1\ ::\ \iota_1\ |\ ...\ |\ \iota_n -\end{displaymath} -Obviously, we loose some type-safety in this approach; we have to express -that in traces only \emph{corresponding} input and output belonging to the -same operation will occur; this form of side-conditions have to be expressed -inside \HOL. From the user perspective, this will not make much difference, -since junk-data resulting from too weak typing can be ruled out by adopted -front-ends. -*} - -text{* Note that the subsequent notion of a test-sequence allows the io stepping -function (and the special case of a program under test) to stop execution -\emph{within} the sequence; such premature terminations are characterized by an -output list which is shorter than the input list. *} - -fun mbind :: "'\<iota> list \<Rightarrow> ('\<iota> \<Rightarrow> ('o,'\<sigma>) MON\<^sub>S\<^sub>E) \<Rightarrow> ('o list,'\<sigma>) MON\<^sub>S\<^sub>E" -where "mbind [] iostep \<sigma> = Some([], \<sigma>)" | - "mbind (a#H) iostep \<sigma> = - (case iostep a \<sigma> of - None \<Rightarrow> Some([], \<sigma>) - | Some (out, \<sigma>') \<Rightarrow> (case mbind H iostep \<sigma>' of - None \<Rightarrow> Some([out],\<sigma>') - | Some(outs,\<sigma>'') \<Rightarrow> Some(out#outs,\<sigma>'')))" - -notation mbind ("mbind\<^sub>F\<^sub>a\<^sub>i\<^sub>l\<^sub>S\<^sub>a\<^sub>v\<^sub>e") (* future name: mbind\<^sub>F\<^sub>a\<^sub>i\<^sub>l\<^sub>S\<^sub>a\<^sub>v\<^sub>e *) - -text{* This definition is fail-safe; in case of an exception, the current state is maintained, - the computation as a whole is marked as success. - Compare to the fail-strict variant @{text "mbind'"}: *} - -lemma mbind_unit [simp]: - "mbind [] f = (return [])" - by(rule ext, simp add: unit_SE_def) - -text{* The characteristic property of @{term mbind} --- which distinguishes it from - @{text mbind'} defined in the sequel --- is that it never fails; it ``swallows'' internal - errors occurring during the computation. *} -lemma mbind_nofailure [simp]: - "mbind S f \<sigma> \<noteq> None" - apply(rule_tac x=\<sigma> in spec) - apply(induct S, auto simp:unit_SE_def) - apply(case_tac "f a x", auto) - apply(erule_tac x="b" in allE) - apply(erule exE, erule exE, simp) - done - - -fun mbind' :: "'\<iota> list \<Rightarrow> ('\<iota> \<Rightarrow> ('o,'\<sigma>) MON\<^sub>S\<^sub>E) \<Rightarrow> ('o list,'\<sigma>) MON\<^sub>S\<^sub>E" -where "mbind' [] iostep \<sigma> = Some([], \<sigma>)" | - "mbind' (a#S) iostep \<sigma> = - (case iostep a \<sigma> of - None \<Rightarrow> None - | Some (out, \<sigma>') \<Rightarrow> (case mbind' S iostep \<sigma>' of - None \<Rightarrow> None (* fail-strict *) - | Some(outs,\<sigma>'') \<Rightarrow> Some(out#outs,\<sigma>'')))" -notation mbind' ("mbind\<^sub>F\<^sub>a\<^sub>i\<^sub>l\<^sub>S\<^sub>t\<^sub>o\<^sub>p") (* future name: mbind\<^sub>F\<^sub>a\<^sub>i\<^sub>l\<^sub>S\<^sub>t\<^sub>o\<^sub>p *) - -lemma mbind'_unit [simp]: - "mbind' [] f = (return [])" - by(rule ext, simp add: unit_SE_def) - -lemma mbind'_bind [simp]: - "(x \<leftarrow> mbind' (a#S) F; M x) = (a \<leftarrow> (F a); (x \<leftarrow> mbind' S F; M (a # x)))" - by(rule ext, rename_tac "z",simp add: bind_SE_def split: option.split) - -declare mbind'.simps[simp del] (* use only more abstract definitions *) - - -fun mbind'' :: "'\<iota> list \<Rightarrow> ('\<iota> \<Rightarrow> ('o,'\<sigma>) MON\<^sub>S\<^sub>E) \<Rightarrow> ('o list,'\<sigma>) MON\<^sub>S\<^sub>E" -where "mbind'' [] iostep \<sigma> = Some([], \<sigma>)" | - "mbind'' (a#S) iostep \<sigma> = - (case iostep a \<sigma> of - None \<Rightarrow> mbind'' S iostep \<sigma> - | Some (out, \<sigma>') \<Rightarrow> (case mbind'' S iostep \<sigma>' of - None \<Rightarrow> None (* does not occur *) - | Some(outs,\<sigma>'') \<Rightarrow> Some(out#outs,\<sigma>'')))" - -notation mbind'' ("mbind\<^sub>F\<^sub>a\<^sub>i\<^sub>l\<^sub>P\<^sub>u\<^sub>r\<^sub>g\<^sub>e") (* future name: mbind\<^sub>P\<^sub>u\<^sub>r\<^sub>g\<^sub>e\<^sub>F\<^sub>a\<^sub>i\<^sub>l *) -declare mbind''.simps[simp del] (* use only more abstract definitions *) - - -text{* mbind' as failure strict operator can be seen as a foldr on bind - - if the types would match \ldots *} - -definition try_SE :: "('o,'\<sigma>) MON\<^sub>S\<^sub>E \<Rightarrow> ('o option,'\<sigma>) MON\<^sub>S\<^sub>E" ("try\<^sub>S\<^sub>E") -where "try\<^sub>S\<^sub>E ioprog = (\<lambda>\<sigma>. case ioprog \<sigma> of - None \<Rightarrow> Some(None, \<sigma>) - | Some(outs, \<sigma>') \<Rightarrow> Some(Some outs, \<sigma>'))" -text{* In contrast, mbind as a failure safe operator can roughly be seen - as a foldr on bind - try: - m1 ; try m2 ; try m3; ... Note, that the rough equivalence only holds for - certain predicates in the sequence - length equivalence modulo None, - for example. However, if a conditional is added, the equivalence - can be made precise: *} - -lemma mbind_try: - "(x \<leftarrow> mbind (a#S) F; M x) = - (a' \<leftarrow> try\<^sub>S\<^sub>E(F a); - if a' = None - then (M []) - else (x \<leftarrow> mbind S F; M (the a' # x)))" -apply(rule ext) -apply(simp add: bind_SE_def try_SE_def) -apply(case_tac "F a x", auto) -apply(simp add: bind_SE_def try_SE_def) -apply(case_tac "mbind S F b", auto) -done - -text{* On this basis, a symbolic evaluation scheme can be established - that reduces mbind-code to try\_SE\_code and ite-cascades. *} - -definition alt_SE :: "[('o, '\<sigma>)MON\<^sub>S\<^sub>E, ('o, '\<sigma>)MON\<^sub>S\<^sub>E] \<Rightarrow> ('o, '\<sigma>)MON\<^sub>S\<^sub>E" (infixl "\<sqinter>\<^sub>S\<^sub>E" 10) -where "(f \<sqinter>\<^sub>S\<^sub>E g) = (\<lambda> \<sigma>. case f \<sigma> of None \<Rightarrow> g \<sigma> - | Some H \<Rightarrow> Some H)" - -definition malt_SE :: "('o, '\<sigma>)MON\<^sub>S\<^sub>E list \<Rightarrow> ('o, '\<sigma>)MON\<^sub>S\<^sub>E" -where "malt_SE S = foldr alt_SE S fail\<^sub>S\<^sub>E" -notation malt_SE ("\<Sqinter>\<^sub>S\<^sub>E") - -lemma malt_SE_mt [simp]: "\<Sqinter>\<^sub>S\<^sub>E [] = fail\<^sub>S\<^sub>E" -by(simp add: malt_SE_def) - -lemma malt_SE_cons [simp]: "\<Sqinter>\<^sub>S\<^sub>E (a # S) = (a \<sqinter>\<^sub>S\<^sub>E (\<Sqinter>\<^sub>S\<^sub>E S))" -by(simp add: malt_SE_def) - - -subsection{* State Backtrack Monads *} -text{*This subsection is still rudimentary and as such an interesting -formal analogue to the previous monad definitions. It is doubtful that it is -interesting for testing and as a cmputational stucture at all. -Clearly more relevant is ``sequence'' instead of ``set,'' which would -rephrase Isabelle's internal tactic concept. *} - -type_synonym ('o, '\<sigma>) MON\<^sub>S\<^sub>B = "'\<sigma> \<Rightarrow> ('o \<times> '\<sigma>) set" - -definition bind_SB :: "('o, '\<sigma>)MON\<^sub>S\<^sub>B \<Rightarrow> ('o \<Rightarrow> ('o', '\<sigma>)MON\<^sub>S\<^sub>B) \<Rightarrow> ('o', '\<sigma>)MON\<^sub>S\<^sub>B" -where "bind_SB f g \<sigma> = \<Union> ((\<lambda>(out, \<sigma>). (g out \<sigma>)) ` (f \<sigma>))" -notation bind_SB ("bind\<^sub>S\<^sub>B") - -definition unit_SB :: "'o \<Rightarrow> ('o, '\<sigma>)MON\<^sub>S\<^sub>B" ("(returns _)" 8) -where "unit_SB e = (\<lambda>\<sigma>. {(e,\<sigma>)})" -notation unit_SB ("unit\<^sub>S\<^sub>B") - -syntax (xsymbols) - "_bind_SB" :: "[pttrn,('o,'\<sigma>)MON\<^sub>S\<^sub>B,('o','\<sigma>)MON\<^sub>S\<^sub>B] \<Rightarrow> ('o','\<sigma>)MON\<^sub>S\<^sub>B" - ("(2 _ := _; _)" [5,8,8]8) -translations - "x := f; g" == "CONST bind_SB f (% x . g)" - - - -lemma bind_left_unit_SB : "(x := returns a; m x) = m a" - by (rule ext,simp add: unit_SB_def bind_SB_def) - -lemma bind_right_unit_SB: "(x := m; returns x) = m" - by (rule ext, simp add: unit_SB_def bind_SB_def) - - -lemma bind_assoc_SB: "(y := (x := m; k x); h y) = (x := m; (y := k x; h y))" - by (rule ext, simp add: unit_SB_def bind_SB_def split_def) - - -subsection{* State Backtrack Exception Monad (vulgo: Boogie-PL) *} -text{* The following combination of the previous two Monad-Constructions -allows for the semantic foundation of a simple generic assertion language -in the style of Schirmers Simpl-Language or Rustan Leino's Boogie-PL language. -The key is to use the exceptional element None for violations of -the assert-statement. *} -type_synonym ('o, '\<sigma>) MON\<^sub>S\<^sub>B\<^sub>E = "'\<sigma> \<Rightarrow> (('o \<times> '\<sigma>) set) option" - - -definition bind_SBE :: "('o,'\<sigma>)MON\<^sub>S\<^sub>B\<^sub>E \<Rightarrow> ('o \<Rightarrow> ('o','\<sigma>)MON\<^sub>S\<^sub>B\<^sub>E) \<Rightarrow> ('o','\<sigma>)MON\<^sub>S\<^sub>B\<^sub>E" -where "bind_SBE f g = (\<lambda>\<sigma>. case f \<sigma> of None \<Rightarrow> None - | Some S \<Rightarrow> (let S' = (\<lambda>(out, \<sigma>'). g out \<sigma>') ` S - in if None \<in> S' then None - else Some(\<Union> (the ` S'))))" - -syntax (xsymbols) - "_bind_SBE" :: "[pttrn,('o,'\<sigma>)MON\<^sub>S\<^sub>B\<^sub>E,('o','\<sigma>)MON\<^sub>S\<^sub>B\<^sub>E] \<Rightarrow> ('o','\<sigma>)MON\<^sub>S\<^sub>B\<^sub>E" - ("(2 _ :\<equiv> _; _)" [5,8,8]8) -translations - "x :\<equiv> f; g" == "CONST bind_SBE f (% x . g)" - -definition unit_SBE :: "'o \<Rightarrow> ('o, '\<sigma>)MON\<^sub>S\<^sub>B\<^sub>E" ("(returning _)" 8) -where "unit_SBE e = (\<lambda>\<sigma>. Some({(e,\<sigma>)}))" - -definition assert_SBE :: "('\<sigma> \<Rightarrow> bool) \<Rightarrow> (unit, '\<sigma>)MON\<^sub>S\<^sub>B\<^sub>E" -where "assert_SBE e = (\<lambda>\<sigma>. if e \<sigma> then Some({((),\<sigma>)}) - else None)" -notation assert_SBE ("assert\<^sub>S\<^sub>B\<^sub>E") - -definition assume_SBE :: "('\<sigma> \<Rightarrow> bool) \<Rightarrow> (unit, '\<sigma>)MON\<^sub>S\<^sub>B\<^sub>E" -where "assume_SBE e = (\<lambda>\<sigma>. if e \<sigma> then Some({((),\<sigma>)}) - else Some {})" -notation assume_SBE ("assume\<^sub>S\<^sub>B\<^sub>E") - - -definition havoc_SBE :: " (unit, '\<sigma>)MON\<^sub>S\<^sub>B\<^sub>E" -where "havoc_SBE = (\<lambda>\<sigma>. Some({x. True}))" -notation havoc_SBE ("havoc\<^sub>S\<^sub>B\<^sub>E") - - -lemma bind_left_unit_SBE : "(x :\<equiv> returning a; m x) = m a" -by (rule ext,simp add: unit_SBE_def bind_SBE_def) - -lemma bind_right_unit_SBE: "(x :\<equiv> m; returning x) = m" - apply (rule ext, simp add: unit_SBE_def bind_SBE_def) - apply (case_tac "m x", simp_all add:Let_def) - apply (rule HOL.ccontr, simp add: Set.image_iff) - done - - -lemmas aux = trans[OF HOL.neq_commute,OF Option.not_None_eq] - -lemma bind_assoc_SBE: "(y :\<equiv> (x :\<equiv> m; k); h y) = (x :\<equiv> m; (y :\<equiv> k; h y))" -proof (rule ext, rename_tac z, simp add: unit_SBE_def bind_SBE_def, - case_tac "m z", simp_all add: Let_def Set.image_iff, safe) - case goal1 then show ?case - by(rule_tac x="(a, b)" in bexI, simp_all) -next - case goal2 then show ?case - apply(rule_tac x="(aa,b)" in bexI, simp_all add:split_def) - apply(erule_tac x="(aa,b)" in ballE) - apply(auto simp: aux image_def split_def intro!: rev_bexI) - done -next - case goal3 then show ?case - by(rule_tac x="(a, b)" in bexI, simp_all) -next - case goal4 then show ?case - apply(erule_tac Q="None = (* FIXME to be shorten *) (case k b of None \<Rightarrow> None | Some S \<Rightarrow> let S' = (\<lambda>(x, y). h x y) ` S in if None \<in> S' then None else Some (\<Union>(the ` S')))" in contrapos_pp) - apply(erule_tac x="(aa,b)" in ballE) - apply(auto simp: aux Option.not_None_eq image_def split_def intro!: rev_bexI) - done -next - case goal5 then show ?case - apply simp apply((erule_tac x="(ab,ba)" in ballE)+) - apply(simp_all add: aux Option.not_None_eq, (erule exE)+, simp add:split_def) - apply(erule rev_bexI,case_tac "None\<in>(\<lambda>p. h (fst p) (snd p))`y",auto simp:split_def) - done - -next - case goal6 then show ?case - apply simp apply((erule_tac x="(a,b)" in ballE)+) - apply(simp_all add: aux Option.not_None_eq, (erule exE)+, simp add:split_def) - apply(erule rev_bexI, case_tac "None\<in>(\<lambda>p. h(fst p)(snd p))`y",auto simp:split_def) - done -qed - - - -(* TODO: IF THEN ELSE and WHILE + Monadic Laws + Operational Rules. *) - - - -section{* Valid Execution Sequences in the State Exception Monad *} -text{* This is still an unstructured merge of executable monad concepts -and specification oriented high-level properties initiating test procedures. *} - -definition valid_SE :: "'\<sigma> \<Rightarrow> (bool,'\<sigma>) MON\<^sub>S\<^sub>E \<Rightarrow> bool" (infix "\<Turnstile>" 15) -where "(\<sigma> \<Turnstile> m) = (m \<sigma> \<noteq> None \<and> fst(the (m \<sigma>)))" -text{* This notation consideres failures as valid -- a definition -inspired by I/O conformance. BUG: It is not possible to define -this concept once and for all in a Hindley-Milner type-system. -For the moment, we present it only for the state-exception -monad, although for the same definition, this notion is applicable -to other monads as well. *} - - -lemma exec_unit_SE [simp]: "(\<sigma> \<Turnstile> (return P)) = (P)" -by(auto simp: valid_SE_def unit_SE_def) - -lemma exec_unit_SE' [simp]: "(\<sigma>\<^sub>0 \<Turnstile> (\<lambda>\<sigma>. Some (f \<sigma>, \<sigma>))) = (f \<sigma>\<^sub>0)" -by(simp add: valid_SE_def ) - -lemma exec_fail_SE [simp]: "(\<sigma> \<Turnstile> fail\<^sub>S\<^sub>E) = False" -by(auto simp: valid_SE_def fail_SE_def) - - -lemma exec_fail_SE'[simp]: "\<not>(\<sigma>\<^sub>0 \<Turnstile> (\<lambda>\<sigma>. None))" -by(simp add: valid_SE_def ) - -lemma exec_bind_SE_failure: -"A \<sigma> = None \<Longrightarrow> \<not>(\<sigma> \<Turnstile> ((s \<leftarrow> A ; M s)))" -by(simp add: valid_SE_def unit_SE_def bind_SE_def) - -lemma exec_bind_SE_success: -"A \<sigma> = Some(b,\<sigma>') \<Longrightarrow> (\<sigma> \<Turnstile> ((s \<leftarrow> A ; M s))) = (\<sigma>' \<Turnstile> (M b))" -by(simp add: valid_SE_def unit_SE_def bind_SE_def ) - -lemma exec_bind_SE_success': (* atomic boolean Monad "Query Functions" *) -"M \<sigma> = Some(f \<sigma>,\<sigma>) \<Longrightarrow> (\<sigma> \<Turnstile> M) = f \<sigma>" -by(simp add: valid_SE_def unit_SE_def bind_SE_def ) - - - -lemma exec_bind_SE_success'': -"\<sigma> \<Turnstile> ((s \<leftarrow> A ; M s)) \<Longrightarrow> \<exists> v \<sigma>'. the(A \<sigma>) = (v,\<sigma>') \<and> \<sigma>' \<Turnstile> (M v)" -apply(auto simp: valid_SE_def unit_SE_def bind_SE_def) -apply(cases "A \<sigma>", simp_all) -apply(simp add: case_prod_unfold) -apply(drule_tac x="A \<sigma>" and f=the in arg_cong, simp) -apply(rule_tac x="fst aa" in exI) -apply(rule_tac x="snd aa" in exI, auto) -done - - -lemma exec_bind_SE_success''': -"\<sigma> \<Turnstile> ((s \<leftarrow> A ; M s)) \<Longrightarrow> \<exists> a. (A \<sigma>) = Some a \<and> (snd a) \<Turnstile> (M (fst a))" -apply(auto simp: valid_SE_def unit_SE_def bind_SE_def) -apply(cases "A \<sigma>", simp_all) -apply(simp_all add: case_prod_unfold - split: prod.splits) -apply(drule_tac x="A \<sigma>" and f=the in arg_cong, simp) -apply(rule_tac x="fst aa" in exI) -apply(rule_tac x="snd aa" in exI, auto) -done - - -lemma exec_bind_SE_success'''' : -"\<sigma> \<Turnstile> ((s \<leftarrow> A ; M s)) \<Longrightarrow> \<exists> v \<sigma>'. A \<sigma> = Some(v,\<sigma>') \<and> \<sigma>' \<Turnstile> (M v)" -apply(auto simp: valid_SE_def unit_SE_def bind_SE_def) -apply(cases "A \<sigma>", simp_all) -apply(simp add: case_prod_unfold) -apply(drule_tac x="A \<sigma>" and f=the in arg_cong, simp) -apply(rule_tac x="fst aa" in exI) -apply(rule_tac x="snd aa" in exI, auto) -done - - -text{* Recall \verb+mbind_unit+ for the base case. *} - -lemma exec_mbindFSave_failure: -"ioprog a \<sigma> = None \<Longrightarrow> - (\<sigma> \<Turnstile> (s \<leftarrow> mbind\<^sub>F\<^sub>a\<^sub>i\<^sub>l\<^sub>S\<^sub>a\<^sub>v\<^sub>e (a#S) ioprog ; M s)) = (\<sigma> \<Turnstile> (M []))" -by(simp add: valid_SE_def unit_SE_def bind_SE_def) - -lemma exec_mbindFStop_failure: -"ioprog a \<sigma> = None \<Longrightarrow> - (\<sigma> \<Turnstile> (s \<leftarrow> mbind\<^sub>F\<^sub>a\<^sub>i\<^sub>l\<^sub>S\<^sub>t\<^sub>o\<^sub>p (a#S) ioprog ; M s)) = (False)" -by(simp add: exec_bind_SE_failure) - -lemma exec_mbindFPurge_failure: -"ioprog a \<sigma> = None \<Longrightarrow> - (\<sigma> \<Turnstile> (s \<leftarrow> mbind\<^sub>F\<^sub>a\<^sub>i\<^sub>l\<^sub>P\<^sub>u\<^sub>r\<^sub>g\<^sub>e (a#S) ioprog ; M s)) = (\<sigma> \<Turnstile> (s \<leftarrow> mbind\<^sub>F\<^sub>a\<^sub>i\<^sub>l\<^sub>P\<^sub>u\<^sub>r\<^sub>g\<^sub>e (S) ioprog ; M s))" -by(simp add: valid_SE_def unit_SE_def bind_SE_def mbind''.simps) - - -lemma exec_mbindFSave_success : -"ioprog a \<sigma> = Some(b,\<sigma>') \<Longrightarrow> - (\<sigma> \<Turnstile> (s \<leftarrow> mbind\<^sub>F\<^sub>a\<^sub>i\<^sub>l\<^sub>S\<^sub>a\<^sub>v\<^sub>e (a#S) ioprog ; M s)) = - (\<sigma>' \<Turnstile> (s \<leftarrow> mbind\<^sub>F\<^sub>a\<^sub>i\<^sub>l\<^sub>S\<^sub>a\<^sub>v\<^sub>e S ioprog ; M (b#s)))" -unfolding valid_SE_def unit_SE_def bind_SE_def -by(cases "mbind\<^sub>F\<^sub>a\<^sub>i\<^sub>l\<^sub>S\<^sub>a\<^sub>v\<^sub>e S ioprog \<sigma>'", auto) - -lemma exec_mbindFStop_success : -"ioprog a \<sigma> = Some(b,\<sigma>') \<Longrightarrow> - (\<sigma> \<Turnstile> (s \<leftarrow> mbind\<^sub>F\<^sub>a\<^sub>i\<^sub>l\<^sub>S\<^sub>t\<^sub>o\<^sub>p (a#S) ioprog ; M s)) = - (\<sigma>' \<Turnstile> (s \<leftarrow> mbind\<^sub>F\<^sub>a\<^sub>i\<^sub>l\<^sub>S\<^sub>t\<^sub>o\<^sub>p S ioprog ; M (b#s)))" -unfolding valid_SE_def unit_SE_def bind_SE_def -by(cases "mbind\<^sub>F\<^sub>a\<^sub>i\<^sub>l\<^sub>S\<^sub>t\<^sub>o\<^sub>p S ioprog \<sigma>'", auto simp: mbind'.simps) - -lemma exec_mbindFPurge_success : -"ioprog a \<sigma> = Some(b,\<sigma>') \<Longrightarrow> - (\<sigma> \<Turnstile> (s \<leftarrow> mbind\<^sub>F\<^sub>a\<^sub>i\<^sub>l\<^sub>P\<^sub>u\<^sub>r\<^sub>g\<^sub>e (a#S) ioprog ; M s)) = - (\<sigma>' \<Turnstile> (s \<leftarrow> mbind\<^sub>F\<^sub>a\<^sub>i\<^sub>l\<^sub>P\<^sub>u\<^sub>r\<^sub>g\<^sub>e S ioprog ; M (b#s)))" -unfolding valid_SE_def unit_SE_def bind_SE_def -by(cases "mbind\<^sub>F\<^sub>a\<^sub>i\<^sub>l\<^sub>P\<^sub>u\<^sub>r\<^sub>g\<^sub>e S ioprog \<sigma>'", auto simp: mbind''.simps) - -lemma exec_mbindFSave: -"(\<sigma> \<Turnstile> (s \<leftarrow> mbind (a#S) ioprog ; return (P s))) = - (case ioprog a \<sigma> of - None \<Rightarrow> (\<sigma> \<Turnstile> (return (P []))) - | Some(b,\<sigma>') \<Rightarrow> (\<sigma>' \<Turnstile> (s \<leftarrow> mbind S ioprog ; return (P (b#s)))))" -apply(case_tac "ioprog a \<sigma>") -by(auto simp: exec_mbindFSave_failure exec_mbindFSave_success split: prod.splits) - - -text{* Universal splitting and symbolic execution rule *} -lemma exec_mbindFSave_E: -assumes seq : "(\<sigma> \<Turnstile> (s \<leftarrow> mbind\<^sub>F\<^sub>a\<^sub>i\<^sub>l\<^sub>S\<^sub>a\<^sub>v\<^sub>e (a#S) ioprog ; (P s)))" - and none: "ioprog a \<sigma> = None \<Longrightarrow> (\<sigma> \<Turnstile> (P [])) \<Longrightarrow> Q" - and some: "\<And> b \<sigma>'. ioprog a \<sigma> = Some(b,\<sigma>') \<Longrightarrow> (\<sigma>' \<Turnstile> (s \<leftarrow> mbind\<^sub>F\<^sub>a\<^sub>i\<^sub>l\<^sub>S\<^sub>a\<^sub>v\<^sub>e S ioprog;(P (b#s)))) \<Longrightarrow> Q " -shows "Q" -using seq -proof(cases "ioprog a \<sigma>") - case None assume ass:"ioprog a \<sigma> = None" show "Q" - apply(rule none[OF ass]) - apply(insert ass, erule_tac ioprog1=ioprog in exec_mbindFSave_failure[THEN iffD1],rule seq) - done -next - case (Some aa) assume ass:"ioprog a \<sigma> = Some aa" show "Q" - apply(insert ass,cases "aa",simp, rename_tac "out" "\<sigma>'") - apply(erule some) - apply(insert ass,simp) - apply(erule_tac ioprog1=ioprog in exec_mbindFSave_success[THEN iffD1],rule seq) - done -qed - -text{* The next rule reveals the particular interest in deduction; - as an elimination rule, it allows for a linear conversion of a validity judgement - @{term "mbind\<^sub>F\<^sub>a\<^sub>i\<^sub>l\<^sub>S\<^sub>t\<^sub>o\<^sub>p"} over an input list @{term "S"} into a constraint system; without any - branching ... Symbolic execution can even be stopped tactically whenever - @{term "ioprog a \<sigma> = Some(b,\<sigma>')"} comes to a contradiction. *} -lemma exec_mbindFStop_E: -assumes seq : "(\<sigma> \<Turnstile> (s \<leftarrow> mbind\<^sub>F\<^sub>a\<^sub>i\<^sub>l\<^sub>S\<^sub>t\<^sub>o\<^sub>p (a#S) ioprog ; (P s)))" - and some: "\<And>b \<sigma>'. ioprog a \<sigma> = Some(b,\<sigma>') \<Longrightarrow> (\<sigma>'\<Turnstile> (s \<leftarrow> mbind\<^sub>F\<^sub>a\<^sub>i\<^sub>l\<^sub>S\<^sub>t\<^sub>o\<^sub>p S ioprog;(P(b#s)))) \<Longrightarrow> Q" -shows "Q" -using seq -proof(cases "ioprog a \<sigma>") - case None assume ass:"ioprog a \<sigma> = None" show "Q" - apply(insert ass seq) - apply(drule_tac \<sigma>=\<sigma> and S=S and M=P in exec_mbindFStop_failure, simp) - done -next - case (Some aa) assume ass:"ioprog a \<sigma> = Some aa" show "Q" - apply(insert ass,cases "aa",simp, rename_tac "out" "\<sigma>'") - apply(erule some) - apply(insert ass,simp) - apply(erule_tac ioprog1=ioprog in exec_mbindFStop_success[THEN iffD1],rule seq) - done -qed - - -lemma exec_mbindFPurge_E: -assumes seq : "(\<sigma> \<Turnstile> (s \<leftarrow> mbind\<^sub>F\<^sub>a\<^sub>i\<^sub>l\<^sub>P\<^sub>u\<^sub>r\<^sub>g\<^sub>e (a#S) ioprog ; (P s)))" - and none: "ioprog a \<sigma> = None \<Longrightarrow> (\<sigma> \<Turnstile> (s \<leftarrow> mbind\<^sub>F\<^sub>a\<^sub>i\<^sub>l\<^sub>P\<^sub>u\<^sub>r\<^sub>g\<^sub>e S ioprog;(P (s)))) \<Longrightarrow> Q" - and some: "\<And> b \<sigma>'. ioprog a \<sigma> = Some(b,\<sigma>') \<Longrightarrow> (\<sigma>' \<Turnstile> (s \<leftarrow> mbind\<^sub>F\<^sub>a\<^sub>i\<^sub>l\<^sub>P\<^sub>u\<^sub>r\<^sub>g\<^sub>e S ioprog;(P (b#s)))) \<Longrightarrow> Q " -shows "Q" -using seq -proof(cases "ioprog a \<sigma>") - case None assume ass:"ioprog a \<sigma> = None" show "Q" - apply(rule none[OF ass]) - apply(insert ass, erule_tac ioprog1=ioprog in exec_mbindFPurge_failure[THEN iffD1],rule seq) - done -next - case (Some aa) assume ass:"ioprog a \<sigma> = Some aa" show "Q" - apply(insert ass,cases "aa",simp, rename_tac "out" "\<sigma>'") - apply(erule some) - apply(insert ass,simp) - apply(erule_tac ioprog1=ioprog in exec_mbindFPurge_success[THEN iffD1],rule seq) - done -qed - - -lemma assert_disch1 :" P \<sigma> \<Longrightarrow> (\<sigma> \<Turnstile> (x \<leftarrow> assert\<^sub>S\<^sub>E P; M x)) = (\<sigma> \<Turnstile> (M True))" -by(auto simp: bind_SE_def assert_SE_def valid_SE_def) - -lemma assert_disch2 :" \<not> P \<sigma> \<Longrightarrow> \<not> (\<sigma> \<Turnstile> (x \<leftarrow> assert\<^sub>S\<^sub>E P ; M s))" -by(auto simp: bind_SE_def assert_SE_def valid_SE_def) - -lemma assert_disch3 :" \<not> P \<sigma> \<Longrightarrow> \<not> (\<sigma> \<Turnstile> (assert\<^sub>S\<^sub>E P))" -by(auto simp: bind_SE_def assert_SE_def valid_SE_def) - -lemma assert_D : "(\<sigma> \<Turnstile> (x \<leftarrow> assert\<^sub>S\<^sub>E P; M x)) \<Longrightarrow> P \<sigma> \<and> (\<sigma> \<Turnstile> (M True))" -by(auto simp: bind_SE_def assert_SE_def valid_SE_def split: HOL.if_split_asm) - -lemma assume_D : "(\<sigma> \<Turnstile> (x \<leftarrow> assume\<^sub>S\<^sub>E P; M x)) \<Longrightarrow> \<exists> \<sigma>. (P \<sigma> \<and> \<sigma> \<Turnstile> (M ()))" -apply(auto simp: bind_SE_def assume_SE_def valid_SE_def split: HOL.if_split_asm) -apply(rule_tac x="Eps P" in exI, auto) -apply(rule_tac x="True" in exI, rule_tac x="b" in exI) -apply(subst Hilbert_Choice.someI,assumption,simp) -apply(subst Hilbert_Choice.someI,assumption,simp) -done -text{* These two rule prove that the SE Monad in connection with the notion of valid sequence -is actually sufficient for a representation of a Boogie-like language. The SBE monad with explicit -sets of states --- to be shown below --- is strictly speaking not necessary (and will therefore -be discontinued in the development). *} - -term "if\<^sub>S\<^sub>E P then B\<^sub>1 else B\<^sub>2 fi" - -lemma if_SE_D1 : "P \<sigma> \<Longrightarrow> (\<sigma> \<Turnstile> (if\<^sub>S\<^sub>E P then B\<^sub>1 else B\<^sub>2 fi)) = (\<sigma> \<Turnstile> B\<^sub>1)" -by(auto simp: if_SE_def valid_SE_def) - -lemma if_SE_D2 : "\<not> P \<sigma> \<Longrightarrow> (\<sigma> \<Turnstile> (if\<^sub>S\<^sub>E P then B\<^sub>1 else B\<^sub>2 fi)) = (\<sigma> \<Turnstile> B\<^sub>2)" -by(auto simp: if_SE_def valid_SE_def) - -lemma if_SE_split_asm : " (\<sigma> \<Turnstile> (if\<^sub>S\<^sub>E P then B\<^sub>1 else B\<^sub>2 fi)) = ((P \<sigma> \<and> (\<sigma> \<Turnstile> B\<^sub>1)) \<or> (\<not> P \<sigma> \<and> (\<sigma> \<Turnstile> B\<^sub>2)))" -by(cases "P \<sigma>",auto simp: if_SE_D1 if_SE_D2) - -lemma if_SE_split : " (\<sigma> \<Turnstile> (if\<^sub>S\<^sub>E P then B\<^sub>1 else B\<^sub>2 fi)) = ((P \<sigma> \<longrightarrow> (\<sigma> \<Turnstile> B\<^sub>1)) \<and> (\<not> P \<sigma> \<longrightarrow> (\<sigma> \<Turnstile> B\<^sub>2)))" -by(cases "P \<sigma>", auto simp: if_SE_D1 if_SE_D2) - - -lemma if_SE_execE: - assumes A: "\<sigma> \<Turnstile> (if\<^sub>S\<^sub>E P then B\<^sub>1 else B\<^sub>2 fi)" - and B: "P \<sigma> \<Longrightarrow> \<sigma> \<Turnstile> B\<^sub>1 \<Longrightarrow> Q" - and C: "\<not> P \<sigma>\<Longrightarrow> \<sigma> \<Turnstile> B\<^sub>2 \<Longrightarrow> Q" - shows "Q" -by(insert A [simplified if_SE_split],cases "P \<sigma>", simp_all, auto elim: B C) - - -lemma [code]: - "(\<sigma> \<Turnstile> m) = (case (m \<sigma>) of None \<Rightarrow> False | (Some (x,y)) \<Rightarrow> x)" - apply(simp add: valid_SE_def) - apply(cases "m \<sigma> = None", simp_all) - apply(insert not_None_eq, auto) -done - - -text{* Test-Refinements will be stated in terms of the failsave @{term mbind}, opting - more generality. The following lemma allows for an optimization both in - test execution as well as in symbolic execution for an important special case of - the post-codition: Whenever the latter has the constraint that the length of input and - output sequence equal each other (that is to say: no failure occured), failsave mbind - can be reduced to failstop mbind ... *} -lemma mbindFSave_vs_mbindFStop : - "(\<sigma> \<Turnstile> (os \<leftarrow> (mbind\<^sub>F\<^sub>a\<^sub>i\<^sub>l\<^sub>S\<^sub>a\<^sub>v\<^sub>e \<iota>s ioprog); return(length \<iota>s = length os \<and> P \<iota>s os))) = - (\<sigma> \<Turnstile> (os \<leftarrow> (mbind\<^sub>F\<^sub>a\<^sub>i\<^sub>l\<^sub>S\<^sub>t\<^sub>o\<^sub>p \<iota>s ioprog); return(P \<iota>s os)))" - apply(rule_tac x=P in spec) - apply(rule_tac x=\<sigma> in spec) - proof(induct "\<iota>s") - case Nil show ?case by(simp_all add: mbind_try try_SE_def del: Monads.mbind.simps) - case (Cons a \<iota>s) show ?case - apply(rule allI, rename_tac "\<sigma>",rule allI, rename_tac "P") - apply(insert Cons.hyps) - apply(case_tac "ioprog a \<sigma>") - apply(simp only: exec_mbindFSave_failure exec_mbindFStop_failure, simp) - apply(simp add: split_paired_all del: Monads.mbind.simps ) - apply(rename_tac "\<sigma>'") - apply(subst exec_mbindFSave_success, assumption) - apply(subst (2) exec_bind_SE_success, assumption) - apply(erule_tac x="\<sigma>'" in allE) - apply(erule_tac x="\<lambda>\<iota>s s. P (a # \<iota>s) (aa # s)" in allE) (* heureka ! *) - apply(simp) - done - qed - - -lemma mbind\<^sub>F\<^sub>a\<^sub>i\<^sub>l\<^sub>S\<^sub>a\<^sub>v\<^sub>e_vs_mbind\<^sub>F\<^sub>a\<^sub>i\<^sub>l\<^sub>S\<^sub>t\<^sub>o\<^sub>p: -assumes A: "\<forall> \<iota> \<sigma>. ioprog \<iota> \<sigma> \<noteq> None" -shows "(\<sigma> \<Turnstile> (os \<leftarrow> (mbind\<^sub>F\<^sub>a\<^sub>i\<^sub>l\<^sub>S\<^sub>a\<^sub>v\<^sub>e \<iota>s ioprog); P os)) = - (\<sigma> \<Turnstile> (os \<leftarrow> (mbind\<^sub>F\<^sub>a\<^sub>i\<^sub>l\<^sub>S\<^sub>t\<^sub>o\<^sub>p \<iota>s ioprog); P os))" -proof(induct "\<iota>s") print_cases - case Nil show ?case by simp -next - case (Cons a \<iota>s) - from Cons.hyps - have B:"\<forall> S f \<sigma>. mbind\<^sub>F\<^sub>a\<^sub>i\<^sub>l\<^sub>S\<^sub>a\<^sub>v\<^sub>e S f \<sigma> \<noteq> None " by simp - have C:"\<forall>\<sigma>. mbind\<^sub>F\<^sub>a\<^sub>i\<^sub>l\<^sub>S\<^sub>t\<^sub>o\<^sub>p \<iota>s ioprog \<sigma> = mbind\<^sub>F\<^sub>a\<^sub>i\<^sub>l\<^sub>S\<^sub>a\<^sub>v\<^sub>e \<iota>s ioprog \<sigma>" - apply(induct \<iota>s, simp) - apply(rule allI,rename_tac "\<sigma>") - apply(simp add: Monads.mbind'.simps(2)) - apply(insert A, erule_tac x="a" in allE) - apply(erule_tac x="\<sigma>" and P="\<lambda>\<sigma> . ioprog a \<sigma> \<noteq> None" in allE) - apply(auto split:option.split) - done - show ?case - apply(insert A,erule_tac x="a" in allE,erule_tac x="\<sigma>" in allE) - apply(simp, elim exE) - apply(rename_tac "out" "\<sigma>'") - apply(insert B, erule_tac x=\<iota>s in allE, erule_tac x=ioprog in allE, erule_tac x=\<sigma>' in allE) - apply(subst(asm) not_None_eq, elim exE) - apply(subst Monads.exec_bind_SE_success) - apply(simp split: option.split, auto) - apply(rule_tac s="(\<lambda> a b c. a # (fst c)) out \<sigma>' (aa, b)" in trans, simp,rule refl) - apply(rule_tac s="(\<lambda> a b c. (snd c)) out \<sigma>' (aa, b)" in trans, simp,rule refl) - apply(simp_all) - apply(subst Monads.exec_bind_SE_success, assumption) - apply(subst Monads.exec_bind_SE_success) - apply(rule_tac s="Some (aa, b)" in trans,simp_all add:C) - apply(subst(asm) Monads.exec_bind_SE_success, assumption) - apply(subst(asm) Monads.exec_bind_SE_success) - apply(rule_tac s="Some (aa, b)" in trans,simp_all add:C) - done -qed - - -section{* Valid Test Sequences in the State Exception Backtrack Monad *} -text{* This is still an unstructured merge of executable monad concepts -and specification oriented high-level properties initiating test procedures. *} - -definition valid_SBE :: "'\<sigma> \<Rightarrow> ('a,'\<sigma>) MON\<^sub>S\<^sub>B\<^sub>E \<Rightarrow> bool" (infix "\<Turnstile>\<^sub>S\<^sub>B\<^sub>E" 15) -where "\<sigma> \<Turnstile>\<^sub>S\<^sub>B\<^sub>E m \<equiv> (m \<sigma> \<noteq> None)" -text{* This notation consideres all non-failures as valid. *} - - -lemma assume_assert: "(\<sigma> \<Turnstile>\<^sub>S\<^sub>B\<^sub>E ( _ :\<equiv> assume\<^sub>S\<^sub>B\<^sub>E P ; assert\<^sub>S\<^sub>B\<^sub>E Q)) = (P \<sigma> \<longrightarrow> Q \<sigma>)" - by(simp add: valid_SBE_def assume_SBE_def assert_SBE_def bind_SBE_def) - -lemma assert_intro: "Q \<sigma> \<Longrightarrow> \<sigma> \<Turnstile>\<^sub>S\<^sub>B\<^sub>E (assert\<^sub>S\<^sub>B\<^sub>E Q)" - by(simp add: valid_SBE_def assume_SBE_def assert_SBE_def bind_SBE_def) - -lemma assume_dest: - "\<lbrakk> \<sigma> \<Turnstile>\<^sub>S\<^sub>B\<^sub>E (x :\<equiv> assume\<^sub>S\<^sub>B\<^sub>E Q; M x); Q \<sigma>' \<rbrakk> \<Longrightarrow> \<sigma> \<Turnstile>\<^sub>S\<^sub>B\<^sub>E M ()" - apply(auto simp: valid_SBE_def assume_SBE_def assert_SBE_def bind_SBE_def) - apply(cases "Q \<sigma>",simp_all) - oops - -text{* This still needs work. What would be needed is a kind - of wp - calculus that comes out of that. So far: nope. *} - -subsection{* Legacy Bindings *} - - -lemma valid_true[simp]: (* legacy: special case *) - "(\<sigma> \<Turnstile> (s \<leftarrow> return x ; return (P s))) = P x" by simp - - -(* -lemmas valid_both = exec_mbindFSave (* legacy *) -lemmas valid_success = exec_mbindFSave_success (* legacy *) -lemmas valid_success'' = exec_mbindFSave_success(* legacy *) -lemmas valid_success' = exec_bind_SE_success (* legacy *) -lemmas valid_failure = exec_mbindFSave_failure (* legacy : *) -lemmas valid_failure' = exec_bind_SE_failure (* legacy *) -lemmas valid_failure''=valid_failure (* legacy : *) -lemmas valid_failure''' = exec_mbindFStop_failure (* legacy : *) -lemmas valid_propagate_fail = exec_fail_SE (* legacy *) -lemmas valid_propagate_fail' = exec_fail_SE' (* legacy *) -lemmas valid_propoagate_3' = valid_propagate_fail' (* legacy *) -lemmas valid_propagate_2 = exec_bind_SE_success''(* legacy *) -lemmas valid_propagate_1 = exec_unit_SE (* legacy *) -lemmas valid_successElem = exec_bind_SE_success' (* legacy *) -lemmas valid_propagate_2' = exec_bind_SE_success'''(* legacy *) -lemmas valid_propagate_2'' = exec_bind_SE_success'''' (* legacy *) -lemmas valid_propoagate_3 = exec_unit_SE' (* legacy *) - *) -(* legacy ?: -lemma valid_success'': -"ioprog a \<sigma> = Some(b,\<sigma>') \<Longrightarrow> - (\<sigma> \<Turnstile> (s \<leftarrow> mbind (a#S) ioprog ; return (P s))) = - (\<sigma>' \<Turnstile> (s \<leftarrow> mbind S ioprog ; return (P (b#s))))" -unfolding valid_SE_def unit_SE_def bind_SE_def -by(cases "mbind S ioprog \<sigma>'", auto) -*) - -end diff --git a/Citadelle/examples/archive/OCL_core_experiments.thy b/Citadelle/examples/archive/OCL_core_experiments.thy deleted file mode 100644 index b4e2b1a9b3c1f537b96b5539476652fe89f37d5c..0000000000000000000000000000000000000000 --- a/Citadelle/examples/archive/OCL_core_experiments.thy +++ /dev/null @@ -1,75 +0,0 @@ -(****************************************************************************** - * 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 - OCL_core_experiments -imports - OCL.UML_Logic -begin - -section{* OCL Core Definitions *} - -nitpick_params - [timeout = 30, tac_timeout = 0.5, show_types,assms=true] -lemma ocl_and_defargs: -"\<tau> \<Turnstile> (P and Q) \<Longrightarrow> (\<tau> \<Turnstile> \<delta> P) \<and> (\<tau> \<Turnstile> \<delta> Q)" -by(auto dest: foundation5 foundation6) - -(* *) - -nitpick_params -nitpick_params - [timeout = 30, tac_timeout = 0.5, show_types] -lemma ocl_and_defargs: -"\<tau> \<Turnstile> ((P and Q) \<triangleq> (P or Q))" -nitpick[show_all] - -oops -lemma "P & Q = Q" -nitpick -oops - - -end diff --git a/Citadelle/examples/archive/OCL_lib_Gogolla_challenge.thy b/Citadelle/examples/archive/OCL_lib_Gogolla_challenge.thy deleted file mode 100644 index 17fdb9ca73a8b7f94a245530be9072a514acf56e..0000000000000000000000000000000000000000 --- a/Citadelle/examples/archive/OCL_lib_Gogolla_challenge.thy +++ /dev/null @@ -1,2960 +0,0 @@ -(****************************************************************************** - * 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. - ******************************************************************************) - -chapter{* Gogolla's challenge on Sets *} - -theory - OCL_lib_Gogolla_challenge -imports - OCL.UML_Library - Isabelle_Finite_Set -begin - -no_notation None ("\<bottom>") - -(* -Sequence{6,8}->iterate\<^sub>S\<^sub>e\<^sub>t(i;r1:Sequence(Integer)=Sequence{9}| - r1->iterate\<^sub>S\<^sub>e\<^sub>t(j;r2:Sequence(Integer)=r1| - r2->including\<^sub>S\<^sub>e\<^sub>t(0)->including\<^sub>S\<^sub>e\<^sub>t(i)->including\<^sub>S\<^sub>e\<^sub>t(j))) -*) -text{* In this section we normalize the following ground OCL term: -@{term "Set{\<six>,\<eight>}->iterate\<^sub>S\<^sub>e\<^sub>t(i;r1=Set{\<nine>}| - r1->iterate\<^sub>S\<^sub>e\<^sub>t(j;r2=r1| - r2->including\<^sub>S\<^sub>e\<^sub>t(\<zero>)->including\<^sub>S\<^sub>e\<^sub>t(i)->including\<^sub>S\<^sub>e\<^sub>t(j)))"}. -Starting from a set of numbers, this complex expression finally involves only two combinators: - \<^enum> @{const UML_Set.OclIterate}, and - \<^enum> @{const UML_Set.OclIncluding}. - -As there is no removing, we conjecture that the final result should be equal to the set -containing all ground numbers appearing in the expression, namely @{term \<six>}, @{term \<eight>}, @{term \<nine>}, and @{term \<zero>}. *} -(* text{*(modulo ordering and duplication for sequences)*} *) - -text{* The following part sets up the necessary requirement so that one can ideally normalize -a general term composed of a set of numbers applied to an arbitrary nesting of -@{term OclIterate} and @{term OclIncluding}. -Instead of following a particular conventional strategy (e.g., call by value, by need, ...), -for efficiency reasons, we present in the next subsections some algebraic properties on sets -to manually minimize the number of reduction steps before obtaining a normal form. *} - -section{* Introduction *} - -text{* Besides the @{term invalid} and @{term null} exception elements, the other concept that -could be treated as a kind of monadic exception is the finiteness property of OCL sets. -Since the iteration operation can only be performed on finite sets, the definition of @{term OclIterate} -contains as prerequisite a check that the given argument is finite. If it is the case, -@{term Finite_Set.fold} is then called internally to execute the iteration. *} - -text{* We intend to provide a generic solution to the Gogolla's challenge, -in the sense that we focus on an arbitrary list of nested @{term OclIterate} combinators. -A naive approach for simplifying such huge expression would be to repeatedly rewrite with -@{thm[source] UML_Set.OclIterate_including}. -However, @{thm[source] UML_Set.OclIterate_including} contains @{term "comp_fun_commute F"} as hypothesis -and in case @{term "F"} is again a nested operation on OCL sets, we would still need additional assumptions -in order to further prove that @{term "comp_fun_commute F"} is true (like the -validity, definedness and finiteness properties, -and the finiteness is precisely required for all sets occurring -in a chain of @{term OclIterate} nested term). -As illustration, @{file "OCL_lib_Gogolla_challenge_naive.thy"} contains additional several lemmas -that can be proved but will not be used, -since they have @{term "comp_fun_commute F"} as hypothesis. *} - -text{* As solution, we propose now to write an Isabelle locale similar as the locale @{term "comp_fun_commute"} -but containing the additional properties that sets should fulfill -while traveling through the nested @{term OclIterate}. -For reusability, these properties will be abstractly regrouped in @{term "is_int"} (representing ground value in a set, like integer) -and @{term "all_defined"} (representing ground sets). *} - -section{* Properties: mtSet *} - -lemma mtSet_all_def : "all_defined \<tau> Set{}" -proof - - have B : "\<lfloor>\<lfloor>{}\<rfloor>\<rfloor> \<in> {X. X = bot \<or> X = null \<or> (\<forall>x\<in>\<lceil>\<lceil>X\<rceil>\<rceil>. x \<noteq> bot)}" by(simp add: mtSet_def) - show ?thesis - apply(simp add: all_defined_def all_defined_set'_def mtSet_def Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inverse B) - by (metis (no_types) foundation16 mtSet_def mtSet_defined transform1) -qed - -lemma cp_mtSet : "\<And>x. Set{} = (\<lambda>_. Set{} x)" -by (metis (hide_lams, no_types) mtSet_def) - -section{* Properties: OclIncluding *} - -subsection{* Identity *} - -lemma including_id'' : "\<tau> \<Turnstile> \<delta> (S:: ('\<AA>, 'a option option) Set) \<Longrightarrow> - x \<in> \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil> \<Longrightarrow> - S->including\<^sub>S\<^sub>e\<^sub>t(\<lambda>\<tau>. x) \<tau> = S \<tau>" - apply(simp add: UML_Set.OclIncluding_def OclValid_def insert_absorb abs_rep_simp' del: StrictRefEq\<^sub>S\<^sub>e\<^sub>t_exec) -by (metis (no_types) OclValid_def Set_inv_lemma foundation18') - -lemma including_id' : "all_defined \<tau> (S:: ('\<AA>, 'a option option) Set) \<Longrightarrow> - x \<in> \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil> \<Longrightarrow> - S->including\<^sub>S\<^sub>e\<^sub>t(\<lambda>\<tau>. x) \<tau> = S \<tau>" -by(rule including_id'', (simp add: all_defined_def)+) - -lemma including_id : - assumes S_all_def : "\<And>\<tau>. all_defined \<tau> (S :: ('\<AA>, 'a option option) Set)" - shows " \<forall>\<tau>. x \<in> \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil> \<Longrightarrow> - S->including\<^sub>S\<^sub>e\<^sub>t(\<lambda>\<tau>. x) = S" -by(rule, rule including_id', simp add: S_all_def, blast) - -subsection{* Commutativity *} - -lemma including_swap__generic : - assumes S_def : "\<tau> \<Turnstile> \<delta> S" - and i_val : "\<tau> \<Turnstile> \<upsilon> i" - and j_val : "\<tau> \<Turnstile> \<upsilon> j" - shows "\<tau> \<Turnstile> ((S :: ('\<AA>, 'a::null) Set)->including\<^sub>S\<^sub>e\<^sub>t(i)->including\<^sub>S\<^sub>e\<^sub>t(j) \<doteq> (S->including\<^sub>S\<^sub>e\<^sub>t(j)->including\<^sub>S\<^sub>e\<^sub>t(i)))" - apply(simp only: OclIncluding_commute StrictRefEq\<^sub>S\<^sub>e\<^sub>t.refl_ext) -by (metis "UML_Set.OclIncluding.1" OclIf_true' OclIncluding_valid_args_valid OclValid_def S_def i_val j_val) - -subsection{* Congruence *} - -lemma including_subst_set : "(s::('\<AA>,'a::null)Set) = t \<Longrightarrow> s->including\<^sub>S\<^sub>e\<^sub>t(x) = (t->including\<^sub>S\<^sub>e\<^sub>t(x))" -by(simp) - -lemmas including_subst_set' = OclIncluding_cong' - -lemma including_subst_set'' : "\<tau> \<Turnstile> \<delta> s \<Longrightarrow> \<tau> \<Turnstile> \<delta> t \<Longrightarrow> \<tau> \<Turnstile> \<upsilon> x \<Longrightarrow> (s::('\<AA>,'a::null)Set) \<tau> = t \<tau> \<Longrightarrow> s->including\<^sub>S\<^sub>e\<^sub>t(x) \<tau> = (t->including\<^sub>S\<^sub>e\<^sub>t(x)) \<tau>" - apply(frule including_subst_set'[where s = s and t = t and x = x], simp_all del: StrictRefEq\<^sub>S\<^sub>e\<^sub>t_exec) - apply(simp add: StrictRefEq\<^sub>S\<^sub>e\<^sub>t OclValid_def del: StrictRefEq\<^sub>S\<^sub>e\<^sub>t_exec) - apply (metis (hide_lams, no_types) OclValid_def foundation20 foundation22) -by (metis UML_Set.OclIncluding.cp0) - - -subsection{* all defined (construction) *} - -lemma cons_all_def' : - assumes S_all_def : "all_defined \<tau> S" - assumes x_val : "\<tau> \<Turnstile> \<upsilon> x" - shows "all_defined \<tau> (S->including\<^sub>S\<^sub>e\<^sub>t(x))" -proof - - - have discr_eq_false_true : "\<And>\<tau>. (false \<tau> = true \<tau>) = False" by (metis OclValid_def foundation2) - - have all_defined1 : "\<And>r2 \<tau>. all_defined \<tau> r2 \<Longrightarrow> \<tau> \<Turnstile> \<delta> r2" by(simp add: all_defined_def) - - have A : "\<bottom> \<in> {X. X = bot \<or> X = null \<or> (\<forall>x\<in>\<lceil>\<lceil>X\<rceil>\<rceil>. x \<noteq> bot)}" by(simp add: bot_option_def) - have B : "\<lfloor>\<bottom>\<rfloor> \<in> {X. X = bot \<or> X = null \<or> (\<forall>x\<in>\<lceil>\<lceil>X\<rceil>\<rceil>. x \<noteq> bot)}" by(simp add: null_option_def bot_option_def) - - have C : "\<lfloor>\<lfloor>insert (x \<tau>) \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil>\<rfloor>\<rfloor> \<in> {X. X = bot \<or> X = null \<or> (\<forall>x\<in>\<lceil>\<lceil>X\<rceil>\<rceil>. x \<noteq> bot)}" - apply(insert S_all_def[simplified all_defined_def, THEN conjunct1] - x_val, frule Set_inv_lemma) - apply(simp add: foundation18 invalid_def) - done - - have G1 : "Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e \<lfloor>\<lfloor>insert (x \<tau>) \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil>\<rfloor>\<rfloor> \<noteq> Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e None" - apply(insert C, simp) - apply(simp add: S_all_def[simplified all_defined_def, THEN conjunct1] x_val A Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inject B C OclValid_def Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_cases Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inverse bot_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def bot_option_def insert_compr insert_def not_Some_eq null_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def null_option_def) - done - - have G2 : "Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e \<lfloor>\<lfloor>insert (x \<tau>) \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil>\<rfloor>\<rfloor> \<noteq> Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e \<lfloor>None\<rfloor>" - apply(insert C, simp) - apply(simp add: S_all_def[simplified all_defined_def, THEN conjunct1] x_val A Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inject B C OclValid_def Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_cases Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inverse bot_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def bot_option_def insert_compr insert_def not_Some_eq null_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def null_option_def) - done - - have G : "(\<delta> (\<lambda>_. Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e \<lfloor>\<lfloor>insert (x \<tau>) \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil>\<rfloor>\<rfloor>)) \<tau> = true \<tau>" - apply(auto simp: OclValid_def false_def true_def defined_def - bot_fun_def bot_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def null_fun_def null_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def G1 G2) - done - - have invert_all_defined_aux : "(\<tau> \<Turnstile>(\<delta> S)) \<Longrightarrow> (\<tau> \<Turnstile>(\<upsilon> x)) \<Longrightarrow> \<lfloor>\<lfloor>insert (x \<tau>) \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil>\<rfloor>\<rfloor> \<in> {X. X = bot \<or> X = null \<or> (\<forall>x\<in>\<lceil>\<lceil>X\<rceil>\<rceil>. x \<noteq> bot)}" - apply(frule Set_inv_lemma) - apply(simp add: foundation18 invalid_def) - done - show ?thesis - apply(subgoal_tac "\<tau> \<Turnstile> \<upsilon> x") prefer 2 apply(simp add: x_val) - apply(simp add: all_defined_def UML_Set.OclIncluding_def OclValid_def) - apply(simp add: x_val[simplified OclValid_def] S_all_def[simplified all_defined_def OclValid_def]) - apply(insert Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inverse[OF invert_all_defined_aux] - S_all_def[simplified all_defined_def] - x_val, simp) - apply(simp add: cp_defined[of "\<lambda>\<tau>. if (\<delta> S) \<tau> = true \<tau> \<and> (\<upsilon> x) \<tau> = true \<tau> then Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e \<lfloor>\<lfloor>\<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil> \<union> {x \<tau>}\<rfloor>\<rfloor> else invalid \<tau>"]) - apply(simp add: all_defined_set'_def OclValid_def) - apply(simp add: cp_valid[symmetric] x_val[simplified OclValid_def]) - apply(rule G) - done -qed - -lemma cons_all_def: - assumes S_all_def : "\<And>\<tau>. all_defined \<tau> S" - assumes x_val : "\<And>\<tau>. \<tau> \<Turnstile> \<upsilon> x" - shows "all_defined \<tau> S->including\<^sub>S\<^sub>e\<^sub>t(x)" -by(rule cons_all_def', simp_all add: assms) - -subsection{* all defined (inversion) *} - -lemma invert_all_defined : "all_defined \<tau> (S->including\<^sub>S\<^sub>e\<^sub>t(x)) \<Longrightarrow> \<tau> \<Turnstile> \<upsilon> x \<and> all_defined \<tau> S" - proof - - have invert_all_defined_aux : "(\<tau> \<Turnstile>(\<delta> S)) \<Longrightarrow> (\<tau> \<Turnstile>(\<upsilon> x)) \<Longrightarrow> \<lfloor>\<lfloor>insert (x \<tau>) \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil>\<rfloor>\<rfloor> \<in> {X. X = bot \<or> X = null \<or> (\<forall>x\<in>\<lceil>\<lceil>X\<rceil>\<rceil>. x \<noteq> bot)}" - apply(frule Set_inv_lemma) - apply(simp add: foundation18 invalid_def) - done - - have OclIncluding_finite_rep_set : "\<And>\<tau> X x. \<And>\<tau>. \<tau> \<Turnstile> (\<delta> X and \<upsilon> x) \<Longrightarrow> - finite \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (X->including\<^sub>S\<^sub>e\<^sub>t(x) \<tau>)\<rceil>\<rceil> = finite \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (X \<tau>)\<rceil>\<rceil>" - apply(rule OclIncluding_finite_rep_set) - apply(metis OclValid_def foundation5)+ - done - - show "all_defined \<tau> (S->including\<^sub>S\<^sub>e\<^sub>t(x)) \<Longrightarrow> ?thesis" - apply(simp add: all_defined_def all_defined_set'_def) - apply(erule conjE, frule OclIncluding_finite_rep_set[of \<tau> S x], simp) - by (metis foundation5) -qed - -lemma invert_all_defined' : "(\<forall>\<tau>. all_defined \<tau> (S->including\<^sub>S\<^sub>e\<^sub>t(\<lambda>(_:: '\<AA> st). x))) \<Longrightarrow> is_int (\<lambda> (_:: '\<AA> st). x) \<and> (\<forall>\<tau>. all_defined \<tau> S)" - apply(rule conjI) - apply(simp only: is_int_def, rule allI) - apply(erule_tac x = \<tau> in allE, simp) - apply(drule invert_all_defined, simp) - apply(rule allI) - apply(erule_tac x = \<tau> in allE) - apply(drule invert_all_defined, simp) -done - -subsection{* Preservation of cp *} - -lemma including_cp_gen : "cp f \<Longrightarrow> cp (\<lambda>r2. ((f r2)->including\<^sub>S\<^sub>e\<^sub>t(x)))" - apply(unfold cp_def) - apply(subst UML_Set.OclIncluding.cp0[of _ x]) - apply(drule exE) prefer 2 apply assumption - apply(rule_tac x = "\<lambda> X_\<tau> \<tau>. ((\<lambda>_. fa X_\<tau> \<tau>)->including\<^sub>S\<^sub>e\<^sub>t(\<lambda>_. x \<tau>)) \<tau>" in exI, simp) -done - -lemma including_cp : "cp (\<lambda>r2. (r2->including\<^sub>S\<^sub>e\<^sub>t(x)))" -by(rule including_cp_gen, simp) - -lemma including_cp' : "cp (UML_Set.OclIncluding S)" - apply(unfold cp_def) - apply(subst UML_Set.OclIncluding.cp0) - apply(rule_tac x = "\<lambda> X_\<tau> \<tau>. ((\<lambda>_. S \<tau>)->including\<^sub>S\<^sub>e\<^sub>t(\<lambda>_. X_\<tau>)) \<tau>" in exI, simp) -done - -lemma including_cp''' : "cp (UML_Set.OclIncluding S->including\<^sub>S\<^sub>e\<^sub>t(i)->including\<^sub>S\<^sub>e\<^sub>t(j))" -by(rule including_cp') - -lemma including_cp2 : "cp (\<lambda>r2. (r2->including\<^sub>S\<^sub>e\<^sub>t(x))->including\<^sub>S\<^sub>e\<^sub>t(y))" -by(rule including_cp_gen, simp add: including_cp) - -lemma including_cp3 : "cp (\<lambda>r2. ((r2->including\<^sub>S\<^sub>e\<^sub>t(x))->including\<^sub>S\<^sub>e\<^sub>t(y))->including\<^sub>S\<^sub>e\<^sub>t(z))" -by(rule including_cp_gen, simp add: including_cp2) - -subsection{* Preservation of global judgment *} - -lemma including_cp_all : - assumes x_int : "is_int x" - and S_def : "\<And>\<tau>. \<tau> \<Turnstile> \<delta> S" - and S_incl : "S \<tau>1 = S \<tau>2" - shows "S->including\<^sub>S\<^sub>e\<^sub>t(x) \<tau>1 = S->including\<^sub>S\<^sub>e\<^sub>t(x) \<tau>2" -proof - - have all_defined1 : "\<And>r2 \<tau>. all_defined \<tau> r2 \<Longrightarrow> \<tau> \<Turnstile> \<delta> r2" by(simp add: all_defined_def) - show ?thesis - apply(unfold UML_Set.OclIncluding_def) - apply(simp add: S_def[simplified OclValid_def] int_is_valid[OF x_int, simplified OclValid_def] S_incl) - apply(subgoal_tac "x \<tau>1 = x \<tau>2", simp) - apply(insert x_int[simplified is_int_def, THEN spec, of \<tau>1, THEN conjunct2, THEN spec], simp) - done -qed - -subsection{* Preservation of non-emptiness *} - -lemma including_notempty : - assumes S_def : "\<tau> \<Turnstile> \<delta> S" - and x_val : "\<tau> \<Turnstile> \<upsilon> x" - and S_notempty : "\<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil> \<noteq> {}" - shows "\<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S->including\<^sub>S\<^sub>e\<^sub>t(x) \<tau>)\<rceil>\<rceil> \<noteq> {}" -proof - - have insert_in_Set_0 : "\<And>\<tau>. (\<tau> \<Turnstile>(\<delta> S)) \<Longrightarrow> (\<tau> \<Turnstile>(\<upsilon> x)) \<Longrightarrow> \<lfloor>\<lfloor>insert (x \<tau>) \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil>\<rfloor>\<rfloor> \<in> {X. X = bot \<or> X = null \<or> (\<forall>x\<in>\<lceil>\<lceil>X\<rceil>\<rceil>. x \<noteq> bot)}" - apply(frule Set_inv_lemma) - apply(simp add: foundation18 invalid_def) - done - show ?thesis - apply(unfold UML_Set.OclIncluding_def) - apply(simp add: S_def[simplified OclValid_def] x_val[simplified OclValid_def] Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inverse[OF insert_in_Set_0[OF S_def x_val]]) - done -qed - -lemma including_notempty' : - assumes x_val : "\<tau> \<Turnstile> \<upsilon> x" - shows "\<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (Set{x} \<tau>)\<rceil>\<rceil> \<noteq> {}" -proof - - have insert_in_Set_0 : "\<And>S \<tau>. (\<tau> \<Turnstile>(\<delta> S)) \<Longrightarrow> (\<tau> \<Turnstile>(\<upsilon> x)) \<Longrightarrow> \<lfloor>\<lfloor>insert (x \<tau>) \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil>\<rfloor>\<rfloor> \<in> {X. X = bot \<or> X = null \<or> (\<forall>x\<in>\<lceil>\<lceil>X\<rceil>\<rceil>. x \<noteq> bot)}" - apply(frule Set_inv_lemma) - apply(simp add: foundation18 invalid_def) - done - show ?thesis - apply(unfold UML_Set.OclIncluding_def) - apply(simp add: x_val[simplified OclValid_def]) - apply(subst Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inverse) - apply(rule insert_in_Set_0) - apply(simp add: mtSet_all_def) - apply(simp_all add: x_val) - done -qed - -section{* Properties: Constant set *} - -lemma cp_singleton : "(\<lambda>_. Set{\<lambda>(_:: '\<AA> st). x} \<tau>) = Set{\<lambda>(_:: '\<AA> st). x}" - apply(rule ext, rename_tac \<tau>') - apply(subst const_OclIncluding[simplified const_def], simp) -by(simp add: mtSet_def, simp) - -lemma cp_doubleton : - assumes a_int : "const a" - shows "(\<lambda>_. Set{\<lambda>(_:: '\<AA> st). x, a} \<tau>) = Set{\<lambda>(_:: '\<AA> st). x, a}" - apply(rule ext, rename_tac \<tau>') - apply(rule const_OclIncluding[simplified const_def, THEN spec, THEN spec], simp) - apply(intro allI, rule const_OclIncluding[simplified const_def, THEN spec, THEN spec]) - apply(simp add: a_int[simplified const_def]) -by(simp add: mtSet_def) - -lemma flatten_int : "Set{a,a} = Set{a}" -by simp - -section{* Properties: OclExcluding *} -subsection{* Identity *} - -lemma excluding_id'': "\<tau> \<Turnstile> \<delta> (S:: ('\<AA>, 'a option option) Set) \<Longrightarrow> - \<tau> \<Turnstile> \<upsilon> (\<lambda>\<tau>. x) \<Longrightarrow> - x \<notin> \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil> \<Longrightarrow> - S->excluding\<^sub>S\<^sub>e\<^sub>t(\<lambda>\<tau>. x) \<tau> = S \<tau>" -by(simp add: UML_Set.OclExcluding_def OclValid_def abs_rep_simp') - -lemma excluding_id : - assumes S_all_def : "\<And>\<tau>. all_defined \<tau> (S :: ('\<AA>, 'a option option) Set)" - and x_int : "is_int (\<lambda>(\<tau>:: '\<AA> st). x)" - shows " \<forall>\<tau>. x \<notin> \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil> \<Longrightarrow> - S->excluding\<^sub>S\<^sub>e\<^sub>t(\<lambda>\<tau>. x) = S" -by(rule, rule excluding_id'', - simp add: S_all_def[simplified all_defined_def], simp add: int_is_valid[OF x_int], blast) - -subsection{* all defined (construction) *} - -lemma cons_all_def_e : - assumes S_all_def : "\<And>\<tau>. all_defined \<tau> S" - assumes x_val : "\<And>\<tau>. \<tau> \<Turnstile> \<upsilon> x" - shows "all_defined \<tau> S->excluding\<^sub>S\<^sub>e\<^sub>t(x)" -proof - - - have discr_eq_false_true : "\<And>\<tau>. (false \<tau> = true \<tau>) = False" by (metis OclValid_def foundation2) - - have all_defined1 : "\<And>r2 \<tau>. all_defined \<tau> r2 \<Longrightarrow> \<tau> \<Turnstile> \<delta> r2" by(simp add: all_defined_def) - - have A : "\<bottom> \<in> {X. X = bot \<or> X = null \<or> (\<forall>x\<in>\<lceil>\<lceil>X\<rceil>\<rceil>. x \<noteq> bot)}" by(simp add: bot_option_def) - have B : "\<lfloor>\<bottom>\<rfloor> \<in> {X. X = bot \<or> X = null \<or> (\<forall>x\<in>\<lceil>\<lceil>X\<rceil>\<rceil>. x \<noteq> bot)}" by(simp add: null_option_def bot_option_def) - - have C : "\<And>\<tau>. \<lfloor>\<lfloor>\<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil> - {x \<tau>}\<rfloor>\<rfloor> \<in> {X. X = bot \<or> X = null \<or> (\<forall>x\<in>\<lceil>\<lceil>X\<rceil>\<rceil>. x \<noteq> bot)}" - proof - fix \<tau> show "?thesis \<tau>" - apply(insert S_all_def[simplified all_defined_def, THEN conjunct1, of \<tau>] - x_val, frule Set_inv_lemma) - apply(simp add: foundation18 invalid_def) - done - qed - - have G1 : "\<And>\<tau>. Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e \<lfloor>\<lfloor>\<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil> - {x \<tau>}\<rfloor>\<rfloor> \<noteq> Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e None" - proof - fix \<tau> show "?thesis \<tau>" - apply(insert C[of \<tau>], simp) - apply(simp add: Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inject bot_option_def) - done - qed - - have G2 : "\<And>\<tau>. Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e \<lfloor>\<lfloor>\<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil> - {x \<tau>}\<rfloor>\<rfloor> \<noteq> Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e \<lfloor>None\<rfloor>" - proof - fix \<tau> show "?thesis \<tau>" - apply(insert C[of \<tau>], simp) - apply(simp add: Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inject bot_option_def null_option_def) - done - qed - - have G : "\<And>\<tau>. (\<delta> (\<lambda>_. Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e \<lfloor>\<lfloor>\<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil> - {x \<tau>}\<rfloor>\<rfloor>)) \<tau> = true \<tau>" - proof - fix \<tau> show "?thesis \<tau>" - apply(auto simp: OclValid_def false_def true_def defined_def - bot_fun_def bot_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def null_fun_def null_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def G1 G2) - done - qed - - have invert_all_defined_aux : "(\<tau> \<Turnstile>(\<delta> S)) \<Longrightarrow> (\<tau> \<Turnstile>(\<upsilon> x)) \<Longrightarrow> \<lfloor>\<lfloor>\<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil> - {x \<tau>}\<rfloor>\<rfloor> \<in> {X. X = bot \<or> X = null \<or> (\<forall>x\<in>\<lceil>\<lceil>X\<rceil>\<rceil>. x \<noteq> bot)}" - apply(frule Set_inv_lemma) - apply(simp add: foundation18 invalid_def) - done - - show ?thesis - apply(subgoal_tac "\<tau> \<Turnstile> \<upsilon> x") prefer 2 apply(simp add: x_val) - apply(simp add: all_defined_def UML_Set.OclExcluding_def OclValid_def) - apply(simp add: x_val[simplified OclValid_def] S_all_def[simplified all_defined_def OclValid_def]) - apply(insert Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inverse[OF invert_all_defined_aux] - S_all_def[simplified all_defined_def, of \<tau>] - x_val[of \<tau>], simp) - apply(simp add: cp_defined[of "\<lambda>\<tau>. Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e \<lfloor>\<lfloor>\<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil> - {x \<tau>}\<rfloor>\<rfloor>"]) - apply(simp add: all_defined_set'_def OclValid_def) - apply(simp add: cp_valid[symmetric] x_val[simplified OclValid_def]) - apply(rule G) - done -qed - -subsection{* Execution *} - -lemma excluding_unfold' : - assumes S_all_def : "\<tau> \<Turnstile> \<delta> S" - and x_val : "\<tau> \<Turnstile> \<upsilon> x" - shows "\<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S->excluding\<^sub>S\<^sub>e\<^sub>t(x) \<tau>)\<rceil>\<rceil> = \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil> - {x \<tau>}" -proof - - have C : "\<lfloor>\<lfloor>\<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil> - {x \<tau>}\<rfloor>\<rfloor> \<in> {X. X = bot \<or> X = null \<or> (\<forall>x\<in>\<lceil>\<lceil>X\<rceil>\<rceil>. x \<noteq> bot)}" - apply(insert S_all_def x_val, frule Set_inv_lemma) - by(simp add: foundation18 invalid_def) - show ?thesis - by(simp add: UML_Set.OclExcluding_def S_all_def[simplified OclValid_def] x_val[simplified OclValid_def] Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inverse[OF C]) -qed - -lemma excluding_unfold : - assumes S_all_def : "\<And>\<tau>. all_defined \<tau> S" - and x_val : "\<And>\<tau>. \<tau> \<Turnstile> \<upsilon> x" - shows "\<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S->excluding\<^sub>S\<^sub>e\<^sub>t(x) \<tau>)\<rceil>\<rceil> = \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil> - {x \<tau>}" -by(rule excluding_unfold', simp add: S_all_def[simplified all_defined_def], simp add: x_val) - -section{* Properties: OclIncluding and OclExcluding *} -subsection{* Identity *} - -lemma Ocl_insert_Diff' : - assumes S_all_def : "\<tau> \<Turnstile> \<delta> (S :: ('\<AA>, 'a option option) Set)" - and x_mem : "x \<in> (\<lambda>a (\<tau>:: '\<AA> st). a) ` \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil>" - and x_int : "\<tau> \<Turnstile> \<upsilon> x" - shows "S->excluding\<^sub>S\<^sub>e\<^sub>t(x)->including\<^sub>S\<^sub>e\<^sub>t(x) \<tau> = S \<tau>" -proof - - have remove_in_Set_0 : "\<And>\<tau>. (\<tau> \<Turnstile>(\<delta> S)) \<Longrightarrow> (\<tau> \<Turnstile>(\<upsilon> x)) \<Longrightarrow> \<lfloor>\<lfloor>\<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil> - {x \<tau>}\<rfloor>\<rfloor> \<in> {X. X = bot \<or> X = null \<or> (\<forall>x\<in>\<lceil>\<lceil>X\<rceil>\<rceil>. x \<noteq> bot)}" - apply(frule Set_inv_lemma) - apply(simp add: foundation18 invalid_def) - done - have inject : "inj (\<lambda>a \<tau>. a)" by(rule inj_fun, simp) - have x_mem : "x \<tau> \<in> \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil>" - by(rule inj_image_mem_iff[OF inject, THEN iffD1], insert x_mem, fast) - show ?thesis - apply(subgoal_tac "\<tau> \<Turnstile> \<delta> (S->excluding\<^sub>S\<^sub>e\<^sub>t(x))") - prefer 2 - apply(simp add: foundation10 S_all_def x_int) - apply(simp add: UML_Set.OclExcluding_def UML_Set.OclIncluding_def S_all_def[simplified OclValid_def] Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inverse[OF remove_in_Set_0] x_int[simplified OclValid_def] OclValid_def) - apply(insert x_mem, drule insert_Diff[symmetric], simp) - by(subst abs_rep_simp', simp add: S_all_def[simplified all_defined_def], simp) -qed - -lemma Ocl_insert_Diff : - assumes S_all_def : "\<And>\<tau>. all_defined \<tau> (S :: ('\<AA>, 'a option option) Set)" - and x_mem : "\<And>\<tau>. x \<in> (\<lambda>a (\<tau>:: '\<AA> st). a) ` \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil>" - and x_int : "is_int x" - shows "S->excluding\<^sub>S\<^sub>e\<^sub>t(x)->including\<^sub>S\<^sub>e\<^sub>t(x) = S" - apply(rule ext, rename_tac \<tau>) - apply(rule Ocl_insert_Diff', simp add: S_all_def[simplified all_defined_def], insert x_mem, fast) -by(simp add: int_is_valid[OF x_int]) - -section{* Properties: OclIterate *} - -subsection{* all defined (inversion) *} - -lemma i_invert_all_defined_not : - assumes A_all_def : "\<exists>\<tau>. \<not> all_defined \<tau> S" - shows "\<exists>\<tau>. \<not> all_defined \<tau> (UML_Set.OclIterate S S F)" -proof - - have A : "\<bottom> \<in> {X. X = bot \<or> X = null \<or> (\<forall>x\<in>\<lceil>\<lceil>X\<rceil>\<rceil>. x \<noteq> bot)}" by(simp add: bot_option_def) - have B : "\<lfloor>\<bottom>\<rfloor> \<in> {X. X = bot \<or> X = null \<or> (\<forall>x\<in>\<lceil>\<lceil>X\<rceil>\<rceil>. x \<noteq> bot)}" by(simp add: null_option_def bot_option_def) - have C : "\<lfloor>None\<rfloor> \<in> {X. X = bot \<or> X = null \<or> (\<forall>x\<in>\<lceil>\<lceil>X\<rceil>\<rceil>. x \<noteq> bot)}" by(simp add: null_option_def bot_option_def) - - show ?thesis - apply(insert A_all_def) - apply(drule exE) prefer 2 apply assumption - apply(rule_tac x = \<tau> in exI) - proof - fix \<tau> show "\<not> all_defined \<tau> S \<Longrightarrow> \<not> all_defined \<tau> (UML_Set.OclIterate S S F)" - apply(unfold UML_Set.OclIterate_def) - apply(case_tac "\<tau> \<Turnstile> (\<delta> S) \<and> \<tau> \<Turnstile> (\<upsilon> S) \<and> finite \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil>", simp add: OclValid_def all_defined_def) - apply(simp add: all_defined_set'_def) - apply(simp add: all_defined_def all_defined_set'_def defined_def OclValid_def false_def true_def bot_fun_def) - done - qed -qed - -lemma i_invert_all_defined : - assumes A_all_def : "\<And>\<tau>. all_defined \<tau> (UML_Set.OclIterate S S F)" - shows "all_defined \<tau> S" -by (metis A_all_def i_invert_all_defined_not) - -lemma i_invert_all_defined' : - assumes A_all_def : "\<forall>\<tau>. all_defined \<tau> (UML_Set.OclIterate S S F)" - shows "\<forall>\<tau>. all_defined \<tau> S" -by (metis A_all_def i_invert_all_defined) - -section{* Properties: (with comp fun commute) invalid *} -subsection{* Preservation of comp fun commute (main) *} - -lemma bot_commute : "comp_fun_commute (\<lambda>_ _. \<bottom>)" -by(simp add: comp_fun_commute_def) - -section{* Properties: (with comp fun commute) OclIf *} -subsection{* Preservation of comp fun commute (main) *} - -lemma if_commute_gen_var_gen : - assumes f_comm : "comp_fun_commute f" - assumes F_comm : "comp_fun_commute F" - and F_cp : "\<And>x S \<tau>. F x S \<tau> = F x (\<lambda>_. S \<tau>) \<tau>" - and f_cp : "\<And>x S \<tau>. f x S \<tau> = f x (\<lambda>_. S \<tau>) \<tau>" - and F_strict : "\<And>x. F x invalid = invalid" - and f_strict : "\<And>x. f x invalid = invalid" - and comm : "\<And>x y S \<tau>. F y (f x S) \<tau> = f x (F y S) \<tau>" - shows "comp_fun_commute (\<lambda>j r2. if c j then (F j r2) else f j r2 endif)" -proof - - have F_comm : "\<And>y x S. (F y (F x S)) = (F x (F y S))" - by (metis comp_fun_commute.fun_left_comm F_comm) - - have f_comm : "\<And>y x S. (f y (f x S)) = (f x (f y S))" - by (metis comp_fun_commute.fun_left_comm f_comm) - - have if_id : "\<And>x. (if x then invalid else invalid endif) = invalid" - by(rule ext,simp add: OclIf_def) - - show ?thesis - apply(simp add: comp_fun_commute_def comp_def) - apply(rule allI)+ - apply(rule ext, rename_tac S) - apply(rule ext, rename_tac \<tau>) - proof - fix y x S \<tau> show "(if c y then F y (if c x then F x S else f x S endif) else f y (if c x then F x S else f x S endif) endif) \<tau> = - (if c x then F x (if c y then F y S else f y S endif) else f x (if c y then F y S else f y S endif) endif) \<tau>" - apply(subst (1 2) cp_OclIf, subst (1 2) F_cp, subst (1 2) f_cp, subst (1 2 4 5) cp_OclIf) - apply(cut_tac bool_split_0[where X = "c y" and \<tau> = \<tau>], auto) - apply(simp_all add: cp_OclIf[symmetric] F_cp[symmetric] f_cp[symmetric] F_strict f_strict if_id) - (* *) - apply(subst F_cp, subst (1 2) cp_OclIf) - apply(cut_tac bool_split_0[where X = "c x" and \<tau> = \<tau>], auto) - apply(simp_all add: cp_OclIf[symmetric] F_cp[symmetric] f_cp[symmetric] F_strict f_strict if_id F_comm comm) - (* *) - apply(subst f_cp, subst (1 2) cp_OclIf) - apply(cut_tac bool_split_0[where X = "c x" and \<tau> = \<tau>], auto) - apply(simp_all add: cp_OclIf[symmetric] F_cp[symmetric] f_cp[symmetric] F_strict f_strict if_id f_comm comm) - done - qed -qed - -section{* Properties: (with comp fun commute) OclIncluding *} -subsection{* Preservation of comp fun commute (main) *} - -lemma including_commute_gen_var_gen : - assumes f_comm : "comp_fun_commute F" - and f_out : "\<And>x y S \<tau>. F x (S->including\<^sub>S\<^sub>e\<^sub>t(y)) \<tau> = (F x S)->including\<^sub>S\<^sub>e\<^sub>t(y) \<tau>" - shows "comp_fun_commute (\<lambda>j r2. ((F j r2)->including\<^sub>S\<^sub>e\<^sub>t(a)))" -proof - - have comm : "\<And>y x S. (F y (F x S)) = (F x (F y S))" - by (metis comp_fun_commute.fun_left_comm f_comm) - show ?thesis - apply(simp add: comp_fun_commute_def comp_def) - apply(rule allI)+ - apply(rule ext, rename_tac S) - apply(rule ext, rename_tac \<tau>) - apply(subst (1 2) UML_Set.OclIncluding.cp0) - apply(subst f_out) - apply(subst comm) - apply(subst f_out[symmetric], simp) - done -qed - -lemma including_commute_gen_var : - assumes f_comm : "EQ_comp_fun_commute F" - and f_out : "\<And>x y S \<tau>. \<tau> \<Turnstile> \<delta> S \<Longrightarrow> \<tau> \<Turnstile> \<upsilon> x \<Longrightarrow> \<tau> \<Turnstile> \<upsilon> y \<Longrightarrow> F x (S->including\<^sub>S\<^sub>e\<^sub>t(y)) \<tau> = (F x S)->including\<^sub>S\<^sub>e\<^sub>t(y) \<tau>" - and a_int : "is_int a" - shows "EQ_comp_fun_commute (\<lambda>j r2. ((F j r2)->including\<^sub>S\<^sub>e\<^sub>t(a)))" -proof - - interpret EQ_comp_fun_commute F by (rule f_comm) - - have f_cp : "\<And>x y \<tau>. F x y \<tau> = F (\<lambda>_. x \<tau>) (\<lambda>_. y \<tau>) \<tau>" - by (metis F_cp F_cp_set) - - have all_defined1 : "\<And>r2 \<tau>. all_defined \<tau> r2 \<Longrightarrow> \<tau> \<Turnstile> \<delta> r2" by(simp add: all_defined_def) - - show ?thesis - apply(simp only: EQ_comp_fun_commute_def) - apply(rule conjI)+ - apply(rule allI)+ - - proof - fix x S \<tau> show "(F x S)->including\<^sub>S\<^sub>e\<^sub>t(a) \<tau> = (F (\<lambda>_. x \<tau>) S)->including\<^sub>S\<^sub>e\<^sub>t(a) \<tau>" - by(subst (1 2) UML_Set.OclIncluding.cp0, subst F_cp, simp) - - apply_end(rule conjI)+ apply_end(rule allI)+ - - fix x S \<tau> show "(F x S)->including\<^sub>S\<^sub>e\<^sub>t(a) \<tau> = (F x (\<lambda>_. S \<tau>))->including\<^sub>S\<^sub>e\<^sub>t(a) \<tau>" - by(subst (1 2) UML_Set.OclIncluding.cp0, subst F_cp_set, simp) - - apply_end(rule allI)+ apply_end(rule impI)+ - - fix x fix S fix \<tau>1 \<tau>2 - show "is_int x \<Longrightarrow> \<forall>\<tau>. all_defined \<tau> S \<Longrightarrow> S \<tau>1 = S \<tau>2 \<Longrightarrow> ((F x S)->including\<^sub>S\<^sub>e\<^sub>t(a)) \<tau>1 = ((F x S)->including\<^sub>S\<^sub>e\<^sub>t(a)) \<tau>2" - apply(subgoal_tac "x \<tau>1 = x \<tau>2") prefer 2 apply (simp add: is_int_def) apply(metis surj_pair) - apply(subgoal_tac "\<And>\<tau>. all_defined \<tau> (F x S)") prefer 2 apply(rule all_def[THEN iffD2], simp only: int_is_valid) - apply(subst including_cp_all[of _ _ \<tau>1 \<tau>2]) apply(simp add: a_int) apply(rule all_defined1, blast) - apply(rule cp_gen, simp, blast, simp) - apply(simp) - done - apply_end(rule conjI) - apply_end(rule allI)+ apply_end(rule impI)+ - - apply_end(rule including_notempty) - apply_end(rule all_defined1) - apply_end(simp add: all_def, metis surj_pair, simp) - apply_end(simp add: int_is_valid[OF a_int]) - apply_end(rule notempty, blast, simp, simp) - - apply_end(rule conjI) apply_end(rule allI)+ - apply_end(rule iffI) - apply_end(drule invert_all_defined, simp add: all_def) - apply_end(rule cons_all_def', simp add: all_def) - apply_end(simp add: int_is_valid[OF a_int]) - - apply_end(rule allI)+ apply_end(rule impI)+ - - fix x y S \<tau> show "\<tau> \<Turnstile> \<upsilon> x \<Longrightarrow> \<tau> \<Turnstile> \<upsilon> y \<Longrightarrow> all_defined \<tau> S \<Longrightarrow> - (F y ((F x S)->including\<^sub>S\<^sub>e\<^sub>t(a)))->including\<^sub>S\<^sub>e\<^sub>t(a) \<tau> = - (F x ((F y S)->including\<^sub>S\<^sub>e\<^sub>t(a)))->including\<^sub>S\<^sub>e\<^sub>t(a) \<tau>" - apply(rule including_subst_set'') - apply(rule all_defined1) - apply(simp add: all_def, rule cons_all_def', simp add: all_def) - apply(simp add: int_is_valid[OF a_int]) - apply(rule all_defined1) - apply(simp add: all_def, rule cons_all_def', simp add: all_def) - apply(simp add: int_is_valid[OF a_int])+ - apply(subst f_out) - apply(rule all_defined1, simp add: all_def, simp) - apply(simp add: int_is_valid[OF a_int]) - apply(subst UML_Set.OclIncluding.cp0) - apply(subst commute, simp_all add: UML_Set.OclIncluding.cp0[symmetric] f_out[symmetric]) - apply(subst f_out[symmetric]) - apply(rule all_defined1, simp add: all_def, simp) - apply(simp add: int_is_valid[OF a_int]) - apply(simp) - done - qed -qed - -subsection{* Preservation of comp fun commute (instance) *} - -lemma including_commute0_generic : - shows "comp_fun_commute (\<lambda>j (r2:: ('\<AA>, 'a option option) Set). (r2->including\<^sub>S\<^sub>e\<^sub>t(j)))" -by(simp add: comp_fun_commute_def comp_def) - -lemma including_commute_generic : - shows "EQ_comp_fun_commute (\<lambda>j (r2:: ('\<AA>, 'a option option) Set). (r2->including\<^sub>S\<^sub>e\<^sub>t(j)))" -proof - - have all_defined1 : "\<And>r2 \<tau>. all_defined \<tau> r2 \<Longrightarrow> \<tau> \<Turnstile> \<delta> r2" by(simp add: all_defined_def) - show ?thesis - apply(simp only: EQ_comp_fun_commute_def including_cp including_cp') - apply(rule conjI, rule conjI) apply(subst (1 2) UML_Set.OclIncluding.cp0, simp) apply(rule conjI) apply(subst (1 2) UML_Set.OclIncluding.cp0, simp) apply(rule allI)+ - apply(rule impI)+ - apply(rule including_cp_all) apply(simp) apply(rule all_defined1, blast) apply(simp) - apply(rule conjI) apply(rule allI)+ - apply(rule impI)+ apply(rule including_notempty) apply(rule all_defined1, blast) apply(simp) apply(simp) - by (metis OclIncluding_commute cons_all_def' invert_all_defined) -qed - -lemma including_commute2_generic : - assumes i_int : "is_int i" - shows "EQ_comp_fun_commute (\<lambda>x (acc :: ('\<AA>, 'a option option) Set). ((acc->including\<^sub>S\<^sub>e\<^sub>t(x))->including\<^sub>S\<^sub>e\<^sub>t(i)))" - apply(rule including_commute_gen_var) - apply(rule including_commute_generic, simp_all add: i_int) -done - -lemma including_commute3_generic : - assumes i_int : "is_int i" - shows "EQ_comp_fun_commute (\<lambda>x (acc :: ('\<AA>, 'a option option) Set). acc->including\<^sub>S\<^sub>e\<^sub>t(i)->including\<^sub>S\<^sub>e\<^sub>t(x))" -proof - - have all_defined1 : "\<And>r2 \<tau>. all_defined \<tau> r2 \<Longrightarrow> \<tau> \<Turnstile> \<delta> r2" by(simp add: all_defined_def) - have i_val : "\<And>\<tau>. \<tau> \<Turnstile> \<upsilon> i" by (simp add: int_is_valid[OF i_int]) - show ?thesis - apply(simp only: EQ_comp_fun_commute_def including_cp2 including_cp') - apply(rule conjI, rule conjI) apply(subst (1 2) UML_Set.OclIncluding.cp0, simp) apply(rule conjI) apply(subst (1 2) UML_Set.OclIncluding.cp0, subst (1 3) UML_Set.OclIncluding.cp0, simp) apply(rule allI)+ - apply(rule impI)+ - apply(rule including_cp_all) apply(simp) using all_defined1 cons_all_def' i_int int_is_valid apply blast - apply(rule including_cp_all) apply(simp add: i_int) apply(rule all_defined1, blast) apply(simp) - apply(rule conjI) apply(rule allI)+ - - apply(rule impI)+ - apply(rule including_notempty) using all_defined1 cons_all_def' i_int int_is_valid apply blast apply(simp) - apply(rule including_notempty) apply(rule all_defined1, blast) apply(simp add: i_val) apply(simp) - by (metis OclIncluding_commute cons_all_def' i_val invert_all_defined) -qed - -lemma including_commute4_generic : - assumes i_int : "is_int i" - and j_int : "is_int j" - shows "EQ_comp_fun_commute (\<lambda>x (acc :: ('\<AA>, 'a option option) Set). acc->including\<^sub>S\<^sub>e\<^sub>t(i)->including\<^sub>S\<^sub>e\<^sub>t(x)->including\<^sub>S\<^sub>e\<^sub>t(j))" -proof - - have all_defined1 : "\<And>r2 \<tau>. all_defined \<tau> r2 \<Longrightarrow> \<tau> \<Turnstile> \<delta> r2" by(simp add: all_defined_def) - have i_val : "\<And>\<tau>. \<tau> \<Turnstile> \<upsilon> i" by (simp add: int_is_valid[OF i_int]) - have j_val : "\<And>\<tau>. \<tau> \<Turnstile> \<upsilon> j" by (simp add: int_is_valid[OF j_int]) - show ?thesis - apply(rule including_commute_gen_var) - apply(rule including_commute3_generic) - apply(simp_all add: i_int j_int) - done -qed - -lemma including_commute5_generic : - assumes i_int : "is_int i" - and j_int : "is_int j" - shows "EQ_comp_fun_commute (\<lambda>x (acc :: ('\<AA>, 'a option option) Set). acc->including\<^sub>S\<^sub>e\<^sub>t(x)->including\<^sub>S\<^sub>e\<^sub>t(j)->including\<^sub>S\<^sub>e\<^sub>t(i))" -proof - - have all_defined1 : "\<And>r2 \<tau>. all_defined \<tau> r2 \<Longrightarrow> \<tau> \<Turnstile> \<delta> r2" by(simp add: all_defined_def) - have i_val : "\<And>\<tau>. \<tau> \<Turnstile> \<upsilon> i" by (simp add: int_is_valid[OF i_int]) - have j_val : "\<And>\<tau>. \<tau> \<Turnstile> \<upsilon> j" by (simp add: int_is_valid[OF j_int]) - show ?thesis - apply(rule including_commute_gen_var)+ - apply(simp add: including_commute_generic) - apply(simp_all add: i_int j_int) - done -qed - -lemma including_commute6_generic : - assumes i_int : "is_int i" - and j_int : "is_int j" - shows "EQ_comp_fun_commute (\<lambda>x (acc :: ('\<AA>, 'a option option) Set). acc->including\<^sub>S\<^sub>e\<^sub>t(i)->including\<^sub>S\<^sub>e\<^sub>t(j)->including\<^sub>S\<^sub>e\<^sub>t(x))" -proof - - have all_defined1 : "\<And>r2 \<tau>. all_defined \<tau> r2 \<Longrightarrow> \<tau> \<Turnstile> \<delta> r2" by(simp add: all_defined_def) - have i_val : "\<And>\<tau>. \<tau> \<Turnstile> \<upsilon> i" by (simp add: int_is_valid[OF i_int]) - have j_val : "\<And>\<tau>. \<tau> \<Turnstile> \<upsilon> j" by (simp add: int_is_valid[OF j_int]) - show ?thesis - apply(simp only: EQ_comp_fun_commute_def including_cp3 including_cp''') - apply(rule conjI, rule conjI) apply(subst (1 2) UML_Set.OclIncluding.cp0, simp) - apply(rule conjI) apply(subst (1 2) UML_Set.OclIncluding.cp0, subst (1 3) UML_Set.OclIncluding.cp0, subst (1 4) UML_Set.OclIncluding.cp0, simp) apply(rule allI)+ - apply(rule impI)+ - apply(rule including_cp_all) apply(simp) apply (metis (hide_lams, no_types) all_defined1 cons_all_def i_val j_val) - apply(rule including_cp_all) apply(simp) apply(simp add: j_int) apply (metis (hide_lams, no_types) all_defined1 cons_all_def i_val) - apply(rule including_cp_all) apply(simp) apply(simp add: i_int) apply(rule all_defined1, blast) apply(simp) - apply(rule conjI) apply(rule allI)+ - - apply(rule impI)+ - apply(rule including_notempty) apply (metis (hide_lams, no_types) all_defined1 cons_all_def i_val j_val) apply(simp) - apply(rule including_notempty) apply (metis (hide_lams, no_types) all_defined1 cons_all_def i_val) apply(simp add: j_val) - apply(rule including_notempty) apply(rule all_defined1, blast) apply(simp add: i_val) apply(simp) - by (metis (no_types, hide_lams) OclIncluding_commute cons_all_def' i_val invert_all_defined j_val) -qed - -section{* Properties: (with comp fun commute) OclIterate *} -subsection{* Congruence *} - -lemma iterate_subst_set_rec : - assumes A_defined : "\<forall>\<tau>. all_defined \<tau> A" - and F_commute : "EQ_comp_fun_commute F" - shows "let Fa' = (\<lambda>a \<tau>. a) ` Fa - ; x' = \<lambda>\<tau>. x in - x \<notin> Fa \<longrightarrow> - all_int_set (insert x' Fa') \<longrightarrow> - (\<forall>\<tau>. all_defined \<tau> (Finite_Set.fold F A Fa')) \<longrightarrow> - (\<forall>\<tau>. all_defined \<tau> (Finite_Set.fold F A (insert x' Fa')))" - apply(simp only: Let_def) apply(rule impI)+ apply(rule allI)+ - apply(rule EQ_comp_fun_commute000.all_defined_fold_rec[OF F_commute[THEN c0_of_c, THEN c000_of_c0]], simp add: A_defined, simp, simp, blast) -done - -lemma iterate_subst_set_rec0 : - assumes F_commute : "EQ_comp_fun_commute0 (\<lambda>x. (F:: ('\<AA>, _) val - \<Rightarrow> ('\<AA>, _) Set - \<Rightarrow> ('\<AA>, _) Set) (\<lambda>_. x))" - shows " - finite Fa \<Longrightarrow> - x \<notin> Fa \<Longrightarrow> - (\<And>\<tau>. all_defined \<tau> A) \<Longrightarrow> - all_int_set ((\<lambda>a (\<tau>:: '\<AA> st). a) ` insert x Fa) \<Longrightarrow> - \<forall>\<tau>. all_defined \<tau> (Finite_Set.fold (\<lambda>x. F (\<lambda>_. x)) A Fa) \<Longrightarrow> - \<forall>\<tau>. all_defined \<tau> (Finite_Set.fold (\<lambda>x. F (\<lambda>_. x)) A (insert x Fa))" - apply(rule allI, rule EQ_comp_fun_commute0.all_defined_fold_rec[OF F_commute]) - apply(simp, simp, simp add: all_int_set_def all_defined_set_def is_int_def, blast) -done - -lemma iterate_subst_set_rec0' : - assumes F_commute : "EQ_comp_fun_commute0' (\<lambda>x. (F:: ('\<AA>, _) val - \<Rightarrow> ('\<AA>, _) Set - \<Rightarrow> ('\<AA>, _) Set) (\<lambda>_. \<lfloor>x\<rfloor>))" - shows " - finite Fa \<Longrightarrow> - x \<notin> Fa \<Longrightarrow> - (\<And>\<tau>. all_defined \<tau> A) \<Longrightarrow> - all_int_set ((\<lambda>a (\<tau>:: '\<AA> st). \<lfloor>a\<rfloor>) ` insert x Fa) \<Longrightarrow> - \<forall>\<tau>. all_defined \<tau> (Finite_Set.fold (\<lambda>x. F (\<lambda>_. \<lfloor>x\<rfloor>)) A Fa) \<Longrightarrow> - \<forall>\<tau>. all_defined \<tau> (Finite_Set.fold (\<lambda>x. F (\<lambda>_. \<lfloor>x\<rfloor>)) A (insert x Fa))" - apply(rule allI, rule EQ_comp_fun_commute0'.all_defined_fold_rec[OF F_commute]) - apply(simp, simp, simp add: all_int_set_def all_defined_set'_def is_int_def, blast) -done - -lemma iterate_subst_set_gen : - assumes S_all_def : "\<And>\<tau>. all_defined \<tau> S" - and A_all_def : "\<And>\<tau>. all_defined \<tau> A" - and F_commute : "EQ_comp_fun_commute F" - and G_commute : "EQ_comp_fun_commute G" - and fold_eq : "\<And>x acc. is_int x \<Longrightarrow> (\<forall>\<tau>. all_defined \<tau> acc) \<Longrightarrow> P acc \<Longrightarrow> F x acc = G x acc" - and P0 : "P A" - and Prec : "\<And>x Fa. all_int_set Fa \<Longrightarrow> - is_int x \<Longrightarrow> x \<notin> Fa \<Longrightarrow> \<forall>\<tau>. all_defined \<tau> (Finite_Set.fold F A Fa) \<Longrightarrow> P (Finite_Set.fold F A Fa) \<Longrightarrow> P (F x (Finite_Set.fold F A Fa))" - shows "(S->iterate\<^sub>S\<^sub>e\<^sub>t(x;acc=A|F x acc)) = (S->iterate\<^sub>S\<^sub>e\<^sub>t(x;acc=A|G x acc))" -proof - - - have S_all_int : "\<And>\<tau>. all_int_set ((\<lambda>a \<tau>. a) ` \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil>)" - by(rule all_def_to_all_int, simp add: assms) - - have A_defined : "\<forall>\<tau>. \<tau> \<Turnstile> \<delta> A" - by(simp add: A_all_def[simplified all_defined_def]) - - interpret EQ_comp_fun_commute F by (rule F_commute) - show ?thesis - apply(simp only: UML_Set.OclIterate_def, rule ext) - proof - - fix \<tau> - show "(if (\<delta> S) \<tau> = true \<tau> \<and> (\<upsilon> A) \<tau> = true \<tau> \<and> finite \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil> then Finite_Set.fold F A ((\<lambda>a \<tau>. a) ` \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil>) \<tau> else \<bottom>) = - (if (\<delta> S) \<tau> = true \<tau> \<and> (\<upsilon> A) \<tau> = true \<tau> \<and> finite \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil> then Finite_Set.fold G A ((\<lambda>a \<tau>. a) ` \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil>) \<tau> else \<bottom>)" - apply(simp add: S_all_def[simplified all_defined_def all_defined_set_def OclValid_def] - A_all_def[simplified all_defined_def OclValid_def] - foundation20[OF A_defined[THEN spec, of \<tau>], simplified OclValid_def] - del: StrictRefEq\<^sub>S\<^sub>e\<^sub>t_exec) - apply(subgoal_tac "Finite_Set.fold F A ((\<lambda>a \<tau>. a) ` \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil>) = Finite_Set.fold G A ((\<lambda>a \<tau>. a) ` \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil>)", simp) - - apply(rule fold_cong[where P = "\<lambda>s. \<forall>\<tau>. all_defined \<tau> s \<and> P s", OF downgrade EQ_comp_fun_commute.downgrade[OF G_commute], simplified image_ident]) - apply(simp only: S_all_int) - apply(simp only: A_all_def) - apply(rule fold_eq, simp add: int_is_valid, simp, simp) - apply(simp, simp, simp add: A_all_def) - apply(simp add: P0) - apply(rule allI) - apply(subst EQ_comp_fun_commute.all_defined_fold_rec[OF F_commute], simp add: A_all_def, simp, simp add: all_int_set_def, blast) - apply(subst fold_insert, simp add: A_all_def, simp, simp, simp) - apply(simp add: Prec) - done - qed -qed - -lemma iterate_subst_set : - assumes S_all_def : "\<And>\<tau>. all_defined \<tau> S" - and A_all_def : "\<And>\<tau>. all_defined \<tau> A" - and F_commute : "EQ_comp_fun_commute F" - and G_commute : "EQ_comp_fun_commute G" - and fold_eq : "\<And>x acc. (\<forall>\<tau>. (\<tau> \<Turnstile> \<upsilon> x)) \<Longrightarrow> (\<forall>\<tau>. all_defined \<tau> acc) \<Longrightarrow> F x acc = G x acc" - shows "(S->iterate\<^sub>S\<^sub>e\<^sub>t(x;acc=A|F x acc)) = (S->iterate\<^sub>S\<^sub>e\<^sub>t(x;acc=A|G x acc))" -by(rule iterate_subst_set_gen[OF S_all_def A_all_def F_commute G_commute fold_eq], (simp add: int_is_valid)+) - -lemma iterate_subst_set' : - assumes S_all_def : "\<And>\<tau>. all_defined \<tau> S" - and A_all_def : "\<And>\<tau>. all_defined \<tau> A" - and A_include : "\<And>\<tau>1 \<tau>2. A \<tau>1 = A \<tau>2" - and F_commute : "EQ_comp_fun_commute F" - and G_commute : "EQ_comp_fun_commute G" - and fold_eq : "\<And>x acc. is_int x \<Longrightarrow> (\<forall>\<tau>. all_defined \<tau> acc) \<Longrightarrow> \<forall>\<tau> \<tau>'. acc \<tau> = acc \<tau>' \<Longrightarrow> F x acc = G x acc" - shows "(S->iterate\<^sub>S\<^sub>e\<^sub>t(x;acc=A|F x acc)) = (S->iterate\<^sub>S\<^sub>e\<^sub>t(x;acc=A|G x acc))" -proof - - interpret EQ_comp_fun_commute F by (rule F_commute) - show ?thesis - apply(rule iterate_subst_set_gen[where P = "\<lambda>acc. \<forall>\<tau> \<tau>'. acc \<tau> = acc \<tau>'", OF S_all_def A_all_def F_commute G_commute fold_eq], blast+) - apply(simp add: A_include) - apply(rule allI)+ - apply(rule cp_gen, simp, blast, blast) - done -qed - -lemma iterate_subst_set'' : - assumes S_all_def : "\<And>\<tau>. all_defined \<tau> S" - and A_all_def : "\<And>\<tau>. all_defined \<tau> A" - and A_notempty : "\<And>\<tau>. \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (A \<tau>)\<rceil>\<rceil> \<noteq> {}" - and F_commute : "EQ_comp_fun_commute F" - and G_commute : "EQ_comp_fun_commute G" - and fold_eq : "\<And>x acc. is_int x \<Longrightarrow> (\<forall>\<tau>. all_defined \<tau> acc) \<Longrightarrow> (\<And>\<tau>. \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (acc \<tau>)\<rceil>\<rceil> \<noteq> {}) \<Longrightarrow> F x acc = G x acc" - shows "(S->iterate\<^sub>S\<^sub>e\<^sub>t(x;acc=A|F x acc)) = (S->iterate\<^sub>S\<^sub>e\<^sub>t(x;acc=A|G x acc))" -proof - - interpret EQ_comp_fun_commute F by (rule F_commute) - show ?thesis - apply(rule iterate_subst_set_gen[where P = "\<lambda>acc. (\<forall>\<tau>. \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (acc \<tau>)\<rceil>\<rceil> \<noteq> {})", OF S_all_def A_all_def F_commute G_commute fold_eq], blast, blast, blast) - apply(simp add: A_notempty) - apply(rule allI)+ - apply(rule notempty, blast, simp add: int_is_valid, blast) - done -qed - -lemma iterate_subst_set_gen0 : - assumes S_all_def : "\<And>\<tau>. all_defined \<tau> S" - and A_all_def : "\<And>\<tau>. all_defined \<tau> A" - and F_commute : "EQ_comp_fun_commute0_gen0 f000 all_def_set (\<lambda>x. F (f000 x))" - and G_commute : "EQ_comp_fun_commute0_gen0 f000 all_def_set (\<lambda>x. (G :: ('\<AA>, _) val - \<Rightarrow> ('\<AA>, _) Set - \<Rightarrow> ('\<AA>, _) Set) (f000 x))" - and fold_eq : "\<And>x acc. is_int (f000 x) \<Longrightarrow> (\<forall>\<tau>. all_defined \<tau> acc) \<Longrightarrow> P acc \<tau> \<Longrightarrow> F (f000 x) acc \<tau> = G (f000 x) acc \<tau>" - and P0 : "P A \<tau>" - and Prec : "\<And>x Fa. \<forall>(\<tau>::'\<AA> st). all_def_set \<tau> Fa \<Longrightarrow> - is_int (f000 x) \<Longrightarrow> - x \<notin> Fa \<Longrightarrow> - \<forall>\<tau>. all_defined \<tau> (Finite_Set.fold (\<lambda>x. F (f000 x)) A Fa) \<Longrightarrow> - P (Finite_Set.fold (\<lambda>x. F (f000 x)) A Fa) \<tau> \<Longrightarrow> - P (F (f000 x) (Finite_Set.fold (\<lambda>x. F (f000 x)) A Fa)) \<tau>" - and f_fold_insert : "\<And>x S. x \<notin> S \<Longrightarrow> is_int (f000 x) \<Longrightarrow> all_int_set (f000 ` S) \<Longrightarrow> Finite_Set.fold F A (insert (f000 x) (f000 ` S)) = F (f000 x) (Finite_Set.fold F A (f000 ` S))" - and g_fold_insert : "\<And>x S. x \<notin> S \<Longrightarrow> is_int (f000 x) \<Longrightarrow> all_int_set (f000 ` S) \<Longrightarrow> Finite_Set.fold G A (insert (f000 x) (f000 ` S)) = G (f000 x) (Finite_Set.fold G A (f000 ` S))" - and S_lift : "all_defined \<tau> S \<Longrightarrow> \<exists>S'. (\<lambda>a \<tau>. a) ` \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil> = f000 ` S'" - shows "(S->iterate\<^sub>S\<^sub>e\<^sub>t(x;acc=A|F x acc)) \<tau> = (S->iterate\<^sub>S\<^sub>e\<^sub>t(x;acc=A|G x acc)) \<tau>" -proof - - have S_all_int : "\<And>\<tau>. all_int_set ((\<lambda>a \<tau>. a) ` \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil>)" - by(rule all_def_to_all_int, simp add: assms) - - have S_all_def' : "\<And>\<tau> \<tau>'. all_defined_set' \<tau>' \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil>" - apply(insert S_all_def) - apply(subst (asm) cp_all_def, simp add: all_defined_def all_defined_set'_def, blast) - done - - have A_defined : "\<forall>\<tau>. \<tau> \<Turnstile> \<delta> A" - by(simp add: A_all_def[simplified all_defined_def]) - - interpret EQ_comp_fun_commute0_gen0 f000 all_def_set "\<lambda>x. F (f000 x)" by (rule F_commute) - show ?thesis - apply(simp only: UML_Set.OclIterate_def) - proof - - show "(if (\<delta> S) \<tau> = true \<tau> \<and> (\<upsilon> A) \<tau> = true \<tau> \<and> finite \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil> then Finite_Set.fold F A ((\<lambda>a \<tau>. a) ` \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil>) \<tau> else \<bottom>) = - (if (\<delta> S) \<tau> = true \<tau> \<and> (\<upsilon> A) \<tau> = true \<tau> \<and> finite \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil> then Finite_Set.fold G A ((\<lambda>a \<tau>. a) ` \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil>) \<tau> else \<bottom>)" - apply(simp add: S_all_def[simplified all_defined_def all_defined_set'_def OclValid_def] - A_all_def[simplified all_defined_def OclValid_def] - foundation20[OF A_defined[THEN spec, of \<tau>], simplified OclValid_def] - del: StrictRefEq\<^sub>S\<^sub>e\<^sub>t_exec) - apply(rule S_lift[OF S_all_def, THEN exE], simp) - apply(subst img_fold[OF F_commute], simp add: A_all_def, drule sym, simp add: S_all_int, rule f_fold_insert, simp_all) apply(subst img_fold[OF G_commute], simp add: A_all_def, drule sym, simp add: S_all_int, rule g_fold_insert, simp_all) - apply(rule fold_cong'[where P = "\<lambda>s \<tau>. (\<forall>\<tau>. all_defined \<tau> s) \<and> P s \<tau>", OF downgrade EQ_comp_fun_commute0_gen0.downgrade[OF G_commute], simplified image_ident]) - apply(rule all_i_set_to_def) - apply(drule sym, simp add: S_all_int, simp add: A_all_def) - apply(rule fold_eq, simp add: int_is_valid, blast, simp) - apply(simp, simp, simp add: A_all_def, rule P0) - apply(rule conjI)+ - apply(subst all_defined_fold_rec[simplified], simp add: A_all_def, simp) apply(subst def_set[THEN iffD2, THEN spec], simp) apply(simp, blast, simp) - apply(subst fold_insert, simp add: A_all_def, simp, simp, simp) - apply(rule Prec, simp+) - done - qed -qed - -lemma iterate_subst_set0_gen : - assumes S_all_def : "\<And>\<tau>. all_defined \<tau> S" - and A_all_def : "\<And>\<tau>. all_defined \<tau> A" - and F_commute : "EQ_comp_fun_commute0 (\<lambda>x. F (\<lambda>_. x))" - and G_commute : "EQ_comp_fun_commute0 (\<lambda>x. (G :: ('\<AA>, _) val - \<Rightarrow> ('\<AA>, _) Set - \<Rightarrow> ('\<AA>, _) Set) (\<lambda>_. x))" - and fold_eq : "\<And>x acc. is_int (\<lambda>(_::'\<AA> st). x) \<Longrightarrow> (\<forall>\<tau>. all_defined \<tau> acc) \<Longrightarrow> P acc \<tau> \<Longrightarrow> F (\<lambda>_. x) acc \<tau> = G (\<lambda>_. x) acc \<tau>" - and P0 : "P A \<tau>" - and Prec : "\<And>x Fa. \<forall>(\<tau>::'\<AA> st). all_defined_set \<tau> Fa \<Longrightarrow> - is_int (\<lambda>(_::'\<AA> st). x) \<Longrightarrow> - x \<notin> Fa \<Longrightarrow> - \<forall>\<tau>. all_defined \<tau> (Finite_Set.fold (\<lambda>x. F (\<lambda>_. x)) A Fa) \<Longrightarrow> - P (Finite_Set.fold (\<lambda>x. F (\<lambda>_. x)) A Fa) \<tau> \<Longrightarrow> - P (F (\<lambda>_. x) (Finite_Set.fold (\<lambda>x. F (\<lambda>_. x)) A Fa)) \<tau>" - shows "(S->iterate\<^sub>S\<^sub>e\<^sub>t(x;acc=A|F x acc)) \<tau> = (S->iterate\<^sub>S\<^sub>e\<^sub>t(x;acc=A|G x acc)) \<tau>" - apply(rule iterate_subst_set_gen0[OF S_all_def A_all_def F_commute[THEN EQ_comp_fun_commute0.downgrade'] G_commute[THEN EQ_comp_fun_commute0.downgrade']]) - apply(rule fold_eq, simp, simp, simp) - apply(rule P0, rule Prec, blast+) - apply(subst EQ_comp_fun_commute000.fold_insert'[OF F_commute[THEN c000_of_c0[where f = F]], simplified], simp add: A_all_def, blast+) - apply(subst EQ_comp_fun_commute000.fold_insert'[OF G_commute[THEN c000_of_c0[where f = G]], simplified], simp add: A_all_def, blast+) -done - -lemma iterate_subst_set0 : - assumes S_all_def : "\<And>\<tau>. all_defined \<tau> S" - and A_all_def : "\<And>\<tau>. all_defined \<tau> A" - and F_commute : "EQ_comp_fun_commute0 (\<lambda>x. F (\<lambda>_. x))" - and G_commute : "EQ_comp_fun_commute0 (\<lambda>x. (G :: ('\<AA>, _) val - \<Rightarrow> ('\<AA>, _) Set - \<Rightarrow> ('\<AA>, _) Set) (\<lambda>_. x))" - and fold_eq : "\<And>x acc. (\<forall>\<tau>. (\<tau> \<Turnstile> \<upsilon> (\<lambda>(_:: '\<AA> st). x))) \<Longrightarrow> (\<forall>\<tau>. all_defined \<tau> acc) \<Longrightarrow> F (\<lambda>_. x) acc = G (\<lambda>_. x) acc" - shows "(S->iterate\<^sub>S\<^sub>e\<^sub>t(x;acc=A|F x acc)) = (S->iterate\<^sub>S\<^sub>e\<^sub>t(x;acc=A|G x acc))" - apply(rule ext, rule iterate_subst_set0_gen, simp_all add: assms) - apply(subst fold_eq, simp_all add: int_is_valid) -done - -lemma iterate_subst_set'0 : - assumes S_all_def : "\<And>\<tau>. all_defined \<tau> S" - and A_all_def : "\<And>\<tau>. all_defined \<tau> A" - and A_include : "\<And>\<tau>1 \<tau>2. A \<tau>1 = A \<tau>2" - and F_commute : "EQ_comp_fun_commute0 (\<lambda>x. F (\<lambda>_. x))" - and G_commute : "EQ_comp_fun_commute0 (\<lambda>x. (G :: ('\<AA>, _) val - \<Rightarrow> ('\<AA>, _) Set - \<Rightarrow> ('\<AA>, _) Set) (\<lambda>_. x))" - and fold_eq : "\<And>x acc \<tau>. is_int (\<lambda>(_::'\<AA> st). x) \<Longrightarrow> (\<forall>\<tau>. all_defined \<tau> acc) \<Longrightarrow> \<forall>\<tau> \<tau>'. acc \<tau> = acc \<tau>' \<Longrightarrow> F (\<lambda>_. x) acc = G (\<lambda>_. x) acc" - shows "(S->iterate\<^sub>S\<^sub>e\<^sub>t(x;acc=A|F x acc)) = (S->iterate\<^sub>S\<^sub>e\<^sub>t(x;acc=A|G x acc))" -proof - - interpret EQ_comp_fun_commute0 "\<lambda>x. F (\<lambda>_. x)" by (rule F_commute) - show ?thesis - apply(rule ext, rule iterate_subst_set0_gen[where P = "\<lambda>acc _. \<forall>\<tau> \<tau>'. acc \<tau> = acc \<tau>'", OF S_all_def A_all_def F_commute G_commute]) - apply(subst fold_eq, simp+, simp add: A_include) - apply(rule allI)+ - apply(rule cp_gen', simp, blast, blast) - done -qed - -lemma iterate_subst_set''0 : - assumes S_all_def : "\<And>\<tau>. all_defined \<tau> S" - and A_all_def : "\<And>\<tau>. all_defined \<tau> A" - and F_commute : "EQ_comp_fun_commute0 (\<lambda>x. F (\<lambda>_. x))" - and G_commute : "EQ_comp_fun_commute0 (\<lambda>x. (G :: ('\<AA>, _) val - \<Rightarrow> ('\<AA>, _) Set - \<Rightarrow> ('\<AA>, _) Set) (\<lambda>_. x))" - and fold_eq : "\<And>x acc. is_int (\<lambda>(_::'\<AA> st). x) \<Longrightarrow> (\<forall>\<tau>. all_defined \<tau> acc) \<Longrightarrow> \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (acc \<tau>)\<rceil>\<rceil> \<noteq> {} \<Longrightarrow> F (\<lambda>_. x) acc \<tau> = G (\<lambda>_. x) acc \<tau>" - shows "\<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (A \<tau>)\<rceil>\<rceil> \<noteq> {} \<Longrightarrow> (S->iterate\<^sub>S\<^sub>e\<^sub>t(x;acc=A|F x acc)) \<tau> = (S->iterate\<^sub>S\<^sub>e\<^sub>t(x;acc=A|G x acc)) \<tau>" -proof - - interpret EQ_comp_fun_commute0 "\<lambda>x. F (\<lambda>_. x)" by (rule F_commute) - show "\<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (A \<tau>)\<rceil>\<rceil> \<noteq> {} \<Longrightarrow> ?thesis" - apply(rule iterate_subst_set0_gen[where P = "\<lambda>acc \<tau>. \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (acc \<tau>)\<rceil>\<rceil> \<noteq> {}", OF S_all_def A_all_def F_commute G_commute]) - apply(subst fold_eq, simp+) - apply(rule notempty', simp+) - done -qed - -lemma iterate_subst_set___ : - assumes S_all_def : "\<And>\<tau>. all_defined \<tau> S" - and A_all_def : "\<And>\<tau>. all_defined \<tau> A" - and A_include : "\<And>\<tau>1 \<tau>2. A \<tau>1 = A \<tau>2" - and F_commute : "EQ_comp_fun_commute0' (\<lambda>x. F (\<lambda>_. \<lfloor>x\<rfloor>))" - and G_commute : "EQ_comp_fun_commute0' (\<lambda>x. (G :: ('\<AA>, _) val - \<Rightarrow> ('\<AA>, _) Set - \<Rightarrow> ('\<AA>, _) Set) (\<lambda>_. \<lfloor>x\<rfloor>))" - and fold_eq : "\<And>x acc. is_int (\<lambda>(_::'\<AA> st). \<lfloor>x\<rfloor>) \<Longrightarrow> (\<forall>\<tau>. all_defined \<tau> acc) \<Longrightarrow> \<forall>\<tau> \<tau>'. acc \<tau> = acc \<tau>' \<Longrightarrow> \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (acc \<tau>)\<rceil>\<rceil> \<noteq> {} \<Longrightarrow> F (\<lambda>_. \<lfloor>x\<rfloor>) acc \<tau> = G (\<lambda>_. \<lfloor>x\<rfloor>) acc \<tau>" - shows "\<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (A \<tau>)\<rceil>\<rceil> \<noteq> {} \<Longrightarrow> (S->iterate\<^sub>S\<^sub>e\<^sub>t(x;acc=A|F x acc)) \<tau> = (S->iterate\<^sub>S\<^sub>e\<^sub>t(x;acc=A|G x acc)) \<tau>" -proof - - interpret EQ_comp_fun_commute0' "\<lambda>x. F (\<lambda>_. \<lfloor>x\<rfloor>)" by (rule F_commute) - show "\<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (A \<tau>)\<rceil>\<rceil> \<noteq> {} \<Longrightarrow> ?thesis" - apply(rule iterate_subst_set_gen0[where P = "\<lambda>acc \<tau>. (\<forall>\<tau> \<tau>'. acc \<tau> = acc \<tau>') \<and> \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (acc \<tau>)\<rceil>\<rceil> \<noteq> {}", OF S_all_def A_all_def F_commute[THEN EQ_comp_fun_commute0'.downgrade'] G_commute[THEN EQ_comp_fun_commute0'.downgrade']]) - apply(rule fold_eq, blast+, simp add: A_include) - apply(rule conjI)+ - apply(rule allI)+ - apply(rule cp_gen', blast+) - apply(rule notempty', blast+) - apply(subst EQ_comp_fun_commute000'.fold_insert'[OF F_commute[THEN c000'_of_c0'[where f = F]], simplified], simp add: A_all_def, blast+) - apply(subst EQ_comp_fun_commute000'.fold_insert'[OF G_commute[THEN c000'_of_c0'[where f = G]], simplified], simp add: A_all_def, blast+) - apply(rule S_lift', simp add: all_defined_def) - done -qed - -subsection{* Context passing *} - -lemma cp_OclIterate1_gen: - assumes f_comm : "EQ_comp_fun_commute0_gen0 f000 all_def_set (\<lambda>x. f (f000 x))" - and A_all_def : "\<And>\<tau>. all_defined \<tau> A" - and f_fold_insert : "\<And>x S A. (\<And>\<tau>. all_defined \<tau> A) \<Longrightarrow> x \<notin> S \<Longrightarrow> is_int (f000 x) \<Longrightarrow> all_int_set (f000 ` S) \<Longrightarrow> Finite_Set.fold f A (insert (f000 x) (f000 ` S)) = f (f000 x) (Finite_Set.fold f A (f000 ` S))" - and S_lift : "all_defined \<tau> X \<Longrightarrow> \<exists>S'. (\<lambda>a \<tau>. a) ` \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (X \<tau>)\<rceil>\<rceil> = f000 ` S'" - shows "(X->iterate\<^sub>S\<^sub>e\<^sub>t(a; x = A | f a x)) \<tau> = - ((\<lambda> _. X \<tau>)->iterate\<^sub>S\<^sub>e\<^sub>t(a; x = (\<lambda>_. A \<tau>) | f a x)) \<tau>" -proof - - have B : "\<lfloor>\<bottom>\<rfloor> \<in> {X. X = bot \<or> X = null \<or> (\<forall>x\<in>\<lceil>\<lceil>X\<rceil>\<rceil>. x \<noteq> bot)}" by(simp add: null_option_def bot_option_def) - have A_all_def' : "\<And>\<tau> \<tau>'. all_defined \<tau> (\<lambda>a. A \<tau>')" by(subst cp_all_def[symmetric], simp add: A_all_def) - - interpret EQ_comp_fun_commute0_gen0 f000 all_def_set "\<lambda>x. f (f000 x)" by (rule f_comm) - show ?thesis - apply(subst UML_Set.cp_OclIterate[symmetric]) - apply(simp add: UML_Set.OclIterate_def cp_valid[symmetric]) - apply(case_tac "\<not>((\<delta> X) \<tau> = true \<tau> \<and> (\<upsilon> A) \<tau> = true \<tau> \<and> finite \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (X \<tau>)\<rceil>\<rceil>)", blast) - apply(simp) - apply(erule conjE)+ - apply(frule Set_inv_lemma[simplified OclValid_def]) - proof - - assume "(\<delta> X) \<tau> = true \<tau>" - "finite \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (X \<tau>)\<rceil>\<rceil>" - "\<forall>x\<in>\<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (X \<tau>)\<rceil>\<rceil>. x \<noteq> \<bottom>" - then have X_def : "all_defined \<tau> X" by (metis (lifting, no_types) OclValid_def all_defined_def all_defined_set'_def foundation18') - show "Finite_Set.fold f A ((\<lambda>a \<tau>. a) ` \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (X \<tau>)\<rceil>\<rceil>) \<tau> = Finite_Set.fold f (\<lambda>_. A \<tau>) ((\<lambda>a \<tau>. a) ` \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (X \<tau>)\<rceil>\<rceil>) \<tau>" - apply(rule S_lift[OF X_def, THEN exE], simp) - apply(subst (1 2) img_fold[OF f_comm], simp add: A_all_def', drule sym, simp add: all_def_to_all_int[OF X_def]) - apply(rule f_fold_insert, simp_all add: A_all_def' A_all_def)+ - apply(rule fold_cong'''[where P = "\<lambda>_ _. True", OF downgrade downgrade, simplified image_ident]) - apply(rule all_i_set_to_def) - apply(drule sym, simp add: all_def_to_all_int[OF X_def], simp add: A_all_def) apply(subst cp_all_def[symmetric], simp add: A_all_def) - apply(blast+) - done - qed -qed - -lemma cp_OclIterate1: - assumes f_comm : "EQ_comp_fun_commute0' (\<lambda>x. f (\<lambda>_. \<lfloor>x\<rfloor>))" - and A_all_def : "\<And>\<tau>. all_defined \<tau> A" - shows "(X->iterate\<^sub>S\<^sub>e\<^sub>t(a; x = A | f a x)) \<tau> = - ((\<lambda> _. X \<tau>)->iterate\<^sub>S\<^sub>e\<^sub>t(a; x = (\<lambda>_. A \<tau>) | f a x)) \<tau>" -proof - - interpret EQ_comp_fun_commute0' "\<lambda>x. f (\<lambda>_. \<lfloor>x\<rfloor>)" by (rule f_comm) - show ?thesis - apply(rule cp_OclIterate1_gen[OF downgrade' A_all_def]) - apply(subst EQ_comp_fun_commute000'.fold_insert'[OF f_comm[THEN c000'_of_c0'[where f = f]], simplified], simp_all) - apply(rule S_lift', simp add: all_defined_def) - done -qed - -subsection{* all defined (construction) *} - -lemma i_cons_all_def : - assumes F_commute : "EQ_comp_fun_commute0 (\<lambda>x. (F :: ('\<AA>, _) val - \<Rightarrow> ('\<AA>, _) Set - \<Rightarrow> ('\<AA>, _) Set) (\<lambda>_. x))" - and A_all_def : "\<And>\<tau>. all_defined \<tau> S" - shows "all_defined \<tau> (UML_Set.OclIterate S S F)" -proof - - have A_all_def' : "\<forall>\<tau>. all_int_set ((\<lambda>a (\<tau>:: '\<AA> st). a) ` \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil>)" - apply(rule allI, rule all_def_to_all_int, simp add: A_all_def) - done - - show ?thesis - apply(unfold UML_Set.OclIterate_def) - apply(simp add: A_all_def[simplified all_defined_def OclValid_def] - A_all_def[simplified all_defined_def all_defined_set'_def] - A_all_def[simplified all_defined_def, THEN conjunct1, THEN foundation20, simplified OclValid_def] - ) - apply(subgoal_tac "\<forall>\<tau>'. all_defined \<tau>' (Finite_Set.fold F S ((\<lambda>a \<tau>. a) ` \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil>))", metis (lifting, no_types) foundation16 all_defined_def) - apply(rule allI, rule EQ_comp_fun_commute000.fold_def[OF F_commute[THEN c000_of_c0]], simp add: A_all_def, simp add: A_all_def') - done -qed - -lemma i_cons_all_def'' : - assumes F_commute : "EQ_comp_fun_commute0' (\<lambda>x. F (\<lambda>_. \<lfloor>x\<rfloor>))" - and S_all_def : "\<And>\<tau>. all_defined \<tau> S" - and A_all_def : "\<And>\<tau>. all_defined \<tau> A" - shows "all_defined \<tau> (UML_Set.OclIterate S A F)" -proof - - have A_all_def' : "\<forall>\<tau>. all_int_set ((\<lambda>a (\<tau>:: '\<AA> st). a) ` \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil>)" - apply(rule allI, rule all_def_to_all_int, simp add: S_all_def) - done - - show ?thesis - apply(unfold UML_Set.OclIterate_def) - apply(simp add: S_all_def[simplified all_defined_def OclValid_def] - S_all_def[simplified all_defined_def all_defined_set'_def] - A_all_def[simplified all_defined_def, THEN conjunct1, THEN foundation20, simplified OclValid_def] - ) - apply(subgoal_tac "\<forall>\<tau>'. all_defined \<tau>' (Finite_Set.fold F A ((\<lambda>a \<tau>. a) ` \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil>))", metis (lifting, no_types) foundation16 all_defined_def) - apply(rule S_lift'[THEN exE, OF S_all_def[of \<tau>, simplified all_defined_def, THEN conjunct1]], simp only:) - apply(rule allI, rule EQ_comp_fun_commute000'.fold_def[OF F_commute[THEN c000'_of_c0']], simp add: A_all_def, drule sym, simp add: A_all_def') - done -qed - -lemma i_cons_all_def''cp : - assumes F_commute : "EQ_comp_fun_commute0' (\<lambda>x. F (\<lambda>_. \<lfloor>x\<rfloor>))" - and S_all_def : "\<And>\<tau>. all_defined \<tau> S" - and A_all_def : "\<And>\<tau>. all_defined \<tau> A" - shows "all_defined \<tau> (\<lambda>\<tau>. UML_Set.OclIterate (\<lambda>_. S \<tau>) (\<lambda>_. A \<tau>) F \<tau>)" - apply(subst cp_OclIterate1[symmetric, OF F_commute A_all_def]) - apply(rule i_cons_all_def''[OF F_commute S_all_def A_all_def]) -done - -lemma i_cons_all_def' : - assumes F_commute : "EQ_comp_fun_commute0' (\<lambda>x. F (\<lambda>_. \<lfloor>x\<rfloor>))" - and A_all_def : "\<And>\<tau>. all_defined \<tau> S" - shows "all_defined \<tau> (UML_Set.OclIterate S S F)" -by(rule i_cons_all_def'', simp_all add: assms) - -subsection{* Preservation of global jugdment *} - -lemma iterate_cp_all_gen : - assumes F_commute : "EQ_comp_fun_commute0_gen0 f000 all_def_set (\<lambda>x. F (f000 x))" - and A_all_def : "\<forall>\<tau>. all_defined \<tau> S" - and S_cp : "S (\<tau>1 :: '\<AA> st) = S \<tau>2" - and f_fold_insert : "\<And>x A S. x \<notin> S \<Longrightarrow> (\<And>\<tau>. all_defined \<tau> A) \<Longrightarrow> is_int (f000 x) \<Longrightarrow> all_int_set (f000 ` S) \<Longrightarrow> Finite_Set.fold F A (insert (f000 x) (f000 ` S)) = F (f000 x) (Finite_Set.fold F A (f000 ` S))" - and S_lift : "all_defined \<tau>2 S \<Longrightarrow> \<exists>S'. (\<lambda>a \<tau>. a) ` \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>2)\<rceil>\<rceil> = f000 ` S'" - shows "UML_Set.OclIterate S S F \<tau>1 = UML_Set.OclIterate S S F \<tau>2" -proof - - have A_all_def' : "\<forall>\<tau>. all_int_set ((\<lambda>a (\<tau>:: '\<AA> st). a) ` \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil>)" - apply(rule allI, rule all_def_to_all_int, simp add: A_all_def) - done - - interpret EQ_comp_fun_commute0_gen0 f000 all_def_set "\<lambda>x. F (f000 x)" by (rule F_commute) - show ?thesis - apply(unfold UML_Set.OclIterate_def) - apply(simp add: A_all_def[THEN spec, simplified all_defined_def OclValid_def] - A_all_def[THEN spec, simplified all_defined_def all_defined_set'_def] - A_all_def[THEN spec, simplified all_defined_def, THEN conjunct1, THEN foundation20, simplified OclValid_def] - S_cp) - apply(rule S_lift[OF A_all_def[THEN spec], THEN exE], simp) - apply(subst (1 2) img_fold[OF F_commute], simp add: A_all_def, drule sym, simp add: A_all_def', rule f_fold_insert, simp_all add: A_all_def) - apply(subst (1 2) image_ident[symmetric]) - apply(rule fold_cong''[where P = "\<lambda>_ _. True", OF F_commute[THEN EQ_comp_fun_commute0_gen0.downgrade] F_commute[THEN EQ_comp_fun_commute0_gen0.downgrade]]) - apply(rule all_i_set_to_def) - apply(drule sym, simp add: A_all_def', simp add: A_all_def) - apply(simp_all add: S_cp) - done -qed - -lemma iterate_cp_all : - assumes F_commute : "EQ_comp_fun_commute0 (\<lambda>x. F (\<lambda>_. x))" - and A_all_def : "\<forall>\<tau>. all_defined \<tau> S" - and S_cp : "S (\<tau>1 :: '\<AA> st) = S \<tau>2" - shows "UML_Set.OclIterate S S F \<tau>1 = UML_Set.OclIterate S S F \<tau>2" - apply(rule iterate_cp_all_gen[OF F_commute[THEN EQ_comp_fun_commute0.downgrade'] A_all_def S_cp]) - apply(subst EQ_comp_fun_commute000.fold_insert'[OF F_commute[THEN c000_of_c0[where f = F]], simplified], blast+) -done - -lemma iterate_cp_all' : - assumes F_commute : "EQ_comp_fun_commute0' (\<lambda>x. F (\<lambda>_. \<lfloor>x\<rfloor>))" - and A_all_def : "\<forall>\<tau>. all_defined \<tau> S" - and S_cp : "S (\<tau>1 :: '\<AA> st) = S \<tau>2" - shows "UML_Set.OclIterate S S F \<tau>1 = UML_Set.OclIterate S S F \<tau>2" - apply(rule iterate_cp_all_gen[OF F_commute[THEN EQ_comp_fun_commute0'.downgrade'] A_all_def S_cp]) - apply(subst EQ_comp_fun_commute000'.fold_insert'[OF F_commute[THEN c000'_of_c0'[where f = F]], simplified], blast+) - apply(rule S_lift', simp add: all_defined_def) -done - -subsection{* Preservation of non-emptiness *} - -lemma iterate_notempty_gen : - assumes F_commute : "EQ_comp_fun_commute0_gen0 f000 all_def_set (\<lambda>x. (F:: ('\<AA>, 'a option option) val - \<Rightarrow> ('\<AA>, _) Set - \<Rightarrow> ('\<AA>, _) Set) (f000 x))" - and A_all_def : "\<forall>\<tau>. all_defined \<tau> S" - and S_notempty : "\<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil> \<noteq> {}" - and f_fold_insert : "\<And>x A S. x \<notin> S \<Longrightarrow> (\<And>\<tau>. all_defined \<tau> A) \<Longrightarrow> is_int (f000 x) \<Longrightarrow> all_int_set (f000 ` S) \<Longrightarrow> Finite_Set.fold F A (insert (f000 x) (f000 ` S)) = F (f000 x) (Finite_Set.fold F A (f000 ` S))" - and S_lift : "all_defined \<tau> S \<Longrightarrow> \<exists>S'. (\<lambda>a \<tau>. a) ` \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil> = f000 ` S'" - shows "\<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (UML_Set.OclIterate S S F \<tau>)\<rceil>\<rceil> \<noteq> {}" -proof - - have A_all_def' : "\<forall>\<tau>. all_int_set ((\<lambda>a (\<tau>:: '\<AA> st). a) ` \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil>)" - apply(rule allI, rule all_def_to_all_int, simp add: A_all_def) - done - - interpret EQ_comp_fun_commute0_gen0 f000 all_def_set "\<lambda>x. F (f000 x)" by (rule F_commute) - show ?thesis - apply(unfold UML_Set.OclIterate_def) - apply(simp add: A_all_def[THEN spec, simplified all_defined_def OclValid_def] - A_all_def[THEN spec, simplified all_defined_def all_defined_set'_def] - A_all_def[THEN spec, simplified all_defined_def, THEN conjunct1, THEN foundation20, simplified OclValid_def] - ) - apply(insert S_notempty) - apply(rule S_lift[OF A_all_def[THEN spec], THEN exE], simp) - apply(subst img_fold[OF F_commute], simp add: A_all_def, drule sym, simp add: A_all_def', rule f_fold_insert, simp_all add: A_all_def) - apply(subst (2) image_ident[symmetric]) - apply(rule all_int_induct) - apply(rule all_i_set_to_def) - apply(drule sym, simp add: A_all_def') - apply(simp) - apply(simp) - apply(subst fold_insert[OF A_all_def], metis surj_pair, simp, simp) - apply(rule notempty, rule allI, rule fold_def[simplified], simp add: A_all_def, blast+) - done -qed - -lemma iterate_notempty : - assumes F_commute : "EQ_comp_fun_commute0 (\<lambda>x. (F:: ('\<AA>, _) val - \<Rightarrow> ('\<AA>, _) Set - \<Rightarrow> ('\<AA>, _) Set) (\<lambda>_. x))" - and A_all_def : "\<forall>\<tau>. all_defined \<tau> S" - and S_notempty : "\<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil> \<noteq> {}" - shows "\<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (UML_Set.OclIterate S S F \<tau>)\<rceil>\<rceil> \<noteq> {}" - apply(rule iterate_notempty_gen[OF F_commute[THEN EQ_comp_fun_commute0.downgrade'] A_all_def S_notempty]) - apply(subst EQ_comp_fun_commute000.fold_insert'[OF F_commute[THEN c000_of_c0[where f = F]], simplified], blast+) -done - -lemma iterate_notempty' : - assumes F_commute : "EQ_comp_fun_commute0' (\<lambda>x. F (\<lambda>_. \<lfloor>x\<rfloor>))" - and A_all_def : "\<forall>\<tau>. all_defined \<tau> S" - and S_notempty : "\<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil> \<noteq> {}" - shows "\<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (UML_Set.OclIterate S S F \<tau>)\<rceil>\<rceil> \<noteq> {}" - apply(rule iterate_notempty_gen[OF F_commute[THEN EQ_comp_fun_commute0'.downgrade'] A_all_def S_notempty]) - apply(subst EQ_comp_fun_commute000'.fold_insert'[OF F_commute[THEN c000'_of_c0'[where f = F]], simplified], blast+) - apply(rule S_lift', simp add: all_defined_def) -done - -subsection{* Preservation of comp fun commute (main) *} - -lemma iterate_commute' : - assumes f_comm : "\<And>a. EQ_comp_fun_commute0' (\<lambda>x. F a (\<lambda>_. \<lfloor>x\<rfloor>))" - - assumes f_notempty : "\<And>S x y \<tau>. is_int (\<lambda>(_::'\<AA> st). \<lfloor>x\<rfloor>) \<Longrightarrow> - is_int (\<lambda>(_::'\<AA> st). \<lfloor>y\<rfloor>) \<Longrightarrow> - (\<forall>(\<tau>::'\<AA> st). all_defined \<tau> S) \<Longrightarrow> - \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil> \<noteq> {} \<Longrightarrow> - UML_Set.OclIterate (UML_Set.OclIterate S S (F x)) (UML_Set.OclIterate S S (F x)) (F y) \<tau> = - UML_Set.OclIterate (UML_Set.OclIterate S S (F y)) (UML_Set.OclIterate S S (F y)) (F x) \<tau>" - - shows "EQ_comp_fun_commute0' (\<lambda>x S. S ->iterate\<^sub>S\<^sub>e\<^sub>t(j;S=S | F x j S))" - proof - interpret EQ_comp_fun_commute0' "\<lambda>x. F a (\<lambda>_. \<lfloor>x\<rfloor>)" by (rule f_comm) - apply_end(simp only: EQ_comp_fun_commute0'_def) - apply_end(rule conjI)+ apply_end(rule allI)+ apply_end(rule impI)+ - apply_end(subst cp_OclIterate1[OF f_comm], blast, simp) - apply_end(rule allI)+ apply_end(rule impI)+ - apply_end(subst iterate_cp_all', simp add: f_comm, simp, simp, simp) - - apply_end(rule conjI)+ apply_end(rule allI)+ apply_end(rule impI)+ - - show "\<And>x S \<tau>. - \<forall>\<tau>. all_defined \<tau> S \<Longrightarrow> - is_int (\<lambda>_. \<lfloor>x\<rfloor>) \<Longrightarrow> \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil> \<noteq> {} \<Longrightarrow> \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (UML_Set.OclIterate S S (F x) \<tau>)\<rceil>\<rceil> \<noteq> {}" - by(rule iterate_notempty'[OF f_comm], simp_all) - - apply_end(rule conjI)+ apply_end(rule allI)+ - fix x y \<tau> - show "(\<forall>\<tau>. all_defined \<tau> (UML_Set.OclIterate y y (F x))) = (is_int (\<lambda>(_:: '\<AA> st). \<lfloor>x\<rfloor>) \<and> (\<forall>\<tau>. all_defined \<tau> y))" - apply(rule iffI, rule conjI) apply(simp add: is_int_def OclValid_def valid_def bot_fun_def bot_option_def) - apply(rule i_invert_all_defined'[where F = "F x"], simp) - apply(rule allI, rule i_cons_all_def'[where F = "F x", OF f_comm], blast) - done - - apply_end(rule allI)+ apply_end(rule impI)+ - apply_end(rule ext, rename_tac \<tau>) - fix S and x and y and \<tau> - show " is_int (\<lambda>(_::'\<AA> st). \<lfloor>x\<rfloor>) \<Longrightarrow> - is_int (\<lambda>(_::'\<AA> st). \<lfloor>y\<rfloor>) \<Longrightarrow> - (\<forall>(\<tau>::'\<AA> st). all_defined \<tau> S) \<Longrightarrow> - UML_Set.OclIterate (UML_Set.OclIterate S S (F x)) (UML_Set.OclIterate S S (F x)) (F y) \<tau> = - UML_Set.OclIterate (UML_Set.OclIterate S S (F y)) (UML_Set.OclIterate S S (F y)) (F x) \<tau> " - apply(case_tac "\<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil> = {}") - apply(subgoal_tac "S \<tau> = Set{} \<tau>") - prefer 2 - apply(drule_tac f = "\<lambda>s. Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e \<lfloor>\<lfloor>s\<rfloor>\<rfloor>" in arg_cong) - apply(subgoal_tac "S \<tau> = Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e \<lfloor>\<lfloor>{}\<rfloor>\<rfloor>") - prefer 2 - apply(metis (hide_lams, no_types) abs_rep_simp' all_defined_def) - apply(simp add: mtSet_def) - - apply(subst (1 2) cp_OclIterate1[OF f_comm]) apply(rule i_cons_all_def'[OF f_comm], blast)+ - apply(subst (1 2 3 4 5 6) cp_OclIterate1[OF f_comm]) - apply(subst cp_all_def[symmetric]) apply(rule i_cons_all_def'[OF f_comm], blast) apply(blast) - apply(subst cp_all_def[symmetric]) apply(rule i_cons_all_def'[OF f_comm], blast) - apply(simp) - apply(subst (1 2 3 4 5 6) cp_OclIterate1[OF f_comm, symmetric]) - apply(subst (1 2) cp_mtSet[symmetric]) - apply(rule i_cons_all_def'[OF f_comm]) apply(simp add: mtSet_all_def)+ - apply(subst (1 2) cp_mtSet[symmetric]) - apply(rule i_cons_all_def'[OF f_comm]) apply(simp add: mtSet_all_def)+ - - apply(subst (1 2) cp_OclIterate1[OF f_comm]) - apply(rule i_cons_all_def'[OF f_comm], metis surj_pair) - apply(rule i_cons_all_def'[OF f_comm], metis surj_pair) - apply(subst (1 2 3 4 5 6) cp_OclIterate1[OF f_comm]) - apply(subst cp_all_def[symmetric]) apply(rule i_cons_all_def'[OF f_comm]) apply(metis surj_pair)+ - apply(subst cp_all_def[symmetric]) apply(rule i_cons_all_def'[OF f_comm]) apply(metis surj_pair)+ - apply(subst (1 2 3 4 5 6) cp_OclIterate1[OF f_comm, symmetric]) - apply(rule i_cons_all_def''cp[OF f_comm]) apply(metis surj_pair) apply(metis surj_pair) apply(metis surj_pair) - apply(rule i_cons_all_def''cp[OF f_comm]) apply(metis surj_pair) apply(metis surj_pair) - - apply(rule f_notempty, simp_all) - - done -qed - -section{* Properties: (with comp fun commute) OclIterate and OclIncluding *} -subsection{* Identity *} - -lemma i_including_id'_generic : - assumes including_commute : "EQ_comp_fun_commute (\<lambda>j (r2 :: ('\<AA>, 'a option option) Set). r2->including\<^sub>S\<^sub>e\<^sub>t(j))" - assumes S_all_def : "\<And>\<tau>. all_defined \<tau> (S :: ('\<AA>, 'a option option) Set)" - shows "(Finite_Set.fold (\<lambda>j r2. r2->including\<^sub>S\<^sub>e\<^sub>t(j)) S ((\<lambda>a \<tau>. a) ` \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil>)) \<tau> = S \<tau>" -proof - - have invert_set_0 : "\<And>x F. \<lfloor>\<lfloor>insert x F\<rfloor>\<rfloor> \<in> {X. X = bot \<or> X = null \<or> (\<forall>x\<in>\<lceil>\<lceil>X\<rceil>\<rceil>. x \<noteq> bot)} \<Longrightarrow> \<lfloor>\<lfloor>F\<rfloor>\<rfloor> \<in> {X. X = bot \<or> X = null \<or> (\<forall>x\<in>\<lceil>\<lceil>X\<rceil>\<rceil>. x \<noteq> bot)}" - by(auto simp: bot_option_def null_option_def) - - have invert_all_def_set : "\<And>x F \<tau>. all_defined_set \<tau> (insert x F) \<Longrightarrow> all_defined_set \<tau> F" - apply(simp add: all_defined_set_def) - done - - have all_def_to_all_int_ : "\<And>set \<tau>. all_defined_set \<tau> set \<Longrightarrow> all_int_set ((\<lambda>a \<tau>. a) ` set)" - apply(simp add: all_defined_set_def all_int_set_def is_int_def) - by (metis foundation18') - - have invert_int : "\<And>x S. all_int_set (insert x S) \<Longrightarrow> - is_int x" - by(simp add: all_int_set_def) - - have inject : "inj (\<lambda>a \<tau>. a)" - by(rule inj_fun, simp) - - have image_cong: "\<And>x Fa f. inj f \<Longrightarrow> x \<notin> Fa \<Longrightarrow> f x \<notin> f ` Fa" - apply(simp add: image_def) - apply(rule ballI) - apply(case_tac "x = xa", simp) - apply(simp add: inj_on_def) - apply(blast) - done - show "Finite_Set.fold (\<lambda>j r2. r2->including\<^sub>S\<^sub>e\<^sub>t(j)) S ((\<lambda>a \<tau>. a) ` \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil>) \<tau> = S \<tau>" - apply(subst finite_induct[where P = "\<lambda>set. all_defined_set \<tau> set \<and> \<lfloor>\<lfloor>set\<rfloor>\<rfloor> \<in> {X. X = bot \<or> X = null \<or> (\<forall>x\<in>\<lceil>\<lceil>X\<rceil>\<rceil>. x \<noteq> bot)} \<longrightarrow> - (\<forall>(s :: ('\<AA>, _) Set). (\<forall>\<tau>. all_defined \<tau> s) \<longrightarrow> - (\<forall>\<tau>. all_defined \<tau> (Finite_Set.fold (\<lambda>j r2. (r2->including\<^sub>S\<^sub>e\<^sub>t(j))) s ((\<lambda>a \<tau>. a) ` set)))) \<and> - (\<forall>s. (\<forall>\<tau>. all_defined \<tau> s) \<and> (set \<subseteq> \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (s \<tau>)\<rceil>\<rceil>) \<longrightarrow> - (Finite_Set.fold (\<lambda>j r2. (r2->including\<^sub>S\<^sub>e\<^sub>t(j))) s ((\<lambda>a \<tau>. a) ` set)) \<tau> = s \<tau>)" - and F = "\<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil>"]) - apply(simp add: S_all_def[simplified all_defined_def all_defined_set'_def]) - apply(simp) - defer - apply(insert S_all_def[simplified all_defined_def, THEN conjunct1, of \<tau>], frule Set_inv_lemma) - apply(simp add: foundation18 all_defined_set_def invalid_def S_all_def[simplified all_defined_def all_defined_set'_def]) - apply (metis assms order_refl) - apply(simp) - - (* *) - apply(rule impI) apply(erule conjE)+ - apply(drule invert_set_0, simp del: StrictRefEq\<^sub>S\<^sub>e\<^sub>t_exec) - apply(frule invert_all_def_set, simp del: StrictRefEq\<^sub>S\<^sub>e\<^sub>t_exec) - apply(erule conjE)+ - - (* *) - apply(rule conjI) - apply(rule allI, rename_tac SSS, rule impI, rule allI, rule allI) - apply(rule iterate_subst_set_rec[simplified Let_def, THEN mp, THEN mp, THEN mp, THEN spec, OF _ including_commute], simp) - apply(simp) - apply(simp add: all_int_set_def all_defined_set_def is_int_def) apply (metis (mono_tags) foundation18') - apply(simp) - (* *) - apply(rule allI, rename_tac SS, rule impI) - apply(drule all_def_to_all_int_)+ - apply(subst EQ_comp_fun_commute.fold_insert[where f = "(\<lambda>j r2. (r2->including\<^sub>S\<^sub>e\<^sub>t(j)))", OF including_commute]) - apply(case_tac \<tau>', simp only:) - apply(simp)+ - apply(rule invert_int, simp) - - apply(rule image_cong) - apply(rule inject) - apply(simp) - - apply(simp) - apply(subst including_id') - apply(metis prod.exhaust) - apply(auto) - done -qed - -lemma iterate_including_id_generic : - assumes including_commute : "EQ_comp_fun_commute (\<lambda>j (r2 :: ('\<AA>, 'a option option) Set). r2->including\<^sub>S\<^sub>e\<^sub>t(j))" - assumes S_all_def : "\<And>\<tau>. all_defined \<tau> (S :: ('\<AA>, 'a option option) Set)" - shows "(S ->iterate\<^sub>S\<^sub>e\<^sub>t(j;r2=S | r2->including\<^sub>S\<^sub>e\<^sub>t(j))) = S" - apply(simp add: UML_Set.OclIterate_def OclValid_def del: StrictRefEq\<^sub>S\<^sub>e\<^sub>t_exec, rule ext) - apply(subgoal_tac "(\<delta> S) \<tau> = true \<tau> \<and> (\<upsilon> S) \<tau> = true \<tau> \<and> finite \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil>", simp del: StrictRefEq\<^sub>S\<^sub>e\<^sub>t_exec) - prefer 2 - proof - - fix \<tau> - show "(\<delta> S) \<tau> = true \<tau> \<and> (\<upsilon> S) \<tau> = true \<tau> \<and> finite \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil>" - apply(simp add: S_all_def[of \<tau>, simplified all_defined_def OclValid_def all_defined_set'_def] - foundation20[simplified OclValid_def]) - done - apply_end(subst i_including_id'_generic[OF including_commute], simp_all add: S_all_def) -qed - -lemma i_including_id00_generic : - assumes including_commute : "EQ_comp_fun_commute (\<lambda>j (r2 :: ('\<AA>, 'a option option) Set). r2->including\<^sub>S\<^sub>e\<^sub>t(j))" - assumes S_all_int : "\<And>\<tau>. all_int_set ((\<lambda>a (\<tau>:: '\<AA> st). a) ` \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e ((S :: ('\<AA>, 'a option option) Set) \<tau>)\<rceil>\<rceil>)" - shows "\<And>\<tau>. \<forall>S'. (\<forall>\<tau>. all_defined \<tau> S') \<longrightarrow> (let img = image (\<lambda>a (\<tau>:: '\<AA> st). a) ; set' = img \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil> ; f = (\<lambda>x. x) in - (\<forall>\<tau>. f ` set' = img \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S' \<tau>)\<rceil>\<rceil>) \<longrightarrow> - (Finite_Set.fold (\<lambda>j r2. r2->including\<^sub>S\<^sub>e\<^sub>t(f j)) Set{} set') = S')" -proof - - have S_incl : "\<forall>(x :: ('\<AA>, 'a option option) Set). (\<forall>\<tau>. all_defined \<tau> x) \<longrightarrow> (\<forall>\<tau>. \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (x \<tau>)\<rceil>\<rceil> = {}) \<longrightarrow> Set{} = x" - apply(rule allI) apply(rule impI)+ - apply(rule ext, rename_tac \<tau>) - apply(drule_tac x = \<tau> in allE) prefer 2 apply assumption - apply(drule_tac x = \<tau> in allE) prefer 2 apply assumption - apply(simp add: mtSet_def) - by (metis (hide_lams, no_types) abs_rep_simp' all_defined_def) - - have invert_set_0 : "\<And>x F. \<lfloor>\<lfloor>insert x F\<rfloor>\<rfloor> \<in> {X. X = bot \<or> X = null \<or> (\<forall>x\<in>\<lceil>\<lceil>X\<rceil>\<rceil>. x \<noteq> bot)} \<Longrightarrow> \<lfloor>\<lfloor>F\<rfloor>\<rfloor> \<in> {X. X = bot \<or> X = null \<or> (\<forall>x\<in>\<lceil>\<lceil>X\<rceil>\<rceil>. x \<noteq> bot)}" - by(auto simp: bot_option_def null_option_def) - - have invert_all_def_set : "\<And>x F \<tau>. all_defined_set \<tau> (insert x F) \<Longrightarrow> all_defined_set \<tau> F" - apply(simp add: all_defined_set_def) - done - - have all_def_to_all_int_ : "\<And>set \<tau>. all_defined_set \<tau> set \<Longrightarrow> all_int_set ((\<lambda>a \<tau>. a) ` set)" - apply(simp add: all_defined_set_def all_int_set_def is_int_def) - by (metis foundation18') - - have invert_int : "\<And>x S. all_int_set (insert x S) \<Longrightarrow> - is_int x" - by(simp add: all_int_set_def) - - have inject : "inj (\<lambda>a \<tau>. a)" - by(rule inj_fun, simp) - - have image_cong: "\<And>x Fa f. inj f \<Longrightarrow> x \<notin> Fa \<Longrightarrow> f x \<notin> f ` Fa" - apply(simp add: image_def) - apply(rule ballI) - apply(case_tac "x = xa", simp) - apply(simp add: inj_on_def) - apply(blast) - done - - have rec : "\<And>x (F :: ('\<AA>,'a option option) val set). all_int_set F \<Longrightarrow> - is_int x \<Longrightarrow> - x \<notin> F \<Longrightarrow> - \<forall>x. (\<forall>\<tau>. all_defined \<tau> x) \<longrightarrow> - (let img = (`) (\<lambda>a \<tau>. a); set' = F; f = \<lambda>x. x - in (\<forall>\<tau>. f ` set' = img \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (x \<tau>)\<rceil>\<rceil>) \<longrightarrow> Finite_Set.fold (\<lambda>j r2. r2->including\<^sub>S\<^sub>e\<^sub>t(f j)) Set{} set' = x) \<Longrightarrow> - \<forall>xa. (\<forall>\<tau>. all_defined \<tau> xa) \<longrightarrow> - (let img = (`) (\<lambda>a \<tau>. a); set' = insert x F; f = \<lambda>x. x - in (\<forall>\<tau>. f ` set' = img \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (xa \<tau>)\<rceil>\<rceil>) \<longrightarrow> Finite_Set.fold (\<lambda>j r2. r2->including\<^sub>S\<^sub>e\<^sub>t(f j)) Set{} set' = xa)" - apply(simp only: Let_def image_ident) - - proof - fix \<tau> fix x fix F :: "('\<AA>,'a option option) val set" - show "all_int_set F \<Longrightarrow> - is_int x \<Longrightarrow> - x \<notin> F \<Longrightarrow> - \<forall>x. (\<forall>\<tau>. all_defined \<tau> x) \<longrightarrow> (\<forall>\<tau>. F = (\<lambda>a \<tau>. a) ` \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (x \<tau>)\<rceil>\<rceil>) \<longrightarrow> Finite_Set.fold (\<lambda>j r2. r2->including\<^sub>S\<^sub>e\<^sub>t(j)) Set{} F = x \<Longrightarrow> - \<forall>xa. (\<forall>\<tau>. all_defined \<tau> xa) \<longrightarrow> (\<forall>\<tau>. insert x F = (\<lambda>a \<tau>. a) ` \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (xa \<tau>)\<rceil>\<rceil>) \<longrightarrow> Finite_Set.fold (\<lambda>j r2. r2->including\<^sub>S\<^sub>e\<^sub>t(j)) Set{} (insert x F) = xa" - apply(rule allI, rename_tac S) apply(rule impI)+ - apply(subst sym[of "insert x F"], blast) - apply(drule_tac x = "S->excluding\<^sub>S\<^sub>e\<^sub>t(x)" in allE) prefer 2 apply assumption - apply(subgoal_tac "\<And>\<tau>. (\<lambda>a \<tau>. a) ` \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S->excluding\<^sub>S\<^sub>e\<^sub>t(x) \<tau>)\<rceil>\<rceil> = ((\<lambda>a \<tau>. a) ` \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil>) - {x}", simp only:) - apply(subgoal_tac "(\<forall>\<tau>. all_defined \<tau> S->excluding\<^sub>S\<^sub>e\<^sub>t(x))") - prefer 2 - apply(rule allI) - apply(rule cons_all_def_e, metis) - apply(rule int_is_valid, simp) - apply(simp) - apply(subst EQ_comp_fun_commute.fold_insert[OF including_commute]) prefer 5 - apply(drule arg_cong[where f = "\<lambda>S. (S->including\<^sub>S\<^sub>e\<^sub>t(x))"], simp) - apply(rule Ocl_insert_Diff) - apply(metis surj_pair) - apply(subst sym[of "insert x F"], metis surj_pair) - apply(simp)+ - apply(subst mtSet_all_def) - apply(simp)+ - apply(subst excluding_unfold) - apply(metis surj_pair) - apply(rule int_is_valid, simp) - apply(subst image_set_diff, simp add: inject) - apply(simp) - apply(drule destruct_int) - apply(frule_tac P = "\<lambda>j. x = (\<lambda>_. j)" in ex1E) prefer 2 apply assumption - apply(blast) - done - qed - - fix \<tau> - show "\<forall>S'. (\<forall>\<tau>. all_defined \<tau> S') \<longrightarrow> (let img = image (\<lambda>a (\<tau>:: '\<AA> st). a); set' = img \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil> ; f = (\<lambda>x. x) in - (\<forall>\<tau>. f ` set' = img \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S' \<tau>)\<rceil>\<rceil>) \<longrightarrow> - (Finite_Set.fold (\<lambda>j r2. r2->including\<^sub>S\<^sub>e\<^sub>t(f j)) Set{} set') = S')" - apply(rule allI) - proof - fix S' :: "('\<AA>, _) Set" show "(\<forall>\<tau>. all_defined \<tau> S') \<longrightarrow> (let img = (`) (\<lambda>a \<tau>. a); set' = img \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil>; f = \<lambda>x. x - in (\<forall>\<tau>. f ` set' = img \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S' \<tau>)\<rceil>\<rceil>) \<longrightarrow> Finite_Set.fold (\<lambda>j r2. r2->including\<^sub>S\<^sub>e\<^sub>t(f j)) Set{} set' = S')" - apply(simp add: Let_def, rule impI) - apply(subgoal_tac "(let img = (`) (\<lambda>a \<tau>. a); set' = (\<lambda>a \<tau>. a) ` \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil>; f = \<lambda>x. x - in (\<forall>\<tau>. f ` set' = img \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S' \<tau>)\<rceil>\<rceil>) \<longrightarrow> Finite_Set.fold (\<lambda>j r2. r2->including\<^sub>S\<^sub>e\<^sub>t(f j)) Set{} set' = S')") prefer 2 - - apply(subst EQ_comp_fun_commute.all_int_induct[where P = "\<lambda>set. - \<forall>S'. (\<forall>\<tau>. all_defined \<tau> S') \<longrightarrow> (let img = image (\<lambda>a (\<tau>:: '\<AA> st). a) - ; set' = set ; f = (\<lambda>x. x) in - (\<forall>\<tau>. f ` set' = img \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S' \<tau>)\<rceil>\<rceil>) \<longrightarrow> - (Finite_Set.fold (\<lambda>j r2. r2->including\<^sub>S\<^sub>e\<^sub>t(f j)) Set{} set') = S')" - and F = "(\<lambda>a (\<tau>:: '\<AA> st). a) ` \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil>", OF including_commute, THEN spec, of S']) - apply(simp add: S_all_int) - apply(simp add: S_incl) - apply(rule rec) - apply(simp) apply(simp) apply(simp) apply(simp) apply(simp) - apply(blast) - - apply(simp add: Let_def) - - done - qed -qed - -lemma iterate_including_id00_generic : - assumes including_commute : "EQ_comp_fun_commute (\<lambda>j (r2 :: ('\<AA>, 'a option option) Set). r2->including\<^sub>S\<^sub>e\<^sub>t(j))" - assumes S_all_def : "\<And>\<tau>. all_defined \<tau> (S :: ('\<AA>, 'a option option) Set)" - and S_incl : "\<And>\<tau> \<tau>'. S \<tau> = S \<tau>'" - shows "(S->iterate\<^sub>S\<^sub>e\<^sub>t(j;r2=Set{} | r2->including\<^sub>S\<^sub>e\<^sub>t(j))) = S" - apply(simp add: UML_Set.OclIterate_def OclValid_def del: StrictRefEq\<^sub>S\<^sub>e\<^sub>t_exec, rule ext) - apply(subgoal_tac "(\<delta> S) \<tau> = true \<tau> \<and> (\<upsilon> S) \<tau> = true \<tau> \<and> finite \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil>", simp del: StrictRefEq\<^sub>S\<^sub>e\<^sub>t_exec) - prefer 2 - proof - - have S_all_int : "\<And>\<tau>. all_int_set ((\<lambda>a \<tau>. a) ` \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil>)" - by(rule all_def_to_all_int, simp add: assms) - - fix \<tau> - show "(\<delta> S) \<tau> = true \<tau> \<and> (\<upsilon> S) \<tau> = true \<tau> \<and> finite \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil>" - apply(simp add: S_all_def[of \<tau>, simplified all_defined_def OclValid_def all_defined_set'_def] - foundation20[simplified OclValid_def]) - done - fix \<tau> show "(\<delta> S) \<tau> = true \<tau> \<and> (\<upsilon> S) \<tau> = true \<tau> \<and> finite \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil> \<Longrightarrow> Finite_Set.fold (\<lambda>j r2. r2->including\<^sub>S\<^sub>e\<^sub>t(j)) Set{} ((\<lambda>a \<tau>. a) ` \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil>) \<tau> = S \<tau>" - apply(subst i_including_id00_generic[OF including_commute, simplified Let_def image_ident, where S = S and \<tau> = \<tau>]) - prefer 4 - apply(rule refl) - apply(simp add: S_all_int S_all_def)+ - by (metis S_incl) -qed - -subsection{* all defined (construction) *} - -lemma preserved_defined_generic : - assumes including_commute : "EQ_comp_fun_commute (\<lambda>j (r2 :: ('\<AA>, 'a option option) Set). r2->including\<^sub>S\<^sub>e\<^sub>t(j))" - assumes S_all_def : "\<And>\<tau>. all_defined \<tau> (S :: ('\<AA>, 'a option option) Set)" - and A_all_def : "\<And>\<tau>. all_defined \<tau> (A :: ('\<AA>, 'a option option) Set)" - shows "let S' = (\<lambda>a \<tau>. a) ` \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil> in - \<forall>\<tau>. all_defined \<tau> (Finite_Set.fold (\<lambda>x acc. (acc->including\<^sub>S\<^sub>e\<^sub>t(x))) A S')" -proof - - have invert_all_int_set : "\<And>x S. all_int_set (insert x S) \<Longrightarrow> - all_int_set S" - by(simp add: all_int_set_def) - show ?thesis - apply(subst Let_def) - apply(rule finite_induct[where P = "\<lambda>set. - let set' = (\<lambda>a \<tau>. a) ` set in - all_int_set set' \<longrightarrow> - (\<forall>\<tau>'. all_defined \<tau>' (Finite_Set.fold (\<lambda>x acc. (acc->including\<^sub>S\<^sub>e\<^sub>t(x))) A set'))" - and F = "\<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil>", simplified Let_def, THEN mp]) - apply(simp add: S_all_def[where \<tau> = \<tau>, simplified all_defined_def all_defined_set'_def]) - apply(simp add: A_all_def) - apply(rule impI, simp only: image_insert, rule iterate_subst_set_rec[simplified Let_def, THEN mp, THEN mp, THEN mp]) - apply(simp add: A_all_def) - apply(simp add: including_commute) - apply(simp) - apply(simp) - apply(drule invert_all_int_set, simp) - - apply(rule all_def_to_all_int[OF S_all_def]) - done -qed - -subsection{* Preservation of comp fun commute (main) *} - -lemma iterate_including_commute : - assumes f_comm : "EQ_comp_fun_commute0 (\<lambda>x. F (\<lambda>_. x))" - and f_empty : "\<And>x y. - is_int (\<lambda>(_:: '\<AA> st). x) \<Longrightarrow> - is_int (\<lambda>(_:: '\<AA> st). y) \<Longrightarrow> - UML_Set.OclIterate Set{\<lambda>(_:: '\<AA> st). x} Set{\<lambda>(_:: '\<AA> st). x} F->including\<^sub>S\<^sub>e\<^sub>t(\<lambda>(_:: '\<AA> st). y) = - UML_Set.OclIterate Set{\<lambda>(_:: '\<AA> st). y} Set{\<lambda>(_:: '\<AA> st). y} F->including\<^sub>S\<^sub>e\<^sub>t(\<lambda>(_:: '\<AA> st). x)" - and com : "\<And>S x y \<tau>. - is_int (\<lambda>(_:: '\<AA> st). x) \<Longrightarrow> - is_int (\<lambda>(_:: '\<AA> st). y) \<Longrightarrow> - \<forall>(\<tau> :: '\<AA> st). all_defined \<tau> S \<Longrightarrow> - \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil> \<noteq> {} \<Longrightarrow> - (UML_Set.OclIterate ((UML_Set.OclIterate S S F)->including\<^sub>S\<^sub>e\<^sub>t(\<lambda>(_:: '\<AA> st). x)) ((UML_Set.OclIterate S S F)->including\<^sub>S\<^sub>e\<^sub>t(\<lambda>(_:: '\<AA> st). x)) F)->including\<^sub>S\<^sub>e\<^sub>t(\<lambda>(_:: '\<AA> st). y) \<tau> = - (UML_Set.OclIterate ((UML_Set.OclIterate S S F)->including\<^sub>S\<^sub>e\<^sub>t(\<lambda>(_:: '\<AA> st). y)) ((UML_Set.OclIterate S S F)->including\<^sub>S\<^sub>e\<^sub>t(\<lambda>(_:: '\<AA> st). y)) F)->including\<^sub>S\<^sub>e\<^sub>t(\<lambda>(_:: '\<AA> st). x) \<tau> " - shows "EQ_comp_fun_commute0 (\<lambda>x r1. r1 ->iterate\<^sub>S\<^sub>e\<^sub>t(j;r2=r1 | F j r2)->including\<^sub>S\<^sub>e\<^sub>t(\<lambda>(_:: '\<AA> st). x))" -proof - - have all_defined1 : "\<And>r2 \<tau>. all_defined \<tau> r2 \<Longrightarrow> \<tau> \<Turnstile> \<delta> r2" by(simp add: all_defined_def) - - - show ?thesis - apply(simp only: EQ_comp_fun_commute0_def) - apply(rule conjI)+ apply(rule allI)+ apply(rule impI)+ - apply(subst (1 2) UML_Set.OclIncluding.cp0, subst cp_OclIterate1[OF f_comm[THEN c0'_of_c0]], blast, simp) - apply(rule allI)+ apply(rule impI)+ - apply(rule including_cp_all, simp, rule all_defined1, rule i_cons_all_def, simp add: f_comm, blast) - apply(rule iterate_cp_all, simp add: f_comm, simp, simp) - apply(rule conjI)+ apply(rule allI)+ apply(rule impI)+ - apply(rule including_notempty, rule all_defined1, rule i_cons_all_def, simp add: f_comm, blast, simp add: int_is_valid) - apply(rule iterate_notempty, simp add: f_comm, simp, simp) - apply(rule conjI)+ apply(rule allI)+ - apply(rule iffI) - apply(drule invert_all_defined', erule conjE, rule conjI, simp) - apply(rule i_invert_all_defined'[where F = F], simp) - apply(rule allI, rule cons_all_def, rule i_cons_all_def[OF f_comm], blast, simp add: int_is_valid) - apply(rule allI)+ apply(rule impI)+ - - apply(rule ext, rename_tac \<tau>) - apply(case_tac "\<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil> = {}") - apply(subgoal_tac "S \<tau> = Set{} \<tau>") - prefer 2 - apply(drule_tac f = "\<lambda>s. Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e \<lfloor>\<lfloor>s\<rfloor>\<rfloor>" in arg_cong) - apply(subgoal_tac "S \<tau> = Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e \<lfloor>\<lfloor>{}\<rfloor>\<rfloor>") - prefer 2 - apply(metis (hide_lams, no_types) abs_rep_simp' all_defined_def) - apply(simp add: mtSet_def) - - apply(subst (1 2) UML_Set.OclIncluding.cp0) - apply(subst (1 2) cp_OclIterate1[OF f_comm[THEN c0'_of_c0]]) - apply(rule cons_all_def') apply(rule i_cons_all_def'[where F = F, OF f_comm[THEN c0'_of_c0]], blast)+ apply(simp add: int_is_valid) - apply(rule cons_all_def') apply(rule i_cons_all_def'[where F = F, OF f_comm[THEN c0'_of_c0]], blast)+ apply(simp add: int_is_valid) - apply(subst (1 2 3 4 5 6) UML_Set.OclIncluding.cp0) - apply(subst (1 2 4 5) cp_OclIterate1[OF f_comm[THEN c0'_of_c0]], blast) - apply(simp) - apply(subst (1 2 4 5) cp_OclIterate1[OF f_comm[THEN c0'_of_c0], symmetric], simp add: mtSet_all_def) - apply(simp) - apply(subst (1 2 4 5) UML_Set.OclIncluding.cp0[symmetric]) - apply(subst (1 2 3 4) cp_singleton) - apply(subst (1 2) UML_Set.OclIncluding.cp0[symmetric]) - apply(subst f_empty, simp_all) - - apply(rule com, simp_all) - done -qed - -lemma iterate_including_commute_var_generic : - assumes f_comm : "EQ_comp_fun_commute0 (\<lambda>x. (F :: ('\<AA>, 'a option option) val - \<Rightarrow> ('\<AA>, _) Set - \<Rightarrow> ('\<AA>, _) Set) (\<lambda>_. x))" - and f_empty : "\<And>x y. - is_int (\<lambda>(_:: '\<AA> st). x) \<Longrightarrow> - is_int (\<lambda>(_:: '\<AA> st). y) \<Longrightarrow> - UML_Set.OclIterate Set{\<lambda>(_:: '\<AA> st). x, a} Set{\<lambda>(_:: '\<AA> st). x, a} F->including\<^sub>S\<^sub>e\<^sub>t(\<lambda>(_:: '\<AA> st). y) = - UML_Set.OclIterate Set{\<lambda>(_:: '\<AA> st). y, a} Set{\<lambda>(_:: '\<AA> st). y, a} F->including\<^sub>S\<^sub>e\<^sub>t(\<lambda>(_:: '\<AA> st). x)" - and com : "\<And>S x y \<tau>. - is_int (\<lambda>(_:: '\<AA> st). x) \<Longrightarrow> - is_int (\<lambda>(_:: '\<AA> st). y) \<Longrightarrow> - \<forall>(\<tau> :: '\<AA> st). all_defined \<tau> S \<Longrightarrow> - \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil> \<noteq> {} \<Longrightarrow> - (UML_Set.OclIterate (((UML_Set.OclIterate S S F)->including\<^sub>S\<^sub>e\<^sub>t(a))->including\<^sub>S\<^sub>e\<^sub>t(\<lambda>(_:: '\<AA> st). x)) (((UML_Set.OclIterate S S F)->including\<^sub>S\<^sub>e\<^sub>t(a))->including\<^sub>S\<^sub>e\<^sub>t(\<lambda>(_:: '\<AA> st). x)) F)->including\<^sub>S\<^sub>e\<^sub>t(\<lambda>(_:: '\<AA> st). y) \<tau> = - (UML_Set.OclIterate (((UML_Set.OclIterate S S F)->including\<^sub>S\<^sub>e\<^sub>t(a))->including\<^sub>S\<^sub>e\<^sub>t(\<lambda>(_:: '\<AA> st). y)) (((UML_Set.OclIterate S S F)->including\<^sub>S\<^sub>e\<^sub>t(a))->including\<^sub>S\<^sub>e\<^sub>t(\<lambda>(_:: '\<AA> st). y)) F)->including\<^sub>S\<^sub>e\<^sub>t(\<lambda>(_:: '\<AA> st). x) \<tau> " - and a_int : "is_int a" - shows "EQ_comp_fun_commute0 (\<lambda>x r1. (((r1 ->iterate\<^sub>S\<^sub>e\<^sub>t(j;r2=r1 | F j r2))->including\<^sub>S\<^sub>e\<^sub>t(a))->including\<^sub>S\<^sub>e\<^sub>t(\<lambda>(_:: '\<AA> st). x)))" -proof - - have all_defined1 : "\<And>r2 \<tau>. all_defined \<tau> r2 \<Longrightarrow> \<tau> \<Turnstile> \<delta> r2" by(simp add: all_defined_def) - show ?thesis - apply(simp only: EQ_comp_fun_commute0_def) - apply(rule conjI)+ apply(rule allI)+ apply(rule impI)+ - apply(subst (1 2) UML_Set.OclIncluding.cp0, subst (1 2 3 4) UML_Set.OclIncluding.cp0, subst cp_OclIterate1[OF f_comm[THEN c0'_of_c0]], blast, simp) - apply(rule allI)+ apply(rule impI)+ - apply(rule including_cp_all, simp, rule all_defined1, rule cons_all_def, rule i_cons_all_def, simp add: f_comm, blast, simp add: a_int int_is_valid) - apply(rule including_cp_all, simp add: a_int, rule all_defined1, rule i_cons_all_def, simp add: f_comm, blast, simp add: a_int int_is_valid) - apply(rule iterate_cp_all, simp add: f_comm, simp, simp) - apply(rule conjI)+ apply(rule allI)+ apply(rule impI)+ - apply(rule including_notempty, rule all_defined1, rule cons_all_def, rule i_cons_all_def, simp add: f_comm, blast, simp add: a_int int_is_valid, simp add: int_is_valid) - apply(rule including_notempty, rule all_defined1, rule i_cons_all_def, simp add: f_comm, blast, simp add: a_int int_is_valid) - apply(rule iterate_notempty, simp add: f_comm, simp, simp) - apply(rule conjI)+ apply(rule allI)+ - apply(rule iffI) - apply(drule invert_all_defined', erule conjE, rule conjI, simp) - apply(rule destruct_int[OF a_int, THEN ex1_implies_ex, THEN exE], rename_tac a', simp only:) - apply(drule invert_all_defined', erule conjE) - apply(rule i_invert_all_defined'[where F = F], simp) - apply(rule allI, rule cons_all_def, rule cons_all_def, rule i_cons_all_def[OF f_comm], blast) apply(simp add: int_is_valid a_int)+ - apply((rule allI)+, (rule impI)+)+ - - apply(rule ext, rename_tac \<tau>) - apply(case_tac "\<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil> = {}") - apply(subgoal_tac "S \<tau> = Set{} \<tau>") - prefer 2 - apply(drule_tac f = "\<lambda>s. Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e \<lfloor>\<lfloor>s\<rfloor>\<rfloor>" in arg_cong) - apply(subgoal_tac "S \<tau> = Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e \<lfloor>\<lfloor>{}\<rfloor>\<rfloor>") - prefer 2 - apply (metis (hide_lams, no_types) abs_rep_simp' all_defined_def prod.exhaust) - apply(simp add: mtSet_def) - - - apply(subst (1 2) UML_Set.OclIncluding.cp0) - apply(subst (1 2 3 4) UML_Set.OclIncluding.cp0) - apply(subst (1 2) cp_OclIterate1[OF f_comm[THEN c0'_of_c0]]) - apply(rule cons_all_def')+ apply(rule i_cons_all_def'[where F = F, OF f_comm[THEN c0'_of_c0]], metis surj_pair) apply(simp add: a_int int_is_valid)+ - apply(rule cons_all_def')+ apply(rule i_cons_all_def'[where F = F, OF f_comm[THEN c0'_of_c0]], metis surj_pair) apply(simp add: a_int int_is_valid)+ - apply(subst (1 2 3 4 5 6 7 8) UML_Set.OclIncluding.cp0) - apply(subst (1 2 3 4 5 6 7 8 9 10 11 12) UML_Set.OclIncluding.cp0) - - apply(subst (1 2 4 5) cp_OclIterate1[OF f_comm[THEN c0'_of_c0]], metis surj_pair) - apply(simp) - apply(subst (1 2 4 5) cp_OclIterate1[OF f_comm[THEN c0'_of_c0], symmetric], simp add: mtSet_all_def) - apply(simp) - apply(subst (1 2 3 4 7 8 9 10) UML_Set.OclIncluding.cp0[symmetric]) - apply(subst (1 2 3 4) cp_doubleton, simp add: int_is_const[OF a_int]) - apply(subst (1 2 3 4) UML_Set.OclIncluding.cp0[symmetric]) - - apply(subst (3 6) OclIncluding_commute) - apply(rule including_subst_set'') - apply(rule all_defined1, rule cons_all_def, rule i_cons_all_def, simp add: f_comm) apply(rule cons_all_def)+ apply(rule mtSet_all_def) apply(simp add: int_is_valid a_int) apply(simp add: int_is_valid a_int) apply(simp add: int_is_valid a_int) - apply(rule all_defined1, rule cons_all_def, rule i_cons_all_def, simp add: f_comm) apply(rule cons_all_def)+ apply(rule mtSet_all_def) apply(simp add: int_is_valid a_int)+ - - apply(subst f_empty, simp_all) - - apply(subst (3 6) OclIncluding_commute) - apply(rule including_subst_set'') - apply(rule all_defined1, rule cons_all_def, rule i_cons_all_def, simp add: f_comm) apply(rule cons_all_def)+ apply(rule i_cons_all_def, simp add: f_comm, metis surj_pair) apply(simp add: int_is_valid a_int) apply(simp add: int_is_valid a_int) apply(simp add: int_is_valid a_int) - apply(rule all_defined1, rule cons_all_def, rule i_cons_all_def, simp add: f_comm) apply(rule cons_all_def)+ apply(rule i_cons_all_def, simp add: f_comm, metis surj_pair) apply(simp add: int_is_valid a_int)+ - - apply(rule com, simp_all) - done -qed - -subsection{* Execution (OclIterate, OclIncluding to OclExcluding) *} - -lemma EQ_OclIterate_including: - assumes S_all_int: "\<And>(\<tau>::'\<AA> st). all_int_set ((\<lambda> a (\<tau>:: '\<AA> st). a) ` \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil>)" - assumes S_all_def: "\<And>\<tau>. all_defined \<tau> S" - and A_all_def: "\<And>\<tau>. all_defined \<tau> A" - and F_commute: "EQ_comp_fun_commute F" - and a_int : "is_int a" - shows "((S->including\<^sub>S\<^sub>e\<^sub>t(a))->iterate\<^sub>S\<^sub>e\<^sub>t(a; x = A | F a x)) = - ((S->excluding\<^sub>S\<^sub>e\<^sub>t(a))->iterate\<^sub>S\<^sub>e\<^sub>t(a; x = F a A | F a x))" -proof - - - have all_defined1 : "\<And>r2 \<tau>. all_defined \<tau> r2 \<Longrightarrow> \<tau> \<Turnstile> \<delta> r2" by(simp add: all_defined_def) - - have F_cp : "\<And> x y \<tau>. F x y \<tau> = F (\<lambda> _. x \<tau>) y \<tau>" - proof - interpret EQ_comp_fun_commute F by (rule F_commute) fix x y \<tau> show "F x y \<tau> = F (\<lambda> _. x \<tau>) y \<tau>" - by(rule F_cp) - qed - - have F_val : "\<And>\<tau>. \<tau> \<Turnstile> \<upsilon> (F a A)" - proof - interpret EQ_comp_fun_commute F by (rule F_commute) fix \<tau> show "\<tau> \<Turnstile> \<upsilon> (F a A)" - apply(insert - all_def - int_is_valid[OF a_int] - A_all_def, simp add: all_defined1 foundation20) - done - qed - - have insert_in_Set_0 : "\<And>\<tau>. (\<tau> \<Turnstile>(\<delta> S)) \<Longrightarrow> (\<tau> \<Turnstile>(\<upsilon> a)) \<Longrightarrow> \<lfloor>\<lfloor>insert (a \<tau>) \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil>\<rfloor>\<rfloor> \<in> {X. X = bot \<or> X = null \<or> (\<forall>x\<in>\<lceil>\<lceil>X\<rceil>\<rceil>. x \<noteq> bot)}" - apply(frule Set_inv_lemma) - apply(simp add: foundation18 invalid_def) - done - have insert_in_Set_0 : "\<And>\<tau>. ?this \<tau>" - apply(rule insert_in_Set_0) - by(simp add: S_all_def[simplified all_defined_def] int_is_valid[OF a_int])+ - - have insert_defined : "\<And>\<tau>. (\<tau> \<Turnstile>(\<delta> S)) \<Longrightarrow> (\<tau> \<Turnstile>(\<upsilon> a)) \<Longrightarrow> - (\<delta> (\<lambda>_. Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e \<lfloor>\<lfloor>insert (a \<tau>) \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil>\<rfloor>\<rfloor>)) \<tau> = true \<tau>" - apply(subst defined_def) - apply(simp add: bot_fun_def bot_option_def bot_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def null_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def null_option_def null_fun_def false_def true_def) - apply(subst Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inject) - apply(rule insert_in_Set_0, simp_all add: bot_option_def) - - apply(subst Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inject) - apply(rule insert_in_Set_0, simp_all add: null_option_def bot_option_def) - done - have insert_defined : "\<And>\<tau>. ?this \<tau>" - apply(rule insert_defined) - by(simp add: S_all_def[simplified all_defined_def] int_is_valid[OF a_int])+ - - have remove_finite : "\<And>\<tau>. finite \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil> \<Longrightarrow> finite ((\<lambda>a (\<tau>:: '\<AA> st). a) ` (\<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil> - {a \<tau>}))" - by(simp) - - have inject : "inj (\<lambda>a \<tau>. a)" - by(rule inj_fun, simp) - - have remove_all_int : "\<And>\<tau>. all_int_set ((\<lambda>a (\<tau>:: '\<AA> st). a) ` (\<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil> - {a \<tau>}))" - proof - fix \<tau> show "?thesis \<tau>" - apply(insert S_all_int[of \<tau>], simp add: all_int_set_def, rule remove_finite) - apply(erule conjE, drule finite_imageD) - apply (metis inj_onI, simp) - done - qed - - have remove_in_Set_0 : "\<And>\<tau>. (\<tau> \<Turnstile>(\<delta> S)) \<Longrightarrow> (\<tau> \<Turnstile>(\<upsilon> a)) \<Longrightarrow> \<lfloor>\<lfloor>\<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil> - {a \<tau>}\<rfloor>\<rfloor> \<in> {X. X = bot \<or> X = null \<or> (\<forall>x\<in>\<lceil>\<lceil>X\<rceil>\<rceil>. x \<noteq> bot)}" - apply(frule Set_inv_lemma) - apply(simp add: foundation18 invalid_def) - done - have remove_in_Set_0 : "\<And>\<tau>. ?this \<tau>" - apply(rule remove_in_Set_0) - by(simp add: S_all_def[simplified all_defined_def] int_is_valid[OF a_int])+ - - have remove_defined : "\<And>\<tau>. (\<tau> \<Turnstile>(\<delta> S)) \<Longrightarrow> (\<tau> \<Turnstile>(\<upsilon> a)) \<Longrightarrow> - (\<delta> (\<lambda>_. Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e \<lfloor>\<lfloor>\<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil> - {a \<tau>}\<rfloor>\<rfloor>)) \<tau> = true \<tau>" - apply(subst defined_def) - apply(simp add: bot_fun_def bot_option_def bot_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def null_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def null_option_def null_fun_def false_def true_def) - apply(subst Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inject) - apply(rule remove_in_Set_0, simp_all add: bot_option_def) - - apply(subst Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inject) - apply(rule remove_in_Set_0, simp_all add: null_option_def bot_option_def) - done - have remove_defined : "\<And>\<tau>. ?this \<tau>" - apply(rule remove_defined) - by(simp add: S_all_def[simplified all_defined_def] int_is_valid[OF a_int])+ - - show ?thesis - apply(rule ext, rename_tac \<tau>) - proof - fix \<tau> show "UML_Set.OclIterate S->including\<^sub>S\<^sub>e\<^sub>t(a) A F \<tau> = UML_Set.OclIterate S->excluding\<^sub>S\<^sub>e\<^sub>t(a) (F a A) F \<tau>" - apply(simp only: UML_Set.cp_OclIterate[of "S->including\<^sub>S\<^sub>e\<^sub>t(a)"] UML_Set.cp_OclIterate[of "S->excluding\<^sub>S\<^sub>e\<^sub>t(a)"]) - apply(subst UML_Set.OclIncluding_def, subst UML_Set.OclExcluding_def) - - apply(simp add: S_all_def[simplified all_defined_def OclValid_def] int_is_valid[OF a_int, simplified OclValid_def]) - - apply(simp add: UML_Set.OclIterate_def) - apply(simp add: Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inverse[OF insert_in_Set_0] Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inverse[OF remove_in_Set_0] - foundation20[OF all_defined1[OF A_all_def], simplified OclValid_def] - S_all_def[simplified all_defined_def all_defined_set_def] - insert_defined - remove_defined - F_val[of \<tau>, simplified OclValid_def]) - - apply(subst EQ_comp_fun_commute.fold_fun_comm[where f = F and z = A and x = a and A = "((\<lambda>a \<tau>. a) ` (\<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil> - {a \<tau>}))", symmetric, OF F_commute A_all_def _ int_is_valid[OF a_int]]) - apply(simp add: remove_all_int) - - apply(subst image_set_diff[OF inject], simp) - apply(subgoal_tac "Finite_Set.fold F A (insert (\<lambda>\<tau>'. a \<tau>) ((\<lambda>a \<tau>. a) ` \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil>)) \<tau> = - F (\<lambda>\<tau>'. a \<tau>) (Finite_Set.fold F A ((\<lambda>a \<tau>. a) ` \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil> - {\<lambda>\<tau>'. a \<tau>})) \<tau>") - apply(subst F_cp) - apply(simp) - - apply(subst EQ_comp_fun_commute.fold_insert_remove[OF F_commute A_all_def S_all_int]) - apply (metis (mono_tags) a_int foundation18' is_int_def) - apply(simp) - done - qed -qed - -lemma (*EQ_OclIterate_including':*) - assumes S_all_int: "\<And>(\<tau>::'\<AA> st). all_int_set ((\<lambda> a (\<tau>:: '\<AA> st). a) ` \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil>)" - assumes S_all_def: "\<And>\<tau>. all_defined \<tau> S" - and A_all_def: "\<And>\<tau>. all_defined \<tau> A" - and F_commute: "EQ_comp_fun_commute F" - and a_int : "is_int a" - shows "((S->including\<^sub>S\<^sub>e\<^sub>t(a))->iterate\<^sub>S\<^sub>e\<^sub>t(a; x = A | F a x)) = - F a ((S->excluding\<^sub>S\<^sub>e\<^sub>t(a))->iterate\<^sub>S\<^sub>e\<^sub>t(a; x = A | F a x))" -proof - - have all_defined1 : "\<And>r2 \<tau>. all_defined \<tau> r2 \<Longrightarrow> \<tau> \<Turnstile> \<delta> r2" by(simp add: all_defined_def) - - have F_cp_set : "\<And> x S \<tau>. F x S \<tau> = F x (\<lambda> _. S \<tau>) \<tau>" - proof - interpret EQ_comp_fun_commute F by (rule F_commute) fix x S \<tau> show "F x S \<tau> = F x (\<lambda> _. S \<tau>) \<tau>" - by(rule F_cp_set) - qed - - have F_val : "\<And>\<tau>. \<tau> \<Turnstile> \<upsilon> (F a A)" - proof - interpret EQ_comp_fun_commute F by (rule F_commute) fix \<tau> show "\<tau> \<Turnstile> \<upsilon> (F a A)" - apply(insert - all_def - int_is_valid[OF a_int] - A_all_def, simp add: all_defined1 foundation20) - done - qed - - have remove_finite : "\<And>\<tau>. finite \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil> \<Longrightarrow> finite ((\<lambda>a (\<tau>:: '\<AA> st). a) ` (\<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil> - {a \<tau>}))" - by(simp) - - have remove_finite': "\<And>\<tau>. finite \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S->excluding\<^sub>S\<^sub>e\<^sub>t(a) \<tau>)\<rceil>\<rceil>" - apply(subst excluding_unfold) - by(simp add: S_all_def int_is_valid[OF a_int] S_all_def[simplified all_defined_def all_defined_set'_def])+ - - have remove_all_int : "\<And>\<tau>. all_int_set ((\<lambda>a (\<tau>:: '\<AA> st). a) ` (\<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil> - {a \<tau>}))" - proof - fix \<tau> show "?thesis \<tau>" - apply(insert S_all_int[of \<tau>], simp add: all_int_set_def, rule remove_finite) - apply(erule conjE, drule finite_imageD) - apply (metis inj_onI, simp) - done - qed - - have remove_all_int' : "\<And>\<tau>. all_int_set ((\<lambda>a (\<tau>:: '\<AA> st). a) ` (\<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S->excluding\<^sub>S\<^sub>e\<^sub>t(a) \<tau>)\<rceil>\<rceil>))" - apply(subst excluding_unfold) - by(simp add: S_all_def int_is_valid[OF a_int] remove_all_int)+ - - show ?thesis - apply(simp add: EQ_OclIterate_including[OF S_all_int S_all_def A_all_def F_commute a_int]) - apply(rule ext, rename_tac \<tau>) - proof - fix \<tau> show "UML_Set.OclIterate S->excluding\<^sub>S\<^sub>e\<^sub>t(a) (F a A) F \<tau> = F a (UML_Set.OclIterate S->excluding\<^sub>S\<^sub>e\<^sub>t(a) A F) \<tau>" - apply(simp add: UML_Set.OclIterate_def) - apply(simp add: foundation20[OF all_defined1[OF A_all_def], simplified OclValid_def] - S_all_def[simplified all_defined_def all_defined_set_def OclValid_def] - int_is_valid[OF a_int, simplified OclValid_def] - F_val[of \<tau>, simplified OclValid_def] - foundation10[simplified OclValid_def] - remove_finite') - - apply(subst EQ_comp_fun_commute.fold_fun_comm[where f = F and z = A and x = a and A = "((\<lambda>a \<tau>. a) ` (\<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S->excluding\<^sub>S\<^sub>e\<^sub>t(a) \<tau>)\<rceil>\<rceil>))", symmetric, OF F_commute A_all_def _ int_is_valid[OF a_int]]) - apply(simp add: remove_all_int') - apply(subst (1 2) F_cp_set, simp) - done - qed -qed - -subsection{* Execution OclIncluding out of OclIterate (theorem) *} - -lemma including_out1_generic : - assumes including_commute : "EQ_comp_fun_commute (\<lambda>j (r2 :: ('\<AA>, 'a option option) Set). r2->including\<^sub>S\<^sub>e\<^sub>t(j))" - assumes including_commute2 : "\<And>i. is_int i \<Longrightarrow> EQ_comp_fun_commute (\<lambda>x (acc :: ('\<AA>, 'a option option) Set). ((acc->including\<^sub>S\<^sub>e\<^sub>t(x))->including\<^sub>S\<^sub>e\<^sub>t(i)))" - assumes S_all_def : "\<And>\<tau>. all_defined \<tau> (S :: ('\<AA>, 'a option option) Set)" - and A_all_def : "\<And>\<tau>. all_defined \<tau> A" - and i_int : "is_int i" - shows "\<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil> \<noteq> {} \<Longrightarrow> - ((S :: ('\<AA>, _) Set)->iterate\<^sub>S\<^sub>e\<^sub>t(x;acc=A | acc->including\<^sub>S\<^sub>e\<^sub>t(x)->including\<^sub>S\<^sub>e\<^sub>t(i))) \<tau> = (S->iterate\<^sub>S\<^sub>e\<^sub>t(x;acc=A | acc->including\<^sub>S\<^sub>e\<^sub>t(x))->including\<^sub>S\<^sub>e\<^sub>t(i)) \<tau>" -proof - - - have i_valid : "\<forall>\<tau>. \<tau> \<Turnstile> \<upsilon> i" - by (metis i_int int_is_valid) - - have all_defined1 : "\<And>r2 \<tau>. all_defined \<tau> r2 \<Longrightarrow> \<tau> \<Turnstile> \<delta> r2" by(simp add: all_defined_def) - - have S_finite : "\<And>\<tau>. finite \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil>" - by(simp add: S_all_def[simplified all_defined_def all_defined_set'_def]) - - have all_def_to_all_int_ : "\<And>set \<tau>. all_defined_set \<tau> set \<Longrightarrow> all_int_set ((\<lambda>a \<tau>. a) ` set)" - apply(simp add: all_defined_set_def all_int_set_def is_int_def) - by (metis foundation18') - - have invert_all_def_set : "\<And>x F \<tau>. all_defined_set \<tau> (insert x F) \<Longrightarrow> all_defined_set \<tau> F" - apply(simp add: all_defined_set_def) - done - - have invert_int : "\<And>x S. all_int_set (insert x S) \<Longrightarrow> - is_int x" - by(simp add: all_int_set_def) - - have inject : "inj (\<lambda>a \<tau>. a)" - by(rule inj_fun, simp) - - - have image_cong: "\<And>x Fa f. inj f \<Longrightarrow> x \<notin> Fa \<Longrightarrow> f x \<notin> f ` Fa" - apply(simp add: image_def) - apply(rule ballI) - apply(case_tac "x = xa", simp) - apply(simp add: inj_on_def) - apply(blast) - done - - - have discr_eq_false_true : "\<And>\<tau>. (false \<tau> = true \<tau>) = False" by (metis OclValid_def foundation2) - - - have invert_all_defined_fold : "\<And> F x a b. let F' = (\<lambda>a \<tau>. a) ` F in x \<notin> F \<longrightarrow> all_int_set (insert (\<lambda>\<tau>. x) F') \<longrightarrow> all_defined (a, b) (Finite_Set.fold (\<lambda>x acc. acc->including\<^sub>S\<^sub>e\<^sub>t(x)) A (insert (\<lambda>\<tau>. x) F')) \<longrightarrow> - all_defined (a, b) (Finite_Set.fold (\<lambda>x acc. acc->including\<^sub>S\<^sub>e\<^sub>t(x)) A F')" - proof - fix F x a b show "?thesis F x a b" - apply(simp add: Let_def) apply(rule impI)+ - apply(insert arg_cong[where f = "\<lambda>x. all_defined (a, b) x", OF EQ_comp_fun_commute.fold_insert[OF including_commute, where x= "(\<lambda>\<tau>. x)" and A = "(\<lambda>a \<tau>. a) ` F" and z = A]] - allI[where P = "\<lambda>x. all_defined x A", OF A_all_def]) - apply(simp) - apply(subgoal_tac "all_int_set ((\<lambda>a \<tau>. a) ` F)") - prefer 2 - apply(simp add: all_int_set_def, auto) - apply(drule invert_int, simp) - apply(subgoal_tac "(\<lambda>(\<tau>:: '\<AA> st). x) \<notin> (\<lambda>a (\<tau>:: '\<AA> st). a) ` F") - prefer 2 - apply(rule image_cong) - apply(rule inject) - apply(simp) - - apply(simp) - apply(rule invert_all_defined[THEN conjunct2, of _ _ "\<lambda>\<tau>. x"], simp) - done - qed - - have i_out : "\<And>i' x F. i = (\<lambda>_. i') \<Longrightarrow> is_int (\<lambda>(\<tau>:: '\<AA> st). x) \<Longrightarrow> \<forall>a b. all_defined (a, b) (Finite_Set.fold (\<lambda>x acc. acc->including\<^sub>S\<^sub>e\<^sub>t(x)) A ((\<lambda>a \<tau>. a) ` F)) \<Longrightarrow> - (((Finite_Set.fold (\<lambda>x acc. (acc->including\<^sub>S\<^sub>e\<^sub>t(x))) A - ((\<lambda>a \<tau>. a) ` F))->including\<^sub>S\<^sub>e\<^sub>t(\<lambda>\<tau>. x))->including\<^sub>S\<^sub>e\<^sub>t(i))->including\<^sub>S\<^sub>e\<^sub>t(i) = - (((Finite_Set.fold (\<lambda>j r2. (r2->including\<^sub>S\<^sub>e\<^sub>t(j))) A ((\<lambda>a \<tau>. a) ` F))->including\<^sub>S\<^sub>e\<^sub>t(\<lambda>\<tau>. x))->including\<^sub>S\<^sub>e\<^sub>t(i))" - proof - fix i' x F show "i = (\<lambda>_. i') \<Longrightarrow> is_int (\<lambda>(\<tau>:: '\<AA> st). x) \<Longrightarrow> \<forall>a b. all_defined (a, b) (Finite_Set.fold (\<lambda>x acc. acc->including\<^sub>S\<^sub>e\<^sub>t(x)) A ((\<lambda>a \<tau>. a) ` F)) \<Longrightarrow> ?thesis i' x F" - by(simp only: OclIncluding_idem) - qed - - have i_out1 : "\<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil> \<noteq> {} \<Longrightarrow> - Finite_Set.fold (\<lambda>x acc. (acc->including\<^sub>S\<^sub>e\<^sub>t(x))->including\<^sub>S\<^sub>e\<^sub>t(i)) A ((\<lambda>a \<tau>. a) ` \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil>) = - (Finite_Set.fold (\<lambda>x acc. acc->including\<^sub>S\<^sub>e\<^sub>t(x)) A ((\<lambda>a \<tau>. a) ` \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil>))->including\<^sub>S\<^sub>e\<^sub>t(i)" - proof - fix \<tau> show "\<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil> \<noteq> {} \<Longrightarrow> - Finite_Set.fold (\<lambda>x acc. (acc->including\<^sub>S\<^sub>e\<^sub>t(x))->including\<^sub>S\<^sub>e\<^sub>t(i)) A ((\<lambda>a \<tau>. a) ` \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil>) = - (Finite_Set.fold (\<lambda>x acc. acc->including\<^sub>S\<^sub>e\<^sub>t(x)) A ((\<lambda>a \<tau>. a) ` \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil>))->including\<^sub>S\<^sub>e\<^sub>t(i)" - apply(subst finite_induct[where P = "\<lambda>set. let set' = (\<lambda>a \<tau>. a) ` set - ; fold_set = Finite_Set.fold (\<lambda>x acc. (acc->including\<^sub>S\<^sub>e\<^sub>t(x))) A set' in - (\<forall>\<tau>. all_defined \<tau> fold_set) \<and> - set' \<noteq> {} \<longrightarrow> - all_int_set set' \<longrightarrow> - (Finite_Set.fold (\<lambda>x acc. (acc->including\<^sub>S\<^sub>e\<^sub>t(x))->including\<^sub>S\<^sub>e\<^sub>t(i)) A set') = - (fold_set->including\<^sub>S\<^sub>e\<^sub>t(i))" - and F = "\<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil>", simplified Let_def]) - apply(simp add: S_finite) - apply(simp) - defer - - apply(subst preserved_defined_generic[OF including_commute, where \<tau> = \<tau>, simplified Let_def]) - apply(simp add: S_all_def) - apply(simp add: A_all_def) - apply(simp) - - apply(rule all_def_to_all_int, simp add: S_all_def) - apply(simp add: UML_Set.OclIncluding.cp0[of _ i]) - - (* *) - apply(rule impI)+ apply(erule conjE)+ - apply(simp) - apply(subst EQ_comp_fun_commute.fold_insert[OF including_commute]) - apply(simp add: A_all_def) - apply(simp add: all_int_set_def) - apply(simp add: invert_int) - - apply(rule image_cong) - apply(rule inject) - apply(simp) - - apply(subst EQ_comp_fun_commute.fold_insert[OF including_commute2]) - apply(simp add: i_int) - apply(simp add: A_all_def) - apply(simp add: all_int_set_def) - apply(simp add: invert_int) - - apply(rule image_cong) - apply(rule inject) - apply(simp) - - apply(subgoal_tac "(\<forall>a b. all_defined (a, b) (Finite_Set.fold (\<lambda>x acc. acc->including\<^sub>S\<^sub>e\<^sub>t(x)) A ((\<lambda>a \<tau>. a) ` F)))") - prefer 2 - apply(rule allI) apply(erule_tac x = a in allE) - apply(rule allI) apply(erule_tac x = b in allE) - apply(simp add: invert_all_defined_fold[simplified Let_def, THEN mp, THEN mp, THEN mp]) - - apply(simp) - - (* *) - apply(case_tac "F = {}", simp) - apply(simp add: all_int_set_def) - done - qed - - show "\<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil> \<noteq> {} \<Longrightarrow> ?thesis" - apply(simp add: UML_Set.OclIterate_def) - apply(simp add: S_all_def[simplified all_defined_def all_defined_set'_def] all_defined1[OF S_all_def, simplified OclValid_def] all_defined1[OF A_all_def, THEN foundation20, simplified OclValid_def]) - apply(drule i_out1) - apply(simp add: UML_Set.OclIncluding.cp0[of _ i]) - done -qed - -lemma including_out2_generic : - assumes including_commute : "EQ_comp_fun_commute (\<lambda>j (r2 :: ('\<AA>, 'a option option) Set). (r2->including\<^sub>S\<^sub>e\<^sub>t(j)))" - assumes including_commute2 : "\<And>i. is_int i \<Longrightarrow> EQ_comp_fun_commute (\<lambda>x (acc :: ('\<AA>, 'a option option) Set). ((acc->including\<^sub>S\<^sub>e\<^sub>t(x))->including\<^sub>S\<^sub>e\<^sub>t(i)))" - assumes including_commute3 : "\<And>i. is_int i \<Longrightarrow> EQ_comp_fun_commute (\<lambda>x (acc :: ('\<AA>, 'a option option) Set). ((acc->including\<^sub>S\<^sub>e\<^sub>t(i))->including\<^sub>S\<^sub>e\<^sub>t(x)))" - assumes including_commute4 : "\<And>i j. is_int i \<Longrightarrow> is_int j \<Longrightarrow> EQ_comp_fun_commute (\<lambda>x (acc :: ('\<AA>, 'a option option) Set). acc->including\<^sub>S\<^sub>e\<^sub>t(i)->including\<^sub>S\<^sub>e\<^sub>t(x)->including\<^sub>S\<^sub>e\<^sub>t(j))" - assumes including_commute5 : "\<And>i j. is_int i \<Longrightarrow> is_int j \<Longrightarrow> EQ_comp_fun_commute (\<lambda>x (acc :: ('\<AA>, 'a option option) Set). acc->including\<^sub>S\<^sub>e\<^sub>t(x)->including\<^sub>S\<^sub>e\<^sub>t(j)->including\<^sub>S\<^sub>e\<^sub>t(i))" - assumes including_out1 : "\<And>S A i \<tau>. (\<And>\<tau>. all_defined \<tau> (S :: ('\<AA>, 'a option option) Set)) \<Longrightarrow> (\<And>\<tau>. all_defined \<tau> A) \<Longrightarrow> is_int i \<Longrightarrow> - \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil> \<noteq> {} \<Longrightarrow> - ((S :: ('\<AA>, _) Set)->iterate\<^sub>S\<^sub>e\<^sub>t(x;acc=A | acc->including\<^sub>S\<^sub>e\<^sub>t(x)->including\<^sub>S\<^sub>e\<^sub>t(i))) \<tau> = (S->iterate\<^sub>S\<^sub>e\<^sub>t(x;acc=A | acc->including\<^sub>S\<^sub>e\<^sub>t(x))->including\<^sub>S\<^sub>e\<^sub>t(i)) \<tau>" - assumes preserved_defined : "\<And>(S :: ('\<AA>, 'a option option) Set) (A :: ('\<AA>, 'a option option) Set) \<tau>. (\<And>\<tau>. all_defined \<tau> S) \<Longrightarrow> -(\<And>\<tau>. all_defined \<tau> A) \<Longrightarrow> let S' = (\<lambda>a \<tau>. a) ` \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil> in \<forall>\<tau>. all_defined \<tau> (Finite_Set.fold (\<lambda>x acc. acc->including\<^sub>S\<^sub>e\<^sub>t(x)) A S')" - - assumes S_all_def : "\<And>\<tau>. all_defined \<tau> (S :: ('\<AA>, 'a option option) Set)" - and A_all_def : "\<And>\<tau>. all_defined \<tau> A" - and i_int : "is_int i" - and x0_int : "is_int x0" - shows "\<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil> \<noteq> {} \<Longrightarrow> (S->iterate\<^sub>S\<^sub>e\<^sub>t(x;acc=A | acc->including\<^sub>S\<^sub>e\<^sub>t(x0)->including\<^sub>S\<^sub>e\<^sub>t(x)->including\<^sub>S\<^sub>e\<^sub>t(i))) \<tau> = (S->iterate\<^sub>S\<^sub>e\<^sub>t(x;acc=A | acc->including\<^sub>S\<^sub>e\<^sub>t(x0)->including\<^sub>S\<^sub>e\<^sub>t(x))->including\<^sub>S\<^sub>e\<^sub>t(i)) \<tau>" -proof - - have x0_val : "\<And>\<tau>. \<tau> \<Turnstile> \<upsilon> x0" apply(insert x0_int[simplified is_int_def]) by (metis foundation18') - have i_val : "\<And>\<tau>. \<tau> \<Turnstile> \<upsilon> i" apply(insert i_int[simplified is_int_def]) by (metis foundation18') - - have all_defined1 : "\<And>r2 \<tau>. all_defined \<tau> r2 \<Longrightarrow> \<tau> \<Turnstile> \<delta> r2" by(simp add: all_defined_def) - - have init_out1 : "(S->iterate\<^sub>S\<^sub>e\<^sub>t(x;acc=A | acc->including\<^sub>S\<^sub>e\<^sub>t(x0)->including\<^sub>S\<^sub>e\<^sub>t(x)->including\<^sub>S\<^sub>e\<^sub>t(i))) = (S->iterate\<^sub>S\<^sub>e\<^sub>t(x;acc=A | acc->including\<^sub>S\<^sub>e\<^sub>t(x)->including\<^sub>S\<^sub>e\<^sub>t(x0)->including\<^sub>S\<^sub>e\<^sub>t(i)))" - apply(rule iterate_subst_set[OF S_all_def A_all_def including_commute4 including_commute5]) - apply(simp add: x0_int i_int)+ - done - - have init_out2 : "\<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil> \<noteq> {} \<Longrightarrow> (S->iterate\<^sub>S\<^sub>e\<^sub>t(x;acc=A | acc->including\<^sub>S\<^sub>e\<^sub>t(x0)->including\<^sub>S\<^sub>e\<^sub>t(x))->including\<^sub>S\<^sub>e\<^sub>t(i)) \<tau> = (S->iterate\<^sub>S\<^sub>e\<^sub>t(x;acc=A | acc->including\<^sub>S\<^sub>e\<^sub>t(x))->including\<^sub>S\<^sub>e\<^sub>t(x0)->including\<^sub>S\<^sub>e\<^sub>t(i)) \<tau>" - apply(rule including_subst_set'') prefer 4 - apply(simp add: including_out1[OF S_all_def A_all_def x0_int, symmetric]) - apply(subst iterate_subst_set[OF S_all_def A_all_def including_commute3 including_commute2]) - apply(simp add: x0_int)+ apply(rule x0_int) - apply(simp) - (* *) - apply(rule all_defined1) - apply(rule i_cons_all_def'') apply(rule including_commute2[THEN c0_of_c, THEN c0'_of_c0], simp add: x0_int, simp add: S_all_def, simp add: A_all_def) - apply(rule all_defined1) - apply(rule cons_all_def) - apply(rule i_cons_all_def'') apply(rule including_commute[THEN c0_of_c, THEN c0'_of_c0], simp add: x0_int, simp add: S_all_def, simp add: A_all_def, simp add: int_is_valid[OF x0_int]) - apply(simp add: int_is_valid[OF i_int]) - done - - have i_valid : "\<forall>\<tau>. \<tau> \<Turnstile> \<upsilon> i" - by (metis i_int int_is_valid) - - - have S_finite : "\<And>\<tau>. finite \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil>" - by(simp add: S_all_def[simplified all_defined_def all_defined_set'_def]) - - have all_def_to_all_int_ : "\<And>set \<tau>. all_defined_set \<tau> set \<Longrightarrow> all_int_set ((\<lambda>a \<tau>. a) ` set)" - apply(simp add: all_defined_set_def all_int_set_def is_int_def) - by (metis foundation18') - - have invert_all_def_set : "\<And>x F \<tau>. all_defined_set \<tau> (insert x F) \<Longrightarrow> all_defined_set \<tau> F" - apply(simp add: all_defined_set_def) - done - - have invert_int : "\<And>x S. all_int_set (insert x S) \<Longrightarrow> - is_int x" - by(simp add: all_int_set_def) - - have inject : "inj (\<lambda>a \<tau>. a)" - by(rule inj_fun, simp) - - - have image_cong: "\<And>x Fa f. inj f \<Longrightarrow> x \<notin> Fa \<Longrightarrow> f x \<notin> f ` Fa" - apply(simp add: image_def) - apply(rule ballI) - apply(case_tac "x = xa", simp) - apply(simp add: inj_on_def) - apply(blast) - done - - - have discr_eq_false_true : "\<And>\<tau>. (false \<tau> = true \<tau>) = False" by (metis OclValid_def foundation2) - - - have invert_all_defined_fold : "\<And> F x a b. let F' = (\<lambda>a \<tau>. a) ` F in x \<notin> F \<longrightarrow> all_int_set (insert (\<lambda>\<tau>. x) F') \<longrightarrow> all_defined (a, b) (Finite_Set.fold (\<lambda>x acc. acc->including\<^sub>S\<^sub>e\<^sub>t(x)) A (insert (\<lambda>\<tau>. x) F')) \<longrightarrow> - all_defined (a, b) (Finite_Set.fold (\<lambda>x acc. acc->including\<^sub>S\<^sub>e\<^sub>t(x)) A F')" - proof - fix F x a b show "?thesis F x a b" - apply(simp add: Let_def) apply(rule impI)+ - apply(insert arg_cong[where f = "\<lambda>x. all_defined (a, b) x", OF EQ_comp_fun_commute.fold_insert[OF including_commute, where x= "(\<lambda>\<tau>. x)" and A = "(\<lambda>a \<tau>. a) ` F" and z = A]] - allI[where P = "\<lambda>x. all_defined x A", OF A_all_def]) - apply(simp) - apply(subgoal_tac "all_int_set ((\<lambda>a \<tau>. a) ` F)") - prefer 2 - apply(simp add: all_int_set_def, auto) - apply(drule invert_int, simp) - apply(subgoal_tac "(\<lambda>(\<tau>:: '\<AA> st). x) \<notin> (\<lambda>a (\<tau>:: '\<AA> st). a) ` F") - prefer 2 - apply(rule image_cong) - apply(rule inject) - apply(simp) - - apply(simp) - apply(rule invert_all_defined[THEN conjunct2, of _ _ "\<lambda>\<tau>. x"], simp) - done - qed - - have i_out : "\<And>i i' x F. is_int i \<Longrightarrow> i = (\<lambda>_. i') \<Longrightarrow> is_int (\<lambda>(\<tau>:: '\<AA> st). x) \<Longrightarrow> \<forall>a b. all_defined (a, b) (Finite_Set.fold (\<lambda>x acc. acc->including\<^sub>S\<^sub>e\<^sub>t(x)) A ((\<lambda>a \<tau>. a) ` F)) \<Longrightarrow> - (((Finite_Set.fold (\<lambda>x acc. (acc->including\<^sub>S\<^sub>e\<^sub>t(x))) A - ((\<lambda>a \<tau>. a) ` F))->including\<^sub>S\<^sub>e\<^sub>t(\<lambda>\<tau>. x))->including\<^sub>S\<^sub>e\<^sub>t(i))->including\<^sub>S\<^sub>e\<^sub>t(i) = - (((Finite_Set.fold (\<lambda>j r2. (r2->including\<^sub>S\<^sub>e\<^sub>t(j))) A ((\<lambda>a \<tau>. a) ` F))->including\<^sub>S\<^sub>e\<^sub>t(\<lambda>\<tau>. x))->including\<^sub>S\<^sub>e\<^sub>t(i))" - by simp - - have destruct3 : "\<And>A B C \<tau>. (\<tau> \<Turnstile> A) \<and> (\<tau> \<Turnstile> B) \<and> (\<tau> \<Turnstile> C) \<Longrightarrow> (\<tau> \<Turnstile> (A and B and C))" - by (metis foundation10 foundation6) - - have i_out1 : "\<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil> \<noteq> {} \<Longrightarrow> - Finite_Set.fold (\<lambda>x acc. (acc->including\<^sub>S\<^sub>e\<^sub>t(x))->including\<^sub>S\<^sub>e\<^sub>t(x0)->including\<^sub>S\<^sub>e\<^sub>t(i)) A ((\<lambda>a \<tau>. a) ` \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil>) = - (Finite_Set.fold (\<lambda>x acc. acc->including\<^sub>S\<^sub>e\<^sub>t(x)) A ((\<lambda>a \<tau>. a) ` \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil>))->including\<^sub>S\<^sub>e\<^sub>t(x0)->including\<^sub>S\<^sub>e\<^sub>t(i)" - proof - fix \<tau> show "\<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil> \<noteq> {} \<Longrightarrow> - Finite_Set.fold (\<lambda>x acc. (acc->including\<^sub>S\<^sub>e\<^sub>t(x))->including\<^sub>S\<^sub>e\<^sub>t(x0)->including\<^sub>S\<^sub>e\<^sub>t(i)) A ((\<lambda>a \<tau>. a) ` \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil>) = - (Finite_Set.fold (\<lambda>x acc. acc->including\<^sub>S\<^sub>e\<^sub>t(x)) A ((\<lambda>a \<tau>. a) ` \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil>))->including\<^sub>S\<^sub>e\<^sub>t(x0)->including\<^sub>S\<^sub>e\<^sub>t(i)" - apply(subst finite_induct[where P = "\<lambda>set. let set' = (\<lambda>a \<tau>. a) ` set - ; fold_set = Finite_Set.fold (\<lambda>x acc. (acc->including\<^sub>S\<^sub>e\<^sub>t(x))) A set' in - (\<forall>\<tau>. all_defined \<tau> fold_set) \<and> - set' \<noteq> {} \<longrightarrow> - all_int_set set' \<longrightarrow> - (Finite_Set.fold (\<lambda>x acc. (acc->including\<^sub>S\<^sub>e\<^sub>t(x))->including\<^sub>S\<^sub>e\<^sub>t(x0)->including\<^sub>S\<^sub>e\<^sub>t(i)) A set') = - (fold_set->including\<^sub>S\<^sub>e\<^sub>t(x0)->including\<^sub>S\<^sub>e\<^sub>t(i))" - and F = "\<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil>", simplified Let_def]) - apply(simp add: S_finite) - apply(simp) - defer - - apply(subst preserved_defined[where \<tau> = \<tau>, simplified Let_def]) - apply(simp add: S_all_def) - apply(simp add: A_all_def) - apply(simp) - - apply(rule all_def_to_all_int, simp add: S_all_def) - apply(simp add: UML_Set.OclIncluding.cp0[of _ i]) - - (* *) - apply(rule impI)+ apply(erule conjE)+ - apply(simp) - apply(subst EQ_comp_fun_commute.fold_insert[OF including_commute]) - apply(simp add: A_all_def) - apply(simp add: all_int_set_def) - apply(simp add: invert_int) - - apply(rule image_cong) - apply(rule inject) - apply(simp) - - apply(subst EQ_comp_fun_commute.fold_insert[OF including_commute5]) - apply(simp add: x0_int) - apply(simp add: i_int) - apply(simp add: A_all_def) - apply(simp add: all_int_set_def) - apply(simp add: invert_int) - - apply(rule image_cong) - apply(rule inject) - apply(simp) - - apply(subgoal_tac "(\<forall>a b. all_defined (a, b) (Finite_Set.fold (\<lambda>x acc. acc->including\<^sub>S\<^sub>e\<^sub>t(x)) A ((\<lambda>a \<tau>. a) ` F)))") - prefer 2 - apply(rule allI) apply(erule_tac x = a in allE) - apply(rule allI) apply(erule_tac x = b in allE) - apply(simp add: invert_all_defined_fold[simplified Let_def, THEN mp, THEN mp, THEN mp]) - - apply(simp) - - (* *) - apply(case_tac "F = {}", simp) - apply(simp add: all_int_set_def) - done - qed - - show "\<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil> \<noteq> {} \<Longrightarrow> ?thesis" - apply(simp only: init_out1, subst init_out2, simp del: OclIncluding_commute) - apply(simp add: UML_Set.OclIterate_def del: OclIncluding_commute) - apply(simp add: S_all_def[simplified all_defined_def all_defined_set'_def] all_defined1[OF S_all_def, simplified OclValid_def] all_defined1[OF A_all_def, THEN foundation20, simplified OclValid_def] - del: OclIncluding_commute) - apply(simp add: i_out1 del: OclIncluding_commute) - apply(simp add: UML_Set.OclIncluding.cp0[of _ i] UML_Set.OclIncluding.cp0[of _ x0]) - done -qed - -lemma including_out0_generic : - assumes including_commute : "EQ_comp_fun_commute (\<lambda>j (r2 :: ('\<AA>, 'a option option) Set). r2->including\<^sub>S\<^sub>e\<^sub>t(j))" - assumes S_all_def : "\<And>\<tau>. all_defined \<tau> (S :: ('\<AA>, 'a option option) Set)" - and S_include : "\<And>\<tau> \<tau>'. S \<tau> = S \<tau>'" - and S_notempty : "\<And>\<tau>. \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil> \<noteq> {}" - and a_int : "is_int a" - shows "(S->iterate\<^sub>S\<^sub>e\<^sub>t(x;acc=Set{a} | acc->including\<^sub>S\<^sub>e\<^sub>t(x))) = (S->including\<^sub>S\<^sub>e\<^sub>t(a))" - - apply(rule ex1E[OF destruct_int[OF a_int]], rename_tac a', simp) - apply(case_tac "\<forall>\<tau>. a' \<in> \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil>") -proof - - have S_all_int : "\<And>\<tau>. all_int_set ((\<lambda>a \<tau>. a) ` \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil>)" - by(rule all_def_to_all_int, simp add: assms) - - have a_all_def : "\<And>\<tau>. all_defined \<tau> Set{a}" - by(rule cons_all_def, rule mtSet_all_def, simp add: int_is_valid[OF a_int]) - - have all_defined1 : "\<And>r2 \<tau>. all_defined \<tau> r2 \<Longrightarrow> \<tau> \<Turnstile> \<delta> r2" by(simp add: all_defined_def) - - have Sa_include : "\<And>a' \<tau> \<tau>'. (\<lambda>_. a') = a \<Longrightarrow> S->including\<^sub>S\<^sub>e\<^sub>t(a) \<tau> = S->including\<^sub>S\<^sub>e\<^sub>t(a) \<tau>'" - apply(simp add: UML_Set.OclIncluding.cp0[of _ a]) - apply(drule sym[of _ a], simp add: UML_Set.OclIncluding.cp0[symmetric]) - proof - fix a' \<tau> \<tau>' show "a = (\<lambda>_. a') \<Longrightarrow> \<lambda>_. S \<tau>->including\<^sub>S\<^sub>e\<^sub>t(\<lambda>_. a') \<tau> = \<lambda>_. S \<tau>'->including\<^sub>S\<^sub>e\<^sub>t(\<lambda>_. a') \<tau>'" - apply(simp add: UML_Set.OclIncluding_def) - apply(drule sym[of a]) - apply(simp add: cp_defined[symmetric]) - apply(simp add: all_defined1[OF S_all_def, simplified OclValid_def] int_is_valid[OF a_int, simplified OclValid_def]) - apply(subst S_include[of \<tau> \<tau>'], simp) - done - qed - - have gen_all : "\<And>a. \<exists> \<tau>. a \<notin> \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil> \<Longrightarrow> \<forall> \<tau>. a \<notin> \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil>" - apply(rule allI) - apply(drule exE) prefer 2 apply assumption - by(subst S_include, simp) - - fix a' show "a = (\<lambda>_. a') \<Longrightarrow> \<forall>\<tau>. a' \<in> \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil> \<Longrightarrow> (S ->iterate\<^sub>S\<^sub>e\<^sub>t(x;acc=Set{\<lambda>_. a'} | acc->including\<^sub>S\<^sub>e\<^sub>t(x))) = S->including\<^sub>S\<^sub>e\<^sub>t(\<lambda>_. a')" - apply(subst including_id[OF S_all_def, symmetric], simp) - apply(drule sym[of a], simp) - apply(subst EQ_OclIterate_including[where a = a and A = "Set{a}" and F = "\<lambda>a A. (A->including\<^sub>S\<^sub>e\<^sub>t(a))", simplified flatten_int, OF S_all_int S_all_def a_all_def including_commute a_int]) - apply(subst EQ_OclIterate_including[where a = a and A = "Set{}" and F = "\<lambda>a A. (A->including\<^sub>S\<^sub>e\<^sub>t(a))", symmetric, OF S_all_int S_all_def mtSet_all_def including_commute a_int]) - apply(rule iterate_including_id00_generic[OF including_commute]) - apply(rule cons_all_def, simp_all add: S_all_def int_is_valid[OF a_int]) - apply(simp add: Sa_include) - done - apply_end simp_all - - fix a' - show "a = (\<lambda>_. a') \<Longrightarrow> - \<forall>y. (\<lambda>_. a') = (\<lambda>_. y) \<longrightarrow> y = a' \<Longrightarrow> \<exists>a b. a' \<notin> \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S (a, b))\<rceil>\<rceil> \<Longrightarrow> (S ->iterate\<^sub>S\<^sub>e\<^sub>t(x;acc=Set{\<lambda>_. a'} | acc->including\<^sub>S\<^sub>e\<^sub>t(x))) = S->including\<^sub>S\<^sub>e\<^sub>t(\<lambda>_. a')" - apply(drule gen_all[simplified]) - apply(subst excluding_id[OF S_all_def, symmetric]) - prefer 2 apply (simp) - apply(drule sym[of a], simp add: a_int) - apply(drule sym[of a], simp) - apply(subst EQ_OclIterate_including[where a = a and A = "Set{}" and F = "\<lambda>a A. (A->including\<^sub>S\<^sub>e\<^sub>t(a))", symmetric, OF S_all_int S_all_def mtSet_all_def including_commute a_int]) - apply(rule iterate_including_id00_generic[OF including_commute]) - apply(rule cons_all_def, simp_all add: S_all_def int_is_valid[OF a_int]) - apply(simp add: Sa_include) - done -qed - -subsection{* Execution OclIncluding out of OclIterate (corollary) *} - -lemma iterate_including_id_out_generic : - assumes including_commute : "EQ_comp_fun_commute (\<lambda>j (r2 :: ('\<AA>, 'a option option) Set). (r2->including\<^sub>S\<^sub>e\<^sub>t(j)))" - assumes including_commute2 : "\<And>i. is_int i \<Longrightarrow> EQ_comp_fun_commute (\<lambda>x (acc :: ('\<AA>, 'a option option) Set). ((acc->including\<^sub>S\<^sub>e\<^sub>t(x))->including\<^sub>S\<^sub>e\<^sub>t(i)))" - assumes including_commute3 : "\<And>i. is_int i \<Longrightarrow> EQ_comp_fun_commute (\<lambda>x (acc :: ('\<AA>, 'a option option) Set). ((acc->including\<^sub>S\<^sub>e\<^sub>t(i))->including\<^sub>S\<^sub>e\<^sub>t(x)))" - assumes including_out1 : "\<And>S A i \<tau>. (\<And>\<tau>. all_defined \<tau> (S :: ('\<AA>, 'a option option) Set)) \<Longrightarrow> (\<And>\<tau>. all_defined \<tau> A) \<Longrightarrow> is_int i \<Longrightarrow> - \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil> \<noteq> {} \<Longrightarrow> - ((S :: ('\<AA>, _) Set)->iterate\<^sub>S\<^sub>e\<^sub>t(x;acc=A | acc->including\<^sub>S\<^sub>e\<^sub>t(x)->including\<^sub>S\<^sub>e\<^sub>t(i))) \<tau> = (S->iterate\<^sub>S\<^sub>e\<^sub>t(x;acc=A | acc->including\<^sub>S\<^sub>e\<^sub>t(x))->including\<^sub>S\<^sub>e\<^sub>t(i)) \<tau>" - - assumes S_def : "\<And>\<tau>. all_defined \<tau> (S:: ('\<AA>, 'a option option) Set)" - and a_int : "is_int a" - shows "\<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil> \<noteq> {} \<Longrightarrow> (S ->iterate\<^sub>S\<^sub>e\<^sub>t(j;r2=S | r2->including\<^sub>S\<^sub>e\<^sub>t(a)->including\<^sub>S\<^sub>e\<^sub>t(j))) \<tau> = S->including\<^sub>S\<^sub>e\<^sub>t(a) \<tau>" -proof - - have all_defined1 : "\<And>r2 \<tau>. all_defined \<tau> r2 \<Longrightarrow> \<tau> \<Turnstile> \<delta> r2" by(simp add: all_defined_def) -show "\<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil> \<noteq> {} \<Longrightarrow> ?thesis" - apply(subst iterate_subst_set0[where G = "\<lambda>j r2. r2->including\<^sub>S\<^sub>e\<^sub>t(j)->including\<^sub>S\<^sub>e\<^sub>t(a)"]) - apply(simp add: S_def) - apply(rule including_commute3[THEN c0_of_c], simp add: a_int) - apply(rule including_commute2[THEN c0_of_c], simp add: a_int) - apply(simp) - apply(subst including_out1) apply(simp add: S_def a_int)+ - apply(subst iterate_including_id_generic[OF including_commute], simp add: S_def, simp) -done -qed - -lemma iterate_including_id_out'_generic : - assumes including_commute : "EQ_comp_fun_commute (\<lambda>j (r2 :: ('\<AA>, 'a option option) Set). (r2->including\<^sub>S\<^sub>e\<^sub>t(j)))" - assumes including_out1 : "\<And>(S:: ('\<AA>, 'a option option) Set) A i \<tau>. (\<And>\<tau>. all_defined \<tau> S) \<Longrightarrow> - (\<And>\<tau>. all_defined \<tau> A) \<Longrightarrow> - is_int i \<Longrightarrow> - \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil> \<noteq> {} \<Longrightarrow> (S ->iterate\<^sub>S\<^sub>e\<^sub>t(x;acc=A | acc->including\<^sub>S\<^sub>e\<^sub>t(x)->including\<^sub>S\<^sub>e\<^sub>t(i))) \<tau> = S ->iterate\<^sub>S\<^sub>e\<^sub>t(x;acc=A | acc->including\<^sub>S\<^sub>e\<^sub>t(x))->including\<^sub>S\<^sub>e\<^sub>t(i) \<tau>" - assumes S_def : "\<And>\<tau>. all_defined \<tau> (S:: ('\<AA>, 'a option option) Set)" - and a_int : "is_int a" - shows "\<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil> \<noteq> {} \<Longrightarrow> (S ->iterate\<^sub>S\<^sub>e\<^sub>t(j;r2=S | r2->including\<^sub>S\<^sub>e\<^sub>t(j)->including\<^sub>S\<^sub>e\<^sub>t(a))) \<tau> = S->including\<^sub>S\<^sub>e\<^sub>t(a) \<tau>" - apply(subst including_out1) apply(simp add: S_def a_int)+ - apply(subst iterate_including_id_generic[OF including_commute], simp add: S_def, simp) -done - -lemma iterate_including_id_out''''_generic : - assumes including_out2 : "\<And>S A i x0 \<tau>. - (\<And>\<tau>. all_defined \<tau> (S :: ('\<AA>, 'a option option) Set)) \<Longrightarrow> - (\<And>\<tau>. all_defined \<tau> A) \<Longrightarrow> - is_int i \<Longrightarrow> - is_int x0 \<Longrightarrow> - \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil> \<noteq> {} \<Longrightarrow> (S->iterate\<^sub>S\<^sub>e\<^sub>t(x;acc=A | acc->including\<^sub>S\<^sub>e\<^sub>t(x0)->including\<^sub>S\<^sub>e\<^sub>t(x)->including\<^sub>S\<^sub>e\<^sub>t(i))) \<tau> = (S->iterate\<^sub>S\<^sub>e\<^sub>t(x;acc=A | acc->including\<^sub>S\<^sub>e\<^sub>t(x0)->including\<^sub>S\<^sub>e\<^sub>t(x))->including\<^sub>S\<^sub>e\<^sub>t(i)) \<tau>" - assumes including_commute3 : "\<And>i. is_int i \<Longrightarrow> EQ_comp_fun_commute (\<lambda>x (acc :: ('\<AA>, 'a option option) Set). ((acc->including\<^sub>S\<^sub>e\<^sub>t(i))->including\<^sub>S\<^sub>e\<^sub>t(x)))" - assumes iterate_including_id_out : "\<And>S a \<tau>. - (\<And>\<tau>. all_defined \<tau> (S:: ('\<AA>, 'a option option) Set)) \<Longrightarrow> - is_int a \<Longrightarrow> - \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil> \<noteq> {} \<Longrightarrow> (S ->iterate\<^sub>S\<^sub>e\<^sub>t(j;r2=S | r2->including\<^sub>S\<^sub>e\<^sub>t(a)->including\<^sub>S\<^sub>e\<^sub>t(j))) \<tau> = S->including\<^sub>S\<^sub>e\<^sub>t(a) \<tau>" - assumes S_def : "\<And>\<tau>. all_defined \<tau> (S:: ('\<AA>, 'a option option) Set)" - and a_int : "is_int a" - and b_int : "is_int b" - shows "\<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil> \<noteq> {} \<Longrightarrow> (S ->iterate\<^sub>S\<^sub>e\<^sub>t(j;r2=S | r2->including\<^sub>S\<^sub>e\<^sub>t(a)->including\<^sub>S\<^sub>e\<^sub>t(j)->including\<^sub>S\<^sub>e\<^sub>t(b))) \<tau> = S->including\<^sub>S\<^sub>e\<^sub>t(a)->including\<^sub>S\<^sub>e\<^sub>t(b) \<tau>" -proof - - have all_defined1 : "\<And>r2 \<tau>. all_defined \<tau> r2 \<Longrightarrow> \<tau> \<Turnstile> \<delta> r2" by(simp add: all_defined_def) -show "\<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil> \<noteq> {} \<Longrightarrow> ?thesis" - apply(subst including_out2) apply(simp add: S_def a_int b_int del: OclIncluding_commute)+ - apply(rule including_subst_set'') - apply(rule all_defined1, rule i_cons_all_def, rule including_commute3[THEN c0_of_c], simp add: a_int, simp add: S_def) - apply(rule all_defined1, rule cons_all_def, simp add: S_def, simp add: int_is_valid[OF a_int], simp add: int_is_valid[OF b_int]) - - apply(rule iterate_including_id_out) apply(simp add: S_def a_int)+ - done -qed - -lemma iterate_including_id_out'''_generic : - assumes including_commute4 : "\<And>i j. is_int i \<Longrightarrow> is_int j \<Longrightarrow> EQ_comp_fun_commute (\<lambda>x (acc :: ('\<AA>, 'a option option) Set). acc->including\<^sub>S\<^sub>e\<^sub>t(i)->including\<^sub>S\<^sub>e\<^sub>t(x)->including\<^sub>S\<^sub>e\<^sub>t(j))" - assumes including_commute6 : "\<And>i j. is_int i \<Longrightarrow> is_int j \<Longrightarrow> EQ_comp_fun_commute (\<lambda>x (acc :: ('\<AA>, 'a option option) Set). acc->including\<^sub>S\<^sub>e\<^sub>t(i)->including\<^sub>S\<^sub>e\<^sub>t(j)->including\<^sub>S\<^sub>e\<^sub>t(x))" - assumes iterate_including_id_out'''' : "\<And>S a b \<tau>. - (\<And>\<tau>. all_defined \<tau> (S:: ('\<AA>, 'a option option) Set)) \<Longrightarrow> - is_int a \<Longrightarrow> - is_int b \<Longrightarrow> - \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil> \<noteq> {} \<Longrightarrow> (S ->iterate\<^sub>S\<^sub>e\<^sub>t(j;r2=S | r2->including\<^sub>S\<^sub>e\<^sub>t(a)->including\<^sub>S\<^sub>e\<^sub>t(j)->including\<^sub>S\<^sub>e\<^sub>t(b))) \<tau> = S->including\<^sub>S\<^sub>e\<^sub>t(a)->including\<^sub>S\<^sub>e\<^sub>t(b) \<tau>" - assumes S_def : "\<And>\<tau>. all_defined \<tau> (S:: ('\<AA>, 'a option option) Set)" - and a_int : "is_int a" - and b_int : "is_int b" - shows "\<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil> \<noteq> {} \<Longrightarrow> (S ->iterate\<^sub>S\<^sub>e\<^sub>t(j;r2=S | r2->including\<^sub>S\<^sub>e\<^sub>t(a)->including\<^sub>S\<^sub>e\<^sub>t(b)->including\<^sub>S\<^sub>e\<^sub>t(j))) \<tau> = S->including\<^sub>S\<^sub>e\<^sub>t(a)->including\<^sub>S\<^sub>e\<^sub>t(b) \<tau>" -proof - - have all_defined1 : "\<And>r2 \<tau>. all_defined \<tau> r2 \<Longrightarrow> \<tau> \<Turnstile> \<delta> r2" by(simp add: all_defined_def) -show "\<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil> \<noteq> {} \<Longrightarrow> ?thesis" - apply(subst iterate_subst_set0[where G = "\<lambda>j r2. r2->including\<^sub>S\<^sub>e\<^sub>t(a)->including\<^sub>S\<^sub>e\<^sub>t(j)->including\<^sub>S\<^sub>e\<^sub>t(b)"]) - apply(simp add: S_def) - apply(rule including_commute6[THEN c0_of_c], simp add: a_int, simp add: b_int) - apply(rule including_commute4[THEN c0_of_c], simp add: a_int, simp add: b_int) - apply(simp) - apply(rule iterate_including_id_out'''') apply(simp add: S_def a_int b_int)+ -done -qed - -section{* Conclusion *} - -lemma GogollasChallenge_on_sets_generic: - assumes val_0[simp] : "\<And>\<tau>. \<tau> \<Turnstile> \<upsilon> zero" - assumes val_6[simp] : "\<And>\<tau>. \<tau> \<Turnstile> \<upsilon> six" - assumes val_8[simp] : "\<And>\<tau>. \<tau> \<Turnstile> \<upsilon> eight" - assumes val_9[simp] : "\<And>\<tau>. \<tau> \<Turnstile> \<upsilon> nine" - assumes OclInt0_int : "is_int (zero :: ('\<AA>, 'a option option) val)" - assumes OclInt6_int : "is_int (six :: ('\<AA>, 'a option option) val)" - assumes OclInt8_int : "is_int (eight :: ('\<AA>, 'a option option) val)" - assumes OclInt9_int : "is_int (nine :: ('\<AA>, 'a option option) val)" - assumes including_commute : "EQ_comp_fun_commute (\<lambda>j (r2 :: ('\<AA>, 'a option option) Set). r2->including\<^sub>S\<^sub>e\<^sub>t(j))" - assumes including_commute2 : "\<And>i. is_int i \<Longrightarrow> EQ_comp_fun_commute (\<lambda>x (acc :: ('\<AA>, 'a option option) Set). ((acc->including\<^sub>S\<^sub>e\<^sub>t(x))->including\<^sub>S\<^sub>e\<^sub>t(i)))" - assumes including_commute3 : "\<And>i. is_int i \<Longrightarrow> EQ_comp_fun_commute (\<lambda>x (acc :: ('\<AA>, 'a option option) Set). ((acc->including\<^sub>S\<^sub>e\<^sub>t(i))->including\<^sub>S\<^sub>e\<^sub>t(x)))" - assumes including_commute4 : "\<And>i j. is_int i \<Longrightarrow> is_int j \<Longrightarrow> EQ_comp_fun_commute (\<lambda>x (acc :: ('\<AA>, 'a option option) Set). acc->including\<^sub>S\<^sub>e\<^sub>t(i)->including\<^sub>S\<^sub>e\<^sub>t(x)->including\<^sub>S\<^sub>e\<^sub>t(j))" - assumes including_commute5 : "\<And>i j. is_int i \<Longrightarrow> is_int j \<Longrightarrow> EQ_comp_fun_commute (\<lambda>x (acc :: ('\<AA>, 'a option option) Set). acc->including\<^sub>S\<^sub>e\<^sub>t(x)->including\<^sub>S\<^sub>e\<^sub>t(j)->including\<^sub>S\<^sub>e\<^sub>t(i))" - assumes including_commute6 : "\<And>i j. is_int i \<Longrightarrow> is_int j \<Longrightarrow> EQ_comp_fun_commute (\<lambda>x (acc :: ('\<AA>, 'a option option) Set). acc->including\<^sub>S\<^sub>e\<^sub>t(i)->including\<^sub>S\<^sub>e\<^sub>t(j)->including\<^sub>S\<^sub>e\<^sub>t(x))" - assumes iterate_including_id : "\<And>(S:: ('\<AA>, 'a option option) Set). (\<And>\<tau>. all_defined \<tau> S) \<Longrightarrow> (S ->iterate\<^sub>S\<^sub>e\<^sub>t(j;r2=S | r2->including\<^sub>S\<^sub>e\<^sub>t(j))) = S" - assumes iterate_including_id_out : "\<And>S a \<tau>. - (\<And>\<tau>. all_defined \<tau> (S:: ('\<AA>, 'a option option) Set)) \<Longrightarrow> - is_int a \<Longrightarrow> - \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil> \<noteq> {} \<Longrightarrow> (S ->iterate\<^sub>S\<^sub>e\<^sub>t(j;r2=S | r2->including\<^sub>S\<^sub>e\<^sub>t(a)->including\<^sub>S\<^sub>e\<^sub>t(j))) \<tau> = S->including\<^sub>S\<^sub>e\<^sub>t(a) \<tau>" - assumes iterate_including_id_out' : "\<And>S a \<tau>. - (\<And>\<tau>. all_defined \<tau> (S:: ('\<AA>, 'a option option) Set)) \<Longrightarrow> - is_int a \<Longrightarrow> - \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil> \<noteq> {} \<Longrightarrow> (S ->iterate\<^sub>S\<^sub>e\<^sub>t(j;r2=S | r2->including\<^sub>S\<^sub>e\<^sub>t(j)->including\<^sub>S\<^sub>e\<^sub>t(a))) \<tau> = S->including\<^sub>S\<^sub>e\<^sub>t(a) \<tau>" - assumes iterate_including_id_out''' : "\<And>S a b \<tau>. - (\<And>\<tau>. all_defined \<tau> (S:: ('\<AA>, 'a option option) Set)) \<Longrightarrow> - is_int a \<Longrightarrow> - is_int b \<Longrightarrow> - \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil> \<noteq> {} \<Longrightarrow> (S ->iterate\<^sub>S\<^sub>e\<^sub>t(j;r2=S | r2->including\<^sub>S\<^sub>e\<^sub>t(a)->including\<^sub>S\<^sub>e\<^sub>t(b)->including\<^sub>S\<^sub>e\<^sub>t(j))) \<tau> = S->including\<^sub>S\<^sub>e\<^sub>t(a)->including\<^sub>S\<^sub>e\<^sub>t(b) \<tau>" - assumes iterate_including_id_out'''' : "\<And>S a b \<tau>. - (\<And>\<tau>. all_defined \<tau> (S:: ('\<AA>, 'a option option) Set)) \<Longrightarrow> - is_int a \<Longrightarrow> - is_int b \<Longrightarrow> - \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil> \<noteq> {} \<Longrightarrow> (S ->iterate\<^sub>S\<^sub>e\<^sub>t(j;r2=S | r2->including\<^sub>S\<^sub>e\<^sub>t(a)->including\<^sub>S\<^sub>e\<^sub>t(j)->including\<^sub>S\<^sub>e\<^sub>t(b))) \<tau> = S->including\<^sub>S\<^sub>e\<^sub>t(a)->including\<^sub>S\<^sub>e\<^sub>t(b) \<tau>" - assumes iterate_including_commute_var : "\<And>F a. - EQ_comp_fun_commute0 (\<lambda>x. (F :: ('\<AA>, 'a option option) val - \<Rightarrow> ('\<AA>, _) Set - \<Rightarrow> ('\<AA>, _) Set) (\<lambda>_. x)) \<Longrightarrow> - (\<And>x y. - is_int (\<lambda>(_:: '\<AA> st). x) \<Longrightarrow> - is_int (\<lambda>(_:: '\<AA> st). y) \<Longrightarrow> - UML_Set.OclIterate Set{\<lambda>(_:: '\<AA> st). x, a} Set{\<lambda>(_:: '\<AA> st). x, a} F->including\<^sub>S\<^sub>e\<^sub>t(\<lambda>(_:: '\<AA> st). y) = - UML_Set.OclIterate Set{\<lambda>(_:: '\<AA> st). y, a} Set{\<lambda>(_:: '\<AA> st). y, a} F->including\<^sub>S\<^sub>e\<^sub>t(\<lambda>(_:: '\<AA> st). x)) \<Longrightarrow> - (\<And>S x y \<tau>. - is_int (\<lambda>(_:: '\<AA> st). x) \<Longrightarrow> - is_int (\<lambda>(_:: '\<AA> st). y) \<Longrightarrow> - \<forall>(\<tau> :: '\<AA> st). all_defined \<tau> S \<Longrightarrow> - \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil> \<noteq> {} \<Longrightarrow> - (UML_Set.OclIterate (((UML_Set.OclIterate S S F)->including\<^sub>S\<^sub>e\<^sub>t(a))->including\<^sub>S\<^sub>e\<^sub>t(\<lambda>(_:: '\<AA> st). x)) (((UML_Set.OclIterate S S F)->including\<^sub>S\<^sub>e\<^sub>t(a))->including\<^sub>S\<^sub>e\<^sub>t(\<lambda>(_:: '\<AA> st). x)) F)->including\<^sub>S\<^sub>e\<^sub>t(\<lambda>(_:: '\<AA> st). y) \<tau> = - (UML_Set.OclIterate (((UML_Set.OclIterate S S F)->including\<^sub>S\<^sub>e\<^sub>t(a))->including\<^sub>S\<^sub>e\<^sub>t(\<lambda>(_:: '\<AA> st). y)) (((UML_Set.OclIterate S S F)->including\<^sub>S\<^sub>e\<^sub>t(a))->including\<^sub>S\<^sub>e\<^sub>t(\<lambda>(_:: '\<AA> st). y)) F)->including\<^sub>S\<^sub>e\<^sub>t(\<lambda>(_:: '\<AA> st). x) \<tau>) \<Longrightarrow> - is_int a \<Longrightarrow> - EQ_comp_fun_commute0 (\<lambda>x r1. (((r1 ->iterate\<^sub>S\<^sub>e\<^sub>t(j;r2=r1 | F j r2))->including\<^sub>S\<^sub>e\<^sub>t(a))->including\<^sub>S\<^sub>e\<^sub>t(\<lambda>(_:: '\<AA> st). x)))" - assumes including_out0 : "\<And>(S:: ('\<AA>, 'a option option) Set) a. (\<And>\<tau>. all_defined \<tau> S) \<Longrightarrow> - (\<And>\<tau> \<tau>'. S \<tau> = S \<tau>') \<Longrightarrow> (\<And>\<tau>. \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil> \<noteq> {}) \<Longrightarrow> is_int a \<Longrightarrow> (S ->iterate\<^sub>S\<^sub>e\<^sub>t(x;acc=Set{a} | acc->including\<^sub>S\<^sub>e\<^sub>t(x))) = S->including\<^sub>S\<^sub>e\<^sub>t(a)" - assumes including_out1 : "\<And>(S:: ('\<AA>, 'a option option) Set) A i \<tau>. (\<And>\<tau>. all_defined \<tau> S) \<Longrightarrow> - (\<And>\<tau>. all_defined \<tau> A) \<Longrightarrow> - is_int i \<Longrightarrow> - \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil> \<noteq> {} \<Longrightarrow> (S ->iterate\<^sub>S\<^sub>e\<^sub>t(x;acc=A | acc->including\<^sub>S\<^sub>e\<^sub>t(x)->including\<^sub>S\<^sub>e\<^sub>t(i))) \<tau> = S ->iterate\<^sub>S\<^sub>e\<^sub>t(x;acc=A | acc->including\<^sub>S\<^sub>e\<^sub>t(x))->including\<^sub>S\<^sub>e\<^sub>t(i) \<tau>" - assumes including_out2 : "\<And>S A i x0 \<tau>. - (\<And>\<tau>. all_defined \<tau> (S :: ('\<AA>, 'a option option) Set)) \<Longrightarrow> - (\<And>\<tau>. all_defined \<tau> A) \<Longrightarrow> - is_int i \<Longrightarrow> - is_int x0 \<Longrightarrow> - \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil> \<noteq> {} \<Longrightarrow> (S->iterate\<^sub>S\<^sub>e\<^sub>t(x;acc=A | acc->including\<^sub>S\<^sub>e\<^sub>t(x0)->including\<^sub>S\<^sub>e\<^sub>t(x)->including\<^sub>S\<^sub>e\<^sub>t(i))) \<tau> = (S->iterate\<^sub>S\<^sub>e\<^sub>t(x;acc=A | acc->including\<^sub>S\<^sub>e\<^sub>t(x0)->including\<^sub>S\<^sub>e\<^sub>t(x))->including\<^sub>S\<^sub>e\<^sub>t(i)) \<tau>" - shows - "(\<tau>:: '\<AA> st) \<Turnstile> (Set{ six,eight } ->iterate\<^sub>S\<^sub>e\<^sub>t(i;r1=Set{nine}| - r1->iterate\<^sub>S\<^sub>e\<^sub>t(j;r2=r1| - r2->including\<^sub>S\<^sub>e\<^sub>t(zero)->including\<^sub>S\<^sub>e\<^sub>t(i)->including\<^sub>S\<^sub>e\<^sub>t(j)))) \<doteq> Set{zero, six, eight, nine}" -proof - - - have all_defined_68 : "\<And>\<tau>. all_defined \<tau> Set{six, eight}" - apply(rule cons_all_def)+ - apply(simp add: all_defined_def all_defined_set'_def mtSet_def Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inverse mtSet_defined[simplified mtSet_def]) - apply(simp)+ - done - have all_defined_9 : "\<And>\<tau>. all_defined \<tau> Set{nine}" - apply(rule cons_all_def)+ - apply(simp add: all_defined_def all_defined_set'_def mtSet_def Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inverse mtSet_defined[simplified mtSet_def]) - apply(simp)+ - done - - have all_defined1 : "\<And>r2 \<tau>. all_defined \<tau> r2 \<Longrightarrow> \<tau> \<Turnstile> \<delta> r2" by(simp add: all_defined_def) - - have commute8: "EQ_comp_fun_commute (\<lambda>x acc. acc->including\<^sub>S\<^sub>e\<^sub>t(zero)->including\<^sub>S\<^sub>e\<^sub>t(x))" apply(rule including_commute3) by (simp add: OclInt0_int) - have commute7: "EQ_comp_fun_commute (\<lambda>x acc. acc->including\<^sub>S\<^sub>e\<^sub>t(x)->including\<^sub>S\<^sub>e\<^sub>t(zero))" apply(rule including_commute2) by (simp add: OclInt0_int) - have commute4: "\<And>x acc. is_int x \<Longrightarrow> EQ_comp_fun_commute (\<lambda>xa acc. acc->including\<^sub>S\<^sub>e\<^sub>t(zero)->including\<^sub>S\<^sub>e\<^sub>t(xa)->including\<^sub>S\<^sub>e\<^sub>t(x))" apply(rule including_commute4) by(simp add: OclInt0_int, blast) - have commute3: "\<And>x acc. is_int x \<Longrightarrow> EQ_comp_fun_commute (\<lambda>xa acc. acc->including\<^sub>S\<^sub>e\<^sub>t(zero)->including\<^sub>S\<^sub>e\<^sub>t(x)->including\<^sub>S\<^sub>e\<^sub>t(xa))" apply(rule including_commute6) by(simp add: OclInt0_int, blast) - - have swap1 : "\<And>(S:: ('\<AA>, _) Set) y x. - is_int x \<Longrightarrow> - is_int y \<Longrightarrow> - \<forall>\<tau>. all_defined \<tau> S \<Longrightarrow> - ((((S->including\<^sub>S\<^sub>e\<^sub>t(zero))->including\<^sub>S\<^sub>e\<^sub>t(x))->including\<^sub>S\<^sub>e\<^sub>t(zero))->including\<^sub>S\<^sub>e\<^sub>t(y)) = - ((((S->including\<^sub>S\<^sub>e\<^sub>t(zero))->including\<^sub>S\<^sub>e\<^sub>t(y))->including\<^sub>S\<^sub>e\<^sub>t(zero))->including\<^sub>S\<^sub>e\<^sub>t(x))" - by simp - - have commute5: "EQ_comp_fun_commute0 (\<lambda>x r1. r1 ->iterate\<^sub>S\<^sub>e\<^sub>t(j;r2=r1 | r2->including\<^sub>S\<^sub>e\<^sub>t(zero)->including\<^sub>S\<^sub>e\<^sub>t(j))->including\<^sub>S\<^sub>e\<^sub>t(\<lambda>(_:: '\<AA> st). x))" - apply(rule iterate_including_commute, rule commute8[THEN c0_of_c]) - apply(rule ext, rename_tac \<tau>) - apply(subst (1 2) UML_Set.OclIncluding.cp0) - apply(subst iterate_including_id_out) - apply (metis cons_all_def' is_int_def mtSet_all_def) - apply(simp add: OclInt0_int) - apply (metis including_notempty' is_int_def) - apply(rule sym, subst UML_Set.OclIncluding.cp0) - apply(subst iterate_including_id_out) - apply (metis cons_all_def' is_int_def mtSet_all_def) - apply(simp add: OclInt0_int) - apply (metis including_notempty' is_int_def) - (* *) - apply(subst (1 2) UML_Set.OclIncluding.cp0[symmetric], simp) - - (* *) - apply(subst (1 2) UML_Set.OclIncluding.cp0) - apply(subst (1 2) cp_OclIterate1[OF including_commute3[THEN c0_of_c, THEN c0'_of_c0]], simp add: OclInt0_int) - apply(rule cons_all_def') apply(rule i_cons_all_def) apply(rule including_commute3[THEN c0_of_c], simp add: OclInt0_int, blast, simp add: int_is_valid) - apply(rule cons_all_def') apply(rule i_cons_all_def) apply(rule including_commute3[THEN c0_of_c], simp add: OclInt0_int, blast, simp add: int_is_valid) - apply(subst (1 2 3 4 5 6) UML_Set.OclIncluding.cp0) - - apply(subst (1 2 3 4 5) iterate_including_id_out) - - apply(metis surj_pair, simp add: OclInt0_int, simp) - apply(subst UML_Set.OclIncluding.cp0[symmetric], rule cp_all_def[THEN iffD1]) - apply(rule cons_all_def', rule i_cons_all_def, rule commute8[THEN c0_of_c], metis surj_pair, simp add: int_is_valid, simp add: OclInt0_int) - - apply(rule including_notempty) - apply(rule all_defined1, rule cp_all_def[THEN iffD1], rule i_cons_all_def, rule commute8[THEN c0_of_c], metis surj_pair, simp add: int_is_valid, simp add: OclInt0_int) - apply(rule iterate_notempty, rule commute7[THEN c0_of_c], metis surj_pair, simp add: int_is_valid, simp add: OclInt0_int) - apply(subst UML_Set.OclIncluding.cp0[symmetric], rule cp_all_def[THEN iffD1]) apply(rule cons_all_def)+ apply(metis surj_pair, simp add: OclInt0_int, simp add: int_is_valid) - apply(rule including_notempty, rule all_defined1, rule cp_all_def[THEN iffD1]) apply(rule cons_all_def)+ apply(metis surj_pair, simp add: OclInt0_int, simp add: int_is_valid) - apply(rule including_notempty, rule all_defined1) apply(metis surj_pair, simp add: OclInt0_int, simp add: int_is_valid) - - apply(subst (1 2 3 4 5 6 7 8) UML_Set.OclIncluding.cp0) - apply(subst (1 2 3 4 5 6 7 8) UML_Set.OclIncluding.cp0[symmetric]) - apply(subst swap1, simp_all) - done - - have commute6: "EQ_comp_fun_commute0 (\<lambda>x r1. r1 ->iterate\<^sub>S\<^sub>e\<^sub>t(j;r2=r1 | r2->including\<^sub>S\<^sub>e\<^sub>t(j)->including\<^sub>S\<^sub>e\<^sub>t(zero))->including\<^sub>S\<^sub>e\<^sub>t(\<lambda>(_:: '\<AA> st). x))" - apply(rule iterate_including_commute, rule commute7[THEN c0_of_c]) - apply(rule ext, rename_tac \<tau>) - apply(subst (1 2) UML_Set.OclIncluding.cp0) - apply(subst iterate_including_id_out') - apply (metis cons_all_def' is_int_def mtSet_all_def) - apply(simp add: OclInt0_int) - apply (metis including_notempty' is_int_def) - apply(rule sym, subst UML_Set.OclIncluding.cp0) - apply(subst iterate_including_id_out') - apply (metis cons_all_def' is_int_def mtSet_all_def) - apply(simp add: OclInt0_int) - apply (metis including_notempty' is_int_def) - (* *) - apply(subst (1 2) UML_Set.OclIncluding.cp0[symmetric], simp) - (* *) - apply(subst (1 2) UML_Set.OclIncluding.cp0) - apply(subst (1 2) cp_OclIterate1[OF including_commute2[THEN c0_of_c, THEN c0'_of_c0]], simp add: OclInt0_int) - apply(rule cons_all_def') apply(rule i_cons_all_def) apply(rule including_commute2[THEN c0_of_c], simp add: OclInt0_int, blast, simp add: int_is_valid) - apply(rule cons_all_def') apply(rule i_cons_all_def) apply(rule including_commute2[THEN c0_of_c], simp add: OclInt0_int, blast, simp add: int_is_valid) - apply(subst (1 2 3 4 5 6) UML_Set.OclIncluding.cp0) - - apply(subst (1 2 3 4 5) iterate_including_id_out') - - apply(metis surj_pair, simp add: OclInt0_int, simp) - apply(subst UML_Set.OclIncluding.cp0[symmetric], rule cp_all_def[THEN iffD1]) - apply(rule cons_all_def', rule i_cons_all_def, rule commute7[THEN c0_of_c], metis surj_pair, simp add: int_is_valid, simp add: OclInt0_int) - - apply(rule including_notempty) - apply(rule all_defined1, rule cp_all_def[THEN iffD1], rule i_cons_all_def, rule commute7[THEN c0_of_c], metis surj_pair, simp add: int_is_valid, simp add: OclInt0_int) - apply(rule iterate_notempty, rule commute7[THEN c0_of_c], metis surj_pair, simp add: int_is_valid, simp add: OclInt0_int) - apply(subst UML_Set.OclIncluding.cp0[symmetric], rule cp_all_def[THEN iffD1]) apply(rule cons_all_def)+ apply(metis surj_pair, simp add: OclInt0_int, simp add: int_is_valid) - apply(rule including_notempty, rule all_defined1, rule cp_all_def[THEN iffD1]) apply(rule cons_all_def)+ apply(metis surj_pair, simp add: OclInt0_int, simp add: int_is_valid) - apply(rule including_notempty, rule all_defined1) apply(metis surj_pair, simp add: OclInt0_int, simp add: int_is_valid) - - apply(subst (1 2 3 4 5 6 7 8) UML_Set.OclIncluding.cp0) - apply(subst (1 2 3 4 5 6 7 8) UML_Set.OclIncluding.cp0[symmetric]) - apply(subst swap1, simp_all) - done - - have commute9: "EQ_comp_fun_commute0 (\<lambda>x r1. r1 ->iterate\<^sub>S\<^sub>e\<^sub>t(j;r2=r1 | r2->including\<^sub>S\<^sub>e\<^sub>t(j))->including\<^sub>S\<^sub>e\<^sub>t(zero)->including\<^sub>S\<^sub>e\<^sub>t(\<lambda>_. x))" - apply(rule iterate_including_commute_var, rule including_commute[THEN c0_of_c]) - apply(rule ext, rename_tac \<tau>) - apply(subst (1 2) UML_Set.OclIncluding.cp0) - apply(subst (1 2) iterate_including_id) - apply (metis OclInt0_int cons_all_def' is_int_def mtSet_all_def) - apply (metis OclInt0_int cons_all_def' is_int_def mtSet_all_def) - - apply(subst (1 2) UML_Set.OclIncluding.cp0[symmetric], simp) - (* *) - apply(subst (1 2) UML_Set.OclIncluding.cp0) - apply(subst (1 2) cp_OclIterate1, rule including_commute[THEN c0_of_c, THEN c0'_of_c0]) - apply(rule cons_all_def')+ apply(rule i_cons_all_def) apply(rule including_commute[THEN c0_of_c], blast, simp, simp add: int_is_valid) - apply(rule cons_all_def')+ apply(rule i_cons_all_def) apply(rule including_commute[THEN c0_of_c], blast, simp, simp add: int_is_valid) - apply(subst (1 2 3 4 5 6) UML_Set.OclIncluding.cp0) - - - apply(subst (1 2 3 4 5 6) UML_Set.OclIncluding.cp0) - apply(subst (1 2 3 4 5 6 7 8 9 10) UML_Set.OclIncluding.cp0) - apply(subst (1 2 3 4 5) iterate_including_id) - - apply(metis surj_pair) - apply(subst (1 2) UML_Set.OclIncluding.cp0[symmetric], rule cp_all_def[THEN iffD1]) - apply(rule cons_all_def', rule cons_all_def', rule i_cons_all_def, rule including_commute[THEN c0_of_c], metis surj_pair) apply(simp add: int_is_valid)+ - apply(subst (1 2) UML_Set.OclIncluding.cp0[symmetric], rule cp_all_def[THEN iffD1]) - apply(rule cons_all_def', rule cons_all_def', metis surj_pair) apply(simp add: int_is_valid)+ apply(metis surj_pair) - - apply(subst (1 2 3 4 5 6) UML_Set.OclIncluding.cp0) - apply(subst (1 2 3 4 5 6) UML_Set.OclIncluding.cp0[symmetric]) - apply(simp add: int_is_valid OclInt0_int)+ - done - - have commute1: "EQ_comp_fun_commute0' (\<lambda>x r1. r1 ->iterate\<^sub>S\<^sub>e\<^sub>t(j;r2=r1 | r2->including\<^sub>S\<^sub>e\<^sub>t(zero)->including\<^sub>S\<^sub>e\<^sub>t(\<lambda>(_:: '\<AA> st). \<lfloor>x\<rfloor>)->including\<^sub>S\<^sub>e\<^sub>t(j)))" - apply(rule iterate_commute') - apply(rule including_commute6[THEN c0_of_c, THEN c0'_of_c0], simp add: OclInt0_int, simp add: int_trivial) - apply(subst (1 2) cp_OclIterate1) - apply(rule including_commute6[THEN c0_of_c, THEN c0'_of_c0], simp add: OclInt0_int, simp) apply(rule i_cons_all_def) apply(rule including_commute6[THEN c0_of_c], simp add: OclInt0_int, simp, blast) - apply(rule including_commute6[THEN c0_of_c, THEN c0'_of_c0], simp add: OclInt0_int, simp) apply(rule i_cons_all_def) apply(rule including_commute6[THEN c0_of_c], simp add: OclInt0_int, simp, blast) - apply(subst (1 2 3 4 5) iterate_including_id_out''') - apply(simp_all add: OclInt0_int) - apply(metis surj_pair) - apply(subst cp_all_def[symmetric]) - apply(rule i_cons_all_def) - apply(rule including_commute5[THEN c0_of_c], simp add: OclInt0_int, simp add: OclInt0_int) - apply(metis surj_pair) - apply(rule iterate_notempty) - apply(rule including_commute5[THEN c0_of_c], simp, simp add: OclInt0_int) - apply(metis surj_pair) - apply(simp) - apply(subst cp_all_def[symmetric]) - apply(rule cons_all_def')+ - apply(metis surj_pair) - apply(simp add: int_is_valid)+ - apply(rule including_notempty) - apply(rule all_defined1) - apply(rule cons_all_def')+ - apply(metis surj_pair) - apply(simp add: int_is_valid)+ - apply(rule including_notempty) - apply(rule all_defined1) - apply(metis surj_pair) - apply(simp add: int_is_valid)+ - apply(subst (1 2 3 4) UML_Set.OclIncluding.cp0) - apply(subst (1 2 3 4 5 6 7 8) UML_Set.OclIncluding.cp0) - apply(subst (1 2 3 4 5 6 7 8) UML_Set.OclIncluding.cp0[symmetric]) - apply(subst swap1, simp_all) - done - - have commute2: "EQ_comp_fun_commute0' (\<lambda>x r1. r1 ->iterate\<^sub>S\<^sub>e\<^sub>t(j;r2=r1 | r2->including\<^sub>S\<^sub>e\<^sub>t(zero)->including\<^sub>S\<^sub>e\<^sub>t(j)->including\<^sub>S\<^sub>e\<^sub>t(\<lambda>(_:: '\<AA> st). \<lfloor>x\<rfloor>)))" - apply(rule iterate_commute') - apply(rule including_commute4[THEN c0_of_c, THEN c0'_of_c0], simp add: OclInt0_int, simp add: int_trivial) - apply(subst (1 2) cp_OclIterate1) - apply(rule including_commute4[THEN c0_of_c, THEN c0'_of_c0], simp add: OclInt0_int, simp) apply(rule i_cons_all_def) apply(rule including_commute4[THEN c0_of_c], simp add: OclInt0_int, simp, blast) - apply(rule including_commute4[THEN c0_of_c, THEN c0'_of_c0], simp add: OclInt0_int, simp) apply(rule i_cons_all_def) apply(rule including_commute4[THEN c0_of_c], simp add: OclInt0_int, simp, blast) - apply(subst (1 2 3 4 5) iterate_including_id_out'''') - apply(simp_all add: OclInt0_int) - apply(metis surj_pair) - apply(subst cp_all_def[symmetric]) - apply(rule i_cons_all_def) - apply(rule including_commute5[THEN c0_of_c], simp, simp add: OclInt0_int) - apply(metis surj_pair) - apply(rule iterate_notempty) - apply(rule including_commute5[THEN c0_of_c], simp, simp add: OclInt0_int) - apply(metis surj_pair) - apply(simp) - apply(subst cp_all_def[symmetric]) - apply(rule cons_all_def')+ - apply(metis surj_pair) - apply(simp add: int_is_valid)+ - apply(rule including_notempty) - apply(rule all_defined1) - apply(rule cons_all_def')+ - apply(metis surj_pair) - apply(simp add: int_is_valid)+ - apply(rule including_notempty) - apply(rule all_defined1) - apply(metis surj_pair) - apply(simp add: int_is_valid)+ - apply(subst (1 2 3 4) UML_Set.OclIncluding.cp0) - apply(subst (1 2 3 4 5 6 7 8) UML_Set.OclIncluding.cp0) - apply(subst (1 2 3 4 5 6 7 8) UML_Set.OclIncluding.cp0[symmetric]) - apply(subst swap1, simp_all) - done - - have set68_notempty : "\<And>(\<tau>:: '\<AA> st). \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (Set{six, eight} \<tau>)\<rceil>\<rceil> \<noteq> {}" - apply(rule including_notempty) - apply(simp add: mtSet_all_def) - apply(simp add: int_is_valid) - apply(rule including_notempty') - by(simp add: int_is_valid) - have set9_notempty : "\<And>(\<tau>:: '\<AA> st). \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (Set{nine} \<tau>)\<rceil>\<rceil> \<noteq> {}" - apply(rule including_notempty') - by(simp add: int_is_valid) - have set68_cp : "\<And>(\<tau>:: '\<AA> st) (\<tau>':: '\<AA> st). Set{six, eight} \<tau> = Set{six, eight} \<tau>'" - apply(rule including_cp_all) apply(simp add: OclInt6_int) apply(simp add: mtSet_all_def) - apply(rule including_cp_all) apply(simp add: OclInt8_int) apply(simp add: mtSet_all_def) - by (simp add: mtSet_def) - have set9_cp : "\<And>(\<tau>1:: '\<AA> st) (\<tau>2:: '\<AA> st). Set{nine} \<tau>1 = Set{nine} \<tau>2" - apply(rule including_cp_all) apply(simp add: OclInt9_int) apply(simp add: mtSet_all_def) - by (simp add: mtSet_def) - - note iterate_subst_set___ = iterate_subst_set___[OF all_defined_68 all_defined_9 set9_cp _ _ _ set9_notempty] - note iterate_subst_set''0 = iterate_subst_set''0[OF all_defined_68 all_defined_9 _ _ _ set9_notempty] - note iterate_subst_set'0 = iterate_subst_set'0[OF all_defined_68 all_defined_9 set9_cp] - - have GogollasChallenge_on_sets: - "(Set{ six,eight } ->iterate\<^sub>S\<^sub>e\<^sub>t(i;r1=Set{nine}| - r1->iterate\<^sub>S\<^sub>e\<^sub>t(j;r2=r1| - r2->including\<^sub>S\<^sub>e\<^sub>t(zero)->including\<^sub>S\<^sub>e\<^sub>t(i)->including\<^sub>S\<^sub>e\<^sub>t(j)))) \<tau> = Set{zero, six, eight, nine} \<tau>" - (* *) - apply(subst iterate_subst_set___[where G = "\<lambda>i r1. r1 ->iterate\<^sub>S\<^sub>e\<^sub>t(j;r2=r1 | r2->including\<^sub>S\<^sub>e\<^sub>t(zero)->including\<^sub>S\<^sub>e\<^sub>t(j)->including\<^sub>S\<^sub>e\<^sub>t(i))"]) - apply(simp add: commute1 del: OclIncluding_commute, simp add: commute2 del: OclIncluding_commute) - apply(subst iterate_subst_set[where G = "\<lambda>j r2. r2->including\<^sub>S\<^sub>e\<^sub>t(zero)->including\<^sub>S\<^sub>e\<^sub>t(j)->including\<^sub>S\<^sub>e\<^sub>t(\<lambda>_. \<lfloor>x\<rfloor>)"]) apply(blast)+ - apply(simp add: commute3 del: OclIncluding_commute, simp add: commute4 del: OclIncluding_commute) - apply(simp) - apply(simp add: int_is_valid del: OclIncluding_commute)+ - (* *) - apply(subst iterate_subst_set___[where G = "\<lambda>i r1. r1 ->iterate\<^sub>S\<^sub>e\<^sub>t(j;r2=r1 | r2->including\<^sub>S\<^sub>e\<^sub>t(zero)->including\<^sub>S\<^sub>e\<^sub>t(j))->including\<^sub>S\<^sub>e\<^sub>t(i)"]) - apply(simp add: commute2 del: OclIncluding_commute, simp add: commute5[THEN c0'_of_c0] del: OclIncluding_commute) - apply(rule including_out2) - apply(blast) apply(blast) apply(blast) apply(simp add: OclInt0_int) apply(simp) - (* *) - apply(subst iterate_subst_set___[where G = "\<lambda>i r1. r1 ->iterate\<^sub>S\<^sub>e\<^sub>t(j;r2=r1 | r2->including\<^sub>S\<^sub>e\<^sub>t(j)->including\<^sub>S\<^sub>e\<^sub>t(zero))->including\<^sub>S\<^sub>e\<^sub>t(i)"]) - apply(simp add: commute5[THEN c0'_of_c0] del: OclIncluding_commute, simp add: commute6[THEN c0'_of_c0] del: OclIncluding_commute) - apply(rule including_subst_set'') - apply(rule all_defined1, rule i_cons_all_def, rule including_commute3[THEN c0_of_c], simp add: OclInt0_int, blast) - apply(rule all_defined1, rule i_cons_all_def, rule including_commute2[THEN c0_of_c], simp add: OclInt0_int, blast) - apply(simp add: int_is_valid) - apply(subst iterate_subst_set[where G = "\<lambda>j r2. r2->including\<^sub>S\<^sub>e\<^sub>t(j)->including\<^sub>S\<^sub>e\<^sub>t(zero)"]) apply(blast)+ - apply(simp add: commute8 del: OclIncluding_commute, simp add: commute7 del: OclIncluding_commute) - apply(simp) - apply(simp add: all_defined1) - (* *) - apply(subst iterate_subst_set''0[where G = "\<lambda>i r1. r1 ->iterate\<^sub>S\<^sub>e\<^sub>t(j;r2=r1 | r2->including\<^sub>S\<^sub>e\<^sub>t(j))->including\<^sub>S\<^sub>e\<^sub>t(zero)->including\<^sub>S\<^sub>e\<^sub>t(i)"]) - apply(simp add: commute6, simp add: commute9) - apply(rule including_subst_set'') - apply(rule all_defined1) apply(rule i_cons_all_def, rule including_commute2[THEN c0_of_c], simp add: OclInt0_int, blast) - apply(rule all_defined1) apply(rule cons_all_def, rule i_cons_all_def, rule including_commute[THEN c0_of_c], blast, simp, simp add: int_is_valid) - apply(rule including_out1) - apply(blast) apply(blast) apply(simp add: OclInt0_int) apply(simp) - (* *) - apply(subst iterate_subst_set'0[where G = "\<lambda>i r1. r1->including\<^sub>S\<^sub>e\<^sub>t(zero)->including\<^sub>S\<^sub>e\<^sub>t(i)"]) - apply(simp add: commute9, simp add: commute8[THEN c0_of_c]) - apply(rule including_subst_set)+ - apply(rule iterate_including_id) apply(blast)+ - (* *) - apply(subst iterate_subst_set[where G = "\<lambda>i r1. r1->including\<^sub>S\<^sub>e\<^sub>t(i)->including\<^sub>S\<^sub>e\<^sub>t(zero)"]) - apply(simp add: all_defined_68, simp add: all_defined_9, simp add: commute8 del: OclIncluding_commute, simp add: commute7 del: OclIncluding_commute) - apply(simp) - (* *) - apply(subst including_out1[OF all_defined_68 all_defined_9 OclInt0_int set68_notempty]) - (* *) - apply(rule including_subst_set'') - apply(rule all_defined1, rule i_cons_all_def'', rule including_commute[THEN c0_of_c, THEN c0'_of_c0], simp add: all_defined_68, simp add: all_defined_9) - apply (metis "UML_Set.OclIncluding.1" OclANY_singleton_exec OclANY_valid_args_valid'' OclInt6_int OclInt8_int OclInt9_int UML_Set.OclIncluding.def_valid_then_def int_is_valid) - apply(simp) - (* *) - apply(subst including_out0[OF all_defined_68 set68_cp set68_notempty OclInt9_int]) - (* *) - by(simp) - - have valid_1 : "\<tau> \<Turnstile> \<upsilon> (Set{ six,eight } ->iterate\<^sub>S\<^sub>e\<^sub>t(i;r1=Set{nine}| - r1->iterate\<^sub>S\<^sub>e\<^sub>t(j;r2=r1| - r2->including\<^sub>S\<^sub>e\<^sub>t(zero)->including\<^sub>S\<^sub>e\<^sub>t(i)->including\<^sub>S\<^sub>e\<^sub>t(j))))" - by(rule foundation20, rule all_defined1, rule i_cons_all_def'', rule commute1, rule all_defined_68, rule all_defined_9) - - have valid_2 : "\<tau> \<Turnstile> \<upsilon> Set{zero, six, eight, nine}" - apply(rule foundation20, rule all_defined1) apply(rule cons_all_def)+ - apply(simp_all add: mtSet_all_def) - done - - show ?thesis - apply(simp only: StrictRefEq\<^sub>S\<^sub>e\<^sub>t OclValid_def StrongEq_def valid_1[simplified OclValid_def] valid_2[simplified OclValid_def] del: OclIncluding_commute) - apply(simp add: GogollasChallenge_on_sets true_def del: OclIncluding_commute) - done -qed - -section{* OCL lib (continued) *} (* OCL_lib *) - -lemma OclSelect_body_commute : - shows "comp_fun_commute (OclSelect_body (P::(('\<AA> state \<times> '\<AA> state \<Rightarrow> 'a option option) - \<Rightarrow> '\<AA> state \<times> '\<AA> state \<Rightarrow> bool option option)))" -proof - - have cp_OclIncluding1: "\<And>x S \<tau>. S->including\<^sub>S\<^sub>e\<^sub>t(x) \<tau> = \<lambda>_. S \<tau>->including\<^sub>S\<^sub>e\<^sub>t(x) \<tau>" - by(simp only: UML_Set.OclIncluding_def, subst cp_defined, simp) - show ?thesis - apply(simp add: OclSelect_body_def) - apply(rule if_commute_gen_var_gen) - apply(rule including_commute0_generic) - apply(simp add: comp_fun_commute_def)+ - apply(rule cp_OclIncluding1) - by(simp)+ -qed - -lemma select_iterate: - assumes OclSelect_body_commute : "comp_fun_commute (OclSelect_body (P::(('\<AA> state \<times> '\<AA> state \<Rightarrow> 'a option option) - \<Rightarrow> '\<AA> state \<times> '\<AA> state \<Rightarrow> bool option option)))" - assumes S_finite: "finite \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil>" - and P_strict: "\<And>x. x \<tau> = \<bottom> \<Longrightarrow> (P x) \<tau> = \<bottom>" - shows "UML_Set.OclSelect S P \<tau> = (S->iterate\<^sub>S\<^sub>e\<^sub>t(x; acc = Set{} | OclSelect_body P x acc)) \<tau>" -proof - - have ex_insert : "\<And>x F P. (\<exists>x\<in>insert x F. P x) = (P x \<or> (\<exists>x\<in>F. P x))" - by (metis insert_iff) - - have insert_set : "\<And>s P S. \<not> P s \<Longrightarrow> {x \<in> insert s S. P x} = {x \<in> S. P x}" - by (metis (mono_tags) insert_iff) - - have inj : "\<And>x F. x \<notin> F \<Longrightarrow> (\<lambda>\<tau>. x) \<notin> (\<lambda>a \<tau>. a) ` F" - by (metis image_iff) - - have valid_inject_true : "\<And>\<tau> P. (\<upsilon> P) \<tau> \<noteq> true \<tau> \<Longrightarrow> (\<upsilon> P) \<tau> = false \<tau>" - apply(simp add: valid_def true_def false_def bot_fun_def bot_option_def - null_fun_def null_option_def) - by (case_tac "P \<tau> = \<bottom>", simp_all add: true_def) - - have defined_inject_true : "\<And>\<tau> P. (\<delta> P) \<tau> \<noteq> true \<tau> \<Longrightarrow> (\<delta> P) \<tau> = false \<tau>" - apply(simp add: defined_def true_def false_def bot_fun_def bot_option_def - null_fun_def null_option_def) - by (case_tac " P \<tau> = \<bottom> \<or> P \<tau> = null", simp_all add: true_def) - - have not_strongeq : "\<And>P. P \<tau> \<noteq> invalid \<tau> \<Longrightarrow> \<not> \<tau> \<Turnstile> P \<doteq> false \<Longrightarrow> (P \<doteq> false) \<tau> = false \<tau>" - by (metis (hide_lams, no_types) OclValid_def StrictRefEq\<^sub>B\<^sub>o\<^sub>o\<^sub>l\<^sub>e\<^sub>a\<^sub>n.defined_args_valid bool_split_0 foundation1 foundation16 foundation18 invalid_def null_fun_def valid4) - - - show ?thesis - apply(simp add: OclSelect_body_def) - apply(simp only: UML_Set.OclSelect_def UML_Set.OclIterate_def) - apply(case_tac "\<tau> \<Turnstile> \<delta> S", simp only: OclValid_def) - apply(subgoal_tac "(if \<exists>x\<in>\<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil>. P (\<lambda>_. x) \<tau> = invalid \<tau> then invalid \<tau> - else Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e \<lfloor>\<lfloor>{x \<in> \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil>. P (\<lambda>_. x) \<tau> \<noteq> false \<tau>}\<rfloor>\<rfloor>) = - Finite_Set.fold (OclSelect_body P) Set{} - ((\<lambda>a \<tau>. a) ` \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil>) \<tau>", - simp add: S_finite) - apply(rule finite_induct[where P = "\<lambda>set. (if \<exists>x\<in>set. P (\<lambda>_. x) \<tau> = invalid \<tau> then invalid \<tau> - else Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e \<lfloor>\<lfloor>{x \<in> set. P (\<lambda>_. x) \<tau> \<noteq> false \<tau>}\<rfloor>\<rfloor>) = - Finite_Set.fold (OclSelect_body P) Set{} - ((\<lambda>a \<tau>. a) ` set) \<tau>", OF S_finite]) - apply(simp add: mtSet_def) - (* *) - apply(simp only: image_insert) - apply(subst comp_fun_commute.fold_insert[OF OclSelect_body_commute], simp) - apply(rule inj, fast) - - apply(simp only: OclSelect_body_def) - apply(simp only: ex_insert) - apply(subst cp_OclIf) - apply(case_tac "\<not> ((\<upsilon> (P (\<lambda>_. x))) \<tau> = true \<tau>)") - apply(drule valid_inject_true) - apply(subgoal_tac "P (\<lambda>_. x) \<tau> = invalid \<tau>", simp add: cp_OclIf[symmetric], simp add: bot_fun_def invalid_def) - apply(simp add: OclIf_def StrictRefEq\<^sub>B\<^sub>o\<^sub>o\<^sub>l\<^sub>e\<^sub>a\<^sub>n false_def true_def invalid_def bot_option_def StrongEq_def defined_def bot_Boolean_def) - apply (metis bot_fun_def OclValid_def foundation2 valid_def invalid_def) - - apply(subst cp_OclIf) - apply(subgoal_tac "P (\<lambda>_. x) \<tau> \<noteq> invalid \<tau>") - prefer 2 - apply (metis bot_fun_def OclValid_def foundation2 valid_def invalid_def) - - apply(case_tac "\<tau> \<Turnstile> (P (\<lambda>_. x) \<doteq> false)") - apply(subst insert_set, simp add: StrictRefEq\<^sub>B\<^sub>o\<^sub>o\<^sub>l\<^sub>e\<^sub>a\<^sub>n OclValid_def, metis OclValid_def foundation22) - - apply(simp add: cp_OclIf[symmetric]) - (* *) - apply(subst not_strongeq, simp, simp) - - apply(simp add: cp_OclIf[symmetric]) - apply(drule sym, drule sym) (* SYM 1/2 *) - apply(subst (1 2) UML_Set.OclIncluding.cp0) - apply(subgoal_tac "((\<lambda>_. Finite_Set.fold (OclSelect_body P) Set{} ((\<lambda>a \<tau>. a) ` F) \<tau>)->including\<^sub>S\<^sub>e\<^sub>t(\<lambda>\<tau>. x)) \<tau> - = - ((\<lambda>_. if \<exists>x\<in>F. P (\<lambda>_. x) \<tau> = invalid \<tau> then invalid \<tau> else Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e \<lfloor>\<lfloor>{x \<in> F. P (\<lambda>_. x) \<tau> \<noteq> false \<tau>}\<rfloor>\<rfloor>)->including\<^sub>S\<^sub>e\<^sub>t(\<lambda>\<tau>. x)) \<tau>") - prefer 2 - apply(simp add: OclSelect_body_def) - apply(simp add: ) - - apply(rule conjI) - apply (metis (no_types, lifting) OclValid_def UML_Set.OclIncluding_def defined_def invalid_set_OclNot_defined not_strongeq) - - apply(rule impI, subst UML_Set.OclIncluding_def, subst Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inverse, simp add: bot_option_def null_option_def) - apply(rule allI, rule impI) - apply(subgoal_tac "xa \<noteq> \<bottom>", case_tac xa, simp add: bot_option_def, simp) - apply (metis (no_types) bot_fun_def P_strict invalid_def) - apply(simp) - - apply(drule sym, simp only:, drule sym, simp only:) (* SYM 2/2 *) - apply(subst (1 2) defined_def, simp add: bot_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def null_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def false_def true_def null_fun_def bot_fun_def) - - apply(subgoal_tac "(\<upsilon> (\<lambda>_. x)) \<tau> = \<lfloor>\<lfloor>True\<rfloor>\<rfloor>") - prefer 2 - proof - fix x show "(\<upsilon> P (\<lambda>_. x)) \<tau> = \<lfloor>\<lfloor>True\<rfloor>\<rfloor> \<Longrightarrow> (\<upsilon> (\<lambda>_. x)) \<tau> = \<lfloor>\<lfloor>True\<rfloor>\<rfloor>" - by (metis bot_fun_def P_strict true_def valid_def) - apply_end(subgoal_tac "Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e \<lfloor>\<lfloor>{x \<in> F. P (\<lambda>_. x) \<tau> \<noteq> \<lfloor>\<lfloor>False\<rfloor>\<rfloor>}\<rfloor>\<rfloor> \<noteq> Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e None \<and> Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e \<lfloor>\<lfloor>{x \<in> F. P (\<lambda>_. x) \<tau> \<noteq> \<lfloor>\<lfloor>False\<rfloor>\<rfloor>}\<rfloor>\<rfloor> \<noteq> Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e \<lfloor>None\<rfloor>", simp) - apply_end(subgoal_tac "{xa. (xa = x \<or> xa \<in> F) \<and> P (\<lambda>_. xa) \<tau> \<noteq> \<lfloor>\<lfloor>False\<rfloor>\<rfloor>} = insert x {x \<in> F. P (\<lambda>_. x) \<tau> \<noteq> \<lfloor>\<lfloor>False\<rfloor>\<rfloor>}", simp) - apply_end(rule equalityI) - apply_end(rule subsetI, simp) - apply_end(rule subsetI, simp, simp add: OclValid_def StrictRefEq\<^sub>B\<^sub>o\<^sub>o\<^sub>l\<^sub>e\<^sub>a\<^sub>n true_def StrongEq_def, blast) - - - fix F - show "Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e \<lfloor>\<lfloor>{x \<in> F. P (\<lambda>_. x) \<tau> \<noteq> \<lfloor>\<lfloor>False\<rfloor>\<rfloor>}\<rfloor>\<rfloor> \<noteq> Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e None \<and> Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e \<lfloor>\<lfloor>{x \<in> F. P (\<lambda>_. x) \<tau> \<noteq> \<lfloor>\<lfloor>False\<rfloor>\<rfloor>}\<rfloor>\<rfloor> \<noteq> Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e \<lfloor>None\<rfloor>" - when "\<forall>x\<in>F. P (\<lambda>_. x) \<tau> \<noteq> \<bottom>" - apply(insert that, subst (1 2) Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inject, simp_all add: bot_option_def null_option_def) - apply(rule allI, rule impI) - proof - fix x show "\<forall>x\<in>F. \<exists>y. P (\<lambda>_. x) \<tau> = \<lfloor>y\<rfloor> \<Longrightarrow> x \<in> F \<and> P (\<lambda>_. x) \<tau> \<noteq> \<lfloor>\<lfloor>False\<rfloor>\<rfloor> \<Longrightarrow> \<exists>y. x = \<lfloor>y\<rfloor>" - apply(case_tac "x = \<bottom>", drule P_strict[where x = "\<lambda>_. x"]) - apply(drule_tac x = x in ballE) prefer 3 apply assumption - apply(simp add: bot_option_def)+ - done - qed - apply_end(simp add: OclValid_def invalid_def)+ - qed -qed - -end diff --git a/Citadelle/examples/archive/OCL_lib_Gogolla_challenge_integer.thy b/Citadelle/examples/archive/OCL_lib_Gogolla_challenge_integer.thy deleted file mode 100644 index 36d82a9727efa693bd9bd289f783917401ae886b..0000000000000000000000000000000000000000 --- a/Citadelle/examples/archive/OCL_lib_Gogolla_challenge_integer.thy +++ /dev/null @@ -1,245 +0,0 @@ -(****************************************************************************** - * 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. - ******************************************************************************) - -chapter{* Gogolla's challenge on Sets *} - -theory - OCL_lib_Gogolla_challenge_integer -imports - OCL_lib_Gogolla_challenge -begin - -section{* Properties: OclIncluding *} -subsection{* Commutativity *} - -lemma including_swap_ : - assumes S_def : "\<tau> \<Turnstile> \<delta> S" - and i_val : "\<tau> \<Turnstile> \<upsilon> i" - and j_val : "\<tau> \<Turnstile> \<upsilon> j" - shows "\<tau> \<Turnstile> ((S :: ('\<AA>, int option option) Set)->including\<^sub>S\<^sub>e\<^sub>t(i)->including\<^sub>S\<^sub>e\<^sub>t(j) \<doteq> (S->including\<^sub>S\<^sub>e\<^sub>t(j)->including\<^sub>S\<^sub>e\<^sub>t(i)))" -by(rule including_swap__generic[OF assms]) - -lemma including_swap' : "\<tau> \<Turnstile> \<delta> S \<Longrightarrow> \<tau> \<Turnstile> \<upsilon> i \<Longrightarrow> \<tau> \<Turnstile> \<upsilon> j \<Longrightarrow> ((S :: ('\<AA>, int option option) Set)->including\<^sub>S\<^sub>e\<^sub>t(i)->including\<^sub>S\<^sub>e\<^sub>t(j) \<tau> = (S->including\<^sub>S\<^sub>e\<^sub>t(j)->including\<^sub>S\<^sub>e\<^sub>t(i)) \<tau>)" -by simp - -lemma including_swap : "\<forall>\<tau>. \<tau> \<Turnstile> \<delta> S \<Longrightarrow> \<forall>\<tau>. \<tau> \<Turnstile> \<upsilon> i \<Longrightarrow> \<forall>\<tau>. \<tau> \<Turnstile> \<upsilon> j \<Longrightarrow> ((S :: ('\<AA>, int option option) Set)->including\<^sub>S\<^sub>e\<^sub>t(i)->including\<^sub>S\<^sub>e\<^sub>t(j) = (S->including\<^sub>S\<^sub>e\<^sub>t(j)->including\<^sub>S\<^sub>e\<^sub>t(i)))" -by simp - -section{* Properties: (with comp fun commute) OclIncluding *} -subsection{* Preservation of comp fun commute (instance) *} - -lemma including_commute : "EQ_comp_fun_commute (\<lambda>j (r2 :: ('\<AA>, int option option) Set). (r2->including\<^sub>S\<^sub>e\<^sub>t(j)))" -by(rule including_commute_generic) - -lemma including_commute2 : - assumes i_int : "is_int i" - shows "EQ_comp_fun_commute (\<lambda>x (acc :: ('\<AA>, int option option) Set). ((acc->including\<^sub>S\<^sub>e\<^sub>t(x))->including\<^sub>S\<^sub>e\<^sub>t(i)))" -by(rule including_commute2_generic, simp_all add: assms) - -lemma including_commute3 : - assumes i_int : "is_int i" - shows "EQ_comp_fun_commute (\<lambda>x (acc :: ('\<AA>, int option option) Set). acc->including\<^sub>S\<^sub>e\<^sub>t(i)->including\<^sub>S\<^sub>e\<^sub>t(x))" -by(rule including_commute3_generic, simp_all add: assms) - -lemma including_commute4 : - assumes i_int : "is_int i" - and j_int : "is_int j" - shows "EQ_comp_fun_commute (\<lambda>x (acc :: ('\<AA>, int option option) Set). acc->including\<^sub>S\<^sub>e\<^sub>t(i)->including\<^sub>S\<^sub>e\<^sub>t(x)->including\<^sub>S\<^sub>e\<^sub>t(j))" -by(rule including_commute4_generic, simp_all add: assms) - -lemma including_commute5 : - assumes i_int : "is_int i" - and j_int : "is_int j" - shows "EQ_comp_fun_commute (\<lambda>x (acc :: ('\<AA>, int option option) Set). acc->including\<^sub>S\<^sub>e\<^sub>t(x)->including\<^sub>S\<^sub>e\<^sub>t(j)->including\<^sub>S\<^sub>e\<^sub>t(i))" -by(rule including_commute5_generic, simp_all add: assms) - -lemma including_commute6 : - assumes i_int : "is_int i" - and j_int : "is_int j" - shows "EQ_comp_fun_commute (\<lambda>x (acc :: ('\<AA>, int option option) Set). acc->including\<^sub>S\<^sub>e\<^sub>t(i)->including\<^sub>S\<^sub>e\<^sub>t(j)->including\<^sub>S\<^sub>e\<^sub>t(x))" -by(rule including_commute6_generic, simp_all add: assms) - -section{* Properties: (with comp fun commute) OclIterate and OclIncluding *} -subsection{* Identity *} - -lemma i_including_id' : - assumes S_all_def : "\<And>\<tau>. all_defined \<tau> (S :: ('\<AA>, int option option) Set)" - shows "(Finite_Set.fold (\<lambda>j r2. r2->including\<^sub>S\<^sub>e\<^sub>t(j)) S ((\<lambda>a \<tau>. a) ` \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil>)) \<tau> = S \<tau>" -by(rule i_including_id'_generic[OF including_commute], simp_all add: assms) - -lemma iterate_including_id : - assumes S_all_def : "\<And>\<tau>. all_defined \<tau> (S :: ('\<AA>, int option option) Set)" - shows "(S ->iterate\<^sub>S\<^sub>e\<^sub>t(j;r2=S | r2->including\<^sub>S\<^sub>e\<^sub>t(j))) = S" -by(rule iterate_including_id_generic[OF including_commute], simp_all add: assms) - -lemma i_including_id00 : - assumes S_all_int : "\<And>\<tau>. all_int_set ((\<lambda>a (\<tau>:: '\<AA> st). a) ` \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e ((S :: ('\<AA>, int option option) Set) \<tau>)\<rceil>\<rceil>)" - shows "\<And>\<tau>. \<forall>S'. (\<forall>\<tau>. all_defined \<tau> S') \<longrightarrow> (let img = image (\<lambda>a (\<tau>:: '\<AA> st). a) ; set' = img \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil> ; f = (\<lambda>x. x) in - (\<forall>\<tau>. f ` set' = img \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S' \<tau>)\<rceil>\<rceil>) \<longrightarrow> - (Finite_Set.fold (\<lambda>j r2. r2->including\<^sub>S\<^sub>e\<^sub>t(f j)) Set{} set') = S')" -by(rule i_including_id00_generic[OF including_commute], simp_all add: assms) - -lemma iterate_including_id00 : - assumes S_all_def : "\<And>\<tau>. all_defined \<tau> (S :: ('\<AA>, int option option) Set)" - and S_incl : "\<And>\<tau> \<tau>'. S \<tau> = S \<tau>'" - shows "(S->iterate\<^sub>S\<^sub>e\<^sub>t(j;r2=Set{} | r2->including\<^sub>S\<^sub>e\<^sub>t(j))) = S" -by(rule iterate_including_id00_generic[OF including_commute], simp_all add: assms) - -subsection{* all defined (construction) *} - -lemma preserved_defined : - assumes S_all_def : "\<And>\<tau>. all_defined \<tau> (S :: ('\<AA>, int option option) Set)" - and A_all_def : "\<And>\<tau>. all_defined \<tau> (A :: ('\<AA>, int option option) Set)" - shows "let S' = (\<lambda>a \<tau>. a) ` \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil> in - \<forall>\<tau>. all_defined \<tau> (Finite_Set.fold (\<lambda>x acc. (acc->including\<^sub>S\<^sub>e\<^sub>t(x))) A S')" -by(rule preserved_defined_generic[OF including_commute S_all_def], simp_all add: assms) - -subsection{* Preservation of comp fun commute (main) *} - -lemma iterate_including_commute_var : - assumes f_comm : "EQ_comp_fun_commute0 (\<lambda>x. (F :: '\<AA> Integer - \<Rightarrow> ('\<AA>, _) Set - \<Rightarrow> ('\<AA>, _) Set) (\<lambda>_. x))" - and f_empty : "\<And>x y. - is_int (\<lambda>(_:: '\<AA> st). x) \<Longrightarrow> - is_int (\<lambda>(_:: '\<AA> st). y) \<Longrightarrow> - UML_Set.OclIterate Set{\<lambda>(_:: '\<AA> st). x, a} Set{\<lambda>(_:: '\<AA> st). x, a} F->including\<^sub>S\<^sub>e\<^sub>t(\<lambda>(_:: '\<AA> st). y) = - UML_Set.OclIterate Set{\<lambda>(_:: '\<AA> st). y, a} Set{\<lambda>(_:: '\<AA> st). y, a} F->including\<^sub>S\<^sub>e\<^sub>t(\<lambda>(_:: '\<AA> st). x)" - and com : "\<And>S x y \<tau>. - is_int (\<lambda>(_:: '\<AA> st). x) \<Longrightarrow> - is_int (\<lambda>(_:: '\<AA> st). y) \<Longrightarrow> - \<forall>(\<tau> :: '\<AA> st). all_defined \<tau> S \<Longrightarrow> - \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil> \<noteq> {} \<Longrightarrow> - (UML_Set.OclIterate (((UML_Set.OclIterate S S F)->including\<^sub>S\<^sub>e\<^sub>t(a))->including\<^sub>S\<^sub>e\<^sub>t(\<lambda>(_:: '\<AA> st). x)) (((UML_Set.OclIterate S S F)->including\<^sub>S\<^sub>e\<^sub>t(a))->including\<^sub>S\<^sub>e\<^sub>t(\<lambda>(_:: '\<AA> st). x)) F)->including\<^sub>S\<^sub>e\<^sub>t(\<lambda>(_:: '\<AA> st). y) \<tau> = - (UML_Set.OclIterate (((UML_Set.OclIterate S S F)->including\<^sub>S\<^sub>e\<^sub>t(a))->including\<^sub>S\<^sub>e\<^sub>t(\<lambda>(_:: '\<AA> st). y)) (((UML_Set.OclIterate S S F)->including\<^sub>S\<^sub>e\<^sub>t(a))->including\<^sub>S\<^sub>e\<^sub>t(\<lambda>(_:: '\<AA> st). y)) F)->including\<^sub>S\<^sub>e\<^sub>t(\<lambda>(_:: '\<AA> st). x) \<tau> " - and a_int : "is_int a" - shows "EQ_comp_fun_commute0 (\<lambda>x r1. (((r1 ->iterate\<^sub>S\<^sub>e\<^sub>t(j;r2=r1 | F j r2))->including\<^sub>S\<^sub>e\<^sub>t(a))->including\<^sub>S\<^sub>e\<^sub>t(\<lambda>(_:: '\<AA> st). x)))" -by(rule iterate_including_commute_var_generic, simp_all add: assms) - -subsection{* Execution OclIncluding out of OclIterate (theorem) *} - -lemma including_out1 : - assumes S_all_def : "\<And>\<tau>. all_defined \<tau> (S :: ('\<AA>, int option option) Set)" - and A_all_def : "\<And>\<tau>. all_defined \<tau> A" - and i_int : "is_int i" - shows "\<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil> \<noteq> {} \<Longrightarrow> - ((S :: ('\<AA>, _) Set)->iterate\<^sub>S\<^sub>e\<^sub>t(x;acc=A | acc->including\<^sub>S\<^sub>e\<^sub>t(x)->including\<^sub>S\<^sub>e\<^sub>t(i))) \<tau> = (S->iterate\<^sub>S\<^sub>e\<^sub>t(x;acc=A | acc->including\<^sub>S\<^sub>e\<^sub>t(x))->including\<^sub>S\<^sub>e\<^sub>t(i)) \<tau>" -by(rule including_out1_generic[OF including_commute including_commute2], simp_all add: assms) - -lemma including_out2 : - assumes S_all_def : "\<And>\<tau>. all_defined \<tau> (S :: ('\<AA>, int option option) Set)" - and A_all_def : "\<And>\<tau>. all_defined \<tau> A" - and i_int : "is_int i" - and x0_int : "is_int x0" - shows "\<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil> \<noteq> {} \<Longrightarrow> (S->iterate\<^sub>S\<^sub>e\<^sub>t(x;acc=A | acc->including\<^sub>S\<^sub>e\<^sub>t(x0)->including\<^sub>S\<^sub>e\<^sub>t(x)->including\<^sub>S\<^sub>e\<^sub>t(i))) \<tau> = (S->iterate\<^sub>S\<^sub>e\<^sub>t(x;acc=A | acc->including\<^sub>S\<^sub>e\<^sub>t(x0)->including\<^sub>S\<^sub>e\<^sub>t(x))->including\<^sub>S\<^sub>e\<^sub>t(i)) \<tau>" - apply(rule including_out2_generic[OF including_commute including_commute2 including_commute3 including_commute4 including_commute5 including_out1]) - apply(simp add: assms) - apply(simp add: assms) - apply(simp add: assms) - apply(simp add: assms) - apply(simp add: assms) - apply(simp add: assms) - apply(simp add: assms) - apply(simp add: assms) - apply(simp add: assms) - apply(simp add: assms) -by(rule preserved_defined, simp_all add: assms) - -lemma including_out0 : - assumes S_all_def : "\<And>\<tau>. all_defined \<tau> (S :: ('\<AA>, int option option) Set)" - and S_include : "\<And>\<tau> \<tau>'. S \<tau> = S \<tau>'" - and S_notempty : "\<And>\<tau>. \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil> \<noteq> {}" - and a_int : "is_int a" - shows "(S->iterate\<^sub>S\<^sub>e\<^sub>t(x;acc=Set{a} | acc->including\<^sub>S\<^sub>e\<^sub>t(x))) = (S->including\<^sub>S\<^sub>e\<^sub>t(a))" -by(rule including_out0_generic[OF including_commute], simp_all add: assms) - -subsection{* Execution OclIncluding out of OclIterate (corollary) *} - -lemma iterate_including_id_out : - assumes S_def : "\<And>\<tau>. all_defined \<tau> (S:: ('\<AA>, int option option) Set)" - and a_int : "is_int a" - shows "\<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil> \<noteq> {} \<Longrightarrow> (S ->iterate\<^sub>S\<^sub>e\<^sub>t(j;r2=S | r2->including\<^sub>S\<^sub>e\<^sub>t(a)->including\<^sub>S\<^sub>e\<^sub>t(j))) \<tau> = S->including\<^sub>S\<^sub>e\<^sub>t(a) \<tau>" -by(rule iterate_including_id_out_generic[OF including_commute including_commute2 including_commute3 including_out1], simp_all add: assms) - -lemma iterate_including_id_out' : - assumes S_def : "\<And>\<tau>. all_defined \<tau> (S:: ('\<AA>, int option option) Set)" - and a_int : "is_int a" - shows "\<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil> \<noteq> {} \<Longrightarrow> (S ->iterate\<^sub>S\<^sub>e\<^sub>t(j;r2=S | r2->including\<^sub>S\<^sub>e\<^sub>t(j)->including\<^sub>S\<^sub>e\<^sub>t(a))) \<tau> = S->including\<^sub>S\<^sub>e\<^sub>t(a) \<tau>" -by(rule iterate_including_id_out'_generic[OF including_commute including_out1], simp_all add: assms) - -lemma iterate_including_id_out'''' : - assumes S_def : "\<And>\<tau>. all_defined \<tau> (S:: ('\<AA>, int option option) Set)" - and a_int : "is_int a" - and b_int : "is_int b" - shows "\<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil> \<noteq> {} \<Longrightarrow> (S ->iterate\<^sub>S\<^sub>e\<^sub>t(j;r2=S | r2->including\<^sub>S\<^sub>e\<^sub>t(a)->including\<^sub>S\<^sub>e\<^sub>t(j)->including\<^sub>S\<^sub>e\<^sub>t(b))) \<tau> = S->including\<^sub>S\<^sub>e\<^sub>t(a)->including\<^sub>S\<^sub>e\<^sub>t(b) \<tau>" -by(rule iterate_including_id_out''''_generic[OF including_out2 including_commute3 iterate_including_id_out], simp_all add: assms) - -lemma iterate_including_id_out''' : - assumes S_def : "\<And>\<tau>. all_defined \<tau> (S:: ('\<AA>, int option option) Set)" - and a_int : "is_int a" - and b_int : "is_int b" - shows "\<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil> \<noteq> {} \<Longrightarrow> (S ->iterate\<^sub>S\<^sub>e\<^sub>t(j;r2=S | r2->including\<^sub>S\<^sub>e\<^sub>t(a)->including\<^sub>S\<^sub>e\<^sub>t(b)->including\<^sub>S\<^sub>e\<^sub>t(j))) \<tau> = S->including\<^sub>S\<^sub>e\<^sub>t(a)->including\<^sub>S\<^sub>e\<^sub>t(b) \<tau>" -by(rule iterate_including_id_out'''_generic[OF including_commute4 including_commute6 iterate_including_id_out''''], simp_all add: assms) - -section{* Conclusion *} - -lemma GogollasChallenge_on_sets: - "\<tau> \<Turnstile> (Set{ \<six>,\<eight> } ->iterate\<^sub>S\<^sub>e\<^sub>t(i;r1=Set{\<nine>}| - r1->iterate\<^sub>S\<^sub>e\<^sub>t(j;r2=r1| - r2->including\<^sub>S\<^sub>e\<^sub>t(\<zero>)->including\<^sub>S\<^sub>e\<^sub>t(i)->including\<^sub>S\<^sub>e\<^sub>t(j)))) \<doteq> Set{\<zero>, \<six>, \<eight>, \<nine>}" -proof - - have val_0 : "\<And>\<tau>. \<tau> \<Turnstile> \<upsilon> \<zero>" by simp - have val_6 : "\<And>\<tau>. \<tau> \<Turnstile> \<upsilon> \<six>" by simp - have val_8 : "\<And>\<tau>. \<tau> \<Turnstile> \<upsilon> \<eight>" by simp - have val_9 : "\<And>\<tau>. \<tau> \<Turnstile> \<upsilon> \<nine>" by simp - have OclInt0_int : "is_int \<zero>" by(simp add: is_int_def OclInt0_def) - have OclInt6_int : "is_int \<six>" by(simp add: is_int_def OclInt6_def) - have OclInt8_int : "is_int \<eight>" by(simp add: is_int_def OclInt8_def) - have OclInt9_int : "is_int \<nine>" by(simp add: is_int_def OclInt9_def) - show ?thesis - by(rule GogollasChallenge_on_sets_generic[OF val_0 val_6 val_8 val_9 OclInt0_int OclInt6_int OclInt8_int OclInt9_int including_commute including_commute2 including_commute3 including_commute4 including_commute5 including_commute6 iterate_including_id iterate_including_id_out iterate_including_id_out' iterate_including_id_out''' iterate_including_id_out'''' iterate_including_commute_var including_out0 including_out1 including_out2]) -qed - -end diff --git a/Citadelle/examples/archive/OCL_lib_Gogolla_challenge_naive.thy b/Citadelle/examples/archive/OCL_lib_Gogolla_challenge_naive.thy deleted file mode 100644 index ad3ef3d04276a59c2a9626c546179c1b41d87cf9..0000000000000000000000000000000000000000 --- a/Citadelle/examples/archive/OCL_lib_Gogolla_challenge_naive.thy +++ /dev/null @@ -1,500 +0,0 @@ -(****************************************************************************** - * 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. - ******************************************************************************) - -chapter{* Gogolla's challenge on Sets *} - -theory - OCL_lib_Gogolla_challenge_naive -imports - Isabelle_Finite_Set -begin - -no_notation None ("\<bottom>") - -text{* As illustration, we present several naive lemmas, that can be proved but will not be used, -since they have @{term "comp_fun_commute F"} as hypothesis: *} - -lemma (*OclIterate_valid:*) -assumes S_finite: "\<And>\<tau>. finite \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil>" -and F_commute: "comp_fun_commute F" -and F_valid_arg: "\<And>a A. \<upsilon> (F a A) = (\<upsilon> a and \<upsilon> A)" -shows "\<upsilon> (S->iterate\<^sub>S\<^sub>e\<^sub>t(a; x = A | F a x)) = (\<delta> S and (S->forAll\<^sub>S\<^sub>e\<^sub>t(x | \<upsilon> x)) and \<upsilon> A)" -proof - - - have defined_inject_true : "\<And>\<tau> P. (\<delta> P) \<tau> \<noteq> true \<tau> \<Longrightarrow> (\<delta> P) \<tau> = false \<tau>" - apply(simp add: defined_def true_def false_def - bot_fun_def bot_option_def - null_fun_def null_option_def) - by (case_tac " P \<tau> = \<bottom> \<or> P \<tau> = null", simp_all add: true_def) - - have valid_inject_true : "\<And>\<tau> P. (\<upsilon> P) \<tau> \<noteq> true \<tau> \<Longrightarrow> (\<upsilon> P) \<tau> = false \<tau>" - apply(simp add: valid_def true_def false_def - bot_fun_def bot_option_def - null_fun_def null_option_def) - by (case_tac " P \<tau> = \<bottom>", simp_all add: true_def) - - have contradict_Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e: "\<And>\<tau> S f. - \<forall>x\<in>\<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e S\<rceil>\<rceil>. f (\<lambda>_. x) \<tau> \<Longrightarrow> - \<exists>x\<in>\<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e S\<rceil>\<rceil>. \<not> (f (\<lambda>_. x) \<tau>) \<Longrightarrow> - False" - apply(drule bexE[where Q = False]) - apply(drule bspec) - apply(assumption) - by(simp) - - have image_cong: "\<And>x Fa f. inj f \<Longrightarrow> x \<notin> Fa \<Longrightarrow> f x \<notin> f ` Fa" - apply(simp add: image_def) - apply(rule ballI) - apply(case_tac "x = xa", simp) - apply(simp add: inj_on_def) - apply(blast) - done - - have inject : "inj (\<lambda>a \<tau>. a)" - by(rule inj_fun, simp) - - have fold_exec_true : "\<And>\<tau>. (\<And>\<tau>. finite \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil>) \<Longrightarrow> - (\<delta> S) \<tau> = true \<tau> \<Longrightarrow> - (\<upsilon> A) \<tau> = true \<tau> \<Longrightarrow> - (\<forall>x\<in>\<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil>. (\<upsilon> (\<lambda>_. x)) \<tau> = true \<tau>) \<Longrightarrow> - ((\<upsilon> Finite_Set.fold F A ((\<lambda>a \<tau>. a) ` \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil>)) \<tau> = true \<tau>)" - proof - - fix \<tau> - show "(\<And>\<tau>. finite \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil>) \<Longrightarrow> - (\<delta> S) \<tau> = true \<tau> \<Longrightarrow> - (\<upsilon> A) \<tau> = true \<tau> \<Longrightarrow> - (\<forall>x\<in>\<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil>. (\<upsilon> (\<lambda>_. x)) \<tau> = true \<tau>) \<Longrightarrow> ?thesis \<tau>" - - apply(case_tac "\<exists>x. x\<in>\<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil>", simp_all) - apply(drule exE) prefer 2 apply(assumption) - - apply(subst finite_induct[where P = "\<lambda>set. (\<forall>x\<in>set. (\<upsilon> (\<lambda>_. x)) \<tau> = true \<tau>) --> (\<upsilon> Finite_Set.fold F A ((\<lambda>a \<tau>. a) ` set)) \<tau> = true \<tau>" - and F = "\<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil>"]) - apply(simp) - apply(simp) - defer - apply(simp) - apply(simp) - apply(rule impI)+ - apply(simp, erule conjE) - apply(subgoal_tac "\<exists>x. Finite_Set.fold F A ((\<lambda>a \<tau>. a) ` Fa) = x \<and> (\<upsilon> x) \<tau> = true \<tau>") - prefer 2 - apply(rule_tac x = "Finite_Set.fold F A ((\<lambda>a \<tau>. a) ` Fa)" in exI) - apply(simp) - apply(drule exE) prefer 2 apply(assumption) - apply(drule conjE) prefer 2 apply(assumption) - apply(subgoal_tac "F (\<lambda>\<tau>. xa) (Finite_Set.fold F A ((\<lambda>a \<tau>. a) ` Fa)) = F (\<lambda>\<tau>. xa) xb") - prefer 2 - apply(simp) - apply(subst comp_fun_commute.fold_insert[where f = F and z = A and A = "((\<lambda>a \<tau>. a) ` Fa)" and x = "(\<lambda>\<tau>. xa)"]) - apply(rule F_commute) - apply(simp) - apply(rule image_cong) - apply(rule inject) - apply(simp) - apply(simp) - apply(subst F_valid_arg) - apply(simp add: cp_OclAnd) - done - qed - - have fold_exec_false : "\<And>\<tau>. (\<And>\<tau>. finite \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil>) \<Longrightarrow> - (\<delta> S) \<tau> = true \<tau> \<Longrightarrow> - (\<upsilon> A) \<tau> = true \<tau> \<Longrightarrow> - (\<exists>x\<in>\<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil>. (\<upsilon> (\<lambda>_. x)) \<tau> = false \<tau>) \<Longrightarrow> - ((\<upsilon> Finite_Set.fold F A ((\<lambda>a \<tau>. a) ` \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil>)) \<tau> = false \<tau>)" - proof - - fix \<tau> - show "(\<And>\<tau>. finite \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil>) \<Longrightarrow> - (\<delta> S) \<tau> = true \<tau> \<Longrightarrow> - (\<upsilon> A) \<tau> = true \<tau> \<Longrightarrow> - (\<exists>x\<in>\<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil>. (\<upsilon> (\<lambda>_. x)) \<tau> = false \<tau>) \<Longrightarrow> ?thesis \<tau>" - - apply(case_tac "\<exists>x. x\<in>\<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil>", simp_all) - apply(drule exE) prefer 2 apply(assumption) - - apply(subst finite_induct[where P = "\<lambda>set. (\<exists>x\<in>set. (\<upsilon> (\<lambda>_. x)) \<tau> = false \<tau>) --> (\<upsilon> Finite_Set.fold F A ((\<lambda>a \<tau>. a) ` set)) \<tau> = false \<tau>" - and F = "\<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil>"]) - apply(simp) - apply(simp) - defer - apply(simp) - apply(simp) - apply(rule impI)+ - apply(drule_tac A = "insert xa Fa" in bexE) prefer 2 apply(assumption) - apply(simp, drule disjE) prefer 3 apply(assumption) - apply(simp) - apply(subgoal_tac "\<forall>x. Finite_Set.fold F A (insert (\<lambda>\<tau>. xa) ((\<lambda>a \<tau>. a) ` Fa)) = x \<longrightarrow> (\<upsilon> x) \<tau> = false \<tau>") apply(simp, rule allI, rule impI) - apply(subgoal_tac "F (\<lambda>\<tau>. xa) (Finite_Set.fold F A ((\<lambda>a \<tau>. a) ` Fa)) = xc") - prefer 2 - apply(subst comp_fun_commute.fold_insert[where f = F and z = A and x = "(\<lambda>\<tau>. xa)" and A = "((\<lambda>a \<tau>. a) ` Fa)", symmetric]) - apply(rule F_commute) - apply(simp) - apply(rule image_cong) - apply(rule inject) - apply(simp) - apply(simp) - apply(subgoal_tac "(\<upsilon> (F (\<lambda>\<tau>. xa) (Finite_Set.fold F A ((\<lambda>a \<tau>. a) ` Fa)))) \<tau> = false \<tau>") apply(simp) - apply(subst F_valid_arg) - apply(subst cp_OclAnd[where X = "\<upsilon> (\<lambda>\<tau>. xa)"], simp) - apply(simp add: cp_OclAnd[symmetric]) - - apply(auto) - apply(subgoal_tac "\<exists>x. Finite_Set.fold F A ((\<lambda>a \<tau>. a) ` Fa) = x \<and> (\<upsilon> x) \<tau> = false \<tau>") - prefer 2 - apply(rule_tac x = "Finite_Set.fold F A ((\<lambda>a \<tau>. a) ` Fa)" in exI) - apply(simp) - apply(drule exE) prefer 2 apply(assumption) - apply(drule conjE) prefer 2 apply(assumption) - apply(subgoal_tac "F (\<lambda>\<tau>. xa) (Finite_Set.fold F A ((\<lambda>a \<tau>. a) ` Fa)) = F (\<lambda>\<tau>. xa) xd") - prefer 2 - apply(simp) - apply(subst comp_fun_commute.fold_insert[where f = F and z = A and A = "((\<lambda>a \<tau>. a) ` Fa)" and x = "(\<lambda>\<tau>. xa)"]) - apply(rule F_commute) - apply(simp) - apply(rule image_cong) - apply(rule inject) - apply(simp) - apply(simp) - apply(subst F_valid_arg) - apply(subst cp_OclAnd[where X = "\<upsilon> (\<lambda>\<tau>. xa)"]) - apply(simp add: cp_OclAnd[symmetric]) - done - qed - - have fold_exec : "\<And>\<tau>. (\<And>\<tau>. finite \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil>) \<Longrightarrow> - (\<delta> S) \<tau> = true \<tau> \<Longrightarrow> - (\<upsilon> A) \<tau> = true \<tau> \<Longrightarrow> - (\<forall>x\<in>\<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil>. (\<upsilon> (\<lambda>_. x)) \<tau> = true \<tau>) = ((\<upsilon> Finite_Set.fold F A ((\<lambda>a \<tau>. a) ` \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil>)) \<tau> = true \<tau>)" - apply(case_tac "\<forall>x\<in>\<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil>. (\<upsilon> (\<lambda>_. x)) \<tau> = true \<tau>") - apply(simp add: fold_exec_true) - - apply(simp) - apply(subgoal_tac "(\<upsilon> Finite_Set.fold F A ((\<lambda>a \<tau>. a) ` \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil>)) \<tau> = false \<tau>") - prefer 2 - apply(rule fold_exec_false, simp_all) - apply(drule bexE) prefer 2 apply(assumption) - apply(rule_tac x = x in bexI) apply(rule valid_inject_true, simp_all) - - apply(auto) - done - - show ?thesis - apply(rule ext, rename_tac \<tau>) - apply(simp add: cp_valid[of "UML_Set.OclIterate S A F"]) - apply(simp add: UML_Set.OclIterate_def) - apply(simp add: cp_OclAnd[of _ "\<upsilon> A"] cp_OclAnd[of "\<delta> S" ]) - apply(simp add: cp_OclAnd[symmetric] cp_valid[symmetric]) - apply(insert S_finite, simp) - - apply(rule conjI) - prefer 2 - apply(case_tac "(\<upsilon> A) \<tau> = true \<tau>", simp) - - apply(rule impI) - apply(subgoal_tac "(\<delta> S) \<tau> = false \<tau>") - prefer 2 - apply(rule defined_inject_true) - apply(simp) - apply(simp add: cp_OclAnd[of _ "\<upsilon> A"] cp_OclAnd[of "\<delta> S" ]) - apply(simp add: cp_OclAnd[symmetric]) - apply(simp add: valid_def bot_fun_def) - - apply(subgoal_tac "(\<upsilon> A) \<tau> = false \<tau>") - prefer 2 - apply(rule valid_inject_true) - apply(simp) - apply(simp add: cp_OclAnd[of _ "\<upsilon> A"] cp_OclAnd[of "\<delta> S" ]) - apply(simp add: cp_OclAnd[symmetric]) - apply(simp add: valid_def bot_fun_def) - - apply(rule impI, erule conjE) - - apply(case_tac "\<tau> \<Turnstile> \<upsilon> Finite_Set.fold F A ((\<lambda>a \<tau>. a) ` \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil>)") - apply(drule fold_exec[symmetric], simp_all add: OclValid_def) - apply(simp add: UML_Set.OclForall_def) - - apply(drule valid_inject_true) - apply(drule fold_exec[symmetric], simp_all add: OclValid_def) - apply(simp add: UML_Set.OclForall_def) - - by (metis bot_fun_def valid_def) -qed - -lemma (*OclIterate\<^sub>S\<^sub>e\<^sub>t_valid_:*) -assumes S_finite: "\<And>\<tau>. finite \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil>" -and F_commute: "comp_fun_commute F" -and A_defined: "\<delta> A = \<upsilon> A" -and F_defined: "\<And>a A. \<delta> A = \<upsilon> A \<Longrightarrow> \<delta> (F a A) = \<upsilon> (F a A)" -(*and F_valid_arg: "\<And>a A. \<upsilon> (F a A) = (\<upsilon> a and \<upsilon> A)"*) -and F_valid_arg_true: "\<And>\<tau> a A. \<tau> \<Turnstile> \<upsilon> a \<Longrightarrow> \<tau> \<Turnstile> \<delta> A \<Longrightarrow> \<tau> \<Turnstile> \<upsilon> (F a A)" -and F_valid_arg_false1: "\<And>\<tau> a A. \<not> (\<tau> \<Turnstile> \<upsilon> a) \<Longrightarrow> \<not> (\<tau> \<Turnstile> \<upsilon> (F a A))" -and F_valid_arg_false2: "\<And>\<tau> a A. \<not> (\<tau> \<Turnstile> \<upsilon> A) \<Longrightarrow> \<not> (\<tau> \<Turnstile> \<upsilon> (F a A))" -shows "\<upsilon> (S->iterate\<^sub>S\<^sub>e\<^sub>t(a; x = A | F a x)) = (\<delta> S and (S->forAll\<^sub>S\<^sub>e\<^sub>t(x | \<upsilon> x)) and \<upsilon> A)" -proof - - - have defined_inject_true : "\<And>\<tau> P. (\<delta> P) \<tau> \<noteq> true \<tau> \<Longrightarrow> (\<delta> P) \<tau> = false \<tau>" - apply(simp add: defined_def true_def false_def - bot_fun_def bot_option_def - null_fun_def null_option_def) - by (case_tac " P \<tau> = \<bottom> \<or> P \<tau> = null", simp_all add: true_def) - - have valid_inject_true : "\<And>\<tau> P. (\<upsilon> P) \<tau> \<noteq> true \<tau> \<Longrightarrow> (\<upsilon> P) \<tau> = false \<tau>" - apply(simp add: valid_def true_def false_def - bot_fun_def bot_option_def - null_fun_def null_option_def) - by (case_tac " P \<tau> = \<bottom>", simp_all add: true_def) - - have contradict_Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e: "\<And>\<tau> S f. - \<forall>x\<in>\<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e S\<rceil>\<rceil>. f (\<lambda>_. x) \<tau> \<Longrightarrow> - \<exists>x\<in>\<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e S\<rceil>\<rceil>. \<not> (f (\<lambda>_. x) \<tau>) \<Longrightarrow> - False" - apply(drule bexE[where Q = False]) - apply(drule bspec) - apply(assumption) - by(simp) - - have image_cong: "\<And>x Fa f. inj f \<Longrightarrow> x \<notin> Fa \<Longrightarrow> f x \<notin> f ` Fa" - apply(simp add: image_def) - apply(rule ballI) - apply(case_tac "x = xa", simp) - apply(simp add: inj_on_def) - apply(blast) - done - - have inject : "inj (\<lambda>a \<tau>. a)" - by(rule inj_fun, simp) - - have fold_exec_true : "\<And>\<tau>. (\<And>\<tau>. finite \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil>) \<Longrightarrow> - \<tau> \<Turnstile> \<delta> S \<Longrightarrow> - \<tau> \<Turnstile> \<upsilon> A \<Longrightarrow> - (\<forall>x\<in>\<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil>. (\<tau> \<Turnstile> \<upsilon> (\<lambda>_. x))) \<Longrightarrow> - \<tau> \<Turnstile> \<upsilon> Finite_Set.fold F A ((\<lambda>a \<tau>. a) ` \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil>)" - - apply(case_tac "\<exists>x. x\<in>\<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil>", simp_all) - apply(drule exE) prefer 2 apply(assumption) - - apply(subst finite_induct[where P = "\<lambda>set. (\<forall>x\<in>set. (\<tau> \<Turnstile> \<upsilon> (\<lambda>_. x))) --> (\<tau> \<Turnstile> \<upsilon> (Finite_Set.fold F A ((\<lambda>a \<tau>. a) ` set)))" - and F = "\<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil>"]) - apply(simp) - apply(simp) - defer - apply(simp) - apply(simp) - apply(rule impI)+ - apply(simp, erule conjE) - apply(subgoal_tac "\<exists>x. Finite_Set.fold F A ((\<lambda>a \<tau>. a) ` Fa) = x \<and> (\<tau> \<Turnstile> \<upsilon> x)") - prefer 2 - apply(rule_tac x = "Finite_Set.fold F A ((\<lambda>a \<tau>. a) ` Fa)" in exI) - apply(simp) - apply(drule exE) prefer 2 apply(assumption) - apply(drule conjE) prefer 2 apply(assumption) - apply(subgoal_tac "F (\<lambda>\<tau>. xa) (Finite_Set.fold F A ((\<lambda>a \<tau>. a) ` Fa)) = F (\<lambda>\<tau>. xa) xb") - prefer 2 - apply(simp) - apply(subst comp_fun_commute.fold_insert[where f = F and z = A and A = "((\<lambda>a \<tau>. a) ` Fa)" and x = "(\<lambda>\<tau>. xa)"]) - apply(rule F_commute) - apply(simp) - apply(rule image_cong) - apply(rule inject) - apply(simp) - apply(simp) - apply(subst F_valid_arg_true, simp_all) - - apply(subgoal_tac "\<upsilon> xb = \<delta> xb", simp) - - apply(subgoal_tac "let c = Finite_Set.fold F A ((\<lambda>a \<tau>. a) ` Fa) in \<upsilon> c = \<delta> c", simp) - - apply(subst finite_induct[where P = "\<lambda>set. let c = Finite_Set.fold F A set in \<upsilon> c = \<delta> c" - and F = "(\<lambda>a \<tau>. a) ` Fa"]) - apply(simp) - apply(simp) - apply(insert A_defined, simp) - defer - apply(simp) - apply(subst comp_fun_commute.fold_insert) - apply(rule F_commute) - apply(simp) - apply(simp) - apply(simp add: Let_def) - apply(subst F_defined) - apply(simp)+ - done - - have fold_exec_false : "\<And>\<tau>. (\<And>\<tau>. finite \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil>) \<Longrightarrow> - \<tau> \<Turnstile> (\<delta> S) \<Longrightarrow> - \<tau> \<Turnstile> (\<upsilon> A) \<Longrightarrow> - (\<exists>x\<in>\<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil>. \<not> (\<tau> \<Turnstile> (\<upsilon> (\<lambda>_. x)))) \<Longrightarrow> - \<not> (\<tau> \<Turnstile> \<upsilon> Finite_Set.fold F A ((\<lambda>a \<tau>. a) ` \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil>))" - - apply(case_tac "\<exists>x. x\<in>\<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil>", simp_all) - apply(drule exE) prefer 2 apply(assumption) - - apply(subst finite_induct[where P = "\<lambda>set. (\<exists>x\<in>set. \<not> (\<tau> \<Turnstile> \<upsilon> (\<lambda>_. x))) --> \<not> (\<tau> \<Turnstile> (\<upsilon> Finite_Set.fold F A ((\<lambda>a \<tau>. a) ` set)))" - and F = "\<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil>"]) - apply(simp) - apply(simp) - defer - apply(simp) - apply(simp) - apply(rule impI)+ - - apply(drule_tac A = "insert xa Fa" in bexE) prefer 2 apply(assumption) - apply(simp, drule disjE) prefer 3 apply(assumption) - apply(simp) - apply(subgoal_tac "\<forall>x. Finite_Set.fold F A (insert (\<lambda>\<tau>. xa) ((\<lambda>a \<tau>. a) ` Fa)) = x \<longrightarrow> \<not> (\<tau> \<Turnstile> (\<upsilon> x))") apply(simp, rule allI, rule impI) - apply(subgoal_tac "F (\<lambda>\<tau>. xa) (Finite_Set.fold F A ((\<lambda>a \<tau>. a) ` Fa)) = xc") - prefer 2 - apply(subst comp_fun_commute.fold_insert[where f = F and z = A and x = "(\<lambda>\<tau>. xa)" and A = "((\<lambda>a \<tau>. a) ` Fa)", symmetric]) - apply(rule F_commute) - apply(simp) - apply(rule image_cong) - apply(rule inject) - apply(simp) - apply(simp) - apply(subgoal_tac "\<not> (\<tau> \<Turnstile> (\<upsilon> (F (\<lambda>\<tau>. xa) (Finite_Set.fold F A ((\<lambda>a \<tau>. a) ` Fa)))))") apply(simp) - apply(rule F_valid_arg_false1, simp) - - apply(subst comp_fun_commute.fold_insert[where f = F and z = A and x = "(\<lambda>\<tau>. xa)" and A = "((\<lambda>a \<tau>. a) ` Fa)"]) - apply(rule F_commute) - apply(simp) - apply(rule image_cong) - apply(rule inject) - apply(simp) - apply(rule F_valid_arg_false2) - apply(subgoal_tac "\<exists>x\<in>Fa. \<not> (\<tau> \<Turnstile> \<upsilon> (\<lambda>_. x))", simp) - apply(rule_tac x = xb in bexI, simp_all) - done - - have fold_exec : "\<And>\<tau>. (\<And>\<tau>. finite \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil>) \<Longrightarrow> - \<tau> \<Turnstile> (\<delta> S) \<Longrightarrow> - \<tau> \<Turnstile> (\<upsilon> A) \<Longrightarrow> - (\<forall>x\<in>\<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil>. (\<tau> \<Turnstile> \<upsilon> (\<lambda>_. x))) = (\<tau> \<Turnstile> \<upsilon> Finite_Set.fold F A ((\<lambda>a \<tau>. a) ` \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil>))" - apply(case_tac "\<forall>x\<in>\<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil>. (\<tau> \<Turnstile> \<upsilon> (\<lambda>_. x))") - apply(simp add: fold_exec_true) - - apply(simp) - apply(subgoal_tac "\<not> (\<tau> \<Turnstile> \<upsilon> Finite_Set.fold F A ((\<lambda>a \<tau>. a) ` \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil>))") - prefer 2 - apply(rule fold_exec_false, simp_all) - done - - have discr_eq_false_true : "\<And>\<tau>. (false \<tau> = true \<tau>) = False" by (metis OclValid_def foundation2) - have discr_eq_false_bot : "\<And>\<tau>. (false \<tau> = bot \<tau>) = False" by (metis defined4 defined_def discr_eq_false_true) - have discr_eq_false_null : "\<And>\<tau>. (false \<tau> = null \<tau>) = False" by (metis defined4 defined_def discr_eq_false_true) - have e_valid_inject_true : "\<And>\<tau>. \<exists>x\<in>\<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil>. (\<upsilon> (\<lambda>_. x)) \<tau> \<noteq> true \<tau> \<Longrightarrow> \<exists>x\<in>\<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil>. (\<upsilon> (\<lambda>_. x)) \<tau> = false \<tau>" - by (metis valid_inject_true) - have f_valid_inject_true : "\<And>\<tau>. \<forall>x\<in>\<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil>. (\<upsilon> (\<lambda>_. x)) \<tau> \<noteq> false \<tau> \<Longrightarrow> \<forall>x\<in>\<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil>. (\<upsilon> (\<lambda>_. x)) \<tau> = true \<tau>" - by (metis valid_inject_true) - - show ?thesis - apply(rule ext, rename_tac \<tau>) - apply(simp add: cp_valid[of "UML_Set.OclIterate S A F"]) - apply(simp add: UML_Set.OclIterate_def) - apply(simp add: cp_OclAnd[of _ "\<upsilon> A"] cp_OclAnd[of "\<delta> S" ]) - apply(simp add: cp_OclAnd[symmetric] cp_valid[symmetric]) - apply(insert S_finite, simp) - - apply(rule conjI) - prefer 2 - apply(case_tac "\<tau> \<Turnstile> (\<upsilon> A)", simp add: OclValid_def) - - apply(rule impI) - apply(subgoal_tac "\<not> (\<tau> \<Turnstile> (\<delta> S))") - prefer 2 - apply(simp add: OclValid_def) - apply(drule defined_inject_true) - apply(simp add: cp_OclAnd[of _ "\<upsilon> A"] cp_OclAnd[of "\<delta> S" ]) - apply(simp add: cp_OclAnd[symmetric]) - apply(simp add: valid_def bot_fun_def) - - apply(simp add: OclValid_def) - apply(drule valid_inject_true) - apply(simp add: cp_OclAnd[of _ "\<upsilon> A"] cp_OclAnd[of "\<delta> S" ]) - apply(simp add: cp_OclAnd[symmetric]) - apply(simp add: valid_def bot_fun_def) - - apply(rule impI, erule conjE) - - apply(case_tac "\<tau> \<Turnstile> \<upsilon> Finite_Set.fold F A ((\<lambda>a \<tau>. a) ` \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil>)") - apply(drule fold_exec[symmetric], simp_all add: OclValid_def) - apply(simp add: UML_Set.OclForall_def) - - apply(drule valid_inject_true) - apply(drule fold_exec[symmetric], simp_all add: OclValid_def) - apply(simp add: UML_Set.OclForall_def) - - by (metis bot_fun_def valid_def) -qed - -section \<open>...\<close> - -lemma mtSet_eq_exec: - assumes S_all_def : "\<And>\<tau>. all_defined \<tau> (S :: 'a state \<times> 'a state \<Rightarrow> Set(\<langle>\<langle>int\<rangle>\<^sub>\<bottom>\<rangle>\<^sub>\<bottom>))" - shows "(S = Set{}) = (\<forall>\<tau>. \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil> = {})" -proof - - have S_incl : "(\<forall>\<tau>. \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil> = {}) \<Longrightarrow> Set{} = S" - apply(rule ext, rename_tac \<tau>) - proof - fix \<tau> show "\<forall>\<tau>. \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil> = {} \<Longrightarrow> Set{} \<tau> = S \<tau>" - apply(insert S_all_def[of \<tau>]) - apply(drule_tac x = \<tau> in allE) prefer 2 apply assumption - apply(simp add: mtSet_def) - by (metis abs_rep_simp' all_defined_def) - qed - have B : "\<lfloor>\<lfloor>{}\<rfloor>\<rfloor> \<in> {X. X = bot \<or> X = null \<or> (\<forall>x\<in>\<lceil>\<lceil>X\<rceil>\<rceil>. x \<noteq> bot)}" by(simp add: mtSet_def) - - show ?thesis - apply(rule iffI) - apply(rule allI, simp add: mtSet_def Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inverse B) - apply(simp add: S_incl) - done -qed - -lemma mtSet_neq_exec : - assumes S_all_def : "\<And>\<tau>. all_defined \<tau> (S :: 'a state \<times> 'a state \<Rightarrow> Set(\<langle>\<langle>int\<rangle>\<^sub>\<bottom>\<rangle>\<^sub>\<bottom>))" - shows "(S \<noteq> Set{}) = (\<exists>\<tau>. \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil> \<noteq> {})" -by(simp add: mtSet_eq_exec[OF S_all_def]) - -end diff --git a/Citadelle/examples/archive/Simple_Model.thy b/Citadelle/examples/archive/Simple_Model.thy deleted file mode 100644 index 5b2ff4d494d0a5a2069d97861154cdc180289812..0000000000000000000000000000000000000000 --- a/Citadelle/examples/archive/Simple_Model.thy +++ /dev/null @@ -1,77 +0,0 @@ -(****************************************************************************** - * 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 Simple_Model - imports FOCL.UML_OCL -begin - -Class A - Attributes s : String -End - -Class C1 < A - Attributes a : Integer -End - -Class C2 < A - Attributes b : Boolean -End - -End! - -declare OclAsType\<^sub>A_C1[simp del] -declare OclAsType\<^sub>C\<^sub>1_A[simp del] -declare up\<^sub>A_down\<^sub>C\<^sub>1_cast[simp] - - - - - - - - -lemma "Y .oclAsType(A) .oclAsType(C1) = Y" -by (auto) - - -end diff --git a/Citadelle/examples/archive/Toy_deep.thy b/Citadelle/examples/archive/Toy_deep.thy deleted file mode 100644 index b25d579a2aac888e2fe8c99c7d2cf950caf1428e..0000000000000000000000000000000000000000 --- a/Citadelle/examples/archive/Toy_deep.thy +++ /dev/null @@ -1,402 +0,0 @@ -(****************************************************************************** - * HOL-TOY - * - * 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. - ******************************************************************************) - -section\<open>Example: A Class Model Converted into a Theory File\<close> -subsection\<open>Introduction\<close> - -theory - Toy_deep -imports - FOCL.Generator_dynamic_sequential -begin -ML_file "~~/src/Doc/antiquote_setup.ML" - -text\<open> -In this example, we configure our package to generate a \<^verbatim>\<open>.thy\<close> file, -without executing the associated generated code contained in this \<^verbatim>\<open>.thy\<close> file -(c.f. @{file "Toy_shallow.thy"} for a direct evaluation). -This mode is particularly relevant for debugging purposes: -while by default no evaluation occurs, -the generated files (and their proofs!) can be executed on -a step by step basis, depending on how we interact with the output window -(by selectively clicking on what is generated). - -After clicking on the generated content, the newly inserted content could depend on some theories -which are not loaded by this current one. -In this case, it is necessary to manually add all the needed dependencies above after the -keyword @{keyword "imports"}. -One should compare this current theory with @{file "Toy_shallow.thy"} -to see the differences of imported theories, and which ones to manually import -(whenever an error happens). -\<close> - -generation_syntax [ (*deep - (generation_semantics [ design (*, oid_start 10*) ]) - (THEORY Toy_generated) - (IMPORTS ["../src/UML_Main", "../src/compiler/Static"] - "../src/compiler/Generator_dynamic_sequential") - SECTION - (*SORRY*) (*no_dirty*) - [ (* in Haskell *) - (* in OCaml module_name M *) - (* in Scala module_name M *) - (* in SML module_name M *) - in self ] - (output_directory "../../doc") - (*, syntax_print*)*) ] - -text\<open> -\<^verbatim>\<open> -generation_syntax - [ deep - (generation_semantics [ design ]) - (THEORY Design_generated) - (IMPORTS ["../src/UML_Main", "../src/compiler/Static"] - "../src/compiler/Generator_dynamic_sequential") - SECTION - (*SORRY*) (*no_dirty*) - [ (* in Haskell *) - (* in OCaml module_name M *) - (* in Scala module_name M *) - (* in SML module_name M *) - in self ] - (output_directory "../../doc") - (*, syntax_print*) ] -\<close> -While in theory it is possible to set the @{keyword "deep"} mode -for generating in all target languages, i.e. by writing -\<^theory_text>\<open>[ in Haskell, in OCaml module_name M, in Scala module_name M, in SML module_name M, in self ]\<close>, -usually using only one target is enough, -since the task of all target is to generate the same Isabelle content. -However in case one language takes too much time to setup, -we recommend to try the generation with another target language, -because all optimizations are currently not (yet) seemingly implemented for all target languages, -or differently activated.\<close> - -subsection\<open>Designing Class Models (I): Basics\<close> - -text\<open> -The following example shows the definitions of a set of classes, -called the ``universe'' of classes. -Instead of providing a single command for building all the complete universe of classes -directly in one block, -we are constructing classes one by one. -So globally the universe describing all classes is partial, it -will only be fully constructed when all classes will be finished to be defined. - -This allows to define classes without having to follow a particular order of definitions. -Here \<open>Atom\<close> is defined before the one of \<open>Molecule\<close> -(\<open>Molecule\<close> will come after): -\<close> - -Class Atom < Molecule - Attributes size : Integer -End - -text\<open>The ``blue'' color of @{command End} indicates that -@{command End} is not a ``green'' keyword. -@{command End} and @{command Class} are in fact similar, they belong to the group of meta-commands -(all meta-commands are defined in @{theory FOCL.Generator_dynamic_sequential}). -At run-time and in @{keyword "deep"} mode, all meta-commands have -approximately the same semantics: they only display some quantity of Isabelle code -in the output window (as long as meta-commands are syntactically correctly formed). -However each meta-command is unique because what is displayed -in the output window depends on the sequence of all meta-commands already encountered before -(and also depends on arguments given to the meta-commands).\<close> - -text\<open> -One particularity of @{command End} is to behave as the identity function when -@{command End} is called without arguments. -As example, here we are calling lots of @{command End} without arguments, -and no Isabelle code is generated.\<close> - End End End -text\<open> -We remark that, like any meta-commands, @{command End} could have been written anywhere -in this theory, for example before @{command Class} or even before @{command generation_syntax}... -Something does not have to be specially opened before using an @{command End}. -\<close> - -Class Molecule < Person -text\<open>As example, here no @{command End} is written.\<close> - -text\<open> -The semantics of @{command End} is further made precise here. -We earlier mentioned that the universe of classes is partially constructed, but one can still -examine what is partially constructed, and one possibility is to use @{command End} for doing so. - -@{command End} can be seen as a lazy meta-command: - \<^item> without parameters, no code is generated, - \<^item> with some parameters (e.g., the symbol \<^verbatim>\<open>!\<close>), it forces the generation of the computation -of the universe, by considering all already encountered classes. -Then a partial representation of the universe can be interactively inspected. -\<close> - -Class Galaxy - Attributes wormhole : UnlimitedNatural - is_sound : Void -End! - -text\<open>At this position, in the output window, -we can observe for the first time some generated Isabelle code, -corresponding to the partial universe of classes being constructed. - -Note: By default, \<open>Atom\<close> and \<open>Molecule\<close> are not (yet) present in the shown universe -because \<open>Person\<close> has not been defined in a separate line (unlike \<open>Galaxy\<close> above).\<close> - -Class Person < Galaxy - Attributes salary : Integer - boss : Person - is_meta_thinking: Boolean - -text\<open> -There is not only @{command End} which forces the computation of the universe, for example -@{command Instance} declares a set of objects belonging to the classes earlier defined, -but the entire universe is needed as knowledge, so there is no choice than forcing -the generation of the universe. -\<close> - -Instance X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1 :: Person = [ salary = 1300 , boss = X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2 ] - and X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2 :: Person = [ salary = 1800 ] - -text\<open> -Here we will call @{command Instance} again to show that the universe will not be computed again -since it was already computed in the previous @{command Instance}. -\<close> - -Instance X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3 :: Person = [ salary = 1 ] - -text\<open>However at any time, the universe can (or will) automatically be recomputed, -whenever we are adding meanwhile another class: - -\<^verbatim>\<open>(*\<close>~\<^theory_text>\<open>Class Big_Bang < Atom\<close>~\<^verbatim>\<open>(* This will force the creation of a new universe. *) *)\<close> - -As remark, not only the universe is recomputed, but -the recomputation takes also into account all meta-commands already encountered. -So in the new setting, \<open>X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1\<close>, \<open>X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2\<close> and \<open>X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3\<close> -will be resurrected... after the \<open>Big_Bang\<close>. -\<close> - -subsection\<open>Designing Class Models (II): Jumping to Another Semantic Floor\<close> - -text\<open> -Until now, meta-commands was used to generate lines of code, and -these lines belong to the Isabelle language. -One particularity of meta-commands is to generate pieces of code containing not only Isabelle code -but also arbitrary meta-commands. -In @{keyword "deep"} mode, this is particularly not a danger -for meta-commands to generate themselves -(whereas for @{keyword "shallow"} the recursion might not terminate). - -In this case, such meta-commands must automatically generate the appropriate call to -@{command generation_syntax} beforehand. -However this is not enough, the compiling environment (comprising the -history of meta-commands) are changing throughout the interactive evaluations, -so the environment must also be taken into account and propagated when meta-commands -are generating themselves. -For example, the environment is needed for consultation whenever resurrecting objects, -recomputing the universe or accessing the hierarchy of classes being -defined. - -As a consequence, in the next example a line @{command setup} is added -after @{command generation_syntax} for bootstrapping the state of the compiling environment. -\<close> - -State \<sigma>\<^sub>1 = - [ ([ salary = 1000 , boss = self 1 ] :: Person) - , ([ salary = 1200 ] :: Person) - (* *) - , ([ salary = 2600 , boss = self 3 ] :: Person) - , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1 - , ([ salary = 2300 , boss = self 2 ] :: Person) - (* *) - (* *) - , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2 ] - -text \<open> -In certain circumstances, the command @{command setup} -must be added again between some particular interleaving of two meta-commands, -especially when the first meta-command only generates Isabelle code, -i.e. when it does not generate meta-commands, like this one: -\<close> - -Instance X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4 :: Person = [] - -text \<open> -After this point, the code generated by the next meta-command @{command State} -has no way to detect that some Isabelle code was generated or not -(precisely between this @{command State} and the previous command @{command State}), -i.e. @{command State} can not know if @{term X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4} is a free or a bound variable. -Consequently, one solution is to use again @{command setup} to state that -@{term X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4} has just been bound by the previous @{command Instance}. -\<close> - -State \<sigma>\<^sub>1' = - [ X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1 - , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2 - , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3 - , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4 ] - -text\<open> -Generally, generating meta-commands allows to perform various extensions -on the Toy language being embedded, without altering the semantics of a particular command:\<close> - -Transition \<sigma>\<^sub>1 \<sigma>\<^sub>1' - -text\<open> -@{command Transition} usually only takes ``bound variables'' as parameters -(not arbitrary \<open>\<lambda>\<close>-terms), however the semantics of @{command Transition} was extended -to mimic the support of some particular terms not restricted to variables. -This extension was implemented by executing some steps of ``\<open>\<zeta>\<close>-reductions rewriting rules'' -operating on the meta-level of commands. -First, it is at least needed to extend the syntax of expressions accepted by @{command Transition}, -we then modify the parsing so that a larger subset of \<open>\<lambda>\<close>-terms -can be given as parameters. -Starting from this expression: -\<^verbatim>\<open> -(*\<close>~\<^theory_text>\<open>Transition \<sigma>\<^sub>1 [ ([ salary = 1000 , boss = self 1 ] :: Person) ]\<close>~\<^verbatim>\<open>*)\<close> - -the rewriting begins with a first call to the next semantic floor, we obtain -the following meta-commands (where \<^theory_text>\<open>Transition [shallow]\<close> is an expression -in normal form): -\<^verbatim>\<open> -(*\<close>~\<^theory_text>\<open>State WFF_10_post = [ ([ "salary" = 1000, "boss" = self 1 ] :: Person) ]\<close>\<^verbatim>\<open> - \<close>~\<^theory_text>\<open>Transition[shallow] \<sigma>\<^sub>1 WFF_10_post\<close>~\<^verbatim>\<open>*)\<close> - -(\<open>WFF_10_post\<close> is an automatically generated name). - -The rewriting of the above @{command State} is performed in its turn. -Finally the overall ultimately terminates when reaching @{command Instance} being already -in normal form: -\<^verbatim>\<open> -(*\<close>~\<^theory_text>\<open>Instance WFF_10_post_object0 :: Person = [ "salary" = 1000, "boss" = [ ] ]\<close>\<^verbatim>\<open> - \<close>~\<^theory_text>\<open>State[shallow] WFF_10_post = [ WFF_10_post_object0 ]\<close>\<^verbatim>\<open> - \<close>~\<^theory_text>\<open>Transition[shallow] \<sigma>\<^sub>1 WFF_10_post\<close>~\<^verbatim>\<open>*)\<close> -\<close> - -subsection\<open>Designing Class Models (III): Interaction with (Pure) Term\<close> - -text\<open> -Meta-commands are obviously not restricted to manipulate expressions in the Outer Syntax level. -It is possible to build meta-commands so that Inner Syntax expressions are directly parsed. -However the dependencies of this theory have been minimized so that experimentations -and debugging can easily occur in @{keyword "deep"} mode -(this file only depends on @{theory FOCL.Generator_dynamic_sequential}). -Since the Inner Syntax expressions would perhaps manipulate expressions coming from other theories -than @{theory FOCL.Generator_dynamic_sequential}, -it can be desirable to consider the Inner Syntax container as a string and leave the parsing -for subsequent semantic floors. - -This is what is implemented here: -\<close> - -text{* -\<^verbatim>\<open>Context Person :: content () - Post "\<close>@{text "\<close>"}@{text "\<open>"}\<^verbatim>\<open>"\<close> -*} - -text{* -Here the expression ``@{text "\<close>"}@{text "\<open>"}'' is not well-typed in Isabelle, but an error is not raised -because the above expression is not (yet) parsed as an Inner Syntax element\footnote{ -In any case an error will not be raised, because the above code -is written in verbatim in the real \<^verbatim>\<open>.thy\<close> file, -however one can copy-paste this code out of the verbatim scope to see that -no errors are really raised. -For presentation purposes, it was embedded in verbatim because we will later discuss about -meta-commands generating Isabelle code, -and then what is generated by this meta-command is of course not well-typed!}. - -However, this is not the same for the resulting generated meta-command: -\<^verbatim>\<open> -(* Context [shallow] Person :: content () - Post : "(\<lambda> result self. (\<close>@{text "\<close>"}@{text "\<open>"}\<^verbatim>\<open>))" *)\<close> - -and an error is immediately raised because the parsing of Inner Syntax expressions -is activated in this case. -*} - -text\<open>For example, one can put the mouse, with the CTRL gesture, -over the variable @{term "a"}, @{term "b"} or @{term "c"} -to be convinced that they are free variables compared with above:\<close> - -Context[shallow] Person :: content () - Post : "a + b = c" - -subsection\<open>Designing Class Models (IV): Saving the Generated to File\<close> - -text\<open> -The experimentations usually finish by saving all the universe -and generated Isabelle theory to the hard disk: -\<^verbatim>\<open> -(*\<close>~\<^theory_text>\<open>generation_syntax deep flush_all\<close>~\<^verbatim>\<open>*)\<close> -\<close> - -text\<open> -Because meta-commands can force the recomputation of the universe of classes at any time, -the saving does not copy in output all generated code produced by meta-commands since the beginning, -but only all the code that was generated since the last recomputation. -\<close> - -subsection\<open>Designing Class Models (V): Inspection of Generated Files\<close> - -text\<open> -According to options given to the (first) command @{command generation_syntax} above, -we retrieve the first generated file in the mentioned directory: -@{file "../../doc/Employee_DesignModel_UMLPart_generated.thy"}. - -Because this file still contains meta-commands, we are here executing again -a new generating step inside this file, the new result becomes saved in -@{file "../../doc/Employee_DesignModel_UMLPart_generated_generated.thy"}. -As remark, in this last file, the dependency to @{theory FOCL.Generator_dynamic_sequential} was -automatically removed because the meta-compiler has detected the absence of meta-commands -in the generated content. - -Note: While the first generated file is intended to be always well-typed, -it can happen that subsequent generations will lead to a not well-typed file. -This is because the meta-compiler only saves the history of meta-commands. -In case some ``native'' Isabelle declarations -are generated among meta-commands, then these Isabelle declarations -are not saved by the meta-compiler, -so these declarations will not be again generated. -Anyway, we see potential solutions for solving this and -they would perhaps be implemented in a future version of the meta-compiler... -\<close> - -end diff --git a/Citadelle/examples/archive/Toy_shallow.thy b/Citadelle/examples/archive/Toy_shallow.thy deleted file mode 100644 index bc1e7f2958f737cb8d051b08dd4d71fb3dca890b..0000000000000000000000000000000000000000 --- a/Citadelle/examples/archive/Toy_shallow.thy +++ /dev/null @@ -1,141 +0,0 @@ -(****************************************************************************** - * HOL-TOY - * - * 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. - ******************************************************************************) - -section\<open>Example: A Class Model Interactively Executed\<close> -subsection\<open>Introduction\<close> - -theory - Toy_shallow -imports - OCL.UML_Main - FOCL.Static - FOCL.Generator_dynamic_sequential -begin -ML_file "~~/src/Doc/antiquote_setup.ML" - -text\<open> -In this example, we configure our package to execute tactic SML code -(corresponding to some generated \verb|.thy| file, @{file "Toy_deep.thy"} -details how to obtain such generated \verb|.thy| file). -Since SML code are already compiled (or reflected) and bound with the native Isabelle API in -@{theory FOCL.Generator_dynamic_sequential}, nothing is generated in this theory. -The system only parses arguments given to meta-commands and immediately calls the corresponding -compiled functions. - -The execution time is comparatively similar as if tactics were written by hand, -except that the generated SML code potentially inherits all optimizations performed -by the raw code generation of Isabelle (if any). -\<close> - -generation_syntax [ shallow (generation_semantics [ design ]) - (*SORRY*) (*no_dirty*) - (*, syntax_print*) ] -text\<open> -The configuration in @{keyword "shallow"} mode is straightforward: -in this mode @{command generation_syntax} basically terminates in $O(1)$. -\<close> - -subsection\<open>Designing Class Models (I): Basics\<close> - -Class Atom < Molecule - Attributes size : Integer -End - - End End End - -Class Molecule < Person - -Class Galaxy - Attributes wormhole : UnlimitedNatural - is_sound : Void -End! - -Class Person < Galaxy - Attributes salary : Integer - boss : Person - is_meta_thinking: Boolean - -Instance X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1 :: Person = [ salary = 1300 , boss = X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2 ] - and X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2 :: Person = [ salary = 1800 ] - -Instance X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3 :: Person = [ salary = 1 ] - -(* Class Big_Bang < Atom (* This will force the creation of a new universe. *) *) - -subsection\<open>Designing Class Models (II): Jumping to Another Semantic Floor\<close> - -State \<sigma>\<^sub>1 = - [ ([ salary = 1000 , boss = self 1 ] :: Person) - , ([ salary = 1200 ] :: Person) - (* *) - , ([ salary = 2600 , boss = self 3 ] :: Person) - , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1 - , ([ salary = 2300 , boss = self 2 ] :: Person) - (* *) - (* *) - , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2 ] - -Instance X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4 :: Person = [] - -State \<sigma>\<^sub>1' = - [ X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1 - , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2 - , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3 - , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4 ] - -Transition \<sigma>\<^sub>1 \<sigma>\<^sub>1' - -(* Transition \<sigma>\<^sub>1 [ ([ salary = 1000 , boss = self 1 ] :: Person) ] *) - -subsection\<open>Designing Class Models (III): Interaction with (Pure) Term\<close> - -text{* -Here in @{keyword "shallow"} mode, the following expression is directly rejected: -\<^verbatim>\<open> -(* Context Person :: content () - Post "\<close>@{text "\<close>"}@{text "\<open>"}\<^verbatim>\<open>" *)\<close> -*} - -consts dot__content :: "(\<AA>, '\<alpha>) val \<Rightarrow> Integer \<Rightarrow> Integer \<Rightarrow> Integer \<Rightarrow> Void" ("(_) .content'((_),(_),(_)')") -Context[shallow] Person :: content (a : Integer, b : Integer, c : Integer) - Post : "\<lambda>_ c b a _. a +\<^sub>i\<^sub>n\<^sub>t b \<doteq> c" - -end diff --git a/Citadelle/examples/empirical_evaluation/Class_model.thy b/Citadelle/examples/empirical_evaluation/Class_model.thy deleted file mode 100644 index 489a12ff7c87421d73ece568dbecef2ec170af73..0000000000000000000000000000000000000000 --- a/Citadelle/examples/empirical_evaluation/Class_model.thy +++ /dev/null @@ -1,130 +0,0 @@ -(****************************************************************************** - * Citadelle - * - * 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 Class_model -imports FOCL.Core_init -begin - -definition "print_class = - (\<lambda> (C_out_OclAny, s) \<Rightarrow> S.flatten [\<open>Class \<close>, s, \<open> End\<close>] - | (C_out_simple s1, s2) \<Rightarrow> S.flatten [\<open>Class \<close>, s2, \<open> < \<close>, s1, \<open> End\<close>])" - -definition \<open>print_abr sprintf_int write_file = - (let sprintf_int = sprintf_int o natural_of_nat - ; S_flatten_n = S.flatten o L.map (\<lambda>s. S.flatten [s, \<lless>[0x0A]\<ggreater>]) in - L.flatten o L.flatten o L.map (\<lambda> (nb_child, deep). - let body = L.map print_class (fst (mk_tree nb_child deep 0)) - ; tree_name = S.flatten [\<open>Tree_\<close>, sprintf_int nb_child, \<open>_\<close>, sprintf_int deep] in - - L.map - (\<lambda> ((gen_mode, gen_comp), gen_import, gen_init, gen_flush). - L.map - (\<lambda>(comp, comp2). - let filename = S.flatten [tree_name, \<open>_\<close>, gen_mode, if String.to_list comp = [] then \<open>\<close> else S.flatten [\<open>_\<close>, comp]] in - write_file - (S.flatten [filename, \<open>.thy\<close>]) - (L.flatten - [ [ S.flatten [\<open>theory \<close>, filename, \<open> imports \<close>, gen_import, \<open> \<close>, - \<open>"../../src/compiler/Generator_dynamic_sequential"\<close>, - \<open> begin\<close>] - , gen_init comp comp2] - , body - , [ \<open>\<close> - , S.flatten [\<open>(* \<close>, String.nat_to_digit10 (length body), \<open> *)\<close> ] - , \<open>\<close> - , gen_flush - , \<open>\<close> - , \<open>end\<close> ] ])) gen_comp) - [ ( (\<open>deep\<close>, [ (\<open>Haskell\<close>, \<open>\<close>) - , (\<open>OCaml\<close>, \<open>module_name M\<close>) - , (\<open>Scala\<close>, \<open>module_name M\<close>) - , (\<open>SML\<close>, \<open>module_name M\<close>) - , (\<open>self\<close>, \<open>\<close>) ]) - , \<open>\<close> - , \<lambda> comp comp2. - S_flatten_n [ \<open>generation_syntax [ deep\<close> - , \<open> (generation_semantics [ analysis (*, oid_start 10*) ])\<close> - , \<open> skip_export\<close> - , S.flatten [\<open> (THEORY \<close>, tree_name, \<open>_generated\<close>, \<open>_\<close>, comp, \<open>)\<close>] - , S.flatten [\<open> (IMPORTS ["../../../src/UML_Main", "../../../src/compiler/Static"]\<close>] - , S.flatten [\<open> "../../../src/compiler/Generator_dynamic_sequential")\<close>] - , \<open> SECTION\<close> - , S.flatten [\<open> [ in \<close>, comp, \<open> \<close>, comp2, \<open> ]\<close>] - , S.flatten [\<open> (output_directory "./doc") ]\<close>] ] - , S_flatten_n [ \<open>generation_syntax deep flush_all\<close> ]) - , ( (\<open>shallow\<close>, [(\<open>\<close>, \<open>\<close>)]) - , S.flatten [ \<open>"../../src/UML_Main"\<close>, \<open> \<close> - , \<open>"../../src/compiler/Static"\<close> ] - , \<lambda>_ _. S_flatten_n [ \<open>generation_syntax [ shallow (generation_semantics [ analysis ]) ]\<close> ] - , \<open>End!\<close>) ]))\<close> - -definition "main sprintf_int write_file = print_abr (\<lambda>n. \<lless>sprintf_int n\<ggreater>) (\<lambda>f l. write_file (String.to_list f) (L.map String.to_list l)) - (let f = List.fold (\<lambda> n l. (1, n) # (n, 1) # l) in - [ (* 0 *) (1, 0) - , (* 1 *) (1, 1) ] - @@@@ - f [ 2, 3, 4, 5, 6, 7(*, 8, 9*) ] - [ (* 6 *) (2, 2) ] - - @@@@ - f [ 12, 14, 20, 30, 39, 42, 56 ] - [ (* 14 *) (2, 3) - , (* 30 *) (2, 4) - , (* 12 *) (3, 2) - , (* 39 *) (3, 3) - , (* 20 *) (4, 2) - , (* 30 *) (5, 2) - , (* 42 *) (6, 2) - , (* 56 *) (7, 2) ] -(* - @@@@ - f [ 62, 72, 84, 90 ] - [ (* 62 *) (2, 5) - , (* 84 *) (4, 3) - , (* 72 *) (8, 2) - , (* 90 *) (9, 2) ]*))" -(* -export_code open main - in OCaml module_name M file "class_model_isabelle.ml" -*) -end diff --git a/Citadelle/examples/empirical_evaluation/Tree_01_00_deep_self.thy b/Citadelle/examples/empirical_evaluation/Tree_01_00_deep_self.thy deleted file mode 100644 index a689d158ba3546f76db894a66ca070a3c3fbfda6..0000000000000000000000000000000000000000 --- a/Citadelle/examples/empirical_evaluation/Tree_01_00_deep_self.thy +++ /dev/null @@ -1,18 +0,0 @@ -theory Tree_01_00_deep_self imports "../../src/compiler/Generator_dynamic_sequential" begin -generation_syntax [ deep - (generation_semantics [ analysis (*, oid_start 10*) ]) - skip_export - (THEORY Tree_01_00_generated_self) - (IMPORTS ["../../../src/UML_Main", "../../../src/compiler/Static"] - "../../../src/compiler/Generator_dynamic_sequential") - SECTION - [ in self ] - (output_directory "./doc") ] - - -(* 0 *) - -generation_syntax deep flush_all - - -end diff --git a/Citadelle/examples/empirical_evaluation/Tree_01_00_shallow.thy b/Citadelle/examples/empirical_evaluation/Tree_01_00_shallow.thy deleted file mode 100644 index 40a78880709e9c21b1cbd0e4014152af81b4ece0..0000000000000000000000000000000000000000 --- a/Citadelle/examples/empirical_evaluation/Tree_01_00_shallow.thy +++ /dev/null @@ -1,9 +0,0 @@ -theory Tree_01_00_shallow imports "../../src/UML_Main" "../../src/compiler/Static" "../../src/compiler/Generator_dynamic_sequential" begin -generation_syntax [ shallow (generation_semantics [ analysis ]) ] - - -(* 0 *) - -End! - -end diff --git a/Citadelle/examples/empirical_evaluation/Tree_01_01_deep_self.thy b/Citadelle/examples/empirical_evaluation/Tree_01_01_deep_self.thy deleted file mode 100644 index 468789461687f35d9e7bac8645ac2ccc147934c0..0000000000000000000000000000000000000000 --- a/Citadelle/examples/empirical_evaluation/Tree_01_01_deep_self.thy +++ /dev/null @@ -1,19 +0,0 @@ -theory Tree_01_01_deep_self imports "../../src/compiler/Generator_dynamic_sequential" begin -generation_syntax [ deep - (generation_semantics [ analysis (*, oid_start 10*) ]) - skip_export - (THEORY Tree_01_01_generated_self) - (IMPORTS ["../../../src/UML_Main", "../../../src/compiler/Static"] - "../../../src/compiler/Generator_dynamic_sequential") - SECTION - [ in self ] - (output_directory "./doc") ] - -Class Aazz End - -(* 1 *) - -generation_syntax deep flush_all - - -end diff --git a/Citadelle/examples/empirical_evaluation/Tree_01_01_shallow.thy b/Citadelle/examples/empirical_evaluation/Tree_01_01_shallow.thy deleted file mode 100644 index c07ce6092e91eb64bb3b1ffa159e1261d2b93e6f..0000000000000000000000000000000000000000 --- a/Citadelle/examples/empirical_evaluation/Tree_01_01_shallow.thy +++ /dev/null @@ -1,10 +0,0 @@ -theory Tree_01_01_shallow imports "../../src/UML_Main" "../../src/compiler/Static" "../../src/compiler/Generator_dynamic_sequential" begin -generation_syntax [ shallow (generation_semantics [ analysis ]) ] - -Class Aazz End - -(* 1 *) - -End! - -end diff --git a/Citadelle/examples/empirical_evaluation/Tree_01_02_deep_self.thy b/Citadelle/examples/empirical_evaluation/Tree_01_02_deep_self.thy deleted file mode 100644 index 0c6dcf4a657a97c04e0e0bc6527104f493f9a54a..0000000000000000000000000000000000000000 --- a/Citadelle/examples/empirical_evaluation/Tree_01_02_deep_self.thy +++ /dev/null @@ -1,20 +0,0 @@ -theory Tree_01_02_deep_self imports "../../src/compiler/Generator_dynamic_sequential" begin -generation_syntax [ deep - (generation_semantics [ analysis (*, oid_start 10*) ]) - skip_export - (THEORY Tree_01_02_generated_self) - (IMPORTS ["../../../src/UML_Main", "../../../src/compiler/Static"] - "../../../src/compiler/Generator_dynamic_sequential") - SECTION - [ in self ] - (output_directory "./doc") ] - -Class Aazz End -Class Bbyy < Aazz End - -(* 2 *) - -generation_syntax deep flush_all - - -end diff --git a/Citadelle/examples/empirical_evaluation/Tree_01_02_shallow.thy b/Citadelle/examples/empirical_evaluation/Tree_01_02_shallow.thy deleted file mode 100644 index 762a3552ed130909971d73b97885a941920e8b09..0000000000000000000000000000000000000000 --- a/Citadelle/examples/empirical_evaluation/Tree_01_02_shallow.thy +++ /dev/null @@ -1,11 +0,0 @@ -theory Tree_01_02_shallow imports "../../src/UML_Main" "../../src/compiler/Static" "../../src/compiler/Generator_dynamic_sequential" begin -generation_syntax [ shallow (generation_semantics [ analysis ]) ] - -Class Aazz End -Class Bbyy < Aazz End - -(* 2 *) - -End! - -end diff --git a/Citadelle/examples/empirical_evaluation/Tree_01_03_deep_self.thy b/Citadelle/examples/empirical_evaluation/Tree_01_03_deep_self.thy deleted file mode 100644 index 29c10c57bf4b96c8ccc7a5a3f21dfd862cdfb2d7..0000000000000000000000000000000000000000 --- a/Citadelle/examples/empirical_evaluation/Tree_01_03_deep_self.thy +++ /dev/null @@ -1,21 +0,0 @@ -theory Tree_01_03_deep_self imports "../../src/compiler/Generator_dynamic_sequential" begin -generation_syntax [ deep - (generation_semantics [ analysis (*, oid_start 10*) ]) - skip_export - (THEORY Tree_01_03_generated_self) - (IMPORTS ["../../../src/UML_Main", "../../../src/compiler/Static"] - "../../../src/compiler/Generator_dynamic_sequential") - SECTION - [ in self ] - (output_directory "./doc") ] - -Class Aazz End -Class Bbyy < Aazz End -Class Ccxx < Bbyy End - -(* 3 *) - -generation_syntax deep flush_all - - -end diff --git a/Citadelle/examples/empirical_evaluation/Tree_01_03_shallow.thy b/Citadelle/examples/empirical_evaluation/Tree_01_03_shallow.thy deleted file mode 100644 index 45f404ccf2dddf52b100cf46a7bcc99ed2df2485..0000000000000000000000000000000000000000 --- a/Citadelle/examples/empirical_evaluation/Tree_01_03_shallow.thy +++ /dev/null @@ -1,12 +0,0 @@ -theory Tree_01_03_shallow imports "../../src/UML_Main" "../../src/compiler/Static" "../../src/compiler/Generator_dynamic_sequential" begin -generation_syntax [ shallow (generation_semantics [ analysis ]) ] - -Class Aazz End -Class Bbyy < Aazz End -Class Ccxx < Bbyy End - -(* 3 *) - -End! - -end diff --git a/Citadelle/examples/empirical_evaluation/Tree_01_04_deep_self.thy b/Citadelle/examples/empirical_evaluation/Tree_01_04_deep_self.thy deleted file mode 100644 index cc0f462d1aceecafa1a790f3336528ba34428f00..0000000000000000000000000000000000000000 --- a/Citadelle/examples/empirical_evaluation/Tree_01_04_deep_self.thy +++ /dev/null @@ -1,22 +0,0 @@ -theory Tree_01_04_deep_self imports "../../src/compiler/Generator_dynamic_sequential" begin -generation_syntax [ deep - (generation_semantics [ analysis (*, oid_start 10*) ]) - skip_export - (THEORY Tree_01_04_generated_self) - (IMPORTS ["../../../src/UML_Main", "../../../src/compiler/Static"] - "../../../src/compiler/Generator_dynamic_sequential") - SECTION - [ in self ] - (output_directory "./doc") ] - -Class Aazz End -Class Bbyy < Aazz End -Class Ccxx < Bbyy End -Class Ddww < Ccxx End - -(* 4 *) - -generation_syntax deep flush_all - - -end diff --git a/Citadelle/examples/empirical_evaluation/Tree_01_04_shallow.thy b/Citadelle/examples/empirical_evaluation/Tree_01_04_shallow.thy deleted file mode 100644 index e936c9f66092ef475f6d7a6d053f9323abe55d16..0000000000000000000000000000000000000000 --- a/Citadelle/examples/empirical_evaluation/Tree_01_04_shallow.thy +++ /dev/null @@ -1,13 +0,0 @@ -theory Tree_01_04_shallow imports "../../src/UML_Main" "../../src/compiler/Static" "../../src/compiler/Generator_dynamic_sequential" begin -generation_syntax [ shallow (generation_semantics [ analysis ]) ] - -Class Aazz End -Class Bbyy < Aazz End -Class Ccxx < Bbyy End -Class Ddww < Ccxx End - -(* 4 *) - -End! - -end diff --git a/Citadelle/examples/empirical_evaluation/Tree_01_05_deep_self.thy b/Citadelle/examples/empirical_evaluation/Tree_01_05_deep_self.thy deleted file mode 100644 index 5423deb8e804368a84469b994f46acaa685effa1..0000000000000000000000000000000000000000 --- a/Citadelle/examples/empirical_evaluation/Tree_01_05_deep_self.thy +++ /dev/null @@ -1,23 +0,0 @@ -theory Tree_01_05_deep_self imports "../../src/compiler/Generator_dynamic_sequential" begin -generation_syntax [ deep - (generation_semantics [ analysis (*, oid_start 10*) ]) - skip_export - (THEORY Tree_01_05_generated_self) - (IMPORTS ["../../../src/UML_Main", "../../../src/compiler/Static"] - "../../../src/compiler/Generator_dynamic_sequential") - SECTION - [ in self ] - (output_directory "./doc") ] - -Class Aazz End -Class Bbyy < Aazz End -Class Ccxx < Bbyy End -Class Ddww < Ccxx End -Class Eevv < Ddww End - -(* 5 *) - -generation_syntax deep flush_all - - -end diff --git a/Citadelle/examples/empirical_evaluation/Tree_01_05_shallow.thy b/Citadelle/examples/empirical_evaluation/Tree_01_05_shallow.thy deleted file mode 100644 index b03b69f069b500005394b499a05d99659da46470..0000000000000000000000000000000000000000 --- a/Citadelle/examples/empirical_evaluation/Tree_01_05_shallow.thy +++ /dev/null @@ -1,14 +0,0 @@ -theory Tree_01_05_shallow imports "../../src/UML_Main" "../../src/compiler/Static" "../../src/compiler/Generator_dynamic_sequential" begin -generation_syntax [ shallow (generation_semantics [ analysis ]) ] - -Class Aazz End -Class Bbyy < Aazz End -Class Ccxx < Bbyy End -Class Ddww < Ccxx End -Class Eevv < Ddww End - -(* 5 *) - -End! - -end diff --git a/Citadelle/examples/empirical_evaluation/Tree_01_06_deep_self.thy b/Citadelle/examples/empirical_evaluation/Tree_01_06_deep_self.thy deleted file mode 100644 index ee05c260fbb5ff7a8e35d275129525ec7bfeebdc..0000000000000000000000000000000000000000 --- a/Citadelle/examples/empirical_evaluation/Tree_01_06_deep_self.thy +++ /dev/null @@ -1,24 +0,0 @@ -theory Tree_01_06_deep_self imports "../../src/compiler/Generator_dynamic_sequential" begin -generation_syntax [ deep - (generation_semantics [ analysis (*, oid_start 10*) ]) - skip_export - (THEORY Tree_01_06_generated_self) - (IMPORTS ["../../../src/UML_Main", "../../../src/compiler/Static"] - "../../../src/compiler/Generator_dynamic_sequential") - SECTION - [ in self ] - (output_directory "./doc") ] - -Class Aazz End -Class Bbyy < Aazz End -Class Ccxx < Bbyy End -Class Ddww < Ccxx End -Class Eevv < Ddww End -Class Ffuu < Eevv End - -(* 6 *) - -generation_syntax deep flush_all - - -end diff --git a/Citadelle/examples/empirical_evaluation/Tree_01_06_shallow.thy b/Citadelle/examples/empirical_evaluation/Tree_01_06_shallow.thy deleted file mode 100644 index 031c8621a459075057a664a03db410f00cee75ab..0000000000000000000000000000000000000000 --- a/Citadelle/examples/empirical_evaluation/Tree_01_06_shallow.thy +++ /dev/null @@ -1,15 +0,0 @@ -theory Tree_01_06_shallow imports "../../src/UML_Main" "../../src/compiler/Static" "../../src/compiler/Generator_dynamic_sequential" begin -generation_syntax [ shallow (generation_semantics [ analysis ]) ] - -Class Aazz End -Class Bbyy < Aazz End -Class Ccxx < Bbyy End -Class Ddww < Ccxx End -Class Eevv < Ddww End -Class Ffuu < Eevv End - -(* 6 *) - -End! - -end diff --git a/Citadelle/examples/empirical_evaluation/Tree_01_07_deep_self.thy b/Citadelle/examples/empirical_evaluation/Tree_01_07_deep_self.thy deleted file mode 100644 index 3f6319354235c8958a6dbb9b01bb0433cc359fc0..0000000000000000000000000000000000000000 --- a/Citadelle/examples/empirical_evaluation/Tree_01_07_deep_self.thy +++ /dev/null @@ -1,25 +0,0 @@ -theory Tree_01_07_deep_self imports "../../src/compiler/Generator_dynamic_sequential" begin -generation_syntax [ deep - (generation_semantics [ analysis (*, oid_start 10*) ]) - skip_export - (THEORY Tree_01_07_generated_self) - (IMPORTS ["../../../src/UML_Main", "../../../src/compiler/Static"] - "../../../src/compiler/Generator_dynamic_sequential") - SECTION - [ in self ] - (output_directory "./doc") ] - -Class Aazz End -Class Bbyy < Aazz End -Class Ccxx < Bbyy End -Class Ddww < Ccxx End -Class Eevv < Ddww End -Class Ffuu < Eevv End -Class Ggtt < Ffuu End - -(* 7 *) - -generation_syntax deep flush_all - - -end diff --git a/Citadelle/examples/empirical_evaluation/Tree_01_07_shallow.thy b/Citadelle/examples/empirical_evaluation/Tree_01_07_shallow.thy deleted file mode 100644 index 7440f961722bcbd2d75a3344c10dcfbeeb9d70ac..0000000000000000000000000000000000000000 --- a/Citadelle/examples/empirical_evaluation/Tree_01_07_shallow.thy +++ /dev/null @@ -1,16 +0,0 @@ -theory Tree_01_07_shallow imports "../../src/UML_Main" "../../src/compiler/Static" "../../src/compiler/Generator_dynamic_sequential" begin -generation_syntax [ shallow (generation_semantics [ analysis ]) ] - -Class Aazz End -Class Bbyy < Aazz End -Class Ccxx < Bbyy End -Class Ddww < Ccxx End -Class Eevv < Ddww End -Class Ffuu < Eevv End -Class Ggtt < Ffuu End - -(* 7 *) - -End! - -end diff --git a/Citadelle/examples/empirical_evaluation/Tree_01_12_deep_self.thy b/Citadelle/examples/empirical_evaluation/Tree_01_12_deep_self.thy deleted file mode 100644 index 97defe1e4478338fddf82cec55abbef42b811070..0000000000000000000000000000000000000000 --- a/Citadelle/examples/empirical_evaluation/Tree_01_12_deep_self.thy +++ /dev/null @@ -1,30 +0,0 @@ -theory Tree_01_12_deep_self imports "../../src/compiler/Generator_dynamic_sequential" begin -generation_syntax [ deep - (generation_semantics [ analysis (*, oid_start 10*) ]) - skip_export - (THEORY Tree_01_12_generated_self) - (IMPORTS ["../../../src/UML_Main", "../../../src/compiler/Static"] - "../../../src/compiler/Generator_dynamic_sequential") - SECTION - [ in self ] - (output_directory "./doc") ] - -Class Aazz End -Class Bbyy < Aazz End -Class Ccxx < Bbyy End -Class Ddww < Ccxx End -Class Eevv < Ddww End -Class Ffuu < Eevv End -Class Ggtt < Ffuu End -Class Hhss < Ggtt End -Class Iirr < Hhss End -Class Jjqq < Iirr End -Class Kkpp < Jjqq End -Class Lloo < Kkpp End - -(* 12 *) - -generation_syntax deep flush_all - - -end diff --git a/Citadelle/examples/empirical_evaluation/Tree_01_12_shallow.thy b/Citadelle/examples/empirical_evaluation/Tree_01_12_shallow.thy deleted file mode 100644 index 50ca01efbe4310ceae98036dde35e528283f253a..0000000000000000000000000000000000000000 --- a/Citadelle/examples/empirical_evaluation/Tree_01_12_shallow.thy +++ /dev/null @@ -1,21 +0,0 @@ -theory Tree_01_12_shallow imports "../../src/UML_Main" "../../src/compiler/Static" "../../src/compiler/Generator_dynamic_sequential" begin -generation_syntax [ shallow (generation_semantics [ analysis ]) ] - -Class Aazz End -Class Bbyy < Aazz End -Class Ccxx < Bbyy End -Class Ddww < Ccxx End -Class Eevv < Ddww End -Class Ffuu < Eevv End -Class Ggtt < Ffuu End -Class Hhss < Ggtt End -Class Iirr < Hhss End -Class Jjqq < Iirr End -Class Kkpp < Jjqq End -Class Lloo < Kkpp End - -(* 12 *) - -End! - -end diff --git a/Citadelle/examples/empirical_evaluation/Tree_01_14_deep_self.thy b/Citadelle/examples/empirical_evaluation/Tree_01_14_deep_self.thy deleted file mode 100644 index 4f9ee9e87e10d5e1c5e2f9b7092616290516c9f5..0000000000000000000000000000000000000000 --- a/Citadelle/examples/empirical_evaluation/Tree_01_14_deep_self.thy +++ /dev/null @@ -1,32 +0,0 @@ -theory Tree_01_14_deep_self imports "../../src/compiler/Generator_dynamic_sequential" begin -generation_syntax [ deep - (generation_semantics [ analysis (*, oid_start 10*) ]) - skip_export - (THEORY Tree_01_14_generated_self) - (IMPORTS ["../../../src/UML_Main", "../../../src/compiler/Static"] - "../../../src/compiler/Generator_dynamic_sequential") - SECTION - [ in self ] - (output_directory "./doc") ] - -Class Aazz End -Class Bbyy < Aazz End -Class Ccxx < Bbyy End -Class Ddww < Ccxx End -Class Eevv < Ddww End -Class Ffuu < Eevv End -Class Ggtt < Ffuu End -Class Hhss < Ggtt End -Class Iirr < Hhss End -Class Jjqq < Iirr End -Class Kkpp < Jjqq End -Class Lloo < Kkpp End -Class Mmnn < Lloo End -Class Nnmm < Mmnn End - -(* 14 *) - -generation_syntax deep flush_all - - -end diff --git a/Citadelle/examples/empirical_evaluation/Tree_01_14_shallow.thy b/Citadelle/examples/empirical_evaluation/Tree_01_14_shallow.thy deleted file mode 100644 index 5f117645820a764f4b5eb06d89e00b7fb0bd6fd2..0000000000000000000000000000000000000000 --- a/Citadelle/examples/empirical_evaluation/Tree_01_14_shallow.thy +++ /dev/null @@ -1,23 +0,0 @@ -theory Tree_01_14_shallow imports "../../src/UML_Main" "../../src/compiler/Static" "../../src/compiler/Generator_dynamic_sequential" begin -generation_syntax [ shallow (generation_semantics [ analysis ]) ] - -Class Aazz End -Class Bbyy < Aazz End -Class Ccxx < Bbyy End -Class Ddww < Ccxx End -Class Eevv < Ddww End -Class Ffuu < Eevv End -Class Ggtt < Ffuu End -Class Hhss < Ggtt End -Class Iirr < Hhss End -Class Jjqq < Iirr End -Class Kkpp < Jjqq End -Class Lloo < Kkpp End -Class Mmnn < Lloo End -Class Nnmm < Mmnn End - -(* 14 *) - -End! - -end diff --git a/Citadelle/examples/empirical_evaluation/Tree_01_20_deep_self.thy b/Citadelle/examples/empirical_evaluation/Tree_01_20_deep_self.thy deleted file mode 100644 index e27ab0f14042c25d0ff9cfcdf34aacf009dd1226..0000000000000000000000000000000000000000 --- a/Citadelle/examples/empirical_evaluation/Tree_01_20_deep_self.thy +++ /dev/null @@ -1,38 +0,0 @@ -theory Tree_01_20_deep_self imports "../../src/compiler/Generator_dynamic_sequential" begin -generation_syntax [ deep - (generation_semantics [ analysis (*, oid_start 10*) ]) - skip_export - (THEORY Tree_01_20_generated_self) - (IMPORTS ["../../../src/UML_Main", "../../../src/compiler/Static"] - "../../../src/compiler/Generator_dynamic_sequential") - SECTION - [ in self ] - (output_directory "./doc") ] - -Class Aazz End -Class Bbyy < Aazz End -Class Ccxx < Bbyy End -Class Ddww < Ccxx End -Class Eevv < Ddww End -Class Ffuu < Eevv End -Class Ggtt < Ffuu End -Class Hhss < Ggtt End -Class Iirr < Hhss End -Class Jjqq < Iirr End -Class Kkpp < Jjqq End -Class Lloo < Kkpp End -Class Mmnn < Lloo End -Class Nnmm < Mmnn End -Class Ooll < Nnmm End -Class Ppkk < Ooll End -Class Qqjj < Ppkk End -Class Rrii < Qqjj End -Class Sshh < Rrii End -Class Ttgg < Sshh End - -(* 20 *) - -generation_syntax deep flush_all - - -end diff --git a/Citadelle/examples/empirical_evaluation/Tree_01_20_shallow.thy b/Citadelle/examples/empirical_evaluation/Tree_01_20_shallow.thy deleted file mode 100644 index 9e6e6d3d2b88771d030be412154b82eaeecc4c5a..0000000000000000000000000000000000000000 --- a/Citadelle/examples/empirical_evaluation/Tree_01_20_shallow.thy +++ /dev/null @@ -1,29 +0,0 @@ -theory Tree_01_20_shallow imports "../../src/UML_Main" "../../src/compiler/Static" "../../src/compiler/Generator_dynamic_sequential" begin -generation_syntax [ shallow (generation_semantics [ analysis ]) ] - -Class Aazz End -Class Bbyy < Aazz End -Class Ccxx < Bbyy End -Class Ddww < Ccxx End -Class Eevv < Ddww End -Class Ffuu < Eevv End -Class Ggtt < Ffuu End -Class Hhss < Ggtt End -Class Iirr < Hhss End -Class Jjqq < Iirr End -Class Kkpp < Jjqq End -Class Lloo < Kkpp End -Class Mmnn < Lloo End -Class Nnmm < Mmnn End -Class Ooll < Nnmm End -Class Ppkk < Ooll End -Class Qqjj < Ppkk End -Class Rrii < Qqjj End -Class Sshh < Rrii End -Class Ttgg < Sshh End - -(* 20 *) - -End! - -end diff --git a/Citadelle/examples/empirical_evaluation/Tree_01_30_deep_self.thy b/Citadelle/examples/empirical_evaluation/Tree_01_30_deep_self.thy deleted file mode 100644 index 3dadc34d688e92d8ef62627222af9c9f4e13faa0..0000000000000000000000000000000000000000 --- a/Citadelle/examples/empirical_evaluation/Tree_01_30_deep_self.thy +++ /dev/null @@ -1,48 +0,0 @@ -theory Tree_01_30_deep_self imports "../../src/compiler/Generator_dynamic_sequential" begin -generation_syntax [ deep - (generation_semantics [ analysis (*, oid_start 10*) ]) - skip_export - (THEORY Tree_01_30_generated_self) - (IMPORTS ["../../../src/UML_Main", "../../../src/compiler/Static"] - "../../../src/compiler/Generator_dynamic_sequential") - SECTION - [ in self ] - (output_directory "./doc") ] - -Class Aazz End -Class Bbyy < Aazz End -Class Ccxx < Bbyy End -Class Ddww < Ccxx End -Class Eevv < Ddww End -Class Ffuu < Eevv End -Class Ggtt < Ffuu End -Class Hhss < Ggtt End -Class Iirr < Hhss End -Class Jjqq < Iirr End -Class Kkpp < Jjqq End -Class Lloo < Kkpp End -Class Mmnn < Lloo End -Class Nnmm < Mmnn End -Class Ooll < Nnmm End -Class Ppkk < Ooll End -Class Qqjj < Ppkk End -Class Rrii < Qqjj End -Class Sshh < Rrii End -Class Ttgg < Sshh End -Class Uuff < Ttgg End -Class Vvee < Uuff End -Class Wwdd < Vvee End -Class Xxcc < Wwdd End -Class Yybb < Xxcc End -Class Zzaa < Yybb End -Class Baba < Zzaa End -Class Bbbb < Baba End -Class Bcbc < Bbbb End -Class Bdbd < Bcbc End - -(* 30 *) - -generation_syntax deep flush_all - - -end diff --git a/Citadelle/examples/empirical_evaluation/Tree_01_30_shallow.thy b/Citadelle/examples/empirical_evaluation/Tree_01_30_shallow.thy deleted file mode 100644 index 0d3c30e32b919fb493ae408a1a60b6a410f46e49..0000000000000000000000000000000000000000 --- a/Citadelle/examples/empirical_evaluation/Tree_01_30_shallow.thy +++ /dev/null @@ -1,39 +0,0 @@ -theory Tree_01_30_shallow imports "../../src/UML_Main" "../../src/compiler/Static" "../../src/compiler/Generator_dynamic_sequential" begin -generation_syntax [ shallow (generation_semantics [ analysis ]) ] - -Class Aazz End -Class Bbyy < Aazz End -Class Ccxx < Bbyy End -Class Ddww < Ccxx End -Class Eevv < Ddww End -Class Ffuu < Eevv End -Class Ggtt < Ffuu End -Class Hhss < Ggtt End -Class Iirr < Hhss End -Class Jjqq < Iirr End -Class Kkpp < Jjqq End -Class Lloo < Kkpp End -Class Mmnn < Lloo End -Class Nnmm < Mmnn End -Class Ooll < Nnmm End -Class Ppkk < Ooll End -Class Qqjj < Ppkk End -Class Rrii < Qqjj End -Class Sshh < Rrii End -Class Ttgg < Sshh End -Class Uuff < Ttgg End -Class Vvee < Uuff End -Class Wwdd < Vvee End -Class Xxcc < Wwdd End -Class Yybb < Xxcc End -Class Zzaa < Yybb End -Class Baba < Zzaa End -Class Bbbb < Baba End -Class Bcbc < Bbbb End -Class Bdbd < Bcbc End - -(* 30 *) - -End! - -end diff --git a/Citadelle/examples/empirical_evaluation/Tree_01_39_deep_self.thy b/Citadelle/examples/empirical_evaluation/Tree_01_39_deep_self.thy deleted file mode 100644 index 315b00198d89bac0a41f6434bf6b2d8fcdd616a2..0000000000000000000000000000000000000000 --- a/Citadelle/examples/empirical_evaluation/Tree_01_39_deep_self.thy +++ /dev/null @@ -1,57 +0,0 @@ -theory Tree_01_39_deep_self imports "../../src/compiler/Generator_dynamic_sequential" begin -generation_syntax [ deep - (generation_semantics [ analysis (*, oid_start 10*) ]) - skip_export - (THEORY Tree_01_39_generated_self) - (IMPORTS ["../../../src/UML_Main", "../../../src/compiler/Static"] - "../../../src/compiler/Generator_dynamic_sequential") - SECTION - [ in self ] - (output_directory "./doc") ] - -Class Aazz End -Class Bbyy < Aazz End -Class Ccxx < Bbyy End -Class Ddww < Ccxx End -Class Eevv < Ddww End -Class Ffuu < Eevv End -Class Ggtt < Ffuu End -Class Hhss < Ggtt End -Class Iirr < Hhss End -Class Jjqq < Iirr End -Class Kkpp < Jjqq End -Class Lloo < Kkpp End -Class Mmnn < Lloo End -Class Nnmm < Mmnn End -Class Ooll < Nnmm End -Class Ppkk < Ooll End -Class Qqjj < Ppkk End -Class Rrii < Qqjj End -Class Sshh < Rrii End -Class Ttgg < Sshh End -Class Uuff < Ttgg End -Class Vvee < Uuff End -Class Wwdd < Vvee End -Class Xxcc < Wwdd End -Class Yybb < Xxcc End -Class Zzaa < Yybb End -Class Baba < Zzaa End -Class Bbbb < Baba End -Class Bcbc < Bbbb End -Class Bdbd < Bcbc End -Class Bebe < Bdbd End -Class Bfbf < Bebe End -Class Bgbg < Bfbf End -Class Bhbh < Bgbg End -Class Bibi < Bhbh End -Class Bjbj < Bibi End -Class Bkbk < Bjbj End -Class Blbl < Bkbk End -Class Bmbm < Blbl End - -(* 39 *) - -generation_syntax deep flush_all - - -end diff --git a/Citadelle/examples/empirical_evaluation/Tree_01_39_shallow.thy b/Citadelle/examples/empirical_evaluation/Tree_01_39_shallow.thy deleted file mode 100644 index d71c26983568acc6d162a3822befab635eb2cb64..0000000000000000000000000000000000000000 --- a/Citadelle/examples/empirical_evaluation/Tree_01_39_shallow.thy +++ /dev/null @@ -1,48 +0,0 @@ -theory Tree_01_39_shallow imports "../../src/UML_Main" "../../src/compiler/Static" "../../src/compiler/Generator_dynamic_sequential" begin -generation_syntax [ shallow (generation_semantics [ analysis ]) ] - -Class Aazz End -Class Bbyy < Aazz End -Class Ccxx < Bbyy End -Class Ddww < Ccxx End -Class Eevv < Ddww End -Class Ffuu < Eevv End -Class Ggtt < Ffuu End -Class Hhss < Ggtt End -Class Iirr < Hhss End -Class Jjqq < Iirr End -Class Kkpp < Jjqq End -Class Lloo < Kkpp End -Class Mmnn < Lloo End -Class Nnmm < Mmnn End -Class Ooll < Nnmm End -Class Ppkk < Ooll End -Class Qqjj < Ppkk End -Class Rrii < Qqjj End -Class Sshh < Rrii End -Class Ttgg < Sshh End -Class Uuff < Ttgg End -Class Vvee < Uuff End -Class Wwdd < Vvee End -Class Xxcc < Wwdd End -Class Yybb < Xxcc End -Class Zzaa < Yybb End -Class Baba < Zzaa End -Class Bbbb < Baba End -Class Bcbc < Bbbb End -Class Bdbd < Bcbc End -Class Bebe < Bdbd End -Class Bfbf < Bebe End -Class Bgbg < Bfbf End -Class Bhbh < Bgbg End -Class Bibi < Bhbh End -Class Bjbj < Bibi End -Class Bkbk < Bjbj End -Class Blbl < Bkbk End -Class Bmbm < Blbl End - -(* 39 *) - -End! - -end diff --git a/Citadelle/examples/empirical_evaluation/Tree_01_42_deep_self.thy b/Citadelle/examples/empirical_evaluation/Tree_01_42_deep_self.thy deleted file mode 100644 index 97809197ea1c9639c4d41a17e3f17c99b49ccc8b..0000000000000000000000000000000000000000 --- a/Citadelle/examples/empirical_evaluation/Tree_01_42_deep_self.thy +++ /dev/null @@ -1,60 +0,0 @@ -theory Tree_01_42_deep_self imports "../../src/compiler/Generator_dynamic_sequential" begin -generation_syntax [ deep - (generation_semantics [ analysis (*, oid_start 10*) ]) - skip_export - (THEORY Tree_01_42_generated_self) - (IMPORTS ["../../../src/UML_Main", "../../../src/compiler/Static"] - "../../../src/compiler/Generator_dynamic_sequential") - SECTION - [ in self ] - (output_directory "./doc") ] - -Class Aazz End -Class Bbyy < Aazz End -Class Ccxx < Bbyy End -Class Ddww < Ccxx End -Class Eevv < Ddww End -Class Ffuu < Eevv End -Class Ggtt < Ffuu End -Class Hhss < Ggtt End -Class Iirr < Hhss End -Class Jjqq < Iirr End -Class Kkpp < Jjqq End -Class Lloo < Kkpp End -Class Mmnn < Lloo End -Class Nnmm < Mmnn End -Class Ooll < Nnmm End -Class Ppkk < Ooll End -Class Qqjj < Ppkk End -Class Rrii < Qqjj End -Class Sshh < Rrii End -Class Ttgg < Sshh End -Class Uuff < Ttgg End -Class Vvee < Uuff End -Class Wwdd < Vvee End -Class Xxcc < Wwdd End -Class Yybb < Xxcc End -Class Zzaa < Yybb End -Class Baba < Zzaa End -Class Bbbb < Baba End -Class Bcbc < Bbbb End -Class Bdbd < Bcbc End -Class Bebe < Bdbd End -Class Bfbf < Bebe End -Class Bgbg < Bfbf End -Class Bhbh < Bgbg End -Class Bibi < Bhbh End -Class Bjbj < Bibi End -Class Bkbk < Bjbj End -Class Blbl < Bkbk End -Class Bmbm < Blbl End -Class Bnbn < Bmbm End -Class Bobo < Bnbn End -Class Bpbp < Bobo End - -(* 42 *) - -generation_syntax deep flush_all - - -end diff --git a/Citadelle/examples/empirical_evaluation/Tree_01_42_shallow.thy b/Citadelle/examples/empirical_evaluation/Tree_01_42_shallow.thy deleted file mode 100644 index f7f1af7956ff2f520e0b5dcd37c37eaa75481e4e..0000000000000000000000000000000000000000 --- a/Citadelle/examples/empirical_evaluation/Tree_01_42_shallow.thy +++ /dev/null @@ -1,51 +0,0 @@ -theory Tree_01_42_shallow imports "../../src/UML_Main" "../../src/compiler/Static" "../../src/compiler/Generator_dynamic_sequential" begin -generation_syntax [ shallow (generation_semantics [ analysis ]) ] - -Class Aazz End -Class Bbyy < Aazz End -Class Ccxx < Bbyy End -Class Ddww < Ccxx End -Class Eevv < Ddww End -Class Ffuu < Eevv End -Class Ggtt < Ffuu End -Class Hhss < Ggtt End -Class Iirr < Hhss End -Class Jjqq < Iirr End -Class Kkpp < Jjqq End -Class Lloo < Kkpp End -Class Mmnn < Lloo End -Class Nnmm < Mmnn End -Class Ooll < Nnmm End -Class Ppkk < Ooll End -Class Qqjj < Ppkk End -Class Rrii < Qqjj End -Class Sshh < Rrii End -Class Ttgg < Sshh End -Class Uuff < Ttgg End -Class Vvee < Uuff End -Class Wwdd < Vvee End -Class Xxcc < Wwdd End -Class Yybb < Xxcc End -Class Zzaa < Yybb End -Class Baba < Zzaa End -Class Bbbb < Baba End -Class Bcbc < Bbbb End -Class Bdbd < Bcbc End -Class Bebe < Bdbd End -Class Bfbf < Bebe End -Class Bgbg < Bfbf End -Class Bhbh < Bgbg End -Class Bibi < Bhbh End -Class Bjbj < Bibi End -Class Bkbk < Bjbj End -Class Blbl < Bkbk End -Class Bmbm < Blbl End -Class Bnbn < Bmbm End -Class Bobo < Bnbn End -Class Bpbp < Bobo End - -(* 42 *) - -End! - -end diff --git a/Citadelle/examples/empirical_evaluation/Tree_01_56_deep_self.thy b/Citadelle/examples/empirical_evaluation/Tree_01_56_deep_self.thy deleted file mode 100644 index ee4c705626b05fb9c4cb8d37f41676bd28f13ca5..0000000000000000000000000000000000000000 --- a/Citadelle/examples/empirical_evaluation/Tree_01_56_deep_self.thy +++ /dev/null @@ -1,74 +0,0 @@ -theory Tree_01_56_deep_self imports "../../src/compiler/Generator_dynamic_sequential" begin -generation_syntax [ deep - (generation_semantics [ analysis (*, oid_start 10*) ]) - skip_export - (THEORY Tree_01_56_generated_self) - (IMPORTS ["../../../src/UML_Main", "../../../src/compiler/Static"] - "../../../src/compiler/Generator_dynamic_sequential") - SECTION - [ in self ] - (output_directory "./doc") ] - -Class Aazz End -Class Bbyy < Aazz End -Class Ccxx < Bbyy End -Class Ddww < Ccxx End -Class Eevv < Ddww End -Class Ffuu < Eevv End -Class Ggtt < Ffuu End -Class Hhss < Ggtt End -Class Iirr < Hhss End -Class Jjqq < Iirr End -Class Kkpp < Jjqq End -Class Lloo < Kkpp End -Class Mmnn < Lloo End -Class Nnmm < Mmnn End -Class Ooll < Nnmm End -Class Ppkk < Ooll End -Class Qqjj < Ppkk End -Class Rrii < Qqjj End -Class Sshh < Rrii End -Class Ttgg < Sshh End -Class Uuff < Ttgg End -Class Vvee < Uuff End -Class Wwdd < Vvee End -Class Xxcc < Wwdd End -Class Yybb < Xxcc End -Class Zzaa < Yybb End -Class Baba < Zzaa End -Class Bbbb < Baba End -Class Bcbc < Bbbb End -Class Bdbd < Bcbc End -Class Bebe < Bdbd End -Class Bfbf < Bebe End -Class Bgbg < Bfbf End -Class Bhbh < Bgbg End -Class Bibi < Bhbh End -Class Bjbj < Bibi End -Class Bkbk < Bjbj End -Class Blbl < Bkbk End -Class Bmbm < Blbl End -Class Bnbn < Bmbm End -Class Bobo < Bnbn End -Class Bpbp < Bobo End -Class Bqbq < Bpbp End -Class Brbr < Bqbq End -Class Bsbs < Brbr End -Class Btbt < Bsbs End -Class Bubu < Btbt End -Class Bvbv < Bubu End -Class Bwbw < Bvbv End -Class Bxbx < Bwbw End -Class Byby < Bxbx End -Class Bzbz < Byby End -Class Caca < Bzbz End -Class Cbcb < Caca End -Class Cccc < Cbcb End -Class Cdcd < Cccc End - -(* 56 *) - -generation_syntax deep flush_all - - -end diff --git a/Citadelle/examples/empirical_evaluation/Tree_01_56_shallow.thy b/Citadelle/examples/empirical_evaluation/Tree_01_56_shallow.thy deleted file mode 100644 index 37e8f6fe7f4e29e8eb7d8743992998ff6022166d..0000000000000000000000000000000000000000 --- a/Citadelle/examples/empirical_evaluation/Tree_01_56_shallow.thy +++ /dev/null @@ -1,65 +0,0 @@ -theory Tree_01_56_shallow imports "../../src/UML_Main" "../../src/compiler/Static" "../../src/compiler/Generator_dynamic_sequential" begin -generation_syntax [ shallow (generation_semantics [ analysis ]) ] - -Class Aazz End -Class Bbyy < Aazz End -Class Ccxx < Bbyy End -Class Ddww < Ccxx End -Class Eevv < Ddww End -Class Ffuu < Eevv End -Class Ggtt < Ffuu End -Class Hhss < Ggtt End -Class Iirr < Hhss End -Class Jjqq < Iirr End -Class Kkpp < Jjqq End -Class Lloo < Kkpp End -Class Mmnn < Lloo End -Class Nnmm < Mmnn End -Class Ooll < Nnmm End -Class Ppkk < Ooll End -Class Qqjj < Ppkk End -Class Rrii < Qqjj End -Class Sshh < Rrii End -Class Ttgg < Sshh End -Class Uuff < Ttgg End -Class Vvee < Uuff End -Class Wwdd < Vvee End -Class Xxcc < Wwdd End -Class Yybb < Xxcc End -Class Zzaa < Yybb End -Class Baba < Zzaa End -Class Bbbb < Baba End -Class Bcbc < Bbbb End -Class Bdbd < Bcbc End -Class Bebe < Bdbd End -Class Bfbf < Bebe End -Class Bgbg < Bfbf End -Class Bhbh < Bgbg End -Class Bibi < Bhbh End -Class Bjbj < Bibi End -Class Bkbk < Bjbj End -Class Blbl < Bkbk End -Class Bmbm < Blbl End -Class Bnbn < Bmbm End -Class Bobo < Bnbn End -Class Bpbp < Bobo End -Class Bqbq < Bpbp End -Class Brbr < Bqbq End -Class Bsbs < Brbr End -Class Btbt < Bsbs End -Class Bubu < Btbt End -Class Bvbv < Bubu End -Class Bwbw < Bvbv End -Class Bxbx < Bwbw End -Class Byby < Bxbx End -Class Bzbz < Byby End -Class Caca < Bzbz End -Class Cbcb < Caca End -Class Cccc < Cbcb End -Class Cdcd < Cccc End - -(* 56 *) - -End! - -end diff --git a/Citadelle/examples/empirical_evaluation/Tree_02_01_deep_self.thy b/Citadelle/examples/empirical_evaluation/Tree_02_01_deep_self.thy deleted file mode 100644 index 55bde7bf914e88097a92f348ecf7e953ad84e692..0000000000000000000000000000000000000000 --- a/Citadelle/examples/empirical_evaluation/Tree_02_01_deep_self.thy +++ /dev/null @@ -1,20 +0,0 @@ -theory Tree_02_01_deep_self imports "../../src/compiler/Generator_dynamic_sequential" begin -generation_syntax [ deep - (generation_semantics [ analysis (*, oid_start 10*) ]) - skip_export - (THEORY Tree_02_01_generated_self) - (IMPORTS ["../../../src/UML_Main", "../../../src/compiler/Static"] - "../../../src/compiler/Generator_dynamic_sequential") - SECTION - [ in self ] - (output_directory "./doc") ] - -Class Aazz End -Class Bbyy End - -(* 2 *) - -generation_syntax deep flush_all - - -end diff --git a/Citadelle/examples/empirical_evaluation/Tree_02_01_shallow.thy b/Citadelle/examples/empirical_evaluation/Tree_02_01_shallow.thy deleted file mode 100644 index 2c851e624111b18f34b7636ac87720c2c664627a..0000000000000000000000000000000000000000 --- a/Citadelle/examples/empirical_evaluation/Tree_02_01_shallow.thy +++ /dev/null @@ -1,11 +0,0 @@ -theory Tree_02_01_shallow imports "../../src/UML_Main" "../../src/compiler/Static" "../../src/compiler/Generator_dynamic_sequential" begin -generation_syntax [ shallow (generation_semantics [ analysis ]) ] - -Class Aazz End -Class Bbyy End - -(* 2 *) - -End! - -end diff --git a/Citadelle/examples/empirical_evaluation/Tree_02_02_deep_self.thy b/Citadelle/examples/empirical_evaluation/Tree_02_02_deep_self.thy deleted file mode 100644 index 558005d917b13c180bdf75d3458e459378eb2bac..0000000000000000000000000000000000000000 --- a/Citadelle/examples/empirical_evaluation/Tree_02_02_deep_self.thy +++ /dev/null @@ -1,24 +0,0 @@ -theory Tree_02_02_deep_self imports "../../src/compiler/Generator_dynamic_sequential" begin -generation_syntax [ deep - (generation_semantics [ analysis (*, oid_start 10*) ]) - skip_export - (THEORY Tree_02_02_generated_self) - (IMPORTS ["../../../src/UML_Main", "../../../src/compiler/Static"] - "../../../src/compiler/Generator_dynamic_sequential") - SECTION - [ in self ] - (output_directory "./doc") ] - -Class Aazz End -Class Bbyy End -Class Ccxx < Aazz End -Class Ddww < Aazz End -Class Eevv < Bbyy End -Class Ffuu < Bbyy End - -(* 6 *) - -generation_syntax deep flush_all - - -end diff --git a/Citadelle/examples/empirical_evaluation/Tree_02_02_shallow.thy b/Citadelle/examples/empirical_evaluation/Tree_02_02_shallow.thy deleted file mode 100644 index e04aa5a108a8d2d3a6f4663b0748b87edd6533ed..0000000000000000000000000000000000000000 --- a/Citadelle/examples/empirical_evaluation/Tree_02_02_shallow.thy +++ /dev/null @@ -1,15 +0,0 @@ -theory Tree_02_02_shallow imports "../../src/UML_Main" "../../src/compiler/Static" "../../src/compiler/Generator_dynamic_sequential" begin -generation_syntax [ shallow (generation_semantics [ analysis ]) ] - -Class Aazz End -Class Bbyy End -Class Ccxx < Aazz End -Class Ddww < Aazz End -Class Eevv < Bbyy End -Class Ffuu < Bbyy End - -(* 6 *) - -End! - -end diff --git a/Citadelle/examples/empirical_evaluation/Tree_02_03_deep_self.thy b/Citadelle/examples/empirical_evaluation/Tree_02_03_deep_self.thy deleted file mode 100644 index 83fc8bff57560b61d754370a3f44baddb86f6c78..0000000000000000000000000000000000000000 --- a/Citadelle/examples/empirical_evaluation/Tree_02_03_deep_self.thy +++ /dev/null @@ -1,32 +0,0 @@ -theory Tree_02_03_deep_self imports "../../src/compiler/Generator_dynamic_sequential" begin -generation_syntax [ deep - (generation_semantics [ analysis (*, oid_start 10*) ]) - skip_export - (THEORY Tree_02_03_generated_self) - (IMPORTS ["../../../src/UML_Main", "../../../src/compiler/Static"] - "../../../src/compiler/Generator_dynamic_sequential") - SECTION - [ in self ] - (output_directory "./doc") ] - -Class Aazz End -Class Bbyy End -Class Ccxx < Aazz End -Class Ddww < Aazz End -Class Eevv < Ccxx End -Class Ffuu < Ccxx End -Class Ggtt < Ddww End -Class Hhss < Ddww End -Class Iirr < Bbyy End -Class Jjqq < Bbyy End -Class Kkpp < Iirr End -Class Lloo < Iirr End -Class Mmnn < Jjqq End -Class Nnmm < Jjqq End - -(* 14 *) - -generation_syntax deep flush_all - - -end diff --git a/Citadelle/examples/empirical_evaluation/Tree_02_03_shallow.thy b/Citadelle/examples/empirical_evaluation/Tree_02_03_shallow.thy deleted file mode 100644 index 48fd730856b3ecbc6ea01121ac35f3ec21d1250d..0000000000000000000000000000000000000000 --- a/Citadelle/examples/empirical_evaluation/Tree_02_03_shallow.thy +++ /dev/null @@ -1,23 +0,0 @@ -theory Tree_02_03_shallow imports "../../src/UML_Main" "../../src/compiler/Static" "../../src/compiler/Generator_dynamic_sequential" begin -generation_syntax [ shallow (generation_semantics [ analysis ]) ] - -Class Aazz End -Class Bbyy End -Class Ccxx < Aazz End -Class Ddww < Aazz End -Class Eevv < Ccxx End -Class Ffuu < Ccxx End -Class Ggtt < Ddww End -Class Hhss < Ddww End -Class Iirr < Bbyy End -Class Jjqq < Bbyy End -Class Kkpp < Iirr End -Class Lloo < Iirr End -Class Mmnn < Jjqq End -Class Nnmm < Jjqq End - -(* 14 *) - -End! - -end diff --git a/Citadelle/examples/empirical_evaluation/Tree_02_04_deep_self.thy b/Citadelle/examples/empirical_evaluation/Tree_02_04_deep_self.thy deleted file mode 100644 index 84664d1a33643733666fa8e4eef45d683be6192e..0000000000000000000000000000000000000000 --- a/Citadelle/examples/empirical_evaluation/Tree_02_04_deep_self.thy +++ /dev/null @@ -1,48 +0,0 @@ -theory Tree_02_04_deep_self imports "../../src/compiler/Generator_dynamic_sequential" begin -generation_syntax [ deep - (generation_semantics [ analysis (*, oid_start 10*) ]) - skip_export - (THEORY Tree_02_04_generated_self) - (IMPORTS ["../../../src/UML_Main", "../../../src/compiler/Static"] - "../../../src/compiler/Generator_dynamic_sequential") - SECTION - [ in self ] - (output_directory "./doc") ] - -Class Aazz End -Class Bbyy End -Class Ccxx < Aazz End -Class Ddww < Aazz End -Class Eevv < Ccxx End -Class Ffuu < Ccxx End -Class Ggtt < Eevv End -Class Hhss < Eevv End -Class Iirr < Ffuu End -Class Jjqq < Ffuu End -Class Kkpp < Ddww End -Class Lloo < Ddww End -Class Mmnn < Kkpp End -Class Nnmm < Kkpp End -Class Ooll < Lloo End -Class Ppkk < Lloo End -Class Qqjj < Bbyy End -Class Rrii < Bbyy End -Class Sshh < Qqjj End -Class Ttgg < Qqjj End -Class Uuff < Sshh End -Class Vvee < Sshh End -Class Wwdd < Ttgg End -Class Xxcc < Ttgg End -Class Yybb < Rrii End -Class Zzaa < Rrii End -Class Baba < Yybb End -Class Bbbb < Yybb End -Class Bcbc < Zzaa End -Class Bdbd < Zzaa End - -(* 30 *) - -generation_syntax deep flush_all - - -end diff --git a/Citadelle/examples/empirical_evaluation/Tree_02_04_shallow.thy b/Citadelle/examples/empirical_evaluation/Tree_02_04_shallow.thy deleted file mode 100644 index e58911952187886a850f0a95abf951f7a0a1bccd..0000000000000000000000000000000000000000 --- a/Citadelle/examples/empirical_evaluation/Tree_02_04_shallow.thy +++ /dev/null @@ -1,39 +0,0 @@ -theory Tree_02_04_shallow imports "../../src/UML_Main" "../../src/compiler/Static" "../../src/compiler/Generator_dynamic_sequential" begin -generation_syntax [ shallow (generation_semantics [ analysis ]) ] - -Class Aazz End -Class Bbyy End -Class Ccxx < Aazz End -Class Ddww < Aazz End -Class Eevv < Ccxx End -Class Ffuu < Ccxx End -Class Ggtt < Eevv End -Class Hhss < Eevv End -Class Iirr < Ffuu End -Class Jjqq < Ffuu End -Class Kkpp < Ddww End -Class Lloo < Ddww End -Class Mmnn < Kkpp End -Class Nnmm < Kkpp End -Class Ooll < Lloo End -Class Ppkk < Lloo End -Class Qqjj < Bbyy End -Class Rrii < Bbyy End -Class Sshh < Qqjj End -Class Ttgg < Qqjj End -Class Uuff < Sshh End -Class Vvee < Sshh End -Class Wwdd < Ttgg End -Class Xxcc < Ttgg End -Class Yybb < Rrii End -Class Zzaa < Rrii End -Class Baba < Yybb End -Class Bbbb < Yybb End -Class Bcbc < Zzaa End -Class Bdbd < Zzaa End - -(* 30 *) - -End! - -end diff --git a/Citadelle/examples/empirical_evaluation/Tree_03_01_deep_self.thy b/Citadelle/examples/empirical_evaluation/Tree_03_01_deep_self.thy deleted file mode 100644 index 6a0a4eff6676f508b1e8953f560c164b46e22226..0000000000000000000000000000000000000000 --- a/Citadelle/examples/empirical_evaluation/Tree_03_01_deep_self.thy +++ /dev/null @@ -1,21 +0,0 @@ -theory Tree_03_01_deep_self imports "../../src/compiler/Generator_dynamic_sequential" begin -generation_syntax [ deep - (generation_semantics [ analysis (*, oid_start 10*) ]) - skip_export - (THEORY Tree_03_01_generated_self) - (IMPORTS ["../../../src/UML_Main", "../../../src/compiler/Static"] - "../../../src/compiler/Generator_dynamic_sequential") - SECTION - [ in self ] - (output_directory "./doc") ] - -Class Aazz End -Class Bbyy End -Class Ccxx End - -(* 3 *) - -generation_syntax deep flush_all - - -end diff --git a/Citadelle/examples/empirical_evaluation/Tree_03_01_shallow.thy b/Citadelle/examples/empirical_evaluation/Tree_03_01_shallow.thy deleted file mode 100644 index e7e6506fc4466283c522c708643e0750d7b26d05..0000000000000000000000000000000000000000 --- a/Citadelle/examples/empirical_evaluation/Tree_03_01_shallow.thy +++ /dev/null @@ -1,12 +0,0 @@ -theory Tree_03_01_shallow imports "../../src/UML_Main" "../../src/compiler/Static" "../../src/compiler/Generator_dynamic_sequential" begin -generation_syntax [ shallow (generation_semantics [ analysis ]) ] - -Class Aazz End -Class Bbyy End -Class Ccxx End - -(* 3 *) - -End! - -end diff --git a/Citadelle/examples/empirical_evaluation/Tree_03_02_deep_self.thy b/Citadelle/examples/empirical_evaluation/Tree_03_02_deep_self.thy deleted file mode 100644 index 9b7a29ebffc05cf54da0f7ee8de39445779221b3..0000000000000000000000000000000000000000 --- a/Citadelle/examples/empirical_evaluation/Tree_03_02_deep_self.thy +++ /dev/null @@ -1,30 +0,0 @@ -theory Tree_03_02_deep_self imports "../../src/compiler/Generator_dynamic_sequential" begin -generation_syntax [ deep - (generation_semantics [ analysis (*, oid_start 10*) ]) - skip_export - (THEORY Tree_03_02_generated_self) - (IMPORTS ["../../../src/UML_Main", "../../../src/compiler/Static"] - "../../../src/compiler/Generator_dynamic_sequential") - SECTION - [ in self ] - (output_directory "./doc") ] - -Class Aazz End -Class Bbyy End -Class Ccxx End -Class Ddww < Aazz End -Class Eevv < Aazz End -Class Ffuu < Aazz End -Class Ggtt < Bbyy End -Class Hhss < Bbyy End -Class Iirr < Bbyy End -Class Jjqq < Ccxx End -Class Kkpp < Ccxx End -Class Lloo < Ccxx End - -(* 12 *) - -generation_syntax deep flush_all - - -end diff --git a/Citadelle/examples/empirical_evaluation/Tree_03_02_shallow.thy b/Citadelle/examples/empirical_evaluation/Tree_03_02_shallow.thy deleted file mode 100644 index 63a8acafda3da1598fe76f045bc1b2faf2237126..0000000000000000000000000000000000000000 --- a/Citadelle/examples/empirical_evaluation/Tree_03_02_shallow.thy +++ /dev/null @@ -1,21 +0,0 @@ -theory Tree_03_02_shallow imports "../../src/UML_Main" "../../src/compiler/Static" "../../src/compiler/Generator_dynamic_sequential" begin -generation_syntax [ shallow (generation_semantics [ analysis ]) ] - -Class Aazz End -Class Bbyy End -Class Ccxx End -Class Ddww < Aazz End -Class Eevv < Aazz End -Class Ffuu < Aazz End -Class Ggtt < Bbyy End -Class Hhss < Bbyy End -Class Iirr < Bbyy End -Class Jjqq < Ccxx End -Class Kkpp < Ccxx End -Class Lloo < Ccxx End - -(* 12 *) - -End! - -end diff --git a/Citadelle/examples/empirical_evaluation/Tree_03_03_deep_self.thy b/Citadelle/examples/empirical_evaluation/Tree_03_03_deep_self.thy deleted file mode 100644 index 45f49f94b44fe12a15c6f088756dfbfe9634cecc..0000000000000000000000000000000000000000 --- a/Citadelle/examples/empirical_evaluation/Tree_03_03_deep_self.thy +++ /dev/null @@ -1,57 +0,0 @@ -theory Tree_03_03_deep_self imports "../../src/compiler/Generator_dynamic_sequential" begin -generation_syntax [ deep - (generation_semantics [ analysis (*, oid_start 10*) ]) - skip_export - (THEORY Tree_03_03_generated_self) - (IMPORTS ["../../../src/UML_Main", "../../../src/compiler/Static"] - "../../../src/compiler/Generator_dynamic_sequential") - SECTION - [ in self ] - (output_directory "./doc") ] - -Class Aazz End -Class Bbyy End -Class Ccxx End -Class Ddww < Aazz End -Class Eevv < Aazz End -Class Ffuu < Aazz End -Class Ggtt < Ddww End -Class Hhss < Ddww End -Class Iirr < Ddww End -Class Jjqq < Eevv End -Class Kkpp < Eevv End -Class Lloo < Eevv End -Class Mmnn < Ffuu End -Class Nnmm < Ffuu End -Class Ooll < Ffuu End -Class Ppkk < Bbyy End -Class Qqjj < Bbyy End -Class Rrii < Bbyy End -Class Sshh < Ppkk End -Class Ttgg < Ppkk End -Class Uuff < Ppkk End -Class Vvee < Qqjj End -Class Wwdd < Qqjj End -Class Xxcc < Qqjj End -Class Yybb < Rrii End -Class Zzaa < Rrii End -Class Baba < Rrii End -Class Bbbb < Ccxx End -Class Bcbc < Ccxx End -Class Bdbd < Ccxx End -Class Bebe < Bbbb End -Class Bfbf < Bbbb End -Class Bgbg < Bbbb End -Class Bhbh < Bcbc End -Class Bibi < Bcbc End -Class Bjbj < Bcbc End -Class Bkbk < Bdbd End -Class Blbl < Bdbd End -Class Bmbm < Bdbd End - -(* 39 *) - -generation_syntax deep flush_all - - -end diff --git a/Citadelle/examples/empirical_evaluation/Tree_03_03_shallow.thy b/Citadelle/examples/empirical_evaluation/Tree_03_03_shallow.thy deleted file mode 100644 index 0ea0dc47c52a27055d31dd9967322bef9c970d88..0000000000000000000000000000000000000000 --- a/Citadelle/examples/empirical_evaluation/Tree_03_03_shallow.thy +++ /dev/null @@ -1,48 +0,0 @@ -theory Tree_03_03_shallow imports "../../src/UML_Main" "../../src/compiler/Static" "../../src/compiler/Generator_dynamic_sequential" begin -generation_syntax [ shallow (generation_semantics [ analysis ]) ] - -Class Aazz End -Class Bbyy End -Class Ccxx End -Class Ddww < Aazz End -Class Eevv < Aazz End -Class Ffuu < Aazz End -Class Ggtt < Ddww End -Class Hhss < Ddww End -Class Iirr < Ddww End -Class Jjqq < Eevv End -Class Kkpp < Eevv End -Class Lloo < Eevv End -Class Mmnn < Ffuu End -Class Nnmm < Ffuu End -Class Ooll < Ffuu End -Class Ppkk < Bbyy End -Class Qqjj < Bbyy End -Class Rrii < Bbyy End -Class Sshh < Ppkk End -Class Ttgg < Ppkk End -Class Uuff < Ppkk End -Class Vvee < Qqjj End -Class Wwdd < Qqjj End -Class Xxcc < Qqjj End -Class Yybb < Rrii End -Class Zzaa < Rrii End -Class Baba < Rrii End -Class Bbbb < Ccxx End -Class Bcbc < Ccxx End -Class Bdbd < Ccxx End -Class Bebe < Bbbb End -Class Bfbf < Bbbb End -Class Bgbg < Bbbb End -Class Bhbh < Bcbc End -Class Bibi < Bcbc End -Class Bjbj < Bcbc End -Class Bkbk < Bdbd End -Class Blbl < Bdbd End -Class Bmbm < Bdbd End - -(* 39 *) - -End! - -end diff --git a/Citadelle/examples/empirical_evaluation/Tree_04_01_deep_self.thy b/Citadelle/examples/empirical_evaluation/Tree_04_01_deep_self.thy deleted file mode 100644 index 012f7451cfa7e6b8e4fc5e0d971982874bb8924b..0000000000000000000000000000000000000000 --- a/Citadelle/examples/empirical_evaluation/Tree_04_01_deep_self.thy +++ /dev/null @@ -1,22 +0,0 @@ -theory Tree_04_01_deep_self imports "../../src/compiler/Generator_dynamic_sequential" begin -generation_syntax [ deep - (generation_semantics [ analysis (*, oid_start 10*) ]) - skip_export - (THEORY Tree_04_01_generated_self) - (IMPORTS ["../../../src/UML_Main", "../../../src/compiler/Static"] - "../../../src/compiler/Generator_dynamic_sequential") - SECTION - [ in self ] - (output_directory "./doc") ] - -Class Aazz End -Class Bbyy End -Class Ccxx End -Class Ddww End - -(* 4 *) - -generation_syntax deep flush_all - - -end diff --git a/Citadelle/examples/empirical_evaluation/Tree_04_01_shallow.thy b/Citadelle/examples/empirical_evaluation/Tree_04_01_shallow.thy deleted file mode 100644 index 01c8b567c1bedb98e27f10c048bf94b48d8991cf..0000000000000000000000000000000000000000 --- a/Citadelle/examples/empirical_evaluation/Tree_04_01_shallow.thy +++ /dev/null @@ -1,13 +0,0 @@ -theory Tree_04_01_shallow imports "../../src/UML_Main" "../../src/compiler/Static" "../../src/compiler/Generator_dynamic_sequential" begin -generation_syntax [ shallow (generation_semantics [ analysis ]) ] - -Class Aazz End -Class Bbyy End -Class Ccxx End -Class Ddww End - -(* 4 *) - -End! - -end diff --git a/Citadelle/examples/empirical_evaluation/Tree_04_02_deep_self.thy b/Citadelle/examples/empirical_evaluation/Tree_04_02_deep_self.thy deleted file mode 100644 index a9530867ae3ddb72b95ffabe55140c949170505c..0000000000000000000000000000000000000000 --- a/Citadelle/examples/empirical_evaluation/Tree_04_02_deep_self.thy +++ /dev/null @@ -1,38 +0,0 @@ -theory Tree_04_02_deep_self imports "../../src/compiler/Generator_dynamic_sequential" begin -generation_syntax [ deep - (generation_semantics [ analysis (*, oid_start 10*) ]) - skip_export - (THEORY Tree_04_02_generated_self) - (IMPORTS ["../../../src/UML_Main", "../../../src/compiler/Static"] - "../../../src/compiler/Generator_dynamic_sequential") - SECTION - [ in self ] - (output_directory "./doc") ] - -Class Aazz End -Class Bbyy End -Class Ccxx End -Class Ddww End -Class Eevv < Aazz End -Class Ffuu < Aazz End -Class Ggtt < Aazz End -Class Hhss < Aazz End -Class Iirr < Bbyy End -Class Jjqq < Bbyy End -Class Kkpp < Bbyy End -Class Lloo < Bbyy End -Class Mmnn < Ccxx End -Class Nnmm < Ccxx End -Class Ooll < Ccxx End -Class Ppkk < Ccxx End -Class Qqjj < Ddww End -Class Rrii < Ddww End -Class Sshh < Ddww End -Class Ttgg < Ddww End - -(* 20 *) - -generation_syntax deep flush_all - - -end diff --git a/Citadelle/examples/empirical_evaluation/Tree_04_02_shallow.thy b/Citadelle/examples/empirical_evaluation/Tree_04_02_shallow.thy deleted file mode 100644 index ae5e7f4b93370fa1075f60f719c62d149d2c56a6..0000000000000000000000000000000000000000 --- a/Citadelle/examples/empirical_evaluation/Tree_04_02_shallow.thy +++ /dev/null @@ -1,29 +0,0 @@ -theory Tree_04_02_shallow imports "../../src/UML_Main" "../../src/compiler/Static" "../../src/compiler/Generator_dynamic_sequential" begin -generation_syntax [ shallow (generation_semantics [ analysis ]) ] - -Class Aazz End -Class Bbyy End -Class Ccxx End -Class Ddww End -Class Eevv < Aazz End -Class Ffuu < Aazz End -Class Ggtt < Aazz End -Class Hhss < Aazz End -Class Iirr < Bbyy End -Class Jjqq < Bbyy End -Class Kkpp < Bbyy End -Class Lloo < Bbyy End -Class Mmnn < Ccxx End -Class Nnmm < Ccxx End -Class Ooll < Ccxx End -Class Ppkk < Ccxx End -Class Qqjj < Ddww End -Class Rrii < Ddww End -Class Sshh < Ddww End -Class Ttgg < Ddww End - -(* 20 *) - -End! - -end diff --git a/Citadelle/examples/empirical_evaluation/Tree_05_01_deep_self.thy b/Citadelle/examples/empirical_evaluation/Tree_05_01_deep_self.thy deleted file mode 100644 index 4dd290a44f96ded685c286cbe907c3a54e57e9dc..0000000000000000000000000000000000000000 --- a/Citadelle/examples/empirical_evaluation/Tree_05_01_deep_self.thy +++ /dev/null @@ -1,23 +0,0 @@ -theory Tree_05_01_deep_self imports "../../src/compiler/Generator_dynamic_sequential" begin -generation_syntax [ deep - (generation_semantics [ analysis (*, oid_start 10*) ]) - skip_export - (THEORY Tree_05_01_generated_self) - (IMPORTS ["../../../src/UML_Main", "../../../src/compiler/Static"] - "../../../src/compiler/Generator_dynamic_sequential") - SECTION - [ in self ] - (output_directory "./doc") ] - -Class Aazz End -Class Bbyy End -Class Ccxx End -Class Ddww End -Class Eevv End - -(* 5 *) - -generation_syntax deep flush_all - - -end diff --git a/Citadelle/examples/empirical_evaluation/Tree_05_01_shallow.thy b/Citadelle/examples/empirical_evaluation/Tree_05_01_shallow.thy deleted file mode 100644 index 9c1edf905286f78524c73e69cf26b76c7ef2f16f..0000000000000000000000000000000000000000 --- a/Citadelle/examples/empirical_evaluation/Tree_05_01_shallow.thy +++ /dev/null @@ -1,14 +0,0 @@ -theory Tree_05_01_shallow imports "../../src/UML_Main" "../../src/compiler/Static" "../../src/compiler/Generator_dynamic_sequential" begin -generation_syntax [ shallow (generation_semantics [ analysis ]) ] - -Class Aazz End -Class Bbyy End -Class Ccxx End -Class Ddww End -Class Eevv End - -(* 5 *) - -End! - -end diff --git a/Citadelle/examples/empirical_evaluation/Tree_05_02_deep_self.thy b/Citadelle/examples/empirical_evaluation/Tree_05_02_deep_self.thy deleted file mode 100644 index 9a613655f0435c25b06e87f09931c387b6f7cc40..0000000000000000000000000000000000000000 --- a/Citadelle/examples/empirical_evaluation/Tree_05_02_deep_self.thy +++ /dev/null @@ -1,48 +0,0 @@ -theory Tree_05_02_deep_self imports "../../src/compiler/Generator_dynamic_sequential" begin -generation_syntax [ deep - (generation_semantics [ analysis (*, oid_start 10*) ]) - skip_export - (THEORY Tree_05_02_generated_self) - (IMPORTS ["../../../src/UML_Main", "../../../src/compiler/Static"] - "../../../src/compiler/Generator_dynamic_sequential") - SECTION - [ in self ] - (output_directory "./doc") ] - -Class Aazz End -Class Bbyy End -Class Ccxx End -Class Ddww End -Class Eevv End -Class Ffuu < Aazz End -Class Ggtt < Aazz End -Class Hhss < Aazz End -Class Iirr < Aazz End -Class Jjqq < Aazz End -Class Kkpp < Bbyy End -Class Lloo < Bbyy End -Class Mmnn < Bbyy End -Class Nnmm < Bbyy End -Class Ooll < Bbyy End -Class Ppkk < Ccxx End -Class Qqjj < Ccxx End -Class Rrii < Ccxx End -Class Sshh < Ccxx End -Class Ttgg < Ccxx End -Class Uuff < Ddww End -Class Vvee < Ddww End -Class Wwdd < Ddww End -Class Xxcc < Ddww End -Class Yybb < Ddww End -Class Zzaa < Eevv End -Class Baba < Eevv End -Class Bbbb < Eevv End -Class Bcbc < Eevv End -Class Bdbd < Eevv End - -(* 30 *) - -generation_syntax deep flush_all - - -end diff --git a/Citadelle/examples/empirical_evaluation/Tree_05_02_shallow.thy b/Citadelle/examples/empirical_evaluation/Tree_05_02_shallow.thy deleted file mode 100644 index 7a9637bfdf3b23937bbf86f5f258baf35669e110..0000000000000000000000000000000000000000 --- a/Citadelle/examples/empirical_evaluation/Tree_05_02_shallow.thy +++ /dev/null @@ -1,39 +0,0 @@ -theory Tree_05_02_shallow imports "../../src/UML_Main" "../../src/compiler/Static" "../../src/compiler/Generator_dynamic_sequential" begin -generation_syntax [ shallow (generation_semantics [ analysis ]) ] - -Class Aazz End -Class Bbyy End -Class Ccxx End -Class Ddww End -Class Eevv End -Class Ffuu < Aazz End -Class Ggtt < Aazz End -Class Hhss < Aazz End -Class Iirr < Aazz End -Class Jjqq < Aazz End -Class Kkpp < Bbyy End -Class Lloo < Bbyy End -Class Mmnn < Bbyy End -Class Nnmm < Bbyy End -Class Ooll < Bbyy End -Class Ppkk < Ccxx End -Class Qqjj < Ccxx End -Class Rrii < Ccxx End -Class Sshh < Ccxx End -Class Ttgg < Ccxx End -Class Uuff < Ddww End -Class Vvee < Ddww End -Class Wwdd < Ddww End -Class Xxcc < Ddww End -Class Yybb < Ddww End -Class Zzaa < Eevv End -Class Baba < Eevv End -Class Bbbb < Eevv End -Class Bcbc < Eevv End -Class Bdbd < Eevv End - -(* 30 *) - -End! - -end diff --git a/Citadelle/examples/empirical_evaluation/Tree_06_01_deep_self.thy b/Citadelle/examples/empirical_evaluation/Tree_06_01_deep_self.thy deleted file mode 100644 index f0cbad1a68aafd745de832610715f6b792cd9827..0000000000000000000000000000000000000000 --- a/Citadelle/examples/empirical_evaluation/Tree_06_01_deep_self.thy +++ /dev/null @@ -1,24 +0,0 @@ -theory Tree_06_01_deep_self imports "../../src/compiler/Generator_dynamic_sequential" begin -generation_syntax [ deep - (generation_semantics [ analysis (*, oid_start 10*) ]) - skip_export - (THEORY Tree_06_01_generated_self) - (IMPORTS ["../../../src/UML_Main", "../../../src/compiler/Static"] - "../../../src/compiler/Generator_dynamic_sequential") - SECTION - [ in self ] - (output_directory "./doc") ] - -Class Aazz End -Class Bbyy End -Class Ccxx End -Class Ddww End -Class Eevv End -Class Ffuu End - -(* 6 *) - -generation_syntax deep flush_all - - -end diff --git a/Citadelle/examples/empirical_evaluation/Tree_06_01_shallow.thy b/Citadelle/examples/empirical_evaluation/Tree_06_01_shallow.thy deleted file mode 100644 index 48d9f21d5246c3e770f845f796167c5a63822f9f..0000000000000000000000000000000000000000 --- a/Citadelle/examples/empirical_evaluation/Tree_06_01_shallow.thy +++ /dev/null @@ -1,15 +0,0 @@ -theory Tree_06_01_shallow imports "../../src/UML_Main" "../../src/compiler/Static" "../../src/compiler/Generator_dynamic_sequential" begin -generation_syntax [ shallow (generation_semantics [ analysis ]) ] - -Class Aazz End -Class Bbyy End -Class Ccxx End -Class Ddww End -Class Eevv End -Class Ffuu End - -(* 6 *) - -End! - -end diff --git a/Citadelle/examples/empirical_evaluation/Tree_06_02_deep_self.thy b/Citadelle/examples/empirical_evaluation/Tree_06_02_deep_self.thy deleted file mode 100644 index 841fb689ceebe8e5592ff17125e8579d8aee5536..0000000000000000000000000000000000000000 --- a/Citadelle/examples/empirical_evaluation/Tree_06_02_deep_self.thy +++ /dev/null @@ -1,60 +0,0 @@ -theory Tree_06_02_deep_self imports "../../src/compiler/Generator_dynamic_sequential" begin -generation_syntax [ deep - (generation_semantics [ analysis (*, oid_start 10*) ]) - skip_export - (THEORY Tree_06_02_generated_self) - (IMPORTS ["../../../src/UML_Main", "../../../src/compiler/Static"] - "../../../src/compiler/Generator_dynamic_sequential") - SECTION - [ in self ] - (output_directory "./doc") ] - -Class Aazz End -Class Bbyy End -Class Ccxx End -Class Ddww End -Class Eevv End -Class Ffuu End -Class Ggtt < Aazz End -Class Hhss < Aazz End -Class Iirr < Aazz End -Class Jjqq < Aazz End -Class Kkpp < Aazz End -Class Lloo < Aazz End -Class Mmnn < Bbyy End -Class Nnmm < Bbyy End -Class Ooll < Bbyy End -Class Ppkk < Bbyy End -Class Qqjj < Bbyy End -Class Rrii < Bbyy End -Class Sshh < Ccxx End -Class Ttgg < Ccxx End -Class Uuff < Ccxx End -Class Vvee < Ccxx End -Class Wwdd < Ccxx End -Class Xxcc < Ccxx End -Class Yybb < Ddww End -Class Zzaa < Ddww End -Class Baba < Ddww End -Class Bbbb < Ddww End -Class Bcbc < Ddww End -Class Bdbd < Ddww End -Class Bebe < Eevv End -Class Bfbf < Eevv End -Class Bgbg < Eevv End -Class Bhbh < Eevv End -Class Bibi < Eevv End -Class Bjbj < Eevv End -Class Bkbk < Ffuu End -Class Blbl < Ffuu End -Class Bmbm < Ffuu End -Class Bnbn < Ffuu End -Class Bobo < Ffuu End -Class Bpbp < Ffuu End - -(* 42 *) - -generation_syntax deep flush_all - - -end diff --git a/Citadelle/examples/empirical_evaluation/Tree_06_02_shallow.thy b/Citadelle/examples/empirical_evaluation/Tree_06_02_shallow.thy deleted file mode 100644 index f2107b47069c3fafa0b0170fed621957381a67f4..0000000000000000000000000000000000000000 --- a/Citadelle/examples/empirical_evaluation/Tree_06_02_shallow.thy +++ /dev/null @@ -1,51 +0,0 @@ -theory Tree_06_02_shallow imports "../../src/UML_Main" "../../src/compiler/Static" "../../src/compiler/Generator_dynamic_sequential" begin -generation_syntax [ shallow (generation_semantics [ analysis ]) ] - -Class Aazz End -Class Bbyy End -Class Ccxx End -Class Ddww End -Class Eevv End -Class Ffuu End -Class Ggtt < Aazz End -Class Hhss < Aazz End -Class Iirr < Aazz End -Class Jjqq < Aazz End -Class Kkpp < Aazz End -Class Lloo < Aazz End -Class Mmnn < Bbyy End -Class Nnmm < Bbyy End -Class Ooll < Bbyy End -Class Ppkk < Bbyy End -Class Qqjj < Bbyy End -Class Rrii < Bbyy End -Class Sshh < Ccxx End -Class Ttgg < Ccxx End -Class Uuff < Ccxx End -Class Vvee < Ccxx End -Class Wwdd < Ccxx End -Class Xxcc < Ccxx End -Class Yybb < Ddww End -Class Zzaa < Ddww End -Class Baba < Ddww End -Class Bbbb < Ddww End -Class Bcbc < Ddww End -Class Bdbd < Ddww End -Class Bebe < Eevv End -Class Bfbf < Eevv End -Class Bgbg < Eevv End -Class Bhbh < Eevv End -Class Bibi < Eevv End -Class Bjbj < Eevv End -Class Bkbk < Ffuu End -Class Blbl < Ffuu End -Class Bmbm < Ffuu End -Class Bnbn < Ffuu End -Class Bobo < Ffuu End -Class Bpbp < Ffuu End - -(* 42 *) - -End! - -end diff --git a/Citadelle/examples/empirical_evaluation/Tree_07_01_deep_self.thy b/Citadelle/examples/empirical_evaluation/Tree_07_01_deep_self.thy deleted file mode 100644 index 3fa2104fad608d7d917b71686cd1ccb7be2ab824..0000000000000000000000000000000000000000 --- a/Citadelle/examples/empirical_evaluation/Tree_07_01_deep_self.thy +++ /dev/null @@ -1,25 +0,0 @@ -theory Tree_07_01_deep_self imports "../../src/compiler/Generator_dynamic_sequential" begin -generation_syntax [ deep - (generation_semantics [ analysis (*, oid_start 10*) ]) - skip_export - (THEORY Tree_07_01_generated_self) - (IMPORTS ["../../../src/UML_Main", "../../../src/compiler/Static"] - "../../../src/compiler/Generator_dynamic_sequential") - SECTION - [ in self ] - (output_directory "./doc") ] - -Class Aazz End -Class Bbyy End -Class Ccxx End -Class Ddww End -Class Eevv End -Class Ffuu End -Class Ggtt End - -(* 7 *) - -generation_syntax deep flush_all - - -end diff --git a/Citadelle/examples/empirical_evaluation/Tree_07_01_shallow.thy b/Citadelle/examples/empirical_evaluation/Tree_07_01_shallow.thy deleted file mode 100644 index 702b24b5d56f2ffe0406adcc1964926bece7504c..0000000000000000000000000000000000000000 --- a/Citadelle/examples/empirical_evaluation/Tree_07_01_shallow.thy +++ /dev/null @@ -1,16 +0,0 @@ -theory Tree_07_01_shallow imports "../../src/UML_Main" "../../src/compiler/Static" "../../src/compiler/Generator_dynamic_sequential" begin -generation_syntax [ shallow (generation_semantics [ analysis ]) ] - -Class Aazz End -Class Bbyy End -Class Ccxx End -Class Ddww End -Class Eevv End -Class Ffuu End -Class Ggtt End - -(* 7 *) - -End! - -end diff --git a/Citadelle/examples/empirical_evaluation/Tree_07_02_deep_self.thy b/Citadelle/examples/empirical_evaluation/Tree_07_02_deep_self.thy deleted file mode 100644 index 0a4d05fe340e4a0dc152fa4b8dc2388b0ead4f52..0000000000000000000000000000000000000000 --- a/Citadelle/examples/empirical_evaluation/Tree_07_02_deep_self.thy +++ /dev/null @@ -1,74 +0,0 @@ -theory Tree_07_02_deep_self imports "../../src/compiler/Generator_dynamic_sequential" begin -generation_syntax [ deep - (generation_semantics [ analysis (*, oid_start 10*) ]) - skip_export - (THEORY Tree_07_02_generated_self) - (IMPORTS ["../../../src/UML_Main", "../../../src/compiler/Static"] - "../../../src/compiler/Generator_dynamic_sequential") - SECTION - [ in self ] - (output_directory "./doc") ] - -Class Aazz End -Class Bbyy End -Class Ccxx End -Class Ddww End -Class Eevv End -Class Ffuu End -Class Ggtt End -Class Hhss < Aazz End -Class Iirr < Aazz End -Class Jjqq < Aazz End -Class Kkpp < Aazz End -Class Lloo < Aazz End -Class Mmnn < Aazz End -Class Nnmm < Aazz End -Class Ooll < Bbyy End -Class Ppkk < Bbyy End -Class Qqjj < Bbyy End -Class Rrii < Bbyy End -Class Sshh < Bbyy End -Class Ttgg < Bbyy End -Class Uuff < Bbyy End -Class Vvee < Ccxx End -Class Wwdd < Ccxx End -Class Xxcc < Ccxx End -Class Yybb < Ccxx End -Class Zzaa < Ccxx End -Class Baba < Ccxx End -Class Bbbb < Ccxx End -Class Bcbc < Ddww End -Class Bdbd < Ddww End -Class Bebe < Ddww End -Class Bfbf < Ddww End -Class Bgbg < Ddww End -Class Bhbh < Ddww End -Class Bibi < Ddww End -Class Bjbj < Eevv End -Class Bkbk < Eevv End -Class Blbl < Eevv End -Class Bmbm < Eevv End -Class Bnbn < Eevv End -Class Bobo < Eevv End -Class Bpbp < Eevv End -Class Bqbq < Ffuu End -Class Brbr < Ffuu End -Class Bsbs < Ffuu End -Class Btbt < Ffuu End -Class Bubu < Ffuu End -Class Bvbv < Ffuu End -Class Bwbw < Ffuu End -Class Bxbx < Ggtt End -Class Byby < Ggtt End -Class Bzbz < Ggtt End -Class Caca < Ggtt End -Class Cbcb < Ggtt End -Class Cccc < Ggtt End -Class Cdcd < Ggtt End - -(* 56 *) - -generation_syntax deep flush_all - - -end diff --git a/Citadelle/examples/empirical_evaluation/Tree_07_02_shallow.thy b/Citadelle/examples/empirical_evaluation/Tree_07_02_shallow.thy deleted file mode 100644 index c0c84d2c63192439750755e12cf2363029932f09..0000000000000000000000000000000000000000 --- a/Citadelle/examples/empirical_evaluation/Tree_07_02_shallow.thy +++ /dev/null @@ -1,65 +0,0 @@ -theory Tree_07_02_shallow imports "../../src/UML_Main" "../../src/compiler/Static" "../../src/compiler/Generator_dynamic_sequential" begin -generation_syntax [ shallow (generation_semantics [ analysis ]) ] - -Class Aazz End -Class Bbyy End -Class Ccxx End -Class Ddww End -Class Eevv End -Class Ffuu End -Class Ggtt End -Class Hhss < Aazz End -Class Iirr < Aazz End -Class Jjqq < Aazz End -Class Kkpp < Aazz End -Class Lloo < Aazz End -Class Mmnn < Aazz End -Class Nnmm < Aazz End -Class Ooll < Bbyy End -Class Ppkk < Bbyy End -Class Qqjj < Bbyy End -Class Rrii < Bbyy End -Class Sshh < Bbyy End -Class Ttgg < Bbyy End -Class Uuff < Bbyy End -Class Vvee < Ccxx End -Class Wwdd < Ccxx End -Class Xxcc < Ccxx End -Class Yybb < Ccxx End -Class Zzaa < Ccxx End -Class Baba < Ccxx End -Class Bbbb < Ccxx End -Class Bcbc < Ddww End -Class Bdbd < Ddww End -Class Bebe < Ddww End -Class Bfbf < Ddww End -Class Bgbg < Ddww End -Class Bhbh < Ddww End -Class Bibi < Ddww End -Class Bjbj < Eevv End -Class Bkbk < Eevv End -Class Blbl < Eevv End -Class Bmbm < Eevv End -Class Bnbn < Eevv End -Class Bobo < Eevv End -Class Bpbp < Eevv End -Class Bqbq < Ffuu End -Class Brbr < Ffuu End -Class Bsbs < Ffuu End -Class Btbt < Ffuu End -Class Bubu < Ffuu End -Class Bvbv < Ffuu End -Class Bwbw < Ffuu End -Class Bxbx < Ggtt End -Class Byby < Ggtt End -Class Bzbz < Ggtt End -Class Caca < Ggtt End -Class Cbcb < Ggtt End -Class Cccc < Ggtt End -Class Cdcd < Ggtt End - -(* 56 *) - -End! - -end diff --git a/Citadelle/examples/empirical_evaluation/Tree_12_01_deep_self.thy b/Citadelle/examples/empirical_evaluation/Tree_12_01_deep_self.thy deleted file mode 100644 index f8f35b369ec864ab247fdd796573d5819f778349..0000000000000000000000000000000000000000 --- a/Citadelle/examples/empirical_evaluation/Tree_12_01_deep_self.thy +++ /dev/null @@ -1,30 +0,0 @@ -theory Tree_12_01_deep_self imports "../../src/compiler/Generator_dynamic_sequential" begin -generation_syntax [ deep - (generation_semantics [ analysis (*, oid_start 10*) ]) - skip_export - (THEORY Tree_12_01_generated_self) - (IMPORTS ["../../../src/UML_Main", "../../../src/compiler/Static"] - "../../../src/compiler/Generator_dynamic_sequential") - SECTION - [ in self ] - (output_directory "./doc") ] - -Class Aazz End -Class Bbyy End -Class Ccxx End -Class Ddww End -Class Eevv End -Class Ffuu End -Class Ggtt End -Class Hhss End -Class Iirr End -Class Jjqq End -Class Kkpp End -Class Lloo End - -(* 12 *) - -generation_syntax deep flush_all - - -end diff --git a/Citadelle/examples/empirical_evaluation/Tree_12_01_shallow.thy b/Citadelle/examples/empirical_evaluation/Tree_12_01_shallow.thy deleted file mode 100644 index 44f92420387a6c8dcd3da8734f99d63ba3da36fd..0000000000000000000000000000000000000000 --- a/Citadelle/examples/empirical_evaluation/Tree_12_01_shallow.thy +++ /dev/null @@ -1,21 +0,0 @@ -theory Tree_12_01_shallow imports "../../src/UML_Main" "../../src/compiler/Static" "../../src/compiler/Generator_dynamic_sequential" begin -generation_syntax [ shallow (generation_semantics [ analysis ]) ] - -Class Aazz End -Class Bbyy End -Class Ccxx End -Class Ddww End -Class Eevv End -Class Ffuu End -Class Ggtt End -Class Hhss End -Class Iirr End -Class Jjqq End -Class Kkpp End -Class Lloo End - -(* 12 *) - -End! - -end diff --git a/Citadelle/examples/empirical_evaluation/Tree_14_01_deep_self.thy b/Citadelle/examples/empirical_evaluation/Tree_14_01_deep_self.thy deleted file mode 100644 index a5aa7965121753d5689c7561ad08c11a5646a20e..0000000000000000000000000000000000000000 --- a/Citadelle/examples/empirical_evaluation/Tree_14_01_deep_self.thy +++ /dev/null @@ -1,32 +0,0 @@ -theory Tree_14_01_deep_self imports "../../src/compiler/Generator_dynamic_sequential" begin -generation_syntax [ deep - (generation_semantics [ analysis (*, oid_start 10*) ]) - skip_export - (THEORY Tree_14_01_generated_self) - (IMPORTS ["../../../src/UML_Main", "../../../src/compiler/Static"] - "../../../src/compiler/Generator_dynamic_sequential") - SECTION - [ in self ] - (output_directory "./doc") ] - -Class Aazz End -Class Bbyy End -Class Ccxx End -Class Ddww End -Class Eevv End -Class Ffuu End -Class Ggtt End -Class Hhss End -Class Iirr End -Class Jjqq End -Class Kkpp End -Class Lloo End -Class Mmnn End -Class Nnmm End - -(* 14 *) - -generation_syntax deep flush_all - - -end diff --git a/Citadelle/examples/empirical_evaluation/Tree_14_01_shallow.thy b/Citadelle/examples/empirical_evaluation/Tree_14_01_shallow.thy deleted file mode 100644 index 5eb833eb5b461ca1d8fbece125fb1d0fc73ae9cc..0000000000000000000000000000000000000000 --- a/Citadelle/examples/empirical_evaluation/Tree_14_01_shallow.thy +++ /dev/null @@ -1,23 +0,0 @@ -theory Tree_14_01_shallow imports "../../src/UML_Main" "../../src/compiler/Static" "../../src/compiler/Generator_dynamic_sequential" begin -generation_syntax [ shallow (generation_semantics [ analysis ]) ] - -Class Aazz End -Class Bbyy End -Class Ccxx End -Class Ddww End -Class Eevv End -Class Ffuu End -Class Ggtt End -Class Hhss End -Class Iirr End -Class Jjqq End -Class Kkpp End -Class Lloo End -Class Mmnn End -Class Nnmm End - -(* 14 *) - -End! - -end diff --git a/Citadelle/examples/empirical_evaluation/Tree_20_01_deep_self.thy b/Citadelle/examples/empirical_evaluation/Tree_20_01_deep_self.thy deleted file mode 100644 index f334b34956397f47c6ef80d54a69dff9eb0b0306..0000000000000000000000000000000000000000 --- a/Citadelle/examples/empirical_evaluation/Tree_20_01_deep_self.thy +++ /dev/null @@ -1,38 +0,0 @@ -theory Tree_20_01_deep_self imports "../../src/compiler/Generator_dynamic_sequential" begin -generation_syntax [ deep - (generation_semantics [ analysis (*, oid_start 10*) ]) - skip_export - (THEORY Tree_20_01_generated_self) - (IMPORTS ["../../../src/UML_Main", "../../../src/compiler/Static"] - "../../../src/compiler/Generator_dynamic_sequential") - SECTION - [ in self ] - (output_directory "./doc") ] - -Class Aazz End -Class Bbyy End -Class Ccxx End -Class Ddww End -Class Eevv End -Class Ffuu End -Class Ggtt End -Class Hhss End -Class Iirr End -Class Jjqq End -Class Kkpp End -Class Lloo End -Class Mmnn End -Class Nnmm End -Class Ooll End -Class Ppkk End -Class Qqjj End -Class Rrii End -Class Sshh End -Class Ttgg End - -(* 20 *) - -generation_syntax deep flush_all - - -end diff --git a/Citadelle/examples/empirical_evaluation/Tree_20_01_shallow.thy b/Citadelle/examples/empirical_evaluation/Tree_20_01_shallow.thy deleted file mode 100644 index 951471baff6c8b4b35557771ce8eaa6ef6634275..0000000000000000000000000000000000000000 --- a/Citadelle/examples/empirical_evaluation/Tree_20_01_shallow.thy +++ /dev/null @@ -1,29 +0,0 @@ -theory Tree_20_01_shallow imports "../../src/UML_Main" "../../src/compiler/Static" "../../src/compiler/Generator_dynamic_sequential" begin -generation_syntax [ shallow (generation_semantics [ analysis ]) ] - -Class Aazz End -Class Bbyy End -Class Ccxx End -Class Ddww End -Class Eevv End -Class Ffuu End -Class Ggtt End -Class Hhss End -Class Iirr End -Class Jjqq End -Class Kkpp End -Class Lloo End -Class Mmnn End -Class Nnmm End -Class Ooll End -Class Ppkk End -Class Qqjj End -Class Rrii End -Class Sshh End -Class Ttgg End - -(* 20 *) - -End! - -end diff --git a/Citadelle/examples/empirical_evaluation/Tree_30_01_deep_self.thy b/Citadelle/examples/empirical_evaluation/Tree_30_01_deep_self.thy deleted file mode 100644 index 7524831ea1da57b46b7e4d8209e5c0b171ad1393..0000000000000000000000000000000000000000 --- a/Citadelle/examples/empirical_evaluation/Tree_30_01_deep_self.thy +++ /dev/null @@ -1,48 +0,0 @@ -theory Tree_30_01_deep_self imports "../../src/compiler/Generator_dynamic_sequential" begin -generation_syntax [ deep - (generation_semantics [ analysis (*, oid_start 10*) ]) - skip_export - (THEORY Tree_30_01_generated_self) - (IMPORTS ["../../../src/UML_Main", "../../../src/compiler/Static"] - "../../../src/compiler/Generator_dynamic_sequential") - SECTION - [ in self ] - (output_directory "./doc") ] - -Class Aazz End -Class Bbyy End -Class Ccxx End -Class Ddww End -Class Eevv End -Class Ffuu End -Class Ggtt End -Class Hhss End -Class Iirr End -Class Jjqq End -Class Kkpp End -Class Lloo End -Class Mmnn End -Class Nnmm End -Class Ooll End -Class Ppkk End -Class Qqjj End -Class Rrii End -Class Sshh End -Class Ttgg End -Class Uuff End -Class Vvee End -Class Wwdd End -Class Xxcc End -Class Yybb End -Class Zzaa End -Class Baba End -Class Bbbb End -Class Bcbc End -Class Bdbd End - -(* 30 *) - -generation_syntax deep flush_all - - -end diff --git a/Citadelle/examples/empirical_evaluation/Tree_30_01_shallow.thy b/Citadelle/examples/empirical_evaluation/Tree_30_01_shallow.thy deleted file mode 100644 index 0b55a47903bd964a9a3bab101aacb49af344a786..0000000000000000000000000000000000000000 --- a/Citadelle/examples/empirical_evaluation/Tree_30_01_shallow.thy +++ /dev/null @@ -1,39 +0,0 @@ -theory Tree_30_01_shallow imports "../../src/UML_Main" "../../src/compiler/Static" "../../src/compiler/Generator_dynamic_sequential" begin -generation_syntax [ shallow (generation_semantics [ analysis ]) ] - -Class Aazz End -Class Bbyy End -Class Ccxx End -Class Ddww End -Class Eevv End -Class Ffuu End -Class Ggtt End -Class Hhss End -Class Iirr End -Class Jjqq End -Class Kkpp End -Class Lloo End -Class Mmnn End -Class Nnmm End -Class Ooll End -Class Ppkk End -Class Qqjj End -Class Rrii End -Class Sshh End -Class Ttgg End -Class Uuff End -Class Vvee End -Class Wwdd End -Class Xxcc End -Class Yybb End -Class Zzaa End -Class Baba End -Class Bbbb End -Class Bcbc End -Class Bdbd End - -(* 30 *) - -End! - -end diff --git a/Citadelle/examples/empirical_evaluation/Tree_39_01_deep_self.thy b/Citadelle/examples/empirical_evaluation/Tree_39_01_deep_self.thy deleted file mode 100644 index f701cbe436c36a1b82fa6c829c2e69f547f9f140..0000000000000000000000000000000000000000 --- a/Citadelle/examples/empirical_evaluation/Tree_39_01_deep_self.thy +++ /dev/null @@ -1,57 +0,0 @@ -theory Tree_39_01_deep_self imports "../../src/compiler/Generator_dynamic_sequential" begin -generation_syntax [ deep - (generation_semantics [ analysis (*, oid_start 10*) ]) - skip_export - (THEORY Tree_39_01_generated_self) - (IMPORTS ["../../../src/UML_Main", "../../../src/compiler/Static"] - "../../../src/compiler/Generator_dynamic_sequential") - SECTION - [ in self ] - (output_directory "./doc") ] - -Class Aazz End -Class Bbyy End -Class Ccxx End -Class Ddww End -Class Eevv End -Class Ffuu End -Class Ggtt End -Class Hhss End -Class Iirr End -Class Jjqq End -Class Kkpp End -Class Lloo End -Class Mmnn End -Class Nnmm End -Class Ooll End -Class Ppkk End -Class Qqjj End -Class Rrii End -Class Sshh End -Class Ttgg End -Class Uuff End -Class Vvee End -Class Wwdd End -Class Xxcc End -Class Yybb End -Class Zzaa End -Class Baba End -Class Bbbb End -Class Bcbc End -Class Bdbd End -Class Bebe End -Class Bfbf End -Class Bgbg End -Class Bhbh End -Class Bibi End -Class Bjbj End -Class Bkbk End -Class Blbl End -Class Bmbm End - -(* 39 *) - -generation_syntax deep flush_all - - -end diff --git a/Citadelle/examples/empirical_evaluation/Tree_39_01_shallow.thy b/Citadelle/examples/empirical_evaluation/Tree_39_01_shallow.thy deleted file mode 100644 index 556b31a9c1b214d6321846e3122c05bdcef60964..0000000000000000000000000000000000000000 --- a/Citadelle/examples/empirical_evaluation/Tree_39_01_shallow.thy +++ /dev/null @@ -1,48 +0,0 @@ -theory Tree_39_01_shallow imports "../../src/UML_Main" "../../src/compiler/Static" "../../src/compiler/Generator_dynamic_sequential" begin -generation_syntax [ shallow (generation_semantics [ analysis ]) ] - -Class Aazz End -Class Bbyy End -Class Ccxx End -Class Ddww End -Class Eevv End -Class Ffuu End -Class Ggtt End -Class Hhss End -Class Iirr End -Class Jjqq End -Class Kkpp End -Class Lloo End -Class Mmnn End -Class Nnmm End -Class Ooll End -Class Ppkk End -Class Qqjj End -Class Rrii End -Class Sshh End -Class Ttgg End -Class Uuff End -Class Vvee End -Class Wwdd End -Class Xxcc End -Class Yybb End -Class Zzaa End -Class Baba End -Class Bbbb End -Class Bcbc End -Class Bdbd End -Class Bebe End -Class Bfbf End -Class Bgbg End -Class Bhbh End -Class Bibi End -Class Bjbj End -Class Bkbk End -Class Blbl End -Class Bmbm End - -(* 39 *) - -End! - -end diff --git a/Citadelle/examples/empirical_evaluation/Tree_42_01_deep_self.thy b/Citadelle/examples/empirical_evaluation/Tree_42_01_deep_self.thy deleted file mode 100644 index d31d17fb9cb83f188dada00982845f790275a9f0..0000000000000000000000000000000000000000 --- a/Citadelle/examples/empirical_evaluation/Tree_42_01_deep_self.thy +++ /dev/null @@ -1,60 +0,0 @@ -theory Tree_42_01_deep_self imports "../../src/compiler/Generator_dynamic_sequential" begin -generation_syntax [ deep - (generation_semantics [ analysis (*, oid_start 10*) ]) - skip_export - (THEORY Tree_42_01_generated_self) - (IMPORTS ["../../../src/UML_Main", "../../../src/compiler/Static"] - "../../../src/compiler/Generator_dynamic_sequential") - SECTION - [ in self ] - (output_directory "./doc") ] - -Class Aazz End -Class Bbyy End -Class Ccxx End -Class Ddww End -Class Eevv End -Class Ffuu End -Class Ggtt End -Class Hhss End -Class Iirr End -Class Jjqq End -Class Kkpp End -Class Lloo End -Class Mmnn End -Class Nnmm End -Class Ooll End -Class Ppkk End -Class Qqjj End -Class Rrii End -Class Sshh End -Class Ttgg End -Class Uuff End -Class Vvee End -Class Wwdd End -Class Xxcc End -Class Yybb End -Class Zzaa End -Class Baba End -Class Bbbb End -Class Bcbc End -Class Bdbd End -Class Bebe End -Class Bfbf End -Class Bgbg End -Class Bhbh End -Class Bibi End -Class Bjbj End -Class Bkbk End -Class Blbl End -Class Bmbm End -Class Bnbn End -Class Bobo End -Class Bpbp End - -(* 42 *) - -generation_syntax deep flush_all - - -end diff --git a/Citadelle/examples/empirical_evaluation/Tree_42_01_shallow.thy b/Citadelle/examples/empirical_evaluation/Tree_42_01_shallow.thy deleted file mode 100644 index 0241b55d80f514201a4d7bd424f578ec722c00d4..0000000000000000000000000000000000000000 --- a/Citadelle/examples/empirical_evaluation/Tree_42_01_shallow.thy +++ /dev/null @@ -1,51 +0,0 @@ -theory Tree_42_01_shallow imports "../../src/UML_Main" "../../src/compiler/Static" "../../src/compiler/Generator_dynamic_sequential" begin -generation_syntax [ shallow (generation_semantics [ analysis ]) ] - -Class Aazz End -Class Bbyy End -Class Ccxx End -Class Ddww End -Class Eevv End -Class Ffuu End -Class Ggtt End -Class Hhss End -Class Iirr End -Class Jjqq End -Class Kkpp End -Class Lloo End -Class Mmnn End -Class Nnmm End -Class Ooll End -Class Ppkk End -Class Qqjj End -Class Rrii End -Class Sshh End -Class Ttgg End -Class Uuff End -Class Vvee End -Class Wwdd End -Class Xxcc End -Class Yybb End -Class Zzaa End -Class Baba End -Class Bbbb End -Class Bcbc End -Class Bdbd End -Class Bebe End -Class Bfbf End -Class Bgbg End -Class Bhbh End -Class Bibi End -Class Bjbj End -Class Bkbk End -Class Blbl End -Class Bmbm End -Class Bnbn End -Class Bobo End -Class Bpbp End - -(* 42 *) - -End! - -end diff --git a/Citadelle/examples/empirical_evaluation/Tree_56_01_deep_self.thy b/Citadelle/examples/empirical_evaluation/Tree_56_01_deep_self.thy deleted file mode 100644 index c7d863c4ab02e4b1b12fb8edcfcf95f25df943a0..0000000000000000000000000000000000000000 --- a/Citadelle/examples/empirical_evaluation/Tree_56_01_deep_self.thy +++ /dev/null @@ -1,74 +0,0 @@ -theory Tree_56_01_deep_self imports "../../src/compiler/Generator_dynamic_sequential" begin -generation_syntax [ deep - (generation_semantics [ analysis (*, oid_start 10*) ]) - skip_export - (THEORY Tree_56_01_generated_self) - (IMPORTS ["../../../src/UML_Main", "../../../src/compiler/Static"] - "../../../src/compiler/Generator_dynamic_sequential") - SECTION - [ in self ] - (output_directory "./doc") ] - -Class Aazz End -Class Bbyy End -Class Ccxx End -Class Ddww End -Class Eevv End -Class Ffuu End -Class Ggtt End -Class Hhss End -Class Iirr End -Class Jjqq End -Class Kkpp End -Class Lloo End -Class Mmnn End -Class Nnmm End -Class Ooll End -Class Ppkk End -Class Qqjj End -Class Rrii End -Class Sshh End -Class Ttgg End -Class Uuff End -Class Vvee End -Class Wwdd End -Class Xxcc End -Class Yybb End -Class Zzaa End -Class Baba End -Class Bbbb End -Class Bcbc End -Class Bdbd End -Class Bebe End -Class Bfbf End -Class Bgbg End -Class Bhbh End -Class Bibi End -Class Bjbj End -Class Bkbk End -Class Blbl End -Class Bmbm End -Class Bnbn End -Class Bobo End -Class Bpbp End -Class Bqbq End -Class Brbr End -Class Bsbs End -Class Btbt End -Class Bubu End -Class Bvbv End -Class Bwbw End -Class Bxbx End -Class Byby End -Class Bzbz End -Class Caca End -Class Cbcb End -Class Cccc End -Class Cdcd End - -(* 56 *) - -generation_syntax deep flush_all - - -end diff --git a/Citadelle/examples/empirical_evaluation/Tree_56_01_shallow.thy b/Citadelle/examples/empirical_evaluation/Tree_56_01_shallow.thy deleted file mode 100644 index e82b060b75b6770b7287583b50f19bc2e3b1fe47..0000000000000000000000000000000000000000 --- a/Citadelle/examples/empirical_evaluation/Tree_56_01_shallow.thy +++ /dev/null @@ -1,65 +0,0 @@ -theory Tree_56_01_shallow imports "../../src/UML_Main" "../../src/compiler/Static" "../../src/compiler/Generator_dynamic_sequential" begin -generation_syntax [ shallow (generation_semantics [ analysis ]) ] - -Class Aazz End -Class Bbyy End -Class Ccxx End -Class Ddww End -Class Eevv End -Class Ffuu End -Class Ggtt End -Class Hhss End -Class Iirr End -Class Jjqq End -Class Kkpp End -Class Lloo End -Class Mmnn End -Class Nnmm End -Class Ooll End -Class Ppkk End -Class Qqjj End -Class Rrii End -Class Sshh End -Class Ttgg End -Class Uuff End -Class Vvee End -Class Wwdd End -Class Xxcc End -Class Yybb End -Class Zzaa End -Class Baba End -Class Bbbb End -Class Bcbc End -Class Bdbd End -Class Bebe End -Class Bfbf End -Class Bgbg End -Class Bhbh End -Class Bibi End -Class Bjbj End -Class Bkbk End -Class Blbl End -Class Bmbm End -Class Bnbn End -Class Bobo End -Class Bpbp End -Class Bqbq End -Class Brbr End -Class Bsbs End -Class Btbt End -Class Bubu End -Class Bvbv End -Class Bwbw End -Class Bxbx End -Class Byby End -Class Bzbz End -Class Caca End -Class Cbcb End -Class Cccc End -Class Cdcd End - -(* 56 *) - -End! - -end diff --git a/Citadelle/examples/empirical_evaluation/class_model.ml b/Citadelle/examples/empirical_evaluation/class_model.ml deleted file mode 100644 index 3db0e8820554ae69805df81c1b94fe338710f542..0000000000000000000000000000000000000000 --- a/Citadelle/examples/empirical_evaluation/class_model.ml +++ /dev/null @@ -1,60 +0,0 @@ -(****************************************************************************** - * Citadelle - * - * 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. - ******************************************************************************) - -open Class_model_isabelle.M -open Printf - -let _ = - main - (function Nat n -> BatString.explode (sprintf "%02d" (Big_int.int_of_big_int n))) - (fun file l -> - let file = BatString.implode file in - printf "%s%s\n" file - (if Sys.file_exists file then - " : file exists" - else - let oc = open_out file in - let () = - begin - List.iter (fun s -> output_string oc (BatString.implode s ^ "\n")) l; - close_out oc; - end in - "")) diff --git a/Citadelle/src/UML_Contracts.thy b/Citadelle/src/UML_Contracts.thy deleted file mode 100644 index 507d359a512827410304d3469f52389eaa6531cd..0000000000000000000000000000000000000000 --- a/Citadelle/src/UML_Contracts.thy +++ /dev/null @@ -1,416 +0,0 @@ -(****************************************************************************** - * 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 diff --git a/Citadelle/src/UML_Library.thy b/Citadelle/src/UML_Library.thy deleted file mode 100644 index 6d307ae7aef1d6874ffad11a3cae57200be1d0b3..0000000000000000000000000000000000000000 --- a/Citadelle/src/UML_Library.thy +++ /dev/null @@ -1,426 +0,0 @@ -(****************************************************************************** - * 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_Library -imports (* Basic Type Operations *) - "basic_types/UML_Boolean" - "basic_types/UML_Void" - "basic_types/UML_Integer" - "basic_types/UML_Real" - "basic_types/UML_String" - - (* Collection Type Operations *) - "collection_types/UML_Pair" - "collection_types/UML_Bag" - "collection_types/UML_Set" - "collection_types/UML_Sequence" -begin - -section{* Miscellaneous Stuff*} - -subsection{* Definition: asBoolean *} - -definition OclAsBoolean\<^sub>I\<^sub>n\<^sub>t :: "('\<AA>) Integer \<Rightarrow> ('\<AA>) Boolean" ("(_)->oclAsType\<^sub>I\<^sub>n\<^sub>t'(Boolean')") -where "OclAsBoolean\<^sub>I\<^sub>n\<^sub>t X = (\<lambda>\<tau>. if (\<delta> X) \<tau> = true \<tau> - then \<lfloor>\<lfloor>\<lceil>\<lceil>X \<tau>\<rceil>\<rceil> \<noteq> 0\<rfloor>\<rfloor> - else invalid \<tau>)" - -interpretation OclAsBoolean\<^sub>I\<^sub>n\<^sub>t : profile_mono\<^sub>d OclAsBoolean\<^sub>I\<^sub>n\<^sub>t "\<lambda>x. \<lfloor>\<lfloor>\<lceil>\<lceil>x\<rceil>\<rceil> \<noteq> 0\<rfloor>\<rfloor>" - by unfold_locales (auto simp: OclAsBoolean\<^sub>I\<^sub>n\<^sub>t_def bot_option_def) - -definition OclAsBoolean\<^sub>R\<^sub>e\<^sub>a\<^sub>l :: "('\<AA>) Real \<Rightarrow> ('\<AA>) Boolean" ("(_)->oclAsType\<^sub>R\<^sub>e\<^sub>a\<^sub>l'(Boolean')") -where "OclAsBoolean\<^sub>R\<^sub>e\<^sub>a\<^sub>l X = (\<lambda>\<tau>. if (\<delta> X) \<tau> = true \<tau> - then \<lfloor>\<lfloor>\<lceil>\<lceil>X \<tau>\<rceil>\<rceil> \<noteq> 0\<rfloor>\<rfloor> - else invalid \<tau>)" - -interpretation OclAsBoolean\<^sub>R\<^sub>e\<^sub>a\<^sub>l : profile_mono\<^sub>d OclAsBoolean\<^sub>R\<^sub>e\<^sub>a\<^sub>l "\<lambda>x. \<lfloor>\<lfloor>\<lceil>\<lceil>x\<rceil>\<rceil> \<noteq> 0\<rfloor>\<rfloor>" - by unfold_locales (auto simp: OclAsBoolean\<^sub>R\<^sub>e\<^sub>a\<^sub>l_def bot_option_def) - -subsection{* Definition: asInteger *} - -definition OclAsInteger\<^sub>R\<^sub>e\<^sub>a\<^sub>l :: "('\<AA>) Real \<Rightarrow> ('\<AA>) Integer" ("(_)->oclAsType\<^sub>R\<^sub>e\<^sub>a\<^sub>l'(Integer')") -where "OclAsInteger\<^sub>R\<^sub>e\<^sub>a\<^sub>l X = (\<lambda>\<tau>. if (\<delta> X) \<tau> = true \<tau> - then \<lfloor>\<lfloor>floor \<lceil>\<lceil>X \<tau>\<rceil>\<rceil>\<rfloor>\<rfloor> - else invalid \<tau>)" - -interpretation OclAsInteger\<^sub>R\<^sub>e\<^sub>a\<^sub>l : profile_mono\<^sub>d OclAsInteger\<^sub>R\<^sub>e\<^sub>a\<^sub>l "\<lambda>x. \<lfloor>\<lfloor>floor \<lceil>\<lceil>x\<rceil>\<rceil>\<rfloor>\<rfloor>" - by unfold_locales (auto simp: OclAsInteger\<^sub>R\<^sub>e\<^sub>a\<^sub>l_def bot_option_def) - -subsection{* Definition: asReal *} - -definition OclAsReal\<^sub>I\<^sub>n\<^sub>t :: "('\<AA>) Integer \<Rightarrow> ('\<AA>) Real" ("(_)->oclAsType\<^sub>I\<^sub>n\<^sub>t'(Real')") -where "OclAsReal\<^sub>I\<^sub>n\<^sub>t X = (\<lambda>\<tau>. if (\<delta> X) \<tau> = true \<tau> - then \<lfloor>\<lfloor>real_of_int \<lceil>\<lceil>X \<tau>\<rceil>\<rceil>\<rfloor>\<rfloor> - else invalid \<tau>)" - -interpretation OclAsReal\<^sub>I\<^sub>n\<^sub>t : profile_mono\<^sub>d OclAsReal\<^sub>I\<^sub>n\<^sub>t "\<lambda>x. \<lfloor>\<lfloor>real_of_int \<lceil>\<lceil>x\<rceil>\<rceil>\<rfloor>\<rfloor>" - by unfold_locales (auto simp: OclAsReal\<^sub>I\<^sub>n\<^sub>t_def bot_option_def) - -lemma Integer_subtype_of_Real: - assumes "\<tau> \<Turnstile> \<delta> X" - shows "\<tau> \<Turnstile> X ->oclAsType\<^sub>I\<^sub>n\<^sub>t(Real) ->oclAsType\<^sub>R\<^sub>e\<^sub>a\<^sub>l(Integer) \<triangleq> X" - apply(insert assms, simp add: OclAsInteger\<^sub>R\<^sub>e\<^sub>a\<^sub>l_def OclAsReal\<^sub>I\<^sub>n\<^sub>t_def OclValid_def StrongEq_def) - apply(subst (2 4) cp_defined, simp add: true_def) - by (metis assms bot_option_def foundation16 null_option_def option.exhaust_sel) - -subsection{* Definition: asPair *} - -definition OclAsPair\<^sub>S\<^sub>e\<^sub>q :: "[('\<AA>,'\<alpha>::null)Sequence]\<Rightarrow>('\<AA>,'\<alpha>::null,'\<alpha>::null) Pair" ("(_)->asPair\<^sub>S\<^sub>e\<^sub>q'(')") -where "OclAsPair\<^sub>S\<^sub>e\<^sub>q S = (if S->size\<^sub>S\<^sub>e\<^sub>q() \<doteq> \<two> - then Pair{S->at\<^sub>S\<^sub>e\<^sub>q(\<zero>),S->at\<^sub>S\<^sub>e\<^sub>q(\<one>)} - else invalid - endif)" - -definition OclAsPair\<^sub>S\<^sub>e\<^sub>t :: "[('\<AA>,'\<alpha>::null)Set]\<Rightarrow>('\<AA>,'\<alpha>::null,'\<alpha>::null) Pair" ("(_)->asPair\<^sub>S\<^sub>e\<^sub>t'(')") -where "OclAsPair\<^sub>S\<^sub>e\<^sub>t S = (if S->size\<^sub>S\<^sub>e\<^sub>t() \<doteq> \<two> - then let v = S->any\<^sub>S\<^sub>e\<^sub>t() in - Pair{v,S->excluding\<^sub>S\<^sub>e\<^sub>t(v)->any\<^sub>S\<^sub>e\<^sub>t()} - else invalid - endif)" - -definition OclAsPair\<^sub>B\<^sub>a\<^sub>g :: "[('\<AA>,'\<alpha>::null)Bag]\<Rightarrow>('\<AA>,'\<alpha>::null,'\<alpha>::null) Pair" ("(_)->asPair\<^sub>B\<^sub>a\<^sub>g'(')") -where "OclAsPair\<^sub>B\<^sub>a\<^sub>g S = (if S->size\<^sub>B\<^sub>a\<^sub>g() \<doteq> \<two> - then let v = S->any\<^sub>B\<^sub>a\<^sub>g() in - Pair{v,S->excluding\<^sub>B\<^sub>a\<^sub>g(v)->any\<^sub>B\<^sub>a\<^sub>g()} - else invalid - endif)" - -subsection{* Definition: asSet *} - -definition OclAsSet\<^sub>S\<^sub>e\<^sub>q :: "[('\<AA>,'\<alpha>::null)Sequence]\<Rightarrow>('\<AA>,'\<alpha>)Set" ("(_)->asSet\<^sub>S\<^sub>e\<^sub>q'(')") -where "OclAsSet\<^sub>S\<^sub>e\<^sub>q S = (S->iterate\<^sub>S\<^sub>e\<^sub>q(b; x = Set{} | x ->including\<^sub>S\<^sub>e\<^sub>t(b)))" - -definition OclAsSet\<^sub>P\<^sub>a\<^sub>i\<^sub>r :: "[('\<AA>,'\<alpha>::null,'\<alpha>::null) Pair]\<Rightarrow>('\<AA>,'\<alpha>)Set" ("(_)->asSet\<^sub>P\<^sub>a\<^sub>i\<^sub>r'(')") -where "OclAsSet\<^sub>P\<^sub>a\<^sub>i\<^sub>r S = Set{S .First(), S .Second()}" - -definition OclAsSet\<^sub>B\<^sub>a\<^sub>g :: "('\<AA>,'\<alpha>::null) Bag\<Rightarrow>('\<AA>,'\<alpha>)Set" ("(_)->asSet\<^sub>B\<^sub>a\<^sub>g'(')") -where "OclAsSet\<^sub>B\<^sub>a\<^sub>g S = (\<lambda> \<tau>. if (\<delta> S) \<tau> = true \<tau> - then Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e\<lfloor>\<lfloor> Rep_Set_base S \<tau> \<rfloor>\<rfloor> - else if (\<upsilon> S) \<tau> = true \<tau> then null \<tau> - else invalid \<tau>)" - -subsection{* Definition: asSequence *} - -definition OclAsSeq\<^sub>S\<^sub>e\<^sub>t :: "[('\<AA>,'\<alpha>::null)Set]\<Rightarrow>('\<AA>,'\<alpha>)Sequence" ("(_)->asSequence\<^sub>S\<^sub>e\<^sub>t'(')") -where "OclAsSeq\<^sub>S\<^sub>e\<^sub>t S = (S->iterate\<^sub>S\<^sub>e\<^sub>t(b; x = Sequence{} | x ->including\<^sub>S\<^sub>e\<^sub>q(b)))" - -definition OclAsSeq\<^sub>B\<^sub>a\<^sub>g :: "[('\<AA>,'\<alpha>::null)Bag]\<Rightarrow>('\<AA>,'\<alpha>)Sequence" ("(_)->asSequence\<^sub>B\<^sub>a\<^sub>g'(')") -where "OclAsSeq\<^sub>B\<^sub>a\<^sub>g S = (S->iterate\<^sub>B\<^sub>a\<^sub>g(b; x = Sequence{} | x ->including\<^sub>S\<^sub>e\<^sub>q(b)))" - -definition OclAsSeq\<^sub>P\<^sub>a\<^sub>i\<^sub>r :: "[('\<AA>,'\<alpha>::null,'\<alpha>::null) Pair]\<Rightarrow>('\<AA>,'\<alpha>)Sequence" ("(_)->asSequence\<^sub>P\<^sub>a\<^sub>i\<^sub>r'(')") -where "OclAsSeq\<^sub>P\<^sub>a\<^sub>i\<^sub>r S = Sequence{S .First(), S .Second()}" - -subsection{* Definition: asBag *} - -definition OclAsBag\<^sub>S\<^sub>e\<^sub>q :: "[('\<AA>,'\<alpha>::null)Sequence]\<Rightarrow>('\<AA>,'\<alpha>)Bag" ("(_)->asBag\<^sub>S\<^sub>e\<^sub>q'(')") -where "OclAsBag\<^sub>S\<^sub>e\<^sub>q S = (\<lambda>\<tau>. Abs_Bag\<^sub>b\<^sub>a\<^sub>s\<^sub>e \<lfloor>\<lfloor>\<lambda>s. if list_ex ((=) s) \<lceil>\<lceil>Rep_Sequence\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil> then 1 else 0\<rfloor>\<rfloor>)" - -definition OclAsBag\<^sub>S\<^sub>e\<^sub>t :: "[('\<AA>,'\<alpha>::null)Set]\<Rightarrow>('\<AA>,'\<alpha>)Bag" ("(_)->asBag\<^sub>S\<^sub>e\<^sub>t'(')") -where "OclAsBag\<^sub>S\<^sub>e\<^sub>t S = (\<lambda>\<tau>. Abs_Bag\<^sub>b\<^sub>a\<^sub>s\<^sub>e \<lfloor>\<lfloor>\<lambda>s. if s \<in> \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil> then 1 else 0\<rfloor>\<rfloor>)" - -lemma assumes "\<tau> \<Turnstile> \<delta> (S ->size\<^sub>S\<^sub>e\<^sub>t())" (* S is finite *) - shows "OclAsBag\<^sub>S\<^sub>e\<^sub>t S = (S->iterate\<^sub>S\<^sub>e\<^sub>t(b; x = Bag{} | x ->including\<^sub>B\<^sub>a\<^sub>g(b)))" -oops - -definition OclAsBag\<^sub>P\<^sub>a\<^sub>i\<^sub>r :: "[('\<AA>,'\<alpha>::null,'\<alpha>::null) Pair]\<Rightarrow>('\<AA>,'\<alpha>)Bag" ("(_)->asBag\<^sub>P\<^sub>a\<^sub>i\<^sub>r'(')") -where "OclAsBag\<^sub>P\<^sub>a\<^sub>i\<^sub>r S = Bag{S .First(), S .Second()}" - -text_raw{* \isatagafp *} -subsection{* Collection Types *} -lemmas cp_intro'' [intro!,simp,code_unfold] = - cp_intro' - (* cp_intro''\<^sub>P\<^sub>a\<^sub>i\<^sub>r *) - cp_intro''\<^sub>S\<^sub>e\<^sub>t - cp_intro''\<^sub>S\<^sub>e\<^sub>q -text_raw{* \endisatagafp *} - -subsection{* Test Statements *} - -lemma syntax_test: "Set{\<two>,\<one>} = (Set{}->including\<^sub>S\<^sub>e\<^sub>t(\<one>)->including\<^sub>S\<^sub>e\<^sub>t(\<two>))" -by (rule refl) - -text{* Here is an example of a nested collection. *} -lemma semantic_test2: -assumes H:"(Set{\<two>} \<doteq> null) = (false::('\<AA>)Boolean)" -shows "(\<tau>::('\<AA>)st) \<Turnstile> (Set{Set{\<two>},null}->includes\<^sub>S\<^sub>e\<^sub>t(null))" -by(simp add: OclIncludes_execute\<^sub>S\<^sub>e\<^sub>t H) - - - -lemma short_cut'[simp,code_unfold]: "(\<eight> \<doteq> \<six>) = false" - apply(rule ext) - apply(simp add: StrictRefEq\<^sub>I\<^sub>n\<^sub>t\<^sub>e\<^sub>g\<^sub>e\<^sub>r StrongEq_def OclInt8_def OclInt6_def - true_def false_def invalid_def bot_option_def) -done - -lemma short_cut''[simp,code_unfold]: "(\<two> \<doteq> \<one>) = false" - apply(rule ext) - apply(simp add: StrictRefEq\<^sub>I\<^sub>n\<^sub>t\<^sub>e\<^sub>g\<^sub>e\<^sub>r StrongEq_def OclInt2_def OclInt1_def - true_def false_def invalid_def bot_option_def) -done -lemma short_cut'''[simp,code_unfold]: "(\<one> \<doteq> \<two>) = false" - apply(rule ext) - apply(simp add: StrictRefEq\<^sub>I\<^sub>n\<^sub>t\<^sub>e\<^sub>g\<^sub>e\<^sub>r StrongEq_def OclInt2_def OclInt1_def - true_def false_def invalid_def bot_option_def) -done - -Assert "\<tau> \<Turnstile> (\<zero> <\<^sub>i\<^sub>n\<^sub>t \<two>) and (\<zero> <\<^sub>i\<^sub>n\<^sub>t \<one>) " - - -text{* Elementary computations on Sets.*} - -declare OclSelect_body_def [simp] - -Assert "\<not> (\<tau> \<Turnstile> \<upsilon>(invalid::('\<AA>,'\<alpha>::null) Set))" -Assert "\<tau> \<Turnstile> \<upsilon>(null::('\<AA>,'\<alpha>::null) Set)" -Assert "\<not> (\<tau> \<Turnstile> \<delta>(null::('\<AA>,'\<alpha>::null) Set))" -Assert "\<tau> \<Turnstile> \<upsilon>(Set{})" -Assert "\<tau> \<Turnstile> \<upsilon>(Set{Set{\<two>},null})" -Assert "\<tau> \<Turnstile> \<delta>(Set{Set{\<two>},null})" -Assert "\<tau> \<Turnstile> (Set{\<two>,\<one>}->includes\<^sub>S\<^sub>e\<^sub>t(\<one>))" -Assert "\<not> (\<tau> \<Turnstile> (Set{\<two>}->includes\<^sub>S\<^sub>e\<^sub>t(\<one>)))" -Assert "\<not> (\<tau> \<Turnstile> (Set{\<two>,\<one>}->includes\<^sub>S\<^sub>e\<^sub>t(null)))" -Assert "\<tau> \<Turnstile> (Set{\<two>,null}->includes\<^sub>S\<^sub>e\<^sub>t(null))" -Assert "\<tau> \<Turnstile> (Set{null,\<two>}->includes\<^sub>S\<^sub>e\<^sub>t(null))" - -Assert "\<tau> \<Turnstile> ((Set{})->forAll\<^sub>S\<^sub>e\<^sub>t(z | \<zero> <\<^sub>i\<^sub>n\<^sub>t z))" - -Assert "\<tau> \<Turnstile> ((Set{\<two>,\<one>})->forAll\<^sub>S\<^sub>e\<^sub>t(z | \<zero> <\<^sub>i\<^sub>n\<^sub>t z))" -Assert "\<not> (\<tau> \<Turnstile> ((Set{\<two>,\<one>})->exists\<^sub>S\<^sub>e\<^sub>t(z | z <\<^sub>i\<^sub>n\<^sub>t \<zero> )))" -Assert "\<not> (\<tau> \<Turnstile> (\<delta>(Set{\<two>,null})->forAll\<^sub>S\<^sub>e\<^sub>t(z | \<zero> <\<^sub>i\<^sub>n\<^sub>t z)))" -Assert "\<not> (\<tau> \<Turnstile> ((Set{\<two>,null})->forAll\<^sub>S\<^sub>e\<^sub>t(z | \<zero> <\<^sub>i\<^sub>n\<^sub>t z)))" -Assert "\<tau> \<Turnstile> ((Set{\<two>,null})->exists\<^sub>S\<^sub>e\<^sub>t(z | \<zero> <\<^sub>i\<^sub>n\<^sub>t z))" - - -Assert "\<not> (\<tau> \<Turnstile> (Set{null::'a Boolean} \<doteq> Set{}))" -Assert "\<not> (\<tau> \<Turnstile> (Set{null::'a Integer} \<doteq> Set{}))" - -Assert "\<not> (\<tau> \<Turnstile> (Set{true} \<doteq> Set{false}))" -Assert "\<not> (\<tau> \<Turnstile> (Set{true,true} \<doteq> Set{false}))" -Assert "\<not> (\<tau> \<Turnstile> (Set{\<two>} \<doteq> Set{\<one>}))" -Assert "\<tau> \<Turnstile> (Set{\<two>,null,\<two>} \<doteq> Set{null,\<two>})" -Assert "\<tau> \<Turnstile> (Set{\<one>,null,\<two>} <> Set{null,\<two>})" -Assert "\<tau> \<Turnstile> (Set{Set{\<two>,null}} \<doteq> Set{Set{null,\<two>}})" -Assert "\<tau> \<Turnstile> (Set{Set{\<two>,null}} <> Set{Set{null,\<two>},null})" -Assert "\<tau> \<Turnstile> (Set{null}->select\<^sub>S\<^sub>e\<^sub>t(x | not x) \<doteq> Set{null})" -Assert "\<tau> \<Turnstile> (Set{null}->reject\<^sub>S\<^sub>e\<^sub>t(x | not x) \<doteq> Set{null})" - -lemma "const (Set{Set{\<two>,null}, invalid})" by(simp add: const_ss) - - -text{* Elementary computations on Sequences.*} - -(*(*TODO*)declare OclSelect_body_def [simp]*) - -Assert "\<not> (\<tau> \<Turnstile> \<upsilon>(invalid::('\<AA>,'\<alpha>::null) Sequence))" -Assert "\<tau> \<Turnstile> \<upsilon>(null::('\<AA>,'\<alpha>::null) Sequence)" -Assert "\<not> (\<tau> \<Turnstile> \<delta>(null::('\<AA>,'\<alpha>::null) Sequence))" -Assert "\<tau> \<Turnstile> \<upsilon>(Sequence{})" -(*(*TOFIX*)Assert "\<tau> \<Turnstile> \<upsilon>(Sequence{Sequence{\<two>},null})" -Assert "\<tau> \<Turnstile> \<delta>(Sequence{Sequence{\<two>},null})"*) -(*(*TODO*)Assert "\<tau> \<Turnstile> (Sequence{\<two>,\<one>}->includes\<^sub>S\<^sub>e\<^sub>q(\<one>))" -Assert "\<not> (\<tau> \<Turnstile> (Sequence{\<two>}->includes\<^sub>S\<^sub>e\<^sub>q(\<one>)))" -Assert "\<not> (\<tau> \<Turnstile> (Sequence{\<two>,\<one>}->includes\<^sub>S\<^sub>e\<^sub>q(null)))" -Assert "\<tau> \<Turnstile> (Sequence{\<two>,null}->includes\<^sub>S\<^sub>e\<^sub>q(null))" -Assert "\<tau> \<Turnstile> (Sequence{null,\<two>}->includes\<^sub>S\<^sub>e\<^sub>q(null))"*) -(*(*TOFIX*) -Assert "\<tau> \<Turnstile> ((Sequence{})->forAll\<^sub>S\<^sub>e\<^sub>q(z | \<zero> <\<^sub>i\<^sub>n\<^sub>t z))" - -Assert "\<tau> \<Turnstile> ((Sequence{\<two>,\<one>})->forAll\<^sub>S\<^sub>e\<^sub>q(z | \<zero> <\<^sub>i\<^sub>n\<^sub>t z))" -Assert "\<not> (\<tau> \<Turnstile> ((Sequence{\<two>,\<one>})->exists\<^sub>S\<^sub>e\<^sub>q(z | z <\<^sub>i\<^sub>n\<^sub>t \<zero> )))" -Assert "\<not> (\<tau> \<Turnstile> (\<delta>(Sequence{\<two>,null})->forAll\<^sub>S\<^sub>e\<^sub>q(z | \<zero> <\<^sub>i\<^sub>n\<^sub>t z)))" -Assert "\<not> (\<tau> \<Turnstile> ((Sequence{\<two>,null})->forAll\<^sub>S\<^sub>e\<^sub>q(z | \<zero> <\<^sub>i\<^sub>n\<^sub>t z)))" -Assert "\<tau> \<Turnstile> ((Sequence{\<two>,null})->exists\<^sub>S\<^sub>e\<^sub>q(z | \<zero> <\<^sub>i\<^sub>n\<^sub>t z))" - - -Assert "\<not> (\<tau> \<Turnstile> (Sequence{null::'a Boolean} \<doteq> Sequence{}))" -Assert "\<not> (\<tau> \<Turnstile> (Sequence{null::'a Integer} \<doteq> Sequence{}))" - -Assert "\<not> (\<tau> \<Turnstile> (Sequence{true} \<doteq> Sequence{false}))" -Assert "\<not> (\<tau> \<Turnstile> (Sequence{true,true} \<doteq> Sequence{false}))" -Assert "\<not> (\<tau> \<Turnstile> (Sequence{\<two>} \<doteq> Sequence{\<one>}))" -Assert "\<tau> \<Turnstile> (Sequence{\<two>,null,\<two>} \<doteq> Sequence{null,\<two>})" -Assert "\<tau> \<Turnstile> (Sequence{\<one>,null,\<two>} <> Sequence{null,\<two>})" -Assert "\<tau> \<Turnstile> (Sequence{Sequence{\<two>,null}} \<doteq> Sequence{Sequence{null,\<two>}})" -Assert "\<tau> \<Turnstile> (Sequence{Sequence{\<two>,null}} <> Sequence{Sequence{null,\<two>},null})" -Assert "\<tau> \<Turnstile> (Sequence{null}->select\<^sub>S\<^sub>e\<^sub>q(x | not x) \<doteq> Sequence{null})"*) -(*(*TODO*)Assert "\<tau> \<Turnstile> (Sequence{null}->reject\<^sub>S\<^sub>e\<^sub>q(x | not x) \<doteq> Sequence{null})"*) - -lemma "const (Sequence{Sequence{\<two>,null}, invalid})" by(simp add: const_ss) - -(*<*) -section{* Experiment with Cartouches *} - -subsection{* ... *} - -ML {* - local - fun mk_char (s, _) accu = - fold - (fn c => fn l => - Syntax.const @{const_syntax Cons} - $ (Syntax.const @{const_syntax Char} $ HOLogic.mk_numeral c) - $ l) - (rev (map Char.ord (String.explode s))) - accu; - - fun mk_string [] = Const (@{const_syntax Nil}, @{typ "char list"}) - | mk_string (s :: ss) = mk_char s (mk_string ss); - - fun mk_int [] = raise TERM ("int_tr", []) - | mk_int S = let val s = implode(map fst S) in - case Int.fromString s of - NONE => raise TERM (" int_tr", []) - | SOME(i) => HOLogic.mk_number HOLogic.intT i - end - - fun mk_number i = - let - fun mk 1 = Syntax.const @{const_syntax Num.One} - | mk i = - let - val (q, r) = Integer.div_mod i 2; - val bit = if r = 0 then @{const_syntax Num.Bit0} else @{const_syntax Num.Bit1}; - in Syntax.const bit $ (mk q) end; - in - if i = 0 then Syntax.const @{const_syntax Groups.zero} - else if i > 0 then Syntax.const @{const_syntax Num.numeral} $ mk i - else - Syntax.const @{const_syntax Groups.uminus} $ - (Syntax.const @{const_syntax Num.numeral} $ mk (~ i)) - end; - - fun mk_frac str = - let - val {mant = i, exp = n} = Lexicon.read_float str; - val exp = Syntax.const @{const_syntax Power.power}; - val ten = mk_number 10; - val exp10 = if n = 1 then ten else exp $ ten $ mk_number n; - in Syntax.const @{const_syntax divide} $ mk_number i $ exp10 end; - - in - val POKE = Unsynchronized.ref ([]:term list) - fun string_tr f content args = - let fun err () = raise TERM ("string_tr", args) in - (case args of - [(c as Const (@{syntax_const "_constrain"}, _)) $ Free (s, _) $ p] => - (case Term_Position.decode_position p of - SOME (pos, _) => c $ f (mk_string (content (s, pos))) $ p - | NONE => err ()) - | _ => err ()) - end; - - fun int_tr f content args = - let fun err () = raise TERM ("int_tr", args) in - (case args of - [(c as Const (@{syntax_const "_constrain"}, _)) $ Free (s, _) $ p] => - (case Term_Position.decode_position p of - SOME (pos, _) => c $ f (mk_int (content (s, pos))) $ p - | NONE => err ()) - | _ => err ()) - end; - - fun float_tr f [(c as Const (@{syntax_const "_constrain"}, _)) $ t $ u $ p] = - c $ f (float_tr f [t]) $ u - | float_tr _ [Const (str, _)] = mk_frac str - | float_tr _ ts = (POKE:=ts;raise TERM ("float_tr", ts)); - (* in [(@{syntax_const "_Float"}, K float_tr)] end *) - - end; -*} - -term "123" - -(* -term "\<open>abc\<close>" -term "\<open>123\<close>" -term "\<open>12,24\<close>" -term "\<open>-12.24\<close>" -*) - -syntax "_cartouche_oclstring" :: "cartouche_position \<Rightarrow> _" ("_") - -subsection{* ... *} - -parse_translation {* - [( @{syntax_const "_cartouche_oclstring"} - , let val cartouche_type = Attrib.setup_config_string @{binding cartouche_type} (K "String") in - fn ctxt => - - (case Config.get ctxt cartouche_type of - "String" => (string_tr - (fn x => Abs("_",dummyT, - Syntax.const @{const_syntax Some} $ - ( Syntax.const @{const_syntax Some} $ x))) - (Symbol_Pos.cartouche_content o Symbol_Pos.explode)) - | "Integer" => int_tr - (fn x => Abs("_",dummyT, - Syntax.const @{const_syntax Some} $ - ( Syntax.const @{const_syntax Some} $ x))) - (Symbol_Pos.cartouche_content o Symbol_Pos.explode) - | "Real" => float_tr (fn x => Abs("_",dummyT, - Syntax.const @{const_syntax Some} $ - ( Syntax.const @{const_syntax Some} $ x))) - | s => error ("Unregistered return type for the cartouche: \"" ^ s ^ "\"")) - - end)] -*} - - -declare [[cartouche_type="Integer"]] -term "\<open>-123\<close>" -declare [[cartouche_type="Real"]] -(*term "\<open>-123.23\<close>" -ML{* (*!POKE -so, the cartouche invocation yields:*) -val it = [Const ("_constrain" , "_") $ Free ("\<open>-123.23\<close>", "_") $ Free ("<markup>", "_")]: term list -*}*) - -syntax - "_ocl_denotation" :: "str_position => string" ("'_'") - -(*>*) -end diff --git a/Citadelle/src/UML_Logic.thy b/Citadelle/src/UML_Logic.thy deleted file mode 100644 index 39319172e674b1ba78f4bc8f8550acde68894e27..0000000000000000000000000000000000000000 --- a/Citadelle/src/UML_Logic.thy +++ /dev/null @@ -1,1491 +0,0 @@ -(****************************************************************************** - * 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. - ******************************************************************************) - -chapter{* Formalization II: OCL Terms and Library Operations *} - -theory UML_Logic -imports UML_Types -begin - -section{* The Operations of the Boolean Type and the OCL Logic*} - -subsection{* Basic Constants *} - -lemma bot_Boolean_def : "(bot::('\<AA>)Boolean) = (\<lambda> \<tau>. \<bottom>)" -by(simp add: bot_fun_def bot_option_def) - -lemma null_Boolean_def : "(null::('\<AA>)Boolean) = (\<lambda> \<tau>. \<lfloor>\<bottom>\<rfloor>)" -by(simp add: null_fun_def null_option_def bot_option_def) - -definition true :: "('\<AA>)Boolean" -where "true \<equiv> \<lambda> \<tau>. \<lfloor>\<lfloor>True\<rfloor>\<rfloor>" - - -definition false :: "('\<AA>)Boolean" -where "false \<equiv> \<lambda> \<tau>. \<lfloor>\<lfloor>False\<rfloor>\<rfloor>" - -lemma bool_split_0: "X \<tau> = invalid \<tau> \<or> X \<tau> = null \<tau> \<or> - X \<tau> = true \<tau> \<or> X \<tau> = false \<tau>" -apply(simp add: invalid_def null_def true_def false_def) -apply(case_tac "X \<tau>",simp_all add: null_fun_def null_option_def bot_option_def) -apply(case_tac "a",simp) -apply(case_tac "aa",simp) -apply auto -done - - - -lemma [simp]: "false (a, b) = \<lfloor>\<lfloor>False\<rfloor>\<rfloor>" -by(simp add:false_def) - -lemma [simp]: "true (a, b) = \<lfloor>\<lfloor>True\<rfloor>\<rfloor>" -by(simp add:true_def) - -lemma textbook_true: "I\<lbrakk>true\<rbrakk> \<tau> = \<lfloor>\<lfloor>True\<rfloor>\<rfloor>" -by(simp add: Sem_def true_def) - -lemma textbook_false: "I\<lbrakk>false\<rbrakk> \<tau> = \<lfloor>\<lfloor>False\<rfloor>\<rfloor>" -by(simp add: Sem_def false_def) - -(* This following para contains a cool technique to generate documentation - with formal content. We should use it everywhere for documentation. *) -text {* -\begin{table}[htbp] - \centering - \begin{tabu}{lX[,c,]} - \toprule - Name & Theorem \\ - \midrule - @{thm [source] textbook_invalid} & @{thm [display=false] textbook_invalid} \\ - @{thm [source] textbook_null_fun} & @{thm [display=false] textbook_null_fun} \\ - @{thm [source] textbook_true} & @{thm [display=false] textbook_true} \\ - @{thm [source] textbook_false} & @{thm [display=false] textbook_false} \\ - \bottomrule - \end{tabu} - \caption{Basic semantic constant definitions of the logic} - \label{tab:sem_basic_constants} -\end{table} -*} - -subsection{* Validity and Definedness *} - -text{* However, this has also the consequence that core concepts like definedness, -validity and even cp have to be redefined on this type class:*} - -definition valid :: "('\<AA>,'a::null)val \<Rightarrow> ('\<AA>)Boolean" ("\<upsilon> _" [100]100) -where "\<upsilon> X \<equiv> \<lambda> \<tau> . if X \<tau> = bot \<tau> then false \<tau> else true \<tau>" - -lemma valid1[simp]: "\<upsilon> invalid = false" - by(rule ext,simp add: valid_def bot_fun_def bot_option_def - invalid_def true_def false_def) -lemma valid2[simp]: "\<upsilon> null = true" - by(rule ext,simp add: valid_def bot_fun_def bot_option_def null_is_valid - null_fun_def invalid_def true_def false_def) -lemma valid3[simp]: "\<upsilon> true = true" - by(rule ext,simp add: valid_def bot_fun_def bot_option_def null_is_valid - null_fun_def invalid_def true_def false_def) -lemma valid4[simp]: "\<upsilon> false = true" - by(rule ext,simp add: valid_def bot_fun_def bot_option_def null_is_valid - null_fun_def invalid_def true_def false_def) -text_raw{* \isatagafp *} -lemma cp_valid: "(\<upsilon> X) \<tau> = (\<upsilon> (\<lambda> _. X \<tau>)) \<tau>" -by(simp add: valid_def) -text_raw{* \endisatagafp *} - -definition defined :: "('\<AA>,'a::null)val \<Rightarrow> ('\<AA>)Boolean" ("\<delta> _" [100]100) -where "\<delta> X \<equiv> \<lambda> \<tau> . if X \<tau> = bot \<tau> \<or> X \<tau> = null \<tau> then false \<tau> else true \<tau>" - -text{* The generalized definitions of invalid and definedness have the same -properties as the old ones : *} -lemma defined1[simp]: "\<delta> invalid = false" - by(rule ext,simp add: defined_def bot_fun_def bot_option_def - null_def invalid_def true_def false_def) -lemma defined2[simp]: "\<delta> null = false" - by(rule ext,simp add: defined_def bot_fun_def bot_option_def - null_def null_option_def null_fun_def invalid_def true_def false_def) -lemma defined3[simp]: "\<delta> true = true" - by(rule ext,simp add: defined_def bot_fun_def bot_option_def null_is_valid null_option_def - null_fun_def invalid_def true_def false_def) -lemma defined4[simp]: "\<delta> false = true" - by(rule ext,simp add: defined_def bot_fun_def bot_option_def null_is_valid null_option_def - null_fun_def invalid_def true_def false_def) -lemma defined5[simp]: "\<delta> \<delta> X = true" - by(rule ext, - auto simp: defined_def true_def false_def - bot_fun_def bot_option_def null_option_def null_fun_def) -lemma defined6[simp]: "\<delta> \<upsilon> X = true" - by(rule ext, - auto simp: valid_def defined_def true_def false_def - bot_fun_def bot_option_def null_option_def null_fun_def) -lemma valid5[simp]: "\<upsilon> \<upsilon> X = true" - by(rule ext, - auto simp: valid_def true_def false_def - bot_fun_def bot_option_def null_option_def null_fun_def) -lemma valid6[simp]: "\<upsilon> \<delta> X = true" - by(rule ext, - auto simp: valid_def defined_def true_def false_def - bot_fun_def bot_option_def null_option_def null_fun_def) -text_raw{* \isatagafp *} -lemma cp_defined:"(\<delta> X)\<tau> = (\<delta> (\<lambda> _. X \<tau>)) \<tau>" -by(simp add: defined_def) -text_raw{* \endisatagafp *} - -text{* The definitions above for the constants @{const defined} and @{const valid} -can be rewritten into the conventional semantic "textbook" format as follows: *} - -lemma textbook_defined: "I\<lbrakk>\<delta>(X)\<rbrakk> \<tau> = (if I\<lbrakk>X\<rbrakk> \<tau> = I\<lbrakk>bot\<rbrakk> \<tau> \<or> I\<lbrakk>X\<rbrakk> \<tau> = I\<lbrakk>null\<rbrakk> \<tau> - then I\<lbrakk>false\<rbrakk> \<tau> - else I\<lbrakk>true\<rbrakk> \<tau>)" -by(simp add: Sem_def defined_def) - -lemma textbook_valid: "I\<lbrakk>\<upsilon>(X)\<rbrakk> \<tau> = (if I\<lbrakk>X\<rbrakk> \<tau> = I\<lbrakk>bot\<rbrakk> \<tau> - then I\<lbrakk>false\<rbrakk> \<tau> - else I\<lbrakk>true\<rbrakk> \<tau>)" -by(simp add: Sem_def valid_def) - - -text {* -\autoref{tab:sem_definedness} and \autoref{tab:alglaws_definedness} -summarize the results of this section. -\begin{table}[htbp] - \centering - \begin{tabu}{lX[,c,]} - \toprule - Name & Theorem \\ - \midrule - @{thm [source] textbook_defined} & @{thm [show_question_marks=false,display=false,margin=45] textbook_defined} \\ - @{thm [source] textbook_valid} & @{thm [show_question_marks=false,display=false,margin=45] textbook_valid} \\ - \bottomrule - \end{tabu} - \caption{Basic predicate definitions of the logic.} - \label{tab:sem_definedness} -\end{table} -\begin{table}[htbp] - \centering - \begin{tabu}{lX[,c,]} - \toprule - Name & Theorem \\ - \midrule - @{thm [source] defined1} & @{thm defined1} \\ - @{thm [source] defined2} & @{thm [display=false,margin=35] defined2} \\ - @{thm [source] defined3} & @{thm [display=false,margin=35] defined3} \\ - @{thm [source] defined4} & @{thm [display=false,margin=35] defined4} \\ - @{thm [source] defined5} & @{thm [display=false,margin=35] defined5} \\ - @{thm [source] defined6} & @{thm [display=false,margin=35] defined6} \\ - \bottomrule - \end{tabu} - \caption{Laws of the basic predicates of the logic.} - \label{tab:alglaws_definedness} -\end{table} -*} - -subsection{* The Equalities of OCL \label{sec:equality}*} -text{* - The OCL contains a particular version of equality, written in - Standard documents \inlineocl+_ = _+ and \inlineocl+_ <> _+ for its - negation, which is referred as \emph{weak referential equality} - hereafter and for which we use the symbol \inlineisar+_ \<doteq> _+ - throughout the formal part of this document. Its semantics is - motivated by the desire of fast execution, and similarity to - languages like Java and C, but does not satisfy the needs of logical - reasoning over OCL expressions and specifications. We therefore - introduce a second equality, referred as \emph{strong equality} or - \emph{logical equality} and written \inlineisar+_ \<triangleq> _+ - which is not present in the current standard but was discussed in - prior texts on OCL like the Amsterdam - Manifesto~\cite{cook.ea::amsterdam:2002} and was identified as - desirable extension of OCL in the Aachen - Meeting~\cite{brucker.ea:summary-aachen:2013} in the future 2.5 OCL - Standard. The purpose of strong equality is to define and reason - over OCL. It is therefore a natural task in Featherweight OCL to - formally investigate the somewhat quite complex relationship between - these two. *} text{* Strong equality has two motivations: a - pragmatic one and a fundamental one. - \begin{enumerate} - \item The pragmatic reason is fairly simple: users of object-oriented languages want - something like a ``shallow object value equality''. - You will want to say - \inlineisar+ a.boss \<triangleq> b.boss@pre + - instead of -\begin{isar} - a.boss \<doteq> b.boss@pre and (* just the pointers are equal! *) - a.boss.name \<doteq> b.boss@pre.name@pre and - a.boss.age \<doteq> b.boss@pre.age@pre -\end{isar} - Breaking a shallow-object equality down to referential equality - of attributes is cumbersome, error-prone, and makes - specifications difficult to extend (add for example an attribute - sex to your class, and check in your OCL specification - everywhere that you did it right with your simulation of strong - equality). Therefore, languages like Java offer facilities - to handle two different equalities, and it is problematic even - in an execution oriented specification language to ignore - shallow object equality because it is so common in the code. - \item The fundamental reason goes as follows: whatever you do to - reason consistently over a language, you need the concept of - equality: you need to know what expressions can be replaced by - others because they \emph{mean the same thing.} People call - this also ``Leibniz Equality'' because this philosopher brought - this principle first explicitly to paper and shed some light - over it. It is the theoretic foundation of what you do in an - optimizing compiler: you replace expressions by \emph{equal} - ones, which you hope are easier to evaluate. In a typed - language, strong equality exists uniformly over all types, it is - ``polymorphic'' $\_ = \_ :: \alpha * \alpha \rightarrow - bool$---this is the way that equality is defined in HOL itself. - We can express Leibniz principle as one logical rule of - surprising simplicity and beauty: - \begin{gather} - s = t \Longrightarrow P(s) = P(t) - \end{gather} - ``Whenever we know, that $s$ is equal to $t$, we can replace the - sub-expression $s$ in a term $P$ by $t$ and we have that the - replacement is equal to the original.'' -\end{enumerate} -*} -text{* - While weak referential equality is defined to be strict in the OCL - standard, we will define strong equality as non-strict. It is quite - nasty (but not impossible) to define the logical equality in a - strict way (the substitutivity rule above would look more complex), - however, whenever references were used, strong equality is needed - since references refer to particular states (pre or post), and that - they mean the same thing can therefore not be taken for granted. -*} - -subsubsection{* Definition *} -text{* - The strict equality on basic types (actually on all types) must be - exceptionally defined on @{term "null"}---otherwise the entire - concept of null in the language does not make much sense. This is an - important exception from the general rule that null - arguments---especially if passed as ``self''-argument---lead to - invalid results. -*} - - -text{* - We define strong equality extremely generic, even for types that - contain a @{text "null"} or @{text "\<bottom>"} element. Strong - equality is simply polymorphic in Featherweight OCL, \ie, is - defined identical for all types in OCL and HOL. -*} -definition StrongEq::"['\<AA> st \<Rightarrow> '\<alpha>,'\<AA> st \<Rightarrow> '\<alpha>] \<Rightarrow> ('\<AA>)Boolean" (infixl "\<triangleq>" 30) -where "X \<triangleq> Y \<equiv> \<lambda> \<tau>. \<lfloor>\<lfloor>X \<tau> = Y \<tau> \<rfloor>\<rfloor>" - -text{* - From this follow already elementary properties like: -*} -lemma [simp,code_unfold]: "(true \<triangleq> false) = false" -by(rule ext, auto simp: StrongEq_def) - -lemma [simp,code_unfold]: "(false \<triangleq> true) = false" -by(rule ext, auto simp: StrongEq_def) - -text{* We are also interested in equalities that need only one part of the state transition. *} -definition StrongEq\<^sub>p\<^sub>r\<^sub>e::"['\<AA> st \<Rightarrow> '\<alpha>,'\<AA> st \<Rightarrow> '\<alpha>] \<Rightarrow> ('\<AA>)Boolean" (infixl "\<triangleq>\<^sub>p\<^sub>r\<^sub>e" 30) -where "X \<triangleq>\<^sub>p\<^sub>r\<^sub>e Y \<equiv> \<lambda> (\<sigma>,_). \<lfloor>\<lfloor> \<forall> \<sigma>' \<sigma>''. X (\<sigma>,\<sigma>') = Y (\<sigma>,\<sigma>'') \<rfloor>\<rfloor>" - - -definition StrongEq\<^sub>p\<^sub>o\<^sub>s\<^sub>t::"['\<AA> st \<Rightarrow> '\<alpha>,'\<AA> st \<Rightarrow> '\<alpha>] \<Rightarrow> ('\<AA>)Boolean" (infixl "\<triangleq>\<^sub>p\<^sub>o\<^sub>s\<^sub>t" 30) -where "X \<triangleq>\<^sub>p\<^sub>o\<^sub>s\<^sub>t Y \<equiv> \<lambda> (_,\<sigma>). \<lfloor>\<lfloor> \<forall> \<sigma>' \<sigma>''. X (\<sigma>',\<sigma>) = Y (\<sigma>'',\<sigma>) \<rfloor>\<rfloor>" - - - -subsubsection{* Fundamental Predicates on Strong Equality *} - -text{* Equality reasoning in OCL is not humpty dumpty. While strong equality -is clearly an equivalence: *} -lemma StrongEq_refl [simp]: "(X \<triangleq> X) = true" -by(rule ext, simp add: null_def invalid_def true_def false_def StrongEq_def) - -lemma StrongEq_sym: "(X \<triangleq> Y) = (Y \<triangleq> X)" -by(rule ext, simp add: eq_sym_conv invalid_def true_def false_def StrongEq_def) - -lemma StrongEq_trans_strong [simp]: - assumes A: "(X \<triangleq> Y) = true" - and B: "(Y \<triangleq> Z) = true" - shows "(X \<triangleq> Z) = true" - apply(insert A B) apply(rule ext) - apply(simp add: null_def invalid_def true_def false_def StrongEq_def) - apply(drule_tac x=x in fun_cong)+ - by auto - -text{* - it is only in a limited sense a congruence, at least from the - point of view of this semantic theory. The point is that it is - only a congruence on OCL expressions, not arbitrary HOL - expressions (with which we can mix Featherweight OCL expressions). A - semantic---not syntactic---characterization of OCL expressions is - that they are \emph{context-passing} or \emph{context-invariant}, - \ie, the context of an entire OCL expression, \ie the pre and - post state it referes to, is passed constantly and unmodified to - the sub-expressions, \ie, all sub-expressions inside an OCL - expression refer to the same context. Expressed formally, this - boils down to: -*} -lemma StrongEq_subst : - assumes cp: "\<And>X. P(X)\<tau> = P(\<lambda> _. X \<tau>)\<tau>" - and eq: "(X \<triangleq> Y)\<tau> = true \<tau>" - shows "(P X \<triangleq> P Y)\<tau> = true \<tau>" - apply(insert cp eq) - apply(simp add: null_def invalid_def true_def false_def StrongEq_def) - apply(subst cp[of X]) - apply(subst cp[of Y]) - by simp - -lemma defined7[simp]: "\<delta> (X \<triangleq> Y) = true" - by(rule ext, - auto simp: defined_def true_def false_def StrongEq_def - bot_fun_def bot_option_def null_option_def null_fun_def) - -lemma valid7[simp]: "\<upsilon> (X \<triangleq> Y) = true" - by(rule ext, - auto simp: valid_def true_def false_def StrongEq_def - bot_fun_def bot_option_def null_option_def null_fun_def) - -lemma cp_StrongEq: "(X \<triangleq> Y) \<tau> = ((\<lambda> _. X \<tau>) \<triangleq> (\<lambda> _. Y \<tau>)) \<tau>" -by(simp add: StrongEq_def) - -subsection{* Logical Connectives and their Universal Properties *} -text{* - It is a design goal to give OCL a semantics that is as closely as - possible to a ``logical system'' in a known sense; a specification - logic where the logical connectives can not be understood other that - having the truth-table aside when reading fails its purpose in our - view. - - Practically, this means that we want to give a definition to the - core operations to be as close as possible to the lattice laws; this - makes also powerful symbolic normalization of OCL specifications - possible as a pre-requisite for automated theorem provers. For - example, it is still possible to compute without any definedness - and validity reasoning the DNF of an OCL specification; be it for - test-case generations or for a smooth transition to a two-valued - representation of the specification amenable to fast standard - SMT-solvers, for example. - - Thus, our representation of the OCL is merely a 4-valued - Kleene-Logics with @{term "invalid"} as least, @{term "null"} as - middle and @{term "true"} resp. @{term "false"} as unrelated - top-elements. -*} - - -definition OclNot :: "('\<AA>)Boolean \<Rightarrow> ('\<AA>)Boolean" ("not") -where "not X \<equiv> \<lambda> \<tau> . case X \<tau> of - \<bottom> \<Rightarrow> \<bottom> - | \<lfloor> \<bottom> \<rfloor> \<Rightarrow> \<lfloor> \<bottom> \<rfloor> - | \<lfloor>\<lfloor> x \<rfloor>\<rfloor> \<Rightarrow> \<lfloor>\<lfloor> \<not> x \<rfloor>\<rfloor>" - - - -lemma cp_OclNot: "(not X)\<tau> = (not (\<lambda> _. X \<tau>)) \<tau>" -by(simp add: OclNot_def) - -lemma OclNot1[simp]: "not invalid = invalid" - by(rule ext,simp add: OclNot_def null_def invalid_def true_def false_def bot_option_def) - -lemma OclNot2[simp]: "not null = null" - by(rule ext,simp add: OclNot_def null_def invalid_def true_def false_def - bot_option_def null_fun_def null_option_def ) - -lemma OclNot3[simp]: "not true = false" - by(rule ext,simp add: OclNot_def null_def invalid_def true_def false_def) - -lemma OclNot4[simp]: "not false = true" - by(rule ext,simp add: OclNot_def null_def invalid_def true_def false_def) - - -lemma OclNot_not[simp]: "not (not X) = X" - apply(rule ext,simp add: OclNot_def null_def invalid_def true_def false_def) - apply(case_tac "X x", simp_all) - apply(case_tac "a", simp_all) - done - -lemma OclNot_inject: "\<And> x y. not x = not y \<Longrightarrow> x = y" - by(subst OclNot_not[THEN sym], simp) - -definition OclAnd :: "[('\<AA>)Boolean, ('\<AA>)Boolean] \<Rightarrow> ('\<AA>)Boolean" (infixl "and" 30) -where "X and Y \<equiv> (\<lambda> \<tau> . case X \<tau> of - \<lfloor>\<lfloor>False\<rfloor>\<rfloor> \<Rightarrow> \<lfloor>\<lfloor>False\<rfloor>\<rfloor> - | \<bottom> \<Rightarrow> (case Y \<tau> of - \<lfloor>\<lfloor>False\<rfloor>\<rfloor> \<Rightarrow> \<lfloor>\<lfloor>False\<rfloor>\<rfloor> - | _ \<Rightarrow> \<bottom>) - | \<lfloor>\<bottom>\<rfloor> \<Rightarrow> (case Y \<tau> of - \<lfloor>\<lfloor>False\<rfloor>\<rfloor> \<Rightarrow> \<lfloor>\<lfloor>False\<rfloor>\<rfloor> - | \<bottom> \<Rightarrow> \<bottom> - | _ \<Rightarrow> \<lfloor>\<bottom>\<rfloor>) - | \<lfloor>\<lfloor>True\<rfloor>\<rfloor> \<Rightarrow> Y \<tau>)" - - -text{* - Note that @{term "not"} is \emph{not} defined as a strict function; - proximity to lattice laws implies that we \emph{need} a definition - of @{term "not"} that satisfies @{text "not(not(x))=x"}. -*} - -text{* - In textbook notation, the logical core constructs @{const - "OclNot"} and @{const "OclAnd"} were represented as follows: -*} -lemma textbook_OclNot: - "I\<lbrakk>not(X)\<rbrakk> \<tau> = (case I\<lbrakk>X\<rbrakk> \<tau> of \<bottom> \<Rightarrow> \<bottom> - | \<lfloor> \<bottom> \<rfloor> \<Rightarrow> \<lfloor> \<bottom> \<rfloor> - | \<lfloor>\<lfloor> x \<rfloor>\<rfloor> \<Rightarrow> \<lfloor>\<lfloor> \<not> x \<rfloor>\<rfloor>)" -by(simp add: Sem_def OclNot_def) - -lemma textbook_OclAnd: - "I\<lbrakk>X and Y\<rbrakk> \<tau> = (case I\<lbrakk>X\<rbrakk> \<tau> of - \<bottom> \<Rightarrow> (case I\<lbrakk>Y\<rbrakk> \<tau> of - \<bottom> \<Rightarrow> \<bottom> - | \<lfloor>\<bottom>\<rfloor> \<Rightarrow> \<bottom> - | \<lfloor>\<lfloor>True\<rfloor>\<rfloor> \<Rightarrow> \<bottom> - | \<lfloor>\<lfloor>False\<rfloor>\<rfloor> \<Rightarrow> \<lfloor>\<lfloor>False\<rfloor>\<rfloor>) - | \<lfloor> \<bottom> \<rfloor> \<Rightarrow> (case I\<lbrakk>Y\<rbrakk> \<tau> of - \<bottom> \<Rightarrow> \<bottom> - | \<lfloor>\<bottom>\<rfloor> \<Rightarrow> \<lfloor>\<bottom>\<rfloor> - | \<lfloor>\<lfloor>True\<rfloor>\<rfloor> \<Rightarrow> \<lfloor>\<bottom>\<rfloor> - | \<lfloor>\<lfloor>False\<rfloor>\<rfloor> \<Rightarrow> \<lfloor>\<lfloor>False\<rfloor>\<rfloor>) - | \<lfloor>\<lfloor>True\<rfloor>\<rfloor> \<Rightarrow> (case I\<lbrakk>Y\<rbrakk> \<tau> of - \<bottom> \<Rightarrow> \<bottom> - | \<lfloor>\<bottom>\<rfloor> \<Rightarrow> \<lfloor>\<bottom>\<rfloor> - | \<lfloor>\<lfloor>y\<rfloor>\<rfloor> \<Rightarrow> \<lfloor>\<lfloor>y\<rfloor>\<rfloor>) - | \<lfloor>\<lfloor>False\<rfloor>\<rfloor> \<Rightarrow> \<lfloor>\<lfloor> False \<rfloor>\<rfloor>)" -by(simp add: OclAnd_def Sem_def split: option.split bool.split) - -definition OclOr :: "[('\<AA>)Boolean, ('\<AA>)Boolean] \<Rightarrow> ('\<AA>)Boolean" (infixl "or" 25) -where "X or Y \<equiv> not(not X and not Y)" - -definition OclImplies :: "[('\<AA>)Boolean, ('\<AA>)Boolean] \<Rightarrow> ('\<AA>)Boolean" (infixl "implies" 25) -where "X implies Y \<equiv> not X or Y" - -(* -definition ocl_eq (infixl "equiv" 30) -where "ocl_eq a b = ((a implies b) and (b implies a))" -*) - -lemma cp_OclAnd:"(X and Y) \<tau> = ((\<lambda> _. X \<tau>) and (\<lambda> _. Y \<tau>)) \<tau>" -by(simp add: OclAnd_def) - -lemma cp_OclOr:"((X::('\<AA>)Boolean) or Y) \<tau> = ((\<lambda> _. X \<tau>) or (\<lambda> _. Y \<tau>)) \<tau>" -apply(simp add: OclOr_def) -apply(subst cp_OclNot[of "not (\<lambda>_. X \<tau>) and not (\<lambda>_. Y \<tau>)"]) -apply(subst cp_OclAnd[of "not (\<lambda>_. X \<tau>)" "not (\<lambda>_. Y \<tau>)"]) -by(simp add: cp_OclNot[symmetric] cp_OclAnd[symmetric] ) - - -lemma cp_OclImplies:"(X implies Y) \<tau> = ((\<lambda> _. X \<tau>) implies (\<lambda> _. Y \<tau>)) \<tau>" -apply(simp add: OclImplies_def) -apply(subst cp_OclOr[of "not (\<lambda>_. X \<tau>)" "(\<lambda>_. Y \<tau>)"]) -by(simp add: cp_OclNot[symmetric] cp_OclOr[symmetric] ) - -lemma OclAnd1[simp]: "(invalid and true) = invalid" - by(rule ext,simp add: OclAnd_def null_def invalid_def true_def false_def bot_option_def) -lemma OclAnd2[simp]: "(invalid and false) = false" - by(rule ext,simp add: OclAnd_def null_def invalid_def true_def false_def bot_option_def) -lemma OclAnd3[simp]: "(invalid and null) = invalid" - by(rule ext,simp add: OclAnd_def null_def invalid_def true_def false_def bot_option_def - null_fun_def null_option_def) -lemma OclAnd4[simp]: "(invalid and invalid) = invalid" - by(rule ext,simp add: OclAnd_def null_def invalid_def true_def false_def bot_option_def) - -lemma OclAnd5[simp]: "(null and true) = null" - by(rule ext,simp add: OclAnd_def null_def invalid_def true_def false_def bot_option_def - null_fun_def null_option_def) -lemma OclAnd6[simp]: "(null and false) = false" - by(rule ext,simp add: OclAnd_def null_def invalid_def true_def false_def bot_option_def - null_fun_def null_option_def) -lemma OclAnd7[simp]: "(null and null) = null" - by(rule ext,simp add: OclAnd_def null_def invalid_def true_def false_def bot_option_def - null_fun_def null_option_def) -lemma OclAnd8[simp]: "(null and invalid) = invalid" - by(rule ext,simp add: OclAnd_def null_def invalid_def true_def false_def bot_option_def - null_fun_def null_option_def) - -lemma OclAnd9[simp]: "(false and true) = false" - by(rule ext,simp add: OclAnd_def null_def invalid_def true_def false_def) -lemma OclAnd10[simp]: "(false and false) = false" - by(rule ext,simp add: OclAnd_def null_def invalid_def true_def false_def) -lemma OclAnd11[simp]: "(false and null) = false" - by(rule ext,simp add: OclAnd_def null_def invalid_def true_def false_def) -lemma OclAnd12[simp]: "(false and invalid) = false" - by(rule ext,simp add: OclAnd_def null_def invalid_def true_def false_def) - -lemma OclAnd13[simp]: "(true and true) = true" - by(rule ext,simp add: OclAnd_def null_def invalid_def true_def false_def) -lemma OclAnd14[simp]: "(true and false) = false" - by(rule ext,simp add: OclAnd_def null_def invalid_def true_def false_def) -lemma OclAnd15[simp]: "(true and null) = null" - by(rule ext,simp add: OclAnd_def null_def invalid_def true_def false_def bot_option_def - null_fun_def null_option_def) -lemma OclAnd16[simp]: "(true and invalid) = invalid" - by(rule ext,simp add: OclAnd_def null_def invalid_def true_def false_def bot_option_def - null_fun_def null_option_def) - -lemma OclAnd_idem[simp]: "(X and X) = X" - apply(rule ext,simp add: OclAnd_def null_def invalid_def true_def false_def) - apply(case_tac "X x", simp_all) - apply(case_tac "a", simp_all) - apply(case_tac "aa", simp_all) - done - -lemma OclAnd_commute: "(X and Y) = (Y and X)" - by(rule ext,auto simp:true_def false_def OclAnd_def invalid_def - split: option.split option.split_asm - bool.split bool.split_asm) - - -lemma OclAnd_false1[simp]: "(false and X) = false" - apply(rule ext, simp add: OclAnd_def) - apply(auto simp:true_def false_def invalid_def - split: option.split option.split_asm) - done - -lemma OclAnd_false2[simp]: "(X and false) = false" - by(simp add: OclAnd_commute) - - -lemma OclAnd_true1[simp]: "(true and X) = X" - apply(rule ext, simp add: OclAnd_def) - apply(auto simp:true_def false_def invalid_def - split: option.split option.split_asm) - done - -lemma OclAnd_true2[simp]: "(X and true) = X" - by(simp add: OclAnd_commute) - -lemma OclAnd_bot1[simp]: "\<And>\<tau>. X \<tau> \<noteq> false \<tau> \<Longrightarrow> (bot and X) \<tau> = bot \<tau>" - apply(simp add: OclAnd_def) - apply(auto simp:true_def false_def bot_fun_def bot_option_def - split: option.split option.split_asm) -done - -lemma OclAnd_bot2[simp]: "\<And>\<tau>. X \<tau> \<noteq> false \<tau> \<Longrightarrow> (X and bot) \<tau> = bot \<tau>" - by(simp add: OclAnd_commute) - -lemma OclAnd_null1[simp]: "\<And>\<tau>. X \<tau> \<noteq> false \<tau> \<Longrightarrow> X \<tau> \<noteq> bot \<tau> \<Longrightarrow> (null and X) \<tau> = null \<tau>" - apply(simp add: OclAnd_def) - apply(auto simp:true_def false_def bot_fun_def bot_option_def null_fun_def null_option_def - split: option.split option.split_asm) -done - -lemma OclAnd_null2[simp]: "\<And>\<tau>. X \<tau> \<noteq> false \<tau> \<Longrightarrow> X \<tau> \<noteq> bot \<tau> \<Longrightarrow> (X and null) \<tau> = null \<tau>" - by(simp add: OclAnd_commute) - -lemma OclAnd_assoc: "(X and (Y and Z)) = (X and Y and Z)" - apply(rule ext, simp add: OclAnd_def) - apply(auto simp:true_def false_def null_def invalid_def - split: option.split option.split_asm - bool.split bool.split_asm) -done - - -lemma OclOr1[simp]: "(invalid or true) = true" -by(rule ext, simp add: OclOr_def OclNot_def OclAnd_def null_def invalid_def true_def false_def - bot_option_def) -lemma OclOr2[simp]: "(invalid or false) = invalid" -by(rule ext, simp add: OclOr_def OclNot_def OclAnd_def null_def invalid_def true_def false_def - bot_option_def) -lemma OclOr3[simp]: "(invalid or null) = invalid" -by(rule ext, simp add: OclOr_def OclNot_def OclAnd_def null_def invalid_def true_def false_def - bot_option_def null_fun_def null_option_def) -lemma OclOr4[simp]: "(invalid or invalid) = invalid" -by(rule ext, simp add: OclOr_def OclNot_def OclAnd_def null_def invalid_def true_def false_def - bot_option_def) - -lemma OclOr5[simp]: "(null or true) = true" -by(rule ext, simp add: OclOr_def OclNot_def OclAnd_def null_def invalid_def true_def false_def - bot_option_def null_fun_def null_option_def) -lemma OclOr6[simp]: "(null or false) = null" -by(rule ext, simp add: OclOr_def OclNot_def OclAnd_def null_def invalid_def true_def false_def - bot_option_def null_fun_def null_option_def) -lemma OclOr7[simp]: "(null or null) = null" -by(rule ext, simp add: OclOr_def OclNot_def OclAnd_def null_def invalid_def true_def false_def - bot_option_def null_fun_def null_option_def) -lemma OclOr8[simp]: "(null or invalid) = invalid" -by(rule ext, simp add: OclOr_def OclNot_def OclAnd_def null_def invalid_def true_def false_def - bot_option_def null_fun_def null_option_def) - -lemma OclOr_idem[simp]: "(X or X) = X" - by(simp add: OclOr_def) - -lemma OclOr_commute: "(X or Y) = (Y or X)" - by(simp add: OclOr_def OclAnd_commute) - -lemma OclOr_false1[simp]: "(false or Y) = Y" - by(simp add: OclOr_def) - -lemma OclOr_false2[simp]: "(Y or false) = Y" - by(simp add: OclOr_def) - -lemma OclOr_true1[simp]: "(true or Y) = true" - by(simp add: OclOr_def) - -lemma OclOr_true2: "(Y or true) = true" - by(simp add: OclOr_def) - -lemma OclOr_bot1[simp]: "\<And>\<tau>. X \<tau> \<noteq> true \<tau> \<Longrightarrow> (bot or X) \<tau> = bot \<tau>" - apply(simp add: OclOr_def OclAnd_def OclNot_def) - apply(auto simp:true_def false_def bot_fun_def bot_option_def - split: option.split option.split_asm) -done - -lemma OclOr_bot2[simp]: "\<And>\<tau>. X \<tau> \<noteq> true \<tau> \<Longrightarrow> (X or bot) \<tau> = bot \<tau>" - by(simp add: OclOr_commute) - -lemma OclOr_null1[simp]: "\<And>\<tau>. X \<tau> \<noteq> true \<tau> \<Longrightarrow> X \<tau> \<noteq> bot \<tau> \<Longrightarrow> (null or X) \<tau> = null \<tau>" - apply(simp add: OclOr_def OclAnd_def OclNot_def) - apply(auto simp:true_def false_def bot_fun_def bot_option_def null_fun_def null_option_def - split: option.split option.split_asm) - apply (metis (full_types) bool.simps(3) bot_option_def null_is_valid null_option_def) -by (metis (full_types) bool.simps(3) option.distinct(1) option.sel) - -lemma OclOr_null2[simp]: "\<And>\<tau>. X \<tau> \<noteq> true \<tau> \<Longrightarrow> X \<tau> \<noteq> bot \<tau> \<Longrightarrow> (X or null) \<tau> = null \<tau>" - by(simp add: OclOr_commute) - -lemma OclOr_assoc: "(X or (Y or Z)) = (X or Y or Z)" - by(simp add: OclOr_def OclAnd_assoc) - -lemma deMorgan1: "not(X and Y) = ((not X) or (not Y))" - by(simp add: OclOr_def) - -lemma deMorgan2: "not(X or Y) = ((not X) and (not Y))" - by(simp add: OclOr_def) - -lemma OclImplies_true1[simp]:"(true implies X) = X" - by(simp add: OclImplies_def) - -lemma OclImplies_true2[simp]: "(X implies true) = true" - by(simp add: OclImplies_def OclOr_true2) - -lemma OclImplies_false1[simp]:"(false implies X) = true" - by(simp add: OclImplies_def) - -subsection{* A Standard Logical Calculus for OCL *} -(* Besides the need for algebraic laws for OCL in order to normalize *) -definition OclValid :: "[('\<AA>)st, ('\<AA>)Boolean] \<Rightarrow> bool" ("(1(_)/ \<Turnstile> (_))" 50) -where "\<tau> \<Turnstile> P \<equiv> ((P \<tau>) = true \<tau>)" - -syntax "_OclNonValid" :: "[('\<AA>)st, ('\<AA>)Boolean] \<Rightarrow> bool" ("(1(_)/ |\<noteq> (_))" 50) - -translations "\<tau> |\<noteq> P" == "\<not>(\<tau> \<Turnstile> P)" - -definition OclValid_at_pre :: "[('\<AA>)state, ('\<AA>)Boolean] \<Rightarrow> bool" ("(1(_)/ \<Turnstile>\<^sub>p\<^sub>r\<^sub>e (_))" 50) -where "\<sigma> \<Turnstile>\<^sub>p\<^sub>r\<^sub>e P \<equiv> (\<forall>\<sigma>\<^sub>p\<^sub>o\<^sub>s\<^sub>t. (\<sigma>, \<sigma>\<^sub>p\<^sub>o\<^sub>s\<^sub>t) \<Turnstile> P)" - -definition OclValid_at_post :: "[('\<AA>)state, ('\<AA>)Boolean] \<Rightarrow> bool" ("(1(_)/ \<Turnstile>\<^sub>p\<^sub>o\<^sub>s\<^sub>t (_))" 50) -where "\<sigma> \<Turnstile>\<^sub>p\<^sub>o\<^sub>s\<^sub>t P \<equiv> (\<forall>\<sigma>\<^sub>p\<^sub>r\<^sub>e. (\<sigma>\<^sub>p\<^sub>r\<^sub>e, \<sigma>) \<Turnstile> P)" - -subsubsection{* Global vs. Local Judgements*} -lemma transform1: "P = true \<Longrightarrow> \<tau> \<Turnstile> P" -by(simp add: OclValid_def) - - -lemma transform1_rev: "\<forall> \<tau>. \<tau> \<Turnstile> P \<Longrightarrow> P = true" -by(rule ext, auto simp: OclValid_def true_def) - -lemma transform2: "(P = Q) \<Longrightarrow> ((\<tau> \<Turnstile> P) = (\<tau> \<Turnstile> Q))" -by(auto simp: OclValid_def) - -lemma transform2_rev: "\<forall> \<tau>. (\<tau> \<Turnstile> \<delta> P) \<and> (\<tau> \<Turnstile> \<delta> Q) \<and> (\<tau> \<Turnstile> P) = (\<tau> \<Turnstile> Q) \<Longrightarrow> P = Q" -apply(rule ext,auto simp: OclValid_def true_def defined_def) -apply(erule_tac x=a in allE) -apply(erule_tac x=b in allE) -apply(auto simp: false_def true_def defined_def bot_Boolean_def null_Boolean_def - split: option.split_asm HOL.if_split_asm) -done -(* Something stronger is possible here (consider P null, Q invalid), - but this thingi should do for our purpose *) - -text{* However, certain properties (like transitivity) can not - be \emph{transformed} from the global level to the local one, - they have to be re-proven on the local level. *} - -lemma (*transform3:*) -assumes H : "P = true \<Longrightarrow> Q = true" -shows "\<tau> \<Turnstile> P \<Longrightarrow> \<tau> \<Turnstile> Q" -apply(simp add: OclValid_def) -apply(rule H[THEN fun_cong]) -apply(rule ext) -oops - -subsubsection{* Local Validity and Meta-logic*} -text{* \label{sec:localVal} *} - -lemma foundation1[simp]: "\<tau> \<Turnstile> true" -by(auto simp: OclValid_def) - -lemma foundation2[simp]: "\<not>(\<tau> \<Turnstile> false)" -by(auto simp: OclValid_def true_def false_def) - -lemma foundation3[simp]: "\<not>(\<tau> \<Turnstile> invalid)" -by(auto simp: OclValid_def true_def false_def invalid_def bot_option_def) - -lemma foundation4[simp]: "\<not>(\<tau> \<Turnstile> null)" -by(auto simp: OclValid_def true_def false_def null_def null_fun_def null_option_def bot_option_def) - -lemma bool_split[simp]: -"(\<tau> \<Turnstile> (x \<triangleq> invalid)) \<or> (\<tau> \<Turnstile> (x \<triangleq> null)) \<or> (\<tau> \<Turnstile> (x \<triangleq> true)) \<or> (\<tau> \<Turnstile> (x \<triangleq> false))" -apply(insert bool_split_0[of x \<tau>], auto) -apply(simp_all add: OclValid_def StrongEq_def true_def null_def invalid_def) -done - -lemma defined_split: -"(\<tau> \<Turnstile> \<delta> x) = ((\<not>(\<tau> \<Turnstile> (x \<triangleq> invalid))) \<and> (\<not> (\<tau> \<Turnstile> (x \<triangleq> null))))" -by(simp add:defined_def true_def false_def invalid_def null_def - StrongEq_def OclValid_def bot_fun_def null_fun_def) - -lemma valid_bool_split: "(\<tau> \<Turnstile> \<upsilon> A) = ((\<tau> \<Turnstile> A \<triangleq> null) \<or> (\<tau> \<Turnstile> A) \<or> (\<tau> \<Turnstile> not A)) " -by(auto simp:valid_def true_def false_def invalid_def null_def OclNot_def - StrongEq_def OclValid_def bot_fun_def bot_option_def null_option_def null_fun_def) - -lemma defined_bool_split: "(\<tau> \<Turnstile> \<delta> A) = ((\<tau> \<Turnstile> A) \<or> (\<tau> \<Turnstile> not A))" -by(auto simp:defined_def true_def false_def invalid_def null_def OclNot_def - StrongEq_def OclValid_def bot_fun_def bot_option_def null_option_def null_fun_def) - - - -lemma foundation5: -"\<tau> \<Turnstile> (P and Q) \<Longrightarrow> (\<tau> \<Turnstile> P) \<and> (\<tau> \<Turnstile> Q)" -by(simp add: OclAnd_def OclValid_def true_def false_def defined_def - split: option.split option.split_asm bool.split bool.split_asm) - -lemma foundation6: -"\<tau> \<Turnstile> P \<Longrightarrow> \<tau> \<Turnstile> \<delta> P" -by(simp add: OclNot_def OclValid_def true_def false_def defined_def - null_option_def null_fun_def bot_option_def bot_fun_def - split: option.split option.split_asm) - - -lemma foundation7[simp]: -"(\<tau> \<Turnstile> not (\<delta> x)) = (\<not> (\<tau> \<Turnstile> \<delta> x))" -by(simp add: OclNot_def OclValid_def true_def false_def defined_def - split: option.split option.split_asm) - -lemma foundation7'[simp]: -"(\<tau> \<Turnstile> not (\<upsilon> x)) = (\<not> (\<tau> \<Turnstile> \<upsilon> x))" -by(simp add: OclNot_def OclValid_def true_def false_def valid_def - split: option.split option.split_asm) - - -text{* - Key theorem for the $\delta$-closure: either an expression is - defined, or it can be replaced (substituted via @{text "StrongEq_L_subst2"}; - see below) by @{text invalid} or @{text null}. Strictness-reduction rules will - usually reduce these substituted terms drastically. -*} - - -lemma foundation8: -"(\<tau> \<Turnstile> \<delta> x) \<or> (\<tau> \<Turnstile> (x \<triangleq> invalid)) \<or> (\<tau> \<Turnstile> (x \<triangleq> null))" -proof - - have 1 : "(\<tau> \<Turnstile> \<delta> x) \<or> (\<not>(\<tau> \<Turnstile> \<delta> x))" by auto - have 2 : "(\<not>(\<tau> \<Turnstile> \<delta> x)) = ((\<tau> \<Turnstile> (x \<triangleq> invalid)) \<or> (\<tau> \<Turnstile> (x \<triangleq> null)))" - by(simp only: defined_split, simp) - show ?thesis by(insert 1, simp add:2) -qed - - -lemma foundation9: -"\<tau> \<Turnstile> \<delta> x \<Longrightarrow> (\<tau> \<Turnstile> not x) = (\<not> (\<tau> \<Turnstile> x))" -apply(simp add: defined_split ) -by(auto simp: OclNot_def null_fun_def null_option_def bot_option_def - OclValid_def invalid_def true_def null_def StrongEq_def) - -lemma foundation9': -"\<tau> \<Turnstile> not x \<Longrightarrow> \<not> (\<tau> \<Turnstile> x)" -by(auto simp: foundation6 foundation9) - -lemma foundation9'': -" \<tau> \<Turnstile> not x \<Longrightarrow> \<tau> \<Turnstile> \<delta> x" -by(metis OclNot3 OclNot_not OclValid_def cp_OclNot cp_defined defined4) - -lemma foundation10: -"\<tau> \<Turnstile> \<delta> x \<Longrightarrow> \<tau> \<Turnstile> \<delta> y \<Longrightarrow> (\<tau> \<Turnstile> (x and y)) = ( (\<tau> \<Turnstile> x) \<and> (\<tau> \<Turnstile> y))" -apply(simp add: defined_split) -by(auto simp: OclAnd_def OclValid_def invalid_def - true_def null_def StrongEq_def null_fun_def null_option_def bot_option_def - split:bool.split_asm) - -lemma foundation10': "(\<tau> \<Turnstile> (A and B)) = ((\<tau> \<Turnstile> A) \<and> (\<tau> \<Turnstile> B))" (* stronger than foundation !*) -by(auto dest:foundation5 simp:foundation6 foundation10) - -lemma foundation11: -"\<tau> \<Turnstile> \<delta> x \<Longrightarrow> \<tau> \<Turnstile> \<delta> y \<Longrightarrow> (\<tau> \<Turnstile> (x or y)) = ( (\<tau> \<Turnstile> x) \<or> (\<tau> \<Turnstile> y))" -apply(simp add: defined_split) -by(auto simp: OclNot_def OclOr_def OclAnd_def OclValid_def invalid_def - true_def null_def StrongEq_def null_fun_def null_option_def bot_option_def - split:bool.split_asm bool.split) - - - -lemma foundation12: -"\<tau> \<Turnstile> \<delta> x \<Longrightarrow> (\<tau> \<Turnstile> (x implies y)) = ( (\<tau> \<Turnstile> x) \<longrightarrow> (\<tau> \<Turnstile> y))" -apply(simp add: defined_split) -by(auto simp: OclNot_def OclOr_def OclAnd_def OclImplies_def bot_option_def - OclValid_def invalid_def true_def null_def StrongEq_def null_fun_def null_option_def - split:bool.split_asm bool.split option.split_asm) - -lemma foundation13:"(\<tau> \<Turnstile> A \<triangleq> true) = (\<tau> \<Turnstile> A)" -by(auto simp: OclNot_def OclValid_def invalid_def true_def null_def StrongEq_def - split:bool.split_asm bool.split) - -lemma foundation14:"(\<tau> \<Turnstile> A \<triangleq> false) = (\<tau> \<Turnstile> not A)" -by(auto simp: OclNot_def OclValid_def invalid_def false_def true_def null_def StrongEq_def - split:bool.split_asm bool.split option.split) - -lemma foundation15:"(\<tau> \<Turnstile> A \<triangleq> invalid) = (\<tau> \<Turnstile> not(\<upsilon> A))" -by(auto simp: OclNot_def OclValid_def valid_def invalid_def false_def true_def null_def - StrongEq_def null_fun_def null_option_def bot_option_def bot_fun_def - split:bool.split_asm bool.split option.split) - -lemma foundation15':"(\<tau> \<Turnstile> A \<triangleq> null) = (\<tau> \<Turnstile> (\<upsilon> A) and not (\<delta> A))" -by(auto simp: OclAnd_def OclNot_def OclValid_def valid_def defined_def false_def true_def - StrongEq_def bot_option_def null_fun_def bot_fun_def - null_is_valid - split:bool.split_asm bool.split option.split) - -(* ... and the usual rules on strictness, definedness propoagation, and cp ... *) -lemma foundation16: "\<tau> \<Turnstile> (\<delta> X) = (X \<tau> \<noteq> bot \<and> X \<tau> \<noteq> null)" -by(auto simp: OclValid_def defined_def false_def true_def bot_fun_def null_fun_def - split:if_split_asm) - -lemma foundation16'': "\<not>(\<tau> \<Turnstile> (\<delta> X)) = ((\<tau> \<Turnstile> (X \<triangleq> invalid)) \<or> (\<tau> \<Turnstile> (X \<triangleq> null)))" -apply(simp add: foundation16) -by(auto simp:defined_def false_def true_def bot_fun_def null_fun_def OclValid_def StrongEq_def invalid_def) - -(* correcter rule; the previous is deprecated *) -lemma foundation16': "(\<tau> \<Turnstile> (\<delta> X)) = (X \<tau> \<noteq> invalid \<tau> \<and> X \<tau> \<noteq> null \<tau>)" -apply(simp add:invalid_def null_def null_fun_def) -by(auto simp: OclValid_def defined_def false_def true_def bot_fun_def null_fun_def - split:if_split_asm) - - - -lemma foundation18: "(\<tau> \<Turnstile> (\<upsilon> X)) = (X \<tau> \<noteq> invalid \<tau>)" -by(auto simp: OclValid_def valid_def false_def true_def bot_fun_def invalid_def - split:if_split_asm) - -(*legacy*) -lemma foundation18': "(\<tau> \<Turnstile> (\<upsilon> X)) = (X \<tau> \<noteq> bot)" -by(auto simp: OclValid_def valid_def false_def true_def bot_fun_def - split:if_split_asm) - -lemma foundation18'': "(\<tau> \<Turnstile> (\<upsilon> X) )= (\<not>(\<tau> \<Turnstile> (X \<triangleq> invalid)))" (* TODO: This should be 18 !*) -by(auto simp:foundation15) - - -lemma foundation20 : "\<tau> \<Turnstile> (\<delta> X) \<Longrightarrow> \<tau> \<Turnstile> \<upsilon> X" -by(simp add: foundation18 foundation16 invalid_def) - -lemma foundation21: "(not A \<triangleq> not B) = (A \<triangleq> B)" -by(rule ext, auto simp: OclNot_def StrongEq_def - split: bool.split_asm HOL.if_split_asm option.split) - -lemma foundation22: "(\<tau> \<Turnstile> (X \<triangleq> Y)) = (X \<tau> = Y \<tau>)" -by(auto simp: StrongEq_def OclValid_def true_def) - -lemma foundation23: "(\<tau> \<Turnstile> P) = (\<tau> \<Turnstile> (\<lambda> _ . P \<tau>))" -by(auto simp: OclValid_def true_def) - - - -lemma foundation24:"(\<tau> \<Turnstile> not(X \<triangleq> Y)) = (X \<tau> \<noteq> Y \<tau>)" -by(simp add: StrongEq_def OclValid_def OclNot_def true_def) - -lemma foundation25: "\<tau> \<Turnstile> P \<Longrightarrow> \<tau> \<Turnstile> (P or Q)" -by(simp add: OclOr_def OclNot_def OclAnd_def OclValid_def true_def) - -lemma foundation25': "\<tau> \<Turnstile> Q \<Longrightarrow> \<tau> \<Turnstile> (P or Q)" -by(subst OclOr_commute, simp add: foundation25) - - -lemma foundation26: -assumes defP: "\<tau> \<Turnstile> \<delta> P" -assumes defQ: "\<tau> \<Turnstile> \<delta> Q" -assumes H: "\<tau> \<Turnstile> (P or Q)" -assumes P: "\<tau> \<Turnstile> P \<Longrightarrow> R" -assumes Q: "\<tau> \<Turnstile> Q \<Longrightarrow> R" -shows "R" -by(insert H, subst (asm) foundation11[OF defP defQ], erule disjE, simp_all add: P Q) - -lemma foundation27: "\<tau> \<Turnstile> A \<Longrightarrow> (\<tau> \<Turnstile> A implies B) = (\<tau> \<Turnstile> B)" -by (simp add: foundation12 foundation6) - -lemma foundation28:"(X=Y) = (\<forall>\<tau>. \<tau> \<Turnstile> X \<triangleq> Y)" -apply(auto) -apply(rule ext, auto) -apply(erule_tac x=a in allE) -apply(erule_tac x=b in allE) -using foundation22 by blast - - -lemma defined_not_I : "\<tau> \<Turnstile> \<delta> (x) \<Longrightarrow> \<tau> \<Turnstile> \<delta> (not x)" - by(auto simp: OclNot_def null_def invalid_def defined_def valid_def OclValid_def - true_def false_def bot_option_def null_option_def null_fun_def bot_fun_def - split: option.split_asm HOL.if_split_asm) - -lemma valid_not_I : "\<tau> \<Turnstile> \<upsilon> (x) \<Longrightarrow> \<tau> \<Turnstile> \<upsilon> (not x)" - by(auto simp: OclNot_def null_def invalid_def defined_def valid_def OclValid_def - true_def false_def bot_option_def null_option_def null_fun_def bot_fun_def - split: option.split_asm option.split HOL.if_split_asm) - -lemma defined_and_I : "\<tau> \<Turnstile> \<delta> (x) \<Longrightarrow> \<tau> \<Turnstile> \<delta> (y) \<Longrightarrow> \<tau> \<Turnstile> \<delta> (x and y)" - apply(simp add: OclAnd_def null_def invalid_def defined_def valid_def OclValid_def - true_def false_def bot_option_def null_option_def null_fun_def bot_fun_def - split: option.split_asm HOL.if_split_asm) - apply(auto simp: null_option_def split: bool.split) - by(case_tac "ya",simp_all) - -lemma valid_and_I : "\<tau> \<Turnstile> \<upsilon> (x) \<Longrightarrow> \<tau> \<Turnstile> \<upsilon> (y) \<Longrightarrow> \<tau> \<Turnstile> \<upsilon> (x and y)" - apply(simp add: OclAnd_def null_def invalid_def defined_def valid_def OclValid_def - true_def false_def bot_option_def null_option_def null_fun_def bot_fun_def - split: option.split_asm HOL.if_split_asm) - by(auto simp: null_option_def split: option.split bool.split) - -lemma defined_or_I : "\<tau> \<Turnstile> \<delta> (x) \<Longrightarrow> \<tau> \<Turnstile> \<delta> (y) \<Longrightarrow> \<tau> \<Turnstile> \<delta> (x or y)" -by(simp add: OclOr_def defined_and_I defined_not_I) - -lemma valid_or_I : "\<tau> \<Turnstile> \<upsilon> (x) \<Longrightarrow> \<tau> \<Turnstile> \<upsilon> (y) \<Longrightarrow> \<tau> \<Turnstile> \<upsilon> (x or y)" -by(simp add: OclOr_def valid_and_I valid_not_I) - -subsubsection{* Local Judgements and Strong Equality *} - -lemma StrongEq_L_refl: "\<tau> \<Turnstile> (x \<triangleq> x)" -by(simp add: OclValid_def StrongEq_def) - - -lemma StrongEq_L_sym: "\<tau> \<Turnstile> (x \<triangleq> y) \<Longrightarrow> \<tau> \<Turnstile> (y \<triangleq> x)" -by(simp add: StrongEq_sym) - -lemma StrongEq_L_trans: "\<tau> \<Turnstile> (x \<triangleq> y) \<Longrightarrow> \<tau> \<Turnstile> (y \<triangleq> z) \<Longrightarrow> \<tau> \<Turnstile> (x \<triangleq> z)" -by(simp add: OclValid_def StrongEq_def true_def) - -lemma StrongEq_L_trans_not: "\<tau> \<Turnstile> (x \<triangleq> y) \<Longrightarrow> \<tau> \<Turnstile> not (y \<triangleq> z) \<Longrightarrow> \<tau> \<Turnstile> not (x \<triangleq> z)" -by(simp add: OclValid_def StrongEq_def true_def OclNot_def) - - -text{* In order to establish substitutivity (which does not -hold in general HOL formulas) we introduce the following -predicate that allows for a calculus of the necessary side-conditions.*} -definition cp :: "(('\<AA>,'\<alpha>) val \<Rightarrow> ('\<AA>,'\<beta>) val) \<Rightarrow> bool" -where "cp P \<equiv> (\<exists> f. \<forall> X \<tau>. P X \<tau> = f (X \<tau>) \<tau>)" - - -text{* The rule of substitutivity in Featherweight OCL holds only -for context-passing expressions, \ie those that pass -the context @{text "\<tau>"} without changing it. Fortunately, all -operators of the OCL language satisfy this property -(but not all HOL operators).*} - -lemma StrongEq_L_subst1: "\<And> \<tau>. cp P \<Longrightarrow> \<tau> \<Turnstile> (x \<triangleq> y) \<Longrightarrow> \<tau> \<Turnstile> (P x \<triangleq> P y)" -by(auto simp: OclValid_def StrongEq_def true_def cp_def) - -lemma StrongEq_L_subst2: -"\<And> \<tau>. cp P \<Longrightarrow> \<tau> \<Turnstile> (x \<triangleq> y) \<Longrightarrow> \<tau> \<Turnstile> (P x) \<Longrightarrow> \<tau> \<Turnstile> (P y)" -by(auto simp: OclValid_def StrongEq_def true_def cp_def) - -lemma StrongEq_L_subst2_rev: "\<tau> \<Turnstile> y \<triangleq> x \<Longrightarrow> cp P \<Longrightarrow> \<tau> \<Turnstile> P x \<Longrightarrow> \<tau> \<Turnstile> P y" -apply(erule StrongEq_L_subst2) -apply(erule StrongEq_L_sym) -by assumption - -lemma StrongEq_L_subst3: -assumes cp: "cp P" -and eq: "\<tau> \<Turnstile> (x \<triangleq> y)" -shows "(\<tau> \<Turnstile> P x) = (\<tau> \<Turnstile> P y)" -apply(rule iffI) -apply(rule StrongEq_L_subst2[OF cp,OF eq],simp) -apply(rule StrongEq_L_subst2[OF cp,OF eq[THEN StrongEq_L_sym]],simp) -done - -lemma StrongEq_L_subst3_rev: -assumes eq: "\<tau> \<Turnstile> (x \<triangleq> y)" -and cp: "cp P" -shows "(\<tau> \<Turnstile> P x) = (\<tau> \<Turnstile> P y)" -by(insert cp, erule StrongEq_L_subst3, rule eq) - -lemma StrongEq_L_subst4_rev: -assumes eq: "\<tau> \<Turnstile> (x \<triangleq> y)" -and cp: "cp P" -shows "(\<not>(\<tau> \<Turnstile> P x)) = (\<not>(\<tau> \<Turnstile> P y))" -thm arg_cong[of _ _ "Not"] -apply(rule arg_cong[of _ _ "Not"]) -by(insert cp, erule StrongEq_L_subst3, rule eq) - -lemma cpI1: -"(\<forall> X \<tau>. f X \<tau> = f(\<lambda>_. X \<tau>) \<tau>) \<Longrightarrow> cp P \<Longrightarrow> cp(\<lambda>X. f (P X))" -apply(auto simp: true_def cp_def) -apply(rule exI, (rule allI)+) -by(erule_tac x="P X" in allE, auto) - -lemma cpI2: -"(\<forall> X Y \<tau>. f X Y \<tau> = f(\<lambda>_. X \<tau>)(\<lambda>_. Y \<tau>) \<tau>) \<Longrightarrow> - cp P \<Longrightarrow> cp Q \<Longrightarrow> cp(\<lambda>X. f (P X) (Q X))" -apply(auto simp: true_def cp_def) -apply(rule exI, (rule allI)+) -by(erule_tac x="P X" in allE, auto) - -lemma cpI3: -"(\<forall> X Y Z \<tau>. f X Y Z \<tau> = f(\<lambda>_. X \<tau>)(\<lambda>_. Y \<tau>)(\<lambda>_. Z \<tau>) \<tau>) \<Longrightarrow> - cp P \<Longrightarrow> cp Q \<Longrightarrow> cp R \<Longrightarrow> cp(\<lambda>X. f (P X) (Q X) (R X))" -apply(auto simp: cp_def) -apply(rule exI, (rule allI)+) -by(erule_tac x="P X" in allE, auto) - -lemma cpI4: -"(\<forall> W X Y Z \<tau>. f W X Y Z \<tau> = f(\<lambda>_. W \<tau>)(\<lambda>_. X \<tau>)(\<lambda>_. Y \<tau>)(\<lambda>_. Z \<tau>) \<tau>) \<Longrightarrow> - cp P \<Longrightarrow> cp Q \<Longrightarrow> cp R \<Longrightarrow> cp S \<Longrightarrow> cp(\<lambda>X. f (P X) (Q X) (R X) (S X))" -apply(auto simp: cp_def) -apply(rule exI, (rule allI)+) -by(erule_tac x="P X" in allE, auto) - -lemma cpI5: -"(\<forall> V W X Y Z \<tau>. f V W X Y Z \<tau> = f(\<lambda>_. V \<tau>) (\<lambda>_. W \<tau>)(\<lambda>_. X \<tau>)(\<lambda>_. Y \<tau>)(\<lambda>_. Z \<tau>) \<tau>) \<Longrightarrow> - cp N \<Longrightarrow> cp P \<Longrightarrow> cp Q \<Longrightarrow> cp R \<Longrightarrow> cp S \<Longrightarrow> cp(\<lambda>X. f (N X) (P X) (Q X) (R X) (S X))" -apply(auto simp: cp_def) -apply(rule exI, (rule allI)+) -by(erule_tac x="N X" in allE, auto) - - -lemma cp_const : "cp(\<lambda>_. c)" - by (simp add: cp_def, fast) - -lemma cp_id : "cp(\<lambda>X. X)" - by (simp add: cp_def, fast) - -text_raw{* \isatagafp *} - -lemmas cp_intro[intro!,simp,code_unfold] = - cp_const - cp_id - cp_defined[THEN allI[THEN allI[THEN cpI1], of defined]] - cp_valid[THEN allI[THEN allI[THEN cpI1], of valid]] - cp_OclNot[THEN allI[THEN allI[THEN cpI1], of not]] - cp_OclAnd[THEN allI[THEN allI[THEN allI[THEN cpI2]], of "(and)"]] - cp_OclOr[THEN allI[THEN allI[THEN allI[THEN cpI2]], of "(or)"]] - cp_OclImplies[THEN allI[THEN allI[THEN allI[THEN cpI2]], of "(implies)"]] - cp_StrongEq[THEN allI[THEN allI[THEN allI[THEN cpI2]], - of "StrongEq"]] - -text_raw{* \endisatagafp *} - - -subsubsection{* Local Judgements and Strong Equality (at pre) *} - -lemma StrongEq_L_sym\<^sub>p\<^sub>r\<^sub>e: "\<sigma>\<^sub>p\<^sub>r\<^sub>e \<Turnstile>\<^sub>p\<^sub>r\<^sub>e (x \<triangleq> y) \<Longrightarrow> \<sigma>\<^sub>p\<^sub>r\<^sub>e \<Turnstile>\<^sub>p\<^sub>r\<^sub>e (y \<triangleq> x)" -by(simp add: StrongEq_sym) - -lemma StrongEq_L_subst2\<^sub>p\<^sub>r\<^sub>e:"cp P \<Longrightarrow> \<sigma>\<^sub>p\<^sub>r\<^sub>e \<Turnstile>\<^sub>p\<^sub>r\<^sub>e (x \<triangleq> y) \<Longrightarrow> \<sigma>\<^sub>p\<^sub>r\<^sub>e \<Turnstile>\<^sub>p\<^sub>r\<^sub>e (P x) \<Longrightarrow> \<sigma>\<^sub>p\<^sub>r\<^sub>e \<Turnstile>\<^sub>p\<^sub>r\<^sub>e (P y)" -by(auto simp: OclValid_def OclValid_at_pre_def StrongEq_def true_def cp_def) - -lemma StrongEq_L_subst2_rev\<^sub>p\<^sub>r\<^sub>e: "\<sigma>\<^sub>p\<^sub>r\<^sub>e \<Turnstile>\<^sub>p\<^sub>r\<^sub>e y \<triangleq> x \<Longrightarrow> cp P \<Longrightarrow> \<sigma>\<^sub>p\<^sub>r\<^sub>e \<Turnstile>\<^sub>p\<^sub>r\<^sub>e P x \<Longrightarrow> \<sigma>\<^sub>p\<^sub>r\<^sub>e \<Turnstile>\<^sub>p\<^sub>r\<^sub>e P y" -apply(erule StrongEq_L_subst2\<^sub>p\<^sub>r\<^sub>e) -apply(erule StrongEq_L_sym\<^sub>p\<^sub>r\<^sub>e) -by assumption - -lemma StrongEq_L_subst3\<^sub>p\<^sub>r\<^sub>e: -assumes cp: "cp P" -and eq: "\<sigma>\<^sub>p\<^sub>r\<^sub>e \<Turnstile>\<^sub>p\<^sub>r\<^sub>e (x \<triangleq> y)" -shows "(\<sigma>\<^sub>p\<^sub>r\<^sub>e \<Turnstile>\<^sub>p\<^sub>r\<^sub>e P x) = (\<sigma>\<^sub>p\<^sub>r\<^sub>e \<Turnstile>\<^sub>p\<^sub>r\<^sub>e P y)" -apply(rule iffI) -apply(rule StrongEq_L_subst2\<^sub>p\<^sub>r\<^sub>e[OF cp,OF eq],simp) -apply(rule StrongEq_L_subst2\<^sub>p\<^sub>r\<^sub>e[OF cp,OF eq[THEN StrongEq_L_sym\<^sub>p\<^sub>r\<^sub>e]],simp) -done - -lemma StrongEq_L_subst3_rev\<^sub>p\<^sub>r\<^sub>e: -assumes eq: "\<sigma>\<^sub>p\<^sub>r\<^sub>e \<Turnstile>\<^sub>p\<^sub>r\<^sub>e (x \<triangleq> y)" -and cp: "cp P" -shows "(\<sigma>\<^sub>p\<^sub>r\<^sub>e \<Turnstile>\<^sub>p\<^sub>r\<^sub>e P x) = (\<sigma>\<^sub>p\<^sub>r\<^sub>e \<Turnstile>\<^sub>p\<^sub>r\<^sub>e P y)" -by(insert cp, erule StrongEq_L_subst3\<^sub>p\<^sub>r\<^sub>e, rule eq) - -subsubsection{* Local Judgements and Strong Equality (at post) *} - -lemma StrongEq_L_sym\<^sub>p\<^sub>o\<^sub>s\<^sub>t: "\<sigma>\<^sub>p\<^sub>o\<^sub>s\<^sub>t \<Turnstile>\<^sub>p\<^sub>o\<^sub>s\<^sub>t (x \<triangleq> y) \<Longrightarrow> \<sigma>\<^sub>p\<^sub>o\<^sub>s\<^sub>t \<Turnstile>\<^sub>p\<^sub>o\<^sub>s\<^sub>t (y \<triangleq> x)" -by(simp add: StrongEq_sym) - -lemma StrongEq_L_subst2\<^sub>p\<^sub>o\<^sub>s\<^sub>t:"cp P \<Longrightarrow> \<sigma>\<^sub>p\<^sub>o\<^sub>s\<^sub>t \<Turnstile>\<^sub>p\<^sub>o\<^sub>s\<^sub>t (x \<triangleq> y) \<Longrightarrow> \<sigma>\<^sub>p\<^sub>o\<^sub>s\<^sub>t \<Turnstile>\<^sub>p\<^sub>o\<^sub>s\<^sub>t (P x) \<Longrightarrow> \<sigma>\<^sub>p\<^sub>o\<^sub>s\<^sub>t \<Turnstile>\<^sub>p\<^sub>o\<^sub>s\<^sub>t (P y)" -by(auto simp: OclValid_def OclValid_at_post_def StrongEq_def true_def cp_def) - -lemma StrongEq_L_subst2_rev\<^sub>p\<^sub>o\<^sub>s\<^sub>t: "\<sigma>\<^sub>p\<^sub>o\<^sub>s\<^sub>t \<Turnstile>\<^sub>p\<^sub>o\<^sub>s\<^sub>t y \<triangleq> x \<Longrightarrow> cp P \<Longrightarrow> \<sigma>\<^sub>p\<^sub>o\<^sub>s\<^sub>t \<Turnstile>\<^sub>p\<^sub>o\<^sub>s\<^sub>t P x \<Longrightarrow> \<sigma>\<^sub>p\<^sub>o\<^sub>s\<^sub>t \<Turnstile>\<^sub>p\<^sub>o\<^sub>s\<^sub>t P y" -apply(erule StrongEq_L_subst2\<^sub>p\<^sub>o\<^sub>s\<^sub>t) -apply(erule StrongEq_L_sym\<^sub>p\<^sub>o\<^sub>s\<^sub>t) -by assumption - -lemma StrongEq_L_subst3\<^sub>p\<^sub>o\<^sub>s\<^sub>t: -assumes cp: "cp P" -and eq: "\<sigma>\<^sub>p\<^sub>o\<^sub>s\<^sub>t \<Turnstile>\<^sub>p\<^sub>o\<^sub>s\<^sub>t (x \<triangleq> y)" -shows "(\<sigma>\<^sub>p\<^sub>o\<^sub>s\<^sub>t \<Turnstile>\<^sub>p\<^sub>o\<^sub>s\<^sub>t P x) = (\<sigma>\<^sub>p\<^sub>o\<^sub>s\<^sub>t \<Turnstile>\<^sub>p\<^sub>o\<^sub>s\<^sub>t P y)" -apply(rule iffI) -apply(rule StrongEq_L_subst2\<^sub>p\<^sub>o\<^sub>s\<^sub>t[OF cp,OF eq],simp) -apply(rule StrongEq_L_subst2\<^sub>p\<^sub>o\<^sub>s\<^sub>t[OF cp,OF eq[THEN StrongEq_L_sym\<^sub>p\<^sub>o\<^sub>s\<^sub>t]],simp) -done - -lemma StrongEq_L_subst3_rev\<^sub>p\<^sub>o\<^sub>s\<^sub>t: -assumes eq: "\<sigma>\<^sub>p\<^sub>o\<^sub>s\<^sub>t \<Turnstile>\<^sub>p\<^sub>o\<^sub>s\<^sub>t (x \<triangleq> y)" -and cp: "cp P" -shows "(\<sigma>\<^sub>p\<^sub>o\<^sub>s\<^sub>t \<Turnstile>\<^sub>p\<^sub>o\<^sub>s\<^sub>t P x) = (\<sigma>\<^sub>p\<^sub>o\<^sub>s\<^sub>t \<Turnstile>\<^sub>p\<^sub>o\<^sub>s\<^sub>t P y)" -by(insert cp, erule StrongEq_L_subst3\<^sub>p\<^sub>o\<^sub>s\<^sub>t, rule eq) - -subsection{* OCL's if then else endif *} - -definition OclIf :: "[('\<AA>)Boolean , ('\<AA>,'\<alpha>::null) val, ('\<AA>,'\<alpha>) val] \<Rightarrow> ('\<AA>,'\<alpha>) val" - ("if (_) then (_) else (_) endif" [10,10,10]50) -where "(if C then B\<^sub>1 else B\<^sub>2 endif) = (\<lambda> \<tau>. if (\<delta> C) \<tau> = true \<tau> - then (if (C \<tau>) = true \<tau> - then B\<^sub>1 \<tau> - else B\<^sub>2 \<tau>) - else invalid \<tau>)" - - -lemma cp_OclIf:"((if C then B\<^sub>1 else B\<^sub>2 endif) \<tau> = - (if (\<lambda> _. C \<tau>) then (\<lambda> _. B\<^sub>1 \<tau>) else (\<lambda> _. B\<^sub>2 \<tau>) endif) \<tau>)" -by(simp only: OclIf_def, subst cp_defined, rule refl) -text_raw{* \isatagafp *} - -lemmas cp_intro'[intro!,simp,code_unfold] = - cp_intro - cp_OclIf[THEN allI[THEN allI[THEN allI[THEN allI[THEN cpI3]]], of "OclIf"]] -text_raw{* \endisatagafp *} - -lemma OclIf_invalid [simp]: "(if invalid then B\<^sub>1 else B\<^sub>2 endif) = invalid" -by(rule ext, auto simp: OclIf_def) - -lemma OclIf_null [simp]: "(if null then B\<^sub>1 else B\<^sub>2 endif) = invalid" -by(rule ext, auto simp: OclIf_def) - -lemma OclIf_true [simp]: "(if true then B\<^sub>1 else B\<^sub>2 endif) = B\<^sub>1" -by(rule ext, auto simp: OclIf_def) - -lemma OclIf_true' [simp]: "\<tau> \<Turnstile> P \<Longrightarrow> (if P then B\<^sub>1 else B\<^sub>2 endif)\<tau> = B\<^sub>1 \<tau>" -apply(subst cp_OclIf,auto simp: OclValid_def) -by(simp add:cp_OclIf[symmetric]) - -lemma OclIf_true'' [simp]: "\<tau> \<Turnstile> P \<Longrightarrow> \<tau> \<Turnstile> (if P then B\<^sub>1 else B\<^sub>2 endif) \<triangleq> B\<^sub>1" -by(subst OclValid_def, simp add: StrongEq_def true_def) - -lemma OclIf_false [simp]: "(if false then B\<^sub>1 else B\<^sub>2 endif) = B\<^sub>2" -by(rule ext, auto simp: OclIf_def) - -lemma OclIf_false' [simp]: "\<tau> \<Turnstile> not P \<Longrightarrow> (if P then B\<^sub>1 else B\<^sub>2 endif)\<tau> = B\<^sub>2 \<tau>" -apply(subst cp_OclIf) -apply(auto simp: foundation14[symmetric] foundation22) -by(auto simp: cp_OclIf[symmetric]) - - -lemma OclIf_idem1[simp]:"(if \<delta> X then A else A endif) = A" -by(rule ext, auto simp: OclIf_def) - -lemma OclIf_idem2[simp]:"(if \<upsilon> X then A else A endif) = A" -by(rule ext, auto simp: OclIf_def) - -lemma OclNot_if[simp]: -"not(if P then C else E endif) = (if P then not C else not E endif)" - (* non-trivial but elementary *) - apply(rule OclNot_inject, simp) - apply(rule ext) - apply(subst cp_OclNot, simp add: OclIf_def) - apply(subst cp_OclNot[symmetric])+ -by simp - -lemma OclIf_defined: "\<tau> \<Turnstile> \<delta> (if P then A else B endif) \<Longrightarrow> \<tau> \<Turnstile> \<delta> P" -by(simp add: defined_def OclValid_def false_def true_def OclIf_def - invalid_def bot_fun_def - split: if_split_asm) - -lemma OclIf_defined': "\<tau> \<Turnstile> \<delta> (if P then A else B endif) \<Longrightarrow> \<tau> \<Turnstile> \<delta> A \<or> \<tau> \<Turnstile> \<delta> B" -by(simp add: defined_def OclValid_def false_def true_def OclIf_def - invalid_def bot_fun_def - split: if_split_asm) - -subsection{* Fundamental Predicates on Basic Types: Strict (Referential) Equality *} - -text{* - In contrast to logical equality, the OCL standard defines an equality operation - which we call ``strict referential equality''. It behaves differently for all - types---on value types, it is basically a strict version of strong equality, - for defined values it behaves identical. But on object types it will compare - their references within the store. We introduce strict referential equality - as an \emph{overloaded} concept and will handle it for - each type instance individually. -*} -consts StrictRefEq :: "[('\<AA>,'a)val,('\<AA>,'a)val] \<Rightarrow> ('\<AA>)Boolean" (infixl "\<doteq>" 30) - -text{* with {term "not"} we can express the notation:*} - -syntax - "_notequal" :: "('\<AA>)Boolean \<Rightarrow> ('\<AA>)Boolean \<Rightarrow> ('\<AA>)Boolean" (infix "<>" 40) -translations - "a <> b" == "CONST OclNot(a \<doteq> b)" - -text{* We will define instances of this equality in a case-by-case basis.*} - -subsection{* Laws to Establish Definedness (\texorpdfstring{$\delta$}{d}-closure) *} - -text{* For the logical connectives, we have --- beyond -@{thm foundation6} --- the following facts: *} -lemma OclNot_defargs: -"\<tau> \<Turnstile> (not P) \<Longrightarrow> \<tau> \<Turnstile> \<delta> P" -by(auto simp: OclNot_def OclValid_def true_def invalid_def defined_def false_def - bot_fun_def bot_option_def null_fun_def null_option_def - split: bool.split_asm HOL.if_split_asm option.split option.split_asm) - - -lemma OclNot_contrapos_nn: - assumes A: "\<tau> \<Turnstile> \<delta> A" - assumes B: "\<tau> \<Turnstile> not B" - assumes C: "\<tau> \<Turnstile> A \<Longrightarrow> \<tau> \<Turnstile> B" - shows "\<tau> \<Turnstile> not A" -proof - - have D : "\<tau> \<Turnstile> \<delta> B" by(rule B[THEN OclNot_defargs]) - show ?thesis - apply(insert B,simp add: A D foundation9) - by(erule contrapos_nn, auto intro: C) -qed - - -subsection{* A Side-calculus for Constant Terms *} - -definition "const X \<equiv> \<forall> \<tau> \<tau>'. X \<tau> = X \<tau>'" - -lemma const_charn: "const X \<Longrightarrow> X \<tau> = X \<tau>'" -by(auto simp: const_def) - -lemma const_subst: - assumes const_X: "const X" - and const_Y: "const Y" - and eq : "X \<tau> = Y \<tau>" - and cp_P: "cp P" - and pp : "P Y \<tau> = P Y \<tau>'" - shows "P X \<tau> = P X \<tau>'" -proof - - have A: "\<And>Y. P Y \<tau> = P (\<lambda>_. Y \<tau>) \<tau>" - apply(insert cp_P, unfold cp_def) - apply(elim exE, erule_tac x=Y in allE', erule_tac x=\<tau> in allE) - apply(erule_tac x="(\<lambda>_. Y \<tau>)" in allE, erule_tac x=\<tau> in allE) - by simp - have B: "\<And>Y. P Y \<tau>' = P (\<lambda>_. Y \<tau>') \<tau>'" - apply(insert cp_P, unfold cp_def) - apply(elim exE, erule_tac x=Y in allE', erule_tac x=\<tau>' in allE) - apply(erule_tac x="(\<lambda>_. Y \<tau>')" in allE, erule_tac x=\<tau>' in allE) - by simp - have C: "X \<tau>' = Y \<tau>'" - apply(rule trans, subst const_charn[OF const_X],rule eq) - by(rule const_charn[OF const_Y]) - show ?thesis - apply(subst A, subst B, simp add: eq C) - apply(subst A[symmetric],subst B[symmetric]) - by(simp add:pp) -qed - - -lemma const_imply2 : - assumes "\<And>\<tau> \<tau>'. P \<tau> = P \<tau>' \<Longrightarrow> Q \<tau> = Q \<tau>'" - shows "const P \<Longrightarrow> const Q" -by(simp add: const_def, insert assms, blast) - -lemma const_imply3 : - assumes "\<And>\<tau> \<tau>'. P \<tau> = P \<tau>' \<Longrightarrow> Q \<tau> = Q \<tau>' \<Longrightarrow> R \<tau> = R \<tau>'" - shows "const P \<Longrightarrow> const Q \<Longrightarrow> const R" -by(simp add: const_def, insert assms, blast) - -lemma const_imply4 : - assumes "\<And>\<tau> \<tau>'. P \<tau> = P \<tau>' \<Longrightarrow> Q \<tau> = Q \<tau>' \<Longrightarrow> R \<tau> = R \<tau>' \<Longrightarrow> S \<tau> = S \<tau>'" - shows "const P \<Longrightarrow> const Q \<Longrightarrow> const R \<Longrightarrow> const S" -by(simp add: const_def, insert assms, blast) - -lemma const_lam : "const (\<lambda>_. e)" -by(simp add: const_def) - - -lemma const_true[simp] : "const true" -by(simp add: const_def true_def) - -lemma const_false[simp] : "const false" -by(simp add: const_def false_def) - -lemma const_null[simp] : "const null" -by(simp add: const_def null_fun_def) - -lemma const_invalid [simp]: "const invalid" -by(simp add: const_def invalid_def) - -lemma const_bot[simp] : "const bot" -by(simp add: const_def bot_fun_def) - - - -lemma const_defined : - assumes "const X" - shows "const (\<delta> X)" -by(rule const_imply2[OF _ assms], - simp add: defined_def false_def true_def bot_fun_def bot_option_def null_fun_def null_option_def) - -lemma const_valid : - assumes "const X" - shows "const (\<upsilon> X)" -by(rule const_imply2[OF _ assms], - simp add: valid_def false_def true_def bot_fun_def null_fun_def assms) - - -lemma const_OclAnd : - assumes "const X" - assumes "const X'" - shows "const (X and X')" -by(rule const_imply3[OF _ assms], subst (1 2) cp_OclAnd, simp add: assms OclAnd_def) - - -lemma const_OclNot : - assumes "const X" - shows "const (not X)" -by(rule const_imply2[OF _ assms],subst cp_OclNot,simp add: assms OclNot_def) - -lemma const_OclOr : - assumes "const X" - assumes "const X'" - shows "const (X or X')" -by(simp add: assms OclOr_def const_OclNot const_OclAnd) - -lemma const_OclImplies : - assumes "const X" - assumes "const X'" - shows "const (X implies X')" -by(simp add: assms OclImplies_def const_OclNot const_OclOr) - -lemma const_StrongEq: - assumes "const X" - assumes "const X'" - shows "const(X \<triangleq> X')" - apply(simp only: StrongEq_def const_def, intro allI) - apply(subst assms(1)[THEN const_charn]) - apply(subst assms(2)[THEN const_charn]) - by simp - - -lemma const_OclIf : - assumes "const B" - and "const C1" - and "const C2" - shows "const (if B then C1 else C2 endif)" - apply(rule const_imply4[OF _ assms], - subst (1 2) cp_OclIf, simp only: OclIf_def cp_defined[symmetric]) - apply(simp add: const_defined[OF assms(1), simplified const_def, THEN spec, THEN spec] - const_true[simplified const_def, THEN spec, THEN spec] - assms[simplified const_def, THEN spec, THEN spec] - const_invalid[simplified const_def, THEN spec, THEN spec]) -by (metis (no_types) bot_fun_def OclValid_def const_def const_true defined_def - foundation16[THEN iffD1] null_fun_def) - - - -lemma const_OclValid1: - assumes "const x" - shows "(\<tau> \<Turnstile> \<delta> x) = (\<tau>' \<Turnstile> \<delta> x)" - apply(simp add: OclValid_def) - apply(subst const_defined[OF assms, THEN const_charn]) - by(simp add: true_def) - -lemma const_OclValid2: - assumes "const x" - shows "(\<tau> \<Turnstile> \<upsilon> x) = (\<tau>' \<Turnstile> \<upsilon> x)" - apply(simp add: OclValid_def) - apply(subst const_valid[OF assms, THEN const_charn]) - by(simp add: true_def) - - -lemma const_HOL_if : "const C \<Longrightarrow> const D \<Longrightarrow> const F \<Longrightarrow> const (\<lambda>\<tau>. if C \<tau> then D \<tau> else F \<tau>)" - by(auto simp: const_def) -lemma const_HOL_and: "const C \<Longrightarrow> const D \<Longrightarrow> const (\<lambda>\<tau>. C \<tau> \<and> D \<tau>)" - by(auto simp: const_def) -lemma const_HOL_eq : "const C \<Longrightarrow> const D \<Longrightarrow> const (\<lambda>\<tau>. C \<tau> = D \<tau>)" - apply(auto simp: const_def) - apply(erule_tac x=\<tau> in allE) - apply(erule_tac x=\<tau> in allE) - apply(erule_tac x=\<tau>' in allE) - apply(erule_tac x=\<tau>' in allE) - apply simp - apply(erule_tac x=\<tau> in allE) - apply(erule_tac x=\<tau> in allE) - apply(erule_tac x=\<tau>' in allE) - apply(erule_tac x=\<tau>' in allE) - by simp - - -lemmas const_ss = const_bot const_null const_invalid const_false const_true const_lam - const_defined const_valid const_StrongEq const_OclNot const_OclAnd - const_OclOr const_OclImplies const_OclIf - const_HOL_if const_HOL_and const_HOL_eq - -text{* Miscellaneous: Recovering the definition of - @{term OclValid_at_pre} and @{term OclValid_at_post} *} - -lemma "\<forall>\<tau>. \<tau> \<Turnstile> X \<triangleq>\<^sub>p\<^sub>r\<^sub>e Y \<Longrightarrow> X (\<sigma>,\<sigma>') = Y (\<sigma>,\<sigma>'')" -unfolding OclValid_def true_def StrongEq\<^sub>p\<^sub>r\<^sub>e_def -by auto - -lemma "\<forall>\<tau>. \<tau> \<Turnstile> X \<triangleq>\<^sub>p\<^sub>o\<^sub>s\<^sub>t Y \<Longrightarrow> X (\<sigma>',\<sigma>) = Y (\<sigma>'',\<sigma>)" -unfolding OclValid_def true_def StrongEq\<^sub>p\<^sub>o\<^sub>s\<^sub>t_def -by auto - -lemma OclValid_at_pre': "const X \<Longrightarrow> \<tau> \<Turnstile> X \<Longrightarrow> fst \<tau> \<Turnstile>\<^sub>p\<^sub>r\<^sub>e X" -by (metis OclValid_at_pre_def OclValid_def const_charn true_def) - -lemma OclValid_at_post': "const X \<Longrightarrow> \<tau> \<Turnstile> X \<Longrightarrow> snd \<tau> \<Turnstile>\<^sub>p\<^sub>o\<^sub>s\<^sub>t X" -by (metis OclValid_at_post_def OclValid_def const_charn true_def) - - -lemma OclValid_at_pre'' : "\<forall>\<sigma>. \<sigma> \<Turnstile>\<^sub>p\<^sub>r\<^sub>e X \<Longrightarrow> const X" -unfolding const_def OclValid_at_pre_def OclValid_def true_def by simp - -lemma OclValid_at_post'' : "\<forall>\<sigma>. \<sigma> \<Turnstile>\<^sub>p\<^sub>o\<^sub>s\<^sub>t X \<Longrightarrow> const X" -unfolding const_def OclValid_at_post_def OclValid_def true_def by simp - - -text{* Miscellaneous: Overloading the syntax of ``bottom'' *} - -notation bot ("\<bottom>") - -end diff --git a/Citadelle/src/UML_Main.thy b/Citadelle/src/UML_Main.thy deleted file mode 100644 index 6efb8ab4d0e2719dcc2b9a815c0dc798224d726f..0000000000000000000000000000000000000000 --- a/Citadelle/src/UML_Main.thy +++ /dev/null @@ -1,72 +0,0 @@ -(****************************************************************************** - * 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_Main -imports UML_Contracts UML_Tools - -begin - -(* legacy---still better names ? -lemmas defined_charn = foundation16 -lemmas definedD = foundation17 -lemmas valid_charn = -lemmas validD = foundation19 -lemmas valid_implies_defined = foundation20 - -lemmas cp_validity = foundation23 -lemmas foundation17 = foundation16[THEN iffD1] -lemmas def_split_local = OCL_core.defined_split -end legacy *) - -end - - - - - - - - - diff --git a/Citadelle/src/UML_OCL.thy b/Citadelle/src/UML_OCL.thy deleted file mode 100644 index 8673231881af736c58708b2bb4f49d7fddb8c096..0000000000000000000000000000000000000000 --- a/Citadelle/src/UML_OCL.thy +++ /dev/null @@ -1,104 +0,0 @@ -(****************************************************************************** - * 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_OCL -imports "UML_Main" - "../examples/archive/Monads" (* NOTE: perform lazily the extraction of generation_syntax - so that dependencies can alternate among theories *) - "compiler/Static" - "compiler/Generator_dynamic_sequential" -begin - -no_notation valid_SE (infix "\<Turnstile>" 15) -notation valid_SE (infix "\<Turnstile>\<^sub>M\<^sub>o\<^sub>n" 15) - -definition "k x _ = \<lfloor>\<lfloor> x \<rfloor>\<rfloor>" -notation "k" ("\<guillemotleft>_\<guillemotright>") -lemma "K \<lfloor>\<lfloor>x\<rfloor>\<rfloor> = \<guillemotleft>x\<guillemotright>" -by(rule ext, simp add: K_def k_def) - -(* Junk : TO BE DONE IN LIBRARY -- bu *) -(*<*) -lemma [simp]: "(\<guillemotleft>x\<guillemotright> <\<^sub>i\<^sub>n\<^sub>t \<guillemotleft>y\<guillemotright>) = \<guillemotleft>x < y\<guillemotright>" -by(rule ext, simp add: OclLess\<^sub>I\<^sub>n\<^sub>t\<^sub>e\<^sub>g\<^sub>e\<^sub>r_def k_def defined_def UML_Types.bot_fun_def - bot_option_def null_fun_def null_option_def) - -lemma [simp]: "(\<guillemotleft>x\<guillemotright> \<le>\<^sub>i\<^sub>n\<^sub>t \<guillemotleft>y\<guillemotright>) = \<guillemotleft>x \<le> y\<guillemotright>" -by(rule ext, simp add: OclLe\<^sub>I\<^sub>n\<^sub>t\<^sub>e\<^sub>g\<^sub>e\<^sub>r_def k_def defined_def UML_Types.bot_fun_def - bot_option_def null_fun_def null_option_def) - - -lemma OclInt0' : "\<zero> = \<guillemotleft>0\<guillemotright>" by(rule ext, simp add: OclInt0_def k_def) -lemma OclInt1' : "\<one> = \<guillemotleft>1\<guillemotright>" by(rule ext, simp add: OclInt1_def k_def) -lemma OclInt2' : "\<two> = \<guillemotleft>2\<guillemotright>" by(rule ext, simp add: OclInt2_def k_def) -lemma OclInt3' : "\<three> = \<guillemotleft>3\<guillemotright>" by(rule ext, simp add: OclInt3_def k_def) -lemma OclInt4' : "\<four> = \<guillemotleft>4\<guillemotright>" by(rule ext, simp add: OclInt4_def k_def) -lemma OclInt5' : "\<five> = \<guillemotleft>5\<guillemotright>" by(rule ext, simp add: OclInt5_def k_def) -lemma OclInt6' : "\<six> = \<guillemotleft>6\<guillemotright>" by(rule ext, simp add: OclInt6_def k_def) -lemma OclInt7' : "\<seven> = \<guillemotleft>7\<guillemotright>" by(rule ext, simp add: OclInt7_def k_def) -lemma OclInt8' : "\<eight> = \<guillemotleft>8\<guillemotright>" by(rule ext, simp add: OclInt8_def k_def) -lemma OclInt9' : "\<nine> = \<guillemotleft>9\<guillemotright>" by(rule ext, simp add: OclInt9_def k_def) -lemma OclInt10': "\<one>\<zero>= \<guillemotleft>10\<guillemotright>"by(rule ext, simp add: OclInt10_def k_def) - -lemma [simp]: "\<tau> \<Turnstile> \<guillemotleft>True\<guillemotright>" - "\<tau> |\<noteq> \<guillemotleft>False\<guillemotright>" -by(simp add: OclValid_def true_def k_def)+ -(*>*) - -(*declare [[quick_and_dirty = true]] shut up fully conservative mode *) - -generation_syntax [ (*deep - (*(generation_semantics [ analysis (*, oid_start 10*) ])*) - (THEORY Model_generated) - (IMPORTS ["OCL.UML_Main", "FOCL.Static"] - "FOCL.Generator_dynamic_sequential") - SECTION - (*SORRY*) - [ (*in OCaml module_name M*) - in self ] - (output_directory "../doc") - ,*) shallow (*SORRY*) ] - -end \ No newline at end of file diff --git a/Citadelle/src/UML_PropertyProfiles.thy b/Citadelle/src/UML_PropertyProfiles.thy deleted file mode 100644 index 6e4059c94125caab3ad9f87fec55d7c9d07d488f..0000000000000000000000000000000000000000 --- a/Citadelle/src/UML_PropertyProfiles.thy +++ /dev/null @@ -1,381 +0,0 @@ -(****************************************************************************** - * 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_PropertyProfiles -imports UML_Logic -begin - -section{* Property Profiles for OCL Operators via Isabelle Locales *} - -text{* We use the Isabelle mechanism of a \emph{Locale} to generate the -common lemmas for each type and operator; Locales can be seen as a -functor that takes a local theory and generates a number of theorems. -In our case, we will instantiate later these locales by the local theory -of an operator definition and obtain the common rules for strictness, definedness -propagation, context-passingness and constance in a systematic way. -*} - -subsection{* Property Profiles for Monadic Operators *} - -locale profile_mono_scheme_defined = - fixes f :: "('\<AA>,'\<alpha>::null)val \<Rightarrow> ('\<AA>,'\<beta>::null)val" - fixes g - assumes def_scheme: "(f x) \<equiv> \<lambda> \<tau>. if (\<delta> x) \<tau> = true \<tau> then g (x \<tau>) else invalid \<tau>" -begin - lemma strict[simp,code_unfold]: " f invalid = invalid" - by(rule ext, simp add: def_scheme true_def false_def) - - lemma null_strict[simp,code_unfold]: " f null = invalid" - by(rule ext, simp add: def_scheme true_def false_def) - - lemma cp0 : "f X \<tau> = f (\<lambda> _. X \<tau>) \<tau>" - by(simp add: def_scheme cp_defined[symmetric]) - - lemma cp[simp,code_unfold] : " cp P \<Longrightarrow> cp (\<lambda>X. f (P X) )" - by(rule cpI1[of "f"], intro allI, rule cp0, simp_all) - -end - -locale profile_mono_schemeV = - fixes f :: "('\<AA>,'\<alpha>::null)val \<Rightarrow> ('\<AA>,'\<beta>::null)val" - fixes g - assumes def_scheme: "(f x) \<equiv> \<lambda> \<tau>. if (\<upsilon> x) \<tau> = true \<tau> then g (x \<tau>) else invalid \<tau>" -begin - lemma strict[simp,code_unfold]: " f invalid = invalid" - by(rule ext, simp add: def_scheme true_def false_def) - - lemma cp0 : "f X \<tau> = f (\<lambda> _. X \<tau>) \<tau>" - by(simp add: def_scheme cp_valid[symmetric]) - - lemma cp[simp,code_unfold] : " cp P \<Longrightarrow> cp (\<lambda>X. f (P X) )" - by(rule cpI1[of "f"], intro allI, rule cp0, simp_all) - -end - -locale profile_mono\<^sub>d = profile_mono_scheme_defined + - assumes "\<And> x. x \<noteq> bot \<Longrightarrow> x \<noteq> null \<Longrightarrow> g x \<noteq> bot" -begin - - lemma const[simp,code_unfold] : - assumes C1 :"const X" - shows "const(f X)" - proof - - have const_g : "const (\<lambda>\<tau>. g (X \<tau>))" by(insert C1, auto simp:const_def, metis) - show ?thesis by(simp_all add : def_scheme const_ss C1 const_g) - qed -end - -locale profile_mono0 = profile_mono_scheme_defined + - assumes def_body: "\<And> x. x \<noteq> bot \<Longrightarrow> x \<noteq> null \<Longrightarrow> g x \<noteq> bot \<and> g x \<noteq> null" - -sublocale profile_mono0 < profile_mono\<^sub>d -by(unfold_locales, simp add: def_scheme, simp add: def_body) - -context profile_mono0 -begin - lemma def_homo[simp,code_unfold]: "\<delta>(f x) = (\<delta> x)" - apply(rule ext, rename_tac "\<tau>",subst foundation22[symmetric]) - apply(case_tac "\<not>(\<tau> \<Turnstile> \<delta> x)", simp add:defined_split, elim disjE) - apply(erule StrongEq_L_subst2_rev, simp,simp) - apply(erule StrongEq_L_subst2_rev, simp,simp) - apply(simp) - apply(rule foundation13[THEN iffD2,THEN StrongEq_L_subst2_rev, where y ="\<delta> x"]) - apply(simp_all add:def_scheme) - apply(simp add: OclValid_def) - by(auto simp:foundation13 StrongEq_def false_def true_def defined_def bot_fun_def null_fun_def def_body - split: if_split_asm) - - lemma def_valid_then_def: "\<upsilon>(f x) = (\<delta>(f x))" - apply(rule ext, rename_tac "\<tau>",subst foundation22[symmetric]) - apply(case_tac "\<not>(\<tau> \<Turnstile> \<delta> x)", simp add:defined_split, elim disjE) - apply(erule StrongEq_L_subst2_rev, simp,simp) - apply(erule StrongEq_L_subst2_rev, simp,simp) - apply simp - apply(simp_all add:def_scheme) - apply(simp add: OclValid_def valid_def, subst cp_StrongEq) - apply(subst (2) cp_defined, simp, simp add: cp_defined[symmetric]) - by(auto simp:foundation13 StrongEq_def false_def true_def defined_def bot_fun_def null_fun_def def_body - split: if_split_asm) -end - -subsection{* Property Profiles for Single *} - -locale profile_single = - fixes d:: "('\<AA>,'a::null)val \<Rightarrow> '\<AA> Boolean" - assumes d_strict[simp,code_unfold]: "d invalid = false" - assumes d_cp0: "d X \<tau> = d (\<lambda> _. X \<tau>) \<tau>" - assumes d_const[simp,code_unfold]: "const X \<Longrightarrow> const (d X)" - -subsection{* Property Profiles for Binary Operators *} - -definition "bin' f g d\<^sub>x d\<^sub>y X Y = - (f X Y = (\<lambda> \<tau>. if (d\<^sub>x X) \<tau> = true \<tau> \<and> (d\<^sub>y Y) \<tau> = true \<tau> - then g X Y \<tau> - else invalid \<tau> ))" - -definition "bin f g = bin' f (\<lambda>X Y \<tau>. g (X \<tau>) (Y \<tau>))" - -lemmas [simp,code_unfold] = bin'_def bin_def - -locale profile_bin_scheme = - fixes d\<^sub>x:: "('\<AA>,'a::null)val \<Rightarrow> '\<AA> Boolean" - fixes d\<^sub>y:: "('\<AA>,'b::null)val \<Rightarrow> '\<AA> Boolean" - fixes f::"('\<AA>,'a::null)val \<Rightarrow> ('\<AA>,'b::null)val \<Rightarrow> ('\<AA>,'c::null)val" - fixes g - assumes d\<^sub>x' : "profile_single d\<^sub>x" - assumes d\<^sub>y' : "profile_single d\<^sub>y" - assumes d\<^sub>x_d\<^sub>y_homo[simp,code_unfold]: "cp (f X) \<Longrightarrow> - cp (\<lambda>x. f x Y) \<Longrightarrow> - f X invalid = invalid \<Longrightarrow> - f invalid Y = invalid \<Longrightarrow> - (\<not> (\<tau> \<Turnstile> d\<^sub>x X) \<or> \<not> (\<tau> \<Turnstile> d\<^sub>y Y)) \<Longrightarrow> - \<tau> \<Turnstile> (\<delta> f X Y \<triangleq> (d\<^sub>x X and d\<^sub>y Y))" - assumes def_scheme''[simplified]: "bin f g d\<^sub>x d\<^sub>y X Y" - assumes 1: "\<tau> \<Turnstile> d\<^sub>x X \<Longrightarrow> \<tau> \<Turnstile> d\<^sub>y Y \<Longrightarrow> \<tau> \<Turnstile> \<delta> f X Y" -begin - interpretation d\<^sub>x : profile_single d\<^sub>x by (rule d\<^sub>x') - interpretation d\<^sub>y : profile_single d\<^sub>y by (rule d\<^sub>y') - - lemma strict1[simp,code_unfold]: " f invalid y = invalid" - by(rule ext, simp add: def_scheme'' true_def false_def) - - lemma strict2[simp,code_unfold]: " f x invalid = invalid" - by(rule ext, simp add: def_scheme'' true_def false_def) - - lemma cp0 : "f X Y \<tau> = f (\<lambda> _. X \<tau>) (\<lambda> _. Y \<tau>) \<tau>" - by(simp add: def_scheme'' d\<^sub>x.d_cp0[symmetric] d\<^sub>y.d_cp0[symmetric] cp_defined[symmetric]) - - lemma cp[simp,code_unfold] : " cp P \<Longrightarrow> cp Q \<Longrightarrow> cp (\<lambda>X. f (P X) (Q X))" - by(rule cpI2[of "f"], intro allI, rule cp0, simp_all) - - lemma def_homo[simp,code_unfold]: "\<delta>(f x y) = (d\<^sub>x x and d\<^sub>y y)" - apply(rule ext, rename_tac "\<tau>",subst foundation22[symmetric]) - apply(case_tac "\<not>(\<tau> \<Turnstile> d\<^sub>x x)", simp) - apply(case_tac "\<not>(\<tau> \<Turnstile> d\<^sub>y y)", simp) - apply(simp) - apply(rule foundation13[THEN iffD2,THEN StrongEq_L_subst2_rev, where y ="d\<^sub>x x"]) - apply(simp_all) - apply(rule foundation13[THEN iffD2,THEN StrongEq_L_subst2_rev, where y ="d\<^sub>y y"]) - apply(simp_all add: 1 foundation13) - done - - lemma def_valid_then_def: "\<upsilon>(f x y) = (\<delta>(f x y))" (* [simp,code_unfold] ? *) - apply(rule ext, rename_tac "\<tau>") - apply(simp_all add: valid_def defined_def def_scheme'' - true_def false_def invalid_def - null_def null_fun_def null_option_def bot_fun_def) - by (metis "1" OclValid_def def_scheme'' foundation16 true_def) - - lemma defined_args_valid: "(\<tau> \<Turnstile> \<delta> (f x y)) = ((\<tau> \<Turnstile> d\<^sub>x x) \<and> (\<tau> \<Turnstile> d\<^sub>y y))" - by(simp add: foundation10') - - lemma const[simp,code_unfold] : - assumes C1 :"const X" and C2 : "const Y" - shows "const(f X Y)" - proof - - have const_g : "const (\<lambda>\<tau>. g (X \<tau>) (Y \<tau>))" - by(insert C1 C2, auto simp:const_def, metis) - show ?thesis - by(simp_all add : def_scheme'' const_ss C1 C2 const_g) - qed -end - - -text{* -In our context, we will use Locales as ``Property Profiles'' for OCL operators; -if an operator @{term "f"} is of profile @{term "profile_bin_scheme defined f g"} we know -that it satisfies a number of properties like @{text "strict1"} or @{text "strict2"} -\ie{} @{term "f invalid y = invalid"} and @{term "f null y = invalid"}. -Since some of the more advanced Locales come with 10 - 15 theorems, property profiles -represent a major structuring mechanism for the OCL library. -*} - - -locale profile_bin_scheme_defined = - fixes d\<^sub>y:: "('\<AA>,'b::null)val \<Rightarrow> '\<AA> Boolean" - fixes f::"('\<AA>,'a::null)val \<Rightarrow> ('\<AA>,'b::null)val \<Rightarrow> ('\<AA>,'c::null)val" - fixes g - assumes d\<^sub>y : "profile_single d\<^sub>y" - assumes d\<^sub>y_homo[simp,code_unfold]: "cp (f X) \<Longrightarrow> - f X invalid = invalid \<Longrightarrow> - \<not> \<tau> \<Turnstile> d\<^sub>y Y \<Longrightarrow> - \<tau> \<Turnstile> \<delta> f X Y \<triangleq> (\<delta> X and d\<^sub>y Y)" - assumes def_scheme'[simplified]: "bin f g defined d\<^sub>y X Y" - assumes def_body': "\<And> x y \<tau>. x\<noteq>bot \<Longrightarrow> x\<noteq>null \<Longrightarrow> (d\<^sub>y y) \<tau> = true \<tau> \<Longrightarrow> g x (y \<tau>) \<noteq> bot \<and> g x (y \<tau>) \<noteq> null " -begin - lemma strict3[simp,code_unfold]: " f null y = invalid" - by(rule ext, simp add: def_scheme' true_def false_def) -end - -sublocale profile_bin_scheme_defined < profile_bin_scheme defined -proof - - interpret d\<^sub>y : profile_single d\<^sub>y by (rule d\<^sub>y) - show "profile_bin_scheme defined d\<^sub>y f g" - apply(unfold_locales) - apply(simp)+ - apply(subst cp_defined, simp) - apply(rule const_defined, simp) - apply(simp add:defined_split, elim disjE) - apply(erule StrongEq_L_subst2_rev, simp, simp)+ - apply(simp) - apply(simp add: def_scheme') - apply(simp add: defined_def OclValid_def false_def true_def - bot_fun_def null_fun_def def_scheme' split: if_split_asm, rule def_body') - by(simp add: true_def)+ -qed - -locale profile_bin\<^sub>d_\<^sub>d = - fixes f::"('\<AA>,'a::null)val \<Rightarrow> ('\<AA>,'b::null)val \<Rightarrow> ('\<AA>,'c::null)val" - fixes g - assumes def_scheme[simplified]: "bin f g defined defined X Y" - assumes def_body: "\<And> x y. x\<noteq>bot \<Longrightarrow> x\<noteq>null \<Longrightarrow> y\<noteq>bot \<Longrightarrow> y\<noteq>null \<Longrightarrow> - g x y \<noteq> bot \<and> g x y \<noteq> null " -begin - lemma strict4[simp,code_unfold]: " f x null = invalid" - by(rule ext, simp add: def_scheme true_def false_def) -end - -sublocale profile_bin\<^sub>d_\<^sub>d < profile_bin_scheme_defined defined - apply(unfold_locales) - apply(simp)+ - apply(subst cp_defined, simp)+ - apply(rule const_defined, simp)+ - apply(simp add:defined_split, elim disjE) - apply(erule StrongEq_L_subst2_rev, simp, simp)+ - apply(simp add: def_scheme) - apply(simp add: defined_def OclValid_def false_def true_def bot_fun_def null_fun_def def_scheme) - apply(rule def_body, simp_all add: true_def false_def split:if_split_asm) -done - -locale profile_bin\<^sub>d_\<^sub>v = - fixes f::"('\<AA>,'a::null)val \<Rightarrow> ('\<AA>,'b::null)val \<Rightarrow> ('\<AA>,'c::null)val" - fixes g - assumes def_scheme[simplified]: "bin f g defined valid X Y" - assumes def_body: "\<And> x y. x\<noteq>bot \<Longrightarrow> x\<noteq>null \<Longrightarrow> y\<noteq>bot \<Longrightarrow> g x y \<noteq> bot \<and> g x y \<noteq> null" - -sublocale profile_bin\<^sub>d_\<^sub>v < profile_bin_scheme_defined valid - apply(unfold_locales) - apply(simp) - apply(subst cp_valid, simp) - apply(rule const_valid, simp) - apply(simp add:foundation18'') - apply(erule StrongEq_L_subst2_rev, simp, simp) - apply(simp add: def_scheme) - by (metis OclValid_def def_body foundation18') - -locale profile_bin\<^sub>S\<^sub>t\<^sub>r\<^sub>o\<^sub>n\<^sub>g\<^sub>E\<^sub>q_\<^sub>v_\<^sub>v = - fixes f :: "('\<AA>,'\<alpha>::null)val \<Rightarrow> ('\<AA>,'\<alpha>::null)val \<Rightarrow> ('\<AA>) Boolean" - assumes def_scheme[simplified]: "bin' f StrongEq valid valid X Y" - -sublocale profile_bin\<^sub>S\<^sub>t\<^sub>r\<^sub>o\<^sub>n\<^sub>g\<^sub>E\<^sub>q_\<^sub>v_\<^sub>v < profile_bin_scheme valid valid f "\<lambda>x y. \<lfloor>\<lfloor>x = y\<rfloor>\<rfloor>" - apply(unfold_locales) - apply(simp) - apply(subst cp_valid, simp) - apply (simp add: const_valid) - apply (metis (hide_lams, mono_tags) OclValid_def def_scheme defined5 defined6 defined_and_I foundation1 foundation10' foundation16' foundation18 foundation21 foundation22 foundation9) - apply(simp add: def_scheme, subst StrongEq_def, simp) - by (metis OclValid_def def_scheme defined7 foundation16) - -context profile_bin\<^sub>S\<^sub>t\<^sub>r\<^sub>o\<^sub>n\<^sub>g\<^sub>E\<^sub>q_\<^sub>v_\<^sub>v - begin - lemma idem[simp,code_unfold]: " f null null = true" - by(rule ext, simp add: def_scheme true_def false_def) - - (* definedness *) - lemma defargs: "\<tau> \<Turnstile> f x y \<Longrightarrow> (\<tau> \<Turnstile> \<upsilon> x) \<and> (\<tau> \<Turnstile> \<upsilon> y)" - by(simp add: def_scheme OclValid_def true_def invalid_def valid_def bot_option_def - split: bool.split_asm HOL.if_split_asm) - - lemma defined_args_valid' : "\<delta> (f x y) = (\<upsilon> x and \<upsilon> y)" - by(auto intro!: transform2_rev defined_and_I simp:foundation10 defined_args_valid) - - (* logic and algebraic properties *) - lemma refl_ext[simp,code_unfold] : "(f x x) = (if (\<upsilon> x) then true else invalid endif)" - by(rule ext, simp add: def_scheme OclIf_def) - - lemma sym : "\<tau> \<Turnstile> (f x y) \<Longrightarrow> \<tau> \<Turnstile> (f y x)" - apply(case_tac "\<tau> \<Turnstile> \<upsilon> x") - apply(auto simp: def_scheme OclValid_def) - by(fold OclValid_def, erule StrongEq_L_sym) - - lemma symmetric : "(f x y) = (f y x)" - by(rule ext, rename_tac \<tau>, auto simp: def_scheme StrongEq_sym) - - lemma trans : "\<tau> \<Turnstile> (f x y) \<Longrightarrow> \<tau> \<Turnstile> (f y z) \<Longrightarrow> \<tau> \<Turnstile> (f x z)" - apply(case_tac "\<tau> \<Turnstile> \<upsilon> x") - apply(case_tac "\<tau> \<Turnstile> \<upsilon> y") - apply(auto simp: def_scheme OclValid_def) - by(fold OclValid_def, auto elim: StrongEq_L_trans) - - lemma StrictRefEq_vs_StrongEq: "\<tau> \<Turnstile>(\<upsilon> x) \<Longrightarrow> \<tau> \<Turnstile>(\<upsilon> y) \<Longrightarrow> (\<tau> \<Turnstile> ((f x y) \<triangleq> (x \<triangleq> y)))" - apply(simp add: def_scheme OclValid_def) - apply(subst cp_StrongEq[of _ "(x \<triangleq> y)"]) - by simp - - lemma StrictRefEq_vs_StrongEq': "\<tau> \<Turnstile>(\<upsilon> x) \<Longrightarrow> \<tau> \<Turnstile>(\<upsilon> y) \<Longrightarrow> ( ((\<tau> \<Turnstile>f x y) = (\<tau> \<Turnstile> (x \<triangleq> y))))" - by(simp add: def_scheme OclValid_def) - end - - -locale profile_bin\<^sub>v_\<^sub>v = - fixes f :: "('\<AA>,'\<alpha>::null)val \<Rightarrow> ('\<AA>,'\<beta>::null)val \<Rightarrow> ('\<AA>,'\<gamma>::null)val" - fixes g - assumes def_scheme[simplified]: "bin f g valid valid X Y" - assumes def_body: "\<And> x y. x\<noteq>bot \<Longrightarrow> y\<noteq>bot \<Longrightarrow> g x y \<noteq> bot \<and> g x y \<noteq> null" - -sublocale profile_bin\<^sub>v_\<^sub>v < profile_bin_scheme valid valid - apply(unfold_locales) - apply(simp, subst cp_valid, simp, rule const_valid, simp)+ - apply (metis (hide_lams, mono_tags) OclValid_def def_scheme defined5 defined6 defined_and_I - foundation1 foundation10' foundation16' foundation18 foundation21 foundation22 foundation9) - apply(simp add: def_scheme) - apply(simp add: defined_def OclValid_def false_def true_def - bot_fun_def null_fun_def def_scheme split: if_split_asm, rule def_body) - by (metis OclValid_def foundation18' true_def)+ - -end diff --git a/Citadelle/src/UML_State.thy b/Citadelle/src/UML_State.thy deleted file mode 100644 index 4029ae19b914d622621aac308003bc619122eb43..0000000000000000000000000000000000000000 --- a/Citadelle/src/UML_State.thy +++ /dev/null @@ -1,1353 +0,0 @@ -(****************************************************************************** - * 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. - ******************************************************************************) - -chapter{* Formalization III: UML/OCL constructs: State Operations and Objects *} - -theory UML_State -imports UML_Library -begin - -no_notation None ("\<bottom>") -section{* Introduction: States over Typed Object Universes *} - -text{* \label{sec:universe} - In the following, we will refine the concepts of a user-defined - data-model (implied by a class-diagram) as well as the notion of - $\state{}$ used in the previous section to much more detail. - Surprisingly, even without a concrete notion of an objects and a - universe of object representation, the generic infrastructure of - state-related operations is fairly rich. -*} - - - -subsection{* Fundamental Properties on Objects: Core Referential Equality *} -subsubsection{* Definition *} - -text{* Generic referential equality - to be used for instantiations - with concrete object types ... *} -definition StrictRefEq\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t :: "('\<AA>,'a::{object,null})val \<Rightarrow> ('\<AA>,'a)val \<Rightarrow> ('\<AA>)Boolean" -where "StrictRefEq\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t x y - \<equiv> \<lambda> \<tau>. if (\<upsilon> x) \<tau> = true \<tau> \<and> (\<upsilon> y) \<tau> = true \<tau> - then if x \<tau> = null \<or> y \<tau> = null - then \<lfloor>\<lfloor>x \<tau> = null \<and> y \<tau> = null\<rfloor>\<rfloor> - else \<lfloor>\<lfloor>(oid_of (x \<tau>)) = (oid_of (y \<tau>)) \<rfloor>\<rfloor> - else invalid \<tau>" - -subsubsection{* Strictness and context passing *} - -lemma StrictRefEq\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_strict1[simp,code_unfold] : -"(StrictRefEq\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t x invalid) = invalid" -by(rule ext, simp add: StrictRefEq\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_def true_def false_def) - -lemma StrictRefEq\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_strict2[simp,code_unfold] : -"(StrictRefEq\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t invalid x) = invalid" -by(rule ext, simp add: StrictRefEq\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_def true_def false_def) - - -lemma cp_StrictRefEq\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t: -"(StrictRefEq\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t x y \<tau>) = (StrictRefEq\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t (\<lambda>_. x \<tau>) (\<lambda>_. y \<tau>)) \<tau>" -by(auto simp: StrictRefEq\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_def cp_valid[symmetric]) - -text_raw{* \isatagafp *} -lemmas cp0_StrictRefEq\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t= cp_StrictRefEq\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t[THEN allI[THEN allI[THEN allI[THEN cpI2]], - of "StrictRefEq\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t"]] - -(*Superfluous in the future ... *) -lemmas cp_intro''[intro!,simp,code_unfold] = - cp_intro'' - cp_StrictRefEq\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t[THEN allI[THEN allI[THEN allI[THEN cpI2]], - of "StrictRefEq\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t"]] - -text_raw{* \endisatagafp *} - -subsection{* Logic and Algebraic Layer on Object *} -subsubsection{* Validity and Definedness Properties *} - -text{* We derive the usual laws on definedness for (generic) object equality:*} -lemma StrictRefEq\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_defargs: -"\<tau> \<Turnstile> (StrictRefEq\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t x (y::('\<AA>,'a::{null,object})val))\<Longrightarrow> (\<tau> \<Turnstile>(\<upsilon> x)) \<and> (\<tau> \<Turnstile>(\<upsilon> y))" -by(simp add: StrictRefEq\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_def OclValid_def true_def invalid_def bot_option_def - split: bool.split_asm HOL.if_split_asm) - -lemma defined_StrictRefEq\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_I: - assumes val_x : "\<tau> \<Turnstile> \<upsilon> x" - assumes val_x : "\<tau> \<Turnstile> \<upsilon> y" - shows "\<tau> \<Turnstile> \<delta> (StrictRefEq\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t x y)" - apply(insert assms, simp add: StrictRefEq\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_def OclValid_def) -by(subst cp_defined, simp add: true_def) - -lemma StrictRefEq\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_def_homo : -"\<delta>(StrictRefEq\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t x (y::('\<AA>,'a::{null,object})val)) = ((\<upsilon> x) and (\<upsilon> y))" -oops (* sorry *) - -subsubsection{* Symmetry *} - -lemma StrictRefEq\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_sym : -assumes x_val : "\<tau> \<Turnstile> \<upsilon> x" -shows "\<tau> \<Turnstile> StrictRefEq\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t x x" -by(simp add: StrictRefEq\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_def true_def OclValid_def - x_val[simplified OclValid_def]) - - -subsubsection{* Behavior vs StrongEq *} - -text{* It remains to clarify the role of the state invariant -$\inv_\sigma(\sigma)$ mentioned above that states the condition that -there is a ``one-to-one'' correspondence between object -representations and $\oid$'s: $\forall \mathit{oid} \in \dom\ap -\sigma\spot oid = \HolOclOidOf\ap \drop{\sigma(\mathit{oid})}$. This -condition is also mentioned in~\cite[Annex A]{omg:ocl:2012} and goes -back to \citet{richters:precise:2002}; however, we state this -condition as an invariant on states rather than a global axiom. It -can, therefore, not be taken for granted that an $\oid$ makes sense -both in pre- and post-states of OCL expressions. -*} - -text{* We capture this invariant in the predicate WFF :*} - -definition WFF :: "('\<AA>::object)st \<Rightarrow> bool" -where "WFF \<tau> = ((\<forall> x \<in> ran(heap(fst \<tau>)). \<lceil>heap(fst \<tau>) (oid_of x)\<rceil> = x) \<and> - (\<forall> x \<in> ran(heap(snd \<tau>)). \<lceil>heap(snd \<tau>) (oid_of x)\<rceil> = x))" - -text{* It turns out that WFF is a key-concept for linking strict referential equality to -logical equality: in well-formed states (i.e. those states where the self (oid-of) field contains -the pointer to which the object is associated to in the state), referential equality coincides -with logical equality. *} - - -text{* We turn now to the generic definition of referential equality on objects: -Equality on objects in a state is reduced to equality on the -references to these objects. As in HOL-OCL~\cite{brucker.ea:hol-ocl:2008,brucker.ea:hol-ocl-book:2006}, -we will store the reference of an object inside the object in a (ghost) field. -By establishing certain invariants (``consistent state''), it can -be assured that there is a ``one-to-one-correspondence'' of objects -to their references---and therefore the definition below -behaves as we expect. *} -text{* Generic Referential Equality enjoys the usual properties: -(quasi) reflexivity, symmetry, transitivity, substitutivity for -defined values. For type-technical reasons, for each concrete -object type, the equality @{text "\<doteq>"} is defined by generic referential -equality. *} - -theorem StrictRefEq\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_vs_StrongEq: -assumes WFF: "WFF \<tau>" -and valid_x: "\<tau> \<Turnstile>(\<upsilon> x)" -and valid_y: "\<tau> \<Turnstile>(\<upsilon> y)" -and x_present_pre: "x \<tau> \<in> ran (heap(fst \<tau>))" -and y_present_pre: "y \<tau> \<in> ran (heap(fst \<tau>))" -and x_present_post:"x \<tau> \<in> ran (heap(snd \<tau>))" -and y_present_post:"y \<tau> \<in> ran (heap(snd \<tau>))" - (* x and y must be object representations that exist in either the pre or post state *) -shows "(\<tau> \<Turnstile> (StrictRefEq\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t x y)) = (\<tau> \<Turnstile> (x \<triangleq> y))" -apply(insert WFF valid_x valid_y x_present_pre y_present_pre x_present_post y_present_post) -apply(auto simp: StrictRefEq\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_def OclValid_def WFF_def StrongEq_def true_def Ball_def) -apply(erule_tac x="x \<tau>" in allE', simp_all) -done - -theorem StrictRefEq\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_vs_StrongEq': -assumes WFF: "WFF \<tau>" -and valid_x: "\<tau> \<Turnstile>(\<upsilon> (x :: ('\<AA>::object,'\<alpha>::{null,object})val))" -and valid_y: "\<tau> \<Turnstile>(\<upsilon> y)" -and oid_preserve: "\<And>x. x \<in> ran (heap(fst \<tau>)) \<or> x \<in> ran (heap(snd \<tau>)) \<Longrightarrow> - H x \<noteq> \<bottom> \<Longrightarrow> oid_of (H x) = oid_of x" -and xy_together: "x \<tau> \<in> H ` ran (heap(fst \<tau>)) \<and> y \<tau> \<in> H ` ran (heap(fst \<tau>)) \<or> - x \<tau> \<in> H ` ran (heap(snd \<tau>)) \<and> y \<tau> \<in> H ` ran (heap(snd \<tau>))" - (* x and y must be object representations that exist in either the pre or post state *) -shows "(\<tau> \<Turnstile> (StrictRefEq\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t x y)) = (\<tau> \<Turnstile> (x \<triangleq> y))" - apply(insert WFF valid_x valid_y xy_together) - apply(simp add: WFF_def) - apply(auto simp: StrictRefEq\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_def OclValid_def WFF_def StrongEq_def true_def Ball_def) -by (metis foundation18' oid_preserve valid_x valid_y)+ - -text{* So, if two object descriptions live in the same state (both pre or post), the referential -equality on objects implies in a WFF state the logical equality. *} - -section{* Operations on Object *} -subsection{* Initial States (for testing and code generation) *} - -definition \<tau>\<^sub>0 :: "('\<AA>)st" -where "\<tau>\<^sub>0 \<equiv> (\<lparr>heap=Map.empty, assocs = Map.empty\<rparr>, - \<lparr>heap=Map.empty, assocs = Map.empty\<rparr>)" - -subsection{* OclAllInstances *} - -text{* To denote OCL types occurring in OCL expressions syntactically---as, for example, -as ``argument'' of \inlineocl{oclAllInstances()}---we use the inverses of the injection functions into the object -universes; we show that this is a sufficient ``characterization.'' *} - -definition OclAllInstances_generic :: "(('\<AA>::object) st \<Rightarrow> '\<AA> state) \<Rightarrow> ('\<AA>::object \<rightharpoonup> '\<alpha>) \<Rightarrow> - ('\<AA>, '\<alpha> option option) Set" -where "OclAllInstances_generic fst_snd H = - (\<lambda>\<tau>. Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e \<lfloor>\<lfloor> Some ` ((H ` ran (heap (fst_snd \<tau>))) - { None }) \<rfloor>\<rfloor>)" - -lemma OclAllInstances_generic_defined: "\<tau> \<Turnstile> \<delta> (OclAllInstances_generic pre_post H)" - apply(simp add: defined_def OclValid_def OclAllInstances_generic_def false_def true_def - bot_fun_def bot_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def null_fun_def null_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def) - apply(rule conjI) - apply(rule notI, subst (asm) Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inject, simp, - (rule disjI2)+, - metis bot_option_def option.distinct(1), - (simp add: bot_option_def null_option_def)+)+ -done - -lemma OclAllInstances_generic_valid: "\<tau> \<Turnstile> \<upsilon> (OclAllInstances_generic pre_post H)" -by(rule foundation20, rule OclAllInstances_generic_defined) - -lemma OclAllInstances_generic_init_empty: - assumes [simp]: "\<And>x. pre_post (x, x) = x" - shows "\<tau>\<^sub>0 \<Turnstile> OclAllInstances_generic pre_post H \<triangleq> Set{}" -by(simp add: StrongEq_def OclAllInstances_generic_def OclValid_def \<tau>\<^sub>0_def mtSet_def) - -lemma represented_generic_objects_nonnull: -assumes A: "\<tau> \<Turnstile> ((OclAllInstances_generic pre_post (H::('\<AA>::object \<rightharpoonup> '\<alpha>))) ->includes\<^sub>S\<^sub>e\<^sub>t(x))" -shows "\<tau> \<Turnstile> not(x \<triangleq> null)" -proof - - have B: "\<tau> \<Turnstile> \<delta> (OclAllInstances_generic pre_post H)" - by (simp add: OclAllInstances_generic_defined) - have C: "\<tau> \<Turnstile> \<upsilon> x" - by (metis OclIncludes.def_valid_then_def - OclIncludes_valid_args_valid A foundation6) - show ?thesis - apply(insert A) - apply(simp add: StrongEq_def OclValid_def - OclNot_def null_def true_def OclIncludes_def B[simplified OclValid_def] - C[simplified OclValid_def]) - apply(simp add:OclAllInstances_generic_def) - apply(erule contrapos_pn) - apply(subst Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e.Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inverse, - auto simp: null_fun_def null_option_def bot_option_def) - done -qed - - -lemma represented_generic_objects_defined: -assumes A: "\<tau> \<Turnstile> ((OclAllInstances_generic pre_post (H::('\<AA>::object \<rightharpoonup> '\<alpha>))) ->includes\<^sub>S\<^sub>e\<^sub>t(x))" -shows "\<tau> \<Turnstile> \<delta> (OclAllInstances_generic pre_post H) \<and> \<tau> \<Turnstile> \<delta> x" -by (metis OclAllInstances_generic_defined - A[THEN represented_generic_objects_nonnull] OclIncludes.defined_args_valid - A foundation16' foundation18 foundation24 foundation6) - - -text{* One way to establish the actual presence of an object representation in a state is:*} - -definition "is_represented_in_state fst_snd x H \<tau> = (x \<tau> \<in> (Some o H) ` ran (heap (fst_snd \<tau>)))" - -lemma represented_generic_objects_in_state: -assumes A: "\<tau> \<Turnstile> (OclAllInstances_generic pre_post H)->includes\<^sub>S\<^sub>e\<^sub>t(x)" -shows "is_represented_in_state pre_post x H \<tau>" -proof - - have B: "(\<delta> (OclAllInstances_generic pre_post H)) \<tau> = true \<tau>" - by(simp add: OclValid_def[symmetric] OclAllInstances_generic_defined) - have C: "(\<upsilon> x) \<tau> = true \<tau>" - by (metis OclValid_def UML_Set.OclIncludes_def assms bot_option_def option.distinct(1) true_def) - have F: "Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e \<lfloor>\<lfloor>Some ` (H ` ran (heap (pre_post \<tau>)) - {None})\<rfloor>\<rfloor>) = - \<lfloor>\<lfloor>Some ` (H ` ran (heap (pre_post \<tau>)) - {None})\<rfloor>\<rfloor>" - by(subst Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e.Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inverse,simp_all add: bot_option_def) - show ?thesis - apply(insert A) - apply(simp add: is_represented_in_state_def OclIncludes_def OclValid_def ran_def B C image_def true_def) - apply(simp add: OclAllInstances_generic_def) - apply(simp add: F) - apply(simp add: ran_def) - by(fastforce) -qed - - -lemma state_update_vs_allInstances_generic_empty: -assumes [simp]: "\<And>a. pre_post (mk a) = a" -shows "(mk \<lparr>heap=Map.empty, assocs=A\<rparr>) \<Turnstile> OclAllInstances_generic pre_post Type \<doteq> Set{}" -proof - - have state_update_vs_allInstances_empty: - "(OclAllInstances_generic pre_post Type) (mk \<lparr>heap=Map.empty, assocs=A\<rparr>) = - Set{} (mk \<lparr>heap=Map.empty, assocs=A\<rparr>)" - by(simp add: OclAllInstances_generic_def mtSet_def) - show ?thesis - apply(simp only: OclValid_def, subst StrictRefEq\<^sub>S\<^sub>e\<^sub>t.cp0, - simp only: state_update_vs_allInstances_empty StrictRefEq\<^sub>S\<^sub>e\<^sub>t.refl_ext) - apply(simp add: OclIf_def valid_def mtSet_def defined_def - bot_fun_def null_fun_def null_option_def bot_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def) - by(subst Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inject, (simp add: bot_option_def true_def)+) -qed - -text{* Here comes a couple of operational rules that allow to infer the value -of \inlineisar+oclAllInstances+ from the context $\tau$. These rules are a special-case -in the sense that they are the only rules that relate statements with \emph{different} -$\tau$'s. For that reason, new concepts like ``constant contexts P'' are necessary -(for which we do not elaborate an own theory for reasons of space limitations; - in examples, we will prove resulting constraints straight forward by hand). *} - - -lemma state_update_vs_allInstances_generic_including': -assumes [simp]: "\<And>a. pre_post (mk a) = a" -assumes "\<And>x. \<sigma>' oid = Some x \<Longrightarrow> x = Object" - and "Type Object \<noteq> None" - shows "(OclAllInstances_generic pre_post Type) - (mk \<lparr>heap=\<sigma>'(oid\<mapsto>Object), assocs=A\<rparr>) - = - ((OclAllInstances_generic pre_post Type)->including\<^sub>S\<^sub>e\<^sub>t(\<lambda> _. \<lfloor>\<lfloor> the (Type Object) \<rfloor>\<rfloor>)) - (mk \<lparr>heap=\<sigma>',assocs=A\<rparr>)" -proof - - have drop_none : "\<And>x. x \<noteq> None \<Longrightarrow> \<lfloor>\<lceil>x\<rceil>\<rfloor> = x" - by(case_tac x, simp+) - - have insert_diff : "\<And>x S. insert \<lfloor>x\<rfloor> (S - {None}) = (insert \<lfloor>x\<rfloor> S) - {None}" - by (metis insert_Diff_if option.distinct(1) singletonE) - - show ?thesis - apply(simp add: UML_Set.OclIncluding_def OclAllInstances_generic_defined[simplified OclValid_def], - simp add: OclAllInstances_generic_def) - apply(subst Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inverse, simp add: bot_option_def, simp add: comp_def, - subst image_insert[symmetric], - subst drop_none, simp add: assms) - apply(case_tac "Type Object", simp add: assms, simp only:, - subst insert_diff, drule sym, simp) - apply(subgoal_tac "ran (\<sigma>'(oid \<mapsto> Object)) = insert Object (ran \<sigma>')", simp) - apply(case_tac "\<not> (\<exists>x. \<sigma>' oid = Some x)") - apply(rule ran_map_upd, simp) - apply(simp, erule exE, frule assms, simp) - apply(subgoal_tac "Object \<in> ran \<sigma>'") prefer 2 - apply(rule ranI, simp) - by(subst insert_absorb, simp, metis fun_upd_apply) - -qed - - -lemma state_update_vs_allInstances_generic_including: -assumes [simp]: "\<And>a. pre_post (mk a) = a" -assumes "\<And>x. \<sigma>' oid = Some x \<Longrightarrow> x = Object" - and "Type Object \<noteq> None" -shows "(OclAllInstances_generic pre_post Type) - (mk \<lparr>heap=\<sigma>'(oid\<mapsto>Object), assocs=A\<rparr>) - = - ((\<lambda>_. (OclAllInstances_generic pre_post Type) - (mk \<lparr>heap=\<sigma>', assocs=A\<rparr>))->including\<^sub>S\<^sub>e\<^sub>t(\<lambda> _. \<lfloor>\<lfloor> the (Type Object) \<rfloor>\<rfloor>)) - (mk \<lparr>heap=\<sigma>'(oid\<mapsto>Object), assocs=A\<rparr>)" - apply(subst state_update_vs_allInstances_generic_including', - simp add: assms, simp add: assms, simp add: assms, - subst UML_Set.OclIncluding.cp0, - simp add: UML_Set.OclIncluding_def) - apply(subst (1 3) cp_defined[symmetric], - simp add: OclAllInstances_generic_defined[simplified OclValid_def]) - - apply(simp add: defined_def OclValid_def OclAllInstances_generic_def invalid_def - bot_fun_def null_fun_def bot_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def null_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def) - apply(subst (1 3) Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inject) -by(simp add: bot_option_def null_option_def)+ - - - -lemma state_update_vs_allInstances_generic_noincluding': -assumes [simp]: "\<And>a. pre_post (mk a) = a" -assumes "\<And>x. \<sigma>' oid = Some x \<Longrightarrow> x = Object" - and "Type Object = None" - shows "(OclAllInstances_generic pre_post Type) - (mk \<lparr>heap=\<sigma>'(oid\<mapsto>Object), assocs=A\<rparr>) - = - (OclAllInstances_generic pre_post Type) - (mk \<lparr>heap=\<sigma>', assocs=A\<rparr>)" -proof - - have drop_none : "\<And>x. x \<noteq> None \<Longrightarrow> \<lfloor>\<lceil>x\<rceil>\<rfloor> = x" - by(case_tac x, simp+) - - have insert_diff : "\<And>x S. insert \<lfloor>x\<rfloor> (S - {None}) = (insert \<lfloor>x\<rfloor> S) - {None}" - by (metis insert_Diff_if option.distinct(1) singletonE) - - show ?thesis - apply(simp add: OclIncluding_def OclAllInstances_generic_defined[simplified OclValid_def] - OclAllInstances_generic_def) - apply(subgoal_tac "ran (\<sigma>'(oid \<mapsto> Object)) = insert Object (ran \<sigma>')", simp add: assms) - apply(case_tac "\<not> (\<exists>x. \<sigma>' oid = Some x)") - apply(rule ran_map_upd, simp) - apply(simp, erule exE, frule assms, simp) - apply(subgoal_tac "Object \<in> ran \<sigma>'") prefer 2 - apply(rule ranI, simp) - apply(subst insert_absorb, simp) - by (metis fun_upd_apply) -qed - -theorem state_update_vs_allInstances_generic_ntc: -assumes [simp]: "\<And>a. pre_post (mk a) = a" -assumes oid_def: "oid\<notin>dom \<sigma>'" -and non_type_conform: "Type Object = None " -and cp_ctxt: "cp P" -and const_ctxt: "\<And>X. const X \<Longrightarrow> const (P X)" -shows "(mk \<lparr>heap=\<sigma>'(oid\<mapsto>Object),assocs=A\<rparr> \<Turnstile> P (OclAllInstances_generic pre_post Type)) = - (mk \<lparr>heap=\<sigma>', assocs=A\<rparr> \<Turnstile> P (OclAllInstances_generic pre_post Type))" - (is "(?\<tau> \<Turnstile> P ?\<phi>) = (?\<tau>' \<Turnstile> P ?\<phi>)") -proof - - have P_cp : "\<And>x \<tau>. P x \<tau> = P (\<lambda>_. x \<tau>) \<tau>" - by (metis (full_types) cp_ctxt cp_def) - have A : "const (P (\<lambda>_. ?\<phi> ?\<tau>))" - by(simp add: const_ctxt const_ss) - have "(?\<tau> \<Turnstile> P ?\<phi>) = (?\<tau> \<Turnstile> \<lambda>_. P ?\<phi> ?\<tau>)" - by(subst foundation23, rule refl) - also have "... = (?\<tau> \<Turnstile> \<lambda>_. P (\<lambda>_. ?\<phi> ?\<tau>) ?\<tau>)" - by(subst P_cp, rule refl) - also have "... = (?\<tau>' \<Turnstile> \<lambda>_. P (\<lambda>_. ?\<phi> ?\<tau>) ?\<tau>')" - apply(simp add: OclValid_def) - by(subst A[simplified const_def], subst const_true[simplified const_def], simp) - finally have X: "(?\<tau> \<Turnstile> P ?\<phi>) = (?\<tau>' \<Turnstile> \<lambda>_. P (\<lambda>_. ?\<phi> ?\<tau>) ?\<tau>')" - by simp - show ?thesis - apply(subst X) apply(subst foundation23[symmetric]) - apply(rule StrongEq_L_subst3[OF cp_ctxt]) - apply(simp add: OclValid_def StrongEq_def true_def) - apply(rule state_update_vs_allInstances_generic_noincluding') - by(insert oid_def, auto simp: non_type_conform) -qed - -theorem state_update_vs_allInstances_generic_tc: -assumes [simp]: "\<And>a. pre_post (mk a) = a" -assumes oid_def: "oid\<notin>dom \<sigma>'" -and type_conform: "Type Object \<noteq> None " -and cp_ctxt: "cp P" -and const_ctxt: "\<And>X. const X \<Longrightarrow> const (P X)" -shows "(mk \<lparr>heap=\<sigma>'(oid\<mapsto>Object),assocs=A\<rparr> \<Turnstile> P (OclAllInstances_generic pre_post Type)) = - (mk \<lparr>heap=\<sigma>', assocs=A\<rparr> \<Turnstile> P ((OclAllInstances_generic pre_post Type) - ->including\<^sub>S\<^sub>e\<^sub>t(\<lambda> _. \<lfloor>(Type Object)\<rfloor>)))" - (is "(?\<tau> \<Turnstile> P ?\<phi>) = (?\<tau>' \<Turnstile> P ?\<phi>')") -proof - - have P_cp : "\<And>x \<tau>. P x \<tau> = P (\<lambda>_. x \<tau>) \<tau>" - by (metis (full_types) cp_ctxt cp_def) - have A : "const (P (\<lambda>_. ?\<phi> ?\<tau>))" - by(simp add: const_ctxt const_ss) - have "(?\<tau> \<Turnstile> P ?\<phi>) = (?\<tau> \<Turnstile> \<lambda>_. P ?\<phi> ?\<tau>)" - by(subst foundation23, rule refl) - also have "... = (?\<tau> \<Turnstile> \<lambda>_. P (\<lambda>_. ?\<phi> ?\<tau>) ?\<tau>)" - by(subst P_cp, rule refl) - also have "... = (?\<tau>' \<Turnstile> \<lambda>_. P (\<lambda>_. ?\<phi> ?\<tau>) ?\<tau>')" - apply(simp add: OclValid_def) - by(subst A[simplified const_def], subst const_true[simplified const_def], simp) - finally have X: "(?\<tau> \<Turnstile> P ?\<phi>) = (?\<tau>' \<Turnstile> \<lambda>_. P (\<lambda>_. ?\<phi> ?\<tau>) ?\<tau>')" - by simp - let ?allInstances = "OclAllInstances_generic pre_post Type" - have "?allInstances ?\<tau> = \<lambda>_. ?allInstances ?\<tau>'->including\<^sub>S\<^sub>e\<^sub>t(\<lambda>_.\<lfloor>\<lfloor>\<lceil>Type Object\<rceil>\<rfloor>\<rfloor>) ?\<tau>" - apply(rule state_update_vs_allInstances_generic_including) - by(insert oid_def, auto simp: type_conform) - also have "... = ((\<lambda>_. ?allInstances ?\<tau>')->including\<^sub>S\<^sub>e\<^sub>t(\<lambda>_. (\<lambda>_.\<lfloor>\<lfloor>\<lceil>Type Object\<rceil>\<rfloor>\<rfloor>) ?\<tau>') ?\<tau>')" - by(subst const_OclIncluding[simplified const_def], simp+) - also have "... = (?allInstances->including\<^sub>S\<^sub>e\<^sub>t(\<lambda> _. \<lfloor>Type Object\<rfloor>) ?\<tau>')" - apply(subst UML_Set.OclIncluding.cp0[symmetric]) - by(insert type_conform, auto) - finally have Y : "?allInstances ?\<tau> = (?allInstances->including\<^sub>S\<^sub>e\<^sub>t(\<lambda> _. \<lfloor>Type Object\<rfloor>) ?\<tau>')" - by auto - show ?thesis - apply(subst X) apply(subst foundation23[symmetric]) - apply(rule StrongEq_L_subst3[OF cp_ctxt]) - apply(simp add: OclValid_def StrongEq_def Y true_def) - done -qed - -declare OclAllInstances_generic_def [simp] - -subsubsection{* OclAllInstances (@post) *} - -definition OclAllInstances_at_post :: "('\<AA> :: object \<rightharpoonup> '\<alpha>) \<Rightarrow> ('\<AA>, '\<alpha> option option) Set" - ("_ .allInstances'(')") -where "OclAllInstances_at_post = OclAllInstances_generic snd" - -lemma OclAllInstances_at_post_defined: "\<tau> \<Turnstile> \<delta> (H .allInstances())" -unfolding OclAllInstances_at_post_def -by(rule OclAllInstances_generic_defined) - -lemma OclAllInstances_at_post_valid: "\<tau> \<Turnstile> \<upsilon> (H .allInstances())" -unfolding OclAllInstances_at_post_def -by(rule OclAllInstances_generic_valid) - -lemma "\<tau>\<^sub>0 \<Turnstile> H .allInstances() \<triangleq> Set{}" -unfolding OclAllInstances_at_post_def -by(rule OclAllInstances_generic_init_empty, simp) - - -lemma represented_at_post_objects_nonnull: -assumes A: "\<tau> \<Turnstile> (((H::('\<AA>::object \<rightharpoonup> '\<alpha>)).allInstances()) ->includes\<^sub>S\<^sub>e\<^sub>t(x))" -shows "\<tau> \<Turnstile> not(x \<triangleq> null)" -by(rule represented_generic_objects_nonnull[OF A[simplified OclAllInstances_at_post_def]]) - - -lemma represented_at_post_objects_defined: -assumes A: "\<tau> \<Turnstile> (((H::('\<AA>::object \<rightharpoonup> '\<alpha>)).allInstances()) ->includes\<^sub>S\<^sub>e\<^sub>t(x))" -shows "\<tau> \<Turnstile> \<delta> (H .allInstances()) \<and> \<tau> \<Turnstile> \<delta> x" -unfolding OclAllInstances_at_post_def -by(rule represented_generic_objects_defined[OF A[simplified OclAllInstances_at_post_def]]) - - -text{* One way to establish the actual presence of an object representation in a state is:*} - -lemma -assumes A: "\<tau> \<Turnstile> H .allInstances()->includes\<^sub>S\<^sub>e\<^sub>t(x)" -shows "is_represented_in_state snd x H \<tau>" -by(rule represented_generic_objects_in_state[OF A[simplified OclAllInstances_at_post_def]]) - -lemma state_update_vs_allInstances_at_post_empty: -shows "(\<sigma>, \<lparr>heap=Map.empty, assocs=A\<rparr>) \<Turnstile> Type .allInstances() \<doteq> Set{}" -unfolding OclAllInstances_at_post_def -by(rule state_update_vs_allInstances_generic_empty[OF snd_conv]) - -text{* Here comes a couple of operational rules that allow to infer the value -of \inlineisar+oclAllInstances+ from the context $\tau$. These rules are a special-case -in the sense that they are the only rules that relate statements with \emph{different} -$\tau$'s. For that reason, new concepts like ``constant contexts P'' are necessary -(for which we do not elaborate an own theory for reasons of space limitations; - in examples, we will prove resulting constraints straight forward by hand). *} - - -lemma state_update_vs_allInstances_at_post_including': -assumes "\<And>x. \<sigma>' oid = Some x \<Longrightarrow> x = Object" - and "Type Object \<noteq> None" - shows "(Type .allInstances()) - (\<sigma>, \<lparr>heap=\<sigma>'(oid\<mapsto>Object), assocs=A\<rparr>) - = - ((Type .allInstances())->including\<^sub>S\<^sub>e\<^sub>t(\<lambda> _. \<lfloor>\<lfloor> the (Type Object) \<rfloor>\<rfloor>)) - (\<sigma>, \<lparr>heap=\<sigma>',assocs=A\<rparr>)" -unfolding OclAllInstances_at_post_def -by(rule state_update_vs_allInstances_generic_including'[OF snd_conv], insert assms) - - -lemma state_update_vs_allInstances_at_post_including: -assumes "\<And>x. \<sigma>' oid = Some x \<Longrightarrow> x = Object" - and "Type Object \<noteq> None" -shows "(Type .allInstances()) - (\<sigma>, \<lparr>heap=\<sigma>'(oid\<mapsto>Object), assocs=A\<rparr>) - = - ((\<lambda>_. (Type .allInstances()) - (\<sigma>, \<lparr>heap=\<sigma>', assocs=A\<rparr>))->including\<^sub>S\<^sub>e\<^sub>t(\<lambda> _. \<lfloor>\<lfloor> the (Type Object) \<rfloor>\<rfloor>)) - (\<sigma>, \<lparr>heap=\<sigma>'(oid\<mapsto>Object), assocs=A\<rparr>)" -unfolding OclAllInstances_at_post_def -by(rule state_update_vs_allInstances_generic_including[OF snd_conv], insert assms) - - - -lemma state_update_vs_allInstances_at_post_noincluding': -assumes "\<And>x. \<sigma>' oid = Some x \<Longrightarrow> x = Object" - and "Type Object = None" - shows "(Type .allInstances()) - (\<sigma>, \<lparr>heap=\<sigma>'(oid\<mapsto>Object), assocs=A\<rparr>) - = - (Type .allInstances()) - (\<sigma>, \<lparr>heap=\<sigma>', assocs=A\<rparr>)" -unfolding OclAllInstances_at_post_def -by(rule state_update_vs_allInstances_generic_noincluding'[OF snd_conv], insert assms) - -theorem state_update_vs_allInstances_at_post_ntc: -assumes oid_def: "oid\<notin>dom \<sigma>'" -and non_type_conform: "Type Object = None " -and cp_ctxt: "cp P" -and const_ctxt: "\<And>X. const X \<Longrightarrow> const (P X)" -shows "((\<sigma>, \<lparr>heap=\<sigma>'(oid\<mapsto>Object),assocs=A\<rparr>) \<Turnstile> (P(Type .allInstances()))) = - ((\<sigma>, \<lparr>heap=\<sigma>', assocs=A\<rparr>) \<Turnstile> (P(Type .allInstances())))" -unfolding OclAllInstances_at_post_def -by(rule state_update_vs_allInstances_generic_ntc[OF snd_conv], insert assms) - -theorem state_update_vs_allInstances_at_post_tc: -assumes oid_def: "oid\<notin>dom \<sigma>'" -and type_conform: "Type Object \<noteq> None " -and cp_ctxt: "cp P" -and const_ctxt: "\<And>X. const X \<Longrightarrow> const (P X)" -shows "((\<sigma>, \<lparr>heap=\<sigma>'(oid\<mapsto>Object),assocs=A\<rparr>) \<Turnstile> (P(Type .allInstances()))) = - ((\<sigma>, \<lparr>heap=\<sigma>', assocs=A\<rparr>) \<Turnstile> (P((Type .allInstances()) - ->including\<^sub>S\<^sub>e\<^sub>t(\<lambda> _. \<lfloor>(Type Object)\<rfloor>))))" -unfolding OclAllInstances_at_post_def -by(rule state_update_vs_allInstances_generic_tc[OF snd_conv], insert assms) - -subsubsection{* OclAllInstances (@pre) *} - -definition OclAllInstances_at_pre :: "('\<AA> :: object \<rightharpoonup> '\<alpha>) \<Rightarrow> ('\<AA>, '\<alpha> option option) Set" - ("_ .allInstances@pre'(')") -where "OclAllInstances_at_pre = OclAllInstances_generic fst" - -lemma OclAllInstances_at_pre_defined: "\<tau> \<Turnstile> \<delta> (H .allInstances@pre())" -unfolding OclAllInstances_at_pre_def -by(rule OclAllInstances_generic_defined) - -lemma OclAllInstances_at_pre_valid: "\<tau> \<Turnstile> \<upsilon> (H .allInstances@pre())" -unfolding OclAllInstances_at_pre_def -by(rule OclAllInstances_generic_valid) - -lemma "\<tau>\<^sub>0 \<Turnstile> H .allInstances@pre() \<triangleq> Set{}" -unfolding OclAllInstances_at_pre_def -by(rule OclAllInstances_generic_init_empty, simp) - - -lemma represented_at_pre_objects_nonnull: -assumes A: "\<tau> \<Turnstile> (((H::('\<AA>::object \<rightharpoonup> '\<alpha>)).allInstances@pre()) ->includes\<^sub>S\<^sub>e\<^sub>t(x))" -shows "\<tau> \<Turnstile> not(x \<triangleq> null)" -by(rule represented_generic_objects_nonnull[OF A[simplified OclAllInstances_at_pre_def]]) - -lemma represented_at_pre_objects_defined: -assumes A: "\<tau> \<Turnstile> (((H::('\<AA>::object \<rightharpoonup> '\<alpha>)).allInstances@pre()) ->includes\<^sub>S\<^sub>e\<^sub>t(x))" -shows "\<tau> \<Turnstile> \<delta> (H .allInstances@pre()) \<and> \<tau> \<Turnstile> \<delta> x" -unfolding OclAllInstances_at_pre_def -by(rule represented_generic_objects_defined[OF A[simplified OclAllInstances_at_pre_def]]) - - -text{* One way to establish the actual presence of an object representation in a state is:*} - -lemma -assumes A: "\<tau> \<Turnstile> H .allInstances@pre()->includes\<^sub>S\<^sub>e\<^sub>t(x)" -shows "is_represented_in_state fst x H \<tau>" -by(rule represented_generic_objects_in_state[OF A[simplified OclAllInstances_at_pre_def]]) - - -lemma state_update_vs_allInstances_at_pre_empty: -shows "(\<lparr>heap=Map.empty, assocs=A\<rparr>, \<sigma>) \<Turnstile> Type .allInstances@pre() \<doteq> Set{}" -unfolding OclAllInstances_at_pre_def -by(rule state_update_vs_allInstances_generic_empty[OF fst_conv]) - -text{* Here comes a couple of operational rules that allow to infer the value -of \inlineisar+oclAllInstances@pre+ from the context $\tau$. These rules are a special-case -in the sense that they are the only rules that relate statements with \emph{different} -$\tau$'s. For that reason, new concepts like ``constant contexts P'' are necessary -(for which we do not elaborate an own theory for reasons of space limitations; - in examples, we will prove resulting constraints straight forward by hand). *} - - -lemma state_update_vs_allInstances_at_pre_including': -assumes "\<And>x. \<sigma>' oid = Some x \<Longrightarrow> x = Object" - and "Type Object \<noteq> None" - shows "(Type .allInstances@pre()) - (\<lparr>heap=\<sigma>'(oid\<mapsto>Object), assocs=A\<rparr>, \<sigma>) - = - ((Type .allInstances@pre())->including\<^sub>S\<^sub>e\<^sub>t(\<lambda> _. \<lfloor>\<lfloor> the (Type Object) \<rfloor>\<rfloor>)) - (\<lparr>heap=\<sigma>',assocs=A\<rparr>, \<sigma>)" -unfolding OclAllInstances_at_pre_def -by(rule state_update_vs_allInstances_generic_including'[OF fst_conv], insert assms) - - -lemma state_update_vs_allInstances_at_pre_including: -assumes "\<And>x. \<sigma>' oid = Some x \<Longrightarrow> x = Object" - and "Type Object \<noteq> None" -shows "(Type .allInstances@pre()) - (\<lparr>heap=\<sigma>'(oid\<mapsto>Object), assocs=A\<rparr>, \<sigma>) - = - ((\<lambda>_. (Type .allInstances@pre()) - (\<lparr>heap=\<sigma>', assocs=A\<rparr>, \<sigma>))->including\<^sub>S\<^sub>e\<^sub>t(\<lambda> _. \<lfloor>\<lfloor> the (Type Object) \<rfloor>\<rfloor>)) - (\<lparr>heap=\<sigma>'(oid\<mapsto>Object), assocs=A\<rparr>, \<sigma>)" -unfolding OclAllInstances_at_pre_def -by(rule state_update_vs_allInstances_generic_including[OF fst_conv], insert assms) - - - -lemma state_update_vs_allInstances_at_pre_noincluding': -assumes "\<And>x. \<sigma>' oid = Some x \<Longrightarrow> x = Object" - and "Type Object = None" - shows "(Type .allInstances@pre()) - (\<lparr>heap=\<sigma>'(oid\<mapsto>Object), assocs=A\<rparr>, \<sigma>) - = - (Type .allInstances@pre()) - (\<lparr>heap=\<sigma>', assocs=A\<rparr>, \<sigma>)" -unfolding OclAllInstances_at_pre_def -by(rule state_update_vs_allInstances_generic_noincluding'[OF fst_conv], insert assms) - -theorem state_update_vs_allInstances_at_pre_ntc: -assumes oid_def: "oid\<notin>dom \<sigma>'" -and non_type_conform: "Type Object = None " -and cp_ctxt: "cp P" -and const_ctxt: "\<And>X. const X \<Longrightarrow> const (P X)" -shows "((\<lparr>heap=\<sigma>'(oid\<mapsto>Object),assocs=A\<rparr>, \<sigma>) \<Turnstile> (P(Type .allInstances@pre()))) = - ((\<lparr>heap=\<sigma>', assocs=A\<rparr>, \<sigma>) \<Turnstile> (P(Type .allInstances@pre())))" -unfolding OclAllInstances_at_pre_def -by(rule state_update_vs_allInstances_generic_ntc[OF fst_conv], insert assms) - -theorem state_update_vs_allInstances_at_pre_tc: -assumes oid_def: "oid\<notin>dom \<sigma>'" -and type_conform: "Type Object \<noteq> None " -and cp_ctxt: "cp P" -and const_ctxt: "\<And>X. const X \<Longrightarrow> const (P X)" -shows "((\<lparr>heap=\<sigma>'(oid\<mapsto>Object),assocs=A\<rparr>, \<sigma>) \<Turnstile> (P(Type .allInstances@pre()))) = - ((\<lparr>heap=\<sigma>', assocs=A\<rparr>, \<sigma>) \<Turnstile> (P((Type .allInstances@pre()) - ->including\<^sub>S\<^sub>e\<^sub>t(\<lambda> _. \<lfloor>(Type Object)\<rfloor>))))" -unfolding OclAllInstances_at_pre_def -by(rule state_update_vs_allInstances_generic_tc[OF fst_conv], insert assms) - -subsubsection{* @post or @pre *} - -theorem StrictRefEq\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_vs_StrongEq'': -assumes WFF: "WFF \<tau>" -and valid_x: "\<tau> \<Turnstile>(\<upsilon> (x :: ('\<AA>::object,'\<alpha>::object option option)val))" -and valid_y: "\<tau> \<Turnstile>(\<upsilon> y)" -and oid_preserve: "\<And>x. x \<in> ran (heap(fst \<tau>)) \<or> x \<in> ran (heap(snd \<tau>)) \<Longrightarrow> - oid_of (H x) = oid_of x" -and xy_together: "\<tau> \<Turnstile> ((H .allInstances()->includes\<^sub>S\<^sub>e\<^sub>t(x) and H .allInstances()->includes\<^sub>S\<^sub>e\<^sub>t(y)) or - (H .allInstances@pre()->includes\<^sub>S\<^sub>e\<^sub>t(x) and H .allInstances@pre()->includes\<^sub>S\<^sub>e\<^sub>t(y)))" - (* x and y must be object representations that exist in either the pre or post state *) -shows "(\<tau> \<Turnstile> (StrictRefEq\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t x y)) = (\<tau> \<Turnstile> (x \<triangleq> y))" -proof - - have at_post_def : "\<And>x. \<tau> \<Turnstile> \<upsilon> x \<Longrightarrow> \<tau> \<Turnstile> \<delta> (H .allInstances()->includes\<^sub>S\<^sub>e\<^sub>t(x))" - apply(simp add: OclIncludes_def OclValid_def - OclAllInstances_at_post_defined[simplified OclValid_def]) - by(subst cp_defined, simp) - have at_pre_def : "\<And>x. \<tau> \<Turnstile> \<upsilon> x \<Longrightarrow> \<tau> \<Turnstile> \<delta> (H .allInstances@pre()->includes\<^sub>S\<^sub>e\<^sub>t(x))" - apply(simp add: OclIncludes_def OclValid_def - OclAllInstances_at_pre_defined[simplified OclValid_def]) - by(subst cp_defined, simp) - have F: "Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e \<lfloor>\<lfloor>Some ` (H ` ran (heap (fst \<tau>)) - {None})\<rfloor>\<rfloor>) = - \<lfloor>\<lfloor>Some ` (H ` ran (heap (fst \<tau>)) - {None})\<rfloor>\<rfloor>" - by(subst Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e.Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inverse,simp_all add: bot_option_def) - have F': "Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e \<lfloor>\<lfloor>Some ` (H ` ran (heap (snd \<tau>)) - {None})\<rfloor>\<rfloor>) = - \<lfloor>\<lfloor>Some ` (H ` ran (heap (snd \<tau>)) - {None})\<rfloor>\<rfloor>" - by(subst Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e.Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inverse,simp_all add: bot_option_def) - show ?thesis - apply(rule StrictRefEq\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_vs_StrongEq'[OF WFF valid_x valid_y, where H = "Some o H"]) - apply(subst oid_preserve[symmetric], simp, simp add: oid_of_option_def) - apply(insert xy_together, - subst (asm) foundation11, - metis at_post_def defined_and_I valid_x valid_y, - metis at_pre_def defined_and_I valid_x valid_y) - apply(erule disjE) - by(drule foundation5, - simp add: OclAllInstances_at_pre_def OclAllInstances_at_post_def - OclValid_def OclIncludes_def true_def F F' - valid_x[simplified OclValid_def] valid_y[simplified OclValid_def] bot_option_def - split: if_split_asm, - simp add: comp_def image_def, fastforce)+ -qed - -subsection{* OclIsNew, OclIsDeleted, OclIsMaintained, OclIsAbsent *} - -definition OclIsNew:: "('\<AA>, '\<alpha>::{null,object})val \<Rightarrow> ('\<AA>)Boolean" ("(_).oclIsNew'(')") -where "X .oclIsNew() \<equiv> (\<lambda>\<tau> . if (\<delta> X) \<tau> = true \<tau> - then \<lfloor>\<lfloor>oid_of (X \<tau>) \<notin> dom(heap(fst \<tau>)) \<and> - oid_of (X \<tau>) \<in> dom(heap(snd \<tau>))\<rfloor>\<rfloor> - else invalid \<tau>)" - -text{* The following predicates --- which are not part of the OCL standard descriptions --- -complete the goal of \inlineisar+oclIsNew+ by describing where an object belongs. -*} - -definition OclIsDeleted:: "('\<AA>, '\<alpha>::{null,object})val \<Rightarrow> ('\<AA>)Boolean" ("(_).oclIsDeleted'(')") -where "X .oclIsDeleted() \<equiv> (\<lambda>\<tau> . if (\<delta> X) \<tau> = true \<tau> - then \<lfloor>\<lfloor>oid_of (X \<tau>) \<in> dom(heap(fst \<tau>)) \<and> - oid_of (X \<tau>) \<notin> dom(heap(snd \<tau>))\<rfloor>\<rfloor> - else invalid \<tau>)" - -definition OclIsMaintained:: "('\<AA>, '\<alpha>::{null,object})val \<Rightarrow> ('\<AA>)Boolean"("(_).oclIsMaintained'(')") -where "X .oclIsMaintained() \<equiv> (\<lambda>\<tau> . if (\<delta> X) \<tau> = true \<tau> - then \<lfloor>\<lfloor>oid_of (X \<tau>) \<in> dom(heap(fst \<tau>)) \<and> - oid_of (X \<tau>) \<in> dom(heap(snd \<tau>))\<rfloor>\<rfloor> - else invalid \<tau>)" - -definition OclIsAbsent:: "('\<AA>, '\<alpha>::{null,object})val \<Rightarrow> ('\<AA>)Boolean" ("(_).oclIsAbsent'(')") -where "X .oclIsAbsent() \<equiv> (\<lambda>\<tau> . if (\<delta> X) \<tau> = true \<tau> - then \<lfloor>\<lfloor>oid_of (X \<tau>) \<notin> dom(heap(fst \<tau>)) \<and> - oid_of (X \<tau>) \<notin> dom(heap(snd \<tau>))\<rfloor>\<rfloor> - else invalid \<tau>)" - -lemma state_split : "\<tau> \<Turnstile> \<delta> X \<Longrightarrow> - \<tau> \<Turnstile> (X .oclIsNew()) \<or> \<tau> \<Turnstile> (X .oclIsDeleted()) \<or> - \<tau> \<Turnstile> (X .oclIsMaintained()) \<or> \<tau> \<Turnstile> (X .oclIsAbsent())" -by(simp add: OclIsDeleted_def OclIsNew_def OclIsMaintained_def OclIsAbsent_def - OclValid_def true_def, blast) - -lemma notNew_vs_others : "\<tau> \<Turnstile> \<delta> X \<Longrightarrow> - (\<not> \<tau> \<Turnstile> (X .oclIsNew())) = (\<tau> \<Turnstile> (X .oclIsDeleted()) \<or> - \<tau> \<Turnstile> (X .oclIsMaintained()) \<or> \<tau> \<Turnstile> (X .oclIsAbsent()))" -by(simp add: OclIsDeleted_def OclIsNew_def OclIsMaintained_def OclIsAbsent_def - OclNot_def OclValid_def true_def, blast) - -subsection{* OclIsModifiedOnly *} -subsubsection{* Definition *} - -text{* The following predicate---which is not part of the OCL -standard---provides a simple, but powerful means to describe framing -conditions. For any formal approach, be it animation of OCL contracts, -test-case generation or die-hard theorem proving, the specification of -the part of a system transition that \emph{does not change} is of -primordial importance. The following operator establishes the equality -between old and new objects in the state (provided that they exist in -both states), with the exception of those objects. *} - -definition OclIsModifiedOnly ::"('\<AA>::object,'\<alpha>::{null,object})Set \<Rightarrow> '\<AA> Boolean" - ("_->oclIsModifiedOnly'(')") -where "X->oclIsModifiedOnly() \<equiv> (\<lambda>(\<sigma>,\<sigma>'). - let X' = (oid_of ` \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e(X(\<sigma>,\<sigma>'))\<rceil>\<rceil>); - S = ((dom (heap \<sigma>) \<inter> dom (heap \<sigma>')) - X') - in if (\<delta> X) (\<sigma>,\<sigma>') = true (\<sigma>,\<sigma>') \<and> (\<forall>x\<in>\<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e(X(\<sigma>,\<sigma>'))\<rceil>\<rceil>. x \<noteq> null) - then \<lfloor>\<lfloor>\<forall> x \<in> S. (heap \<sigma>) x = (heap \<sigma>') x\<rfloor>\<rfloor> - else invalid (\<sigma>,\<sigma>'))" - -subsubsection{* Execution with Invalid or Null or Null Element as Argument *} - -lemma "invalid->oclIsModifiedOnly() = invalid" -by(simp add: OclIsModifiedOnly_def) - -lemma "null->oclIsModifiedOnly() = invalid" -by(simp add: OclIsModifiedOnly_def) - -lemma - assumes X_null : "\<tau> \<Turnstile> X->includes\<^sub>S\<^sub>e\<^sub>t(null)" - shows "\<tau> \<Turnstile> X->oclIsModifiedOnly() \<triangleq> invalid" - apply(insert X_null, - simp add : OclIncludes_def OclIsModifiedOnly_def StrongEq_def OclValid_def true_def) - apply(case_tac \<tau>, simp) - apply(simp split: if_split_asm) -by(simp add: null_fun_def, blast) - -subsubsection{* Context Passing *} - -lemma cp_OclIsModifiedOnly : "X->oclIsModifiedOnly() \<tau> = (\<lambda>_. X \<tau>)->oclIsModifiedOnly() \<tau>" -by(simp only: OclIsModifiedOnly_def, case_tac \<tau>, simp only:, subst cp_defined, simp) - -subsection{* OclSelf *} - -text{* The following predicate---which is not part of the OCL -standard---explicitly retrieves in the pre or post state the original OCL expression -given as argument. *} - -definition [simp]: "OclSelf x H fst_snd = (\<lambda>\<tau> . if (\<delta> x) \<tau> = true \<tau> - then if oid_of (x \<tau>) \<in> dom(heap(fst \<tau>)) \<and> oid_of (x \<tau>) \<in> dom(heap (snd \<tau>)) - then H \<lceil>(heap(fst_snd \<tau>))(oid_of (x \<tau>))\<rceil> - else invalid \<tau> - else invalid \<tau>)" - -definition OclSelf_at_pre :: "('\<AA>::object,'\<alpha>::{null,object})val \<Rightarrow> - ('\<AA> \<Rightarrow> '\<alpha>) \<Rightarrow> - ('\<AA>::object,'\<alpha>::{null,object})val" ("(_)@pre(_)") -where "x @pre H = OclSelf x H fst" - -definition OclSelf_at_post :: "('\<AA>::object,'\<alpha>::{null,object})val \<Rightarrow> - ('\<AA> \<Rightarrow> '\<alpha>) \<Rightarrow> - ('\<AA>::object,'\<alpha>::{null,object})val" ("(_)@post(_)") -where "x @post H = OclSelf x H snd" - -subsection{* Framing Theorem *} - -lemma all_oid_diff: - assumes def_x : "\<tau> \<Turnstile> \<delta> x" - assumes def_X : "\<tau> \<Turnstile> \<delta> X" - assumes def_X' : "\<And>x. x \<in> \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (X \<tau>)\<rceil>\<rceil> \<Longrightarrow> x \<noteq> null" - - defines "P \<equiv> (\<lambda>a. not (StrictRefEq\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t x a))" - shows "(\<tau> \<Turnstile> X->forAll\<^sub>S\<^sub>e\<^sub>t(a| P a)) = (oid_of (x \<tau>) \<notin> oid_of ` \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (X \<tau>)\<rceil>\<rceil>)" -proof - - have P_null_bot: "\<And>b. b = null \<or> b = \<bottom> \<Longrightarrow> - \<not> (\<exists>x\<in>\<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (X \<tau>)\<rceil>\<rceil>. P (\<lambda>(_:: 'a state \<times> 'a state). x) \<tau> = b \<tau>)" - apply(erule disjE) - apply(simp, rule ballI, - simp add: P_def StrictRefEq\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_def, rename_tac x', - subst cp_OclNot, simp, - subgoal_tac "x \<tau> \<noteq> null \<and> x' \<noteq> null", simp, - simp add: OclNot_def null_fun_def null_option_def bot_option_def bot_fun_def invalid_def, - ( metis def_X' def_x foundation16[THEN iffD1] - | (metis bot_fun_def OclValid_def Set_inv_lemma def_X def_x defined_def valid_def, - metis def_X' def_x foundation16[THEN iffD1])))+ - done - - - have not_inj : "\<And>x y. ((not x) \<tau> = (not y) \<tau>) = (x \<tau> = y \<tau>)" - by (metis foundation21 foundation22) - - have P_false : "\<exists>x\<in>\<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (X \<tau>)\<rceil>\<rceil>. P (\<lambda>_. x) \<tau> = false \<tau> \<Longrightarrow> - oid_of (x \<tau>) \<in> oid_of ` \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (X \<tau>)\<rceil>\<rceil>" - apply(erule bexE, rename_tac x') - apply(simp add: P_def) - apply(simp only: OclNot3[symmetric], simp only: not_inj) - apply(simp add: StrictRefEq\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_def split: if_split_asm) - apply(subgoal_tac "x \<tau> \<noteq> null \<and> x' \<noteq> null", simp) - using def_X' def_x foundation16 apply blast - by(simp add: invalid_def bot_option_def true_def)+ - - have P_true : "\<forall>x\<in>\<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (X \<tau>)\<rceil>\<rceil>. P (\<lambda>_. x) \<tau> = true \<tau> \<Longrightarrow> - oid_of (x \<tau>) \<notin> oid_of ` \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (X \<tau>)\<rceil>\<rceil>" - apply(subgoal_tac "\<forall>x'\<in>\<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (X \<tau>)\<rceil>\<rceil>. oid_of x' \<noteq> oid_of (x \<tau>)") - apply (metis imageE) - apply(rule ballI, drule_tac x = "x'" in ballE) prefer 3 apply assumption - apply(simp add: P_def) - apply(simp only: OclNot4[symmetric], simp only: not_inj) - apply(simp add: StrictRefEq\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_def false_def split: if_split_asm) - apply(subgoal_tac "x \<tau> \<noteq> null \<and> x' \<noteq> null", simp) - apply (metis def_X' def_x foundation16[THEN iffD1]) - by(simp add: invalid_def bot_option_def false_def)+ - - have bool_split : "\<forall>x\<in>\<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (X \<tau>)\<rceil>\<rceil>. P (\<lambda>_. x) \<tau> \<noteq> null \<tau> \<Longrightarrow> - \<forall>x\<in>\<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (X \<tau>)\<rceil>\<rceil>. P (\<lambda>_. x) \<tau> \<noteq> \<bottom> \<tau> \<Longrightarrow> - \<forall>x\<in>\<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (X \<tau>)\<rceil>\<rceil>. P (\<lambda>_. x) \<tau> \<noteq> false \<tau> \<Longrightarrow> - \<forall>x\<in>\<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (X \<tau>)\<rceil>\<rceil>. P (\<lambda>_. x) \<tau> = true \<tau>" - apply(rule ballI) - apply(drule_tac x = x in ballE) prefer 3 apply assumption - apply(drule_tac x = x in ballE) prefer 3 apply assumption - apply(drule_tac x = x in ballE) prefer 3 apply assumption - apply (metis (full_types) bot_fun_def OclNot4 OclValid_def foundation16 - foundation9 not_inj null_fun_def) - by(fast+) - - show ?thesis - apply(subst OclForall_rep_set_true[OF def_X], simp add: OclValid_def) - apply(rule iffI, simp add: P_true) - by (metis P_false P_null_bot bool_split) -qed - -theorem framing: - assumes modifiesclause:"\<tau> \<Turnstile> (X->excluding\<^sub>S\<^sub>e\<^sub>t(x))->oclIsModifiedOnly()" - and oid_is_typerepr : "\<tau> \<Turnstile> X->forAll\<^sub>S\<^sub>e\<^sub>t(a| not (StrictRefEq\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t x a))" - shows "\<tau> \<Turnstile> (x @pre P \<triangleq> (x @post P))" - apply(case_tac "\<tau> \<Turnstile> \<delta> x") - proof - show "\<tau> \<Turnstile> \<delta> x \<Longrightarrow> ?thesis" proof - assume def_x : "\<tau> \<Turnstile> \<delta> x" show ?thesis proof - - - have def_X : "\<tau> \<Turnstile> \<delta> X" - apply(insert oid_is_typerepr, simp add: UML_Set.OclForall_def OclValid_def split: if_split_asm) - by(simp add: bot_option_def true_def) - - have def_X' : "\<And>x. x \<in> \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (X \<tau>)\<rceil>\<rceil> \<Longrightarrow> x \<noteq> null" - apply(insert modifiesclause, simp add: OclIsModifiedOnly_def OclValid_def split: if_split_asm) - apply(case_tac \<tau>, simp split: if_split_asm) - apply(simp add: UML_Set.OclExcluding_def split: if_split_asm) - apply(subst (asm) (2) Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inverse) - apply(simp, (rule disjI2)+) - apply (metis (hide_lams, mono_tags) Diff_iff Set_inv_lemma def_X) - apply(simp) - apply(erule ballE[where P = "\<lambda>x. x \<noteq> null"]) apply(assumption) - apply(simp) - apply (metis (hide_lams, no_types) def_x foundation16[THEN iffD1]) - apply (metis (hide_lams, no_types) OclValid_def def_X def_x foundation20 - OclExcluding_valid_args_valid OclExcluding_valid_args_valid'') - by(simp add: invalid_def bot_option_def) - - have oid_is_typerepr : "oid_of (x \<tau>) \<notin> oid_of ` \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (X \<tau>)\<rceil>\<rceil>" - by(rule all_oid_diff[THEN iffD1, OF def_x def_X def_X' oid_is_typerepr]) - - show ?thesis - apply(simp add: StrongEq_def OclValid_def true_def OclSelf_at_pre_def OclSelf_at_post_def - def_x[simplified OclValid_def]) - apply(rule conjI, rule impI) - apply(rule_tac f = "\<lambda>x. P \<lceil>x\<rceil>" in arg_cong) - apply(insert modifiesclause[simplified OclIsModifiedOnly_def OclValid_def]) - apply(case_tac \<tau>, rename_tac \<sigma> \<sigma>', simp split: if_split_asm) - apply(subst (asm) (2) UML_Set.OclExcluding_def) - apply(drule foundation5[simplified OclValid_def true_def], simp) - apply(subst (asm) Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inverse, simp) - apply(rule disjI2)+ - apply (metis (hide_lams, no_types) DiffD1 OclValid_def Set_inv_lemma def_x - foundation16 foundation18') - apply(simp) - apply(erule_tac x = "oid_of (x (\<sigma>, \<sigma>'))" in ballE) apply simp+ - apply (metis (hide_lams, no_types) - DiffD1 image_iff image_insert insert_Diff_single insert_absorb oid_is_typerepr) - apply(simp add: invalid_def bot_option_def)+ - by blast - qed qed -qed(simp add: OclSelf_at_post_def OclSelf_at_pre_def OclValid_def StrongEq_def true_def)+ - -text{* As corollary, the framing property can be expressed with only the strong equality -as comparison operator. *} - -theorem framing': - assumes wff : "WFF \<tau>" - assumes modifiesclause:"\<tau> \<Turnstile> (X->excluding\<^sub>S\<^sub>e\<^sub>t(x))->oclIsModifiedOnly()" - and oid_is_typerepr : "\<tau> \<Turnstile> X->forAll\<^sub>S\<^sub>e\<^sub>t(a| not (x \<triangleq> a))" - and oid_preserve: "\<And>x. x \<in> ran (heap(fst \<tau>)) \<or> x \<in> ran (heap(snd \<tau>)) \<Longrightarrow> - oid_of (H x) = oid_of x" - and xy_together: - "\<tau> \<Turnstile> X->forAll\<^sub>S\<^sub>e\<^sub>t(y | (H .allInstances()->includes\<^sub>S\<^sub>e\<^sub>t(x) and H .allInstances()->includes\<^sub>S\<^sub>e\<^sub>t(y)) or - (H .allInstances@pre()->includes\<^sub>S\<^sub>e\<^sub>t(x) and H .allInstances@pre()->includes\<^sub>S\<^sub>e\<^sub>t(y)))" - shows "\<tau> \<Turnstile> (x @pre P \<triangleq> (x @post P))" -proof - - have def_X : "\<tau> \<Turnstile> \<delta> X" - apply(insert oid_is_typerepr, simp add: UML_Set.OclForall_def OclValid_def split: if_split_asm) - by(simp add: bot_option_def true_def) - show ?thesis - apply(case_tac "\<tau> \<Turnstile> \<delta> x", drule foundation20) - apply(rule framing[OF modifiesclause]) - apply(rule OclForall_cong'[OF _ oid_is_typerepr xy_together], rename_tac y) - apply(cut_tac Set_inv_lemma'[OF def_X]) prefer 2 apply assumption - apply(rule OclNot_contrapos_nn, simp add: StrictRefEq\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_def) - apply(simp add: OclValid_def, subst cp_defined, simp, - assumption) - apply(rule StrictRefEq\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_vs_StrongEq''[THEN iffD1, OF wff _ _ oid_preserve], assumption+) - by(simp add: OclSelf_at_post_def OclSelf_at_pre_def OclValid_def StrongEq_def true_def)+ -qed - -theorem framing'': - assumes wff: "WFF \<tau>" - assumes modifiesNothing:"\<tau> \<Turnstile> (Set{})->oclIsModifiedOnly()" - shows "fst \<tau> = snd \<tau>" -oops - -subsection{* Miscellaneous *} - -lemma pre_post_new: "\<tau> \<Turnstile> (x .oclIsNew()) \<Longrightarrow> \<not> (\<tau> \<Turnstile> \<upsilon>(x @pre H1)) \<and> \<not> (\<tau> \<Turnstile> \<upsilon>(x @post H2))" -by(simp add: OclIsNew_def OclSelf_at_pre_def OclSelf_at_post_def - OclValid_def StrongEq_def true_def false_def - bot_option_def invalid_def bot_fun_def valid_def - split: if_split_asm) - -lemma pre_post_old: "\<tau> \<Turnstile> (x .oclIsDeleted()) \<Longrightarrow> \<not> (\<tau> \<Turnstile> \<upsilon>(x @pre H1)) \<and> \<not> (\<tau> \<Turnstile> \<upsilon>(x @post H2))" -by(simp add: OclIsDeleted_def OclSelf_at_pre_def OclSelf_at_post_def - OclValid_def StrongEq_def true_def false_def - bot_option_def invalid_def bot_fun_def valid_def - split: if_split_asm) - -lemma pre_post_absent: "\<tau> \<Turnstile> (x .oclIsAbsent()) \<Longrightarrow> \<not> (\<tau> \<Turnstile> \<upsilon>(x @pre H1)) \<and> \<not> (\<tau> \<Turnstile> \<upsilon>(x @post H2))" -by(simp add: OclIsAbsent_def OclSelf_at_pre_def OclSelf_at_post_def - OclValid_def StrongEq_def true_def false_def - bot_option_def invalid_def bot_fun_def valid_def - split: if_split_asm) - -lemma pre_post_maintained: "(\<tau> \<Turnstile> \<upsilon>(x @pre H1) \<or> \<tau> \<Turnstile> \<upsilon>(x @post H2)) \<Longrightarrow> \<tau> \<Turnstile> (x .oclIsMaintained())" -by(simp add: OclIsMaintained_def OclSelf_at_pre_def OclSelf_at_post_def - OclValid_def StrongEq_def true_def false_def - bot_option_def invalid_def bot_fun_def valid_def - split: if_split_asm) - -lemma pre_post_maintained': -"\<tau> \<Turnstile> (x .oclIsMaintained()) \<Longrightarrow> (\<tau> \<Turnstile> \<upsilon>(x @pre (Some o H1)) \<and> \<tau> \<Turnstile> \<upsilon>(x @post (Some o H2)))" -by(simp add: OclIsMaintained_def OclSelf_at_pre_def OclSelf_at_post_def - OclValid_def StrongEq_def true_def false_def - bot_option_def invalid_def bot_fun_def valid_def - split: if_split_asm) - -lemma framing_same_state: "(\<sigma>, \<sigma>) \<Turnstile> (x @pre H \<triangleq> (x @post H))" -by(simp add: OclSelf_at_pre_def OclSelf_at_post_def OclValid_def StrongEq_def) - -section{* Accessors on Object *} -subsection{* Definition *} - -definition "select_object mt incl smash deref l = smash (foldl incl mt (map deref l)) - \<comment> \<open>smash returns null with \<open>mt\<close> in input (in this case, object contains null pointer)\<close>" - -text{* The continuation @{text f} is usually instantiated with a smashing -function which is either the identity @{term id} or, for \inlineocl{0..1} cardinalities -of associations, the @{term OclANY}-selector which also handles the -@{term null}-cases appropriately. A standard use-case for this combinator -is for example: *} -term "(select_object mtSet UML_Set.OclIncluding UML_Set.OclANY f l oid )::('\<AA>, 'a::null)val" - -definition "select_object\<^sub>S\<^sub>e\<^sub>t = select_object mtSet UML_Set.OclIncluding id" -definition "select_object_any0\<^sub>S\<^sub>e\<^sub>t f s_set = UML_Set.OclANY (select_object\<^sub>S\<^sub>e\<^sub>t f s_set)" -definition "select_object_any\<^sub>S\<^sub>e\<^sub>t f s_set = - (let s = select_object\<^sub>S\<^sub>e\<^sub>t f s_set in - if s->size\<^sub>S\<^sub>e\<^sub>t() \<triangleq> \<zero> then - null - else if s->size\<^sub>S\<^sub>e\<^sub>t() \<triangleq> \<one> then - s->any\<^sub>S\<^sub>e\<^sub>t() - else - \<bottom> - endif - endif)" -definition "select_object\<^sub>S\<^sub>e\<^sub>q = select_object mtSequence UML_Sequence.OclIncluding id" -definition "select_object_any0\<^sub>S\<^sub>e\<^sub>q f s_set = UML_Sequence.OclANY (select_object\<^sub>S\<^sub>e\<^sub>q f s_set)" -definition "select_object_any\<^sub>S\<^sub>e\<^sub>q f s_set = - (let s = select_object\<^sub>S\<^sub>e\<^sub>q f s_set in - if s->size\<^sub>S\<^sub>e\<^sub>q() \<triangleq> \<zero> then - null - else if s->size\<^sub>S\<^sub>e\<^sub>q() \<triangleq> \<one> then - s->any\<^sub>S\<^sub>e\<^sub>q() - else - \<bottom> - endif - endif)" -definition "select_object\<^sub>P\<^sub>a\<^sub>i\<^sub>r f1 f2 = (\<lambda>(a,b). OclPair (f1 a) (f2 b))" - -subsection{* Validity and Definedness Properties *} - -lemma select_fold_exec\<^sub>S\<^sub>e\<^sub>q: - assumes "list_all (\<lambda>f. (\<tau> \<Turnstile> \<upsilon> f)) l" - shows "\<lceil>\<lceil>Rep_Sequence\<^sub>b\<^sub>a\<^sub>s\<^sub>e (foldl UML_Sequence.OclIncluding Sequence{} l \<tau>)\<rceil>\<rceil> = List.map (\<lambda>f. f \<tau>) l" -proof - - have def_fold: "\<And>l. list_all (\<lambda>f. \<tau> \<Turnstile> \<upsilon> f) l \<Longrightarrow> - \<tau> \<Turnstile> (\<delta> foldl UML_Sequence.OclIncluding Sequence{} l)" - apply(rule rev_induct[where P = "\<lambda>l. list_all (\<lambda>f. (\<tau> \<Turnstile> \<upsilon> f)) l \<longrightarrow> \<tau> \<Turnstile> (\<delta> foldl UML_Sequence.OclIncluding Sequence{} l)", THEN mp], simp) - by(simp add: foundation10') - show ?thesis - apply(rule rev_induct[where P = "\<lambda>l. list_all (\<lambda>f. (\<tau> \<Turnstile> \<upsilon> f)) l \<longrightarrow> \<lceil>\<lceil>Rep_Sequence\<^sub>b\<^sub>a\<^sub>s\<^sub>e (foldl UML_Sequence.OclIncluding Sequence{} l \<tau>)\<rceil>\<rceil> = List.map (\<lambda>f. f \<tau>) l", THEN mp], simp) - apply(simp add: mtSequence_def) - apply(subst Abs_Sequence\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inverse, (simp | intro impI)+) - apply(simp add: UML_Sequence.OclIncluding_def, intro conjI impI) - apply(subst Abs_Sequence\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inverse, simp, (rule disjI2)+) - apply(simp add: list_all_iff foundation18', simp) - apply(subst (asm) def_fold[simplified (no_asm) OclValid_def], simp, simp add: OclValid_def) - by (rule assms) -qed - -lemma select_fold_exec\<^sub>S\<^sub>e\<^sub>t: - assumes "list_all (\<lambda>f. (\<tau> \<Turnstile> \<upsilon> f)) l" - shows "\<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (foldl UML_Set.OclIncluding Set{} l \<tau>)\<rceil>\<rceil> = set (List.map (\<lambda>f. f \<tau>) l)" -proof - - have def_fold: "\<And>l. list_all (\<lambda>f. \<tau> \<Turnstile> \<upsilon> f) l \<Longrightarrow> - \<tau> \<Turnstile> (\<delta> foldl UML_Set.OclIncluding Set{} l)" - apply(rule rev_induct[where P = "\<lambda>l. list_all (\<lambda>f. (\<tau> \<Turnstile> \<upsilon> f)) l \<longrightarrow> \<tau> \<Turnstile> (\<delta> foldl UML_Set.OclIncluding Set{} l)", THEN mp], simp) - by(simp add: foundation10') - show ?thesis - apply(rule rev_induct[where P = "\<lambda>l. list_all (\<lambda>f. (\<tau> \<Turnstile> \<upsilon> f)) l \<longrightarrow> \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (foldl UML_Set.OclIncluding Set{} l \<tau>)\<rceil>\<rceil> = set (List.map (\<lambda>f. f \<tau>) l)", THEN mp], simp) - apply(simp add: mtSet_def) - apply(subst Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inverse, (simp | intro impI)+) - apply(simp add: UML_Set.OclIncluding_def, intro conjI impI) - apply(subst Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inverse, simp, (rule disjI2)+) - apply(simp add: list_all_iff foundation18', simp) - apply(subst (asm) def_fold[simplified (no_asm) OclValid_def], simp, simp add: OclValid_def) - by (rule assms) -qed - -lemma fold_val_elem\<^sub>S\<^sub>e\<^sub>q: - assumes "\<tau> \<Turnstile> \<upsilon> (foldl UML_Sequence.OclIncluding Sequence{} (List.map (f p) s_set))" - shows "list_all (\<lambda>x. (\<tau> \<Turnstile> \<upsilon> (f p x))) s_set" - apply(rule rev_induct[where P = "\<lambda>s_set. \<tau> \<Turnstile> \<upsilon> foldl UML_Sequence.OclIncluding Sequence{} (List.map (f p) s_set) \<longrightarrow> list_all (\<lambda>x. \<tau> \<Turnstile> \<upsilon> f p x) s_set", THEN mp]) - apply(simp, auto) - apply (metis (hide_lams, mono_tags) UML_Sequence.OclIncluding.def_valid_then_def UML_Sequence.OclIncluding.defined_args_valid foundation20)+ -by(simp add: assms) - -lemma fold_val_elem\<^sub>S\<^sub>e\<^sub>t: - assumes "\<tau> \<Turnstile> \<upsilon> (foldl UML_Set.OclIncluding Set{} (List.map (f p) s_set))" - shows "list_all (\<lambda>x. (\<tau> \<Turnstile> \<upsilon> (f p x))) s_set" - apply(rule rev_induct[where P = "\<lambda>s_set. \<tau> \<Turnstile> \<upsilon> foldl UML_Set.OclIncluding Set{} (List.map (f p) s_set) \<longrightarrow> list_all (\<lambda>x. \<tau> \<Turnstile> \<upsilon> f p x) s_set", THEN mp]) - apply(simp, auto) - apply (metis (hide_lams, mono_tags) foundation10' foundation20)+ -by(simp add: assms) - -lemma select_object_any_defined0\<^sub>S\<^sub>e\<^sub>q: - assumes def_sel: "\<tau> \<Turnstile> \<delta> (select_object_any0\<^sub>S\<^sub>e\<^sub>q f s_set)" - shows "s_set \<noteq> []" - apply(insert def_sel, case_tac s_set) - apply(simp add: select_object_any0\<^sub>S\<^sub>e\<^sub>q_def select_object\<^sub>S\<^sub>e\<^sub>q_def select_object_def - defined_def OclValid_def - false_def true_def bot_fun_def bot_option_def - split: if_split_asm) -by(simp) - -lemma select_object_any_defined0\<^sub>S\<^sub>e\<^sub>t: - assumes def_sel: "\<tau> \<Turnstile> \<delta> (select_object_any0\<^sub>S\<^sub>e\<^sub>t f s_set)" - shows "s_set \<noteq> []" - apply(insert def_sel, case_tac s_set) - apply(simp add: select_object_any0\<^sub>S\<^sub>e\<^sub>t_def select_object\<^sub>S\<^sub>e\<^sub>t_def select_object_def - defined_def OclValid_def - false_def true_def bot_fun_def bot_option_def - split: if_split_asm) -by(simp) - -lemma select_object_any_defined\<^sub>S\<^sub>e\<^sub>q: - assumes def_sel: "\<tau> \<Turnstile> \<delta> (select_object_any\<^sub>S\<^sub>e\<^sub>q f s_set)" - shows "s_set \<noteq> []" - apply(insert def_sel, case_tac s_set) - apply(simp add: select_object_any\<^sub>S\<^sub>e\<^sub>q_def UML_Sequence.OclANY_def select_object\<^sub>S\<^sub>e\<^sub>q_def select_object_def - defined_def OclValid_def - false_def true_def bot_fun_def bot_option_def - OclInt0_def OclInt1_def StrongEq_def OclIf_def null_fun_def null_option_def - split: if_split_asm) -by(simp) - -lemma select_object_any_defined\<^sub>S\<^sub>e\<^sub>t: - assumes def_sel: "\<tau> \<Turnstile> \<delta> (select_object_any\<^sub>S\<^sub>e\<^sub>t f s_set)" - shows "s_set \<noteq> []" - apply(insert def_sel, case_tac s_set) - apply(simp add: select_object_any\<^sub>S\<^sub>e\<^sub>t_def UML_Sequence.OclANY_def select_object\<^sub>S\<^sub>e\<^sub>t_def select_object_def - defined_def OclValid_def - false_def true_def bot_fun_def bot_option_def - OclInt0_def OclInt1_def StrongEq_def OclIf_def null_fun_def null_option_def - split: if_split_asm) -by(simp) - -lemma select_object_any_exec0\<^sub>S\<^sub>e\<^sub>q: - assumes def_sel: "\<tau> \<Turnstile> \<delta> (select_object_any0\<^sub>S\<^sub>e\<^sub>q f s_set)" - shows "\<exists> e. List.member s_set e \<and> (\<tau> \<Turnstile> (select_object_any0\<^sub>S\<^sub>e\<^sub>q f s_set \<triangleq> f e))" -proof - - fix z - show ?thesis - when " \<lceil>\<lceil>Rep_Sequence\<^sub>b\<^sub>a\<^sub>s\<^sub>e (select_object\<^sub>S\<^sub>e\<^sub>q f s_set \<tau>)\<rceil>\<rceil> = z" - apply(insert that def_sel[simplified foundation16], - simp add: select_object_any0\<^sub>S\<^sub>e\<^sub>q_def foundation22 UML_Sequence.OclANY_def null_fun_def split: if_split_asm) - - apply(simp add: select_object\<^sub>S\<^sub>e\<^sub>q_def select_object_def) - apply(subst (asm) select_fold_exec\<^sub>S\<^sub>e\<^sub>q) - apply(rule fold_val_elem\<^sub>S\<^sub>e\<^sub>q, simp add: OclValid_def) - apply(simp add: comp_def) - - apply(case_tac s_set, simp, simp add: false_def true_def, simp) - - proof - fix a l - show "f a \<tau> # map (\<lambda>x. f x \<tau>) l = z \<Longrightarrow> - \<exists>e. List.member (a # l) e \<and> hd z = f e \<tau>" - apply(rule exI[where x = a], case_tac z, simp+) - by(simp add: member_rec) - qed -qed blast - -lemma select_object_any_exec\<^sub>S\<^sub>e\<^sub>q: - assumes def_sel: "\<tau> \<Turnstile> \<delta> (select_object_any\<^sub>S\<^sub>e\<^sub>q f s_set)" - shows "\<exists> e. List.member s_set e \<and> (\<tau> \<Turnstile> (select_object_any\<^sub>S\<^sub>e\<^sub>q f s_set \<triangleq> f e))" -proof - - have def_sel0: "\<tau> \<Turnstile> \<delta> (select_object_any0\<^sub>S\<^sub>e\<^sub>q f s_set)" - apply (simp add: select_object_any0\<^sub>S\<^sub>e\<^sub>q_def) - apply(insert OclIf_defined'[OF def_sel[simplified select_object_any\<^sub>S\<^sub>e\<^sub>q_def select_object_any0\<^sub>S\<^sub>e\<^sub>q_def Let_def]], auto) - apply(drule OclIf_defined', auto) - by(simp add: defined_def) - - have A00: "\<tau> \<Turnstile> not (select_object\<^sub>S\<^sub>e\<^sub>q f s_set->size\<^sub>S\<^sub>e\<^sub>q() \<triangleq> \<zero>)" - apply(insert def_sel) - apply(simp add: select_object_any\<^sub>S\<^sub>e\<^sub>q_def Let_def OclValid_def) - apply(subst (asm) cp_defined, subst (asm) cp_OclIf) - apply(case_tac "\<tau> \<Turnstile> select_object\<^sub>S\<^sub>e\<^sub>q f s_set->size\<^sub>S\<^sub>e\<^sub>q() \<triangleq> \<zero>", simp add: OclValid_def) - apply(simp add: cp_defined[symmetric] false_def true_def) - by (metis (no_types) OclIf_defined OclValid_def cp_defined defined_bool_split) - - have A0: "\<tau> \<Turnstile> select_object\<^sub>S\<^sub>e\<^sub>q f s_set->size\<^sub>S\<^sub>e\<^sub>q() \<triangleq> \<one>" - apply(rule contrapos_pp, simp, simp add: StrongEq_def OclValid_def true_def) - apply(insert def_sel) - apply(simp add: select_object_any\<^sub>S\<^sub>e\<^sub>q_def Let_def OclValid_def) - apply(subst (asm) cp_defined, simp add: OclIf_false'[OF A00]) - by(subst (asm) cp_OclIf, subst (asm) StrongEq_def, - simp add: OclIf_def true_def defined_def false_def) - - have A: "\<tau> \<Turnstile> (select_object_any\<^sub>S\<^sub>e\<^sub>q f s_set \<triangleq> select_object_any0\<^sub>S\<^sub>e\<^sub>q f s_set)" - apply(simp add: OclValid_def StrongEq_def true_def) - apply(simp add: select_object_any\<^sub>S\<^sub>e\<^sub>q_def select_object_any0\<^sub>S\<^sub>e\<^sub>q_def Let_def OclIf_false'[OF A00]) - by(rule OclIf_true', rule A0) - - show ?thesis - apply(rule exE[OF select_object_any_exec0\<^sub>S\<^sub>e\<^sub>q[OF def_sel0]]) - proof - fix e - show "List.member s_set e \<and> \<tau> \<Turnstile> select_object_any0\<^sub>S\<^sub>e\<^sub>q f s_set \<triangleq> f e \<Longrightarrow> ?thesis" - by(rule exI[where x = e], simp add: StrongEq_L_trans[OF A]) - qed -qed - -lemma (*select_object_any_exec\<^sub>S\<^sub>e\<^sub>t:*) - assumes def_sel: "\<tau> \<Turnstile> \<delta> (select_object_any0\<^sub>S\<^sub>e\<^sub>t f s_set)" - shows "\<exists> e. List.member s_set e \<and> (\<tau> \<Turnstile> (select_object_any0\<^sub>S\<^sub>e\<^sub>t f s_set \<triangleq> f e))" -proof - - have list_all_map: "\<And>P f l. list_all P (List.map f l) = list_all (P o f) l" - by(induct_tac l, simp_all) - - fix z - show ?thesis - when " \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (select_object\<^sub>S\<^sub>e\<^sub>t f s_set \<tau>)\<rceil>\<rceil> = z" - apply(insert that def_sel[simplified foundation16], - simp add: select_object_any0\<^sub>S\<^sub>e\<^sub>t_def foundation22 UML_Set.OclANY_def null_fun_def split: if_split_asm) - - apply(simp add: select_object\<^sub>S\<^sub>e\<^sub>t_def select_object_def) - apply(subst (asm) select_fold_exec\<^sub>S\<^sub>e\<^sub>t) - apply(rule fold_val_elem\<^sub>S\<^sub>e\<^sub>t, simp add: OclValid_def) - apply(simp add: comp_def) - - apply(case_tac s_set, simp, simp add: false_def true_def, simp) - - proof - fix a l - show "insert (f a \<tau>) ((\<lambda>x. f x \<tau>) ` set l) = z \<Longrightarrow> - \<exists>e. List.member (a # l) e \<and> (SOME y. y \<in> z) = f e \<tau>" - apply(rule list.induct[where P = "\<lambda>l. \<forall>z a. insert (f a \<tau>) ((\<lambda>x. f x \<tau>) ` set l) = z \<longrightarrow> - (\<exists>e. List.member (a # l) e \<and> ((SOME y. y \<in> z) = f e \<tau>))", THEN spec, THEN spec, THEN mp], intro allI impI) - proof - fix x xa show "insert (f xa \<tau>) ((\<lambda>x. f x \<tau>) ` set []) = x \<Longrightarrow> \<exists>e. List.member [xa] e \<and> (SOME y. y \<in> x) = f e \<tau>" - apply(rule exI[where x = xa], simp add: List.member_def) - apply(subst some_equality[where a = "f xa \<tau>"]) - apply (metis (mono_tags) insertI1) - apply (metis (mono_tags) empty_iff insert_iff) - by(simp) - apply_end(intro allI impI, simp) - fix x list xa xb - show " \<forall>x. \<exists>e. List.member (x # list) e \<and> (SOME y. y = f x \<tau> \<or> y \<in> (\<lambda>x. f x \<tau>) ` set list) = f e \<tau> \<Longrightarrow> - insert (f xb \<tau>) (insert (f x \<tau>) ((\<lambda>x. f x \<tau>) ` set list)) = xa \<Longrightarrow> - \<exists>e. List.member (xb # x # list) e \<and> (SOME y. y \<in> xa) = f e \<tau>" - apply(case_tac "x = xb", simp) - apply(erule allE[where x = xb]) - apply(erule exE) - proof - fix e show "insert (f xb \<tau>) ((\<lambda>x. f x \<tau>) ` set list) = xa \<Longrightarrow> - x = xb \<Longrightarrow> - List.member (xb # list) e \<and> (SOME y. y = f xb \<tau> \<or> y \<in> (\<lambda>x. f x \<tau>) ` set list) = f e \<tau> \<Longrightarrow> - \<exists>e. List.member (xb # xb # list) e \<and> (SOME y. y \<in> xa) = f e \<tau>" - apply(rule exI[where x = e], auto) - by (metis member_rec(1)) - apply_end(case_tac "List.member list x") - apply_end(erule allE[where x = xb]) - apply_end(erule exE) - fix e - let ?P = "\<lambda>y. y = f xb \<tau> \<or> y \<in> (\<lambda>x. f x \<tau>) ` set list" - show "insert (f xb \<tau>) (insert (f x \<tau>) ((\<lambda>x. f x \<tau>) ` set list)) = xa \<Longrightarrow> - x \<noteq> xb \<Longrightarrow> - List.member list x \<Longrightarrow> - List.member (xb # list) e \<and> (SOME y. y = f xb \<tau> \<or> y \<in> (\<lambda>x. f x \<tau>) ` set list) = f e \<tau> \<Longrightarrow> - \<exists>e. List.member (xb # x # list) e \<and> (SOME y. y \<in> xa) = f e \<tau>" - apply(rule exI[where x = e], auto) - apply (metis member_rec(1)) - - apply(subgoal_tac "?P (f e \<tau>)") - prefer 2 - apply(case_tac "xb = e", simp) - apply (metis (mono_tags) image_eqI in_set_member member_rec(1)) - - apply(rule someI2[where a = "f e \<tau>"]) - apply(erule disjE, simp)+ - apply(rule disjI2)+ apply(simp) -oops - -lemma select_object_any_exec\<^sub>S\<^sub>e\<^sub>t: - assumes def_sel: "\<tau> \<Turnstile> \<delta> (select_object_any\<^sub>S\<^sub>e\<^sub>t f s_set)" - shows "\<exists> e. List.member s_set e \<and> (\<tau> \<Turnstile> (select_object_any\<^sub>S\<^sub>e\<^sub>t f s_set \<triangleq> f e))" -proof - - have card_singl: "\<And>A a. finite A \<Longrightarrow> card (insert a A) = 1 \<Longrightarrow> A \<subseteq> {a}" - by (auto, metis Suc_inject card_Suc_eq card_eq_0_iff insert_absorb insert_not_empty singleton_iff) - - have list_same: "\<And>f s_set z' x. f ` set s_set = {z'} \<Longrightarrow> List.member s_set x \<Longrightarrow> f x = z'" - by (metis (full_types) empty_iff imageI in_set_member insert_iff) - - fix z - show ?thesis - when " \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (select_object\<^sub>S\<^sub>e\<^sub>t f s_set \<tau>)\<rceil>\<rceil> = z" - apply(insert that def_sel[simplified foundation16], - simp add: select_object_any\<^sub>S\<^sub>e\<^sub>t_def foundation22 - Let_def null_fun_def bot_fun_def OclIf_def - split: if_split_asm) - apply(simp add: StrongEq_def OclInt1_def true_def UML_Set.OclSize_def - bot_option_def UML_Set.OclANY_def null_fun_def - split: if_split_asm) - apply(subgoal_tac "\<exists>z'. z = {z'}") - prefer 2 - apply(rule finite.cases[where a = z], simp, simp, simp) - apply(rule card_singl, simp, simp) - apply(erule exE, clarsimp) - - apply(simp add: select_object\<^sub>S\<^sub>e\<^sub>t_def select_object_def) - apply(subst (asm) select_fold_exec\<^sub>S\<^sub>e\<^sub>t) - apply(rule fold_val_elem\<^sub>S\<^sub>e\<^sub>t, simp add: OclValid_def true_def) - apply(simp add: comp_def) - - apply(case_tac s_set, simp) - proof - fix z' a list show "(\<lambda>x. f x \<tau>) ` set s_set = {z'} \<Longrightarrow> s_set = a # list \<Longrightarrow> \<exists>e. List.member s_set e \<and> z' = f e \<tau>" - apply(drule list_same[where x1 = a]) - apply (metis member_rec(1)) - by (metis (hide_lams, mono_tags) ListMem_iff elem in_set_member) - qed -qed blast+ - -end diff --git a/Citadelle/src/UML_Tools.thy b/Citadelle/src/UML_Tools.thy deleted file mode 100644 index 0b97c15aa5182eaa631e1ee1c480cb3d99da11f0..0000000000000000000000000000000000000000 --- a/Citadelle/src/UML_Tools.thy +++ /dev/null @@ -1,149 +0,0 @@ -(****************************************************************************** - * 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_Tools -imports UML_Logic -begin - - -lemmas substs1 = StrongEq_L_subst2_rev - foundation15[THEN iffD2, THEN StrongEq_L_subst2_rev] - foundation7'[THEN iffD2, THEN foundation15[THEN iffD2, - THEN StrongEq_L_subst2_rev]] - foundation14[THEN iffD2, THEN StrongEq_L_subst2_rev] - foundation13[THEN iffD2, THEN StrongEq_L_subst2_rev] - -lemmas substs2 = StrongEq_L_subst3_rev - foundation15[THEN iffD2, THEN StrongEq_L_subst3_rev] - foundation7'[THEN iffD2, THEN foundation15[THEN iffD2, - THEN StrongEq_L_subst3_rev]] - foundation14[THEN iffD2, THEN StrongEq_L_subst3_rev] - foundation13[THEN iffD2, THEN StrongEq_L_subst3_rev] - -lemmas substs4 = StrongEq_L_subst4_rev - foundation15[THEN iffD2, THEN StrongEq_L_subst4_rev] - foundation7'[THEN iffD2, THEN foundation15[THEN iffD2, - THEN StrongEq_L_subst4_rev]] - foundation14[THEN iffD2, THEN StrongEq_L_subst4_rev] - foundation13[THEN iffD2, THEN StrongEq_L_subst4_rev] - - -lemmas substs = substs1 substs2 substs4 [THEN iffD2] substs4 -thm substs -ML{* -fun ocl_subst_asm_tac ctxt = FIRST'(map (fn C => (eresolve0_tac [C]) THEN' (simp_tac ctxt)) - @{thms "substs"}) - -val ocl_subst_asm = fn ctxt => SIMPLE_METHOD (ocl_subst_asm_tac ctxt 1); - -val _ = Theory.setup - (Method.setup (Binding.name "ocl_subst_asm") - (Scan.succeed (ocl_subst_asm)) - "ocl substition step") - -*} - -lemma test1 : "\<tau> \<Turnstile> A \<Longrightarrow> \<tau> \<Turnstile> (A and B \<triangleq> B)" -apply(tactic "ocl_subst_asm_tac @{context} 1") -apply(simp) -done - -lemma test2 : "\<tau> \<Turnstile> A \<Longrightarrow> \<tau> \<Turnstile> (A and B \<triangleq> B)" -by(ocl_subst_asm, simp) - -lemma test3 : "\<tau> \<Turnstile> A \<Longrightarrow> \<tau> \<Turnstile> (A and A)" -by(ocl_subst_asm, simp) - -lemma test4 : "\<tau> \<Turnstile> not A \<Longrightarrow> \<tau> \<Turnstile> (A and B \<triangleq> false)" -by(ocl_subst_asm, simp) - -lemma test5 : "\<tau> \<Turnstile> (A \<triangleq> null) \<Longrightarrow> \<tau> \<Turnstile> (B \<triangleq> null) \<Longrightarrow> \<not> (\<tau> \<Turnstile> (A and B))" -by(ocl_subst_asm,ocl_subst_asm,simp) - -lemma test6 : "\<tau> \<Turnstile> not A \<Longrightarrow> \<not> (\<tau> \<Turnstile> (A and B))" -by(ocl_subst_asm, simp) - -lemma test7 : "\<not> (\<tau> \<Turnstile> (\<upsilon> A)) \<Longrightarrow> \<tau> \<Turnstile> (not B) \<Longrightarrow> \<not> (\<tau> \<Turnstile> (A and B))" -by(ocl_subst_asm,ocl_subst_asm,simp) - - - - - -(* a proof that shows that not everything is humpty dumpty ... *) -lemma X: "\<not> (\<tau> \<Turnstile> (invalid and B))" -apply(insert foundation8[of "\<tau>" "B"], elim disjE, - simp add:defined_bool_split, elim disjE) -apply(ocl_subst_asm, simp) -apply(ocl_subst_asm, simp) -apply(ocl_subst_asm, simp) -apply(ocl_subst_asm, simp) -done - -(* easier is: *) -(* just to show the power of this extremely useful foundational rule:*) -lemma X': "\<not> (\<tau> \<Turnstile> (invalid and B))" -by(simp add:foundation10') -lemma Y: "\<not> (\<tau> \<Turnstile> (null and B))" -by(simp add: foundation10') -lemma Z: "\<not> (\<tau> \<Turnstile> (false and B))" -by(simp add: foundation10') -lemma Z': "(\<tau> \<Turnstile> (true and B)) = (\<tau> \<Turnstile> B)" -by(simp) - - - -(* TODO : establish tactic support for ocl_subst thm1 ... thmn - (argument line version) *) - -(* TODO : Implement delta-closure procedure *) - -(* TODO : Implement ocl_smt *) - - -end - -(* > *) diff --git a/Citadelle/src/UML_Types.thy b/Citadelle/src/UML_Types.thy deleted file mode 100644 index 117a46b3709eafaee6b9f78bb6431283454ecff9..0000000000000000000000000000000000000000 --- a/Citadelle/src/UML_Types.thy +++ /dev/null @@ -1,654 +0,0 @@ -(****************************************************************************** - * 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. - ******************************************************************************) - -chapter{* Formalization I: OCL Types and Core Definitions \label{sec:focl-types}*} - -theory UML_Types -imports HOL.Transcendental (* Testing *) -keywords "Assert" :: thy_decl - and "Assert_local" :: thy_decl -begin - -(* declare[[syntax_ambiguity_warning = false]] *) - -section{* Preliminaries *} -subsection{* Notations for the Option Type *} - -text{* - First of all, we will use a more compact notation for the library - option type which occur all over in our definitions and which will make - the presentation more like a textbook: -*} - -no_notation ceiling ("\<lceil>_\<rceil>") (* For Real Numbers only ... Otherwise has unfortunate side-effects on syntax. *) -no_notation floor ("\<lfloor>_\<rfloor>") (* For Real Numbers only ... Otherwise has unfortunate side-effects on syntax. *) - -type_notation option ("\<langle>_\<rangle>\<^sub>\<bottom>") (* NOTE: "_\<^sub>\<bottom>" also works *) -notation Some ("\<lfloor>(_)\<rfloor>") -notation None ("\<bottom>") -notation the ("\<lceil>(_)\<rceil>") - -text{* These commands introduce an alternative, more compact notation for the type constructor - @{typ "'\<alpha> option"}, namely @{typ "\<langle>'\<alpha>\<rangle>\<^sub>\<bottom>"}. Furthermore, the constructors @{term "Some X"} and - @{term "None"} of the type @{typ "'\<alpha> option"}, namely @{term "\<lfloor>X\<rfloor>"} and @{term "\<bottom>"}. *} - -text{* The definitions for the constants and operations based on functions -will be geared towards a format that Isabelle can check to be a ``conservative'' -(\ie, logically safe) axiomatic definition. By introducing an explicit -interpretation function (which happens to be defined just as the identity -since we are using a shallow embedding of OCL into HOL), all these definitions -can be rewritten into the conventional semantic textbook format. -To say it in other words: The interpretation function @{text Sem} as defined -below is just a textual marker for presentation purposes, i.e. intended for readers -used to conventional textbook notations on semantics. Since we use a ``shallow embedding'', -i.e. since we represent the syntax of OCL directly by HOL constants, the interpretation function -is semantically not only superfluous, but from an Isabelle perspective strictly in -the way for certain consistency checks performed by the definitional packages. -*} - -definition Sem :: "'a \<Rightarrow> 'a" ("I\<lbrakk>_\<rbrakk>") -where "I\<lbrakk>x\<rbrakk> \<equiv> x" - - -subsection{* Common Infrastructure for all OCL Types \label{sec:focl-common-types}*} - -text {* In order to have the possibility to nest collection types, - such that we can give semantics to expressions like @{text "Set{Set{\<two>},null}"}, - it is necessary to introduce a uniform interface for types having - the @{text "invalid"} (= bottom) element. The reason is that we impose - a data-invariant on raw-collection \inlineisar|types_code| which assures - that the @{text "invalid"} element is not allowed inside the collection; - all raw-collections of this form were identified with the @{text "invalid"} element - itself. The construction requires that the new collection type is - not comparable with the raw-types (consisting of nested option type constructions), - such that the data-invariant must be expressed in terms of the interface. - In a second step, our base-types will be shown to be instances of this interface. - *} - -text{* - This uniform interface consists in a type class requiring the existence - of a bot and a null element. The construction proceeds by - abstracting the null (defined by @{text "\<lfloor> \<bottom> \<rfloor>"} on - @{text "'a option option"}) to a @{text null} element, which may - have an arbitrary semantic structure, and an undefinedness element @{text "\<bottom>"} - to an abstract undefinedness element @{text "bot"} (also written - @{text "\<bottom>"} whenever no confusion arises). As a consequence, it is necessary - to redefine the notions of invalid, defined, valuation etc. - on top of this interface. *} - -text{* - This interface consists in two abstract type classes @{text bot} - and @{text null} for the class of all types comprising a bot and a - distinct null element. *} -(* -instance option :: (plus) plus by intro_classes -instance "fun" :: (type, plus) plus by intro_classes -*) - -class bot = - fixes bot :: "'a" - assumes nonEmpty : "\<exists> x. x \<noteq> bot" - - -class null = bot + - fixes null :: "'a" - assumes null_is_valid : "null \<noteq> bot" - - -subsection{* Accommodation of Basic Types to the Abstract Interface *} - -text{* - In the following it is shown that the ``option-option'' type is - in fact in the @{text null} class and that function spaces over these - classes again ``live'' in these classes. This motivates the default construction - of the semantic domain for the basic types (\inlineocl{Boolean}, - \inlineocl{Integer}, \inlineocl{Real}, \ldots). -*} - -instantiation option :: (type)bot -begin - definition bot_option_def: "(bot::'a option) \<equiv> (None::'a option)" - instance proof show "\<exists>x::'a option. x \<noteq> bot" - by(rule_tac x="Some x" in exI, simp add:bot_option_def) - qed -end - - -instantiation option :: (bot)null -begin - definition null_option_def: "(null::'a::bot option) \<equiv> \<lfloor> bot \<rfloor>" - instance proof show "(null::'a::bot option) \<noteq> bot" - by( simp add : null_option_def bot_option_def) - qed -end - - -instantiation "fun" :: (type,bot) bot -begin - definition bot_fun_def: "bot \<equiv> (\<lambda> x. bot)" - instance proof show "\<exists>(x::'a \<Rightarrow> 'b). x \<noteq> bot" - apply(rule_tac x="\<lambda> _. (SOME y. y \<noteq> bot)" in exI, auto) - apply(drule_tac x=x in fun_cong,auto simp:bot_fun_def) - apply(erule contrapos_pp, simp) - apply(rule some_eq_ex[THEN iffD2]) - apply(simp add: nonEmpty) - done - qed -end - - -instantiation "fun" :: (type,null) null -begin - definition null_fun_def: "(null::'a \<Rightarrow> 'b::null) \<equiv> (\<lambda> x. null)" - instance proof - show "(null::'a \<Rightarrow> 'b::null) \<noteq> bot" - apply(auto simp: null_fun_def bot_fun_def) - apply(drule_tac x=x in fun_cong) - apply(erule contrapos_pp, simp add: null_is_valid) - done - qed -end - -text{* A trivial consequence of this adaption of the interface is that -abstract and concrete versions of null are the same on base types -(as could be expected). *} - -subsection{* The Common Infrastructure of Object Types (Class Types) and States. *} - -text{* Recall that OCL is a textual extension of the UML; in particular, we use OCL as means to -annotate UML class models. Thus, OCL inherits a notion of \emph{data} in the UML: UML class -models provide classes, inheritance, types of objects, and subtypes connecting them along -the inheritance hierarchie. -*} - -text{* For the moment, we formalize the most common notions of objects, in particular -the existance of object-identifiers (oid) for each object under which it can -be referenced in a \emph{state}. *} - -type_synonym oid = nat - -text{* We refrained from the alternative: -\begin{isar}[mathescape] -$\text{\textbf{type-synonym}}$ $\mathit{oid = ind}$ -\end{isar} -which is slightly more abstract but non-executable. -*} - -text{* \emph{States} in UML/OCL are a pair of -\begin{itemize} -\item a partial map from oid's to elements of an \emph{object universe}, - \ie{} the set of all possible object representations. -\item and an oid-indexed family of \emph{associations}, \ie{} finite relations between - objects living in a state. These relations can be n-ary which we model by nested lists. -\end{itemize} -For the moment we do not have to describe the concrete structure of the object universe and denote -it by the polymorphic variable @{text "'\<AA>"}.*} - -record ('\<AA>)state = - heap :: "oid \<rightharpoonup> '\<AA> " - assocs :: "oid \<rightharpoonup> ((oid list) list) list" - -text{* In general, OCL operations are functions implicitly depending on a pair -of pre- and post-state, \ie{} \emph{state transitions}. Since this will be reflected in our -representation of OCL Types within HOL, we need to introduce the foundational concept of an -object id (oid), which is just some infinite set, and some abstract notion of state. *} - -type_synonym ('\<AA>)st = "'\<AA> state \<times> '\<AA> state" - -text{* We will require for all objects that there is a function that -projects the oid of an object in the state (we will settle the question how to define -this function later). We will use the Isabelle type class mechanism~\cite{haftmann.ea:constructive:2006} -to capture this: *} - -class object = fixes oid_of :: "'a \<Rightarrow> oid" - -text{* Thus, if needed, we can constrain the object universe to objects by adding -the following type class constraint:*} -typ "'\<AA> :: object" - -text{* The major instance needed are instances constructed over options: once an object, -options of objects are also objects. *} -instantiation option :: (object)object -begin - definition oid_of_option_def: "oid_of x = oid_of (the x)" - instance .. -end - - -subsection{* Common Infrastructure for all OCL Types (II): Valuations as OCL Types *} -text{* Since OCL operations in general depend on pre- and post-states, we will -represent OCL types as \emph{functions} from pre- and post-state to some -HOL raw-type that contains exactly the data in the OCL type --- see below. -This gives rise to the idea that we represent OCL types by \emph{Valuations}. -*} -text{* Valuations are functions from a state pair (built upon -data universe @{typ "'\<AA>"}) to an arbitrary null-type (\ie, containing -at least a destinguished @{text "null"} and @{text "invalid"} element). *} - -type_synonym ('\<AA>,'\<alpha>) val = "'\<AA> st \<Rightarrow> '\<alpha>::null" - -text{* The definitions for the constants and operations based on valuations -will be geared towards a format that Isabelle can check to be a ``conservative'' -(\ie, logically safe) axiomatic definition. By introducing an explicit -interpretation function (which happens to be defined just as the identity -since we are using a shallow embedding of OCL into HOL), all these definitions -can be rewritten into the conventional semantic textbook format as follows: *} - -subsection{* The fundamental constants 'invalid' and 'null' in all OCL Types *} - -text{* As a consequence of semantic domain definition, any OCL type will -have the two semantic constants @{text "invalid"} (for exceptional, aborted -computation) and @{text "null"}: - *} - -definition invalid :: "('\<AA>,'\<alpha>::bot) val" -where "invalid \<equiv> \<lambda> \<tau>. bot" - -text{* This conservative Isabelle definition of the polymorphic constant -@{const invalid} is equivalent with the textbook definition: *} - -lemma textbook_invalid: "I\<lbrakk>invalid\<rbrakk>\<tau> = bot" -by(simp add: invalid_def Sem_def) - - -text {* Note that the definition : -{\small -\begin{isar}[mathescape] -definition null :: "('$\mathfrak{A}$,'\<alpha>::null) val" -where "null \<equiv> \<lambda> \<tau>. null" -\end{isar} -} is not necessary since we defined the entire function space over null types -again as null-types; the crucial definition is @{thm "null_fun_def"}. -Thus, the polymorphic constant @{const null} is simply the result of -a general type class construction. Nevertheless, we can derive the -semantic textbook definition for the OCL null constant based on the -abstract null: -*} - -lemma textbook_null_fun: "I\<lbrakk>null::('\<AA>,'\<alpha>::null) val\<rbrakk> \<tau> = (null::('\<alpha>::null))" -by(simp add: null_fun_def Sem_def) - -section{* Basic OCL Value Types *} - -text {* The structure of this section roughly follows the structure of Chapter -11 of the OCL standard~\cite{omg:ocl:2012}, which introduces the OCL -Library. *} - -text{* The semantic domain of the (basic) boolean type is now defined as the Standard: -the space of valuation to @{typ "bool option option"}, \ie{} the Boolean base type:*} - -type_synonym Boolean\<^sub>b\<^sub>a\<^sub>s\<^sub>e = "bool option option" -type_synonym ('\<AA>)Boolean = "('\<AA>,Boolean\<^sub>b\<^sub>a\<^sub>s\<^sub>e) val" - -text{* Because of the previous class definitions, Isabelle type-inference establishes that -@{typ "('\<AA>)Boolean"} lives actually both in the type class @{term bot} and @{term null}; -this type is sufficiently rich to contain at least these two elements. -Analogously we build: *} -type_synonym Integer\<^sub>b\<^sub>a\<^sub>s\<^sub>e = "int option option" -type_synonym ('\<AA>)Integer = "('\<AA>,Integer\<^sub>b\<^sub>a\<^sub>s\<^sub>e) val" - -type_synonym String\<^sub>b\<^sub>a\<^sub>s\<^sub>e = "string option option" -type_synonym ('\<AA>)String = "('\<AA>,String\<^sub>b\<^sub>a\<^sub>s\<^sub>e) val" - -type_synonym Real\<^sub>b\<^sub>a\<^sub>s\<^sub>e = "real option option" -type_synonym ('\<AA>)Real = "('\<AA>,Real\<^sub>b\<^sub>a\<^sub>s\<^sub>e) val" - -text{* Since @{term "Real"} is again a basic type, we define its semantic domain -as the valuations over @{text "real option option"} --- i.e. the mathematical type of real numbers. -The HOL-theory for @{text real} ``Real'' transcendental numbers such as $\pi$ and $e$ as well as -infrastructure to reason over infinite convergent Cauchy-sequences (it is thus possible, in principle, -to reason in Featherweight OCL that the sum of inverted two-s exponentials is actually 2. - -If needed, a code-generator to compile @{text "Real"} to floating-point -numbers can be added; this allows for mapping reals to an efficient machine representation; -of course, this feature would be logically unsafe.*} - -text{* For technical reasons related to the Isabelle type inference for type-classes -(we don't get the properties in the right order that class instantiation provides them, -if we would follow the previous scheme), we give a slightly atypic definition:*} - -typedef Void\<^sub>b\<^sub>a\<^sub>s\<^sub>e = "{X::unit option option. X = bot \<or> X = null }" by(rule_tac x="bot" in exI, simp) - -type_synonym ('\<AA>)Void = "('\<AA>,Void\<^sub>b\<^sub>a\<^sub>s\<^sub>e) val" - - - - -section{* Some OCL Collection Types *} - -text{* For the semantic construction of the collection types, we have two goals: -\begin{enumerate} -\item we want the types to be \emph{fully abstract}, \ie, the type should not - contain junk-elements that are not representable by OCL expressions, and -\item we want a possibility to nest collection types (so, we want the - potential of talking about @{text "Set(Set(Sequences(Pairs(X,Y))))"}). -\end{enumerate} -The former principle rules out the option to define @{text "'\<alpha> Set"} just by - @{text "('\<AA>, ('\<alpha> option option) set) val"}. This would allow sets to contain -junk elements such as @{text "{\<bottom>}"} which we need to identify with undefinedness -itself. Abandoning fully abstractness of rules would later on produce all sorts -of problems when quantifying over the elements of a type. -However, if we build an own type, then it must conform to our abstract interface -in order to have nested types: arguments of type-constructors must conform to our -abstract interface, and the result type too. -*} - -subsection{* The Construction of the Pair Type (Tuples) *} - -text{* The core of an own type construction is done via a type - definition which provides the base-type @{text "('\<alpha>, '\<beta>) Pair\<^sub>b\<^sub>a\<^sub>s\<^sub>e"}. It - is shown that this type ``fits'' indeed into the abstract type - interface discussed in the previous section. *} - -typedef (overloaded) ('\<alpha>, '\<beta>) Pair\<^sub>b\<^sub>a\<^sub>s\<^sub>e = "{X::('\<alpha>::null \<times> '\<beta>::null) option option. - X = bot \<or> X = null \<or> (fst\<lceil>\<lceil>X\<rceil>\<rceil> \<noteq> bot \<and> snd\<lceil>\<lceil>X\<rceil>\<rceil> \<noteq> bot)}" - by (rule_tac x="bot" in exI, simp) - -text{* We ``carve'' out from the concrete type @{typ "('\<alpha>::null \<times> '\<beta>::null) option option"} -the new fully abstract type, which will not contain representations like @{term "\<lfloor>\<lfloor>(\<bottom>,a)\<rfloor>\<rfloor>"} -or @{term "\<lfloor>\<lfloor>(b,\<bottom>)\<rfloor>\<rfloor>"}. The type constuctor @{text "Pair{x,y}"} to be defined later will -identify these with @{term "invalid"}. -*} - -instantiation Pair\<^sub>b\<^sub>a\<^sub>s\<^sub>e :: (null,null)bot -begin - definition bot_Pair\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def: "(bot_class.bot :: ('a::null,'b::null) Pair\<^sub>b\<^sub>a\<^sub>s\<^sub>e) \<equiv> Abs_Pair\<^sub>b\<^sub>a\<^sub>s\<^sub>e None" - - instance proof show "\<exists>x::('a,'b) Pair\<^sub>b\<^sub>a\<^sub>s\<^sub>e. x \<noteq> bot" - apply(rule_tac x="Abs_Pair\<^sub>b\<^sub>a\<^sub>s\<^sub>e \<lfloor>None\<rfloor>" in exI) - by(simp add: bot_Pair\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def Abs_Pair\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inject null_option_def bot_option_def) - qed -end - -instantiation Pair\<^sub>b\<^sub>a\<^sub>s\<^sub>e :: (null,null)null -begin - definition null_Pair\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def: "(null::('a::null,'b::null) Pair\<^sub>b\<^sub>a\<^sub>s\<^sub>e) \<equiv> Abs_Pair\<^sub>b\<^sub>a\<^sub>s\<^sub>e \<lfloor> None \<rfloor>" - - instance proof show "(null::('a::null,'b::null) Pair\<^sub>b\<^sub>a\<^sub>s\<^sub>e) \<noteq> bot" - by(simp add: bot_Pair\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def null_Pair\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def Abs_Pair\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inject - null_option_def bot_option_def) - qed -end - - -text{* ... and lifting this type to the format of a valuation gives us:*} -type_synonym ('\<AA>,'\<alpha>,'\<beta>) Pair = "('\<AA>, ('\<alpha>,'\<beta>) Pair\<^sub>b\<^sub>a\<^sub>s\<^sub>e) val" -type_notation Pair\<^sub>b\<^sub>a\<^sub>s\<^sub>e ("Pair'(_,_')") - -subsection{* The Construction of the Set Type *} - -text{* The core of an own type construction is done via a type - definition which provides the raw-type @{text "'\<alpha> Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e"}. It - is shown that this type ``fits'' indeed into the abstract type - interface discussed in the previous section. Note that we make - no restriction whatsoever to \emph{finite} sets; while with - the standards type-constructors only finite sets can be denoted, - there is the possibility to define in fact infinite - type constructors in \FOCL (c.f. \autoref{sec:set-type-extensions}). *} - -typedef (overloaded) '\<alpha> Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e ="{X::('\<alpha>::null) set option option. X = bot \<or> X = null \<or> (\<forall>x\<in>\<lceil>\<lceil>X\<rceil>\<rceil>. x \<noteq> bot)}" - by (rule_tac x="bot" in exI, simp) - -instantiation Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e :: (null)bot -begin - - definition bot_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def: "(bot::('a::null) Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e) \<equiv> Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e None" - - instance proof show "\<exists>x::'a Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e. x \<noteq> bot" - apply(rule_tac x="Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e \<lfloor>None\<rfloor>" in exI) - by(simp add: bot_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inject null_option_def bot_option_def) - qed -end - -instantiation Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e :: (null)null -begin - - definition null_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def: "(null::('a::null) Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e) \<equiv> Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e \<lfloor> None \<rfloor>" - - instance proof show "(null::('a::null) Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e) \<noteq> bot" - by(simp add:null_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def bot_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inject - null_option_def bot_option_def) - qed -end - -text{* ... and lifting this type to the format of a valuation gives us:*} -type_synonym ('\<AA>,'\<alpha>) Set = "('\<AA>, '\<alpha> Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e) val" -type_notation Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e ("Set'(_')") - -subsection{* The Construction of the Bag Type *} -text{* The core of an own type construction is done via a type - definition which provides the raw-type @{text "'\<alpha> Bag\<^sub>b\<^sub>a\<^sub>s\<^sub>e"} - based on multi-sets from the \HOL library. As in Sets, it - is shown that this type ``fits'' indeed into the abstract type - interface discussed in the previous section, and as in sets, we make - no restriction whatsoever to \emph{finite} multi-sets; while with - the standards type-constructors only finite sets can be denoted, - there is the possibility to define in fact infinite - type constructors in \FOCL (c.f. \autoref{sec:bag-type-extensions}). - However, while several @{text null} elements are possible in a Bag, there - can't be no bottom (invalid) element in them. -*} - -typedef (overloaded) '\<alpha> Bag\<^sub>b\<^sub>a\<^sub>s\<^sub>e ="{X::('\<alpha>::null \<Rightarrow> nat) option option. X = bot \<or> X = null \<or> \<lceil>\<lceil>X\<rceil>\<rceil> bot = 0 }" - by (rule_tac x="bot" in exI, simp) - -instantiation Bag\<^sub>b\<^sub>a\<^sub>s\<^sub>e :: (null)bot -begin - - definition bot_Bag\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def: "(bot::('a::null) Bag\<^sub>b\<^sub>a\<^sub>s\<^sub>e) \<equiv> Abs_Bag\<^sub>b\<^sub>a\<^sub>s\<^sub>e None" - - instance proof show "\<exists>x::'a Bag\<^sub>b\<^sub>a\<^sub>s\<^sub>e. x \<noteq> bot" - apply(rule_tac x="Abs_Bag\<^sub>b\<^sub>a\<^sub>s\<^sub>e \<lfloor>None\<rfloor>" in exI) - by(simp add: bot_Bag\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def Abs_Bag\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inject - null_option_def bot_option_def) - qed -end - -instantiation Bag\<^sub>b\<^sub>a\<^sub>s\<^sub>e :: (null)null -begin - - definition null_Bag\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def: "(null::('a::null) Bag\<^sub>b\<^sub>a\<^sub>s\<^sub>e) \<equiv> Abs_Bag\<^sub>b\<^sub>a\<^sub>s\<^sub>e \<lfloor> None \<rfloor>" - - instance proof show "(null::('a::null) Bag\<^sub>b\<^sub>a\<^sub>s\<^sub>e) \<noteq> bot" - by(simp add:null_Bag\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def bot_Bag\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def Abs_Bag\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inject - null_option_def bot_option_def) - qed -end - -text{* ... and lifting this type to the format of a valuation gives us:*} -type_synonym ('\<AA>,'\<alpha>) Bag = "('\<AA>, '\<alpha> Bag\<^sub>b\<^sub>a\<^sub>s\<^sub>e) val" -type_notation Bag\<^sub>b\<^sub>a\<^sub>s\<^sub>e ("Bag'(_')") - -subsection{* The Construction of the Sequence Type *} - -text{* The core of an own type construction is done via a type - definition which provides the base-type @{text "'\<alpha> Sequence\<^sub>b\<^sub>a\<^sub>s\<^sub>e"}. It - is shown that this type ``fits'' indeed into the abstract type - interface discussed in the previous section. *} - -typedef (overloaded) '\<alpha> Sequence\<^sub>b\<^sub>a\<^sub>s\<^sub>e ="{X::('\<alpha>::null) list option option. - X = bot \<or> X = null \<or> (\<forall>x\<in>set \<lceil>\<lceil>X\<rceil>\<rceil>. x \<noteq> bot)}" - by (rule_tac x="bot" in exI, simp) - -instantiation Sequence\<^sub>b\<^sub>a\<^sub>s\<^sub>e :: (null)bot -begin - - definition bot_Sequence\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def: "(bot::('a::null) Sequence\<^sub>b\<^sub>a\<^sub>s\<^sub>e) \<equiv> Abs_Sequence\<^sub>b\<^sub>a\<^sub>s\<^sub>e None" - - instance proof show "\<exists>x::'a Sequence\<^sub>b\<^sub>a\<^sub>s\<^sub>e. x \<noteq> bot" - apply(rule_tac x="Abs_Sequence\<^sub>b\<^sub>a\<^sub>s\<^sub>e \<lfloor>None\<rfloor>" in exI) - by(auto simp:bot_Sequence\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def Abs_Sequence\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inject - null_option_def bot_option_def) - qed -end - - -instantiation Sequence\<^sub>b\<^sub>a\<^sub>s\<^sub>e :: (null)null -begin - - definition null_Sequence\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def: "(null::('a::null) Sequence\<^sub>b\<^sub>a\<^sub>s\<^sub>e) \<equiv> Abs_Sequence\<^sub>b\<^sub>a\<^sub>s\<^sub>e \<lfloor> None \<rfloor>" - - instance proof show "(null::('a::null) Sequence\<^sub>b\<^sub>a\<^sub>s\<^sub>e) \<noteq> bot" - by(auto simp:bot_Sequence\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def null_Sequence\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def Abs_Sequence\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inject - null_option_def bot_option_def) - qed -end - - -text{* ... and lifting this type to the format of a valuation gives us:*} -type_synonym ('\<AA>,'\<alpha>) Sequence = "('\<AA>, '\<alpha> Sequence\<^sub>b\<^sub>a\<^sub>s\<^sub>e) val" -type_notation Sequence\<^sub>b\<^sub>a\<^sub>s\<^sub>e ("Sequence'(_')") - -subsection{* Discussion: The Representation of UML/OCL Types in Featherweight OCL *} -text{* In the introduction, we mentioned that there is an ``injective representation -mapping'' between the types of OCL and the types of Featherweight OCL (and its -meta-language: HOL). This injectivity is at the heart of our representation technique ---- a so-called \emph{shallow embedding} --- and means: OCL types were mapped one-to-one -to types in HOL, ruling out a resentation where -everything is mapped on some common HOL-type, say ``OCL-expression'', in which we -would have to sort out the typing of OCL and its impact on the semantic representation -function in an own, quite heavy side-calculus. -*} - -text{* After the previous sections, we are now able to exemplify this representation as follows: - -\begin{table}[htbp] - \centering - \begin{tabu}{lX[,c,]} - \toprule - OCL Type & HOL Type \\ - \midrule - \inlineocl|Boolean| & @{typ "('\<AA>)Boolean"} \\ - \inlineocl|Boolean -> Boolean| & @{typ "('\<AA>)Boolean \<Rightarrow> ('\<AA>)Boolean"} \\ - \inlineocl|(Integer,Integer) -> Boolean| & @{typ "('\<AA>)Integer \<Rightarrow> ('\<AA>)Integer \<Rightarrow> ('\<AA>)Boolean"} \\ - \inlineocl|Set(Integer)| & @{typ "('\<AA>,Integer\<^sub>b\<^sub>a\<^sub>s\<^sub>e)Set"} \\ - \inlineocl|Set(Integer)-> Real| & @{typ "('\<AA>,Integer\<^sub>b\<^sub>a\<^sub>s\<^sub>e)Set \<Rightarrow> ('\<AA>)Real"} \\ - \inlineocl|Set(Pair(Integer,Boolean))| & @{typ "('\<AA>,(Integer\<^sub>b\<^sub>a\<^sub>s\<^sub>e, Boolean\<^sub>b\<^sub>a\<^sub>s\<^sub>e)Pair\<^sub>b\<^sub>a\<^sub>s\<^sub>e)Set"} \\ - \inlineocl|Set(<T>)| & @{typ "('\<AA>,'\<alpha>::null)Set"} \\ - \bottomrule - \end{tabu} - \caption{Correspondance between \OCL types and \HOL types} - \label{tab:types} -\end{table} -We do not formalize the representation map here; however, its principles are quite straight-forward: -\begin{enumerate} -\item cartesion products of arguments were curried, -\item constants of type \inlineocl{T} were mapped to valuations over the - HOL-type for \inlineocl{T}, -\item functions \inlineocl{T -> T'} were mapped to functions in HOL, where - \inlineocl{T} and \inlineocl{T'} were mapped to the valuations for them, and -\item the arguments of type constructors \inlineocl{Set(T)} remain corresponding HOL base-types. -\end{enumerate} - -*} - -text{* Note, furthermore, that our construction of ``fully abstract types'' (no junk, no confusion) -assures that the logical equality to be defined in the next section works correctly and comes -as element of the ``lingua franca'', \ie{} HOL. *} - -(*<*) -section{* Miscelleaneous: ML assertions *} -text{* \fixme{Can we suppress this form the text ???} *} -text{* We introduce here a new command \emph{Assert} similar as \emph{value} for proving - that the given term in argument is a true proposition. The difference with \emph{value} is that -\emph{Assert} fails if the normal form of the term evaluated is not equal to @{term True}. -Moreover, in case \emph{value} could not normalize the given term, as another strategy of reduction - we try to prove it with a single ``simp'' tactic. *} - -ML{* -fun disp_msg title msg status = title ^ ": '" ^ msg ^ "' " ^ status - -fun lemma msg specification_theorem concl in_local thy = - SOME - (in_local (fn lthy => - specification_theorem Thm.theoremK NONE (K I) Binding.empty_atts [] [] - (Element.Shows [(Binding.empty_atts, [(concl lthy, [])])]) - false lthy - |> Proof.global_terminal_proof - ((Method.Combinator ( Method.no_combinator_info - , Method.Then - , [Method.Basic (fn ctxt => SIMPLE_METHOD (asm_full_simp_tac ctxt 1))]), - (Position.none, Position.none)), NONE)) - thy) - handle ERROR s => - (warning s; writeln (disp_msg "KO" msg "failed to normalize"); NONE) - -fun outer_syntax_command command_spec theory in_local = - Outer_Syntax.command command_spec "assert that the given specification is true" - (Parse.term >> (fn elems_concl => theory (fn thy => - case - lemma "nbe" (Specification.theorem true) - (fn lthy => - let val expr = Nbe.dynamic_value lthy (Syntax.read_term lthy elems_concl) - val thy = Proof_Context.theory_of lthy - open HOLogic in - if Sign.typ_equiv thy (fastype_of expr, @{typ "prop"}) then - expr - else mk_Trueprop (mk_eq (@{term "True"}, expr)) - end) - in_local - thy - of NONE => - let val attr_simp = "simp" in - case lemma attr_simp (Specification.theorem_cmd true) (K elems_concl) in_local thy of - NONE => raise (ERROR "Assertion failed") - | SOME thy => - (writeln (disp_msg "OK" "simp" "finished the normalization"); -(* TO BE DONE - why does this not work ? ? ? - une regle importante est dans simp, mais pas dans code_unfold ... *) - thy) - end - | SOME thy => thy))) - -val () = outer_syntax_command @{command_keyword Assert} Toplevel.theory Named_Target.theory_map -val () = outer_syntax_command @{command_keyword Assert_local} (Toplevel.local_theory NONE NONE) I -(* TO BE DONE merge the two commands together *) -*} -(*>*) - - -end - diff --git a/Citadelle/src/basic_types/UML_Boolean.thy b/Citadelle/src/basic_types/UML_Boolean.thy deleted file mode 100644 index 56536ac6dcee33eedf03c225728a15f82d1c7706..0000000000000000000000000000000000000000 --- a/Citadelle/src/basic_types/UML_Boolean.thy +++ /dev/null @@ -1,142 +0,0 @@ -(****************************************************************************** - * 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_Boolean -imports "../UML_PropertyProfiles" -begin - - -subsection{* Fundamental Predicates on Basic Types: Strict (Referential) Equality *} -text{* - Here is a first instance of a definition of strict value equality---for - the special case of the type @{typ "('\<AA>)Boolean"}, it is just - the strict extension of the logical - equality: -*} -overloading StrictRefEq \<equiv> "StrictRefEq :: [('\<AA>)Boolean,('\<AA>)Boolean] \<Rightarrow> ('\<AA>)Boolean" -begin - definition StrictRefEq\<^sub>B\<^sub>o\<^sub>o\<^sub>l\<^sub>e\<^sub>a\<^sub>n[code_unfold] : - "(x::('\<AA>)Boolean) \<doteq> y \<equiv> \<lambda> \<tau>. if (\<upsilon> x) \<tau> = true \<tau> \<and> (\<upsilon> y) \<tau> = true \<tau> - then (x \<triangleq> y)\<tau> - else invalid \<tau>" -end - -text{* which implies elementary properties like: *} -lemma [simp,code_unfold] : "(true \<doteq> false) = false" -by(simp add:StrictRefEq\<^sub>B\<^sub>o\<^sub>o\<^sub>l\<^sub>e\<^sub>a\<^sub>n) -lemma [simp,code_unfold] : "(false \<doteq> true) = false" -by(simp add:StrictRefEq\<^sub>B\<^sub>o\<^sub>o\<^sub>l\<^sub>e\<^sub>a\<^sub>n) - -lemma null_non_false [simp,code_unfold]:"(null \<doteq> false) = false" - apply(rule ext, simp add: StrictRefEq\<^sub>B\<^sub>o\<^sub>o\<^sub>l\<^sub>e\<^sub>a\<^sub>n StrongEq_def false_def) - by(simp add: UML_Types.bot_fun_def invalid_def null_Boolean_def valid_def) - -lemma null_non_true [simp,code_unfold]:"(null \<doteq> true) = false" - apply(rule ext, simp add: StrictRefEq\<^sub>B\<^sub>o\<^sub>o\<^sub>l\<^sub>e\<^sub>a\<^sub>n StrongEq_def false_def) - by(simp add: true_def bot_option_def null_fun_def null_option_def) - -lemma false_non_null [simp,code_unfold]:"(false \<doteq> null) = false" - apply(rule ext, simp add: StrictRefEq\<^sub>B\<^sub>o\<^sub>o\<^sub>l\<^sub>e\<^sub>a\<^sub>n StrongEq_def false_def) - by(simp add: UML_Types.bot_fun_def bot_option_def null_fun_def null_option_def valid_def) - -lemma true_non_null [simp,code_unfold]:"(true \<doteq> null) = false" - apply(rule ext, simp add: StrictRefEq\<^sub>B\<^sub>o\<^sub>o\<^sub>l\<^sub>e\<^sub>a\<^sub>n StrongEq_def false_def) - by(simp add: true_def bot_option_def null_fun_def null_option_def) - -text{* With respect to strictness properties and miscelleaneous side-calculi, -strict referential equality behaves on booleans as described in the -@{term "profile_bin\<^sub>S\<^sub>t\<^sub>r\<^sub>o\<^sub>n\<^sub>g\<^sub>E\<^sub>q_\<^sub>v_\<^sub>v"}:*} -interpretation StrictRefEq\<^sub>B\<^sub>o\<^sub>o\<^sub>l\<^sub>e\<^sub>a\<^sub>n : profile_bin\<^sub>S\<^sub>t\<^sub>r\<^sub>o\<^sub>n\<^sub>g\<^sub>E\<^sub>q_\<^sub>v_\<^sub>v "\<lambda> x y. (x::('\<AA>)Boolean) \<doteq> y" - by unfold_locales (auto simp:StrictRefEq\<^sub>B\<^sub>o\<^sub>o\<^sub>l\<^sub>e\<^sub>a\<^sub>n) - -text{* In particular, it is strict, cp-preserving and const-preserving. In particular, -it generates the simplifier rules for terms like:*} -lemma "(invalid \<doteq> false) = invalid" by(simp) -lemma "(invalid \<doteq> true) = invalid" by(simp) -lemma "(false \<doteq> invalid) = invalid" by(simp) -lemma "(true \<doteq> invalid) = invalid" by(simp) -lemma "((invalid::('\<AA>)Boolean) \<doteq> invalid) = invalid" by(simp) -text{* Thus, the weak equality is \emph{not} reflexive. *} - -subsection{* Boolean xor. *} - -text{* Our Proposal. CHECK THIS WITH ED. *} - -definition OclXor :: "[('\<AA>)Boolean, ('\<AA>)Boolean] \<Rightarrow> ('\<AA>)Boolean" (infixl "xor" 27) -where "(X xor Y) \<equiv> (not(X \<doteq> Y))" - -interpretation xor\<^sub>B\<^sub>o\<^sub>o\<^sub>l\<^sub>e\<^sub>a\<^sub>n : profile_bin\<^sub>v_\<^sub>v "\<lambda> x y. ((x::('\<AA>)Boolean) xor y)" "\<lambda>x y. \<lfloor>\<lfloor>x \<noteq> y\<rfloor>\<rfloor>" -apply unfold_locales apply simp -apply (auto simp:OclXor_def StrictRefEq\<^sub>B\<^sub>o\<^sub>o\<^sub>l\<^sub>e\<^sub>a\<^sub>n StrongEq_def null_option_def bot_option_def) -apply (rule ext) -by (auto simp:OclNot_def StrongEq_def valid_def invalid_def bot_option_def) - - -subsection{* Test Statements on Boolean Operations. *} -text{* Here follows a list of code-examples, that explain the meanings -of the above definitions by compilation to code and execution to @{term "True"}.*} - -text{* Elementary computations on Boolean *} -Assert "\<tau> \<Turnstile> \<upsilon>(true)" -Assert "\<tau> \<Turnstile> \<delta>(false)" -Assert "\<tau> |\<noteq> \<delta>(null)" -Assert "\<tau> |\<noteq> \<delta>(invalid)" -Assert "\<tau> \<Turnstile> \<upsilon>((null::('\<AA>)Boolean))" -Assert "\<tau> |\<noteq> \<upsilon>(invalid)" -Assert "\<tau> \<Turnstile> (true and true)" -Assert "\<tau> \<Turnstile> (true and true \<triangleq> true)" -Assert "\<tau> \<Turnstile> ((null or null) \<triangleq> null)" -Assert "\<tau> \<Turnstile> ((null or null) \<doteq> null)" -Assert "\<tau> \<Turnstile> ((true \<triangleq> false) \<triangleq> false)" -Assert "\<tau> \<Turnstile> ((invalid \<triangleq> false) \<triangleq> false)" -Assert "\<tau> \<Turnstile> ((invalid \<doteq> false) \<triangleq> invalid)" -Assert "\<tau> \<Turnstile> (true <> false)" -Assert "\<tau> \<Turnstile> (false <> true)" - - - - - -end diff --git a/Citadelle/src/basic_types/UML_Integer.thy b/Citadelle/src/basic_types/UML_Integer.thy deleted file mode 100644 index b682146ceba255376f3ade4699a769caaef41d82..0000000000000000000000000000000000000000 --- a/Citadelle/src/basic_types/UML_Integer.thy +++ /dev/null @@ -1,291 +0,0 @@ -(****************************************************************************** - * 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_Integer -imports "../UML_PropertyProfiles" -begin - -section{* Basic Type Integer: Operations *} - -subsection{* Fundamental Predicates on Integers: Strict Equality \label{sec:integer-strict-eq}*} - -text{* The last basic operation belonging to the fundamental infrastructure -of a value-type in OCL is the weak equality, which is defined similar -to the @{typ "('\<AA>)Boolean"}-case as strict extension of the strong equality:*} -overloading StrictRefEq \<equiv> "StrictRefEq :: [('\<AA>)Integer,('\<AA>)Integer] \<Rightarrow> ('\<AA>)Boolean" -begin - definition StrictRefEq\<^sub>I\<^sub>n\<^sub>t\<^sub>e\<^sub>g\<^sub>e\<^sub>r[code_unfold] : - "(x::('\<AA>)Integer) \<doteq> y \<equiv> \<lambda> \<tau>. if (\<upsilon> x) \<tau> = true \<tau> \<and> (\<upsilon> y) \<tau> = true \<tau> - then (x \<triangleq> y) \<tau> - else invalid \<tau>" -end - -text{* Property proof in terms of @{term "profile_bin\<^sub>S\<^sub>t\<^sub>r\<^sub>o\<^sub>n\<^sub>g\<^sub>E\<^sub>q_\<^sub>v_\<^sub>v"}*} -interpretation StrictRefEq\<^sub>I\<^sub>n\<^sub>t\<^sub>e\<^sub>g\<^sub>e\<^sub>r : profile_bin\<^sub>S\<^sub>t\<^sub>r\<^sub>o\<^sub>n\<^sub>g\<^sub>E\<^sub>q_\<^sub>v_\<^sub>v "\<lambda> x y. (x::('\<AA>)Integer) \<doteq> y" - by unfold_locales (auto simp: StrictRefEq\<^sub>I\<^sub>n\<^sub>t\<^sub>e\<^sub>g\<^sub>e\<^sub>r) - -subsection{* Basic Integer Constants *} - -text{* Although the remaining part of this library reasons about -integers abstractly, we provide here as example some convenient shortcuts. *} - -definition OclInt0 ::"('\<AA>)Integer" ("\<zero>") where "\<zero> = (\<lambda> _ . \<lfloor>\<lfloor>0::int\<rfloor>\<rfloor>)" -definition OclInt1 ::"('\<AA>)Integer" ("\<one>") where "\<one> = (\<lambda> _ . \<lfloor>\<lfloor>1::int\<rfloor>\<rfloor>)" -definition OclInt2 ::"('\<AA>)Integer" ("\<two>") where "\<two> = (\<lambda> _ . \<lfloor>\<lfloor>2::int\<rfloor>\<rfloor>)" -text{* Etc. *} -text_raw{* \isatagafp *} -definition OclInt3 ::"('\<AA>)Integer" ("\<three>") where "\<three> = (\<lambda> _ . \<lfloor>\<lfloor>3::int\<rfloor>\<rfloor>)" -definition OclInt4 ::"('\<AA>)Integer" ("\<four>") where "\<four> = (\<lambda> _ . \<lfloor>\<lfloor>4::int\<rfloor>\<rfloor>)" -definition OclInt5 ::"('\<AA>)Integer" ("\<five>") where "\<five> = (\<lambda> _ . \<lfloor>\<lfloor>5::int\<rfloor>\<rfloor>)" -definition OclInt6 ::"('\<AA>)Integer" ("\<six>") where "\<six> = (\<lambda> _ . \<lfloor>\<lfloor>6::int\<rfloor>\<rfloor>)" -definition OclInt7 ::"('\<AA>)Integer" ("\<seven>") where "\<seven> = (\<lambda> _ . \<lfloor>\<lfloor>7::int\<rfloor>\<rfloor>)" -definition OclInt8 ::"('\<AA>)Integer" ("\<eight>") where "\<eight> = (\<lambda> _ . \<lfloor>\<lfloor>8::int\<rfloor>\<rfloor>)" -definition OclInt9 ::"('\<AA>)Integer" ("\<nine>") where "\<nine> = (\<lambda> _ . \<lfloor>\<lfloor>9::int\<rfloor>\<rfloor>)" -definition OclInt10 ::"('\<AA>)Integer" ("\<one>\<zero>")where "\<one>\<zero> = (\<lambda> _ . \<lfloor>\<lfloor>10::int\<rfloor>\<rfloor>)" - -subsection{* Validity and Definedness Properties *} - -lemma "\<delta>(null::('\<AA>)Integer) = false" by simp -lemma "\<upsilon>(null::('\<AA>)Integer) = true" by simp - -lemma [simp,code_unfold]: "\<delta> (\<lambda>_. \<lfloor>\<lfloor>n\<rfloor>\<rfloor>) = true" -by(simp add:defined_def true_def - bot_fun_def bot_option_def null_fun_def null_option_def) - -lemma [simp,code_unfold]: "\<upsilon> (\<lambda>_. \<lfloor>\<lfloor>n\<rfloor>\<rfloor>) = true" -by(simp add:valid_def true_def - bot_fun_def bot_option_def) - -(* ecclectic proofs to make examples executable *) -lemma [simp,code_unfold]: "\<delta> \<zero> = true" by(simp add:OclInt0_def) -lemma [simp,code_unfold]: "\<upsilon> \<zero> = true" by(simp add:OclInt0_def) -lemma [simp,code_unfold]: "\<delta> \<one> = true" by(simp add:OclInt1_def) -lemma [simp,code_unfold]: "\<upsilon> \<one> = true" by(simp add:OclInt1_def) -lemma [simp,code_unfold]: "\<delta> \<two> = true" by(simp add:OclInt2_def) -lemma [simp,code_unfold]: "\<upsilon> \<two> = true" by(simp add:OclInt2_def) -lemma [simp,code_unfold]: "\<delta> \<six> = true" by(simp add:OclInt6_def) -lemma [simp,code_unfold]: "\<upsilon> \<six> = true" by(simp add:OclInt6_def) -lemma [simp,code_unfold]: "\<delta> \<eight> = true" by(simp add:OclInt8_def) -lemma [simp,code_unfold]: "\<upsilon> \<eight> = true" by(simp add:OclInt8_def) -lemma [simp,code_unfold]: "\<delta> \<nine> = true" by(simp add:OclInt9_def) -lemma [simp,code_unfold]: "\<upsilon> \<nine> = true" by(simp add:OclInt9_def) - -text_raw{* \endisatagafp *} - -subsection{* Arithmetical Operations *} - -subsubsection{* Definition *} -text{* Here is a common case of a built-in operation on built-in types. -Note that the arguments must be both defined (non-null, non-bot). *} -text{* Note that we can not follow the lexis of the OCL Standard for Isabelle -technical reasons; these operators are heavily overloaded in the HOL library -that a further overloading would lead to heavy technical buzz in this -document. -*} -definition OclAdd\<^sub>I\<^sub>n\<^sub>t\<^sub>e\<^sub>g\<^sub>e\<^sub>r ::"('\<AA>)Integer \<Rightarrow> ('\<AA>)Integer \<Rightarrow> ('\<AA>)Integer" (infix "+\<^sub>i\<^sub>n\<^sub>t" 40) -where "x +\<^sub>i\<^sub>n\<^sub>t y \<equiv> \<lambda> \<tau>. if (\<delta> x) \<tau> = true \<tau> \<and> (\<delta> y) \<tau> = true \<tau> - then \<lfloor>\<lfloor>\<lceil>\<lceil>x \<tau>\<rceil>\<rceil> + \<lceil>\<lceil>y \<tau>\<rceil>\<rceil>\<rfloor>\<rfloor> - else invalid \<tau> " -interpretation OclAdd\<^sub>I\<^sub>n\<^sub>t\<^sub>e\<^sub>g\<^sub>e\<^sub>r : profile_bin\<^sub>d_\<^sub>d "(+\<^sub>i\<^sub>n\<^sub>t)" "\<lambda> x y. \<lfloor>\<lfloor>\<lceil>\<lceil>x\<rceil>\<rceil> + \<lceil>\<lceil>y\<rceil>\<rceil>\<rfloor>\<rfloor>" - by unfold_locales (auto simp:OclAdd\<^sub>I\<^sub>n\<^sub>t\<^sub>e\<^sub>g\<^sub>e\<^sub>r_def bot_option_def null_option_def) - - -definition OclMinus\<^sub>I\<^sub>n\<^sub>t\<^sub>e\<^sub>g\<^sub>e\<^sub>r ::"('\<AA>)Integer \<Rightarrow> ('\<AA>)Integer \<Rightarrow> ('\<AA>)Integer" (infix "-\<^sub>i\<^sub>n\<^sub>t" 41) -where "x -\<^sub>i\<^sub>n\<^sub>t y \<equiv> \<lambda> \<tau>. if (\<delta> x) \<tau> = true \<tau> \<and> (\<delta> y) \<tau> = true \<tau> - then \<lfloor>\<lfloor>\<lceil>\<lceil>x \<tau>\<rceil>\<rceil> - \<lceil>\<lceil>y \<tau>\<rceil>\<rceil>\<rfloor>\<rfloor> - else invalid \<tau> " -interpretation OclMinus\<^sub>I\<^sub>n\<^sub>t\<^sub>e\<^sub>g\<^sub>e\<^sub>r : profile_bin\<^sub>d_\<^sub>d "(-\<^sub>i\<^sub>n\<^sub>t)" "\<lambda> x y. \<lfloor>\<lfloor>\<lceil>\<lceil>x\<rceil>\<rceil> - \<lceil>\<lceil>y\<rceil>\<rceil>\<rfloor>\<rfloor>" - by unfold_locales (auto simp:OclMinus\<^sub>I\<^sub>n\<^sub>t\<^sub>e\<^sub>g\<^sub>e\<^sub>r_def bot_option_def null_option_def) - - -definition OclMult\<^sub>I\<^sub>n\<^sub>t\<^sub>e\<^sub>g\<^sub>e\<^sub>r ::"('\<AA>)Integer \<Rightarrow> ('\<AA>)Integer \<Rightarrow> ('\<AA>)Integer" (infix "*\<^sub>i\<^sub>n\<^sub>t" 45) -where "x *\<^sub>i\<^sub>n\<^sub>t y \<equiv> \<lambda> \<tau>. if (\<delta> x) \<tau> = true \<tau> \<and> (\<delta> y) \<tau> = true \<tau> - then \<lfloor>\<lfloor>\<lceil>\<lceil>x \<tau>\<rceil>\<rceil> * \<lceil>\<lceil>y \<tau>\<rceil>\<rceil>\<rfloor>\<rfloor> - else invalid \<tau>" -interpretation OclMult\<^sub>I\<^sub>n\<^sub>t\<^sub>e\<^sub>g\<^sub>e\<^sub>r : profile_bin\<^sub>d_\<^sub>d "( *\<^sub>i\<^sub>n\<^sub>t)" "\<lambda> x y. \<lfloor>\<lfloor>\<lceil>\<lceil>x\<rceil>\<rceil> * \<lceil>\<lceil>y\<rceil>\<rceil>\<rfloor>\<rfloor>" - by unfold_locales (auto simp:OclMult\<^sub>I\<^sub>n\<^sub>t\<^sub>e\<^sub>g\<^sub>e\<^sub>r_def bot_option_def null_option_def) - -text{* Here is the special case of division, which is defined as invalid for division -by zero. *} -definition OclDivision\<^sub>I\<^sub>n\<^sub>t\<^sub>e\<^sub>g\<^sub>e\<^sub>r ::"('\<AA>)Integer \<Rightarrow> ('\<AA>)Integer \<Rightarrow> ('\<AA>)Integer" (infix "div\<^sub>i\<^sub>n\<^sub>t" 45) -where "x div\<^sub>i\<^sub>n\<^sub>t y \<equiv> \<lambda> \<tau>. if (\<delta> x) \<tau> = true \<tau> \<and> (\<delta> y) \<tau> = true \<tau> - then if y \<tau> \<noteq> OclInt0 \<tau> then \<lfloor>\<lfloor>\<lceil>\<lceil>x \<tau>\<rceil>\<rceil> div \<lceil>\<lceil>y \<tau>\<rceil>\<rceil>\<rfloor>\<rfloor> else invalid \<tau> - else invalid \<tau> " -(* TODO: special locale setup.*) - -definition OclModulus\<^sub>I\<^sub>n\<^sub>t\<^sub>e\<^sub>g\<^sub>e\<^sub>r ::"('\<AA>)Integer \<Rightarrow> ('\<AA>)Integer \<Rightarrow> ('\<AA>)Integer" (infix "mod\<^sub>i\<^sub>n\<^sub>t" 45) -where "x mod\<^sub>i\<^sub>n\<^sub>t y \<equiv> \<lambda> \<tau>. if (\<delta> x) \<tau> = true \<tau> \<and> (\<delta> y) \<tau> = true \<tau> - then if y \<tau> \<noteq> OclInt0 \<tau> then \<lfloor>\<lfloor>\<lceil>\<lceil>x \<tau>\<rceil>\<rceil> mod \<lceil>\<lceil>y \<tau>\<rceil>\<rceil>\<rfloor>\<rfloor> else invalid \<tau> - else invalid \<tau> " -(* TODO: special locale setup.*) - - -definition OclLess\<^sub>I\<^sub>n\<^sub>t\<^sub>e\<^sub>g\<^sub>e\<^sub>r ::"('\<AA>)Integer \<Rightarrow> ('\<AA>)Integer \<Rightarrow> ('\<AA>)Boolean" (infix "<\<^sub>i\<^sub>n\<^sub>t" 35) -where "x <\<^sub>i\<^sub>n\<^sub>t y \<equiv> \<lambda> \<tau>. if (\<delta> x) \<tau> = true \<tau> \<and> (\<delta> y) \<tau> = true \<tau> - then \<lfloor>\<lfloor>\<lceil>\<lceil>x \<tau>\<rceil>\<rceil> < \<lceil>\<lceil>y \<tau>\<rceil>\<rceil>\<rfloor>\<rfloor> - else invalid \<tau> " -interpretation OclLess\<^sub>I\<^sub>n\<^sub>t\<^sub>e\<^sub>g\<^sub>e\<^sub>r : profile_bin\<^sub>d_\<^sub>d "(<\<^sub>i\<^sub>n\<^sub>t)" "\<lambda> x y. \<lfloor>\<lfloor>\<lceil>\<lceil>x\<rceil>\<rceil> < \<lceil>\<lceil>y\<rceil>\<rceil>\<rfloor>\<rfloor>" - by unfold_locales (auto simp:OclLess\<^sub>I\<^sub>n\<^sub>t\<^sub>e\<^sub>g\<^sub>e\<^sub>r_def bot_option_def null_option_def) - -definition OclLe\<^sub>I\<^sub>n\<^sub>t\<^sub>e\<^sub>g\<^sub>e\<^sub>r ::"('\<AA>)Integer \<Rightarrow> ('\<AA>)Integer \<Rightarrow> ('\<AA>)Boolean" (infix "\<le>\<^sub>i\<^sub>n\<^sub>t" 35) -where "x \<le>\<^sub>i\<^sub>n\<^sub>t y \<equiv> \<lambda> \<tau>. if (\<delta> x) \<tau> = true \<tau> \<and> (\<delta> y) \<tau> = true \<tau> - then \<lfloor>\<lfloor>\<lceil>\<lceil>x \<tau>\<rceil>\<rceil> \<le> \<lceil>\<lceil>y \<tau>\<rceil>\<rceil>\<rfloor>\<rfloor> - else invalid \<tau> " -interpretation OclLe\<^sub>I\<^sub>n\<^sub>t\<^sub>e\<^sub>g\<^sub>e\<^sub>r : profile_bin\<^sub>d_\<^sub>d "(\<le>\<^sub>i\<^sub>n\<^sub>t)" "\<lambda> x y. \<lfloor>\<lfloor>\<lceil>\<lceil>x\<rceil>\<rceil> \<le> \<lceil>\<lceil>y\<rceil>\<rceil>\<rfloor>\<rfloor>" - by unfold_locales (auto simp:OclLe\<^sub>I\<^sub>n\<^sub>t\<^sub>e\<^sub>g\<^sub>e\<^sub>r_def bot_option_def null_option_def) - -subsubsection{* Basic Properties *} - -lemma OclAdd\<^sub>I\<^sub>n\<^sub>t\<^sub>e\<^sub>g\<^sub>e\<^sub>r_commute: "(X +\<^sub>i\<^sub>n\<^sub>t Y) = (Y +\<^sub>i\<^sub>n\<^sub>t X)" - by(rule ext,auto simp:true_def false_def OclAdd\<^sub>I\<^sub>n\<^sub>t\<^sub>e\<^sub>g\<^sub>e\<^sub>r_def invalid_def - split: option.split option.split_asm - bool.split bool.split_asm) - -subsubsection{* Execution with Invalid or Null or Zero as Argument *} - -lemma OclAdd\<^sub>I\<^sub>n\<^sub>t\<^sub>e\<^sub>g\<^sub>e\<^sub>r_zero1[simp,code_unfold] : -"(x +\<^sub>i\<^sub>n\<^sub>t \<zero>) = (if \<upsilon> x and not (\<delta> x) then invalid else x endif)" - proof (rule ext, rename_tac \<tau>, case_tac "(\<upsilon> x and not (\<delta> x)) \<tau> = true \<tau>") - fix \<tau> show "(\<upsilon> x and not (\<delta> x)) \<tau> = true \<tau> \<Longrightarrow> - (x +\<^sub>i\<^sub>n\<^sub>t \<zero>) \<tau> = (if \<upsilon> x and not (\<delta> x) then invalid else x endif) \<tau>" - apply(subst OclIf_true', simp add: OclValid_def) - by (metis OclAdd\<^sub>I\<^sub>n\<^sub>t\<^sub>e\<^sub>g\<^sub>e\<^sub>r_def OclNot_defargs OclValid_def foundation5 foundation9) - next fix \<tau> - have A: "\<And>\<tau>. (\<tau> \<Turnstile> not (\<upsilon> x and not (\<delta> x))) = (x \<tau> = invalid \<tau> \<or> \<tau> \<Turnstile> \<delta> x)" - by (metis OclNot_not OclOr_def defined5 defined6 defined_not_I foundation11 foundation18' - foundation6 foundation7 foundation9 invalid_def) - have B: "\<tau> \<Turnstile> \<delta> x \<Longrightarrow> \<lfloor>\<lfloor>\<lceil>\<lceil>x \<tau>\<rceil>\<rceil>\<rfloor>\<rfloor> = x \<tau>" - apply(cases "x \<tau>", metis bot_option_def foundation16) - apply(rename_tac x', case_tac x', metis bot_option_def foundation16 null_option_def) - by(simp) - show "(x +\<^sub>i\<^sub>n\<^sub>t \<zero>) \<tau> = (if \<upsilon> x and not (\<delta> x) then invalid else x endif) \<tau>" - when "\<tau> \<Turnstile> not (\<upsilon> x and not (\<delta> x))" - apply(insert that, subst OclIf_false', simp, simp add: A, auto simp: OclAdd\<^sub>I\<^sub>n\<^sub>t\<^sub>e\<^sub>g\<^sub>e\<^sub>r_def OclInt0_def) - (* *) - apply(simp add: foundation16'[simplified OclValid_def]) - apply(simp add: B) - by(simp add: OclValid_def) -qed(metis OclValid_def defined5 defined6 defined_and_I defined_not_I foundation9) - -lemma OclAdd\<^sub>I\<^sub>n\<^sub>t\<^sub>e\<^sub>g\<^sub>e\<^sub>r_zero2[simp,code_unfold] : -"(\<zero> +\<^sub>i\<^sub>n\<^sub>t x) = (if \<upsilon> x and not (\<delta> x) then invalid else x endif)" -by(subst OclAdd\<^sub>I\<^sub>n\<^sub>t\<^sub>e\<^sub>g\<^sub>e\<^sub>r_commute, simp) - -(* TODO Basic proproperties for multiplication, division, modulus. *) - - - -subsection{* Test Statements *} -text{* Here follows a list of code-examples, that explain the meanings -of the above definitions by compilation to code and execution to @{term "True"}.*} - -Assert "\<tau> \<Turnstile> ( \<nine> \<le>\<^sub>i\<^sub>n\<^sub>t \<one>\<zero> )" -Assert "\<tau> \<Turnstile> (( \<four> +\<^sub>i\<^sub>n\<^sub>t \<four> ) \<le>\<^sub>i\<^sub>n\<^sub>t \<one>\<zero> )" -Assert "\<tau> |\<noteq> (( \<four> +\<^sub>i\<^sub>n\<^sub>t ( \<four> +\<^sub>i\<^sub>n\<^sub>t \<four> )) <\<^sub>i\<^sub>n\<^sub>t \<one>\<zero> )" -Assert "\<tau> \<Turnstile> not (\<upsilon> (null +\<^sub>i\<^sub>n\<^sub>t \<one>)) " -Assert "\<tau> \<Turnstile> (((\<nine> *\<^sub>i\<^sub>n\<^sub>t \<four>) div\<^sub>i\<^sub>n\<^sub>t \<one>\<zero>) \<le>\<^sub>i\<^sub>n\<^sub>t \<four>) " -Assert "\<tau> \<Turnstile> not (\<delta> (\<one> div\<^sub>i\<^sub>n\<^sub>t \<zero>)) " -Assert "\<tau> \<Turnstile> not (\<upsilon> (\<one> div\<^sub>i\<^sub>n\<^sub>t \<zero>)) " - - - -lemma integer_non_null [simp]: "((\<lambda>_. \<lfloor>\<lfloor>n\<rfloor>\<rfloor>) \<doteq> (null::('\<AA>)Integer)) = false" -by(rule ext,auto simp: StrictRefEq\<^sub>I\<^sub>n\<^sub>t\<^sub>e\<^sub>g\<^sub>e\<^sub>r valid_def - bot_fun_def bot_option_def null_fun_def null_option_def StrongEq_def) - -lemma null_non_integer [simp]: "((null::('\<AA>)Integer) \<doteq> (\<lambda>_. \<lfloor>\<lfloor>n\<rfloor>\<rfloor>)) = false" -by(rule ext,auto simp: StrictRefEq\<^sub>I\<^sub>n\<^sub>t\<^sub>e\<^sub>g\<^sub>e\<^sub>r valid_def - bot_fun_def bot_option_def null_fun_def null_option_def StrongEq_def) - -lemma OclInt0_non_null [simp,code_unfold]: "(\<zero> \<doteq> null) = false" by(simp add: OclInt0_def) -lemma null_non_OclInt0 [simp,code_unfold]: "(null \<doteq> \<zero>) = false" by(simp add: OclInt0_def) -lemma OclInt1_non_null [simp,code_unfold]: "(\<one> \<doteq> null) = false" by(simp add: OclInt1_def) -lemma null_non_OclInt1 [simp,code_unfold]: "(null \<doteq> \<one>) = false" by(simp add: OclInt1_def) -lemma OclInt2_non_null [simp,code_unfold]: "(\<two> \<doteq> null) = false" by(simp add: OclInt2_def) -lemma null_non_OclInt2 [simp,code_unfold]: "(null \<doteq> \<two>) = false" by(simp add: OclInt2_def) -lemma OclInt6_non_null [simp,code_unfold]: "(\<six> \<doteq> null) = false" by(simp add: OclInt6_def) -lemma null_non_OclInt6 [simp,code_unfold]: "(null \<doteq> \<six>) = false" by(simp add: OclInt6_def) -lemma OclInt8_non_null [simp,code_unfold]: "(\<eight> \<doteq> null) = false" by(simp add: OclInt8_def) -lemma null_non_OclInt8 [simp,code_unfold]: "(null \<doteq> \<eight>) = false" by(simp add: OclInt8_def) -lemma OclInt9_non_null [simp,code_unfold]: "(\<nine> \<doteq> null) = false" by(simp add: OclInt9_def) -lemma null_non_OclInt9 [simp,code_unfold]: "(null \<doteq> \<nine>) = false" by(simp add: OclInt9_def) - - -text{* Here follows a list of code-examples, that explain the meanings -of the above definitions by compilation to code and execution to @{term "True"}.*} - - -text{* Elementary computations on Integer *} - -Assert "\<tau> \<Turnstile> ((\<zero> <\<^sub>i\<^sub>n\<^sub>t \<two>) and (\<zero> <\<^sub>i\<^sub>n\<^sub>t \<one>))" - -Assert "\<tau> \<Turnstile> \<one> <> \<two>" -Assert "\<tau> \<Turnstile> \<two> <> \<one>" -Assert "\<tau> \<Turnstile> \<two> \<doteq> \<two>" - -Assert "\<tau> \<Turnstile> \<upsilon> \<four>" -Assert "\<tau> \<Turnstile> \<delta> \<four>" -Assert "\<tau> \<Turnstile> \<upsilon> (null::('\<AA>)Integer)" -Assert "\<tau> \<Turnstile> (invalid \<triangleq> invalid)" -Assert "\<tau> \<Turnstile> (null \<triangleq> null)" -Assert "\<tau> \<Turnstile> (\<four> \<triangleq> \<four>)" -Assert "\<tau> |\<noteq> (\<nine> \<triangleq> \<one>\<zero>)" -Assert "\<tau> |\<noteq> (invalid \<triangleq> \<one>\<zero>)" -Assert "\<tau> |\<noteq> (null \<triangleq> \<one>\<zero>)" -Assert "\<tau> |\<noteq> (invalid \<doteq> (invalid::('\<AA>)Integer))" (* Without typeconstraint not executable.*) -Assert "\<tau> |\<noteq> \<upsilon> (invalid \<doteq> (invalid::('\<AA>)Integer))" (* Without typeconstraint not executable.*) -Assert "\<tau> |\<noteq> (invalid <> (invalid::('\<AA>)Integer))" (* Without typeconstraint not executable.*) -Assert "\<tau> |\<noteq> \<upsilon> (invalid <> (invalid::('\<AA>)Integer))" (* Without typeconstraint not executable.*) -Assert "\<tau> \<Turnstile> (null \<doteq> (null::('\<AA>)Integer) )" (* Without typeconstraint not executable.*) -Assert "\<tau> \<Turnstile> (null \<doteq> (null::('\<AA>)Integer) )" (* Without typeconstraint not executable.*) -Assert "\<tau> \<Turnstile> (\<four> \<doteq> \<four>)" -Assert "\<tau> |\<noteq> (\<four> <> \<four>)" -Assert "\<tau> |\<noteq> (\<four> \<doteq> \<one>\<zero>)" -Assert "\<tau> \<Turnstile> (\<four> <> \<one>\<zero>)" -Assert "\<tau> |\<noteq> (\<zero> <\<^sub>i\<^sub>n\<^sub>t null)" -Assert "\<tau> |\<noteq> (\<delta> (\<zero> <\<^sub>i\<^sub>n\<^sub>t null))" - - -end diff --git a/Citadelle/src/basic_types/UML_Real.thy b/Citadelle/src/basic_types/UML_Real.thy deleted file mode 100644 index 44846541c4bac34bccd921715e3b633eba10b523..0000000000000000000000000000000000000000 --- a/Citadelle/src/basic_types/UML_Real.thy +++ /dev/null @@ -1,290 +0,0 @@ -(****************************************************************************** - * 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_Real -imports "../UML_PropertyProfiles" -begin - -section{* Basic Type Real: Operations *} - -subsection{* Fundamental Predicates on Reals: Strict Equality \label{sec:real-strict-eq}*} - -text{* The last basic operation belonging to the fundamental infrastructure -of a value-type in OCL is the weak equality, which is defined similar -to the @{typ "('\<AA>)Boolean"}-case as strict extension of the strong equality:*} -overloading StrictRefEq \<equiv> "StrictRefEq :: [('\<AA>)Real,('\<AA>)Real] \<Rightarrow> ('\<AA>)Boolean" -begin - definition StrictRefEq\<^sub>R\<^sub>e\<^sub>a\<^sub>l [code_unfold] : - "(x::('\<AA>)Real) \<doteq> y \<equiv> \<lambda> \<tau>. if (\<upsilon> x) \<tau> = true \<tau> \<and> (\<upsilon> y) \<tau> = true \<tau> - then (x \<triangleq> y) \<tau> - else invalid \<tau>" -end - -text{* Property proof in terms of @{term "profile_bin\<^sub>S\<^sub>t\<^sub>r\<^sub>o\<^sub>n\<^sub>g\<^sub>E\<^sub>q_\<^sub>v_\<^sub>v"}*} -interpretation StrictRefEq\<^sub>R\<^sub>e\<^sub>a\<^sub>l : profile_bin\<^sub>S\<^sub>t\<^sub>r\<^sub>o\<^sub>n\<^sub>g\<^sub>E\<^sub>q_\<^sub>v_\<^sub>v "\<lambda> x y. (x::('\<AA>)Real) \<doteq> y" - by unfold_locales (auto simp: StrictRefEq\<^sub>R\<^sub>e\<^sub>a\<^sub>l) - -subsection{* Basic Real Constants *} - -text{* Although the remaining part of this library reasons about -reals abstractly, we provide here as example some convenient shortcuts. *} - -definition OclReal0 ::"('\<AA>)Real" ("\<zero>.\<zero>") where "\<zero>.\<zero> = (\<lambda> _ . \<lfloor>\<lfloor>0::real\<rfloor>\<rfloor>)" -definition OclReal1 ::"('\<AA>)Real" ("\<one>.\<zero>") where "\<one>.\<zero> = (\<lambda> _ . \<lfloor>\<lfloor>1::real\<rfloor>\<rfloor>)" -definition OclReal2 ::"('\<AA>)Real" ("\<two>.\<zero>") where "\<two>.\<zero> = (\<lambda> _ . \<lfloor>\<lfloor>2::real\<rfloor>\<rfloor>)" -text{* Etc. *} -text_raw{* \isatagafp *} -definition OclReal3 ::"('\<AA>)Real" ("\<three>.\<zero>") where "\<three>.\<zero> = (\<lambda> _ . \<lfloor>\<lfloor>3::real\<rfloor>\<rfloor>)" -definition OclReal4 ::"('\<AA>)Real" ("\<four>.\<zero>") where "\<four>.\<zero> = (\<lambda> _ . \<lfloor>\<lfloor>4::real\<rfloor>\<rfloor>)" -definition OclReal5 ::"('\<AA>)Real" ("\<five>.\<zero>") where "\<five>.\<zero> = (\<lambda> _ . \<lfloor>\<lfloor>5::real\<rfloor>\<rfloor>)" -definition OclReal6 ::"('\<AA>)Real" ("\<six>.\<zero>") where "\<six>.\<zero> = (\<lambda> _ . \<lfloor>\<lfloor>6::real\<rfloor>\<rfloor>)" -definition OclReal7 ::"('\<AA>)Real" ("\<seven>.\<zero>") where "\<seven>.\<zero> = (\<lambda> _ . \<lfloor>\<lfloor>7::real\<rfloor>\<rfloor>)" -definition OclReal8 ::"('\<AA>)Real" ("\<eight>.\<zero>") where "\<eight>.\<zero> = (\<lambda> _ . \<lfloor>\<lfloor>8::real\<rfloor>\<rfloor>)" -definition OclReal9 ::"('\<AA>)Real" ("\<nine>.\<zero>") where "\<nine>.\<zero> = (\<lambda> _ . \<lfloor>\<lfloor>9::real\<rfloor>\<rfloor>)" -definition OclReal10 ::"('\<AA>)Real" ("\<one>\<zero>.\<zero>") where "\<one>\<zero>.\<zero> = (\<lambda> _ . \<lfloor>\<lfloor>10::real\<rfloor>\<rfloor>)" -definition OclRealpi ::"('\<AA>)Real" ("\<pi>") where "\<pi> = (\<lambda> _ . \<lfloor>\<lfloor>pi\<rfloor>\<rfloor>)" - -subsection{* Validity and Definedness Properties *} - -lemma "\<delta>(null::('\<AA>)Real) = false" by simp -lemma "\<upsilon>(null::('\<AA>)Real) = true" by simp - -lemma [simp,code_unfold]: "\<delta> (\<lambda>_. \<lfloor>\<lfloor>n\<rfloor>\<rfloor>) = true" -by(simp add:defined_def true_def - bot_fun_def bot_option_def null_fun_def null_option_def) - -lemma [simp,code_unfold]: "\<upsilon> (\<lambda>_. \<lfloor>\<lfloor>n\<rfloor>\<rfloor>) = true" -by(simp add:valid_def true_def - bot_fun_def bot_option_def) - -(* ecclectic proofs to make examples executable *) -lemma [simp,code_unfold]: "\<delta> \<zero>.\<zero> = true" by(simp add:OclReal0_def) -lemma [simp,code_unfold]: "\<upsilon> \<zero>.\<zero> = true" by(simp add:OclReal0_def) -lemma [simp,code_unfold]: "\<delta> \<one>.\<zero> = true" by(simp add:OclReal1_def) -lemma [simp,code_unfold]: "\<upsilon> \<one>.\<zero> = true" by(simp add:OclReal1_def) -lemma [simp,code_unfold]: "\<delta> \<two>.\<zero> = true" by(simp add:OclReal2_def) -lemma [simp,code_unfold]: "\<upsilon> \<two>.\<zero> = true" by(simp add:OclReal2_def) -lemma [simp,code_unfold]: "\<delta> \<six>.\<zero> = true" by(simp add:OclReal6_def) -lemma [simp,code_unfold]: "\<upsilon> \<six>.\<zero> = true" by(simp add:OclReal6_def) -lemma [simp,code_unfold]: "\<delta> \<eight>.\<zero> = true" by(simp add:OclReal8_def) -lemma [simp,code_unfold]: "\<upsilon> \<eight>.\<zero> = true" by(simp add:OclReal8_def) -lemma [simp,code_unfold]: "\<delta> \<nine>.\<zero> = true" by(simp add:OclReal9_def) -lemma [simp,code_unfold]: "\<upsilon> \<nine>.\<zero> = true" by(simp add:OclReal9_def) -text_raw{* \endisatagafp *} - -subsection{* Arithmetical Operations *} - -subsubsection{* Definition *} -text{* Here is a common case of a built-in operation on built-in types. -Note that the arguments must be both defined (non-null, non-bot). *} -text{* Note that we can not follow the lexis of the OCL Standard for Isabelle -technical reasons; these operators are heavily overloaded in the HOL library -that a further overloading would lead to heavy technical buzz in this -document. -*} -definition OclAdd\<^sub>R\<^sub>e\<^sub>a\<^sub>l ::"('\<AA>)Real \<Rightarrow> ('\<AA>)Real \<Rightarrow> ('\<AA>)Real" (infix "+\<^sub>r\<^sub>e\<^sub>a\<^sub>l" 40) -where "x +\<^sub>r\<^sub>e\<^sub>a\<^sub>l y \<equiv> \<lambda> \<tau>. if (\<delta> x) \<tau> = true \<tau> \<and> (\<delta> y) \<tau> = true \<tau> - then \<lfloor>\<lfloor>\<lceil>\<lceil>x \<tau>\<rceil>\<rceil> + \<lceil>\<lceil>y \<tau>\<rceil>\<rceil>\<rfloor>\<rfloor> - else invalid \<tau> " -interpretation OclAdd\<^sub>R\<^sub>e\<^sub>a\<^sub>l : profile_bin\<^sub>d_\<^sub>d "(+\<^sub>r\<^sub>e\<^sub>a\<^sub>l)" "\<lambda> x y. \<lfloor>\<lfloor>\<lceil>\<lceil>x\<rceil>\<rceil> + \<lceil>\<lceil>y\<rceil>\<rceil>\<rfloor>\<rfloor>" - by unfold_locales (auto simp:OclAdd\<^sub>R\<^sub>e\<^sub>a\<^sub>l_def bot_option_def null_option_def) - - -definition OclMinus\<^sub>R\<^sub>e\<^sub>a\<^sub>l ::"('\<AA>)Real \<Rightarrow> ('\<AA>)Real \<Rightarrow> ('\<AA>)Real" (infix "-\<^sub>r\<^sub>e\<^sub>a\<^sub>l" 41) -where "x -\<^sub>r\<^sub>e\<^sub>a\<^sub>l y \<equiv> \<lambda> \<tau>. if (\<delta> x) \<tau> = true \<tau> \<and> (\<delta> y) \<tau> = true \<tau> - then \<lfloor>\<lfloor>\<lceil>\<lceil>x \<tau>\<rceil>\<rceil> - \<lceil>\<lceil>y \<tau>\<rceil>\<rceil>\<rfloor>\<rfloor> - else invalid \<tau> " -interpretation OclMinus\<^sub>R\<^sub>e\<^sub>a\<^sub>l : profile_bin\<^sub>d_\<^sub>d "(-\<^sub>r\<^sub>e\<^sub>a\<^sub>l)" "\<lambda> x y. \<lfloor>\<lfloor>\<lceil>\<lceil>x\<rceil>\<rceil> - \<lceil>\<lceil>y\<rceil>\<rceil>\<rfloor>\<rfloor>" - by unfold_locales (auto simp:OclMinus\<^sub>R\<^sub>e\<^sub>a\<^sub>l_def bot_option_def null_option_def) - - -definition OclMult\<^sub>R\<^sub>e\<^sub>a\<^sub>l ::"('\<AA>)Real \<Rightarrow> ('\<AA>)Real \<Rightarrow> ('\<AA>)Real" (infix "*\<^sub>r\<^sub>e\<^sub>a\<^sub>l" 45) -where "x *\<^sub>r\<^sub>e\<^sub>a\<^sub>l y \<equiv> \<lambda> \<tau>. if (\<delta> x) \<tau> = true \<tau> \<and> (\<delta> y) \<tau> = true \<tau> - then \<lfloor>\<lfloor>\<lceil>\<lceil>x \<tau>\<rceil>\<rceil> * \<lceil>\<lceil>y \<tau>\<rceil>\<rceil>\<rfloor>\<rfloor> - else invalid \<tau>" -interpretation OclMult\<^sub>R\<^sub>e\<^sub>a\<^sub>l : profile_bin\<^sub>d_\<^sub>d "( *\<^sub>r\<^sub>e\<^sub>a\<^sub>l)" "\<lambda> x y. \<lfloor>\<lfloor>\<lceil>\<lceil>x\<rceil>\<rceil> * \<lceil>\<lceil>y\<rceil>\<rceil>\<rfloor>\<rfloor>" - by unfold_locales (auto simp:OclMult\<^sub>R\<^sub>e\<^sub>a\<^sub>l_def bot_option_def null_option_def) - -text{* Here is the special case of division, which is defined as invalid for division -by zero. *} -definition OclDivision\<^sub>R\<^sub>e\<^sub>a\<^sub>l ::"('\<AA>)Real \<Rightarrow> ('\<AA>)Real \<Rightarrow> ('\<AA>)Real" (infix "div\<^sub>r\<^sub>e\<^sub>a\<^sub>l" 45) -where "x div\<^sub>r\<^sub>e\<^sub>a\<^sub>l y \<equiv> \<lambda> \<tau>. if (\<delta> x) \<tau> = true \<tau> \<and> (\<delta> y) \<tau> = true \<tau> - then if y \<tau> \<noteq> OclReal0 \<tau> then \<lfloor>\<lfloor>\<lceil>\<lceil>x \<tau>\<rceil>\<rceil> / \<lceil>\<lceil>y \<tau>\<rceil>\<rceil>\<rfloor>\<rfloor> else invalid \<tau> - else invalid \<tau> " -(* TODO: special locale setup.*) - -definition "mod_float a b = a - real_of_int (floor (a / b)) * b" -definition OclModulus\<^sub>R\<^sub>e\<^sub>a\<^sub>l ::"('\<AA>)Real \<Rightarrow> ('\<AA>)Real \<Rightarrow> ('\<AA>)Real" (infix "mod\<^sub>r\<^sub>e\<^sub>a\<^sub>l" 45) -where "x mod\<^sub>r\<^sub>e\<^sub>a\<^sub>l y \<equiv> \<lambda> \<tau>. if (\<delta> x) \<tau> = true \<tau> \<and> (\<delta> y) \<tau> = true \<tau> - then if y \<tau> \<noteq> OclReal0 \<tau> then \<lfloor>\<lfloor>mod_float \<lceil>\<lceil>x \<tau>\<rceil>\<rceil> \<lceil>\<lceil>y \<tau>\<rceil>\<rceil>\<rfloor>\<rfloor> else invalid \<tau> - else invalid \<tau> " -(* TODO: special locale setup.*) - - -definition OclLess\<^sub>R\<^sub>e\<^sub>a\<^sub>l ::"('\<AA>)Real \<Rightarrow> ('\<AA>)Real \<Rightarrow> ('\<AA>)Boolean" (infix "<\<^sub>r\<^sub>e\<^sub>a\<^sub>l" 35) -where "x <\<^sub>r\<^sub>e\<^sub>a\<^sub>l y \<equiv> \<lambda> \<tau>. if (\<delta> x) \<tau> = true \<tau> \<and> (\<delta> y) \<tau> = true \<tau> - then \<lfloor>\<lfloor>\<lceil>\<lceil>x \<tau>\<rceil>\<rceil> < \<lceil>\<lceil>y \<tau>\<rceil>\<rceil>\<rfloor>\<rfloor> - else invalid \<tau> " -interpretation OclLess\<^sub>R\<^sub>e\<^sub>a\<^sub>l : profile_bin\<^sub>d_\<^sub>d "(<\<^sub>r\<^sub>e\<^sub>a\<^sub>l)" "\<lambda> x y. \<lfloor>\<lfloor>\<lceil>\<lceil>x\<rceil>\<rceil> < \<lceil>\<lceil>y\<rceil>\<rceil>\<rfloor>\<rfloor>" - by unfold_locales (auto simp:OclLess\<^sub>R\<^sub>e\<^sub>a\<^sub>l_def bot_option_def null_option_def) - -definition OclLe\<^sub>R\<^sub>e\<^sub>a\<^sub>l ::"('\<AA>)Real \<Rightarrow> ('\<AA>)Real \<Rightarrow> ('\<AA>)Boolean" (infix "\<le>\<^sub>r\<^sub>e\<^sub>a\<^sub>l" 35) -where "x \<le>\<^sub>r\<^sub>e\<^sub>a\<^sub>l y \<equiv> \<lambda> \<tau>. if (\<delta> x) \<tau> = true \<tau> \<and> (\<delta> y) \<tau> = true \<tau> - then \<lfloor>\<lfloor>\<lceil>\<lceil>x \<tau>\<rceil>\<rceil> \<le> \<lceil>\<lceil>y \<tau>\<rceil>\<rceil>\<rfloor>\<rfloor> - else invalid \<tau> " -interpretation OclLe\<^sub>R\<^sub>e\<^sub>a\<^sub>l : profile_bin\<^sub>d_\<^sub>d "(\<le>\<^sub>r\<^sub>e\<^sub>a\<^sub>l)" "\<lambda> x y. \<lfloor>\<lfloor>\<lceil>\<lceil>x\<rceil>\<rceil> \<le> \<lceil>\<lceil>y\<rceil>\<rceil>\<rfloor>\<rfloor>" - by unfold_locales (auto simp:OclLe\<^sub>R\<^sub>e\<^sub>a\<^sub>l_def bot_option_def null_option_def) - -subsubsection{* Basic Properties *} - -lemma OclAdd\<^sub>R\<^sub>e\<^sub>a\<^sub>l_commute: "(X +\<^sub>r\<^sub>e\<^sub>a\<^sub>l Y) = (Y +\<^sub>r\<^sub>e\<^sub>a\<^sub>l X)" - by(rule ext,auto simp:true_def false_def OclAdd\<^sub>R\<^sub>e\<^sub>a\<^sub>l_def invalid_def - split: option.split option.split_asm - bool.split bool.split_asm) - -subsubsection{* Execution with Invalid or Null or Zero as Argument *} - -lemma OclAdd\<^sub>R\<^sub>e\<^sub>a\<^sub>l_zero1[simp,code_unfold] : -"(x +\<^sub>r\<^sub>e\<^sub>a\<^sub>l \<zero>.\<zero>) = (if \<upsilon> x and not (\<delta> x) then invalid else x endif)" - proof (rule ext, rename_tac \<tau>, case_tac "(\<upsilon> x and not (\<delta> x)) \<tau> = true \<tau>") - fix \<tau> show "(\<upsilon> x and not (\<delta> x)) \<tau> = true \<tau> \<Longrightarrow> - (x +\<^sub>r\<^sub>e\<^sub>a\<^sub>l \<zero>.\<zero>) \<tau> = (if \<upsilon> x and not (\<delta> x) then invalid else x endif) \<tau>" - apply(subst OclIf_true', simp add: OclValid_def) - by (metis OclAdd\<^sub>R\<^sub>e\<^sub>a\<^sub>l_def OclNot_defargs OclValid_def foundation5 foundation9) - next fix \<tau> - have A: "\<And>\<tau>. (\<tau> \<Turnstile> not (\<upsilon> x and not (\<delta> x))) = (x \<tau> = invalid \<tau> \<or> \<tau> \<Turnstile> \<delta> x)" - by (metis OclNot_not OclOr_def defined5 defined6 defined_not_I foundation11 foundation18' - foundation6 foundation7 foundation9 invalid_def) - have B: "\<tau> \<Turnstile> \<delta> x \<Longrightarrow> \<lfloor>\<lfloor>\<lceil>\<lceil>x \<tau>\<rceil>\<rceil>\<rfloor>\<rfloor> = x \<tau>" - apply(cases "x \<tau>", metis bot_option_def foundation16) - apply(rename_tac x', case_tac x', metis bot_option_def foundation16 null_option_def) - by(simp) - show "(x +\<^sub>r\<^sub>e\<^sub>a\<^sub>l \<zero>.\<zero>) \<tau> = (if \<upsilon> x and not (\<delta> x) then invalid else x endif) \<tau>" - when "\<tau> \<Turnstile> not (\<upsilon> x and not (\<delta> x))" - apply(insert that, subst OclIf_false', simp, simp add: A, auto simp: OclAdd\<^sub>R\<^sub>e\<^sub>a\<^sub>l_def OclReal0_def) - (* *) - apply(simp add: foundation16'[simplified OclValid_def]) - apply(simp add: B) - by(simp add: OclValid_def) -qed(metis OclValid_def defined5 defined6 defined_and_I defined_not_I foundation9) - -lemma OclAdd\<^sub>R\<^sub>e\<^sub>a\<^sub>l_zero2[simp,code_unfold] : -"(\<zero>.\<zero> +\<^sub>r\<^sub>e\<^sub>a\<^sub>l x) = (if \<upsilon> x and not (\<delta> x) then invalid else x endif)" -by(subst OclAdd\<^sub>R\<^sub>e\<^sub>a\<^sub>l_commute, simp) - -(* TODO Basic proproperties for multiplication, division, modulus. *) - - - -subsection{* Test Statements *} -text{* Here follows a list of code-examples, that explain the meanings -of the above definitions by compilation to code and execution to @{term "True"}.*} - -Assert "\<tau> \<Turnstile> ( \<nine>.\<zero> \<le>\<^sub>r\<^sub>e\<^sub>a\<^sub>l \<one>\<zero>.\<zero> )" -Assert "\<tau> \<Turnstile> (( \<four>.\<zero> +\<^sub>r\<^sub>e\<^sub>a\<^sub>l \<four>.\<zero> ) \<le>\<^sub>r\<^sub>e\<^sub>a\<^sub>l \<one>\<zero>.\<zero> )" -Assert "\<tau> |\<noteq> (( \<four>.\<zero> +\<^sub>r\<^sub>e\<^sub>a\<^sub>l ( \<four>.\<zero> +\<^sub>r\<^sub>e\<^sub>a\<^sub>l \<four>.\<zero> )) <\<^sub>r\<^sub>e\<^sub>a\<^sub>l \<one>\<zero>.\<zero> )" -Assert "\<tau> \<Turnstile> not (\<upsilon> (null +\<^sub>r\<^sub>e\<^sub>a\<^sub>l \<one>.\<zero>)) " -Assert "\<tau> \<Turnstile> (((\<nine>.\<zero> *\<^sub>r\<^sub>e\<^sub>a\<^sub>l \<four>.\<zero>) div\<^sub>r\<^sub>e\<^sub>a\<^sub>l \<one>\<zero>.\<zero>) \<le>\<^sub>r\<^sub>e\<^sub>a\<^sub>l \<four>.\<zero>) " -Assert "\<tau> \<Turnstile> not (\<delta> (\<one>.\<zero> div\<^sub>r\<^sub>e\<^sub>a\<^sub>l \<zero>.\<zero>)) " -Assert "\<tau> \<Turnstile> not (\<upsilon> (\<one>.\<zero> div\<^sub>r\<^sub>e\<^sub>a\<^sub>l \<zero>.\<zero>)) " - - - -lemma real_non_null [simp]: "((\<lambda>_. \<lfloor>\<lfloor>n\<rfloor>\<rfloor>) \<doteq> (null::('\<AA>)Real)) = false" -by(rule ext,auto simp: StrictRefEq\<^sub>R\<^sub>e\<^sub>a\<^sub>l valid_def - bot_fun_def bot_option_def null_fun_def null_option_def StrongEq_def) - -lemma null_non_real [simp]: "((null::('\<AA>)Real) \<doteq> (\<lambda>_. \<lfloor>\<lfloor>n\<rfloor>\<rfloor>)) = false" -by(rule ext,auto simp: StrictRefEq\<^sub>R\<^sub>e\<^sub>a\<^sub>l valid_def - bot_fun_def bot_option_def null_fun_def null_option_def StrongEq_def) - -lemma OclReal0_non_null [simp,code_unfold]: "(\<zero>.\<zero> \<doteq> null) = false" by(simp add: OclReal0_def) -lemma null_non_OclReal0 [simp,code_unfold]: "(null \<doteq> \<zero>.\<zero>) = false" by(simp add: OclReal0_def) -lemma OclReal1_non_null [simp,code_unfold]: "(\<one>.\<zero> \<doteq> null) = false" by(simp add: OclReal1_def) -lemma null_non_OclReal1 [simp,code_unfold]: "(null \<doteq> \<one>.\<zero>) = false" by(simp add: OclReal1_def) -lemma OclReal2_non_null [simp,code_unfold]: "(\<two>.\<zero> \<doteq> null) = false" by(simp add: OclReal2_def) -lemma null_non_OclReal2 [simp,code_unfold]: "(null \<doteq> \<two>.\<zero>) = false" by(simp add: OclReal2_def) -lemma OclReal6_non_null [simp,code_unfold]: "(\<six>.\<zero> \<doteq> null) = false" by(simp add: OclReal6_def) -lemma null_non_OclReal6 [simp,code_unfold]: "(null \<doteq> \<six>.\<zero>) = false" by(simp add: OclReal6_def) -lemma OclReal8_non_null [simp,code_unfold]: "(\<eight>.\<zero> \<doteq> null) = false" by(simp add: OclReal8_def) -lemma null_non_OclReal8 [simp,code_unfold]: "(null \<doteq> \<eight>.\<zero>) = false" by(simp add: OclReal8_def) -lemma OclReal9_non_null [simp,code_unfold]: "(\<nine>.\<zero> \<doteq> null) = false" by(simp add: OclReal9_def) -lemma null_non_OclReal9 [simp,code_unfold]: "(null \<doteq> \<nine>.\<zero>) = false" by(simp add: OclReal9_def) - - -text{* Here follows a list of code-examples, that explain the meanings -of the above definitions by compilation to code and execution to @{term "True"}.*} - - -text{* Elementary computations on Real *} - -Assert "\<tau> \<Turnstile> \<one>.\<zero> <> \<two>.\<zero>" -Assert "\<tau> \<Turnstile> \<two>.\<zero> <> \<one>.\<zero>" -Assert "\<tau> \<Turnstile> \<two>.\<zero> \<doteq> \<two>.\<zero>" - -Assert "\<tau> \<Turnstile> \<upsilon> \<four>.\<zero>" -Assert "\<tau> \<Turnstile> \<delta> \<four>.\<zero>" -Assert "\<tau> \<Turnstile> \<upsilon> (null::('\<AA>)Real)" -Assert "\<tau> \<Turnstile> (invalid \<triangleq> invalid)" -Assert "\<tau> \<Turnstile> (null \<triangleq> null)" -Assert "\<tau> \<Turnstile> (\<four>.\<zero> \<triangleq> \<four>.\<zero>)" -Assert "\<tau> |\<noteq> (\<nine>.\<zero> \<triangleq> \<one>\<zero>.\<zero>)" -Assert "\<tau> |\<noteq> (invalid \<triangleq> \<one>\<zero>.\<zero>)" -Assert "\<tau> |\<noteq> (null \<triangleq> \<one>\<zero>.\<zero>)" -Assert "\<tau> |\<noteq> (invalid \<doteq> (invalid::('\<AA>)Real))" (* Without typeconstraint not executable.*) -Assert "\<tau> |\<noteq> \<upsilon> (invalid \<doteq> (invalid::('\<AA>)Real))" (* Without typeconstraint not executable.*) -Assert "\<tau> |\<noteq> (invalid <> (invalid::('\<AA>)Real))" (* Without typeconstraint not executable.*) -Assert "\<tau> |\<noteq> \<upsilon> (invalid <> (invalid::('\<AA>)Real))" (* Without typeconstraint not executable.*) -Assert "\<tau> \<Turnstile> (null \<doteq> (null::('\<AA>)Real) )" (* Without typeconstraint not executable.*) -Assert "\<tau> \<Turnstile> (null \<doteq> (null::('\<AA>)Real) )" (* Without typeconstraint not executable.*) -Assert "\<tau> \<Turnstile> (\<four>.\<zero> \<doteq> \<four>.\<zero>)" -Assert "\<tau> |\<noteq> (\<four>.\<zero> <> \<four>.\<zero>)" -Assert "\<tau> |\<noteq> (\<four>.\<zero> \<doteq> \<one>\<zero>.\<zero>)" -Assert "\<tau> \<Turnstile> (\<four>.\<zero> <> \<one>\<zero>.\<zero>)" -Assert "\<tau> |\<noteq> (\<zero>.\<zero> <\<^sub>r\<^sub>e\<^sub>a\<^sub>l null)" -Assert "\<tau> |\<noteq> (\<delta> (\<zero>.\<zero> <\<^sub>r\<^sub>e\<^sub>a\<^sub>l null))" - - -end diff --git a/Citadelle/src/basic_types/UML_String.thy b/Citadelle/src/basic_types/UML_String.thy deleted file mode 100644 index 09d98521d698e9565bd9838a7166b4fa8fc1416d..0000000000000000000000000000000000000000 --- a/Citadelle/src/basic_types/UML_String.thy +++ /dev/null @@ -1,170 +0,0 @@ -(****************************************************************************** - * 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_String -imports "../UML_PropertyProfiles" -begin - -section{* Basic Type String: Operations *} - -subsection{* Fundamental Properties on Strings: Strict Equality \label{sec:string-strict-eq}*} - -text{* The last basic operation belonging to the fundamental infrastructure -of a value-type in OCL is the weak equality, which is defined similar -to the @{typ "('\<AA>)Boolean"}-case as strict extension of the strong equality:*} -overloading StrictRefEq \<equiv> "StrictRefEq :: [('\<AA>)String,('\<AA>)String] \<Rightarrow> ('\<AA>)Boolean" -begin - definition StrictRefEq\<^sub>S\<^sub>t\<^sub>r\<^sub>i\<^sub>n\<^sub>g[code_unfold] : - "(x::('\<AA>)String) \<doteq> y \<equiv> \<lambda> \<tau>. if (\<upsilon> x) \<tau> = true \<tau> \<and> (\<upsilon> y) \<tau> = true \<tau> - then (x \<triangleq> y) \<tau> - else invalid \<tau>" -end - -text{* Property proof in terms of @{term "profile_bin\<^sub>S\<^sub>t\<^sub>r\<^sub>o\<^sub>n\<^sub>g\<^sub>E\<^sub>q_\<^sub>v_\<^sub>v"}*} -interpretation StrictRefEq\<^sub>S\<^sub>t\<^sub>r\<^sub>i\<^sub>n\<^sub>g : profile_bin\<^sub>S\<^sub>t\<^sub>r\<^sub>o\<^sub>n\<^sub>g\<^sub>E\<^sub>q_\<^sub>v_\<^sub>v "\<lambda> x y. (x::('\<AA>)String) \<doteq> y" - by unfold_locales (auto simp: StrictRefEq\<^sub>S\<^sub>t\<^sub>r\<^sub>i\<^sub>n\<^sub>g) - -subsection{* Basic String Constants *} - -text{* Although the remaining part of this library reasons about -integers abstractly, we provide here as example some convenient shortcuts. *} - -definition OclStringa ::"('\<AA>)String" ("\<a>") where "\<a> = (\<lambda> _ . \<lfloor>\<lfloor>''a''\<rfloor>\<rfloor>)" -definition OclStringb ::"('\<AA>)String" ("\<b>") where "\<b> = (\<lambda> _ . \<lfloor>\<lfloor>''b''\<rfloor>\<rfloor>)" -definition OclStringc ::"('\<AA>)String" ("\<c>") where "\<c> = (\<lambda> _ . \<lfloor>\<lfloor>''c''\<rfloor>\<rfloor>)" -text{* Etc.*} -text_raw{* \isatagafp *} - -subsection{* Validity and Definedness Properties *} - -lemma "\<delta>(null::('\<AA>)String) = false" by simp -lemma "\<upsilon>(null::('\<AA>)String) = true" by simp - -lemma [simp,code_unfold]: "\<delta> (\<lambda>_. \<lfloor>\<lfloor>n\<rfloor>\<rfloor>) = true" -by(simp add:defined_def true_def - bot_fun_def bot_option_def null_fun_def null_option_def) - -lemma [simp,code_unfold]: "\<upsilon> (\<lambda>_. \<lfloor>\<lfloor>n\<rfloor>\<rfloor>) = true" -by(simp add:valid_def true_def - bot_fun_def bot_option_def) - -(* ecclectic proofs to make examples executable *) -lemma [simp,code_unfold]: "\<delta> \<a> = true" by(simp add:OclStringa_def) -lemma [simp,code_unfold]: "\<upsilon> \<a> = true" by(simp add:OclStringa_def) -text_raw{* \endisatagafp *} - -subsection{* String Operations *} - -subsubsection{* Definition *} -text{* Here is a common case of a built-in operation on built-in types. -Note that the arguments must be both defined (non-null, non-bot). *} -text{* Note that we can not follow the lexis of the OCL Standard for Isabelle -technical reasons; these operators are heavily overloaded in the HOL library -that a further overloading would lead to heavy technical buzz in this -document. -*} -definition OclAdd\<^sub>S\<^sub>t\<^sub>r\<^sub>i\<^sub>n\<^sub>g ::"('\<AA>)String \<Rightarrow> ('\<AA>)String \<Rightarrow> ('\<AA>)String" (infix "+\<^sub>s\<^sub>t\<^sub>r\<^sub>i\<^sub>n\<^sub>g" 40) -where "x +\<^sub>s\<^sub>t\<^sub>r\<^sub>i\<^sub>n\<^sub>g y \<equiv> \<lambda> \<tau>. if (\<delta> x) \<tau> = true \<tau> \<and> (\<delta> y) \<tau> = true \<tau> - then \<lfloor>\<lfloor>concat [\<lceil>\<lceil>x \<tau>\<rceil>\<rceil>, \<lceil>\<lceil>y \<tau>\<rceil>\<rceil>]\<rfloor>\<rfloor> - else invalid \<tau> " -interpretation OclAdd\<^sub>S\<^sub>t\<^sub>r\<^sub>i\<^sub>n\<^sub>g : profile_bin\<^sub>d_\<^sub>d "(+\<^sub>s\<^sub>t\<^sub>r\<^sub>i\<^sub>n\<^sub>g)" "\<lambda> x y. \<lfloor>\<lfloor>concat [\<lceil>\<lceil>x\<rceil>\<rceil>, \<lceil>\<lceil>y\<rceil>\<rceil>]\<rfloor>\<rfloor>" - by unfold_locales (auto simp:OclAdd\<^sub>S\<^sub>t\<^sub>r\<^sub>i\<^sub>n\<^sub>g_def bot_option_def null_option_def) - -(* TODO : size(), concat, substring(s:string) toInteger, toReal, at(i:Integer), characters() etc. *) - - -subsubsection{* Basic Properties *} - -lemma OclAdd\<^sub>S\<^sub>t\<^sub>r\<^sub>i\<^sub>n\<^sub>g_not_commute: "\<exists>X Y. (X +\<^sub>s\<^sub>t\<^sub>r\<^sub>i\<^sub>n\<^sub>g Y) \<noteq> (Y +\<^sub>s\<^sub>t\<^sub>r\<^sub>i\<^sub>n\<^sub>g X)" - apply(rule_tac x = "\<lambda>_. \<lfloor>\<lfloor>''b''\<rfloor>\<rfloor>" in exI) - apply(rule_tac x = "\<lambda>_. \<lfloor>\<lfloor>''a''\<rfloor>\<rfloor>" in exI) - apply(simp_all add:OclAdd\<^sub>S\<^sub>t\<^sub>r\<^sub>i\<^sub>n\<^sub>g_def) - by(auto, drule fun_cong, auto) - - -subsection{* Test Statements *} -text{* Here follows a list of code-examples, that explain the meanings -of the above definitions by compilation to code and execution to @{term "True"}.*} -(* -Assert "\<tau> \<Turnstile> ( \<nine> \<le>\<^sub>s\<^sub>t\<^sub>r\<^sub>i\<^sub>n\<^sub>g \<one>\<zero> )" -Assert "\<tau> \<Turnstile> (( \<four> +\<^sub>s\<^sub>t\<^sub>r\<^sub>i\<^sub>n\<^sub>g \<four> ) \<le>\<^sub>s\<^sub>t\<^sub>r\<^sub>i\<^sub>n\<^sub>g \<one>\<zero> )" -Assert "\<tau> |\<noteq> (( \<four> +\<^sub>s\<^sub>t\<^sub>r\<^sub>i\<^sub>n\<^sub>g ( \<four> +\<^sub>s\<^sub>t\<^sub>r\<^sub>i\<^sub>n\<^sub>g \<four> )) <\<^sub>s\<^sub>t\<^sub>r\<^sub>i\<^sub>n\<^sub>g \<one>\<zero> )" -Assert "\<tau> \<Turnstile> not (\<upsilon> (null +\<^sub>s\<^sub>t\<^sub>r\<^sub>i\<^sub>n\<^sub>g \<one>)) " -*) - -text{* Here follows a list of code-examples, that explain the meanings -of the above definitions by compilation to code and execution to @{term "True"}.*} - - -text{* Elementary computations on String *} - -Assert "\<tau> \<Turnstile> \<a> <> \<b>" -Assert "\<tau> \<Turnstile> \<b> <> \<a>" -Assert "\<tau> \<Turnstile> \<b> \<doteq> \<b>" - -Assert "\<tau> \<Turnstile> \<upsilon> \<a>" -Assert "\<tau> \<Turnstile> \<delta> \<a>" -Assert "\<tau> \<Turnstile> \<upsilon> (null::('\<AA>)String)" -Assert "\<tau> \<Turnstile> (invalid \<triangleq> invalid)" -Assert "\<tau> \<Turnstile> (null \<triangleq> null)" -Assert "\<tau> \<Turnstile> (\<a> \<triangleq> \<a>)" -Assert "\<tau> |\<noteq> (\<a> \<triangleq> \<b>)" -Assert "\<tau> |\<noteq> (invalid \<triangleq> \<b>)" -Assert "\<tau> |\<noteq> (null \<triangleq> \<b>)" -Assert "\<tau> |\<noteq> (invalid \<doteq> (invalid::('\<AA>)String))" (* Without typeconstraint not executable.*) -Assert "\<tau> |\<noteq> \<upsilon> (invalid \<doteq> (invalid::('\<AA>)String))" (* Without typeconstraint not executable.*) -Assert "\<tau> |\<noteq> (invalid <> (invalid::('\<AA>)String))" (* Without typeconstraint not executable.*) -Assert "\<tau> |\<noteq> \<upsilon> (invalid <> (invalid::('\<AA>)String))" (* Without typeconstraint not executable.*) -Assert "\<tau> \<Turnstile> (null \<doteq> (null::('\<AA>)String) )" (* Without typeconstraint not executable.*) -Assert "\<tau> \<Turnstile> (null \<doteq> (null::('\<AA>)String) )" (* Without typeconstraint not executable.*) -Assert "\<tau> \<Turnstile> (\<b> \<doteq> \<b>)" -Assert "\<tau> |\<noteq> (\<b> <> \<b>)" -Assert "\<tau> |\<noteq> (\<b> \<doteq> \<c>)" -Assert "\<tau> \<Turnstile> (\<b> <> \<c>)" -(*Assert "\<tau> |\<noteq> (\<zero> <\<^sub>s\<^sub>t\<^sub>r\<^sub>i\<^sub>n\<^sub>g null)" -Assert "\<tau> |\<noteq> (\<delta> (\<zero> <\<^sub>s\<^sub>t\<^sub>r\<^sub>i\<^sub>n\<^sub>g null))" -*) - -end diff --git a/Citadelle/src/basic_types/UML_UnlimitedNatural.thy b/Citadelle/src/basic_types/UML_UnlimitedNatural.thy deleted file mode 100644 index 0e789d06fe8dc01c5453b587a63dcc14b0767dc4..0000000000000000000000000000000000000000 --- a/Citadelle/src/basic_types/UML_UnlimitedNatural.thy +++ /dev/null @@ -1,404 +0,0 @@ -(****************************************************************************** - * 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_UnlimitedNatural -imports OCL.UML_PropertyProfiles -begin - -section{* ... *} - -text{* Unlike @{term "Integer"}, we should also include the infinity value besides @{term "undefined"} and @{term "null"}. *} - - -class infinity = null + - fixes infinity :: "'a" - assumes infinity_is_valid : "infinity \<noteq> bot" - assumes infinity_is_defined : "infinity \<noteq> null" - -instantiation option :: (null)infinity -begin - definition infinity_option_def: "(infinity::'a::null option) \<equiv> \<lfloor> null \<rfloor>" - instance proof show "(infinity::'a::null option) \<noteq> null" - by( simp add:infinity_option_def null_is_valid null_option_def bot_option_def) - show "(infinity::'a::null option) \<noteq> bot" - by( simp add:infinity_option_def null_option_def bot_option_def) - qed -end - -instantiation "fun" :: (type,infinity) infinity -begin - definition infinity_fun_def: "(infinity::'a \<Rightarrow> 'b::infinity) \<equiv> (\<lambda> x. infinity)" - - instance proof - show "(infinity::'a \<Rightarrow> 'b::infinity) \<noteq> bot" - apply(auto simp: infinity_fun_def bot_fun_def) - apply(drule_tac x=x in fun_cong) - apply(erule contrapos_pp, simp add: infinity_is_valid) - done - show "(infinity::'a \<Rightarrow> 'b::infinity) \<noteq> null" - apply(auto simp: infinity_fun_def null_fun_def) - apply(drule_tac x=x in fun_cong) - apply(erule contrapos_pp, simp add: infinity_is_defined) - done - qed -end - -type_synonym ('\<AA>,'\<alpha>) val' = "'\<AA> st \<Rightarrow> '\<alpha>::infinity" - -definition limitedNatural :: "('\<AA>,'a::infinity)val' \<Rightarrow> ('\<AA>)Boolean" ("\<mu> _" [100]100) -where "\<mu> X \<equiv> \<lambda> \<tau> . if X \<tau> = bot \<tau> \<or> X \<tau> = null \<tau> \<or> X \<tau> = infinity \<tau> then false \<tau> else true \<tau>" - -lemma (*valid*)[simp]: "\<upsilon> infinity = true" - by(rule ext, simp add: bot_fun_def infinity_fun_def infinity_is_valid valid_def) - -lemma (*defined*)[simp]: "\<delta> infinity = true" - by(rule ext, simp add: bot_fun_def defined_def infinity_fun_def infinity_is_defined infinity_is_valid null_fun_def) - -lemma (*limitedNatural*)[simp]: "\<mu> invalid = false" - by(rule ext, simp add: bot_fun_def invalid_def limitedNatural_def) - -lemma (*limitedNatural*)[simp]: "\<mu> null = false" - by(rule ext, simp add: limitedNatural_def) - -lemma (*limitedNatural*)[simp]: "\<mu> infinity = false" - by(rule ext, simp add: limitedNatural_def) - -section{* UML Types *} - -text{* Since @{term "UnlimitedNatural"} is again a basic type, we define its semantic domain -as the valuations over @{typ "nat option option option"}. *} -type_synonym UnlimitedNatural\<^sub>b\<^sub>a\<^sub>s\<^sub>e = "nat option option option" -type_synonym ('\<AA>)UnlimitedNatural = "('\<AA>, UnlimitedNatural\<^sub>b\<^sub>a\<^sub>s\<^sub>e) val'" - -section{* Basic Types UnlimitedNatural: Operations *} - -subsection{* Fundamental Predicates on UnlimitedNaturals: Strict Equality *} - -text{* The last basic operation belonging to the fundamental infrastructure -of a value-type in OCL is the weak equality, which is defined similar -to the @{typ "('\<AA>)Boolean"}-case as strict extension of the strong equality:*} -overloading StrictRefEq \<equiv> "StrictRefEq :: [('\<AA>)UnlimitedNatural,('\<AA>)UnlimitedNatural] \<Rightarrow> ('\<AA>)Boolean" -begin - definition StrictRefEq\<^sub>U\<^sub>n\<^sub>l\<^sub>i\<^sub>m\<^sub>i\<^sub>t\<^sub>e\<^sub>d\<^sub>N\<^sub>a\<^sub>t\<^sub>u\<^sub>r\<^sub>a\<^sub>l[code_unfold] : - "(x::('\<AA>)UnlimitedNatural) \<doteq> y \<equiv> \<lambda> \<tau>. if (\<upsilon> x) \<tau> = true \<tau> \<and> (\<upsilon> y) \<tau> = true \<tau> - then (x \<triangleq> y) \<tau> - else invalid \<tau>" -end - -text{* Property proof in terms of @{term "profile_bin\<^sub>S\<^sub>t\<^sub>r\<^sub>o\<^sub>n\<^sub>g\<^sub>E\<^sub>q_\<^sub>v_\<^sub>v"}*} -interpretation StrictRefEq\<^sub>U\<^sub>n\<^sub>l\<^sub>i\<^sub>m\<^sub>i\<^sub>t\<^sub>e\<^sub>d\<^sub>N\<^sub>a\<^sub>t\<^sub>u\<^sub>r\<^sub>a\<^sub>l : profile_bin\<^sub>S\<^sub>t\<^sub>r\<^sub>o\<^sub>n\<^sub>g\<^sub>E\<^sub>q_\<^sub>v_\<^sub>v "\<lambda> x y. (x::('\<AA>)UnlimitedNatural) \<doteq> y" - by unfold_locales (auto simp: StrictRefEq\<^sub>U\<^sub>n\<^sub>l\<^sub>i\<^sub>m\<^sub>i\<^sub>t\<^sub>e\<^sub>d\<^sub>N\<^sub>a\<^sub>t\<^sub>u\<^sub>r\<^sub>a\<^sub>l) - -subsection{* Basic UnlimitedNatural Constants *} - -text{* Although the remaining part of this library reasons about -integers abstractly, we provide here as example some convenient shortcuts. *} - -locale OclUnlimitedNatural - -definition OclNat0 ::"('\<AA>)UnlimitedNatural" (*"\<zero>"*) -where "OclNat0(*\<zero>*) = (\<lambda> _ . \<lfloor>\<lfloor>\<lfloor>0::nat\<rfloor>\<rfloor>\<rfloor>)" - -definition OclNat1 ::"('\<AA>)UnlimitedNatural" (*"\<one>"*) -where "OclNat1(*\<one>*) = (\<lambda> _ . \<lfloor>\<lfloor>\<lfloor>1::nat\<rfloor>\<rfloor>\<rfloor>)" - -definition OclNat2 ::"('\<AA>)UnlimitedNatural" (*"\<two>"*) -where "OclNat2(*\<two>*) = (\<lambda> _ . \<lfloor>\<lfloor>\<lfloor>2::nat\<rfloor>\<rfloor>\<rfloor>)" - -definition OclNat3 ::"('\<AA>)UnlimitedNatural" (*"\<three>"*) -where "OclNat3(*\<three>*) = (\<lambda> _ . \<lfloor>\<lfloor>\<lfloor>3::nat\<rfloor>\<rfloor>\<rfloor>)" - -definition OclNat4 ::"('\<AA>)UnlimitedNatural" (*"\<four>"*) -where "OclNat4(*\<four>*) = (\<lambda> _ . \<lfloor>\<lfloor>\<lfloor>4::nat\<rfloor>\<rfloor>\<rfloor>)" - -definition OclNat5 ::"('\<AA>)UnlimitedNatural" (*"\<five>"*) -where "OclNat5(*\<five>*) = (\<lambda> _ . \<lfloor>\<lfloor>\<lfloor>5::nat\<rfloor>\<rfloor>\<rfloor>)" - -definition OclNat6 ::"('\<AA>)UnlimitedNatural" (*"\<six>"*) -where "OclNat6(*\<six>*) = (\<lambda> _ . \<lfloor>\<lfloor>\<lfloor>6::nat\<rfloor>\<rfloor>\<rfloor>)" - -definition OclNat7 ::"('\<AA>)UnlimitedNatural" (*"\<seven>"*) -where "OclNat7(*\<seven>*) = (\<lambda> _ . \<lfloor>\<lfloor>\<lfloor>7::nat\<rfloor>\<rfloor>\<rfloor>)" - -definition OclNat8 ::"('\<AA>)UnlimitedNatural" (*"\<eight>"*) -where "OclNat8(*\<eight>*) = (\<lambda> _ . \<lfloor>\<lfloor>\<lfloor>8::nat\<rfloor>\<rfloor>\<rfloor>)" - -definition OclNat9 ::"('\<AA>)UnlimitedNatural" (*"\<nine>"*) -where "OclNat9(*\<nine>*) = (\<lambda> _ . \<lfloor>\<lfloor>\<lfloor>9::nat\<rfloor>\<rfloor>\<rfloor>)" - -definition OclNat10 ::"('\<AA>)UnlimitedNatural" (*"\<one>\<zero>"*) -where "OclNat10(*\<one>\<zero>*) = (\<lambda> _ . \<lfloor>\<lfloor>\<lfloor>10::nat\<rfloor>\<rfloor>\<rfloor>)" - -context OclUnlimitedNatural -begin - -abbreviation OclNat_0 ("\<zero>") where "\<zero> \<equiv> OclNat0" -abbreviation OclNat_1 ("\<one>") where "\<one> \<equiv> OclNat1" -abbreviation OclNat_2 ("\<two>") where "\<two> \<equiv> OclNat2" -abbreviation OclNat_3 ("\<three>") where "\<three> \<equiv> OclNat3" -abbreviation OclNat_4 ("\<four>") where "\<four> \<equiv> OclNat4" -abbreviation OclNat_5 ("\<five>") where "\<five> \<equiv> OclNat5" -abbreviation OclNat_6 ("\<six>") where "\<six> \<equiv> OclNat6" -abbreviation OclNat_7 ("\<seven>") where "\<seven> \<equiv> OclNat7" -abbreviation OclNat_8 ("\<eight>") where "\<eight> \<equiv> OclNat8" -abbreviation OclNat_9 ("\<nine>") where "\<nine> \<equiv> OclNat9" -abbreviation OclNat_10 ("\<one>\<zero>") where "\<one>\<zero> \<equiv> OclNat10" - -end - -definition OclNat_infinity :: "('\<AA>)UnlimitedNatural" ("\<infinity>") -where "\<infinity> = (\<lambda>_. \<lfloor>\<lfloor>None\<rfloor>\<rfloor>)" - -subsection{* Validity and Definedness Properties *} - -lemma "\<delta>(null::('\<AA>)UnlimitedNatural) = false" by simp -lemma "\<upsilon>(null::('\<AA>)UnlimitedNatural) = true" by simp - -lemma [simp,code_unfold]: "\<delta> (\<lambda>_. \<lfloor>\<lfloor>\<lfloor>n\<rfloor>\<rfloor>\<rfloor>) = true" -by(simp add:defined_def true_def - bot_fun_def bot_option_def null_fun_def null_option_def) - -lemma [simp,code_unfold]: "\<upsilon> (\<lambda>_. \<lfloor>\<lfloor>\<lfloor>n\<rfloor>\<rfloor>\<rfloor>) = true" -by(simp add:valid_def true_def - bot_fun_def bot_option_def) - -lemma [simp,code_unfold]: "\<mu> (\<lambda>_. \<lfloor>\<lfloor>\<lfloor>n\<rfloor>\<rfloor>\<rfloor>) = true" -by(simp add: limitedNatural_def true_def - bot_fun_def bot_option_def null_fun_def null_option_def infinity_fun_def infinity_option_def) - -(* ecclectic proofs to make examples executable *) -lemma [simp,code_unfold]: "\<delta> OclNat0 = true" by(simp add:OclNat0_def) -lemma [simp,code_unfold]: "\<upsilon> OclNat0 = true" by(simp add:OclNat0_def) - - -subsection{* Arithmetical Operations *} - -subsubsection{* Definition *} -text{* Here is a common case of a built-in operation on built-in types. -Note that the arguments must be both defined (non-null, non-bot). *} -text{* Note that we can not follow the lexis of the OCL Standard for Isabelle -technical reasons; these operators are heavily overloaded in the HOL library -that a further overloading would lead to heavy technical buzz in this -document. -*} -definition OclAdd\<^sub>U\<^sub>n\<^sub>l\<^sub>i\<^sub>m\<^sub>i\<^sub>t\<^sub>e\<^sub>d\<^sub>N\<^sub>a\<^sub>t\<^sub>u\<^sub>r\<^sub>a\<^sub>l ::"('\<AA>)UnlimitedNatural \<Rightarrow> ('\<AA>)UnlimitedNatural \<Rightarrow> ('\<AA>)UnlimitedNatural" (infix "+\<^sub>n\<^sub>a\<^sub>t" 40) -where "x +\<^sub>n\<^sub>a\<^sub>t y \<equiv> \<lambda> \<tau>. if (\<mu> x) \<tau> = true \<tau> \<and> (\<mu> y) \<tau> = true \<tau> - then \<lfloor>\<lfloor>\<lfloor>\<lceil>\<lceil>\<lceil>x \<tau>\<rceil>\<rceil>\<rceil> + \<lceil>\<lceil>\<lceil>y \<tau>\<rceil>\<rceil>\<rceil>\<rfloor>\<rfloor>\<rfloor> - else invalid \<tau> " -interpretation OclAdd\<^sub>U\<^sub>n\<^sub>l\<^sub>i\<^sub>m\<^sub>i\<^sub>t\<^sub>e\<^sub>d\<^sub>N\<^sub>a\<^sub>t\<^sub>u\<^sub>r\<^sub>a\<^sub>l : profile_bin\<^sub>d_\<^sub>d "(+\<^sub>n\<^sub>a\<^sub>t)" "\<lambda> x y. \<lfloor>\<lfloor>\<lfloor>\<lceil>\<lceil>\<lceil>x\<rceil>\<rceil>\<rceil> + \<lceil>\<lceil>\<lceil>y\<rceil>\<rceil>\<rceil>\<rfloor>\<rfloor>\<rfloor>" - apply (unfold_locales, auto simp:OclAdd\<^sub>U\<^sub>n\<^sub>l\<^sub>i\<^sub>m\<^sub>i\<^sub>t\<^sub>e\<^sub>d\<^sub>N\<^sub>a\<^sub>t\<^sub>u\<^sub>r\<^sub>a\<^sub>l_def bot_option_def null_option_def infinity_option_def) - sorry -(* TODO: special locale setup.*) - - -definition OclMinus\<^sub>U\<^sub>n\<^sub>l\<^sub>i\<^sub>m\<^sub>i\<^sub>t\<^sub>e\<^sub>d\<^sub>N\<^sub>a\<^sub>t\<^sub>u\<^sub>r\<^sub>a\<^sub>l ::"('\<AA>)UnlimitedNatural \<Rightarrow> ('\<AA>)UnlimitedNatural \<Rightarrow> ('\<AA>)UnlimitedNatural" (infix "-\<^sub>n\<^sub>a\<^sub>t" 41) -where "x -\<^sub>n\<^sub>a\<^sub>t y \<equiv> \<lambda> \<tau>. if (\<mu> x) \<tau> = true \<tau> \<and> (\<mu> y) \<tau> = true \<tau> - then \<lfloor>\<lfloor>\<lfloor>\<lceil>\<lceil>\<lceil>x \<tau>\<rceil>\<rceil>\<rceil> - \<lceil>\<lceil>\<lceil>y \<tau>\<rceil>\<rceil>\<rceil>\<rfloor>\<rfloor>\<rfloor> - else invalid \<tau> " -interpretation OclMinus\<^sub>U\<^sub>n\<^sub>l\<^sub>i\<^sub>m\<^sub>i\<^sub>t\<^sub>e\<^sub>d\<^sub>N\<^sub>a\<^sub>t\<^sub>u\<^sub>r\<^sub>a\<^sub>l : profile_bin\<^sub>d_\<^sub>d "(-\<^sub>n\<^sub>a\<^sub>t)" "\<lambda> x y. \<lfloor>\<lfloor>\<lfloor>\<lceil>\<lceil>\<lceil>x\<rceil>\<rceil>\<rceil> - \<lceil>\<lceil>\<lceil>y\<rceil>\<rceil>\<rceil>\<rfloor>\<rfloor>\<rfloor>" - apply (unfold_locales, auto simp:OclMinus\<^sub>U\<^sub>n\<^sub>l\<^sub>i\<^sub>m\<^sub>i\<^sub>t\<^sub>e\<^sub>d\<^sub>N\<^sub>a\<^sub>t\<^sub>u\<^sub>r\<^sub>a\<^sub>l_def bot_option_def null_option_def infinity_option_def) - sorry -(* TODO: special locale setup.*) - - -definition OclMult\<^sub>U\<^sub>n\<^sub>l\<^sub>i\<^sub>m\<^sub>i\<^sub>t\<^sub>e\<^sub>d\<^sub>N\<^sub>a\<^sub>t\<^sub>u\<^sub>r\<^sub>a\<^sub>l ::"('\<AA>)UnlimitedNatural \<Rightarrow> ('\<AA>)UnlimitedNatural \<Rightarrow> ('\<AA>)UnlimitedNatural" (infix "*\<^sub>n\<^sub>a\<^sub>t" 45) -where "x *\<^sub>n\<^sub>a\<^sub>t y \<equiv> \<lambda> \<tau>. if (\<mu> x) \<tau> = true \<tau> \<and> (\<mu> y) \<tau> = true \<tau> - then \<lfloor>\<lfloor>\<lfloor>\<lceil>\<lceil>\<lceil>x \<tau>\<rceil>\<rceil>\<rceil> * \<lceil>\<lceil>\<lceil>y \<tau>\<rceil>\<rceil>\<rceil>\<rfloor>\<rfloor>\<rfloor> - else invalid \<tau> " -interpretation OclMult\<^sub>U\<^sub>n\<^sub>l\<^sub>i\<^sub>m\<^sub>i\<^sub>t\<^sub>e\<^sub>d\<^sub>N\<^sub>a\<^sub>t\<^sub>u\<^sub>r\<^sub>a\<^sub>l : profile_bin\<^sub>d_\<^sub>d "( *\<^sub>n\<^sub>a\<^sub>t)" "\<lambda> x y. \<lfloor>\<lfloor>\<lfloor>\<lceil>\<lceil>\<lceil>x\<rceil>\<rceil>\<rceil> * \<lceil>\<lceil>\<lceil>y\<rceil>\<rceil>\<rceil>\<rfloor>\<rfloor>\<rfloor>" - apply (unfold_locales, auto simp:OclMult\<^sub>U\<^sub>n\<^sub>l\<^sub>i\<^sub>m\<^sub>i\<^sub>t\<^sub>e\<^sub>d\<^sub>N\<^sub>a\<^sub>t\<^sub>u\<^sub>r\<^sub>a\<^sub>l_def bot_option_def null_option_def infinity_option_def) - sorry -(* TODO: special locale setup.*) - -text{* Here is the special case of division, which is defined as invalid for division -by zero. *} -definition OclDivision\<^sub>U\<^sub>n\<^sub>l\<^sub>i\<^sub>m\<^sub>i\<^sub>t\<^sub>e\<^sub>d\<^sub>N\<^sub>a\<^sub>t\<^sub>u\<^sub>r\<^sub>a\<^sub>l ::"('\<AA>)UnlimitedNatural \<Rightarrow> ('\<AA>)UnlimitedNatural \<Rightarrow> ('\<AA>)UnlimitedNatural" (infix "div\<^sub>n\<^sub>a\<^sub>t" 45) -where "x div\<^sub>n\<^sub>a\<^sub>t y \<equiv> \<lambda> \<tau>. if (\<mu> x) \<tau> = true \<tau> \<and> (\<mu> y) \<tau> = true \<tau> - then if y \<tau> \<noteq> OclNat0 \<tau> then \<lfloor>\<lfloor>\<lfloor>\<lceil>\<lceil>\<lceil>x \<tau>\<rceil>\<rceil>\<rceil> div \<lceil>\<lceil>\<lceil>y \<tau>\<rceil>\<rceil>\<rceil>\<rfloor>\<rfloor>\<rfloor> else invalid \<tau> - else invalid \<tau> " -(* TODO: special locale setup.*) - - -definition OclModulus\<^sub>U\<^sub>n\<^sub>l\<^sub>i\<^sub>m\<^sub>i\<^sub>t\<^sub>e\<^sub>d\<^sub>N\<^sub>a\<^sub>t\<^sub>u\<^sub>r\<^sub>a\<^sub>l ::"('\<AA>)UnlimitedNatural \<Rightarrow> ('\<AA>)UnlimitedNatural \<Rightarrow> ('\<AA>)UnlimitedNatural" (infix "mod\<^sub>n\<^sub>a\<^sub>t" 45) -where "x mod\<^sub>n\<^sub>a\<^sub>t y \<equiv> \<lambda> \<tau>. if (\<mu> x) \<tau> = true \<tau> \<and> (\<mu> y) \<tau> = true \<tau> - then if y \<tau> \<noteq> OclNat0 \<tau> then \<lfloor>\<lfloor>\<lfloor>\<lceil>\<lceil>\<lceil>x \<tau>\<rceil>\<rceil>\<rceil> mod \<lceil>\<lceil>\<lceil>y \<tau>\<rceil>\<rceil>\<rceil>\<rfloor>\<rfloor>\<rfloor> else invalid \<tau> - else invalid \<tau> " -(* TODO: special locale setup.*) - - -definition OclLess\<^sub>U\<^sub>n\<^sub>l\<^sub>i\<^sub>m\<^sub>i\<^sub>t\<^sub>e\<^sub>d\<^sub>N\<^sub>a\<^sub>t\<^sub>u\<^sub>r\<^sub>a\<^sub>l ::"('\<AA>)UnlimitedNatural \<Rightarrow> ('\<AA>)UnlimitedNatural \<Rightarrow> ('\<AA>)Boolean" (infix "<\<^sub>n\<^sub>a\<^sub>t" 35) -where "x <\<^sub>n\<^sub>a\<^sub>t y \<equiv> \<lambda> \<tau>. if (\<mu> x) \<tau> = true \<tau> \<and> (\<mu> y) \<tau> = true \<tau> - then \<lfloor>\<lfloor>\<lceil>\<lceil>\<lceil>x \<tau>\<rceil>\<rceil>\<rceil> < \<lceil>\<lceil>\<lceil>y \<tau>\<rceil>\<rceil>\<rceil>\<rfloor>\<rfloor> - else if (\<delta> x) \<tau> = true \<tau> \<and> (\<delta> y) \<tau> = true \<tau> - then (\<mu> x) \<tau> - else invalid \<tau>" -interpretation OclLess\<^sub>U\<^sub>n\<^sub>l\<^sub>i\<^sub>m\<^sub>i\<^sub>t\<^sub>e\<^sub>d\<^sub>N\<^sub>a\<^sub>t\<^sub>u\<^sub>r\<^sub>a\<^sub>l : profile_bin\<^sub>d_\<^sub>d "(<\<^sub>n\<^sub>a\<^sub>t)" "\<lambda> x y. \<lfloor>\<lfloor>\<lceil>\<lceil>\<lceil>x\<rceil>\<rceil>\<rceil> < \<lceil>\<lceil>\<lceil>y\<rceil>\<rceil>\<rceil>\<rfloor>\<rfloor>" - apply (unfold_locales, auto simp:OclLess\<^sub>U\<^sub>n\<^sub>l\<^sub>i\<^sub>m\<^sub>i\<^sub>t\<^sub>e\<^sub>d\<^sub>N\<^sub>a\<^sub>t\<^sub>u\<^sub>r\<^sub>a\<^sub>l_def bot_option_def null_option_def infinity_option_def) - oops -(* TODO: special locale setup.*) - -definition OclLe\<^sub>U\<^sub>n\<^sub>l\<^sub>i\<^sub>m\<^sub>i\<^sub>t\<^sub>e\<^sub>d\<^sub>N\<^sub>a\<^sub>t\<^sub>u\<^sub>r\<^sub>a\<^sub>l ::"('\<AA>)UnlimitedNatural \<Rightarrow> ('\<AA>)UnlimitedNatural \<Rightarrow> ('\<AA>)Boolean" (infix "\<le>\<^sub>n\<^sub>a\<^sub>t" 35) -where "x \<le>\<^sub>n\<^sub>a\<^sub>t y \<equiv> \<lambda> \<tau>. if (\<mu> x) \<tau> = true \<tau> \<and> (\<mu> y) \<tau> = true \<tau> - then \<lfloor>\<lfloor>\<lceil>\<lceil>\<lceil>x \<tau>\<rceil>\<rceil>\<rceil> \<le> \<lceil>\<lceil>\<lceil>y \<tau>\<rceil>\<rceil>\<rceil>\<rfloor>\<rfloor> - else if (\<delta> x) \<tau> = true \<tau> \<and> (\<delta> y) \<tau> = true \<tau> - then not (\<mu> y) \<tau> - else invalid \<tau>" -interpretation OclLe\<^sub>U\<^sub>n\<^sub>l\<^sub>i\<^sub>m\<^sub>i\<^sub>t\<^sub>e\<^sub>d\<^sub>N\<^sub>a\<^sub>t\<^sub>u\<^sub>r\<^sub>a\<^sub>l : profile_bin\<^sub>d_\<^sub>d "(\<le>\<^sub>n\<^sub>a\<^sub>t)" "\<lambda> x y. \<lfloor>\<lfloor>\<lceil>\<lceil>\<lceil>x\<rceil>\<rceil>\<rceil> \<le> \<lceil>\<lceil>\<lceil>y\<rceil>\<rceil>\<rceil>\<rfloor>\<rfloor>" - apply (unfold_locales, auto simp:OclLe\<^sub>U\<^sub>n\<^sub>l\<^sub>i\<^sub>m\<^sub>i\<^sub>t\<^sub>e\<^sub>d\<^sub>N\<^sub>a\<^sub>t\<^sub>u\<^sub>r\<^sub>a\<^sub>l_def bot_option_def null_option_def infinity_option_def) - oops -(* TODO: special locale setup.*) - -abbreviation OclAdd_\<^sub>U\<^sub>n\<^sub>l\<^sub>i\<^sub>m\<^sub>i\<^sub>t\<^sub>e\<^sub>d\<^sub>N\<^sub>a\<^sub>t\<^sub>u\<^sub>r\<^sub>a\<^sub>l (infix "+\<^sub>U\<^sub>N" 40) where "x +\<^sub>U\<^sub>N y \<equiv> OclAdd\<^sub>U\<^sub>n\<^sub>l\<^sub>i\<^sub>m\<^sub>i\<^sub>t\<^sub>e\<^sub>d\<^sub>N\<^sub>a\<^sub>t\<^sub>u\<^sub>r\<^sub>a\<^sub>l x y" -abbreviation OclMinus_\<^sub>U\<^sub>n\<^sub>l\<^sub>i\<^sub>m\<^sub>i\<^sub>t\<^sub>e\<^sub>d\<^sub>N\<^sub>a\<^sub>t\<^sub>u\<^sub>r\<^sub>a\<^sub>l (infix "-\<^sub>U\<^sub>N" 41) where "x -\<^sub>U\<^sub>N y \<equiv> OclMinus\<^sub>U\<^sub>n\<^sub>l\<^sub>i\<^sub>m\<^sub>i\<^sub>t\<^sub>e\<^sub>d\<^sub>N\<^sub>a\<^sub>t\<^sub>u\<^sub>r\<^sub>a\<^sub>l x y" -abbreviation OclMult_\<^sub>U\<^sub>n\<^sub>l\<^sub>i\<^sub>m\<^sub>i\<^sub>t\<^sub>e\<^sub>d\<^sub>N\<^sub>a\<^sub>t\<^sub>u\<^sub>r\<^sub>a\<^sub>l (infix "*\<^sub>U\<^sub>N" 45) where "x *\<^sub>U\<^sub>N y \<equiv> OclMult\<^sub>U\<^sub>n\<^sub>l\<^sub>i\<^sub>m\<^sub>i\<^sub>t\<^sub>e\<^sub>d\<^sub>N\<^sub>a\<^sub>t\<^sub>u\<^sub>r\<^sub>a\<^sub>l x y" -abbreviation OclDivision_\<^sub>U\<^sub>n\<^sub>l\<^sub>i\<^sub>m\<^sub>i\<^sub>t\<^sub>e\<^sub>d\<^sub>N\<^sub>a\<^sub>t\<^sub>u\<^sub>r\<^sub>a\<^sub>l (infix "div\<^sub>U\<^sub>N" 45) where "x div\<^sub>U\<^sub>N y \<equiv> OclDivision\<^sub>U\<^sub>n\<^sub>l\<^sub>i\<^sub>m\<^sub>i\<^sub>t\<^sub>e\<^sub>d\<^sub>N\<^sub>a\<^sub>t\<^sub>u\<^sub>r\<^sub>a\<^sub>l x y" -abbreviation OclModulus_\<^sub>U\<^sub>n\<^sub>l\<^sub>i\<^sub>m\<^sub>i\<^sub>t\<^sub>e\<^sub>d\<^sub>N\<^sub>a\<^sub>t\<^sub>u\<^sub>r\<^sub>a\<^sub>l (infix "mod\<^sub>U\<^sub>N" 45) where "x mod\<^sub>U\<^sub>N y \<equiv> OclModulus\<^sub>U\<^sub>n\<^sub>l\<^sub>i\<^sub>m\<^sub>i\<^sub>t\<^sub>e\<^sub>d\<^sub>N\<^sub>a\<^sub>t\<^sub>u\<^sub>r\<^sub>a\<^sub>l x y" -abbreviation OclLess_\<^sub>U\<^sub>n\<^sub>l\<^sub>i\<^sub>m\<^sub>i\<^sub>t\<^sub>e\<^sub>d\<^sub>N\<^sub>a\<^sub>t\<^sub>u\<^sub>r\<^sub>a\<^sub>l (infix "<\<^sub>U\<^sub>N" 35) where "x <\<^sub>U\<^sub>N y \<equiv> OclLess\<^sub>U\<^sub>n\<^sub>l\<^sub>i\<^sub>m\<^sub>i\<^sub>t\<^sub>e\<^sub>d\<^sub>N\<^sub>a\<^sub>t\<^sub>u\<^sub>r\<^sub>a\<^sub>l x y" -abbreviation OclLe_\<^sub>U\<^sub>n\<^sub>l\<^sub>i\<^sub>m\<^sub>i\<^sub>t\<^sub>e\<^sub>d\<^sub>N\<^sub>a\<^sub>t\<^sub>u\<^sub>r\<^sub>a\<^sub>l (infix "\<le>\<^sub>U\<^sub>N" 35) where "x \<le>\<^sub>U\<^sub>N y \<equiv> OclLe\<^sub>U\<^sub>n\<^sub>l\<^sub>i\<^sub>m\<^sub>i\<^sub>t\<^sub>e\<^sub>d\<^sub>N\<^sub>a\<^sub>t\<^sub>u\<^sub>r\<^sub>a\<^sub>l x y" - -subsubsection{* Basic Properties *} - -lemma OclAdd\<^sub>U\<^sub>n\<^sub>l\<^sub>i\<^sub>m\<^sub>i\<^sub>t\<^sub>e\<^sub>d\<^sub>N\<^sub>a\<^sub>t\<^sub>u\<^sub>r\<^sub>a\<^sub>l_commute: "(X +\<^sub>n\<^sub>a\<^sub>t Y) = (Y +\<^sub>n\<^sub>a\<^sub>t X)" - by(rule ext,auto simp:true_def false_def OclAdd\<^sub>U\<^sub>n\<^sub>l\<^sub>i\<^sub>m\<^sub>i\<^sub>t\<^sub>e\<^sub>d\<^sub>N\<^sub>a\<^sub>t\<^sub>u\<^sub>r\<^sub>a\<^sub>l_def invalid_def - split: option.split option.split_asm - bool.split bool.split_asm) - -subsubsection{* Execution with Invalid or Null or Zero as Argument *} - -lemma OclAdd\<^sub>U\<^sub>n\<^sub>l\<^sub>i\<^sub>m\<^sub>i\<^sub>t\<^sub>e\<^sub>d\<^sub>N\<^sub>a\<^sub>t\<^sub>u\<^sub>r\<^sub>a\<^sub>l_zero1[simp,code_unfold] : -"(x +\<^sub>n\<^sub>a\<^sub>t OclNat0) = (if \<upsilon> x and not (\<delta> x) then invalid else x endif)" - proof (rule ext, rename_tac \<tau>, case_tac "(\<upsilon> x and not (\<delta> x)) \<tau> = true \<tau>") - fix \<tau> show "(\<upsilon> x and not (\<delta> x)) \<tau> = true \<tau> \<Longrightarrow> - (x +\<^sub>n\<^sub>a\<^sub>t OclNat0) \<tau> = (if \<upsilon> x and not (\<delta> x) then invalid else x endif) \<tau>" - apply(subst OclIf_true', simp add: OclValid_def) - sorry - next fix \<tau> - have A: "\<And>\<tau>. (\<tau> \<Turnstile> not (\<upsilon> x and not (\<delta> x))) = (x \<tau> = invalid \<tau> \<or> \<tau> \<Turnstile> \<delta> x)" - by (metis OclNot_not OclOr_def defined5 defined6 defined_not_I foundation11 foundation18' - foundation6 foundation7 foundation9 invalid_def) - have B: "\<tau> \<Turnstile> \<delta> x \<Longrightarrow> \<lfloor>\<lfloor>\<lceil>\<lceil>x \<tau>\<rceil>\<rceil>\<rfloor>\<rfloor> = x \<tau>" - apply(cases "x \<tau>", metis bot_option_def foundation16) - apply(rename_tac x', case_tac x', metis bot_option_def foundation16 null_option_def) - by(simp) - show "(x +\<^sub>n\<^sub>a\<^sub>t OclNat0) \<tau> = (if \<upsilon> x and not (\<delta> x) then invalid else x endif) \<tau>" - when "\<tau> \<Turnstile> not (\<upsilon> x and not (\<delta> x))" - apply(insert that, subst OclIf_false', simp, simp add: A, auto simp: OclAdd\<^sub>U\<^sub>n\<^sub>l\<^sub>i\<^sub>m\<^sub>i\<^sub>t\<^sub>e\<^sub>d\<^sub>N\<^sub>a\<^sub>t\<^sub>u\<^sub>r\<^sub>a\<^sub>l_def OclNat0_def) - (* *) - sorry - apply_end(metis OclValid_def defined5 defined6 defined_and_I defined_not_I foundation9) -oops - -lemma OclAdd\<^sub>U\<^sub>n\<^sub>l\<^sub>i\<^sub>m\<^sub>i\<^sub>t\<^sub>e\<^sub>d\<^sub>N\<^sub>a\<^sub>t\<^sub>u\<^sub>r\<^sub>a\<^sub>l_zero2[simp,code_unfold] : -"(OclNat0 +\<^sub>n\<^sub>a\<^sub>t x) = (if \<upsilon> x and not (\<delta> x) then invalid else x endif)" -apply(subst OclAdd\<^sub>U\<^sub>n\<^sub>l\<^sub>i\<^sub>m\<^sub>i\<^sub>t\<^sub>e\<^sub>d\<^sub>N\<^sub>a\<^sub>t\<^sub>u\<^sub>r\<^sub>a\<^sub>l_commute, simp?) -oops - -(* TODO Basic proproperties for multiplication, division, modulus. *) - - - -subsubsection{* Test Statements *} -text{* Here follows a list of code-examples, that explain the meanings -of the above definitions by compilation to code and execution to @{term "True"}.*} - -context OclUnlimitedNatural -begin -Assert_local "\<tau> \<Turnstile> ( \<nine> \<le>\<^sub>U\<^sub>N \<one>\<zero> )" -Assert_local "\<tau> \<Turnstile> (( \<four> +\<^sub>U\<^sub>N \<four> ) \<le>\<^sub>U\<^sub>N \<one>\<zero> )" -Assert_local "\<tau> |\<noteq> (( \<four> +\<^sub>U\<^sub>N ( \<four> +\<^sub>U\<^sub>N \<four> )) <\<^sub>U\<^sub>N \<one>\<zero> )" -Assert_local "\<tau> \<Turnstile> (\<zero> \<le>\<^sub>n\<^sub>a\<^sub>t \<infinity>)" -Assert_local "\<tau> \<Turnstile> not (\<upsilon> (null +\<^sub>U\<^sub>N \<one>))" -Assert_local "\<tau> \<Turnstile> not (\<upsilon> (\<infinity> +\<^sub>n\<^sub>a\<^sub>t \<zero>))" -Assert_local "\<tau> \<Turnstile> \<mu> \<one>" -end -Assert "\<tau> \<Turnstile> not (\<upsilon> (null +\<^sub>n\<^sub>a\<^sub>t \<infinity>))" -Assert "\<tau> \<Turnstile> not (\<infinity> <\<^sub>n\<^sub>a\<^sub>t \<infinity>)" -Assert "\<tau> \<Turnstile> not (\<upsilon> (invalid \<le>\<^sub>n\<^sub>a\<^sub>t \<infinity>))" -Assert "\<tau> \<Turnstile> not (\<upsilon> (null \<le>\<^sub>n\<^sub>a\<^sub>t \<infinity>))" -Assert "\<tau> \<Turnstile> \<upsilon> \<infinity>" -Assert "\<tau> \<Turnstile> \<delta> \<infinity>" -Assert "\<tau> \<Turnstile> not (\<mu> \<infinity>)" - - - -lemma integer_non_null [simp]: "((\<lambda>_. \<lfloor>\<lfloor>n\<rfloor>\<rfloor>) \<doteq> (null::('\<AA>)UnlimitedNatural)) = false" -by(rule ext,auto simp: StrictRefEq\<^sub>U\<^sub>n\<^sub>l\<^sub>i\<^sub>m\<^sub>i\<^sub>t\<^sub>e\<^sub>d\<^sub>N\<^sub>a\<^sub>t\<^sub>u\<^sub>r\<^sub>a\<^sub>l valid_def - bot_fun_def bot_option_def null_fun_def null_option_def StrongEq_def) - -lemma null_non_integer [simp]: "((null::('\<AA>)UnlimitedNatural) \<doteq> (\<lambda>_. \<lfloor>\<lfloor>n\<rfloor>\<rfloor>)) = false" -by(rule ext,auto simp: StrictRefEq\<^sub>U\<^sub>n\<^sub>l\<^sub>i\<^sub>m\<^sub>i\<^sub>t\<^sub>e\<^sub>d\<^sub>N\<^sub>a\<^sub>t\<^sub>u\<^sub>r\<^sub>a\<^sub>l valid_def - bot_fun_def bot_option_def null_fun_def null_option_def StrongEq_def) - -lemma OclNat0_non_null [simp,code_unfold]: "(OclNat0 \<doteq> null) = false" by(simp add: OclNat0_def) -lemma null_non_OclNat0 [simp,code_unfold]: "(null \<doteq> OclNat0) = false" by(simp add: OclNat0_def) - - -subsection{* Test Statements on Basic UnlimitedNatural *} -text{* Here follows a list of code-examples, that explain the meanings -of the above definitions by compilation to code and execution to @{term "True"}.*} - - -text{* Elementary computations on UnlimitedNatural *} - -Assert "\<tau> \<Turnstile> OclNat0 <> OclNat1" -Assert "\<tau> \<Turnstile> OclNat1 <> OclNat0" -Assert "\<tau> \<Turnstile> OclNat0 \<doteq> OclNat0" - -Assert "\<tau> \<Turnstile> \<upsilon> OclNat0" -Assert "\<tau> \<Turnstile> \<delta> OclNat0" -Assert "\<tau> \<Turnstile> \<upsilon> (null::('\<AA>)UnlimitedNatural)" -Assert "\<tau> \<Turnstile> (invalid \<triangleq> invalid)" -Assert "\<tau> \<Turnstile> (null \<triangleq> null)" -Assert "\<tau> |\<noteq> (invalid \<doteq> (invalid::('\<AA>)UnlimitedNatural))" (* Without typeconstraint not executable.*) -Assert "\<tau> |\<noteq> \<upsilon> (invalid \<doteq> (invalid::('\<AA>)UnlimitedNatural))" (* Without typeconstraint not executable.*) -Assert "\<tau> |\<noteq> (invalid <> (invalid::('\<AA>)UnlimitedNatural))" (* Without typeconstraint not executable.*) -Assert "\<tau> |\<noteq> \<upsilon> (invalid <> (invalid::('\<AA>)UnlimitedNatural))" (* Without typeconstraint not executable.*) -Assert "\<tau> \<Turnstile> (null \<doteq> (null::('\<AA>)UnlimitedNatural) )" (* Without typeconstraint not executable.*) -Assert "\<tau> \<Turnstile> (null \<doteq> (null::('\<AA>)UnlimitedNatural) )" (* Without typeconstraint not executable.*) -Assert "\<tau> |\<noteq> (OclNat0 <\<^sub>n\<^sub>a\<^sub>t null)" -Assert "\<tau> |\<noteq> (\<delta> (OclNat0 <\<^sub>n\<^sub>a\<^sub>t null))" - - -end diff --git a/Citadelle/src/basic_types/UML_Void.thy b/Citadelle/src/basic_types/UML_Void.thy deleted file mode 100644 index b6a2f2d71c0b3f242e967aded635ebad36229528..0000000000000000000000000000000000000000 --- a/Citadelle/src/basic_types/UML_Void.thy +++ /dev/null @@ -1,141 +0,0 @@ -(****************************************************************************** - * 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_Void -imports "../UML_PropertyProfiles" -begin - -section{* Basic Type Void: Operations *} - -(* For technical reasons, the type does not contain to the null-class yet. *) -text {* This \emph{minimal} OCL type contains only two elements: -@{term "invalid"} and @{term "null"}. -@{term "Void"} could initially be defined as @{typ "unit option option"}, -however the cardinal of this type is more than two, so it would have the cost to consider - @{text "Some None"} and @{text "Some (Some ())"} seemingly everywhere.*} - -subsection{* Fundamental Properties on Voids: Strict Equality *} - -subsubsection{* Definition *} - -instantiation Void\<^sub>b\<^sub>a\<^sub>s\<^sub>e :: bot -begin - definition bot_Void_def: "(bot_class.bot :: Void\<^sub>b\<^sub>a\<^sub>s\<^sub>e) \<equiv> Abs_Void\<^sub>b\<^sub>a\<^sub>s\<^sub>e None" - - instance proof show "\<exists>x:: Void\<^sub>b\<^sub>a\<^sub>s\<^sub>e. x \<noteq> bot" - apply(rule_tac x="Abs_Void\<^sub>b\<^sub>a\<^sub>s\<^sub>e \<lfloor>None\<rfloor>" in exI) - apply(simp add:bot_Void_def, subst Abs_Void\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inject) - apply(simp_all add: null_option_def bot_option_def) - done - qed -end - -instantiation Void\<^sub>b\<^sub>a\<^sub>s\<^sub>e :: null -begin - definition null_Void_def: "(null::Void\<^sub>b\<^sub>a\<^sub>s\<^sub>e) \<equiv> Abs_Void\<^sub>b\<^sub>a\<^sub>s\<^sub>e \<lfloor> None \<rfloor>" - - instance proof show "(null:: Void\<^sub>b\<^sub>a\<^sub>s\<^sub>e) \<noteq> bot" - apply(simp add:null_Void_def bot_Void_def, subst Abs_Void\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inject) - apply(simp_all add: null_option_def bot_option_def) - done - qed -end - - -text{* The last basic operation belonging to the fundamental infrastructure -of a value-type in OCL is the weak equality, which is defined similar -to the @{typ "('\<AA>)Void"}-case as strict extension of the strong equality:*} -overloading StrictRefEq \<equiv> "StrictRefEq :: [('\<AA>)Void,('\<AA>)Void] \<Rightarrow> ('\<AA>)Boolean" -begin - definition StrictRefEq\<^sub>V\<^sub>o\<^sub>i\<^sub>d[code_unfold] : - "(x::('\<AA>)Void) \<doteq> y \<equiv> \<lambda> \<tau>. if (\<upsilon> x) \<tau> = true \<tau> \<and> (\<upsilon> y) \<tau> = true \<tau> - then (x \<triangleq> y) \<tau> - else invalid \<tau>" -end - -text{* Property proof in terms of @{term "profile_bin\<^sub>S\<^sub>t\<^sub>r\<^sub>o\<^sub>n\<^sub>g\<^sub>E\<^sub>q_\<^sub>v_\<^sub>v"}*} -interpretation StrictRefEq\<^sub>V\<^sub>o\<^sub>i\<^sub>d : profile_bin\<^sub>S\<^sub>t\<^sub>r\<^sub>o\<^sub>n\<^sub>g\<^sub>E\<^sub>q_\<^sub>v_\<^sub>v "\<lambda> x y. (x::('\<AA>)Void) \<doteq> y" - by unfold_locales (auto simp: StrictRefEq\<^sub>V\<^sub>o\<^sub>i\<^sub>d) - - -subsection{* Basic Void Constants *} - - -subsection{* Validity and Definedness Properties *} - -lemma "\<delta>(null::('\<AA>)Void) = false" by simp -lemma "\<upsilon>(null::('\<AA>)Void) = true" by simp - -lemma [simp,code_unfold]: "\<delta> (\<lambda>_. Abs_Void\<^sub>b\<^sub>a\<^sub>s\<^sub>e None) = false" -apply(simp add:defined_def true_def - bot_fun_def bot_option_def) -apply(rule ext, simp split:, intro conjI impI) -by(simp add: bot_Void_def) - -lemma [simp,code_unfold]: "\<upsilon> (\<lambda>_. Abs_Void\<^sub>b\<^sub>a\<^sub>s\<^sub>e None) = false" -apply(simp add:valid_def true_def - bot_fun_def bot_option_def) -apply(rule ext, simp split:, intro conjI impI) -by(simp add: bot_Void_def) - -lemma [simp,code_unfold]: "\<delta> (\<lambda>_. Abs_Void\<^sub>b\<^sub>a\<^sub>s\<^sub>e \<lfloor>None\<rfloor>) = false" -apply(simp add:defined_def true_def - bot_fun_def bot_option_def null_fun_def null_option_def) -apply(rule ext, simp split:, intro conjI impI) -by(simp add: null_Void_def) - -lemma [simp,code_unfold]: "\<upsilon> (\<lambda>_. Abs_Void\<^sub>b\<^sub>a\<^sub>s\<^sub>e \<lfloor>None\<rfloor>) = true" -apply(simp add:valid_def true_def - bot_fun_def bot_option_def) -apply(rule ext, simp split:, intro conjI impI) -by(metis null_Void_def null_is_valid, simp add: true_def) - - -subsection{* Test Statements *} - -Assert "\<tau> \<Turnstile> ((null::('\<AA>)Void) \<doteq> null)" - - -end diff --git a/Citadelle/src/collection_types/UML_Bag.thy b/Citadelle/src/collection_types/UML_Bag.thy deleted file mode 100644 index abdb69869311428b85e927ae6f65ca036629e8e5..0000000000000000000000000000000000000000 --- a/Citadelle/src/collection_types/UML_Bag.thy +++ /dev/null @@ -1,3180 +0,0 @@ -(****************************************************************************** - * 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_Bag -imports "../basic_types/UML_Void" - "../basic_types/UML_Boolean" - "../basic_types/UML_Integer" - "../basic_types/UML_String" - "../basic_types/UML_Real" -begin - -no_notation None ("\<bottom>") -section{* Collection Type Bag: Operations *} - -definition "Rep_Bag_base' x = {(x0, y). y < \<lceil>\<lceil>Rep_Bag\<^sub>b\<^sub>a\<^sub>s\<^sub>e x\<rceil>\<rceil> x0 }" -definition "Rep_Bag_base x \<tau> = {(x0, y). y < \<lceil>\<lceil>Rep_Bag\<^sub>b\<^sub>a\<^sub>s\<^sub>e (x \<tau>)\<rceil>\<rceil> x0 }" -definition "Rep_Set_base x \<tau> = fst ` {(x0, y). y < \<lceil>\<lceil>Rep_Bag\<^sub>b\<^sub>a\<^sub>s\<^sub>e (x \<tau>)\<rceil>\<rceil> x0 }" - -definition ApproxEq (infixl "\<cong>" 30) -where "X \<cong> Y \<equiv> \<lambda> \<tau>. \<lfloor>\<lfloor>Rep_Set_base X \<tau> = Rep_Set_base Y \<tau> \<rfloor>\<rfloor>" - - -subsection{* As a Motivation for the (infinite) Type Construction: Type-Extensions as Bags - \label{sec:bag-type-extensions}*} - -text{* Our notion of typed bag goes beyond the usual notion of a finite executable bag and -is powerful enough to capture \emph{the extension of a type} in UML and OCL. This means -we can have in Featherweight OCL Bags containing all possible elements of a type, not only -those (finite) ones representable in a state. This holds for base types as well as class types, -although the notion for class-types --- involving object id's not occurring in a state --- -requires some care. - -In a world with @{term invalid} and @{term null}, there are two notions extensions possible: -\begin{enumerate} -\item the bag of all \emph{defined} values of a type @{term T} - (for which we will introduce the constant @{term T}) -\item the bag of all \emph{valid} values of a type @{term T}, so including @{term null} - (for which we will introduce the constant @{term T\<^sub>n\<^sub>u\<^sub>l\<^sub>l}). -\end{enumerate} -*} - -text{* We define the bag extensions for the base type @{term Integer} as follows: *} -definition Integer :: "('\<AA>,Integer\<^sub>b\<^sub>a\<^sub>s\<^sub>e) Bag" -where "Integer \<equiv> (\<lambda> \<tau>. (Abs_Bag\<^sub>b\<^sub>a\<^sub>s\<^sub>e o Some o Some) (\<lambda> None \<Rightarrow> 0 | Some None \<Rightarrow> 0 | _ \<Rightarrow> 1))" - -definition Integer\<^sub>n\<^sub>u\<^sub>l\<^sub>l :: "('\<AA>,Integer\<^sub>b\<^sub>a\<^sub>s\<^sub>e) Bag" -where "Integer\<^sub>n\<^sub>u\<^sub>l\<^sub>l \<equiv> (\<lambda> \<tau>. (Abs_Bag\<^sub>b\<^sub>a\<^sub>s\<^sub>e o Some o Some) (\<lambda> None \<Rightarrow> 0 | _ \<Rightarrow> 1))" - -lemma Integer_defined : "\<delta> Integer = true" -apply(rule ext, auto simp: Integer_def defined_def false_def true_def - bot_fun_def null_fun_def null_option_def) -by(simp_all add: Abs_Bag\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inject bot_option_def bot_Bag\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def null_Bag\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def null_option_def) - -lemma Integer\<^sub>n\<^sub>u\<^sub>l\<^sub>l_defined : "\<delta> Integer\<^sub>n\<^sub>u\<^sub>l\<^sub>l = true" -apply(rule ext, auto simp: Integer\<^sub>n\<^sub>u\<^sub>l\<^sub>l_def defined_def false_def true_def - bot_fun_def null_fun_def null_option_def) -by(simp_all add: Abs_Bag\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inject bot_option_def bot_Bag\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def null_Bag\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def null_option_def) - -text{* This allows the theorems: - - @{text "\<tau> \<Turnstile> \<delta> x \<Longrightarrow> \<tau> \<Turnstile> (Integer->includes\<^sub>B\<^sub>a\<^sub>g(x))"} - @{text "\<tau> \<Turnstile> \<delta> x \<Longrightarrow> \<tau> \<Turnstile> Integer \<triangleq> (Integer->including\<^sub>B\<^sub>a\<^sub>g(x))"} - -and - - @{text "\<tau> \<Turnstile> \<upsilon> x \<Longrightarrow> \<tau> \<Turnstile> (Integer\<^sub>n\<^sub>u\<^sub>l\<^sub>l->includes\<^sub>B\<^sub>a\<^sub>g(x))"} - @{text "\<tau> \<Turnstile> \<upsilon> x \<Longrightarrow> \<tau> \<Turnstile> Integer\<^sub>n\<^sub>u\<^sub>l\<^sub>l \<triangleq> (Integer\<^sub>n\<^sub>u\<^sub>l\<^sub>l->including\<^sub>B\<^sub>a\<^sub>g(x))"} - -which characterize the infiniteness of these bags by a recursive property on these bags. -*} - -text{* In the same spirit, we proceed similarly for the remaining base types: *} - -definition Void\<^sub>n\<^sub>u\<^sub>l\<^sub>l :: "('\<AA>,Void\<^sub>b\<^sub>a\<^sub>s\<^sub>e) Bag" -where "Void\<^sub>n\<^sub>u\<^sub>l\<^sub>l \<equiv> (\<lambda> \<tau>. (Abs_Bag\<^sub>b\<^sub>a\<^sub>s\<^sub>e o Some o Some) (\<lambda> x. if x = Abs_Void\<^sub>b\<^sub>a\<^sub>s\<^sub>e (Some None) then 1 else 0))" - -definition Void\<^sub>e\<^sub>m\<^sub>p\<^sub>t\<^sub>y :: "('\<AA>,Void\<^sub>b\<^sub>a\<^sub>s\<^sub>e) Bag" -where "Void\<^sub>e\<^sub>m\<^sub>p\<^sub>t\<^sub>y \<equiv> (\<lambda> \<tau>. (Abs_Bag\<^sub>b\<^sub>a\<^sub>s\<^sub>e o Some o Some) (\<lambda>_. 0))" - -lemma Void\<^sub>n\<^sub>u\<^sub>l\<^sub>l_defined : "\<delta> Void\<^sub>n\<^sub>u\<^sub>l\<^sub>l = true" -apply(rule ext, auto simp: Void\<^sub>n\<^sub>u\<^sub>l\<^sub>l_def defined_def false_def true_def - bot_fun_def null_fun_def null_option_def - bot_Bag\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def null_Bag\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def) -by((subst (asm) Abs_Bag\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inject, auto simp add: bot_option_def null_option_def bot_Void_def), - (subst (asm) Abs_Void\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inject, auto simp add: bot_option_def null_option_def))+ - -lemma Void\<^sub>e\<^sub>m\<^sub>p\<^sub>t\<^sub>y_defined : "\<delta> Void\<^sub>e\<^sub>m\<^sub>p\<^sub>t\<^sub>y = true" -apply(rule ext, auto simp: Void\<^sub>e\<^sub>m\<^sub>p\<^sub>t\<^sub>y_def defined_def false_def true_def - bot_fun_def null_fun_def null_option_def - bot_Bag\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def null_Bag\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def) -by((subst (asm) Abs_Bag\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inject, auto simp add: bot_option_def null_option_def bot_Void_def))+ - -lemma assumes "\<tau> \<Turnstile> \<delta> (V :: ('\<AA>,Void\<^sub>b\<^sub>a\<^sub>s\<^sub>e) Bag)" - shows "\<tau> \<Turnstile> V \<cong> Void\<^sub>n\<^sub>u\<^sub>l\<^sub>l \<or> \<tau> \<Turnstile> V \<cong> Void\<^sub>e\<^sub>m\<^sub>p\<^sub>t\<^sub>y" -proof - - have A:"\<And>x y. x \<noteq> {} \<Longrightarrow> \<exists>y. y\<in> x" - by (metis all_not_in_conv) -show "?thesis" - apply(case_tac "V \<tau>") - proof - fix y show "V \<tau> = Abs_Bag\<^sub>b\<^sub>a\<^sub>s\<^sub>e y \<Longrightarrow> - y \<in> {X. X = \<bottom> \<or> X = null \<or> \<lceil>\<lceil>X\<rceil>\<rceil> \<bottom> = 0} \<Longrightarrow> - \<tau> \<Turnstile> V \<cong> Void\<^sub>n\<^sub>u\<^sub>l\<^sub>l \<or> \<tau> \<Turnstile> V \<cong> Void\<^sub>e\<^sub>m\<^sub>p\<^sub>t\<^sub>y" - apply(insert assms, case_tac y, simp add: bot_option_def, simp add: bot_Bag\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def foundation16) - apply(simp add: bot_option_def null_option_def) - apply(erule disjE, metis OclValid_def defined_def foundation2 null_Bag\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def null_fun_def true_def) - proof - fix a show "V \<tau> = Abs_Bag\<^sub>b\<^sub>a\<^sub>s\<^sub>e \<lfloor>a\<rfloor> \<Longrightarrow> \<lceil>a\<rceil> \<bottom> = 0 \<Longrightarrow> \<tau> \<Turnstile> V \<cong> Void\<^sub>n\<^sub>u\<^sub>l\<^sub>l \<or> \<tau> \<Turnstile> V \<cong> Void\<^sub>e\<^sub>m\<^sub>p\<^sub>t\<^sub>y" - apply(case_tac a, simp, insert assms, metis OclValid_def foundation16 null_Bag\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def true_def) - apply(simp) - proof - fix aa show " V \<tau> = Abs_Bag\<^sub>b\<^sub>a\<^sub>s\<^sub>e \<lfloor>\<lfloor>aa\<rfloor>\<rfloor> \<Longrightarrow> aa \<bottom> = 0 \<Longrightarrow> \<tau> \<Turnstile> V \<cong> Void\<^sub>n\<^sub>u\<^sub>l\<^sub>l \<or> \<tau> \<Turnstile> V \<cong> Void\<^sub>e\<^sub>m\<^sub>p\<^sub>t\<^sub>y" - apply(case_tac "aa (Abs_Void\<^sub>b\<^sub>a\<^sub>s\<^sub>e \<lfloor>None\<rfloor>) = 0", - rule disjI2, - insert assms, - simp add: Void\<^sub>e\<^sub>m\<^sub>p\<^sub>t\<^sub>y_def OclValid_def ApproxEq_def Rep_Set_base_def true_def Abs_Bag\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inverse image_def) - apply(intro allI) - proof - fix x fix b show " V \<tau> = Abs_Bag\<^sub>b\<^sub>a\<^sub>s\<^sub>e \<lfloor>\<lfloor>aa\<rfloor>\<rfloor> \<Longrightarrow> aa \<bottom> = 0 \<Longrightarrow> aa (Abs_Void\<^sub>b\<^sub>a\<^sub>s\<^sub>e \<lfloor>None\<rfloor>) = 0 \<Longrightarrow> (\<delta> V) \<tau> = \<lfloor>\<lfloor>True\<rfloor>\<rfloor> \<Longrightarrow> \<not> b < aa x" - apply (case_tac x, auto) - apply (simp add: bot_Void_def bot_option_def) - apply (simp add: bot_option_def null_option_def) - done - apply_end(simp+, rule disjI1) - show "V \<tau> = Abs_Bag\<^sub>b\<^sub>a\<^sub>s\<^sub>e \<lfloor>\<lfloor>aa\<rfloor>\<rfloor> \<Longrightarrow> aa \<bottom> = 0 \<Longrightarrow> 0 < aa (Abs_Void\<^sub>b\<^sub>a\<^sub>s\<^sub>e \<lfloor>None\<rfloor>) \<Longrightarrow> \<tau> \<Turnstile> \<delta> V \<Longrightarrow> \<tau> \<Turnstile> V \<cong> Void\<^sub>n\<^sub>u\<^sub>l\<^sub>l" - apply(simp add: Void\<^sub>n\<^sub>u\<^sub>l\<^sub>l_def OclValid_def ApproxEq_def Rep_Set_base_def true_def Abs_Bag\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inverse image_def, - subst Abs_Bag\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inverse, simp) - using bot_Void_def apply auto[1] - apply(simp) - apply(rule equalityI, rule subsetI, simp) - proof - fix x show "V \<tau> = Abs_Bag\<^sub>b\<^sub>a\<^sub>s\<^sub>e \<lfloor>\<lfloor>aa\<rfloor>\<rfloor> \<Longrightarrow> - aa \<bottom> = 0 \<Longrightarrow> 0 < aa (Abs_Void\<^sub>b\<^sub>a\<^sub>s\<^sub>e \<lfloor>None\<rfloor>) \<Longrightarrow> (\<delta> V) \<tau> = \<lfloor>\<lfloor>True\<rfloor>\<rfloor> \<Longrightarrow> \<exists>b. b < aa x \<Longrightarrow> x = Abs_Void\<^sub>b\<^sub>a\<^sub>s\<^sub>e \<lfloor>None\<rfloor>" - apply( case_tac x, auto) - apply (simp add: bot_Void_def bot_option_def) - by (simp add: bot_option_def null_option_def) - qed ((simp add: bot_Void_def bot_option_def)+, blast) -qed qed qed qed qed - -definition Boolean :: "('\<AA>,Boolean\<^sub>b\<^sub>a\<^sub>s\<^sub>e) Bag" -where "Boolean \<equiv> (\<lambda> \<tau>. (Abs_Bag\<^sub>b\<^sub>a\<^sub>s\<^sub>e o Some o Some) (\<lambda> None \<Rightarrow> 0 | Some None \<Rightarrow> 0 | _ \<Rightarrow> 1))" - -definition Boolean\<^sub>n\<^sub>u\<^sub>l\<^sub>l :: "('\<AA>,Boolean\<^sub>b\<^sub>a\<^sub>s\<^sub>e) Bag" -where "Boolean\<^sub>n\<^sub>u\<^sub>l\<^sub>l \<equiv> (\<lambda> \<tau>. (Abs_Bag\<^sub>b\<^sub>a\<^sub>s\<^sub>e o Some o Some) (\<lambda> None \<Rightarrow> 0 | _ \<Rightarrow> 1))" - -lemma Boolean_defined : "\<delta> Boolean = true" -apply(rule ext, auto simp: Boolean_def defined_def false_def true_def - bot_fun_def null_fun_def null_option_def) -by(simp_all add: Abs_Bag\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inject bot_option_def bot_Bag\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def null_Bag\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def null_option_def) - -lemma Boolean\<^sub>n\<^sub>u\<^sub>l\<^sub>l_defined : "\<delta> Boolean\<^sub>n\<^sub>u\<^sub>l\<^sub>l = true" -apply(rule ext, auto simp: Boolean\<^sub>n\<^sub>u\<^sub>l\<^sub>l_def defined_def false_def true_def - bot_fun_def null_fun_def null_option_def) -by(simp_all add: Abs_Bag\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inject bot_option_def bot_Bag\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def null_Bag\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def null_option_def) - -definition String :: "('\<AA>,String\<^sub>b\<^sub>a\<^sub>s\<^sub>e) Bag" -where "String \<equiv> (\<lambda> \<tau>. (Abs_Bag\<^sub>b\<^sub>a\<^sub>s\<^sub>e o Some o Some) (\<lambda> None \<Rightarrow> 0 | Some None \<Rightarrow> 0 | _ \<Rightarrow> 1))" - -definition String\<^sub>n\<^sub>u\<^sub>l\<^sub>l :: "('\<AA>,String\<^sub>b\<^sub>a\<^sub>s\<^sub>e) Bag" -where "String\<^sub>n\<^sub>u\<^sub>l\<^sub>l \<equiv> (\<lambda> \<tau>. (Abs_Bag\<^sub>b\<^sub>a\<^sub>s\<^sub>e o Some o Some) (\<lambda> None \<Rightarrow> 0 | _ \<Rightarrow> 1))" - -lemma String_defined : "\<delta> String = true" -apply(rule ext, auto simp: String_def defined_def false_def true_def - bot_fun_def null_fun_def null_option_def) -by(simp_all add: Abs_Bag\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inject bot_option_def bot_Bag\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def null_Bag\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def null_option_def) - -lemma String\<^sub>n\<^sub>u\<^sub>l\<^sub>l_defined : "\<delta> String\<^sub>n\<^sub>u\<^sub>l\<^sub>l = true" -apply(rule ext, auto simp: String\<^sub>n\<^sub>u\<^sub>l\<^sub>l_def defined_def false_def true_def - bot_fun_def null_fun_def null_option_def) -by(simp_all add: Abs_Bag\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inject bot_option_def bot_Bag\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def null_Bag\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def null_option_def) - -definition Real :: "('\<AA>,Real\<^sub>b\<^sub>a\<^sub>s\<^sub>e) Bag" -where "Real \<equiv> (\<lambda> \<tau>. (Abs_Bag\<^sub>b\<^sub>a\<^sub>s\<^sub>e o Some o Some) (\<lambda> None \<Rightarrow> 0 | Some None \<Rightarrow> 0 | _ \<Rightarrow> 1))" - -definition Real\<^sub>n\<^sub>u\<^sub>l\<^sub>l :: "('\<AA>,Real\<^sub>b\<^sub>a\<^sub>s\<^sub>e) Bag" -where "Real\<^sub>n\<^sub>u\<^sub>l\<^sub>l \<equiv> (\<lambda> \<tau>. (Abs_Bag\<^sub>b\<^sub>a\<^sub>s\<^sub>e o Some o Some) (\<lambda> None \<Rightarrow> 0 | _ \<Rightarrow> 1))" - -lemma Real_defined : "\<delta> Real = true" -apply(rule ext, auto simp: Real_def defined_def false_def true_def - bot_fun_def null_fun_def null_option_def) -by(simp_all add: Abs_Bag\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inject bot_option_def bot_Bag\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def null_Bag\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def null_option_def) - -lemma Real\<^sub>n\<^sub>u\<^sub>l\<^sub>l_defined : "\<delta> Real\<^sub>n\<^sub>u\<^sub>l\<^sub>l = true" -apply(rule ext, auto simp: Real\<^sub>n\<^sub>u\<^sub>l\<^sub>l_def defined_def false_def true_def - bot_fun_def null_fun_def null_option_def) -by(simp_all add: Abs_Bag\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inject bot_option_def bot_Bag\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def null_Bag\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def null_option_def) - -subsection{* Basic Properties of the Bag Type*} - -text{* Every element in a defined bag is valid. *} - -lemma Bag_inv_lemma: "\<tau> \<Turnstile> (\<delta> X) \<Longrightarrow> \<lceil>\<lceil>Rep_Bag\<^sub>b\<^sub>a\<^sub>s\<^sub>e (X \<tau>)\<rceil>\<rceil> bot = 0" -apply(insert Rep_Bag\<^sub>b\<^sub>a\<^sub>s\<^sub>e [of "X \<tau>"], simp) -apply(auto simp: OclValid_def defined_def false_def true_def cp_def - bot_fun_def bot_Bag\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def null_Bag\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def null_fun_def - split:if_split_asm) - apply(erule contrapos_pp [of "Rep_Bag\<^sub>b\<^sub>a\<^sub>s\<^sub>e (X \<tau>) = bot"]) - apply(subst Abs_Bag\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inject[symmetric], rule Rep_Bag\<^sub>b\<^sub>a\<^sub>s\<^sub>e, simp) - apply(simp add: Rep_Bag\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inverse bot_Bag\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def bot_option_def) -apply(erule contrapos_pp [of "Rep_Bag\<^sub>b\<^sub>a\<^sub>s\<^sub>e (X \<tau>) = null"]) -apply(subst Abs_Bag\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inject[symmetric], rule Rep_Bag\<^sub>b\<^sub>a\<^sub>s\<^sub>e, simp) -apply(simp add: Rep_Bag\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inverse null_option_def) -by (simp add: bot_option_def) - -lemma Bag_inv_lemma' : - assumes x_def : "\<tau> \<Turnstile> \<delta> X" - and e_mem : "\<lceil>\<lceil>Rep_Bag\<^sub>b\<^sub>a\<^sub>s\<^sub>e (X \<tau>)\<rceil>\<rceil> e \<ge> 1" - shows "\<tau> \<Turnstile> \<upsilon> (\<lambda>_. e)" -apply(case_tac "e = bot", insert assms, drule Bag_inv_lemma, simp) -by (simp add: foundation18') - -lemma abs_rep_simp' : - assumes S_all_def : "\<tau> \<Turnstile> \<delta> S" - shows "Abs_Bag\<^sub>b\<^sub>a\<^sub>s\<^sub>e \<lfloor>\<lfloor>\<lceil>\<lceil>Rep_Bag\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil>\<rfloor>\<rfloor> = S \<tau>" -proof - - have discr_eq_false_true : "\<And>\<tau>. (false \<tau> = true \<tau>) = False" by(simp add: false_def true_def) - show ?thesis - apply(insert S_all_def, simp add: OclValid_def defined_def) - apply(rule mp[OF Abs_Bag\<^sub>b\<^sub>a\<^sub>s\<^sub>e_induct[where P = "\<lambda>S. (if S = \<bottom> \<tau> \<or> S = null \<tau> - then false \<tau> else true \<tau>) = true \<tau> \<longrightarrow> - Abs_Bag\<^sub>b\<^sub>a\<^sub>s\<^sub>e \<lfloor>\<lfloor>\<lceil>\<lceil>Rep_Bag\<^sub>b\<^sub>a\<^sub>s\<^sub>e S\<rceil>\<rceil>\<rfloor>\<rfloor> = S"]], - rename_tac S') - apply(simp add: Abs_Bag\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inverse discr_eq_false_true) - apply(case_tac S') apply(simp add: bot_fun_def bot_Bag\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def)+ - apply(rename_tac S'', case_tac S'') apply(simp add: null_fun_def null_Bag\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def)+ - done -qed - -lemma invalid_bag_OclNot_defined [simp,code_unfold]:"\<delta>(invalid::('\<AA>,'\<alpha>::null) Bag) = false" by simp -lemma null_bag_OclNot_defined [simp,code_unfold]:"\<delta>(null::('\<AA>,'\<alpha>::null) Bag) = false" -by(simp add: defined_def null_fun_def) -lemma invalid_bag_valid [simp,code_unfold]:"\<upsilon>(invalid::('\<AA>,'\<alpha>::null) Bag) = false" -by simp -lemma null_bag_valid [simp,code_unfold]:"\<upsilon>(null::('\<AA>,'\<alpha>::null) Bag) = true" -apply(simp add: valid_def null_fun_def bot_fun_def bot_Bag\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def null_Bag\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def) -apply(subst Abs_Bag\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inject,simp_all add: null_option_def bot_option_def) -done - -text{* ... which means that we can have a type @{text "('\<AA>,('\<AA>,('\<AA>) Integer) Bag) Bag"} -corresponding exactly to Bag(Bag(Integer)) in OCL notation. Note that the parameter -@{text "'\<AA>"} still refers to the object universe; making the OCL semantics entirely parametric -in the object universe makes it possible to study (and prove) its properties -independently from a concrete class diagram. *} - -subsection{* Definition: Strict Equality \label{sec:bag-strict-equality}*} - -text{* After the part of foundational operations on bags, we detail here equality on bags. -Strong equality is inherited from the OCL core, but we have to consider -the case of the strict equality. We decide to overload strict equality in the -same way we do for other value's in OCL:*} - -overloading StrictRefEq \<equiv> "StrictRefEq :: [('\<AA>,'\<alpha>::null)Bag,('\<AA>,'\<alpha>::null)Bag] \<Rightarrow> ('\<AA>)Boolean" -begin - definition StrictRefEq\<^sub>B\<^sub>a\<^sub>g : - "(x::('\<AA>,'\<alpha>::null)Bag) \<doteq> y \<equiv> \<lambda> \<tau>. if (\<upsilon> x) \<tau> = true \<tau> \<and> (\<upsilon> y) \<tau> = true \<tau> - then (x \<triangleq> y)\<tau> - else invalid \<tau>" -end - -text{* One might object here that for the case of objects, this is an empty definition. -The answer is no, we will restrain later on states and objects such that any object -has its oid stored inside the object (so the ref, under which an object can be referenced -in the store will represented in the object itself). For such well-formed stores that satisfy -this invariant (the WFF-invariant), the referential equality and the -strong equality---and therefore the strict equality on bags in the sense above---coincides.*} - -text{* Property proof in terms of @{term "profile_bin\<^sub>S\<^sub>t\<^sub>r\<^sub>o\<^sub>n\<^sub>g\<^sub>E\<^sub>q_\<^sub>v_\<^sub>v"}*} -interpretation StrictRefEq\<^sub>B\<^sub>a\<^sub>g : profile_bin\<^sub>S\<^sub>t\<^sub>r\<^sub>o\<^sub>n\<^sub>g\<^sub>E\<^sub>q_\<^sub>v_\<^sub>v "\<lambda> x y. (x::('\<AA>,'\<alpha>::null)Bag) \<doteq> y" - by unfold_locales (auto simp: StrictRefEq\<^sub>B\<^sub>a\<^sub>g) - - - -subsection{* Constants: mtBag *} -definition mtBag::"('\<AA>,'\<alpha>::null) Bag" ("Bag{}") -where "Bag{} \<equiv> (\<lambda> \<tau>. Abs_Bag\<^sub>b\<^sub>a\<^sub>s\<^sub>e \<lfloor>\<lfloor>\<lambda>_. 0::nat\<rfloor>\<rfloor> )" - - -lemma mtBag_defined[simp,code_unfold]:"\<delta>(Bag{}) = true" -apply(rule ext, auto simp: mtBag_def defined_def null_Bag\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def - bot_Bag\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def bot_fun_def null_fun_def) -by(simp_all add: Abs_Bag\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inject bot_option_def null_option_def) - -lemma mtBag_valid[simp,code_unfold]:"\<upsilon>(Bag{}) = true" -apply(rule ext,auto simp: mtBag_def valid_def - bot_Bag\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def bot_fun_def null_fun_def) -by(simp_all add: Abs_Bag\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inject bot_option_def null_option_def) - -lemma mtBag_rep_bag: "\<lceil>\<lceil>Rep_Bag\<^sub>b\<^sub>a\<^sub>s\<^sub>e (Bag{} \<tau>)\<rceil>\<rceil> = (\<lambda> _. 0)" - apply(simp add: mtBag_def, subst Abs_Bag\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inverse) -by(simp add: bot_option_def)+ - -text_raw{* \isatagafp *} - -lemma [simp,code_unfold]: "const Bag{}" -by(simp add: const_def mtBag_def) - - -text{* Note that the collection types in OCL allow for null to be included; - however, there is the null-collection into which inclusion yields invalid. *} - -text_raw{* \endisatagafp *} - -subsection{* Definition: Including *} - -definition OclIncluding :: "[('\<AA>,'\<alpha>::null) Bag,('\<AA>,'\<alpha>) val] \<Rightarrow> ('\<AA>,'\<alpha>) Bag" -where "OclIncluding x y = (\<lambda> \<tau>. if (\<delta> x) \<tau> = true \<tau> \<and> (\<upsilon> y) \<tau> = true \<tau> - then Abs_Bag\<^sub>b\<^sub>a\<^sub>s\<^sub>e \<lfloor>\<lfloor> \<lceil>\<lceil>Rep_Bag\<^sub>b\<^sub>a\<^sub>s\<^sub>e(x \<tau>)\<rceil>\<rceil> - ((y \<tau>):=\<lceil>\<lceil>Rep_Bag\<^sub>b\<^sub>a\<^sub>s\<^sub>e(x \<tau>)\<rceil>\<rceil>(y \<tau>)+1) - \<rfloor>\<rfloor> - else invalid \<tau> )" -notation OclIncluding ("_->including\<^sub>B\<^sub>a\<^sub>g'(_')") - -interpretation OclIncluding : profile_bin\<^sub>d_\<^sub>v OclIncluding "\<lambda>x y. Abs_Bag\<^sub>b\<^sub>a\<^sub>s\<^sub>e\<lfloor>\<lfloor>\<lceil>\<lceil>Rep_Bag\<^sub>b\<^sub>a\<^sub>s\<^sub>e x\<rceil>\<rceil> - (y := \<lceil>\<lceil>Rep_Bag\<^sub>b\<^sub>a\<^sub>s\<^sub>e x\<rceil>\<rceil> y + 1)\<rfloor>\<rfloor>" -proof - - let ?X = "\<lambda>x y. \<lceil>\<lceil>Rep_Bag\<^sub>b\<^sub>a\<^sub>s\<^sub>e(x)\<rceil>\<rceil> ((y):=\<lceil>\<lceil>Rep_Bag\<^sub>b\<^sub>a\<^sub>s\<^sub>e(x)\<rceil>\<rceil>( y )+1)" - show "profile_bin\<^sub>d_\<^sub>v OclIncluding (\<lambda>x y. Abs_Bag\<^sub>b\<^sub>a\<^sub>s\<^sub>e \<lfloor>\<lfloor> ?X x y \<rfloor>\<rfloor>)" - apply unfold_locales - apply(auto simp:OclIncluding_def bot_option_def null_option_def - bot_Bag\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def null_Bag\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def) - by(subst (asm) Abs_Bag\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inject, simp_all, - metis (mono_tags, lifting) Rep_Bag\<^sub>b\<^sub>a\<^sub>s\<^sub>e Rep_Bag\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inverse bot_option_def mem_Collect_eq null_option_def, - simp add: bot_option_def null_option_def)+ -qed - -syntax - "_OclFinbag" :: "args => ('\<AA>,'a::null) Bag" ("Bag{(_)}") -translations - "Bag{x, xs}" == "CONST OclIncluding (Bag{xs}) x" - "Bag{x}" == "CONST OclIncluding (Bag{}) x " - - -subsection{* Definition: Excluding *} - -definition OclExcluding :: "[('\<AA>,'\<alpha>::null) Bag,('\<AA>,'\<alpha>) val] \<Rightarrow> ('\<AA>,'\<alpha>) Bag" -where "OclExcluding x y = (\<lambda> \<tau>. if (\<delta> x) \<tau> = true \<tau> \<and> (\<upsilon> y) \<tau> = true \<tau> - then Abs_Bag\<^sub>b\<^sub>a\<^sub>s\<^sub>e \<lfloor>\<lfloor> \<lceil>\<lceil>Rep_Bag\<^sub>b\<^sub>a\<^sub>s\<^sub>e (x \<tau>)\<rceil>\<rceil> ((y \<tau>):=0::nat) \<rfloor>\<rfloor> - else invalid \<tau> )" -notation OclExcluding ("_->excluding\<^sub>B\<^sub>a\<^sub>g'(_')") - -interpretation OclExcluding: profile_bin\<^sub>d_\<^sub>v OclExcluding - "\<lambda>x y. Abs_Bag\<^sub>b\<^sub>a\<^sub>s\<^sub>e \<lfloor>\<lfloor>\<lceil>\<lceil>Rep_Bag\<^sub>b\<^sub>a\<^sub>s\<^sub>e(x)\<rceil>\<rceil>(y:=0::nat)\<rfloor>\<rfloor>" -proof - - show "profile_bin\<^sub>d_\<^sub>v OclExcluding (\<lambda>x y. Abs_Bag\<^sub>b\<^sub>a\<^sub>s\<^sub>e \<lfloor>\<lfloor>\<lceil>\<lceil>Rep_Bag\<^sub>b\<^sub>a\<^sub>s\<^sub>e x\<rceil>\<rceil>(y := 0)\<rfloor>\<rfloor>)" - apply unfold_locales - apply(auto simp:OclExcluding_def bot_option_def null_option_def - null_Bag\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def bot_Bag\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def) - by(subst (asm) Abs_Bag\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inject, - simp_all add: bot_option_def null_option_def, - metis (mono_tags, lifting) Rep_Bag\<^sub>b\<^sub>a\<^sub>s\<^sub>e Rep_Bag\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inverse bot_option_def - mem_Collect_eq null_option_def)+ -qed - -subsection{* Definition: Includes *} - -definition OclIncludes :: "[('\<AA>,'\<alpha>::null) Bag,('\<AA>,'\<alpha>) val] \<Rightarrow> '\<AA> Boolean" -where "OclIncludes x y = (\<lambda> \<tau>. if (\<delta> x) \<tau> = true \<tau> \<and> (\<upsilon> y) \<tau> = true \<tau> - then \<lfloor>\<lfloor> \<lceil>\<lceil>Rep_Bag\<^sub>b\<^sub>a\<^sub>s\<^sub>e (x \<tau>)\<rceil>\<rceil> (y \<tau>) > 0 \<rfloor>\<rfloor> - else \<bottom> )" -notation OclIncludes ("_->includes\<^sub>B\<^sub>a\<^sub>g'(_')" (*[66,65]65*)) - -interpretation OclIncludes : profile_bin\<^sub>d_\<^sub>v OclIncludes "\<lambda>x y. \<lfloor>\<lfloor> \<lceil>\<lceil>Rep_Bag\<^sub>b\<^sub>a\<^sub>s\<^sub>e x\<rceil>\<rceil> y > 0 \<rfloor>\<rfloor>" -by(unfold_locales, auto simp:OclIncludes_def bot_option_def null_option_def invalid_def) - -subsection{* Definition: Excludes *} - -definition OclExcludes :: "[('\<AA>,'\<alpha>::null) Bag,('\<AA>,'\<alpha>) val] \<Rightarrow> '\<AA> Boolean" -where "OclExcludes x y = (not(OclIncludes x y))" -notation OclExcludes ("_->excludes\<^sub>B\<^sub>a\<^sub>g'(_')" (*[66,65]65*)) - -text{* The case of the size definition is somewhat special, we admit -explicitly in Featherweight OCL the possibility of infinite bags. For -the size definition, this requires an extra condition that assures -that the cardinality of the bag is actually a defined integer. *} - -interpretation OclExcludes : profile_bin\<^sub>d_\<^sub>v OclExcludes "\<lambda>x y. \<lfloor>\<lfloor> \<lceil>\<lceil>Rep_Bag\<^sub>b\<^sub>a\<^sub>s\<^sub>e x\<rceil>\<rceil> y \<le> 0 \<rfloor>\<rfloor>" -by(unfold_locales, auto simp:OclExcludes_def OclIncludes_def OclNot_def bot_option_def null_option_def invalid_def) - -subsection{* Definition: Size *} - -definition OclSize :: "('\<AA>,'\<alpha>::null)Bag \<Rightarrow> '\<AA> Integer" -where "OclSize x = (\<lambda> \<tau>. if (\<delta> x) \<tau> = true \<tau> \<and> finite (Rep_Bag_base x \<tau>) - then \<lfloor>\<lfloor> int (card (Rep_Bag_base x \<tau>)) \<rfloor>\<rfloor> - else \<bottom> )" -notation (* standard ascii syntax *) - OclSize ("_->size\<^sub>B\<^sub>a\<^sub>g'(')" (*[66]*)) - -text{* The following definition follows the requirement of the -standard to treat null as neutral element of bags. It is -a well-documented exception from the general strictness -rule and the rule that the distinguished argument self should -be non-null. *} - -(*TODO Locale - Equivalent*) - - -subsection{* Definition: IsEmpty *} - -definition OclIsEmpty :: "('\<AA>,'\<alpha>::null) Bag \<Rightarrow> '\<AA> Boolean" -where "OclIsEmpty x = ((\<upsilon> x and not (\<delta> x)) or ((OclSize x) \<doteq> \<zero>))" -notation OclIsEmpty ("_->isEmpty\<^sub>B\<^sub>a\<^sub>g'(')" (*[66]*)) - -(*TODO Locale - Equivalent*) - -subsection{* Definition: NotEmpty *} - -definition OclNotEmpty :: "('\<AA>,'\<alpha>::null) Bag \<Rightarrow> '\<AA> Boolean" -where "OclNotEmpty x = not(OclIsEmpty x)" -notation OclNotEmpty ("_->notEmpty\<^sub>B\<^sub>a\<^sub>g'(')" (*[66]*)) - -(*TODO Locale - Equivalent*) - -subsection{* Definition: Any *} - -(* Slight breach of naming convention in order to avoid naming conflict on constant.*) -definition OclANY :: "[('\<AA>,'\<alpha>::null) Bag] \<Rightarrow> ('\<AA>,'\<alpha>) val" -where "OclANY x = (\<lambda> \<tau>. if (\<upsilon> x) \<tau> = true \<tau> - then if (\<delta> x and OclNotEmpty x) \<tau> = true \<tau> - then SOME y. y \<in> (Rep_Set_base x \<tau>) - else null \<tau> - else \<bottom> )" -notation OclANY ("_->any\<^sub>B\<^sub>a\<^sub>g'(')") - -(*TODO Locale - Equivalent*) - -(* actually, this definition covers only: X->any\<^sub>B\<^sub>a\<^sub>g(true) of the standard, which foresees -a (totally correct) high-level definition -source->any\<^sub>B\<^sub>a\<^sub>g(iterator | body) = -source->select(iterator | body)->asSequence()->first(). Since we don't have sequences, -we have to go for a direct---restricted---definition. *) - -subsection{* Definition: Forall *} - -text{* The definition of OclForall mimics the one of @{term "OclAnd"}: -OclForall is not a strict operation. *} -definition OclForall :: "[('\<AA>,'\<alpha>::null)Bag,('\<AA>,'\<alpha>)val\<Rightarrow>('\<AA>)Boolean] \<Rightarrow> '\<AA> Boolean" -where "OclForall S P = (\<lambda> \<tau>. if (\<delta> S) \<tau> = true \<tau> - then if (\<exists>x\<in>Rep_Set_base S \<tau>. P (\<lambda>_. x) \<tau> = false \<tau>) - then false \<tau> - else if (\<exists>x\<in>Rep_Set_base S \<tau>. P (\<lambda>_. x) \<tau> = invalid \<tau>) - then invalid \<tau> - else if (\<exists>x\<in>Rep_Set_base S \<tau>. P (\<lambda>_. x) \<tau> = null \<tau>) - then null \<tau> - else true \<tau> - else \<bottom>)" -syntax - "_OclForallBag" :: "[('\<AA>,'\<alpha>::null) Bag,id,('\<AA>)Boolean] \<Rightarrow> '\<AA> Boolean" ("(_)->forAll\<^sub>B\<^sub>a\<^sub>g'(_|_')") -translations - "X->forAll\<^sub>B\<^sub>a\<^sub>g(x | P)" == "CONST UML_Bag.OclForall X (%x. P)" - -(*TODO Locale - Equivalent*) - -subsection{* Definition: Exists *} - -text{* Like OclForall, OclExists is also not strict. *} -definition OclExists :: "[('\<AA>,'\<alpha>::null) Bag,('\<AA>,'\<alpha>)val\<Rightarrow>('\<AA>)Boolean] \<Rightarrow> '\<AA> Boolean" -where "OclExists S P = not(UML_Bag.OclForall S (\<lambda> X. not (P X)))" - -syntax - "_OclExistBag" :: "[('\<AA>,'\<alpha>::null) Bag,id,('\<AA>)Boolean] \<Rightarrow> '\<AA> Boolean" ("(_)->exists\<^sub>B\<^sub>a\<^sub>g'(_|_')") -translations - "X->exists\<^sub>B\<^sub>a\<^sub>g(x | P)" == "CONST UML_Bag.OclExists X (%x. P)" - -(*TODO Locale - Equivalent*) - -subsection{* Definition: Iterate *} - -definition OclIterate :: "[('\<AA>,'\<alpha>::null) Bag,('\<AA>,'\<beta>::null)val, - ('\<AA>,'\<alpha>)val\<Rightarrow>('\<AA>,'\<beta>)val\<Rightarrow>('\<AA>,'\<beta>)val] \<Rightarrow> ('\<AA>,'\<beta>)val" -where "OclIterate S A F = (\<lambda> \<tau>. if (\<delta> S) \<tau> = true \<tau> \<and> (\<upsilon> A) \<tau> = true \<tau> \<and> finite (Rep_Bag_base S \<tau>) - then Finite_Set.fold (F o (\<lambda>a \<tau>. a) o fst) A (Rep_Bag_base S \<tau>) \<tau> - else \<bottom>)" -syntax - "_OclIterateBag" :: "[('\<AA>,'\<alpha>::null) Bag, idt, idt, '\<alpha>, '\<beta>] => ('\<AA>,'\<gamma>)val" - ("_ ->iterate\<^sub>B\<^sub>a\<^sub>g'(_;_=_ | _')" (*[71,100,70]50*)) -translations - "X->iterate\<^sub>B\<^sub>a\<^sub>g(a; x = A | P)" == "CONST OclIterate X A (%a. (% x. P))" - -(*TODO Locale - Equivalent*) - -subsection{* Definition: Select *} - - -definition OclSelect :: "[('\<AA>,'\<alpha>::null)Bag,('\<AA>,'\<alpha>)val\<Rightarrow>('\<AA>)Boolean] \<Rightarrow> ('\<AA>,'\<alpha>)Bag" -where "OclSelect S P = (\<lambda>\<tau>. if (\<delta> S) \<tau> = true \<tau> - then if (\<exists>x\<in>Rep_Set_base S \<tau>. P(\<lambda> _. x) \<tau> = invalid \<tau>) - then invalid \<tau> - else Abs_Bag\<^sub>b\<^sub>a\<^sub>s\<^sub>e \<lfloor>\<lfloor>\<lambda>x. - let n = \<lceil>\<lceil> Rep_Bag\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>) \<rceil>\<rceil> x in - if n = 0 | P (\<lambda>_. x) \<tau> = false \<tau> then - 0 - else - n\<rfloor>\<rfloor> - else invalid \<tau>)" -syntax - "_OclSelectBag" :: "[('\<AA>,'\<alpha>::null) Bag,id,('\<AA>)Boolean] \<Rightarrow> '\<AA> Boolean" ("(_)->select\<^sub>B\<^sub>a\<^sub>g'(_|_')") -translations - "X->select\<^sub>B\<^sub>a\<^sub>g(x | P)" == "CONST OclSelect X (% x. P)" - -(*TODO Locale - Equivalent*) - -subsection{* Definition: Reject *} - -definition OclReject :: "[('\<AA>,'\<alpha>::null)Bag,('\<AA>,'\<alpha>)val\<Rightarrow>('\<AA>)Boolean] \<Rightarrow> ('\<AA>,'\<alpha>::null)Bag" -where "OclReject S P = OclSelect S (not o P)" -syntax - "_OclRejectBag" :: "[('\<AA>,'\<alpha>::null) Bag,id,('\<AA>)Boolean] \<Rightarrow> '\<AA> Boolean" ("(_)->reject\<^sub>B\<^sub>a\<^sub>g'(_|_')") -translations - "X->reject\<^sub>B\<^sub>a\<^sub>g(x | P)" == "CONST OclReject X (% x. P)" - -(*TODO Locale - Equivalent*) - -subsection{* Definition: IncludesAll *} - -definition OclIncludesAll :: "[('\<AA>,'\<alpha>::null) Bag,('\<AA>,'\<alpha>) Bag] \<Rightarrow> '\<AA> Boolean" -where "OclIncludesAll x y = (\<lambda> \<tau>. if (\<delta> x) \<tau> = true \<tau> \<and> (\<delta> y) \<tau> = true \<tau> - then \<lfloor>\<lfloor>Rep_Bag_base y \<tau> \<subseteq> Rep_Bag_base x \<tau> \<rfloor>\<rfloor> - else \<bottom> )" -notation OclIncludesAll ("_->includesAll\<^sub>B\<^sub>a\<^sub>g'(_')" (*[66,65]65*)) - -interpretation OclIncludesAll : profile_bin\<^sub>d_\<^sub>d OclIncludesAll "\<lambda>x y. \<lfloor>\<lfloor>Rep_Bag_base' y \<subseteq> Rep_Bag_base' x \<rfloor>\<rfloor>" -by(unfold_locales, auto simp:OclIncludesAll_def bot_option_def null_option_def invalid_def - Rep_Bag_base_def Rep_Bag_base'_def) - -subsection{* Definition: ExcludesAll *} - -definition OclExcludesAll :: "[('\<AA>,'\<alpha>::null) Bag,('\<AA>,'\<alpha>) Bag] \<Rightarrow> '\<AA> Boolean" -where "OclExcludesAll x y = (\<lambda> \<tau>. if (\<delta> x) \<tau> = true \<tau> \<and> (\<delta> y) \<tau> = true \<tau> - then \<lfloor>\<lfloor>Rep_Bag_base y \<tau> \<inter> Rep_Bag_base x \<tau> = {} \<rfloor>\<rfloor> - else \<bottom> )" -notation OclExcludesAll ("_->excludesAll\<^sub>B\<^sub>a\<^sub>g'(_')" (*[66,65]65*)) - -interpretation OclExcludesAll : profile_bin\<^sub>d_\<^sub>d OclExcludesAll "\<lambda>x y. \<lfloor>\<lfloor>Rep_Bag_base' y \<inter> Rep_Bag_base' x = {} \<rfloor>\<rfloor>" -by(unfold_locales, auto simp:OclExcludesAll_def bot_option_def null_option_def invalid_def - Rep_Bag_base_def Rep_Bag_base'_def) - -subsection{* Definition: Union *} - -definition OclUnion :: "[('\<AA>,'\<alpha>::null) Bag,('\<AA>,'\<alpha>) Bag] \<Rightarrow> ('\<AA>,'\<alpha>) Bag" -where "OclUnion x y = (\<lambda> \<tau>. if (\<delta> x) \<tau> = true \<tau> \<and> (\<delta> y) \<tau> = true \<tau> - then Abs_Bag\<^sub>b\<^sub>a\<^sub>s\<^sub>e \<lfloor>\<lfloor> \<lambda> X. \<lceil>\<lceil>Rep_Bag\<^sub>b\<^sub>a\<^sub>s\<^sub>e (x \<tau>)\<rceil>\<rceil> X + - \<lceil>\<lceil>Rep_Bag\<^sub>b\<^sub>a\<^sub>s\<^sub>e (y \<tau>)\<rceil>\<rceil> X\<rfloor>\<rfloor> - else invalid \<tau> )" -notation OclUnion ("_->union\<^sub>B\<^sub>a\<^sub>g'(_')" (*[66,65]65*)) - -interpretation OclUnion : - profile_bin\<^sub>d_\<^sub>d OclUnion "\<lambda>x y. Abs_Bag\<^sub>b\<^sub>a\<^sub>s\<^sub>e \<lfloor>\<lfloor> \<lambda> X. \<lceil>\<lceil>Rep_Bag\<^sub>b\<^sub>a\<^sub>s\<^sub>e x\<rceil>\<rceil> X + - \<lceil>\<lceil>Rep_Bag\<^sub>b\<^sub>a\<^sub>s\<^sub>e y\<rceil>\<rceil> X\<rfloor>\<rfloor>" -proof - - show "profile_bin\<^sub>d_\<^sub>d OclUnion (\<lambda>x y. Abs_Bag\<^sub>b\<^sub>a\<^sub>s\<^sub>e \<lfloor>\<lfloor> \<lambda> X. \<lceil>\<lceil>Rep_Bag\<^sub>b\<^sub>a\<^sub>s\<^sub>e x\<rceil>\<rceil> X + \<lceil>\<lceil>Rep_Bag\<^sub>b\<^sub>a\<^sub>s\<^sub>e y\<rceil>\<rceil> X\<rfloor>\<rfloor>)" - apply unfold_locales - apply(auto simp:OclUnion_def bot_option_def null_option_def - null_Bag\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def bot_Bag\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def) - by(subst (asm) Abs_Bag\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inject, - simp_all add: bot_option_def null_option_def, - metis (mono_tags, lifting) Rep_Bag\<^sub>b\<^sub>a\<^sub>s\<^sub>e Rep_Bag\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inverse bot_option_def mem_Collect_eq - null_option_def)+ -qed - -subsection{* Definition: Intersection *} - -definition OclIntersection :: "[('\<AA>,'\<alpha>::null) Bag,('\<AA>,'\<alpha>) Bag] \<Rightarrow> ('\<AA>,'\<alpha>) Bag" -where "OclIntersection x y = (\<lambda> \<tau>. if (\<delta> x) \<tau> = true \<tau> \<and> (\<delta> y) \<tau> = true \<tau> - then Abs_Bag\<^sub>b\<^sub>a\<^sub>s\<^sub>e\<lfloor>\<lfloor> \<lambda> X. min (\<lceil>\<lceil>Rep_Bag\<^sub>b\<^sub>a\<^sub>s\<^sub>e (x \<tau>)\<rceil>\<rceil> X) - (\<lceil>\<lceil>Rep_Bag\<^sub>b\<^sub>a\<^sub>s\<^sub>e (y \<tau>)\<rceil>\<rceil> X)\<rfloor>\<rfloor> - else \<bottom> )" -notation OclIntersection("_->intersection\<^sub>B\<^sub>a\<^sub>g'(_')" (*[71,70]70*)) - -interpretation OclIntersection : - profile_bin\<^sub>d_\<^sub>d OclIntersection "\<lambda>x y. Abs_Bag\<^sub>b\<^sub>a\<^sub>s\<^sub>e \<lfloor>\<lfloor> \<lambda> X. min (\<lceil>\<lceil>Rep_Bag\<^sub>b\<^sub>a\<^sub>s\<^sub>e x\<rceil>\<rceil> X) - (\<lceil>\<lceil>Rep_Bag\<^sub>b\<^sub>a\<^sub>s\<^sub>e y\<rceil>\<rceil> X)\<rfloor>\<rfloor>" -proof - - show "profile_bin\<^sub>d_\<^sub>d OclIntersection (\<lambda>x y. Abs_Bag\<^sub>b\<^sub>a\<^sub>s\<^sub>e \<lfloor>\<lfloor> \<lambda> X. min (\<lceil>\<lceil>Rep_Bag\<^sub>b\<^sub>a\<^sub>s\<^sub>e x\<rceil>\<rceil> X) - (\<lceil>\<lceil>Rep_Bag\<^sub>b\<^sub>a\<^sub>s\<^sub>e y\<rceil>\<rceil> X)\<rfloor>\<rfloor>)" - apply unfold_locales - apply(auto simp:OclIntersection_def bot_option_def null_option_def - null_Bag\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def bot_Bag\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def invalid_def) - by(subst (asm) Abs_Bag\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inject, - simp_all add: bot_option_def null_option_def, - metis (mono_tags, lifting) Rep_Bag\<^sub>b\<^sub>a\<^sub>s\<^sub>e Rep_Bag\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inverse bot_option_def mem_Collect_eq min_0R - null_option_def)+ -qed - -subsection{* Definition: Count *} - -definition OclCount :: "[('\<AA>,'\<alpha>::null) Bag,('\<AA>,'\<alpha>) val] \<Rightarrow> ('\<AA>) Integer" -where "OclCount x y = (\<lambda> \<tau>. if (\<delta> x) \<tau> = true \<tau> \<and> (\<delta> y) \<tau> = true \<tau> - then \<lfloor>\<lfloor>int(\<lceil>\<lceil>Rep_Bag\<^sub>b\<^sub>a\<^sub>s\<^sub>e (x \<tau>)\<rceil>\<rceil> (y \<tau>))\<rfloor>\<rfloor> - else invalid \<tau> )" -notation OclCount ("_->count\<^sub>B\<^sub>a\<^sub>g'(_')" (*[66,65]65*)) - -interpretation OclCount : profile_bin\<^sub>d_\<^sub>d OclCount "\<lambda>x y. \<lfloor>\<lfloor>int(\<lceil>\<lceil>Rep_Bag\<^sub>b\<^sub>a\<^sub>s\<^sub>e x\<rceil>\<rceil> y)\<rfloor>\<rfloor>" -by(unfold_locales, auto simp:OclCount_def bot_option_def null_option_def) - -subsection{* Definition (future operators) *} - -consts (* abstract bag collection operations *) - OclSum :: " ('\<AA>,'\<alpha>::null) Bag \<Rightarrow> '\<AA> Integer" - -notation OclSum ("_->sum\<^sub>B\<^sub>a\<^sub>g'(')" (*[66]*)) - -subsection{* Logical Properties *} - -text{* OclIncluding *} - -lemma OclIncluding_valid_args_valid: -"(\<tau> \<Turnstile> \<upsilon>(X->including\<^sub>B\<^sub>a\<^sub>g(x))) = ((\<tau> \<Turnstile>(\<delta> X)) \<and> (\<tau> \<Turnstile>(\<upsilon> x)))" -by (metis (hide_lams, no_types) OclIncluding.def_valid_then_def OclIncluding.defined_args_valid) - -lemma OclIncluding_valid_args_valid''[simp,code_unfold]: -"\<upsilon>(X->including\<^sub>B\<^sub>a\<^sub>g(x)) = ((\<delta> X) and (\<upsilon> x))" -by (simp add: OclIncluding.def_valid_then_def) - -text{* etc. etc. *} -text_raw{* \isatagafp *} - -text{* OclExcluding *} - -lemma OclExcluding_valid_args_valid: -"(\<tau> \<Turnstile> \<upsilon>(X->excluding\<^sub>B\<^sub>a\<^sub>g(x))) = ((\<tau> \<Turnstile>(\<delta> X)) \<and> (\<tau> \<Turnstile>(\<upsilon> x)))" -by (metis OclExcluding.def_valid_then_def OclExcluding.defined_args_valid) - -lemma OclExcluding_valid_args_valid''[simp,code_unfold]: -"\<upsilon>(X->excluding\<^sub>B\<^sub>a\<^sub>g(x)) = ((\<delta> X) and (\<upsilon> x))" -by (simp add: OclExcluding.def_valid_then_def) - -text{* OclIncludes *} - -lemma OclIncludes_valid_args_valid: -"(\<tau> \<Turnstile> \<upsilon>(X->includes\<^sub>B\<^sub>a\<^sub>g(x))) = ((\<tau> \<Turnstile>(\<delta> X)) \<and> (\<tau> \<Turnstile>(\<upsilon> x)))" -by (simp add: OclIncludes.def_valid_then_def foundation10') - -lemma OclIncludes_valid_args_valid''[simp,code_unfold]: -"\<upsilon>(X->includes\<^sub>B\<^sub>a\<^sub>g(x)) = ((\<delta> X) and (\<upsilon> x))" -by (simp add: OclIncludes.def_valid_then_def) - -text{* OclExcludes *} - -lemma OclExcludes_valid_args_valid: -"(\<tau> \<Turnstile> \<upsilon>(X->excludes\<^sub>B\<^sub>a\<^sub>g(x))) = ((\<tau> \<Turnstile>(\<delta> X)) \<and> (\<tau> \<Turnstile>(\<upsilon> x)))" -by (simp add: OclExcludes.def_valid_then_def foundation10') - -lemma OclExcludes_valid_args_valid''[simp,code_unfold]: -"\<upsilon>(X->excludes\<^sub>B\<^sub>a\<^sub>g(x)) = ((\<delta> X) and (\<upsilon> x))" -by (simp add: OclExcludes.def_valid_then_def) - -text{* OclSize *} - -lemma OclSize_defined_args_valid: "\<tau> \<Turnstile> \<delta> (X->size\<^sub>B\<^sub>a\<^sub>g()) \<Longrightarrow> \<tau> \<Turnstile> \<delta> X" -by(auto simp: OclSize_def OclValid_def true_def valid_def false_def StrongEq_def - defined_def invalid_def bot_fun_def null_fun_def - split: bool.split_asm HOL.if_split_asm option.split) - -lemma OclSize_infinite: -assumes non_finite:"\<tau> \<Turnstile> not(\<delta>(S->size\<^sub>B\<^sub>a\<^sub>g()))" -shows "(\<tau> \<Turnstile> not(\<delta>(S))) \<or> \<not> finite (Rep_Bag_base S \<tau>)" -apply(insert non_finite, simp) -apply(rule impI) -apply(simp add: OclSize_def OclValid_def defined_def bot_fun_def null_fun_def bot_option_def null_option_def - split: if_split_asm) -done - -lemma "\<tau> \<Turnstile> \<delta> X \<Longrightarrow> \<not> finite (Rep_Bag_base X \<tau>) \<Longrightarrow> \<not> \<tau> \<Turnstile> \<delta> (X->size\<^sub>B\<^sub>a\<^sub>g())" -by(simp add: OclSize_def OclValid_def defined_def bot_fun_def false_def true_def) - -lemma size_defined: - assumes X_finite: "\<And>\<tau>. finite (Rep_Bag_base X \<tau>)" - shows "\<delta> (X->size\<^sub>B\<^sub>a\<^sub>g()) = \<delta> X" - apply(rule ext, simp add: cp_defined[of "X->size\<^sub>B\<^sub>a\<^sub>g()"] OclSize_def) - apply(simp add: defined_def bot_option_def bot_fun_def null_option_def null_fun_def X_finite) -done - -lemma size_defined': - assumes X_finite: "finite (Rep_Bag_base X \<tau>)" - shows "(\<tau> \<Turnstile> \<delta> (X->size\<^sub>B\<^sub>a\<^sub>g())) = (\<tau> \<Turnstile> \<delta> X)" - apply(simp add: cp_defined[of "X->size\<^sub>B\<^sub>a\<^sub>g()"] OclSize_def OclValid_def) - apply(simp add: defined_def bot_option_def bot_fun_def null_option_def null_fun_def X_finite) -done - -text{* OclIsEmpty *} - -lemma OclIsEmpty_defined_args_valid:"\<tau> \<Turnstile> \<delta> (X->isEmpty\<^sub>B\<^sub>a\<^sub>g()) \<Longrightarrow> \<tau> \<Turnstile> \<upsilon> X" - apply(auto simp: OclIsEmpty_def OclValid_def defined_def valid_def false_def true_def - bot_fun_def null_fun_def OclAnd_def OclOr_def OclNot_def - split: if_split_asm) - apply(case_tac "(X->size\<^sub>B\<^sub>a\<^sub>g() \<doteq> \<zero>) \<tau>", simp add: bot_option_def, simp, rename_tac x) - apply(case_tac x, simp add: null_option_def bot_option_def, simp) - apply(simp add: OclSize_def StrictRefEq\<^sub>I\<^sub>n\<^sub>t\<^sub>e\<^sub>g\<^sub>e\<^sub>r valid_def) -by (metis (hide_lams, no_types) - bot_fun_def OclValid_def defined_def foundation2 invalid_def) - -lemma "\<tau> \<Turnstile> \<delta> (null->isEmpty\<^sub>B\<^sub>a\<^sub>g())" -by(auto simp: OclIsEmpty_def OclValid_def defined_def valid_def false_def true_def - bot_fun_def null_fun_def OclAnd_def OclOr_def OclNot_def null_is_valid - split: if_split_asm) - -lemma OclIsEmpty_infinite: "\<tau> \<Turnstile> \<delta> X \<Longrightarrow> \<not> finite (Rep_Bag_base X \<tau>) \<Longrightarrow> \<not> \<tau> \<Turnstile> \<delta> (X->isEmpty\<^sub>B\<^sub>a\<^sub>g())" - apply(auto simp: OclIsEmpty_def OclValid_def defined_def valid_def false_def true_def - bot_fun_def null_fun_def OclAnd_def OclOr_def OclNot_def - split: if_split_asm) - apply(case_tac "(X->size\<^sub>B\<^sub>a\<^sub>g() \<doteq> \<zero>) \<tau>", simp add: bot_option_def, simp, rename_tac x) - apply(case_tac x, simp add: null_option_def bot_option_def, simp) -by(simp add: OclSize_def StrictRefEq\<^sub>I\<^sub>n\<^sub>t\<^sub>e\<^sub>g\<^sub>e\<^sub>r valid_def bot_fun_def false_def true_def invalid_def) - -text{* OclNotEmpty *} - -lemma OclNotEmpty_defined_args_valid:"\<tau> \<Turnstile> \<delta> (X->notEmpty\<^sub>B\<^sub>a\<^sub>g()) \<Longrightarrow> \<tau> \<Turnstile> \<upsilon> X" -by (metis (hide_lams, no_types) OclNotEmpty_def OclNot_defargs OclNot_not foundation6 foundation9 - OclIsEmpty_defined_args_valid) - -lemma "\<tau> \<Turnstile> \<delta> (null->notEmpty\<^sub>B\<^sub>a\<^sub>g())" -by (metis (hide_lams, no_types) OclNotEmpty_def OclAnd_false1 OclAnd_idem OclIsEmpty_def - OclNot3 OclNot4 OclOr_def defined2 defined4 transform1 valid2) - -lemma OclNotEmpty_infinite: "\<tau> \<Turnstile> \<delta> X \<Longrightarrow> \<not> finite (Rep_Bag_base X \<tau>) \<Longrightarrow> \<not> \<tau> \<Turnstile> \<delta> (X->notEmpty\<^sub>B\<^sub>a\<^sub>g())" - apply(simp add: OclNotEmpty_def) - apply(drule OclIsEmpty_infinite, simp) -by (metis OclNot_defargs OclNot_not foundation6 foundation9) - -lemma OclNotEmpty_has_elt : "\<tau> \<Turnstile> \<delta> X \<Longrightarrow> - \<tau> \<Turnstile> X->notEmpty\<^sub>B\<^sub>a\<^sub>g() \<Longrightarrow> - \<exists>e. e \<in> (Rep_Bag_base X \<tau>)" -proof - - have s_non_empty: "\<And>S. S \<noteq> {} \<Longrightarrow> \<exists>x. x \<in> S" - by blast -show "\<tau> \<Turnstile> \<delta> X \<Longrightarrow> - \<tau> \<Turnstile> X->notEmpty\<^sub>B\<^sub>a\<^sub>g() \<Longrightarrow> - ?thesis" - apply(simp add: OclNotEmpty_def OclIsEmpty_def deMorgan1 deMorgan2, drule foundation5) - apply(subst (asm) (2) OclNot_def, - simp add: OclValid_def StrictRefEq\<^sub>I\<^sub>n\<^sub>t\<^sub>e\<^sub>g\<^sub>e\<^sub>r StrongEq_def - split: if_split_asm) - prefer 2 - apply(simp add: invalid_def bot_option_def true_def) - apply(simp add: OclSize_def valid_def split: if_split_asm, - simp_all add: false_def true_def bot_option_def bot_fun_def OclInt0_def) - apply(drule s_non_empty[of "Rep_Bag_base X \<tau>"], erule exE, case_tac x) -by blast -qed - -lemma OclNotEmpty_has_elt' : "\<tau> \<Turnstile> \<delta> X \<Longrightarrow> - \<tau> \<Turnstile> X->notEmpty\<^sub>B\<^sub>a\<^sub>g() \<Longrightarrow> - \<exists>e. e \<in> (Rep_Set_base X \<tau>)" - apply(drule OclNotEmpty_has_elt, simp) -by(simp add: Rep_Bag_base_def Rep_Set_base_def image_def) - -text{* OclANY *} - -lemma OclANY_defined_args_valid: "\<tau> \<Turnstile> \<delta> (X->any\<^sub>B\<^sub>a\<^sub>g()) \<Longrightarrow> \<tau> \<Turnstile> \<delta> X" -by(auto simp: OclANY_def OclValid_def true_def valid_def false_def StrongEq_def - defined_def invalid_def bot_fun_def null_fun_def OclAnd_def - split: bool.split_asm HOL.if_split_asm option.split) - -lemma "\<tau> \<Turnstile> \<delta> X \<Longrightarrow> \<tau> \<Turnstile> X->isEmpty\<^sub>B\<^sub>a\<^sub>g() \<Longrightarrow> \<not> \<tau> \<Turnstile> \<delta> (X->any\<^sub>B\<^sub>a\<^sub>g())" - apply(simp add: OclANY_def OclValid_def) - apply(subst cp_defined, subst cp_OclAnd, simp add: OclNotEmpty_def, subst (1 2) cp_OclNot, - simp add: cp_OclNot[symmetric] cp_OclAnd[symmetric] cp_defined[symmetric], - simp add: false_def true_def) -by(drule foundation20[simplified OclValid_def true_def], simp) - -lemma OclANY_valid_args_valid: -"(\<tau> \<Turnstile> \<upsilon>(X->any\<^sub>B\<^sub>a\<^sub>g())) = (\<tau> \<Turnstile> \<upsilon> X)" -proof - - have A: "(\<tau> \<Turnstile> \<upsilon>(X->any\<^sub>B\<^sub>a\<^sub>g())) \<Longrightarrow> ((\<tau> \<Turnstile>(\<upsilon> X)))" - by(auto simp: OclANY_def OclValid_def true_def valid_def false_def StrongEq_def - defined_def invalid_def bot_fun_def null_fun_def - split: bool.split_asm HOL.if_split_asm option.split) - have B: "(\<tau> \<Turnstile>(\<upsilon> X)) \<Longrightarrow> (\<tau> \<Turnstile> \<upsilon>(X->any\<^sub>B\<^sub>a\<^sub>g()))" - apply(auto simp: OclANY_def OclValid_def true_def false_def StrongEq_def - defined_def invalid_def valid_def bot_fun_def null_fun_def - bot_option_def null_option_def null_is_valid - OclAnd_def - split: bool.split_asm HOL.if_split_asm option.split) - apply(frule Bag_inv_lemma[OF foundation16[THEN iffD2], OF conjI], simp) - apply(subgoal_tac "(\<delta> X) \<tau> = true \<tau>") - prefer 2 - apply (metis (hide_lams, no_types) OclValid_def foundation16) - apply(simp add: true_def, - drule OclNotEmpty_has_elt'[simplified OclValid_def true_def], simp) - apply(erule exE, - rule someI2[where Q = "\<lambda>x. x \<noteq> \<bottom>" and P = "\<lambda>y. y \<in> (Rep_Set_base X \<tau>)", - simplified not_def, THEN mp], simp, auto) - by(simp add: Rep_Set_base_def image_def) - show ?thesis by(auto dest:A intro:B) -qed - -lemma OclANY_valid_args_valid''[simp,code_unfold]: -"\<upsilon>(X->any\<^sub>B\<^sub>a\<^sub>g()) = (\<upsilon> X)" -by(auto intro!: OclANY_valid_args_valid transform2_rev) - -(* and higher order ones : forall, exists, iterate, select, reject... *) -text_raw{* \endisatagafp *} - -subsection{* Execution Laws with Invalid or Null or Infinite Set as Argument *} - -text{* OclIncluding *} (* properties already generated by the corresponding locale *) - -text{* OclExcluding *} (* properties already generated by the corresponding locale *) - -text{* OclIncludes *} (* properties already generated by the corresponding locale *) - -text{* OclExcludes *} (* properties already generated by the corresponding locale *) - -text{* OclSize *} - -lemma OclSize_invalid[simp,code_unfold]:"(invalid->size\<^sub>B\<^sub>a\<^sub>g()) = invalid" -by(simp add: bot_fun_def OclSize_def invalid_def defined_def valid_def false_def true_def) - -lemma OclSize_null[simp,code_unfold]:"(null->size\<^sub>B\<^sub>a\<^sub>g()) = invalid" -by(rule ext, - simp add: bot_fun_def null_fun_def null_is_valid OclSize_def - invalid_def defined_def valid_def false_def true_def) - -text{* OclIsEmpty *} - -lemma OclIsEmpty_invalid[simp,code_unfold]:"(invalid->isEmpty\<^sub>B\<^sub>a\<^sub>g()) = invalid" -by(simp add: OclIsEmpty_def) - -lemma OclIsEmpty_null[simp,code_unfold]:"(null->isEmpty\<^sub>B\<^sub>a\<^sub>g()) = true" -by(simp add: OclIsEmpty_def) - -text{* OclNotEmpty *} - -lemma OclNotEmpty_invalid[simp,code_unfold]:"(invalid->notEmpty\<^sub>B\<^sub>a\<^sub>g()) = invalid" -by(simp add: OclNotEmpty_def) - -lemma OclNotEmpty_null[simp,code_unfold]:"(null->notEmpty\<^sub>B\<^sub>a\<^sub>g()) = false" -by(simp add: OclNotEmpty_def) - -text{* OclANY *} - -lemma OclANY_invalid[simp,code_unfold]:"(invalid->any\<^sub>B\<^sub>a\<^sub>g()) = invalid" -by(simp add: bot_fun_def OclANY_def invalid_def defined_def valid_def false_def true_def) - -lemma OclANY_null[simp,code_unfold]:"(null->any\<^sub>B\<^sub>a\<^sub>g()) = null" -by(simp add: OclANY_def false_def true_def) - -text{* OclForall *} - -lemma OclForall_invalid[simp,code_unfold]:"invalid->forAll\<^sub>B\<^sub>a\<^sub>g(a| P a) = invalid" -by(simp add: bot_fun_def invalid_def OclForall_def defined_def valid_def false_def true_def) - -lemma OclForall_null[simp,code_unfold]:"null->forAll\<^sub>B\<^sub>a\<^sub>g(a | P a) = invalid" -by(simp add: bot_fun_def invalid_def OclForall_def defined_def valid_def false_def true_def) - -text{* OclExists *} - -lemma OclExists_invalid[simp,code_unfold]:"invalid->exists\<^sub>B\<^sub>a\<^sub>g(a| P a) = invalid" -by(simp add: OclExists_def) - -lemma OclExists_null[simp,code_unfold]:"null->exists\<^sub>B\<^sub>a\<^sub>g(a | P a) = invalid" -by(simp add: OclExists_def) - -text{* OclIterate *} - -lemma OclIterate_invalid[simp,code_unfold]:"invalid->iterate\<^sub>B\<^sub>a\<^sub>g(a; x = A | P a x) = invalid" -by(simp add: bot_fun_def invalid_def OclIterate_def defined_def valid_def false_def true_def) - -lemma OclIterate_null[simp,code_unfold]:"null->iterate\<^sub>B\<^sub>a\<^sub>g(a; x = A | P a x) = invalid" -by(simp add: bot_fun_def invalid_def OclIterate_def defined_def valid_def false_def true_def) - - -lemma OclIterate_invalid_args[simp,code_unfold]:"S->iterate\<^sub>B\<^sub>a\<^sub>g(a; x = invalid | P a x) = invalid" -by(simp add: bot_fun_def invalid_def OclIterate_def defined_def valid_def false_def true_def) - -text{* An open question is this ... *} -lemma (*OclIterate_null_args[simp,code_unfold]:*) "S->iterate\<^sub>B\<^sub>a\<^sub>g(a; x = null | P a x) = invalid" -oops -(* In the definition above, this does not hold in general. - And I believe, this is how it should be ... *) - -lemma OclIterate_infinite: -assumes non_finite: "\<tau> \<Turnstile> not(\<delta>(S->size\<^sub>B\<^sub>a\<^sub>g()))" -shows "(OclIterate S A F) \<tau> = invalid \<tau>" -apply(insert non_finite [THEN OclSize_infinite]) -apply(subst (asm) foundation9, simp) -by(metis OclIterate_def OclValid_def invalid_def) - -text{* OclSelect *} - -lemma OclSelect_invalid[simp,code_unfold]:"invalid->select\<^sub>B\<^sub>a\<^sub>g(a | P a) = invalid" -by(simp add: bot_fun_def invalid_def OclSelect_def defined_def valid_def false_def true_def) - -lemma OclSelect_null[simp,code_unfold]:"null->select\<^sub>B\<^sub>a\<^sub>g(a | P a) = invalid" -by(simp add: bot_fun_def invalid_def OclSelect_def defined_def valid_def false_def true_def) - -text{* OclReject *} - -lemma OclReject_invalid[simp,code_unfold]:"invalid->reject\<^sub>B\<^sub>a\<^sub>g(a | P a) = invalid" -by(simp add: OclReject_def) - -lemma OclReject_null[simp,code_unfold]:"null->reject\<^sub>B\<^sub>a\<^sub>g(a | P a) = invalid" -by(simp add: OclReject_def) - -text_raw{* \isatagafp *} - -subsubsection{* Context Passing *} - -lemma cp_OclIncludes1: -"(X->includes\<^sub>B\<^sub>a\<^sub>g(x)) \<tau> = (X->includes\<^sub>B\<^sub>a\<^sub>g(\<lambda> _. x \<tau>)) \<tau>" -by(auto simp: OclIncludes_def StrongEq_def invalid_def - cp_defined[symmetric] cp_valid[symmetric]) - -lemma cp_OclSize: "X->size\<^sub>B\<^sub>a\<^sub>g() \<tau> = ((\<lambda>_. X \<tau>)->size\<^sub>B\<^sub>a\<^sub>g()) \<tau>" -by(simp add: OclSize_def cp_defined[symmetric] Rep_Bag_base_def) - -lemma cp_OclIsEmpty: "X->isEmpty\<^sub>B\<^sub>a\<^sub>g() \<tau> = ((\<lambda>_. X \<tau>)->isEmpty\<^sub>B\<^sub>a\<^sub>g()) \<tau>" - apply(simp only: OclIsEmpty_def) - apply(subst (2) cp_OclOr, - subst cp_OclAnd, - subst cp_OclNot, - subst StrictRefEq\<^sub>I\<^sub>n\<^sub>t\<^sub>e\<^sub>g\<^sub>e\<^sub>r.cp0) -by(simp add: cp_defined[symmetric] cp_valid[symmetric] StrictRefEq\<^sub>I\<^sub>n\<^sub>t\<^sub>e\<^sub>g\<^sub>e\<^sub>r.cp0[symmetric] - cp_OclSize[symmetric] cp_OclNot[symmetric] cp_OclAnd[symmetric] cp_OclOr[symmetric]) - -lemma cp_OclNotEmpty: "X->notEmpty\<^sub>B\<^sub>a\<^sub>g() \<tau> = ((\<lambda>_. X \<tau>)->notEmpty\<^sub>B\<^sub>a\<^sub>g()) \<tau>" - apply(simp only: OclNotEmpty_def) - apply(subst (2) cp_OclNot) -by(simp add: cp_OclNot[symmetric] cp_OclIsEmpty[symmetric]) - -lemma cp_OclANY: "X->any\<^sub>B\<^sub>a\<^sub>g() \<tau> = ((\<lambda>_. X \<tau>)->any\<^sub>B\<^sub>a\<^sub>g()) \<tau>" - apply(simp only: OclANY_def) - apply(subst (2) cp_OclAnd) -by(simp only: cp_OclAnd[symmetric] cp_defined[symmetric] cp_valid[symmetric] - cp_OclNotEmpty[symmetric] Rep_Set_base_def) - -lemma cp_OclForall: -"(S->forAll\<^sub>B\<^sub>a\<^sub>g(x | P x)) \<tau> = ((\<lambda> _. S \<tau>)->forAll\<^sub>B\<^sub>a\<^sub>g(x | P (\<lambda> _. x \<tau>))) \<tau>" -by(auto simp add: OclForall_def cp_defined[symmetric] Rep_Set_base_def) - -(* first-order version !*) -lemma cp_OclForall1 [simp,intro!]: -"cp S \<Longrightarrow> cp (\<lambda>X. ((S X)->forAll\<^sub>B\<^sub>a\<^sub>g(x | P x)))" -apply(simp add: cp_def) -apply(erule exE, rule exI, intro allI) -apply(erule_tac x=X in allE) -by(subst cp_OclForall, simp) - -lemma (*cp_OclForall2 [simp,intro!]:*) -"cp (\<lambda>X St x. P (\<lambda>\<tau>. x) X St) \<Longrightarrow> cp S \<Longrightarrow> cp (\<lambda>X. (S X)->forAll\<^sub>B\<^sub>a\<^sub>g(x|P x X)) " -apply(simp only: cp_def) -oops - -lemma (*cp_OclForall:*) -"cp S \<Longrightarrow> - (\<And> x. cp(P x)) \<Longrightarrow> - cp(\<lambda>X. ((S X)->forAll\<^sub>B\<^sub>a\<^sub>g(x | P x X)))" -oops - -(* old proof in HOL-OCL based on Isabelle2005: - -lemma cp_OclForall2 [simp,intro!]: -"\<lbrakk> cp (\<lambda> X St.(\<lambda>x. P (\<lambda>\<tau>. x) X St)); - cp (S :: (('a,'c)VAL \<Rightarrow> ('a,('b::bot))Set)) \<rbrakk> - \<Longrightarrow> cp(\<lambda>X. \<MathOclForAll> Y \<in> S X \<bullet> P (Y::'a \<Rightarrow> 'b) X) " -apply(simp only: cp_def OclForAll_def) -apply(erule exE)+ -apply(rule exI, rule allI, rule allI) -apply (simp only:) -apply(rule_tac t = "(\<lambda>x. P (\<lambda>\<tau>. x) X \<tau> )" and - s = "f (X \<tau> ) \<tau> " in subst) -prefer 2 -ML{* Unify.search_bound:=1000; *} -apply(rule refl) -ML{* Unify.search_bound:=20; *} -(* Miracle ! This works. Definitively a unification problem !!! *) -apply simp -done (* temporary solution. *) - (* TODO: improve !!! *) - -*) - -lemma cp_OclExists: -"(S->exists\<^sub>B\<^sub>a\<^sub>g(x | P x)) \<tau> = ((\<lambda> _. S \<tau>)->exists\<^sub>B\<^sub>a\<^sub>g(x | P (\<lambda> _. x \<tau>))) \<tau>" -by(simp add: OclExists_def OclNot_def, subst cp_OclForall, simp) - -(* first-order version !*) -lemma cp_OclExists1 [simp,intro!]: -"cp S \<Longrightarrow> cp (\<lambda>X. ((S X)->exists\<^sub>B\<^sub>a\<^sub>g(x | P x)))" -apply(simp add: cp_def) -apply(erule exE, rule exI, intro allI) -apply(erule_tac x=X in allE) -by(subst cp_OclExists,simp) - -lemma cp_OclIterate: - "(X->iterate\<^sub>B\<^sub>a\<^sub>g(a; x = A | P a x)) \<tau> = - ((\<lambda> _. X \<tau>)->iterate\<^sub>B\<^sub>a\<^sub>g(a; x = A | P a x)) \<tau>" -by(simp add: OclIterate_def cp_defined[symmetric] Rep_Bag_base_def) - -lemma cp_OclSelect: "(X->select\<^sub>B\<^sub>a\<^sub>g(a | P a)) \<tau> = - ((\<lambda> _. X \<tau>)->select\<^sub>B\<^sub>a\<^sub>g(a | P a)) \<tau>" -by(simp add: OclSelect_def cp_defined[symmetric] Rep_Set_base_def) - -lemma cp_OclReject: "(X->reject\<^sub>B\<^sub>a\<^sub>g(a | P a)) \<tau> = ((\<lambda> _. X \<tau>)->reject\<^sub>B\<^sub>a\<^sub>g(a | P a)) \<tau>" -by(simp add: OclReject_def, subst cp_OclSelect, simp) - -lemmas cp_intro''\<^sub>B\<^sub>a\<^sub>g[intro!,simp,code_unfold] = - cp_OclSize [THEN allI[THEN allI[THEN cpI1], of "OclSize"]] - cp_OclIsEmpty [THEN allI[THEN allI[THEN cpI1], of "OclIsEmpty"]] - cp_OclNotEmpty [THEN allI[THEN allI[THEN cpI1], of "OclNotEmpty"]] - cp_OclANY [THEN allI[THEN allI[THEN cpI1], of "OclANY"]] - -subsubsection{* Const *} - -lemma const_OclIncluding[simp,code_unfold] : - assumes const_x : "const x" - and const_S : "const S" - shows "const (S->including\<^sub>B\<^sub>a\<^sub>g(x))" - proof - - have A:"\<And>\<tau> \<tau>'. \<not> (\<tau> \<Turnstile> \<upsilon> x) \<Longrightarrow> (S->including\<^sub>B\<^sub>a\<^sub>g(x) \<tau>) = (S->including\<^sub>B\<^sub>a\<^sub>g(x) \<tau>')" - apply(simp add: foundation18) - apply(erule const_subst[OF const_x const_invalid],simp_all) - by(rule const_charn[OF const_invalid]) - have B: "\<And> \<tau> \<tau>'. \<not> (\<tau> \<Turnstile> \<delta> S) \<Longrightarrow> (S->including\<^sub>B\<^sub>a\<^sub>g(x) \<tau>) = (S->including\<^sub>B\<^sub>a\<^sub>g(x) \<tau>')" - apply(simp add: foundation16', elim disjE) - apply(erule const_subst[OF const_S const_invalid],simp_all) - apply(rule const_charn[OF const_invalid]) - apply(erule const_subst[OF const_S const_null],simp_all) - by(rule const_charn[OF const_invalid]) - show ?thesis - apply(simp only: const_def,intro allI, rename_tac \<tau> \<tau>') - apply(case_tac "\<not> (\<tau> \<Turnstile> \<upsilon> x)", simp add: A) - apply(case_tac "\<not> (\<tau> \<Turnstile> \<delta> S)", simp_all add: B) - apply(frule_tac \<tau>'1= \<tau>' in const_OclValid2[OF const_x, THEN iffD1]) - apply(frule_tac \<tau>'1= \<tau>' in const_OclValid1[OF const_S, THEN iffD1]) - apply(simp add: OclIncluding_def OclValid_def) - apply(subst (1 2) const_charn[OF const_x]) - apply(subst (1 2) const_charn[OF const_S]) - by simp -qed -text_raw{* \endisatagafp *} - - -(* -lemma const_OclForall : - assumes "const X" - assumes "\<And>x \<tau>1 \<tau>2. x \<tau>1 = x \<tau>2 \<Longrightarrow> X' x \<tau>1 = X' x \<tau>2" - shows "const (OclForall X X')" - apply(simp only: const_def, intro allI) - proof - fix \<tau>1 \<tau>2 show "OclForall X X' \<tau>1 = OclForall X X' \<tau>2" - apply(subst (1 2) cp_OclForall, simp only: OclForall_def cp_defined[symmetric]) - by(simp only: const_defined[OF assms(1), simplified const_def, THEN spec, THEN spec, of \<tau>1 \<tau>2] - const_true[simplified const_def, THEN spec, THEN spec, of \<tau>1 \<tau>2] - const_false[simplified const_def, THEN spec, THEN spec, of \<tau>1 \<tau>2] - const_null[simplified const_def, THEN spec, THEN spec, of \<tau>1 \<tau>2] - const_bot[simplified const_def, THEN spec, THEN spec, of \<tau>1 \<tau>2] - assms(1)[simplified const_def, THEN spec, THEN spec, of \<tau>1 \<tau>2] - assms(2)[of _ \<tau>1 \<tau>2]) -qed - -lemma const_OclIncludes : - assumes "const X" - assumes "const X'" - shows "const (OclIncludes X X')" - apply(rule const_imply3[OF _ assms], subst (1 2) cp_OclIncludes, simp only: OclIncludes_def cp_defined[symmetric] cp_valid[symmetric]) - apply(simp add: - const_defined[OF assms(1), simplified const_def, THEN spec, THEN spec] - const_valid[OF assms(2), simplified const_def, THEN spec, THEN spec] - const_true[simplified const_def, THEN spec, THEN spec] assms[simplified const_def] - bot_option_def) -by (metis (no_types) const_def const_defined const_true const_valid cp_defined cp_valid) - -*) - -subsection{* General Algebraic Execution Rules *} -subsubsection{* Execution Rules on Including *} - -lemma OclIncluding_finite_rep_set : - assumes X_def : "\<tau> \<Turnstile> \<delta> X" - and x_val : "\<tau> \<Turnstile> \<upsilon> x" - shows "finite (Rep_Bag_base (X->including\<^sub>B\<^sub>a\<^sub>g(x)) \<tau>) = finite (Rep_Bag_base X \<tau>)" -oops -(* - proof - - have C : "\<lfloor>\<lfloor>insert (x \<tau>) \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (X \<tau>)\<rceil>\<rceil>\<rfloor>\<rfloor> \<in> {X. X = bot \<or> X = null \<or> (\<forall>x\<in>\<lceil>\<lceil>X\<rceil>\<rceil>. x \<noteq> bot)}" - by(insert X_def x_val, frule Set_inv_lemma, simp add: foundation18 invalid_def) - show "?thesis" - by(insert X_def x_val, - auto simp: OclIncluding_def Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inverse[OF C] - dest: foundation13[THEN iffD2, THEN foundation22[THEN iffD1]]) -qed -*) - -lemma OclIncluding_commute0 : - assumes S_def : "\<tau> \<Turnstile> \<delta> S" - and i_val : "\<tau> \<Turnstile> \<upsilon> i" - and j_val : "\<tau> \<Turnstile> \<upsilon> j" - shows "\<tau> \<Turnstile> ((S :: ('\<AA>, 'a::null) Bag)->including\<^sub>B\<^sub>a\<^sub>g(i)->including\<^sub>B\<^sub>a\<^sub>g(j) \<triangleq> (S->including\<^sub>B\<^sub>a\<^sub>g(j)->including\<^sub>B\<^sub>a\<^sub>g(i)))" -oops -(* -proof - - have A : "\<lfloor>\<lfloor>insert (i \<tau>) \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil>\<rfloor>\<rfloor> \<in> {X. X = bot \<or> X = null \<or> (\<forall>x\<in>\<lceil>\<lceil>X\<rceil>\<rceil>. x \<noteq> bot)}" - by(insert S_def i_val, frule Set_inv_lemma, simp add: foundation18 invalid_def) - have B : "\<lfloor>\<lfloor>insert (j \<tau>) \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil>\<rfloor>\<rfloor> \<in> {X. X = bot \<or> X = null \<or> (\<forall>x\<in>\<lceil>\<lceil>X\<rceil>\<rceil>. x \<noteq> bot)}" - by(insert S_def j_val, frule Set_inv_lemma, simp add: foundation18 invalid_def) - - have G1 : "Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e \<lfloor>\<lfloor>insert (i \<tau>) \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil>\<rfloor>\<rfloor> \<noteq> Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e None" - by(insert A, simp add: Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inject bot_option_def null_option_def) - have G2 : "Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e \<lfloor>\<lfloor>insert (i \<tau>) \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil>\<rfloor>\<rfloor> \<noteq> Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e \<lfloor>None\<rfloor>" - by(insert A, simp add: Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inject bot_option_def null_option_def) - have G3 : "Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e \<lfloor>\<lfloor>insert (j \<tau>) \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil>\<rfloor>\<rfloor> \<noteq> Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e None" - by(insert B, simp add: Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inject bot_option_def null_option_def) - have G4 : "Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e \<lfloor>\<lfloor>insert (j \<tau>) \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil>\<rfloor>\<rfloor> \<noteq> Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e \<lfloor>None\<rfloor>" - by(insert B, simp add: Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inject bot_option_def null_option_def) - - have * : "(\<delta> (\<lambda>_. Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e \<lfloor>\<lfloor>insert (i \<tau>) \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil>\<rfloor>\<rfloor>)) \<tau> = \<lfloor>\<lfloor>True\<rfloor>\<rfloor>" - by(auto simp: OclValid_def false_def defined_def null_fun_def true_def - bot_fun_def bot_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def null_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def S_def i_val G1 G2) - - have ** : "(\<delta> (\<lambda>_. Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e \<lfloor>\<lfloor>insert (j \<tau>) \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil>\<rfloor>\<rfloor>)) \<tau> = \<lfloor>\<lfloor>True\<rfloor>\<rfloor>" - by(auto simp: OclValid_def false_def defined_def null_fun_def true_def - bot_fun_def bot_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def null_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def S_def i_val G3 G4) - - have *** : "Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e \<lfloor>\<lfloor>insert(j \<tau>)\<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e(Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e\<lfloor>\<lfloor>insert(i \<tau>)\<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e(S \<tau>)\<rceil>\<rceil>\<rfloor>\<rfloor>)\<rceil>\<rceil>\<rfloor>\<rfloor> = - Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e \<lfloor>\<lfloor>insert(i \<tau>)\<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e(Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e\<lfloor>\<lfloor>insert(j \<tau>)\<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e(S \<tau>)\<rceil>\<rceil>\<rfloor>\<rfloor>)\<rceil>\<rceil>\<rfloor>\<rfloor>" - by(simp add: Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inverse[OF A] Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inverse[OF B] Set.insert_commute) - show ?thesis - apply(simp add: OclIncluding_def S_def[simplified OclValid_def] - i_val[simplified OclValid_def] j_val[simplified OclValid_def] - true_def OclValid_def StrongEq_def) - apply(subst cp_defined, - simp add: S_def[simplified OclValid_def] - i_val[simplified OclValid_def] j_val[simplified OclValid_def] true_def * ) - apply(subst cp_defined, - simp add: S_def[simplified OclValid_def] - i_val[simplified OclValid_def] j_val[simplified OclValid_def] true_def ** *** ) - apply(subst cp_defined, - simp add: S_def[simplified OclValid_def] - i_val[simplified OclValid_def] j_val[simplified OclValid_def] true_def * ) - apply(subst cp_defined, - simp add: S_def[simplified OclValid_def] - i_val[simplified OclValid_def] j_val[simplified OclValid_def] true_def * ) - apply(subst cp_defined, - simp add: S_def[simplified OclValid_def] - i_val[simplified OclValid_def] j_val[simplified OclValid_def] true_def * ** ) - done -qed -*) - -lemma OclIncluding_commute[simp,code_unfold]: -"((S :: ('\<AA>, 'a::null) Bag)->including\<^sub>B\<^sub>a\<^sub>g(i)->including\<^sub>B\<^sub>a\<^sub>g(j) = (S->including\<^sub>B\<^sub>a\<^sub>g(j)->including\<^sub>B\<^sub>a\<^sub>g(i)))" -oops -(* -proof - - have A: "\<And> \<tau>. \<tau> \<Turnstile> (i \<triangleq> invalid) \<Longrightarrow> (S->including\<^sub>B\<^sub>a\<^sub>g(i)->including\<^sub>B\<^sub>a\<^sub>g(j)) \<tau> = invalid \<tau>" - apply(rule foundation22[THEN iffD1]) - by(erule StrongEq_L_subst2_rev, simp,simp) - have A': "\<And> \<tau>. \<tau> \<Turnstile> (i \<triangleq> invalid) \<Longrightarrow> (S->including\<^sub>B\<^sub>a\<^sub>g(j)->including\<^sub>B\<^sub>a\<^sub>g(i)) \<tau> = invalid \<tau>" - apply(rule foundation22[THEN iffD1]) - by(erule StrongEq_L_subst2_rev, simp,simp) - have B:"\<And> \<tau>. \<tau> \<Turnstile> (j \<triangleq> invalid) \<Longrightarrow> (S->including\<^sub>B\<^sub>a\<^sub>g(i)->including\<^sub>B\<^sub>a\<^sub>g(j)) \<tau> = invalid \<tau>" - apply(rule foundation22[THEN iffD1]) - by(erule StrongEq_L_subst2_rev, simp,simp) - have B':"\<And> \<tau>. \<tau> \<Turnstile> (j \<triangleq> invalid) \<Longrightarrow> (S->including\<^sub>B\<^sub>a\<^sub>g(j)->including\<^sub>B\<^sub>a\<^sub>g(i)) \<tau> = invalid \<tau>" - apply(rule foundation22[THEN iffD1]) - by(erule StrongEq_L_subst2_rev, simp,simp) - have C: "\<And> \<tau>. \<tau> \<Turnstile> (S \<triangleq> invalid) \<Longrightarrow> (S->including\<^sub>B\<^sub>a\<^sub>g(i)->including\<^sub>B\<^sub>a\<^sub>g(j)) \<tau> = invalid \<tau>" - apply(rule foundation22[THEN iffD1]) - by(erule StrongEq_L_subst2_rev, simp,simp) - have C': "\<And> \<tau>. \<tau> \<Turnstile> (S \<triangleq> invalid) \<Longrightarrow> (S->including\<^sub>B\<^sub>a\<^sub>g(j)->including\<^sub>B\<^sub>a\<^sub>g(i)) \<tau> = invalid \<tau>" - apply(rule foundation22[THEN iffD1]) - by(erule StrongEq_L_subst2_rev, simp,simp) - have D: "\<And> \<tau>. \<tau> \<Turnstile> (S \<triangleq> null) \<Longrightarrow> (S->including\<^sub>B\<^sub>a\<^sub>g(i)->including\<^sub>B\<^sub>a\<^sub>g(j)) \<tau> = invalid \<tau>" - apply(rule foundation22[THEN iffD1]) - by(erule StrongEq_L_subst2_rev, simp,simp) - have D': "\<And> \<tau>. \<tau> \<Turnstile> (S \<triangleq> null) \<Longrightarrow> (S->including\<^sub>B\<^sub>a\<^sub>g(j)->including\<^sub>B\<^sub>a\<^sub>g(i)) \<tau> = invalid \<tau>" - apply(rule foundation22[THEN iffD1]) - by(erule StrongEq_L_subst2_rev, simp,simp) - show ?thesis - apply(rule ext, rename_tac \<tau>) - apply(case_tac "\<tau> \<Turnstile> (\<upsilon> i)") - apply(case_tac "\<tau> \<Turnstile> (\<upsilon> j)") - apply(case_tac "\<tau> \<Turnstile> (\<delta> S)") - apply(simp only: OclIncluding_commute0[THEN foundation22[THEN iffD1]]) - apply(simp add: foundation16', elim disjE) - apply(simp add: C[OF foundation22[THEN iffD2]] C'[OF foundation22[THEN iffD2]]) - apply(simp add: D[OF foundation22[THEN iffD2]] D'[OF foundation22[THEN iffD2]]) - apply(simp add:foundation18 B[OF foundation22[THEN iffD2]] B'[OF foundation22[THEN iffD2]]) - apply(simp add:foundation18 A[OF foundation22[THEN iffD2]] A'[OF foundation22[THEN iffD2]]) - done -qed -*) - -subsubsection{* Execution Rules on Excluding *} - -lemma OclExcluding_finite_rep_set : - assumes X_def : "\<tau> \<Turnstile> \<delta> X" - and x_val : "\<tau> \<Turnstile> \<upsilon> x" - shows "finite (Rep_Bag_base (X->excluding\<^sub>B\<^sub>a\<^sub>g(x)) \<tau>) = finite (Rep_Bag_base X \<tau>)" -oops -(* - proof - - have C : "\<lfloor>\<lfloor>(Rep_Bag_base X \<tau>) - {x \<tau>}\<rfloor>\<rfloor> \<in> {X. X = bot \<or> X = null \<or> (\<forall>x\<in>\<lceil>\<lceil>X\<rceil>\<rceil>. x \<noteq> bot)}" - apply(insert X_def x_val, frule Set_inv_lemma) - apply(simp add: foundation18 invalid_def) - done - show "?thesis" - by(insert X_def x_val, - auto simp: OclExcluding_def Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inverse[OF C] - dest: foundation13[THEN iffD2, THEN foundation22[THEN iffD1]]) -qed -*) - -lemma OclExcluding_charn0[simp]: -assumes val_x:"\<tau> \<Turnstile> (\<upsilon> x)" -shows "\<tau> \<Turnstile> ((Bag{}->excluding\<^sub>B\<^sub>a\<^sub>g(x)) \<triangleq> Bag{})" -proof - - have A : "\<lfloor>None\<rfloor> \<in> {X. X = bot \<or> X = null \<or> (\<forall>x\<in>\<lceil>\<lceil>X\<rceil>\<rceil>. x \<noteq> bot)}" - by(simp add: null_option_def bot_option_def) - have B : "\<lfloor>\<lfloor>{}\<rfloor>\<rfloor> \<in> {X. X = bot \<or> X = null \<or> (\<forall>x\<in>\<lceil>\<lceil>X\<rceil>\<rceil>. x \<noteq> bot)}" by(simp add: mtBag_def) - - show ?thesis using val_x - apply(auto simp: OclValid_def OclIncludes_def OclNot_def false_def true_def StrongEq_def - OclExcluding_def mtBag_def defined_def bot_fun_def null_fun_def null_Bag\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def invalid_def) - apply(subst (asm) Abs_Bag\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inject, simp, simp add: null_option_def bot_option_def, simp) - apply(subst Bag\<^sub>b\<^sub>a\<^sub>s\<^sub>e.Abs_Bag\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inverse, simp_all) - by (metis fun_upd_triv) -qed - -lemma OclExcluding_commute0 : - assumes S_def : "\<tau> \<Turnstile> \<delta> S" - and i_val : "\<tau> \<Turnstile> \<upsilon> i" - and j_val : "\<tau> \<Turnstile> \<upsilon> j" - shows "\<tau> \<Turnstile> ((S :: ('\<AA>, 'a::null) Bag)->excluding\<^sub>B\<^sub>a\<^sub>g(i)->excluding\<^sub>B\<^sub>a\<^sub>g(j) \<triangleq> (S->excluding\<^sub>B\<^sub>a\<^sub>g(j)->excluding\<^sub>B\<^sub>a\<^sub>g(i)))" -oops -(* -proof - - have A : "\<lfloor>\<lfloor>\<lceil>\<lceil>Rep_Bag\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil> - {i \<tau>}\<rfloor>\<rfloor> \<in> {X. X = bot \<or> X = null \<or> (\<forall>x\<in>\<lceil>\<lceil>X\<rceil>\<rceil>. x \<noteq> bot)}" - by(insert S_def i_val, frule Bag_inv_lemma, simp add: foundation18 invalid_def) - have B : "\<lfloor>\<lfloor>\<lceil>\<lceil>Rep_Bag\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil> - {j \<tau>}\<rfloor>\<rfloor> \<in> {X. X = bot \<or> X = null \<or> (\<forall>x\<in>\<lceil>\<lceil>X\<rceil>\<rceil>. x \<noteq> bot)}" - by(insert S_def j_val, frule Bag_inv_lemma, simp add: foundation18 invalid_def) - - have G1 : "Abs_Bag\<^sub>b\<^sub>a\<^sub>s\<^sub>e \<lfloor>\<lfloor>\<lceil>\<lceil>Rep_Bag\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil> - {i \<tau>}\<rfloor>\<rfloor> \<noteq> Abs_Bag\<^sub>b\<^sub>a\<^sub>s\<^sub>e None" - by(insert A, simp add: Abs_Bag\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inject bot_option_def null_option_def) - have G2 : "Abs_Bag\<^sub>b\<^sub>a\<^sub>s\<^sub>e \<lfloor>\<lfloor>\<lceil>\<lceil>Rep_Bag\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil> - {i \<tau>}\<rfloor>\<rfloor> \<noteq> Abs_Bag\<^sub>b\<^sub>a\<^sub>s\<^sub>e \<lfloor>None\<rfloor>" - by(insert A, simp add: Abs_Bag\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inject bot_option_def null_option_def) - have G3 : "Abs_Bag\<^sub>b\<^sub>a\<^sub>s\<^sub>e \<lfloor>\<lfloor>\<lceil>\<lceil>Rep_Bag\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil> - {j \<tau>}\<rfloor>\<rfloor> \<noteq> Abs_Bag\<^sub>b\<^sub>a\<^sub>s\<^sub>e None" - by(insert B, simp add: Abs_Bag\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inject bot_option_def null_option_def) - have G4 : "Abs_Bag\<^sub>b\<^sub>a\<^sub>s\<^sub>e \<lfloor>\<lfloor>\<lceil>\<lceil>Rep_Bag\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil> - {j \<tau>}\<rfloor>\<rfloor> \<noteq> Abs_Bag\<^sub>b\<^sub>a\<^sub>s\<^sub>e \<lfloor>None\<rfloor>" - by(insert B, simp add: Abs_Bag\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inject bot_option_def null_option_def) - - have * : "(\<delta> (\<lambda>_. Abs_Bag\<^sub>b\<^sub>a\<^sub>s\<^sub>e \<lfloor>\<lfloor>\<lceil>\<lceil>Rep_Bag\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil> - {i \<tau>}\<rfloor>\<rfloor>)) \<tau> = \<lfloor>\<lfloor>True\<rfloor>\<rfloor>" - by(auto simp: OclValid_def false_def defined_def null_fun_def true_def - bot_fun_def bot_Bag\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def null_Bag\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def S_def i_val G1 G2) - - have ** : "(\<delta> (\<lambda>_. Abs_Bag\<^sub>b\<^sub>a\<^sub>s\<^sub>e \<lfloor>\<lfloor>\<lceil>\<lceil>Rep_Bag\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil> - {j \<tau>}\<rfloor>\<rfloor>)) \<tau> = \<lfloor>\<lfloor>True\<rfloor>\<rfloor>" - by(auto simp: OclValid_def false_def defined_def null_fun_def true_def - bot_fun_def bot_Bag\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def null_Bag\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def S_def i_val G3 G4) - - have *** : "Abs_Bag\<^sub>b\<^sub>a\<^sub>s\<^sub>e \<lfloor>\<lfloor>\<lceil>\<lceil>Rep_Bag\<^sub>b\<^sub>a\<^sub>s\<^sub>e(Abs_Bag\<^sub>b\<^sub>a\<^sub>s\<^sub>e\<lfloor>\<lfloor>\<lceil>\<lceil>Rep_Bag\<^sub>b\<^sub>a\<^sub>s\<^sub>e(S \<tau>)\<rceil>\<rceil>-{i \<tau>}\<rfloor>\<rfloor>)\<rceil>\<rceil>-{j \<tau>}\<rfloor>\<rfloor> = - Abs_Bag\<^sub>b\<^sub>a\<^sub>s\<^sub>e \<lfloor>\<lfloor>\<lceil>\<lceil>Rep_Bag\<^sub>b\<^sub>a\<^sub>s\<^sub>e(Abs_Bag\<^sub>b\<^sub>a\<^sub>s\<^sub>e\<lfloor>\<lfloor>\<lceil>\<lceil>Rep_Bag\<^sub>b\<^sub>a\<^sub>s\<^sub>e(S \<tau>)\<rceil>\<rceil>-{j \<tau>}\<rfloor>\<rfloor>)\<rceil>\<rceil>-{i \<tau>}\<rfloor>\<rfloor>" - apply(simp add: Abs_Bag\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inverse[OF A] Abs_Bag\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inverse[OF B]) - by (metis Diff_insert2 insert_commute) - show ?thesis - apply(simp add: OclExcluding_def S_def[simplified OclValid_def] - i_val[simplified OclValid_def] j_val[simplified OclValid_def] - true_def OclValid_def StrongEq_def) - apply(subst cp_defined, - simp add: S_def[simplified OclValid_def] - i_val[simplified OclValid_def] j_val[simplified OclValid_def] true_def * ) - apply(subst cp_defined, - simp add: S_def[simplified OclValid_def] - i_val[simplified OclValid_def] j_val[simplified OclValid_def] true_def ** *** ) - apply(subst cp_defined, - simp add: S_def[simplified OclValid_def] - i_val[simplified OclValid_def] j_val[simplified OclValid_def] true_def * ) - apply(subst cp_defined, - simp add: S_def[simplified OclValid_def] - i_val[simplified OclValid_def] j_val[simplified OclValid_def] true_def * ) - apply(subst cp_defined, - simp add: S_def[simplified OclValid_def] - i_val[simplified OclValid_def] j_val[simplified OclValid_def] true_def * ** ) - done -qed -*) - -lemma OclExcluding_commute[simp,code_unfold]: -"((S :: ('\<AA>, 'a::null) Bag)->excluding\<^sub>B\<^sub>a\<^sub>g(i)->excluding\<^sub>B\<^sub>a\<^sub>g(j) = (S->excluding\<^sub>B\<^sub>a\<^sub>g(j)->excluding\<^sub>B\<^sub>a\<^sub>g(i)))" -oops -(* -proof - - have A: "\<And> \<tau>. \<tau> \<Turnstile> i \<triangleq> invalid \<Longrightarrow> (S->excluding\<^sub>B\<^sub>a\<^sub>g(i)->excluding\<^sub>B\<^sub>a\<^sub>g(j)) \<tau> = invalid \<tau>" - apply(rule foundation22[THEN iffD1]) - by(erule StrongEq_L_subst2_rev, simp,simp) - have A': "\<And> \<tau>. \<tau> \<Turnstile> i \<triangleq> invalid \<Longrightarrow> (S->excluding\<^sub>B\<^sub>a\<^sub>g(j)->excluding\<^sub>B\<^sub>a\<^sub>g(i)) \<tau> = invalid \<tau>" - apply(rule foundation22[THEN iffD1]) - by(erule StrongEq_L_subst2_rev, simp,simp) - have B:"\<And> \<tau>. \<tau> \<Turnstile> j \<triangleq> invalid \<Longrightarrow> (S->excluding\<^sub>B\<^sub>a\<^sub>g(i)->excluding\<^sub>B\<^sub>a\<^sub>g(j)) \<tau> = invalid \<tau>" - apply(rule foundation22[THEN iffD1]) - by(erule StrongEq_L_subst2_rev, simp,simp) - have B':"\<And> \<tau>. \<tau> \<Turnstile> j \<triangleq> invalid \<Longrightarrow> (S->excluding\<^sub>B\<^sub>a\<^sub>g(j)->excluding\<^sub>B\<^sub>a\<^sub>g(i)) \<tau> = invalid \<tau>" - apply(rule foundation22[THEN iffD1]) - by(erule StrongEq_L_subst2_rev, simp,simp) - have C: "\<And> \<tau>. \<tau> \<Turnstile> S \<triangleq> invalid \<Longrightarrow> (S->excluding\<^sub>B\<^sub>a\<^sub>g(i)->excluding\<^sub>B\<^sub>a\<^sub>g(j)) \<tau> = invalid \<tau>" - apply(rule foundation22[THEN iffD1]) - by(erule StrongEq_L_subst2_rev, simp,simp) - have C': "\<And> \<tau>. \<tau> \<Turnstile> S \<triangleq> invalid \<Longrightarrow> (S->excluding\<^sub>B\<^sub>a\<^sub>g(j)->excluding\<^sub>B\<^sub>a\<^sub>g(i)) \<tau> = invalid \<tau>" - apply(rule foundation22[THEN iffD1]) - by(erule StrongEq_L_subst2_rev, simp,simp) - have D: "\<And> \<tau>. \<tau> \<Turnstile> S \<triangleq> null \<Longrightarrow> (S->excluding\<^sub>B\<^sub>a\<^sub>g(i)->excluding\<^sub>B\<^sub>a\<^sub>g(j)) \<tau> = invalid \<tau>" - apply(rule foundation22[THEN iffD1]) - by(erule StrongEq_L_subst2_rev, simp,simp) - have D': "\<And> \<tau>. \<tau> \<Turnstile> S \<triangleq> null \<Longrightarrow> (S->excluding\<^sub>B\<^sub>a\<^sub>g(j)->excluding\<^sub>B\<^sub>a\<^sub>g(i)) \<tau> = invalid \<tau>" - apply(rule foundation22[THEN iffD1]) - by(erule StrongEq_L_subst2_rev, simp,simp) - show ?thesis - apply(rule ext, rename_tac \<tau>) - apply(case_tac "\<tau> \<Turnstile> (\<upsilon> i)") - apply(case_tac "\<tau> \<Turnstile> (\<upsilon> j)") - apply(case_tac "\<tau> \<Turnstile> (\<delta> S)") - apply(simp only: OclExcluding_commute0[THEN foundation22[THEN iffD1]]) - apply(simp add: foundation16', elim disjE) - apply(simp add: C[OF foundation22[THEN iffD2]] C'[OF foundation22[THEN iffD2]]) - apply(simp add: D[OF foundation22[THEN iffD2]] D'[OF foundation22[THEN iffD2]]) - apply(simp add:foundation18 B[OF foundation22[THEN iffD2]] B'[OF foundation22[THEN iffD2]]) - apply(simp add:foundation18 A[OF foundation22[THEN iffD2]] A'[OF foundation22[THEN iffD2]]) - done -qed -*) - -lemma OclExcluding_charn0_exec[simp,code_unfold]: -"(Bag{}->excluding\<^sub>B\<^sub>a\<^sub>g(x)) = (if (\<upsilon> x) then Bag{} else invalid endif)" -proof - - have A: "\<And> \<tau>. (Bag{}->excluding\<^sub>B\<^sub>a\<^sub>g(invalid)) \<tau> = (if (\<upsilon> invalid) then Bag{} else invalid endif) \<tau>" - by simp - have B: "\<And> \<tau> x. \<tau> \<Turnstile> (\<upsilon> x) \<Longrightarrow> - (Bag{}->excluding\<^sub>B\<^sub>a\<^sub>g(x)) \<tau> = (if (\<upsilon> x) then Bag{} else invalid endif) \<tau>" - by(simp add: OclExcluding_charn0[THEN foundation22[THEN iffD1]]) - show ?thesis - apply(rule ext, rename_tac \<tau>) - apply(case_tac "\<tau> \<Turnstile> (\<upsilon> x)") - apply(simp add: B) - apply(simp add: foundation18) - apply(subst OclExcluding.cp0, simp) - apply(simp add: cp_OclIf[symmetric] OclExcluding.cp0[symmetric] cp_valid[symmetric] A) - done -qed - -lemma OclExcluding_charn1: -assumes def_X:"\<tau> \<Turnstile> (\<delta> X)" -and val_x:"\<tau> \<Turnstile> (\<upsilon> x)" -and val_y:"\<tau> \<Turnstile> (\<upsilon> y)" -and neq :"\<tau> \<Turnstile> not(x \<triangleq> y)" -shows "\<tau> \<Turnstile> ((X->including\<^sub>B\<^sub>a\<^sub>g(x))->excluding\<^sub>B\<^sub>a\<^sub>g(y)) \<triangleq> ((X->excluding\<^sub>B\<^sub>a\<^sub>g(y))->including\<^sub>B\<^sub>a\<^sub>g(x))" -oops -(* -proof - - have C : "\<lfloor>\<lfloor>insert (x \<tau>) (Rep_Bag_base X \<tau>)\<rfloor>\<rfloor> \<in> {X. X = bot \<or> X = null \<or> (\<forall>x\<in>\<lceil>\<lceil>X\<rceil>\<rceil>. x \<noteq> bot)}" - by(insert def_X val_x, frule Set_inv_lemma, simp add: foundation18 invalid_def) - have D : "\<lfloor>\<lfloor>(Rep_Bag_base X \<tau>) - {y \<tau>}\<rfloor>\<rfloor> \<in> {X. X = bot \<or> X = null \<or> (\<forall>x\<in>\<lceil>\<lceil>X\<rceil>\<rceil>. x \<noteq> bot)}" - by(insert def_X val_x, frule Set_inv_lemma, simp add: foundation18 invalid_def) - have E : "x \<tau> \<noteq> y \<tau>" - by(insert neq, - auto simp: OclValid_def bot_fun_def OclIncluding_def OclIncludes_def - false_def true_def defined_def valid_def bot_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def - null_fun_def null_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def StrongEq_def OclNot_def) - - have G1 : "Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e \<lfloor>\<lfloor>insert (x \<tau>) (Rep_Bag_base X \<tau>)\<rfloor>\<rfloor> \<noteq> Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e None" - by(insert C, simp add: Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inject bot_option_def null_option_def) - have G2 : "Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e \<lfloor>\<lfloor>insert (x \<tau>) (Rep_Bag_base X \<tau>)\<rfloor>\<rfloor> \<noteq> Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e \<lfloor>None\<rfloor>" - by(insert C, simp add: Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inject bot_option_def null_option_def) - have G : "(\<delta> (\<lambda>_. Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e \<lfloor>\<lfloor>insert (x \<tau>) (Rep_Bag_base X \<tau>)\<rfloor>\<rfloor>)) \<tau> = true \<tau>" - by(auto simp: OclValid_def false_def true_def defined_def - bot_fun_def bot_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def null_fun_def null_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def G1 G2) - - have H1 : "Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e \<lfloor>\<lfloor>(Rep_Bag_base X \<tau>) - {y \<tau>}\<rfloor>\<rfloor> \<noteq> Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e None" - by(insert D, simp add: Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inject bot_option_def null_option_def) - have H2 : "Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e \<lfloor>\<lfloor>(Rep_Bag_base X \<tau>) - {y \<tau>}\<rfloor>\<rfloor> \<noteq> Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e \<lfloor>None\<rfloor>" - by(insert D, simp add: Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inject bot_option_def null_option_def) - have H : "(\<delta> (\<lambda>_. Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e \<lfloor>\<lfloor>(Rep_Bag_base X \<tau>) - {y \<tau>}\<rfloor>\<rfloor>)) \<tau> = true \<tau>" - by(auto simp: OclValid_def false_def true_def defined_def - bot_fun_def bot_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def null_fun_def null_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def H1 H2) - - have Z : "insert (x \<tau>) (Rep_Bag_base X \<tau>) - {y \<tau>} = insert (x \<tau>) ((Rep_Bag_base X \<tau>) - {y \<tau>})" - by(auto simp: E) - show ?thesis - apply(insert def_X[THEN foundation13[THEN iffD2]] val_x[THEN foundation13[THEN iffD2]] - val_y[THEN foundation13[THEN iffD2]]) - apply(simp add: foundation22 OclIncluding_def OclExcluding_def def_X[THEN foundation16[THEN iffD1]]) - apply(subst cp_defined, simp)+ - apply(simp add: G H Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inverse[OF C] Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inverse[OF D] Z) - done -qed -*) - - -lemma OclExcluding_charn2: -assumes def_X:"\<tau> \<Turnstile> (\<delta> X)" -and val_x:"\<tau> \<Turnstile> (\<upsilon> x)" -shows "\<tau> \<Turnstile> (((X->including\<^sub>B\<^sub>a\<^sub>g(x))->excluding\<^sub>B\<^sub>a\<^sub>g(x)) \<triangleq> (X->excluding\<^sub>B\<^sub>a\<^sub>g(x)))" -oops -(* -proof - - have C : "\<lfloor>\<lfloor>insert (x \<tau>) (Rep_Bag_base X \<tau>)\<rfloor>\<rfloor> \<in> {X. X = bot \<or> X = null \<or> (\<forall>x\<in>\<lceil>\<lceil>X\<rceil>\<rceil>. x \<noteq> bot)}" - by(insert def_X val_x, frule Set_inv_lemma, simp add: foundation18 invalid_def) - have G1 : "Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e \<lfloor>\<lfloor>insert (x \<tau>) (Rep_Bag_base X \<tau>)\<rfloor>\<rfloor> \<noteq> Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e None" - by(insert C, simp add: Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inject bot_option_def null_option_def) - have G2 : "Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e \<lfloor>\<lfloor>insert (x \<tau>) (Rep_Bag_base X \<tau>)\<rfloor>\<rfloor> \<noteq> Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e \<lfloor>None\<rfloor>" - by(insert C, simp add: Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inject bot_option_def null_option_def) - show ?thesis - apply(insert def_X[THEN foundation16[THEN iffD1]] - val_x[THEN foundation18[THEN iffD1]]) - apply(auto simp: OclValid_def bot_fun_def OclIncluding_def OclIncludes_def false_def true_def - invalid_def defined_def valid_def bot_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def null_fun_def null_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def - StrongEq_def) - apply(subst OclExcluding.cp0) - apply(auto simp:OclExcluding_def) - apply(simp add: Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inverse[OF C]) - apply(simp_all add: false_def true_def defined_def valid_def - null_fun_def bot_fun_def null_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def bot_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def - split: bool.split_asm HOL.if_split_asm option.split) - apply(auto simp: G1 G2) - done -qed -*) - - - -theorem OclExcluding_charn3: "((X->including\<^sub>B\<^sub>a\<^sub>g(x))->excluding\<^sub>B\<^sub>a\<^sub>g(x)) = (X->excluding\<^sub>B\<^sub>a\<^sub>g(x))" -oops -(* -proof - - have A1 : "\<And>\<tau>. \<tau> \<Turnstile> (X \<triangleq> invalid) \<Longrightarrow> (X->including\<^sub>B\<^sub>a\<^sub>g(x)->excluding\<^sub>B\<^sub>a\<^sub>g(x)) \<tau> = invalid \<tau>" - apply(rule foundation22[THEN iffD1]) - by(erule StrongEq_L_subst2_rev, simp,simp) - have A1': "\<And>\<tau>. \<tau> \<Turnstile> (X \<triangleq> invalid) \<Longrightarrow> (X->excluding\<^sub>B\<^sub>a\<^sub>g(x)) \<tau> = invalid \<tau>" - apply(rule foundation22[THEN iffD1]) - by(erule StrongEq_L_subst2_rev, simp,simp) - have A2 : "\<And>\<tau>. \<tau> \<Turnstile> (X \<triangleq> null) \<Longrightarrow> (X->including\<^sub>B\<^sub>a\<^sub>g(x)->excluding\<^sub>B\<^sub>a\<^sub>g(x)) \<tau> = invalid \<tau>" - apply(rule foundation22[THEN iffD1]) - by(erule StrongEq_L_subst2_rev, simp,simp) - have A2': "\<And>\<tau>. \<tau> \<Turnstile> (X \<triangleq> null) \<Longrightarrow> (X->excluding\<^sub>B\<^sub>a\<^sub>g(x)) \<tau> = invalid \<tau>" - apply(rule foundation22[THEN iffD1]) - by(erule StrongEq_L_subst2_rev, simp,simp) - have A3 : "\<And>\<tau>. \<tau> \<Turnstile> (x \<triangleq> invalid) \<Longrightarrow> (X->including\<^sub>B\<^sub>a\<^sub>g(x)->excluding\<^sub>B\<^sub>a\<^sub>g(x)) \<tau> = invalid \<tau>" - apply(rule foundation22[THEN iffD1]) - by(erule StrongEq_L_subst2_rev, simp,simp) - have A3': "\<And>\<tau>. \<tau> \<Turnstile> (x \<triangleq> invalid) \<Longrightarrow> (X->excluding\<^sub>B\<^sub>a\<^sub>g(x)) \<tau> = invalid \<tau>" - apply(rule foundation22[THEN iffD1]) - by(erule StrongEq_L_subst2_rev, simp,simp) - - show ?thesis - apply(rule ext, rename_tac "\<tau>") - apply(case_tac "\<tau> \<Turnstile> (\<upsilon> x)") - apply(case_tac "\<tau> \<Turnstile> (\<delta> X)") - apply(simp only: OclExcluding_charn2[THEN foundation22[THEN iffD1]]) - apply(simp add: foundation16', elim disjE) - apply(simp add: A1[OF foundation22[THEN iffD2]] A1'[OF foundation22[THEN iffD2]]) - apply(simp add: A2[OF foundation22[THEN iffD2]] A2'[OF foundation22[THEN iffD2]]) - apply(simp add:foundation18 A3[OF foundation22[THEN iffD2]] A3'[OF foundation22[THEN iffD2]]) - done -qed -*) - -text{* One would like a generic theorem of the form: -\begin{isar}[mathescape] -lemma OclExcluding_charn_exec: - "(X->including$_{Set}$(x::('$\mathfrak{A}$,'a::null)val)->excluding$_{Set}$(y)) = - (if \<delta> X then if x \<doteq> y - then X->excluding$_{Set}$(y) - else X->excluding$_{Set}$(y)->including$_{Set}$(x) - endif - else invalid endif)" -\end{isar} -Unfortunately, this does not hold in general, since referential equality is -an overloaded concept and has to be defined for each type individually. -Consequently, it is only valid for concrete type instances for Boolean, -Integer, and Sets thereof... -*} - - -text{* The computational law \emph{OclExcluding-charn-exec} becomes generic since it -uses strict equality which in itself is generic. It is possible to prove -the following generic theorem and instantiate it later (using properties -that link the polymorphic logical strong equality with the concrete instance -of strict quality).*} -lemma OclExcluding_charn_exec: - assumes strict1: "(invalid \<doteq> y) = invalid" - and strict2: "(x \<doteq> invalid) = invalid" - and StrictRefEq_valid_args_valid: "\<And> (x::('\<AA>,'a::null)val) y \<tau>. - (\<tau> \<Turnstile> \<delta> (x \<doteq> y)) = ((\<tau> \<Turnstile> (\<upsilon> x)) \<and> (\<tau> \<Turnstile> \<upsilon> y))" - and cp_StrictRefEq: "\<And> (X::('\<AA>,'a::null)val) Y \<tau>. (X \<doteq> Y) \<tau> = ((\<lambda>_. X \<tau>) \<doteq> (\<lambda>_. Y \<tau>)) \<tau>" - and StrictRefEq_vs_StrongEq: "\<And> (x::('\<AA>,'a::null)val) y \<tau>. - \<tau> \<Turnstile> \<upsilon> x \<Longrightarrow> \<tau> \<Turnstile> \<upsilon> y \<Longrightarrow> (\<tau> \<Turnstile> ((x \<doteq> y) \<triangleq> (x \<triangleq> y)))" - shows "(X->including\<^sub>B\<^sub>a\<^sub>g(x::('\<AA>,'a::null)val)->excluding\<^sub>B\<^sub>a\<^sub>g(y)) = - (if \<delta> X then if x \<doteq> y - then X->excluding\<^sub>B\<^sub>a\<^sub>g(y) - else X->excluding\<^sub>B\<^sub>a\<^sub>g(y)->including\<^sub>B\<^sub>a\<^sub>g(x) - endif - else invalid endif)" -oops -(* -proof - - (* Lifting theorems, largely analogous OclIncludes_execute_generic, - with the same problems wrt. strict equality. *) - have A1: "\<And>\<tau>. \<tau> \<Turnstile> (X \<triangleq> invalid) \<Longrightarrow> - (X->including\<^sub>B\<^sub>a\<^sub>g(x)->includes\<^sub>B\<^sub>a\<^sub>g(y)) \<tau> = invalid \<tau>" - apply(rule foundation22[THEN iffD1]) - by(erule StrongEq_L_subst2_rev, simp,simp) - - have B1: "\<And>\<tau>. \<tau> \<Turnstile> (X \<triangleq> null) \<Longrightarrow> - (X->including\<^sub>B\<^sub>a\<^sub>g(x)->includes\<^sub>B\<^sub>a\<^sub>g(y)) \<tau> = invalid \<tau>" - apply(rule foundation22[THEN iffD1]) - by(erule StrongEq_L_subst2_rev, simp,simp) - - have A2: "\<And>\<tau>. \<tau> \<Turnstile> (X \<triangleq> invalid) \<Longrightarrow> X->including\<^sub>B\<^sub>a\<^sub>g(x)->excluding\<^sub>B\<^sub>a\<^sub>g(y) \<tau> = invalid \<tau>" - apply(rule foundation22[THEN iffD1]) - by(erule StrongEq_L_subst2_rev, simp,simp) - - have B2: "\<And>\<tau>. \<tau> \<Turnstile> (X \<triangleq> null) \<Longrightarrow> X->including\<^sub>B\<^sub>a\<^sub>g(x)->excluding\<^sub>B\<^sub>a\<^sub>g(y) \<tau> = invalid \<tau>" - apply(rule foundation22[THEN iffD1]) - by(erule StrongEq_L_subst2_rev, simp,simp) - - note [simp] = cp_StrictRefEq [THEN allI[THEN allI[THEN allI[THEN cpI2]], of "StrictRefEq"]] - - have C: "\<And>\<tau>. \<tau> \<Turnstile> (x \<triangleq> invalid) \<Longrightarrow> - (X->including\<^sub>B\<^sub>a\<^sub>g(x)->excluding\<^sub>B\<^sub>a\<^sub>g(y)) \<tau> = - (if x \<doteq> y then X->excluding\<^sub>B\<^sub>a\<^sub>g(y) else X->excluding\<^sub>B\<^sub>a\<^sub>g(y)->including\<^sub>B\<^sub>a\<^sub>g(x) endif) \<tau>" - apply(rule foundation22[THEN iffD1]) - apply(erule StrongEq_L_subst2_rev,simp,simp) - by(simp add: strict1) - - have D: "\<And>\<tau>. \<tau> \<Turnstile> (y \<triangleq> invalid) \<Longrightarrow> - (X->including\<^sub>B\<^sub>a\<^sub>g(x)->excluding\<^sub>B\<^sub>a\<^sub>g(y)) \<tau> = - (if x \<doteq> y then X->excluding\<^sub>B\<^sub>a\<^sub>g(y) else X->excluding\<^sub>B\<^sub>a\<^sub>g(y)->including\<^sub>B\<^sub>a\<^sub>g(x) endif) \<tau>" - apply(rule foundation22[THEN iffD1]) - apply(erule StrongEq_L_subst2_rev,simp,simp) - by (simp add: strict2) - - have E: "\<And>\<tau>. \<tau> \<Turnstile> \<upsilon> x \<Longrightarrow> \<tau> \<Turnstile> \<upsilon> y \<Longrightarrow> - (if x \<doteq> y then X->excluding\<^sub>B\<^sub>a\<^sub>g(y) else X->excluding\<^sub>B\<^sub>a\<^sub>g(y)->including\<^sub>B\<^sub>a\<^sub>g(x) endif) \<tau> = - (if x \<triangleq> y then X->excluding\<^sub>B\<^sub>a\<^sub>g(y) else X->excluding\<^sub>B\<^sub>a\<^sub>g(y)->including\<^sub>B\<^sub>a\<^sub>g(x) endif) \<tau>" - apply(subst cp_OclIf) - apply(subst StrictRefEq_vs_StrongEq[THEN foundation22[THEN iffD1]]) - by(simp_all add: cp_OclIf[symmetric]) - - have F: "\<And>\<tau>. \<tau> \<Turnstile> \<delta> X \<Longrightarrow> \<tau> \<Turnstile> \<upsilon> x \<Longrightarrow> \<tau> \<Turnstile> (x \<triangleq> y) \<Longrightarrow> - (X->including\<^sub>B\<^sub>a\<^sub>g(x)->excluding\<^sub>B\<^sub>a\<^sub>g(y) \<tau>) = (X->excluding\<^sub>B\<^sub>a\<^sub>g(y) \<tau>)" - apply(drule StrongEq_L_sym) - apply(rule foundation22[THEN iffD1]) - apply(erule StrongEq_L_subst2_rev,simp) - by(simp add: OclExcluding_charn2) - - show ?thesis - apply(rule ext, rename_tac "\<tau>") - apply(case_tac "\<not> (\<tau> \<Turnstile> (\<delta> X))", simp add:defined_split,elim disjE A1 B1 A2 B2) - apply(case_tac "\<not> (\<tau> \<Turnstile> (\<upsilon> x))", - simp add:foundation18 foundation22[symmetric], - drule StrongEq_L_sym) - apply(simp add: foundation22 C) - apply(case_tac "\<not> (\<tau> \<Turnstile> (\<upsilon> y))", - simp add:foundation18 foundation22[symmetric], - drule StrongEq_L_sym, simp add: foundation22 D, simp) - apply(subst E,simp_all) - apply(case_tac "\<tau> \<Turnstile> not (x \<triangleq> y)") - apply(simp add: OclExcluding_charn1[simplified foundation22] - OclExcluding_charn2[simplified foundation22]) - apply(simp add: foundation9 F) - done -qed -*) -(* -(* Hack to work around OF-Bug *) -schematic_lemma OclExcluding_charn_exec\<^sub>I\<^sub>n\<^sub>t\<^sub>e\<^sub>g\<^sub>e\<^sub>r[simp,code_unfold]: "?X" -by(rule OclExcluding_charn_exec[OF StrictRefEq\<^sub>I\<^sub>n\<^sub>t\<^sub>e\<^sub>g\<^sub>e\<^sub>r.strict1 StrictRefEq\<^sub>I\<^sub>n\<^sub>t\<^sub>e\<^sub>g\<^sub>e\<^sub>r.strict2 - StrictRefEq\<^sub>I\<^sub>n\<^sub>t\<^sub>e\<^sub>g\<^sub>e\<^sub>r.defined_args_valid - StrictRefEq\<^sub>I\<^sub>n\<^sub>t\<^sub>e\<^sub>g\<^sub>e\<^sub>r.cp0 StrictRefEq\<^sub>I\<^sub>n\<^sub>t\<^sub>e\<^sub>g\<^sub>e\<^sub>r.StrictRefEq_vs_StrongEq], simp_all) - -schematic_lemma OclExcluding_charn_exec\<^sub>B\<^sub>o\<^sub>o\<^sub>l\<^sub>e\<^sub>a\<^sub>n[simp,code_unfold]: "?X" -by(rule OclExcluding_charn_exec[OF StrictRefEq\<^sub>B\<^sub>o\<^sub>o\<^sub>l\<^sub>e\<^sub>a\<^sub>n.strict1 StrictRefEq\<^sub>B\<^sub>o\<^sub>o\<^sub>l\<^sub>e\<^sub>a\<^sub>n.strict2 - StrictRefEq\<^sub>B\<^sub>o\<^sub>o\<^sub>l\<^sub>e\<^sub>a\<^sub>n.defined_args_valid - StrictRefEq\<^sub>B\<^sub>o\<^sub>o\<^sub>l\<^sub>e\<^sub>a\<^sub>n.cp0 StrictRefEq\<^sub>B\<^sub>o\<^sub>o\<^sub>l\<^sub>e\<^sub>a\<^sub>n.StrictRefEq_vs_StrongEq], simp_all) - - -schematic_lemma OclExcluding_charn_exec\<^sub>B\<^sub>a\<^sub>g[simp,code_unfold]: "?X" -by(rule OclExcluding_charn_exec[OF StrictRefEq\<^sub>B\<^sub>a\<^sub>g.strict1 StrictRefEq\<^sub>B\<^sub>a\<^sub>g.strict2 - StrictRefEq\<^sub>B\<^sub>a\<^sub>g.defined_args_valid - StrictRefEq\<^sub>B\<^sub>a\<^sub>g.cp0 StrictRefEq\<^sub>B\<^sub>a\<^sub>g.StrictRefEq_vs_StrongEq], simp_all) -*) -(* -subsubsection{* Execution Rules on Includes *} - -lemma OclIncludes_charn0[simp]: -assumes val_x:"\<tau> \<Turnstile> (\<upsilon> x)" -shows "\<tau> \<Turnstile> not(Set{}->includes\<^sub>B\<^sub>a\<^sub>g(x))" -using val_x -apply(auto simp: OclValid_def OclIncludes_def OclNot_def false_def true_def) -apply(auto simp: mtSet_def Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e.Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inverse) -done - - -lemma OclIncludes_charn0'[simp,code_unfold]: -"Set{}->includes\<^sub>B\<^sub>a\<^sub>g(x) = (if \<upsilon> x then false else invalid endif)" -proof - - have A: "\<And> \<tau>. (Set{}->includes\<^sub>B\<^sub>a\<^sub>g(invalid)) \<tau> = (if (\<upsilon> invalid) then false else invalid endif) \<tau>" - by simp - have B: "\<And> \<tau> x. \<tau> \<Turnstile> (\<upsilon> x) \<Longrightarrow> (Set{}->includes\<^sub>B\<^sub>a\<^sub>g(x)) \<tau> = (if \<upsilon> x then false else invalid endif) \<tau>" - apply(frule OclIncludes_charn0, simp add: OclValid_def) - apply(rule foundation21[THEN fun_cong, simplified StrongEq_def,simplified, - THEN iffD1, of _ _ "false"]) - by simp - show ?thesis - apply(rule ext, rename_tac \<tau>) - apply(case_tac "\<tau> \<Turnstile> (\<upsilon> x)") - apply(simp_all add: B foundation18) - apply(subst OclIncludes.cp0, simp add: OclIncludes.cp0[symmetric] A) - done -qed - -lemma OclIncludes_charn1: -assumes def_X:"\<tau> \<Turnstile> (\<delta> X)" -assumes val_x:"\<tau> \<Turnstile> (\<upsilon> x)" -shows "\<tau> \<Turnstile> (X->including\<^sub>B\<^sub>a\<^sub>g(x)->includes\<^sub>B\<^sub>a\<^sub>g(x))" -proof - - have C : "\<lfloor>\<lfloor>insert (x \<tau>) (Rep_Bag_base X \<tau>)\<rfloor>\<rfloor> \<in> {X. X = bot \<or> X = null \<or> (\<forall>x\<in>\<lceil>\<lceil>X\<rceil>\<rceil>. x \<noteq> bot)}" - by(insert def_X val_x, frule Set_inv_lemma, simp add: foundation18 invalid_def) - show ?thesis - apply(subst OclIncludes_def, simp add: foundation10[simplified OclValid_def] OclValid_def - def_X[simplified OclValid_def] val_x[simplified OclValid_def]) - apply(simp add: OclIncluding_def def_X[simplified OclValid_def] val_x[simplified OclValid_def] - Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inverse[OF C] true_def) - done -qed - - - -lemma OclIncludes_charn2: -assumes def_X:"\<tau> \<Turnstile> (\<delta> X)" -and val_x:"\<tau> \<Turnstile> (\<upsilon> x)" -and val_y:"\<tau> \<Turnstile> (\<upsilon> y)" -and neq :"\<tau> \<Turnstile> not(x \<triangleq> y)" -shows "\<tau> \<Turnstile> (X->including\<^sub>B\<^sub>a\<^sub>g(x)->includes\<^sub>B\<^sub>a\<^sub>g(y)) \<triangleq> (X->includes\<^sub>B\<^sub>a\<^sub>g(y))" -proof - - have C : "\<lfloor>\<lfloor>insert (x \<tau>) (Rep_Bag_base X \<tau>)\<rfloor>\<rfloor> \<in> {X. X = bot \<or> X = null \<or> (\<forall>x\<in>\<lceil>\<lceil>X\<rceil>\<rceil>. x \<noteq> bot)}" - by(insert def_X val_x, frule Set_inv_lemma, simp add: foundation18 invalid_def) - show ?thesis - apply(subst OclIncludes_def, - simp add: def_X[simplified OclValid_def] val_x[simplified OclValid_def] - val_y[simplified OclValid_def] foundation10[simplified OclValid_def] - OclValid_def StrongEq_def) - apply(simp add: OclIncluding_def OclIncludes_def def_X[simplified OclValid_def] - val_x[simplified OclValid_def] val_y[simplified OclValid_def] - Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inverse[OF C] true_def) - by(metis foundation22 foundation6 foundation9 neq) -qed - -text{* Here is again a generic theorem similar as above. *} - -lemma OclIncludes_execute_generic: -assumes strict1: "(invalid \<doteq> y) = invalid" -and strict2: "(x \<doteq> invalid) = invalid" -and cp_StrictRefEq: "\<And> (X::('\<AA>,'a::null)val) Y \<tau>. (X \<doteq> Y) \<tau> = ((\<lambda>_. X \<tau>) \<doteq> (\<lambda>_. Y \<tau>)) \<tau>" -and StrictRefEq_vs_StrongEq: "\<And> (x::('\<AA>,'a::null)val) y \<tau>. - \<tau> \<Turnstile> \<upsilon> x \<Longrightarrow> \<tau> \<Turnstile> \<upsilon> y \<Longrightarrow> (\<tau> \<Turnstile> ((x \<doteq> y) \<triangleq> (x \<triangleq> y)))" -shows - "(X->including\<^sub>B\<^sub>a\<^sub>g(x::('\<AA>,'a::null)val)->includes\<^sub>B\<^sub>a\<^sub>g(y)) = - (if \<delta> X then if x \<doteq> y then true else X->includes\<^sub>B\<^sub>a\<^sub>g(y) endif else invalid endif)" -proof - - have A: "\<And>\<tau>. \<tau> \<Turnstile> (X \<triangleq> invalid) \<Longrightarrow> - (X->including\<^sub>B\<^sub>a\<^sub>g(x)->includes\<^sub>B\<^sub>a\<^sub>g(y)) \<tau> = invalid \<tau>" - apply(rule foundation22[THEN iffD1]) - by(erule StrongEq_L_subst2_rev,simp,simp) - have B: "\<And>\<tau>. \<tau> \<Turnstile> (X \<triangleq> null) \<Longrightarrow> - (X->including\<^sub>B\<^sub>a\<^sub>g(x)->includes\<^sub>B\<^sub>a\<^sub>g(y)) \<tau> = invalid \<tau>" - apply(rule foundation22[THEN iffD1]) - by(erule StrongEq_L_subst2_rev,simp,simp) - - note [simp] = cp_StrictRefEq [THEN allI[THEN allI[THEN allI[THEN cpI2]], of "StrictRefEq"]] - - have C: "\<And>\<tau>. \<tau> \<Turnstile> (x \<triangleq> invalid) \<Longrightarrow> - (X->including\<^sub>B\<^sub>a\<^sub>g(x)->includes\<^sub>B\<^sub>a\<^sub>g(y)) \<tau> = - (if x \<doteq> y then true else X->includes\<^sub>B\<^sub>a\<^sub>g(y) endif) \<tau>" - apply(rule foundation22[THEN iffD1]) - apply(erule StrongEq_L_subst2_rev,simp,simp) - by (simp add: strict1) - have D:"\<And>\<tau>. \<tau> \<Turnstile> (y \<triangleq> invalid) \<Longrightarrow> - (X->including\<^sub>B\<^sub>a\<^sub>g(x)->includes\<^sub>B\<^sub>a\<^sub>g(y)) \<tau> = - (if x \<doteq> y then true else X->includes\<^sub>B\<^sub>a\<^sub>g(y) endif) \<tau>" - apply(rule foundation22[THEN iffD1]) - apply(erule StrongEq_L_subst2_rev,simp,simp) - by (simp add: strict2) - have E: "\<And>\<tau>. \<tau> \<Turnstile> \<upsilon> x \<Longrightarrow> \<tau> \<Turnstile> \<upsilon> y \<Longrightarrow> - (if x \<doteq> y then true else X->includes\<^sub>B\<^sub>a\<^sub>g(y) endif) \<tau> = - (if x \<triangleq> y then true else X->includes\<^sub>B\<^sub>a\<^sub>g(y) endif) \<tau>" - apply(subst cp_OclIf) - apply(subst StrictRefEq_vs_StrongEq[THEN foundation22[THEN iffD1]]) - by(simp_all add: cp_OclIf[symmetric]) - have F: "\<And>\<tau>. \<tau> \<Turnstile> (x \<triangleq> y) \<Longrightarrow> - (X->including\<^sub>B\<^sub>a\<^sub>g(x)->includes\<^sub>B\<^sub>a\<^sub>g(y)) \<tau> = (X->including\<^sub>B\<^sub>a\<^sub>g(x)->includes\<^sub>B\<^sub>a\<^sub>g(x)) \<tau>" - apply(rule foundation22[THEN iffD1]) - by(erule StrongEq_L_subst2_rev,simp, simp) - show ?thesis - apply(rule ext, rename_tac "\<tau>") - apply(case_tac "\<not> (\<tau> \<Turnstile> (\<delta> X))", simp add:defined_split,elim disjE A B) - apply(case_tac "\<not> (\<tau> \<Turnstile> (\<upsilon> x))", - simp add:foundation18 foundation22[symmetric], - drule StrongEq_L_sym) - apply(simp add: foundation22 C) - apply(case_tac "\<not> (\<tau> \<Turnstile> (\<upsilon> y))", - simp add:foundation18 foundation22[symmetric], - drule StrongEq_L_sym, simp add: foundation22 D, simp) - apply(subst E,simp_all) - apply(case_tac "\<tau> \<Turnstile> not(x \<triangleq> y)") - apply(simp add: OclIncludes_charn2[simplified foundation22]) - apply(simp add: foundation9 F - OclIncludes_charn1[THEN foundation13[THEN iffD2], - THEN foundation22[THEN iffD1]]) - done -qed - - -(* Hack to work around OF-Bug *) -schematic_lemma OclIncludes_execute\<^sub>I\<^sub>n\<^sub>t\<^sub>e\<^sub>g\<^sub>e\<^sub>r[simp,code_unfold]: "?X" -by(rule OclIncludes_execute_generic[OF StrictRefEq\<^sub>I\<^sub>n\<^sub>t\<^sub>e\<^sub>g\<^sub>e\<^sub>r.strict1 StrictRefEq\<^sub>I\<^sub>n\<^sub>t\<^sub>e\<^sub>g\<^sub>e\<^sub>r.strict2 - StrictRefEq\<^sub>I\<^sub>n\<^sub>t\<^sub>e\<^sub>g\<^sub>e\<^sub>r.cp0 - StrictRefEq\<^sub>I\<^sub>n\<^sub>t\<^sub>e\<^sub>g\<^sub>e\<^sub>r.StrictRefEq_vs_StrongEq], simp_all) - - -schematic_lemma OclIncludes_execute\<^sub>B\<^sub>o\<^sub>o\<^sub>l\<^sub>e\<^sub>a\<^sub>n[simp,code_unfold]: "?X" -by(rule OclIncludes_execute_generic[OF StrictRefEq\<^sub>B\<^sub>o\<^sub>o\<^sub>l\<^sub>e\<^sub>a\<^sub>n.strict1 StrictRefEq\<^sub>B\<^sub>o\<^sub>o\<^sub>l\<^sub>e\<^sub>a\<^sub>n.strict2 - StrictRefEq\<^sub>B\<^sub>o\<^sub>o\<^sub>l\<^sub>e\<^sub>a\<^sub>n.cp0 - StrictRefEq\<^sub>B\<^sub>o\<^sub>o\<^sub>l\<^sub>e\<^sub>a\<^sub>n.StrictRefEq_vs_StrongEq], simp_all) - - -schematic_lemma OclIncludes_execute\<^sub>B\<^sub>a\<^sub>g[simp,code_unfold]: "?X" -by(rule OclIncludes_execute_generic[OF StrictRefEq\<^sub>B\<^sub>a\<^sub>g.strict1 StrictRefEq\<^sub>B\<^sub>a\<^sub>g.strict2 - StrictRefEq\<^sub>B\<^sub>a\<^sub>g.cp0 - StrictRefEq\<^sub>B\<^sub>a\<^sub>g.StrictRefEq_vs_StrongEq], simp_all) - -lemma OclIncludes_including_generic : - assumes OclIncludes_execute_generic [simp] : "\<And>X x y. - (X->including\<^sub>B\<^sub>a\<^sub>g(x::('\<AA>,'a::null)val)->includes\<^sub>B\<^sub>a\<^sub>g(y)) = - (if \<delta> X then if x \<doteq> y then true else X->includes\<^sub>B\<^sub>a\<^sub>g(y) endif else invalid endif)" - and StrictRefEq_strict'' : "\<And>x y. \<delta> ((x::('\<AA>,'a::null)val) \<doteq> y) = (\<upsilon>(x) and \<upsilon>(y))" - and a_val : "\<tau> \<Turnstile> \<upsilon> a" - and x_val : "\<tau> \<Turnstile> \<upsilon> x" - and S_incl : "\<tau> \<Turnstile> (S)->includes\<^sub>B\<^sub>a\<^sub>g((x::('\<AA>,'a::null)val))" - shows "\<tau> \<Turnstile> S->including\<^sub>B\<^sub>a\<^sub>g((a::('\<AA>,'a::null)val))->includes\<^sub>B\<^sub>a\<^sub>g(x)" -proof - - have discr_eq_bot1_true : "\<And>\<tau>. (\<bottom> \<tau> = true \<tau>) = False" - by (metis bot_fun_def foundation1 foundation18' valid3) - have discr_eq_bot2_true : "\<And>\<tau>. (\<bottom> = true \<tau>) = False" - by (metis bot_fun_def discr_eq_bot1_true) - have discr_neq_invalid_true : "\<And>\<tau>. (invalid \<tau> \<noteq> true \<tau>) = True" - by (metis discr_eq_bot2_true invalid_def) - have discr_eq_invalid_true : "\<And>\<tau>. (invalid \<tau> = true \<tau>) = False" - by (metis bot_option_def invalid_def option.simps(2) true_def) -show ?thesis - apply(simp) - apply(subgoal_tac "\<tau> \<Turnstile> \<delta> S") - prefer 2 - apply(insert S_incl[simplified OclIncludes_def], simp add: OclValid_def) - apply(metis discr_eq_bot2_true) - apply(simp add: cp_OclIf[of "\<delta> S"] OclValid_def OclIf_def x_val[simplified OclValid_def] - discr_neq_invalid_true discr_eq_invalid_true) - by (metis OclValid_def S_incl StrictRefEq_strict'' a_val foundation10 foundation6 x_val) -qed - -lemmas OclIncludes_including\<^sub>I\<^sub>n\<^sub>t\<^sub>e\<^sub>g\<^sub>e\<^sub>r = - OclIncludes_including_generic[OF OclIncludes_execute\<^sub>I\<^sub>n\<^sub>t\<^sub>e\<^sub>g\<^sub>e\<^sub>r StrictRefEq\<^sub>I\<^sub>n\<^sub>t\<^sub>e\<^sub>g\<^sub>e\<^sub>r.def_homo] - -subsubsection{* Execution Rules on Excludes *} - -lemma OclExcludes_charn1: -assumes def_X:"\<tau> \<Turnstile> (\<delta> X)" -assumes val_x:"\<tau> \<Turnstile> (\<upsilon> x)" -shows "\<tau> \<Turnstile> (X->excluding\<^sub>B\<^sub>a\<^sub>g(x)->excludes\<^sub>B\<^sub>a\<^sub>g(x))" -proof - - let ?OclSet = "\<lambda>S. \<lfloor>\<lfloor>S\<rfloor>\<rfloor> \<in> {X. X = \<bottom> \<or> X = null \<or> (\<forall>x\<in>\<lceil>\<lceil>X\<rceil>\<rceil>. x \<noteq> \<bottom>)}" - have diff_in_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e : "?OclSet ((Rep_Bag_base X \<tau>) - {x \<tau>})" - apply(simp, (rule disjI2)+) - by (metis (hide_lams, no_types) Diff_iff Set_inv_lemma def_X) - - show ?thesis - apply(subst OclExcludes_def, simp add: foundation10[simplified OclValid_def] OclValid_def - def_X[simplified OclValid_def] val_x[simplified OclValid_def]) - apply(subst OclIncludes_def, simp add: OclNot_def) - apply(simp add: OclExcluding_def def_X[simplified OclValid_def] val_x[simplified OclValid_def] - Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inverse[OF diff_in_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e] true_def) - by(simp add: OclAnd_def def_X[simplified OclValid_def] val_x[simplified OclValid_def] true_def) -qed - -subsubsection{* Execution Rules on Size *} - -lemma [simp,code_unfold]: "Set{} ->size\<^sub>B\<^sub>a\<^sub>g() = \<zero>" - apply(rule ext) - apply(simp add: defined_def mtSet_def OclSize_def - bot_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def bot_fun_def - null_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def null_fun_def) - apply(subst Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inject, simp_all add: bot_option_def null_option_def) + -by(simp add: Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inverse bot_option_def null_option_def OclInt0_def) - -lemma OclSize_including_exec[simp,code_unfold]: - "((X ->including\<^sub>B\<^sub>a\<^sub>g(x)) ->size\<^sub>B\<^sub>a\<^sub>g()) = (if \<delta> X and \<upsilon> x then - X ->size\<^sub>B\<^sub>a\<^sub>g() +\<^sub>i\<^sub>n\<^sub>t if X ->includes\<^sub>B\<^sub>a\<^sub>g(x) then \<zero> else \<one> endif - else - invalid - endif)" -proof - - - have valid_inject_true : "\<And>\<tau> P. (\<upsilon> P) \<tau> \<noteq> true \<tau> \<Longrightarrow> (\<upsilon> P) \<tau> = false \<tau>" - apply(simp add: valid_def true_def false_def bot_fun_def bot_option_def - null_fun_def null_option_def) - by (case_tac "P \<tau> = \<bottom>", simp_all add: true_def) - have defined_inject_true : "\<And>\<tau> P. (\<delta> P) \<tau> \<noteq> true \<tau> \<Longrightarrow> (\<delta> P) \<tau> = false \<tau>" - apply(simp add: defined_def true_def false_def bot_fun_def bot_option_def - null_fun_def null_option_def) - by (case_tac " P \<tau> = \<bottom> \<or> P \<tau> = null", simp_all add: true_def) - - show ?thesis - apply(rule ext, rename_tac \<tau>) - proof - - fix \<tau> - have includes_notin: "\<not> \<tau> \<Turnstile> X->includes\<^sub>B\<^sub>a\<^sub>g(x) \<Longrightarrow> (\<delta> X) \<tau> = true \<tau> \<and> (\<upsilon> x) \<tau> = true \<tau> \<Longrightarrow> - x \<tau> \<notin> (Rep_Bag_base X \<tau>)" - by(simp add: OclIncludes_def OclValid_def true_def) - - have includes_def: "\<tau> \<Turnstile> X->includes\<^sub>B\<^sub>a\<^sub>g(x) \<Longrightarrow> \<tau> \<Turnstile> \<delta> X" - by (metis bot_fun_def OclIncludes_def OclValid_def defined3 foundation16) - - have includes_val: "\<tau> \<Turnstile> X->includes\<^sub>B\<^sub>a\<^sub>g(x) \<Longrightarrow> \<tau> \<Turnstile> \<upsilon> x" - using foundation5 foundation6 by fastforce - - have ins_in_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e: "\<tau> \<Turnstile> \<delta> X \<Longrightarrow> \<tau> \<Turnstile> \<upsilon> x \<Longrightarrow> - \<lfloor>\<lfloor>insert (x \<tau>) (Rep_Bag_base X \<tau>)\<rfloor>\<rfloor> \<in> {X. X = \<bottom> \<or> X = null \<or> (\<forall>x\<in>\<lceil>\<lceil>X\<rceil>\<rceil>. x \<noteq> \<bottom>)}" - apply(simp add: bot_option_def null_option_def) - by (metis (hide_lams, no_types) Set_inv_lemma foundation18' foundation5) - - have m : "\<And>\<tau>. (\<lambda>_. \<bottom>) = (\<lambda>_. invalid \<tau>)" by(rule ext, simp add:invalid_def) - - show "X->including\<^sub>B\<^sub>a\<^sub>g(x)->size\<^sub>B\<^sub>a\<^sub>g() \<tau> = (if \<delta> X and \<upsilon> x - then X->size\<^sub>B\<^sub>a\<^sub>g() +\<^sub>i\<^sub>n\<^sub>t if X->includes\<^sub>B\<^sub>a\<^sub>g(x) then \<zero> else \<one> endif - else invalid endif) \<tau>" - apply(case_tac "\<tau> \<Turnstile> \<delta> X and \<upsilon> x", simp) - apply(subst OclAdd\<^sub>I\<^sub>n\<^sub>t\<^sub>e\<^sub>g\<^sub>e\<^sub>r.cp0) - apply(case_tac "\<tau> \<Turnstile> X->includes\<^sub>B\<^sub>a\<^sub>g(x)", simp add: OclAdd\<^sub>I\<^sub>n\<^sub>t\<^sub>e\<^sub>g\<^sub>e\<^sub>r.cp0[symmetric]) - apply(case_tac "\<tau> \<Turnstile> ((\<upsilon> (X->size\<^sub>B\<^sub>a\<^sub>g())) and not (\<delta> (X->size\<^sub>B\<^sub>a\<^sub>g())))", simp) - apply(drule foundation5[where P = "\<upsilon> X->size\<^sub>B\<^sub>a\<^sub>g()"], erule conjE) - apply(drule OclSize_infinite) - apply(frule includes_def, drule includes_val, simp) - apply(subst OclSize_def, subst OclIncluding_finite_rep_set, assumption+) - apply (metis (hide_lams, no_types) invalid_def) - - apply(subst OclIf_false', - metis (hide_lams, no_types) defined5 defined6 defined_and_I defined_not_I - foundation1 foundation9) - apply(subst cp_OclSize, simp add: OclIncluding_includes0 cp_OclSize[symmetric]) - (* *) - apply(subst OclIf_false', subst foundation9, auto, simp add: OclSize_def) - apply(drule foundation5) - apply(subst (1 2) OclIncluding_finite_rep_set, fast+) - apply(subst (1 2) cp_OclAnd, subst (1 2) OclAdd\<^sub>I\<^sub>n\<^sub>t\<^sub>e\<^sub>g\<^sub>e\<^sub>r.cp0, simp) - apply(rule conjI) - apply(simp add: OclIncluding_def) - apply(subst Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inverse[OF ins_in_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e], fast+) - apply(subst (asm) (2 3) OclValid_def, simp add: OclAdd\<^sub>I\<^sub>n\<^sub>t\<^sub>e\<^sub>g\<^sub>e\<^sub>r_def OclInt1_def) - apply(rule impI) - apply(drule Finite_Set.card.insert[where x = "x \<tau>"]) - apply(rule includes_notin, simp, simp) - apply (metis Suc_eq_plus1 int_1 of_nat_add) - - apply(subst (1 2) m[of \<tau>], simp only: OclAdd\<^sub>I\<^sub>n\<^sub>t\<^sub>e\<^sub>g\<^sub>e\<^sub>r.cp0[symmetric],simp, simp add:invalid_def) - apply(subst OclIncluding_finite_rep_set, fast+, simp add: OclValid_def) - (* *) - apply(subst OclIf_false', metis (hide_lams, no_types) defined6 foundation1 foundation9 - OclExcluding_valid_args_valid'') - by (metis cp_OclSize foundation18' OclIncluding_valid_args_valid'' invalid_def OclSize_invalid) - qed -qed - -subsubsection{* Execution Rules on IsEmpty *} - -lemma [simp,code_unfold]: "Set{}->isEmpty\<^sub>B\<^sub>a\<^sub>g() = true" -by(simp add: OclIsEmpty_def) - -lemma OclIsEmpty_including [simp]: -assumes X_def: "\<tau> \<Turnstile> \<delta> X" - and X_finite: "finite (Rep_Bag_base X \<tau>)" - and a_val: "\<tau> \<Turnstile> \<upsilon> a" -shows "X->including\<^sub>B\<^sub>a\<^sub>g(a)->isEmpty\<^sub>B\<^sub>a\<^sub>g() \<tau> = false \<tau>" -proof - - have A1 : "\<And>\<tau> X. X \<tau> = true \<tau> \<or> X \<tau> = false \<tau> \<Longrightarrow> (X and not X) \<tau> = false \<tau>" - by (metis (no_types) OclAnd_false1 OclAnd_idem OclImplies_def OclNot3 OclNot_not OclOr_false1 - cp_OclAnd cp_OclNot deMorgan1 deMorgan2) - - have defined_inject_true : "\<And>\<tau> P. (\<delta> P) \<tau> \<noteq> true \<tau> \<Longrightarrow> (\<delta> P) \<tau> = false \<tau>" - apply(simp add: defined_def true_def false_def bot_fun_def bot_option_def - null_fun_def null_option_def) - by (case_tac " P \<tau> = \<bottom> \<or> P \<tau> = null", simp_all add: true_def) - - have B : "\<And>X \<tau>. \<tau> \<Turnstile> \<upsilon> X \<Longrightarrow> X \<tau> \<noteq> \<zero> \<tau> \<Longrightarrow> (X \<doteq> \<zero>) \<tau> = false \<tau>" - apply(simp add: foundation22[symmetric] foundation14 foundation9) - apply(erule StrongEq_L_subst4_rev[THEN iffD2, OF StrictRefEq\<^sub>I\<^sub>n\<^sub>t\<^sub>e\<^sub>g\<^sub>e\<^sub>r.StrictRefEq_vs_StrongEq]) - by(simp_all) - - show ?thesis - apply(simp add: OclIsEmpty_def del: OclSize_including_exec) - apply(subst cp_OclOr, subst A1) - apply (metis OclExcludes.def_homo defined_inject_true) - apply(simp add: cp_OclOr[symmetric] del: OclSize_including_exec) - apply(rule B, - rule foundation20, - metis OclIncluding.def_homo OclIncluding_finite_rep_set X_def X_finite a_val foundation10' size_defined') - apply(simp add: OclSize_def OclIncluding_finite_rep_set[OF X_def a_val] X_finite OclInt0_def) - by (metis OclValid_def X_def a_val foundation10 foundation6 - OclIncluding_notempty_rep_set[OF X_def a_val]) -qed - -subsubsection{* Execution Rules on NotEmpty *} - -lemma [simp,code_unfold]: "Set{}->notEmpty\<^sub>B\<^sub>a\<^sub>g() = false" -by(simp add: OclNotEmpty_def) - -lemma OclNotEmpty_including [simp,code_unfold]: -assumes X_def: "\<tau> \<Turnstile> \<delta> X" - and X_finite: "finite (Rep_Bag_base X \<tau>)" - and a_val: "\<tau> \<Turnstile> \<upsilon> a" -shows "X->including\<^sub>B\<^sub>a\<^sub>g(a)->notEmpty\<^sub>B\<^sub>a\<^sub>g() \<tau> = true \<tau>" - apply(simp add: OclNotEmpty_def) - apply(subst cp_OclNot, subst OclIsEmpty_including, simp_all add: assms) -by (metis OclNot4 cp_OclNot) - -subsubsection{* Execution Rules on Any *} - -lemma [simp,code_unfold]: "Set{}->any\<^sub>B\<^sub>a\<^sub>g() = null" -by(rule ext, simp add: OclANY_def, simp add: false_def true_def) - -lemma OclANY_singleton_exec[simp,code_unfold]: - "(Set{}->including\<^sub>B\<^sub>a\<^sub>g(a))->any\<^sub>B\<^sub>a\<^sub>g() = a" - apply(rule ext, rename_tac \<tau>, simp add: mtSet_def OclANY_def) - apply(case_tac "\<tau> \<Turnstile> \<upsilon> a") - apply(simp add: OclValid_def mtSet_defined[simplified mtSet_def] - mtSet_valid[simplified mtSet_def] mtSet_rep_set[simplified mtSet_def]) - apply(subst (1 2) cp_OclAnd, - subst (1 2) OclNotEmpty_including[where X = "Set{}", simplified mtSet_def]) - apply(simp add: mtSet_defined[simplified mtSet_def]) - apply(metis (hide_lams, no_types) finite.emptyI mtSet_def mtSet_rep_set) - apply(simp add: OclValid_def) - apply(simp add: OclIncluding_def) - apply(rule conjI) - apply(subst (1 2) Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inverse, simp add: bot_option_def null_option_def) - apply(simp, metis OclValid_def foundation18') - apply(simp) - apply(simp add: mtSet_defined[simplified mtSet_def]) - (* *) - apply(subgoal_tac "a \<tau> = \<bottom>") - prefer 2 - apply(simp add: OclValid_def valid_def bot_fun_def split: if_split_asm) - apply(simp) - apply(subst (1 2 3 4) cp_OclAnd, - simp add: mtSet_defined[simplified mtSet_def] valid_def bot_fun_def) -by(simp add: cp_OclAnd[symmetric], rule impI, simp add: false_def true_def) - -subsubsection{* Execution Rules on Forall *} - -lemma OclForall_mtSet_exec[simp,code_unfold] :"((Set{})->forAll\<^sub>B\<^sub>a\<^sub>g(z| P(z))) = true" -apply(simp add: OclForall_def) -apply(subst mtSet_def)+ -apply(subst Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inverse, simp_all add: true_def)+ -done - - -text{* The following rule is a main theorem of our approach: From a denotational definition -that assures consistency, but may be --- as in the case of the @{term "X->forAll\<^sub>B\<^sub>a\<^sub>g(x | P x)"} --- -dauntingly complex, we derive operational rules that can serve as a gold-standard for operational -execution, since they may be evaluated in whatever situation and according to whatever strategy. -In the case of @{term "X->forAll\<^sub>B\<^sub>a\<^sub>g(x | P x)"}, the operational rule gives immediately a way to -evaluation in any finite (in terms of conventional OCL: denotable) set, although the rule also -holds for the infinite case: - -@{term "Integer\<^sub>n\<^sub>u\<^sub>l\<^sub>l ->forAll\<^sub>B\<^sub>a\<^sub>g(x | (Integer\<^sub>n\<^sub>u\<^sub>l\<^sub>l ->forAll\<^sub>B\<^sub>a\<^sub>g(y | x +\<^sub>i\<^sub>n\<^sub>t y \<triangleq> y +\<^sub>i\<^sub>n\<^sub>t x)))"} - -or even: - -@{term "Integer ->forAll\<^sub>B\<^sub>a\<^sub>g(x | (Integer ->forAll\<^sub>B\<^sub>a\<^sub>g(y | x +\<^sub>i\<^sub>n\<^sub>t y \<doteq> y +\<^sub>i\<^sub>n\<^sub>t x)))"} - -are valid OCL statements in any context $\tau$. -*} - -theorem OclForall_including_exec[simp,code_unfold] : - assumes cp0 : "cp P" - shows "((S->including\<^sub>B\<^sub>a\<^sub>g(x))->forAll\<^sub>B\<^sub>a\<^sub>g(z | P(z))) = (if \<delta> S and \<upsilon> x - then P x and (S->forAll\<^sub>B\<^sub>a\<^sub>g(z | P(z))) - else invalid - endif)" -proof - - have cp: "\<And>\<tau>. P x \<tau> = P (\<lambda>_. x \<tau>) \<tau>" by(insert cp0, auto simp: cp_def) - - have cp_eq : "\<And>\<tau> v. (P x \<tau> = v) = (P (\<lambda>_. x \<tau>) \<tau> = v)" by(subst cp, simp) - - have cp_OclNot_eq : "\<And>\<tau> v. (P x \<tau> \<noteq> v) = (P (\<lambda>_. x \<tau>) \<tau> \<noteq> v)" by(subst cp, simp) - - have insert_in_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e : "\<And>\<tau>. (\<tau> \<Turnstile>(\<delta> S)) \<Longrightarrow> (\<tau> \<Turnstile>(\<upsilon> x)) \<Longrightarrow> - \<lfloor>\<lfloor>insert (x \<tau>) \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil>\<rfloor>\<rfloor> \<in> - {X. X = bot \<or> X = null \<or> (\<forall>x\<in>\<lceil>\<lceil>X\<rceil>\<rceil>. x \<noteq> bot)}" - by(frule Set_inv_lemma, simp add: foundation18 invalid_def) - - have forall_including_invert : "\<And>\<tau> f. (f x \<tau> = f (\<lambda> _. x \<tau>) \<tau>) \<Longrightarrow> - \<tau> \<Turnstile> (\<delta> S and \<upsilon> x) \<Longrightarrow> - (\<forall>x\<in>\<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S->including\<^sub>B\<^sub>a\<^sub>g(x) \<tau>)\<rceil>\<rceil>. f (\<lambda>_. x) \<tau>) = - (f x \<tau> \<and> (\<forall>x\<in>\<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil>. f (\<lambda>_. x) \<tau>))" - apply(drule foundation5, simp add: OclIncluding_def) - apply(subst Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inverse) - apply(rule insert_in_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e, fast+) - by(simp add: OclValid_def) - - have exists_including_invert : "\<And>\<tau> f. (f x \<tau> = f (\<lambda> _. x \<tau>) \<tau>) \<Longrightarrow> - \<tau> \<Turnstile> (\<delta> S and \<upsilon> x) \<Longrightarrow> - (\<exists>x\<in>\<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S->including\<^sub>B\<^sub>a\<^sub>g(x) \<tau>)\<rceil>\<rceil>. f (\<lambda>_. x) \<tau>) = - (f x \<tau> \<or> (\<exists>x\<in>\<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil>. f (\<lambda>_. x) \<tau>))" - apply(subst arg_cong[where f = "\<lambda>x. \<not>x", - OF forall_including_invert[where f = "\<lambda>x \<tau>. \<not> (f x \<tau>)"], - simplified]) - by simp_all - - have contradict_Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e: "\<And>\<tau> S f. \<exists>x\<in>\<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e S\<rceil>\<rceil>. f (\<lambda>_. x) \<tau> \<Longrightarrow> - (\<forall>x\<in>\<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e S\<rceil>\<rceil>. \<not> (f (\<lambda>_. x) \<tau>)) = False" - by(case_tac "(\<forall>x\<in>\<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e S\<rceil>\<rceil>. \<not> (f (\<lambda>_. x) \<tau>)) = True", simp_all) - - have bot_invalid : "\<bottom> = invalid" by(rule ext, simp add: invalid_def bot_fun_def) - - have bot_invalid2 : "\<And>\<tau>. \<bottom> = invalid \<tau>" by(simp add: invalid_def) - - have C1 : "\<And>\<tau>. P x \<tau> = false \<tau> \<or> (\<exists>x\<in>\<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil>. P (\<lambda>_. x) \<tau> = false \<tau>) \<Longrightarrow> - \<tau> \<Turnstile> (\<delta> S and \<upsilon> x) \<Longrightarrow> - false \<tau> = (P x and OclForall S P) \<tau>" - apply(simp add: cp_OclAnd[of "P x"]) - apply(elim disjE, simp) - apply(simp only: cp_OclAnd[symmetric], simp) - apply(subgoal_tac "OclForall S P \<tau> = false \<tau>") - apply(simp only: cp_OclAnd[symmetric], simp) - apply(simp add: OclForall_def) - apply(fold OclValid_def, simp add: foundation10') - done - - have C2 : "\<And>\<tau>. \<tau> \<Turnstile> (\<delta> S and \<upsilon> x) \<Longrightarrow> - P x \<tau> = null \<tau> \<or> (\<exists>x\<in>\<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil>. P (\<lambda>_. x) \<tau> = null \<tau>) \<Longrightarrow> - P x \<tau> = invalid \<tau> \<or> (\<exists>x\<in>\<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil>. P (\<lambda>_. x) \<tau> = invalid \<tau>) \<Longrightarrow> - \<forall>x\<in>\<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S->including\<^sub>B\<^sub>a\<^sub>g(x) \<tau>)\<rceil>\<rceil>. P (\<lambda>_. x) \<tau> \<noteq> false \<tau> \<Longrightarrow> - invalid \<tau> = (P x and OclForall S P) \<tau>" - apply(subgoal_tac "(\<delta> S)\<tau> = true \<tau>") - prefer 2 apply(simp add: foundation10', simp add: OclValid_def) - apply(drule forall_including_invert[of "\<lambda> x \<tau>. P x \<tau> \<noteq> false \<tau>", OF cp_OclNot_eq, THEN iffD1]) - apply(assumption) - apply(simp add: cp_OclAnd[of "P x"],elim disjE, simp_all) - apply(simp add: invalid_def null_fun_def null_option_def bot_fun_def bot_option_def) - apply(subgoal_tac "OclForall S P \<tau> = invalid \<tau>") - apply(simp only:cp_OclAnd[symmetric],simp,simp add:invalid_def bot_fun_def) - apply(unfold OclForall_def, simp add: invalid_def false_def bot_fun_def,simp) - apply(simp add:cp_OclAnd[symmetric],simp) - apply(erule conjE) - apply(subgoal_tac "(P x \<tau> = invalid \<tau>) \<or> (P x \<tau> = null \<tau>) \<or> (P x \<tau> = true \<tau>) \<or> (P x \<tau> = false \<tau>)") - prefer 2 apply(rule bool_split_0) - apply(elim disjE, simp_all) - apply(simp only:cp_OclAnd[symmetric],simp)+ - done - - have A : "\<And>\<tau>. \<tau> \<Turnstile> (\<delta> S and \<upsilon> x) \<Longrightarrow> - OclForall (S->including\<^sub>B\<^sub>a\<^sub>g(x)) P \<tau> = (P x and OclForall S P) \<tau>" - proof - fix \<tau> - assume 0 : "\<tau> \<Turnstile> (\<delta> S and \<upsilon> x)" - let ?S = "\<lambda>ocl. P x \<tau> \<noteq> ocl \<tau> \<and> (\<forall>x\<in>\<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil>. P (\<lambda>_. x) \<tau> \<noteq> ocl \<tau>)" - let ?S' = "\<lambda>ocl. \<forall>x\<in>\<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S->including\<^sub>B\<^sub>a\<^sub>g(x) \<tau>)\<rceil>\<rceil>. P (\<lambda>_. x) \<tau> \<noteq> ocl \<tau>" - let ?assms_1 = "?S' null" - let ?assms_2 = "?S' invalid" - let ?assms_3 = "?S' false" - have 4 : "?assms_3 \<Longrightarrow> ?S false" - apply(subst forall_including_invert[of "\<lambda> x \<tau>. P x \<tau> \<noteq> false \<tau>",symmetric]) - by(simp_all add: cp_OclNot_eq 0) - have 5 : "?assms_2 \<Longrightarrow> ?S invalid" - apply(subst forall_including_invert[of "\<lambda> x \<tau>. P x \<tau> \<noteq> invalid \<tau>",symmetric]) - by(simp_all add: cp_OclNot_eq 0) - have 6 : "?assms_1 \<Longrightarrow> ?S null" - apply(subst forall_including_invert[of "\<lambda> x \<tau>. P x \<tau> \<noteq> null \<tau>",symmetric]) - by(simp_all add: cp_OclNot_eq 0) - have 7 : "(\<delta> S) \<tau> = true \<tau>" - by(insert 0, simp add: foundation10', simp add: OclValid_def) - show "?thesis \<tau>" - apply(subst OclForall_def) - apply(simp add: cp_OclAnd[THEN sym] OclValid_def contradict_Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e) - apply(intro conjI impI,fold OclValid_def) - apply(simp_all add: exists_including_invert[where f = "\<lambda> x \<tau>. P x \<tau> = null \<tau>", OF cp_eq]) - apply(simp_all add: exists_including_invert[where f = "\<lambda> x \<tau>. P x \<tau> = invalid \<tau>", OF cp_eq]) - apply(simp_all add: exists_including_invert[where f = "\<lambda> x \<tau>. P x \<tau> = false \<tau>", OF cp_eq]) - proof - - assume 1 : "P x \<tau> = null \<tau> \<or> (\<exists>x\<in>\<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil>. P (\<lambda>_. x) \<tau> = null \<tau>)" - and 2 : ?assms_2 - and 3 : ?assms_3 - show "null \<tau> = (P x and OclForall S P) \<tau>" - proof - - note 4 = 4[OF 3] - note 5 = 5[OF 2] - have 6 : "P x \<tau> = null \<tau> \<or> P x \<tau> = true \<tau>" - by(metis 4 5 bool_split_0) - show ?thesis - apply(insert 6, elim disjE) - apply(subst cp_OclAnd) - apply(simp add: OclForall_def 7 4[THEN conjunct2] 5[THEN conjunct2]) - apply(simp_all add:cp_OclAnd[symmetric]) - apply(subst cp_OclAnd, simp_all add:cp_OclAnd[symmetric] OclForall_def) - apply(simp add:4[THEN conjunct2] 5[THEN conjunct2] 0[simplified OclValid_def] 7) - apply(insert 1, elim disjE, auto) - done - qed - next - assume 1 : ?assms_1 - and 2 : "P x \<tau> = invalid \<tau> \<or> (\<exists>x\<in>\<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil>. P (\<lambda>_. x) \<tau> = invalid \<tau>)" - and 3 : ?assms_3 - show "invalid \<tau> = (P x and OclForall S P) \<tau>" - proof - - note 4 = 4[OF 3] - note 6 = 6[OF 1] - have 5 : "P x \<tau> = invalid \<tau> \<or> P x \<tau> = true \<tau>" - by(metis 4 6 bool_split_0) - show ?thesis - apply(insert 5, elim disjE) - apply(subst cp_OclAnd) - apply(simp add: OclForall_def 4[THEN conjunct2] 6[THEN conjunct2] 7) - apply(simp_all add:cp_OclAnd[symmetric]) - apply(subst cp_OclAnd, simp_all add:cp_OclAnd[symmetric] OclForall_def) - apply(insert 2, elim disjE, simp add: invalid_def true_def bot_option_def) - apply(simp add: 0[simplified OclValid_def] 4[THEN conjunct2] 6[THEN conjunct2] 7) - by(auto) - qed - next - assume 1 : ?assms_1 - and 2 : ?assms_2 - and 3 : ?assms_3 - show "true \<tau> = (P x and OclForall S P) \<tau>" - proof - - note 4 = 4[OF 3] - note 5 = 5[OF 2] - note 6 = 6[OF 1] - have 8 : "P x \<tau> = true \<tau>" - by(metis 4 5 6 bool_split_0) - show ?thesis - apply(subst cp_OclAnd, simp add: 8 cp_OclAnd[symmetric]) - by(simp add: OclForall_def 4 5 6 7) - qed - qed ( simp add: 0 - | rule C1, simp+ - | rule C2, simp add: 0 )+ - qed - - have B : "\<And>\<tau>. \<not> (\<tau> \<Turnstile> (\<delta> S and \<upsilon> x)) \<Longrightarrow> - OclForall (S->including\<^sub>B\<^sub>a\<^sub>g(x)) P \<tau> = invalid \<tau>" - apply(rule foundation22[THEN iffD1]) - apply(simp only: foundation10' de_Morgan_conj foundation18'', elim disjE) - apply(simp add: defined_split, elim disjE) - apply(erule StrongEq_L_subst2_rev, simp+)+ - done - - show ?thesis - apply(rule ext, rename_tac \<tau>) - apply(simp add: OclIf_def) - apply(simp add: cp_defined[of "\<delta> S and \<upsilon> x"] cp_defined[THEN sym]) - apply(intro conjI impI) - by(auto intro!: A B simp: OclValid_def) -qed - - - - -subsubsection{* Execution Rules on Exists *} - -lemma OclExists_mtSet_exec[simp,code_unfold] : -"((Set{})->exists\<^sub>B\<^sub>a\<^sub>g(z | P(z))) = false" -by(simp add: OclExists_def) - -lemma OclExists_including_exec[simp,code_unfold] : - assumes cp: "cp P" - shows "((S->including\<^sub>B\<^sub>a\<^sub>g(x))->exists\<^sub>B\<^sub>a\<^sub>g(z | P(z))) = (if \<delta> S and \<upsilon> x - then P x or (S->exists\<^sub>B\<^sub>a\<^sub>g(z | P(z))) - else invalid - endif)" - by(simp add: OclExists_def OclOr_def cp OclNot_inject) - - -subsubsection{* Execution Rules on Iterate *} - -lemma OclIterate_empty[simp,code_unfold]: "((Set{})->iterate\<^sub>B\<^sub>a\<^sub>g(a; x = A | P a x)) = A" -proof - - have C : "\<And> \<tau>. (\<delta> (\<lambda>\<tau>. Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e \<lfloor>\<lfloor>{}\<rfloor>\<rfloor>)) \<tau> = true \<tau>" - by (metis (no_types) defined_def mtSet_def mtSet_defined null_fun_def) - show ?thesis - apply(simp add: OclIterate_def mtSet_def Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inverse valid_def C) - apply(rule ext, rename_tac \<tau>) - apply(case_tac "A \<tau> = \<bottom> \<tau>", simp_all, simp add:true_def false_def bot_fun_def) - apply(simp add: Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inverse) - done -qed - -text{* In particular, this does hold for A = null. *} - -lemma OclIterate_including: -assumes S_finite: "\<tau> \<Turnstile> \<delta>(S->size\<^sub>B\<^sub>a\<^sub>g())" -and F_valid_arg: "(\<upsilon> A) \<tau> = (\<upsilon> (F a A)) \<tau>" -and F_commute: "comp_fun_commute F" -and F_cp: "\<And> x y \<tau>. F x y \<tau> = F (\<lambda> _. x \<tau>) y \<tau>" -shows "((S->including\<^sub>B\<^sub>a\<^sub>g(a))->iterate\<^sub>B\<^sub>a\<^sub>g(a; x = A | F a x)) \<tau> = - ((S->excluding\<^sub>B\<^sub>a\<^sub>g(a))->iterate\<^sub>B\<^sub>a\<^sub>g(a; x = F a A | F a x)) \<tau>" -proof - - have insert_in_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e : "\<And>\<tau>. (\<tau> \<Turnstile>(\<delta> S)) \<Longrightarrow> (\<tau> \<Turnstile>(\<upsilon> a)) \<Longrightarrow> - \<lfloor>\<lfloor>insert (a \<tau>) \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil>\<rfloor>\<rfloor> \<in> {X. X = bot \<or> X = null \<or> (\<forall>x\<in>\<lceil>\<lceil>X\<rceil>\<rceil>. x \<noteq> bot)}" - by(frule Set_inv_lemma, simp add: foundation18 invalid_def) - - have insert_defined : "\<And>\<tau>. (\<tau> \<Turnstile>(\<delta> S)) \<Longrightarrow> (\<tau> \<Turnstile>(\<upsilon> a)) \<Longrightarrow> - (\<delta> (\<lambda>_. Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e \<lfloor>\<lfloor>insert (a \<tau>) \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil>\<rfloor>\<rfloor>)) \<tau> = true \<tau>" - apply(subst defined_def) - apply(simp add: bot_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def bot_fun_def null_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def null_fun_def) - by(subst Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inject, - rule insert_in_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e, simp_all add: null_option_def bot_option_def)+ - - have remove_finite : "finite \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil> \<Longrightarrow> - finite ((\<lambda>a \<tau>. a) ` (\<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil> - {a \<tau>}))" - by(simp) - - have remove_in_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e : "\<And>\<tau>. (\<tau> \<Turnstile>(\<delta> S)) \<Longrightarrow> (\<tau> \<Turnstile>(\<upsilon> a)) \<Longrightarrow> - \<lfloor>\<lfloor>\<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil> - {a \<tau>}\<rfloor>\<rfloor> \<in> {X. X = bot \<or> X = null \<or> (\<forall>x\<in>\<lceil>\<lceil>X\<rceil>\<rceil>. x \<noteq> bot)}" - by(frule Set_inv_lemma, simp add: foundation18 invalid_def) - - have remove_defined : "\<And>\<tau>. (\<tau> \<Turnstile>(\<delta> S)) \<Longrightarrow> (\<tau> \<Turnstile>(\<upsilon> a)) \<Longrightarrow> - (\<delta> (\<lambda>_. Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e \<lfloor>\<lfloor>\<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil> - {a \<tau>}\<rfloor>\<rfloor>)) \<tau> = true \<tau>" - apply(subst defined_def) - apply(simp add: bot_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def bot_fun_def null_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def null_fun_def) - by(subst Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inject, - rule remove_in_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e, simp_all add: null_option_def bot_option_def)+ - - have abs_rep: "\<And>x. \<lfloor>\<lfloor>x\<rfloor>\<rfloor> \<in> {X. X = bot \<or> X = null \<or> (\<forall>x\<in>\<lceil>\<lceil>X\<rceil>\<rceil>. x \<noteq> bot)} \<Longrightarrow> - \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e \<lfloor>\<lfloor>x\<rfloor>\<rfloor>)\<rceil>\<rceil> = x" - by(subst Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inverse, simp_all) - - have inject : "inj (\<lambda>a \<tau>. a)" - by(rule inj_fun, simp) - - show ?thesis - apply(subst (1 2) cp_OclIterate, subst OclIncluding_def, subst OclExcluding_def) - apply(case_tac "\<not> ((\<delta> S) \<tau> = true \<tau> \<and> (\<upsilon> a) \<tau> = true \<tau>)", simp add: invalid_def) - - apply(subgoal_tac "OclIterate (\<lambda>_. \<bottom>) A F \<tau> = OclIterate (\<lambda>_. \<bottom>) (F a A) F \<tau>", simp) - apply(rule conjI, blast+) - apply(simp add: OclIterate_def defined_def bot_option_def bot_fun_def false_def true_def) - - apply(simp add: OclIterate_def) - apply((subst abs_rep[OF insert_in_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e[simplified OclValid_def], of \<tau>], simp_all)+, - (subst abs_rep[OF remove_in_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e[simplified OclValid_def], of \<tau>], simp_all)+, - (subst insert_defined, simp_all add: OclValid_def)+, - (subst remove_defined, simp_all add: OclValid_def)+) - - apply(case_tac "\<not> ((\<upsilon> A) \<tau> = true \<tau>)", (simp add: F_valid_arg)+) - apply(rule impI, - subst Finite_Set.comp_fun_commute.fold_fun_left_comm[symmetric, OF F_commute], - rule remove_finite, simp) - - apply(subst image_set_diff[OF inject], simp) - apply(subgoal_tac "Finite_Set.fold F A (insert (\<lambda>\<tau>'. a \<tau>) ((\<lambda>a \<tau>. a) ` \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil>)) \<tau> = - F (\<lambda>\<tau>'. a \<tau>) (Finite_Set.fold F A ((\<lambda>a \<tau>. a) ` \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil> - {\<lambda>\<tau>'. a \<tau>})) \<tau>") - apply(subst F_cp, simp) - - by(subst Finite_Set.comp_fun_commute.fold_insert_remove[OF F_commute], simp+) -qed - -subsubsection{* Execution Rules on Select *} - -lemma OclSelect_mtSet_exec[simp,code_unfold]: "OclSelect mtSet P = mtSet" - apply(rule ext, rename_tac \<tau>) - apply(simp add: OclSelect_def mtSet_def defined_def false_def true_def - bot_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def bot_fun_def null_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def null_fun_def) -by(( subst (1 2 3 4 5) Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inverse - | subst Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inject), (simp add: null_option_def bot_option_def)+)+ - -definition "OclSelect_body :: _ \<Rightarrow> _ \<Rightarrow> _ \<Rightarrow> ('\<AA>, 'a option option) Set - \<equiv> (\<lambda>P x acc. if P x \<doteq> false then acc else acc->including\<^sub>B\<^sub>a\<^sub>g(x) endif)" - -theorem OclSelect_including_exec[simp,code_unfold]: - assumes P_cp : "cp P" - shows "OclSelect (X->including\<^sub>B\<^sub>a\<^sub>g(y)) P = OclSelect_body P y (OclSelect (X->excluding\<^sub>B\<^sub>a\<^sub>g(y)) P)" - (is "_ = ?select") -proof - - have P_cp: "\<And>x \<tau>. P x \<tau> = P (\<lambda>_. x \<tau>) \<tau>" by(insert P_cp, auto simp: cp_def) - - have ex_including : "\<And>f X y \<tau>. \<tau> \<Turnstile> \<delta> X \<Longrightarrow> \<tau> \<Turnstile> \<upsilon> y \<Longrightarrow> - (\<exists>x\<in>\<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (X->including\<^sub>B\<^sub>a\<^sub>g(y) \<tau>)\<rceil>\<rceil>. f (P (\<lambda>_. x)) \<tau>) = - (f (P (\<lambda>_. y \<tau>)) \<tau> \<or> (\<exists>x\<in>(Rep_Bag_base X \<tau>). f (P (\<lambda>_. x)) \<tau>))" - apply(simp add: OclIncluding_def OclValid_def) - apply(subst Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inverse, simp, (rule disjI2)+) - by (metis (hide_lams, no_types) OclValid_def Set_inv_lemma foundation18',simp) - - have al_including : "\<And>f X y \<tau>. \<tau> \<Turnstile> \<delta> X \<Longrightarrow> \<tau> \<Turnstile> \<upsilon> y \<Longrightarrow> - (\<forall>x\<in>\<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (X->including\<^sub>B\<^sub>a\<^sub>g(y) \<tau>)\<rceil>\<rceil>. f (P (\<lambda>_. x)) \<tau>) = - (f (P (\<lambda>_. y \<tau>)) \<tau> \<and> (\<forall>x\<in>(Rep_Bag_base X \<tau>). f (P (\<lambda>_. x)) \<tau>))" - apply(simp add: OclIncluding_def OclValid_def) - apply(subst Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inverse, simp, (rule disjI2)+) - by (metis (hide_lams, no_types) OclValid_def Set_inv_lemma foundation18', simp) - - have ex_excluding1 : "\<And>f X y \<tau>. \<tau> \<Turnstile> \<delta> X \<Longrightarrow> \<tau> \<Turnstile> \<upsilon> y \<Longrightarrow> \<not> (f (P (\<lambda>_. y \<tau>)) \<tau>) \<Longrightarrow> - (\<exists>x\<in>(Rep_Bag_base X \<tau>). f (P (\<lambda>_. x)) \<tau>) = - (\<exists>x\<in>\<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (X->excluding\<^sub>B\<^sub>a\<^sub>g(y) \<tau>)\<rceil>\<rceil>. f (P (\<lambda>_. x)) \<tau>)" - apply(simp add: OclExcluding_def OclValid_def) - apply(subst Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inverse, simp, (rule disjI2)+) - by (metis (no_types) Diff_iff OclValid_def Set_inv_lemma) auto - - have al_excluding1 : "\<And>f X y \<tau>. \<tau> \<Turnstile> \<delta> X \<Longrightarrow> \<tau> \<Turnstile> \<upsilon> y \<Longrightarrow> f (P (\<lambda>_. y \<tau>)) \<tau> \<Longrightarrow> - (\<forall>x\<in>(Rep_Bag_base X \<tau>). f (P (\<lambda>_. x)) \<tau>) = - (\<forall>x\<in>\<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (X->excluding\<^sub>B\<^sub>a\<^sub>g(y) \<tau>)\<rceil>\<rceil>. f (P (\<lambda>_. x)) \<tau>)" - apply(simp add: OclExcluding_def OclValid_def) - apply(subst Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inverse, simp, (rule disjI2)+) - by (metis (no_types) Diff_iff OclValid_def Set_inv_lemma) auto - - have in_including : "\<And>f X y \<tau>. \<tau> \<Turnstile> \<delta> X \<Longrightarrow> \<tau> \<Turnstile> \<upsilon> y \<Longrightarrow> - {x \<in> \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (X->including\<^sub>B\<^sub>a\<^sub>g(y) \<tau>)\<rceil>\<rceil>. f (P (\<lambda>_. x) \<tau>)} = - (let s = {x \<in> (Rep_Bag_base X \<tau>). f (P (\<lambda>_. x) \<tau>)} in - if f (P (\<lambda>_. y \<tau>) \<tau>) then insert (y \<tau>) s else s)" - apply(simp add: OclIncluding_def OclValid_def) - apply(subst Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inverse, simp, (rule disjI2)+) - apply (metis (hide_lams, no_types) OclValid_def Set_inv_lemma foundation18') - by(simp add: Let_def, auto) - - let ?OclSet = "\<lambda>S. \<lfloor>\<lfloor>S\<rfloor>\<rfloor> \<in> {X. X = \<bottom> \<or> X = null \<or> (\<forall>x\<in>\<lceil>\<lceil>X\<rceil>\<rceil>. x \<noteq> \<bottom>)}" - - have diff_in_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e : "\<And>\<tau>. (\<delta> X) \<tau> = true \<tau> \<Longrightarrow> ?OclSet ((Rep_Bag_base X \<tau>) - {y \<tau>})" - apply(simp, (rule disjI2)+) - by (metis (mono_tags) Diff_iff OclValid_def Set_inv_lemma) - - have ins_in_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e : "\<And>\<tau>. (\<delta> X) \<tau> = true \<tau> \<Longrightarrow> (\<upsilon> y) \<tau> = true \<tau> \<Longrightarrow> - ?OclSet (insert (y \<tau>) {x \<in> (Rep_Bag_base X \<tau>). P (\<lambda>_. x) \<tau> \<noteq> false \<tau>})" - apply(simp, (rule disjI2)+) - by (metis (hide_lams, no_types) OclValid_def Set_inv_lemma foundation18') - - have ins_in_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e' : "\<And>\<tau>. (\<delta> X) \<tau> = true \<tau> \<Longrightarrow> (\<upsilon> y) \<tau> = true \<tau> \<Longrightarrow> - ?OclSet (insert (y \<tau>) {x \<in> (Rep_Bag_base X \<tau>). x \<noteq> y \<tau> \<and> P (\<lambda>_. x) \<tau> \<noteq> false \<tau>})" - apply(simp, (rule disjI2)+) - by (metis (hide_lams, no_types) OclValid_def Set_inv_lemma foundation18') - - have ins_in_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e'' : "\<And>\<tau>. (\<delta> X) \<tau> = true \<tau> \<Longrightarrow> - ?OclSet {x \<in> (Rep_Bag_base X \<tau>). P (\<lambda>_. x) \<tau> \<noteq> false \<tau>}" - apply(simp, (rule disjI2)+) - by (metis (hide_lams, no_types) OclValid_def Set_inv_lemma) - - have ins_in_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e''' : "\<And>\<tau>. (\<delta> X) \<tau> = true \<tau> \<Longrightarrow> - ?OclSet {x \<in> (Rep_Bag_base X \<tau>). x \<noteq> y \<tau> \<and> P (\<lambda>_. x) \<tau> \<noteq> false \<tau>}" - apply(simp, (rule disjI2)+) - by(metis (hide_lams, no_types) OclValid_def Set_inv_lemma) - - have if_same : "\<And>a b c d \<tau>. \<tau> \<Turnstile> \<delta> a \<Longrightarrow> b \<tau> = d \<tau> \<Longrightarrow> c \<tau> = d \<tau> \<Longrightarrow> - (if a then b else c endif) \<tau> = d \<tau>" - by(simp add: OclIf_def OclValid_def) - - have invert_including : "\<And>P y \<tau>. P \<tau> = \<bottom> \<Longrightarrow> P->including\<^sub>B\<^sub>a\<^sub>g(y) \<tau> = \<bottom>" - by (metis (hide_lams, no_types) foundation16[THEN iffD1] - foundation18' OclIncluding_valid_args_valid) - - have exclude_defined : "\<And>\<tau>. \<tau> \<Turnstile> \<delta> X \<Longrightarrow> - (\<delta>(\<lambda>_. Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e \<lfloor>\<lfloor>{x\<in>(Rep_Bag_base X \<tau>). x \<noteq> y \<tau> \<and> P (\<lambda>_. x) \<tau>\<noteq>false \<tau>}\<rfloor>\<rfloor>)) \<tau> = true \<tau>" - apply(subst defined_def, - simp add: false_def true_def bot_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def bot_fun_def null_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def null_fun_def) - by(subst Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inject[OF ins_in_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e'''[simplified false_def]], - (simp add: OclValid_def bot_option_def null_option_def)+)+ - - have if_eq : "\<And>x A B \<tau>. \<tau> \<Turnstile> \<upsilon> x \<Longrightarrow> \<tau> \<Turnstile> ((if x \<doteq> false then A else B endif) \<triangleq> - (if x \<triangleq> false then A else B endif))" - apply(simp add: StrictRefEq\<^sub>B\<^sub>o\<^sub>o\<^sub>l\<^sub>e\<^sub>a\<^sub>n OclValid_def) - apply(subst (2) StrongEq_def) - by(subst cp_OclIf, simp add: cp_OclIf[symmetric] true_def) - - have OclSelect_body_bot: "\<And>\<tau>. \<tau> \<Turnstile> \<delta> X \<Longrightarrow> \<tau> \<Turnstile> \<upsilon> y \<Longrightarrow> P y \<tau> \<noteq> \<bottom> \<Longrightarrow> - (\<exists>x\<in>(Rep_Bag_base X \<tau>). P (\<lambda>_. x) \<tau> = \<bottom>) \<Longrightarrow> \<bottom> = ?select \<tau>" - apply(drule ex_excluding1[where X2 = X and y2 = y and f2 = "\<lambda>x \<tau>. x \<tau> = \<bottom>"], - (simp add: P_cp[symmetric])+) - apply(subgoal_tac "\<tau> \<Turnstile> (\<bottom> \<triangleq> ?select)", simp add: OclValid_def StrongEq_def true_def bot_fun_def) - apply(simp add: OclSelect_body_def) - apply(subst StrongEq_L_subst3[OF _ if_eq], simp, metis foundation18') - apply(simp add: OclValid_def, subst StrongEq_def, subst true_def, simp) - apply(subgoal_tac "\<exists>x\<in>\<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (X->excluding\<^sub>B\<^sub>a\<^sub>g(y) \<tau>)\<rceil>\<rceil>. P (\<lambda>_. x) \<tau> = \<bottom> \<tau>") - prefer 2 apply (metis bot_fun_def ) - apply(subst if_same[where d5 = "\<bottom>"]) - apply (metis defined7 transform1) - apply(simp add: OclSelect_def bot_option_def bot_fun_def invalid_def) - apply(subst invert_including) - by(simp add: OclSelect_def bot_option_def bot_fun_def invalid_def)+ - - - have d_and_v_inject : "\<And>\<tau> X y. (\<delta> X and \<upsilon> y) \<tau> \<noteq> true \<tau> \<Longrightarrow> (\<delta> X and \<upsilon> y) \<tau> = false \<tau>" - apply(fold OclValid_def, subst foundation22[symmetric]) - apply(auto simp:foundation10' defined_split) - apply(erule StrongEq_L_subst2_rev,simp,simp) - apply(erule StrongEq_L_subst2_rev,simp,simp) - by(erule foundation7'[THEN iffD2, THEN foundation15[THEN iffD2, - THEN StrongEq_L_subst2_rev]],simp,simp) - - - - - have OclSelect_body_bot': "\<And>\<tau>. (\<delta> X and \<upsilon> y) \<tau> \<noteq> true \<tau> \<Longrightarrow> \<bottom> = ?select \<tau>" - apply(drule d_and_v_inject) - apply(simp add: OclSelect_def OclSelect_body_def) - apply(subst cp_OclIf, subst OclIncluding.cp0, simp add: false_def true_def) - apply(subst cp_OclIf[symmetric], subst OclIncluding.cp0[symmetric]) - by (metis (lifting, no_types) OclIf_def foundation18 foundation18' invert_including) - - have conj_split2 : "\<And>a b c \<tau>. ((a \<triangleq> false) \<tau> = false \<tau> \<longrightarrow> b) \<and> ((a \<triangleq> false) \<tau> = true \<tau> \<longrightarrow> c) \<Longrightarrow> - (a \<tau> \<noteq> false \<tau> \<longrightarrow> b) \<and> (a \<tau> = false \<tau> \<longrightarrow> c)" - by (metis OclValid_def defined7 foundation14 foundation22 foundation9) - - have defined_inject_true : "\<And>\<tau> P. (\<delta> P) \<tau> \<noteq> true \<tau> \<Longrightarrow> (\<delta> P) \<tau> = false \<tau>" - apply(simp add: defined_def true_def false_def bot_fun_def bot_option_def - null_fun_def null_option_def) - by (case_tac " P \<tau> = \<bottom> \<or> P \<tau> = null", simp_all add: true_def) - - have cp_OclSelect_body : "\<And>\<tau>. ?select \<tau> = OclSelect_body P y (\<lambda>_.(OclSelect (X->excluding\<^sub>B\<^sub>a\<^sub>g(y))P)\<tau>)\<tau>" - apply(simp add: OclSelect_body_def) - by(subst (1 2) cp_OclIf, subst (1 2) OclIncluding.cp0, blast) - - have OclSelect_body_strict1 : "OclSelect_body P y invalid = invalid" - by(rule ext, simp add: OclSelect_body_def OclIf_def) - - have bool_invalid: "\<And>(x::('\<AA>)Boolean) y \<tau>. \<not> (\<tau> \<Turnstile> \<upsilon> x) \<Longrightarrow> \<tau> \<Turnstile> ((x \<doteq> y) \<triangleq> invalid)" - by(simp add: StrictRefEq\<^sub>B\<^sub>o\<^sub>o\<^sub>l\<^sub>e\<^sub>a\<^sub>n OclValid_def StrongEq_def true_def) - - have conj_comm : "\<And>p q r. (p \<and> q \<and> r) = ((p \<and> q) \<and> r)" by blast - - have inv_bot : "\<And>\<tau>. invalid \<tau> = \<bottom> \<tau>" by (metis bot_fun_def invalid_def) - have inv_bot' : "\<And>\<tau>. invalid \<tau> = \<bottom>" by (simp add: invalid_def) - - show ?thesis - apply(rule ext, rename_tac \<tau>) - apply(subst OclSelect_def) - apply(case_tac "(\<delta> (X->including\<^sub>B\<^sub>a\<^sub>g(y))) \<tau> = true \<tau>", simp) - apply(( subst ex_including | subst in_including), - metis OclValid_def foundation5, - metis OclValid_def foundation5)+ - apply(simp add: Let_def inv_bot) - apply(subst (2 4 7 9) bot_fun_def) - - apply(subst (4) false_def, subst (4) bot_fun_def, simp add: bot_option_def P_cp[symmetric]) - (* *) - apply(case_tac "\<not> (\<tau> \<Turnstile> (\<upsilon> P y))") - apply(subgoal_tac "P y \<tau> \<noteq> false \<tau>") - prefer 2 - apply (metis (hide_lams, no_types) foundation1 foundation18' valid4) - apply(simp) - (* *) - apply(subst conj_comm, rule conjI) - apply(drule_tac y11 = false in bool_invalid) - apply(simp only: OclSelect_body_def, - metis OclIf_def OclValid_def defined_def foundation2 foundation22 - bot_fun_def invalid_def) - (* *) - apply(drule foundation5[simplified OclValid_def], - subst al_including[simplified OclValid_def], - simp, - simp) - apply(simp add: P_cp[symmetric]) - apply (metis bot_fun_def foundation18') - - apply(simp add: foundation18' bot_fun_def OclSelect_body_bot OclSelect_body_bot') - (* *) - apply(subst (1 2) al_including, metis OclValid_def foundation5, metis OclValid_def foundation5) - apply(simp add: P_cp[symmetric], subst (4) false_def, subst (4) bot_option_def, simp) - - apply(simp add: OclSelect_def[simplified inv_bot'] OclSelect_body_def StrictRefEq\<^sub>B\<^sub>o\<^sub>o\<^sub>l\<^sub>e\<^sub>a\<^sub>n) - apply(subst (1 2 3 4) cp_OclIf, - subst (1 2 3 4) foundation18'[THEN iffD2, simplified OclValid_def], - simp, - simp only: cp_OclIf[symmetric] refl if_True) - apply(subst (1 2) OclIncluding.cp0, rule conj_split2, simp add: cp_OclIf[symmetric]) - apply(subst (1 2 3 4 5 6 7 8) cp_OclIf[symmetric], simp) - apply(( subst ex_excluding1[symmetric] - | subst al_excluding1[symmetric] ), - metis OclValid_def foundation5, - metis OclValid_def foundation5, - simp add: P_cp[symmetric] bot_fun_def)+ - apply(simp add: bot_fun_def) - apply(subst (1 2) invert_including, simp+) - (* *) - apply(rule conjI, blast) - apply(intro impI conjI) - apply(subst OclExcluding_def) - apply(drule foundation5[simplified OclValid_def], simp) - apply(subst Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inverse[OF diff_in_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e], fast) - apply(simp add: OclIncluding_def cp_valid[symmetric]) - apply((erule conjE)+, frule exclude_defined[simplified OclValid_def], simp) - apply(subst Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inverse[OF ins_in_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e'''], simp+) - apply(subst Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inject[OF ins_in_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e ins_in_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e'], fast+) - (* *) - apply(simp add: OclExcluding_def) - apply(simp add: foundation10[simplified OclValid_def]) - apply(subst Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inverse[OF diff_in_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e], simp+) - apply(subst Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inject[OF ins_in_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e'' ins_in_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e'''], simp+) - apply(subgoal_tac "P (\<lambda>_. y \<tau>) \<tau> = false \<tau>") - prefer 2 - apply(subst P_cp[symmetric], metis OclValid_def foundation22) - apply(rule equalityI) - apply(rule subsetI, simp, metis) - apply(rule subsetI, simp) - (* *) - apply(drule defined_inject_true) - apply(subgoal_tac "\<not> (\<tau> \<Turnstile> \<delta> X) \<or> \<not> (\<tau> \<Turnstile> \<upsilon> y)") - prefer 2 - apply (metis OclIncluding.def_homo OclIncluding_valid_args_valid OclIncluding_valid_args_valid'' OclValid_def foundation18 valid1) - apply(subst cp_OclSelect_body, subst cp_OclSelect, subst OclExcluding_def) - apply(simp add: OclValid_def false_def true_def, rule conjI, blast) - apply(simp add: OclSelect_invalid[simplified invalid_def] - OclSelect_body_strict1[simplified invalid_def] - inv_bot') - done -qed - -subsubsection{* Execution Rules on Reject *} - -lemma OclReject_mtSet_exec[simp,code_unfold]: "OclReject mtSet P = mtSet" -by(simp add: OclReject_def) - -lemma OclReject_including_exec[simp,code_unfold]: - assumes P_cp : "cp P" - shows "OclReject (X->including\<^sub>B\<^sub>a\<^sub>g(y)) P = OclSelect_body (not o P) y (OclReject (X->excluding\<^sub>B\<^sub>a\<^sub>g(y)) P)" - apply(simp add: OclReject_def comp_def, rule OclSelect_including_exec) -by (metis assms cp_intro'(5)) - -subsubsection{* Execution Rules Combining Previous Operators *} - -text{* OclIncluding *} - -(* logical level : *) -lemma OclIncluding_idem0 : - assumes "\<tau> \<Turnstile> \<delta> S" - and "\<tau> \<Turnstile> \<upsilon> i" - shows "\<tau> \<Turnstile> (S->including\<^sub>B\<^sub>a\<^sub>g(i)->including\<^sub>B\<^sub>a\<^sub>g(i) \<triangleq> (S->including\<^sub>B\<^sub>a\<^sub>g(i)))" -by(simp add: OclIncluding_includes OclIncludes_charn1 assms) - -(* Pure algebraic level *) -theorem OclIncluding_idem[simp,code_unfold]: "((S :: ('\<AA>,'a::null)Set)->including\<^sub>B\<^sub>a\<^sub>g(i)->including\<^sub>B\<^sub>a\<^sub>g(i) = (S->including\<^sub>B\<^sub>a\<^sub>g(i)))" -proof - - have A: "\<And> \<tau>. \<tau> \<Turnstile> (i \<triangleq> invalid) \<Longrightarrow> (S->including\<^sub>B\<^sub>a\<^sub>g(i)->including\<^sub>B\<^sub>a\<^sub>g(i)) \<tau> = invalid \<tau>" - apply(rule foundation22[THEN iffD1]) - by(erule StrongEq_L_subst2_rev, simp,simp) - have A':"\<And> \<tau>. \<tau> \<Turnstile> (i \<triangleq> invalid) \<Longrightarrow> (S->including\<^sub>B\<^sub>a\<^sub>g(i)) \<tau> = invalid \<tau>" - apply(rule foundation22[THEN iffD1]) - by(erule StrongEq_L_subst2_rev, simp,simp) - have C: "\<And> \<tau>. \<tau> \<Turnstile> (S \<triangleq> invalid) \<Longrightarrow> (S->including\<^sub>B\<^sub>a\<^sub>g(i)->including\<^sub>B\<^sub>a\<^sub>g(i)) \<tau> = invalid \<tau>" - apply(rule foundation22[THEN iffD1]) - by(erule StrongEq_L_subst2_rev, simp,simp) - have C': "\<And> \<tau>. \<tau> \<Turnstile> (S \<triangleq> invalid) \<Longrightarrow> (S->including\<^sub>B\<^sub>a\<^sub>g(i)) \<tau> = invalid \<tau>" - apply(rule foundation22[THEN iffD1]) - by(erule StrongEq_L_subst2_rev, simp,simp) - have D: "\<And> \<tau>. \<tau> \<Turnstile> (S \<triangleq> null) \<Longrightarrow> (S->including\<^sub>B\<^sub>a\<^sub>g(i)->including\<^sub>B\<^sub>a\<^sub>g(i)) \<tau> = invalid \<tau>" - apply(rule foundation22[THEN iffD1]) - by(erule StrongEq_L_subst2_rev, simp,simp) - have D': "\<And> \<tau>. \<tau> \<Turnstile> (S \<triangleq> null) \<Longrightarrow> (S->including\<^sub>B\<^sub>a\<^sub>g(i)) \<tau> = invalid \<tau>" - apply(rule foundation22[THEN iffD1]) - by(erule StrongEq_L_subst2_rev, simp,simp) - show ?thesis - apply(rule ext, rename_tac \<tau>) - apply(case_tac "\<tau> \<Turnstile> (\<upsilon> i)") - apply(case_tac "\<tau> \<Turnstile> (\<delta> S)") - apply(simp only: OclIncluding_idem0[THEN foundation22[THEN iffD1]]) - apply(simp add: foundation16', elim disjE) - apply(simp add: C[OF foundation22[THEN iffD2]] C'[OF foundation22[THEN iffD2]]) - apply(simp add: D[OF foundation22[THEN iffD2]] D'[OF foundation22[THEN iffD2]]) - apply(simp add:foundation18 A[OF foundation22[THEN iffD2]] A'[OF foundation22[THEN iffD2]]) - done -qed - -text{* OclExcluding *} - -(* logical level : *) -lemma OclExcluding_idem0 : - assumes "\<tau> \<Turnstile> \<delta> S" - and "\<tau> \<Turnstile> \<upsilon> i" - shows "\<tau> \<Turnstile> (S->excluding\<^sub>B\<^sub>a\<^sub>g(i)->excluding\<^sub>B\<^sub>a\<^sub>g(i) \<triangleq> (S->excluding\<^sub>B\<^sub>a\<^sub>g(i)))" -by(simp add: OclExcluding_excludes OclExcludes_charn1 assms) - -(* Pure algebraic level *) -theorem OclExcluding_idem[simp,code_unfold]: "((S->excluding\<^sub>B\<^sub>a\<^sub>g(i))->excluding\<^sub>B\<^sub>a\<^sub>g(i)) = (S->excluding\<^sub>B\<^sub>a\<^sub>g(i))" -proof - - have A: "\<And> \<tau>. \<tau> \<Turnstile> (i \<triangleq> invalid) \<Longrightarrow> (S->excluding\<^sub>B\<^sub>a\<^sub>g(i)->excluding\<^sub>B\<^sub>a\<^sub>g(i)) \<tau> = invalid \<tau>" - apply(rule foundation22[THEN iffD1]) - by(erule StrongEq_L_subst2_rev, simp,simp) - have A':"\<And> \<tau>. \<tau> \<Turnstile> (i \<triangleq> invalid) \<Longrightarrow> (S->excluding\<^sub>B\<^sub>a\<^sub>g(i)) \<tau> = invalid \<tau>" - apply(rule foundation22[THEN iffD1]) - by(erule StrongEq_L_subst2_rev, simp,simp) - have C: "\<And> \<tau>. \<tau> \<Turnstile> (S \<triangleq> invalid) \<Longrightarrow> (S->excluding\<^sub>B\<^sub>a\<^sub>g(i)->excluding\<^sub>B\<^sub>a\<^sub>g(i)) \<tau> = invalid \<tau>" - apply(rule foundation22[THEN iffD1]) - by(erule StrongEq_L_subst2_rev, simp,simp) - have C': "\<And> \<tau>. \<tau> \<Turnstile> (S \<triangleq> invalid) \<Longrightarrow> (S->excluding\<^sub>B\<^sub>a\<^sub>g(i)) \<tau> = invalid \<tau>" - apply(rule foundation22[THEN iffD1]) - by(erule StrongEq_L_subst2_rev, simp,simp) - have D: "\<And> \<tau>. \<tau> \<Turnstile> (S \<triangleq> null) \<Longrightarrow> (S->excluding\<^sub>B\<^sub>a\<^sub>g(i)->excluding\<^sub>B\<^sub>a\<^sub>g(i)) \<tau> = invalid \<tau>" - apply(rule foundation22[THEN iffD1]) - by(erule StrongEq_L_subst2_rev, simp,simp) - have D': "\<And> \<tau>. \<tau> \<Turnstile> (S \<triangleq> null) \<Longrightarrow> (S->excluding\<^sub>B\<^sub>a\<^sub>g(i)) \<tau> = invalid \<tau>" - apply(rule foundation22[THEN iffD1]) - by(erule StrongEq_L_subst2_rev, simp,simp) - show ?thesis - apply(rule ext, rename_tac \<tau>) - apply(case_tac "\<tau> \<Turnstile> (\<upsilon> i)") - apply(case_tac "\<tau> \<Turnstile> (\<delta> S)") - apply(simp only: OclExcluding_idem0[THEN foundation22[THEN iffD1]]) - apply(simp add: foundation16', elim disjE) - apply(simp add: C[OF foundation22[THEN iffD2]] C'[OF foundation22[THEN iffD2]]) - apply(simp add: D[OF foundation22[THEN iffD2]] D'[OF foundation22[THEN iffD2]]) - apply(simp add:foundation18 A[OF foundation22[THEN iffD2]] A'[OF foundation22[THEN iffD2]]) - done -qed - -text{* OclIncludes *} - - -lemma OclIncludes_any[simp,code_unfold]: - "X->includes\<^sub>B\<^sub>a\<^sub>g(X->any\<^sub>B\<^sub>a\<^sub>g()) = (if \<delta> X then - if \<delta> (X->size\<^sub>B\<^sub>a\<^sub>g()) then not(X->isEmpty\<^sub>B\<^sub>a\<^sub>g()) - else X->includes\<^sub>B\<^sub>a\<^sub>g(null) endif - else invalid endif)" -proof - - have defined_inject_true : "\<And>\<tau> P. (\<delta> P) \<tau> \<noteq> true \<tau> \<Longrightarrow> (\<delta> P) \<tau> = false \<tau>" - apply(simp add: defined_def true_def false_def bot_fun_def bot_option_def - null_fun_def null_option_def) - by (case_tac " P \<tau> = \<bottom> \<or> P \<tau> = null", simp_all add: true_def) - - have valid_inject_true : "\<And>\<tau> P. (\<upsilon> P) \<tau> \<noteq> true \<tau> \<Longrightarrow> (\<upsilon> P) \<tau> = false \<tau>" - apply(simp add: valid_def true_def false_def bot_fun_def bot_option_def - null_fun_def null_option_def) - by (case_tac "P \<tau> = \<bottom>", simp_all add: true_def) - - - - have notempty': "\<And>\<tau> X. \<tau> \<Turnstile> \<delta> X \<Longrightarrow> finite (Rep_Bag_base X \<tau>) \<Longrightarrow> not (X->isEmpty\<^sub>B\<^sub>a\<^sub>g()) \<tau> \<noteq> true \<tau> \<Longrightarrow> - X \<tau> = Set{} \<tau>" - apply(case_tac "X \<tau>", rename_tac X', simp add: mtSet_def Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inject) - apply(erule disjE, metis (hide_lams, mono_tags) bot_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def bot_option_def foundation16) - apply(erule disjE, metis (hide_lams, no_types) bot_option_def - null_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def null_option_def foundation16[THEN iffD1]) - apply(case_tac X', simp, metis (hide_lams, no_types) bot_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def foundation16[THEN iffD1]) - apply(rename_tac X'', case_tac X'', simp) - apply (metis (hide_lams, no_types) foundation16[THEN iffD1] null_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def) - apply(simp add: OclIsEmpty_def OclSize_def) - apply(subst (asm) cp_OclNot, subst (asm) cp_OclOr, subst (asm) StrictRefEq\<^sub>I\<^sub>n\<^sub>t\<^sub>e\<^sub>g\<^sub>e\<^sub>r.cp0, - subst (asm) cp_OclAnd, subst (asm) cp_OclNot) - apply(simp only: OclValid_def foundation20[simplified OclValid_def] - cp_OclNot[symmetric] cp_OclAnd[symmetric] cp_OclOr[symmetric]) - apply(simp add: Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inverse split: if_split_asm) - by(simp add: true_def OclInt0_def OclNot_def StrictRefEq\<^sub>I\<^sub>n\<^sub>t\<^sub>e\<^sub>g\<^sub>e\<^sub>r StrongEq_def) - - have B: "\<And>X \<tau>. \<not> finite (Rep_Bag_base X \<tau>) \<Longrightarrow> (\<delta> (X->size\<^sub>B\<^sub>a\<^sub>g())) \<tau> = false \<tau>" - apply(subst cp_defined) - apply(simp add: OclSize_def) - by (metis bot_fun_def defined_def) - - show ?thesis - apply(rule ext, rename_tac \<tau>, simp only: OclIncludes_def OclANY_def) - apply(subst cp_OclIf, subst (2) cp_valid) - apply(case_tac "(\<delta> X) \<tau> = true \<tau>", - simp only: foundation20[simplified OclValid_def] cp_OclIf[symmetric], simp, - subst (1 2) cp_OclAnd, simp add: cp_OclAnd[symmetric]) - apply(case_tac "finite (Rep_Bag_base X \<tau>)") - apply(frule size_defined'[THEN iffD2, simplified OclValid_def], assumption) - apply(subst (1 2 3 4) cp_OclIf, simp) - apply(subst (1 2 3 4) cp_OclIf[symmetric], simp) - apply(case_tac "(X->notEmpty\<^sub>B\<^sub>a\<^sub>g()) \<tau> = true \<tau>", simp) - apply(frule OclNotEmpty_has_elt[simplified OclValid_def], simp) - apply(simp add: OclNotEmpty_def cp_OclIf[symmetric]) - apply(subgoal_tac "(SOME y. y \<in> (Rep_Bag_base X \<tau>)) \<in> (Rep_Bag_base X \<tau>)", simp add: true_def) - apply(metis OclValid_def Set_inv_lemma foundation18' null_option_def true_def) - apply(rule someI_ex, simp) - apply(simp add: OclNotEmpty_def cp_valid[symmetric]) - apply(subgoal_tac "\<not> (null \<tau> \<in> (Rep_Bag_base X \<tau>))", simp) - apply(subst OclIsEmpty_def, simp add: OclSize_def) - apply(subst cp_OclNot, subst cp_OclOr, subst StrictRefEq\<^sub>I\<^sub>n\<^sub>t\<^sub>e\<^sub>g\<^sub>e\<^sub>r.cp0, subst cp_OclAnd, - subst cp_OclNot, simp add: OclValid_def foundation20[simplified OclValid_def] - cp_OclNot[symmetric] cp_OclAnd[symmetric] cp_OclOr[symmetric]) - apply(frule notempty'[simplified OclValid_def], - (simp add: mtSet_def Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inverse OclInt0_def false_def)+) - apply(drule notempty'[simplified OclValid_def], simp, simp) - apply (metis (hide_lams, no_types) empty_iff mtSet_rep_set) - (* *) - apply(frule B) - apply(subst (1 2 3 4) cp_OclIf, simp) - apply(subst (1 2 3 4) cp_OclIf[symmetric], simp) - apply(case_tac "(X->notEmpty\<^sub>B\<^sub>a\<^sub>g()) \<tau> = true \<tau>", simp) - apply(frule OclNotEmpty_has_elt[simplified OclValid_def], simp) - apply(simp add: OclNotEmpty_def OclIsEmpty_def) - apply(subgoal_tac "X->size\<^sub>B\<^sub>a\<^sub>g() \<tau> = \<bottom>") - prefer 2 - apply (metis (hide_lams, no_types) OclSize_def) - apply(subst (asm) cp_OclNot, subst (asm) cp_OclOr, subst (asm) StrictRefEq\<^sub>I\<^sub>n\<^sub>t\<^sub>e\<^sub>g\<^sub>e\<^sub>r.cp0, - subst (asm) cp_OclAnd, subst (asm) cp_OclNot) - apply(simp add: OclValid_def foundation20[simplified OclValid_def] - cp_OclNot[symmetric] cp_OclAnd[symmetric] cp_OclOr[symmetric]) - apply(simp add: OclNot_def StrongEq_def StrictRefEq\<^sub>I\<^sub>n\<^sub>t\<^sub>e\<^sub>g\<^sub>e\<^sub>r valid_def false_def true_def - bot_option_def bot_fun_def invalid_def) - - apply (metis bot_fun_def null_fun_def null_is_valid valid_def) - by(drule defined_inject_true, - simp add: false_def true_def OclIf_false[simplified false_def] invalid_def) -qed - -text{* OclSize *} - -lemma [simp,code_unfold]: "\<delta> (Set{} ->size\<^sub>B\<^sub>a\<^sub>g()) = true" -by simp - - -lemma [simp,code_unfold]: "\<delta> ((X ->including\<^sub>B\<^sub>a\<^sub>g(x)) ->size\<^sub>B\<^sub>a\<^sub>g()) = (\<delta>(X->size\<^sub>B\<^sub>a\<^sub>g()) and \<upsilon>(x))" -proof - - have defined_inject_true : "\<And>\<tau> P. (\<delta> P) \<tau> \<noteq> true \<tau> \<Longrightarrow> (\<delta> P) \<tau> = false \<tau>" - apply(simp add: defined_def true_def false_def bot_fun_def bot_option_def - null_fun_def null_option_def) - by (case_tac " P \<tau> = \<bottom> \<or> P \<tau> = null", simp_all add: true_def) - - have valid_inject_true : "\<And>\<tau> P. (\<upsilon> P) \<tau> \<noteq> true \<tau> \<Longrightarrow> (\<upsilon> P) \<tau> = false \<tau>" - apply(simp add: valid_def true_def false_def bot_fun_def bot_option_def - null_fun_def null_option_def) - by (case_tac "P \<tau> = \<bottom>", simp_all add: true_def) - - have OclIncluding_finite_rep_set : "\<And>\<tau>. (\<delta> X and \<upsilon> x) \<tau> = true \<tau> \<Longrightarrow> - finite \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (X->including\<^sub>B\<^sub>a\<^sub>g(x) \<tau>)\<rceil>\<rceil> = finite (Rep_Bag_base X \<tau>)" - apply(rule OclIncluding_finite_rep_set) - by(metis OclValid_def foundation5)+ - - have card_including_exec : "\<And>\<tau>. (\<delta> (\<lambda>_. \<lfloor>\<lfloor>int (card \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (X->including\<^sub>B\<^sub>a\<^sub>g(x) \<tau>)\<rceil>\<rceil>)\<rfloor>\<rfloor>)) \<tau> = - (\<delta> (\<lambda>_. \<lfloor>\<lfloor>int (card (Rep_Bag_base X \<tau>))\<rfloor>\<rfloor>)) \<tau>" - by(simp add: defined_def bot_fun_def bot_option_def null_fun_def null_option_def) - - show ?thesis - apply(rule ext, rename_tac \<tau>) - apply(case_tac "(\<delta> (X->including\<^sub>B\<^sub>a\<^sub>g(x)->size\<^sub>B\<^sub>a\<^sub>g())) \<tau> = true \<tau>", simp del: OclSize_including_exec) - apply(subst cp_OclAnd, subst cp_defined, simp only: cp_defined[of "X->including\<^sub>B\<^sub>a\<^sub>g(x)->size\<^sub>B\<^sub>a\<^sub>g()"], - simp add: OclSize_def) - apply(case_tac "((\<delta> X and \<upsilon> x) \<tau> = true \<tau> \<and> finite \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (X->including\<^sub>B\<^sub>a\<^sub>g(x) \<tau>)\<rceil>\<rceil>)", simp) - apply(erule conjE, - simp add: OclIncluding_finite_rep_set[simplified OclValid_def] card_including_exec - cp_OclAnd[of "\<delta> X" "\<upsilon> x"] - cp_OclAnd[of "true", THEN sym]) - apply(subgoal_tac "(\<delta> X) \<tau> = true \<tau> \<and> (\<upsilon> x) \<tau> = true \<tau>", simp) - apply(rule foundation5[of _ "\<delta> X" "\<upsilon> x", simplified OclValid_def], - simp only: cp_OclAnd[THEN sym]) - apply(simp, simp add: defined_def true_def false_def bot_fun_def bot_option_def) - - apply(drule defined_inject_true[of "X->including\<^sub>B\<^sub>a\<^sub>g(x)->size\<^sub>B\<^sub>a\<^sub>g()"], - simp del: OclSize_including_exec, - simp only: cp_OclAnd[of "\<delta> (X->size\<^sub>B\<^sub>a\<^sub>g())" "\<upsilon> x"], - simp add: cp_defined[of "X->including\<^sub>B\<^sub>a\<^sub>g(x)->size\<^sub>B\<^sub>a\<^sub>g()" ] cp_defined[of "X->size\<^sub>B\<^sub>a\<^sub>g()" ] - del: OclSize_including_exec, - simp add: OclSize_def card_including_exec - del: OclSize_including_exec) - apply(case_tac "(\<delta> X and \<upsilon> x) \<tau> = true \<tau> \<and> finite (Rep_Bag_base X \<tau>)", - simp add: OclIncluding_finite_rep_set[simplified OclValid_def] card_including_exec, - simp only: cp_OclAnd[THEN sym], - simp add: defined_def bot_fun_def) - - apply(split if_split_asm) - apply(simp add: OclIncluding_finite_rep_set[simplified OclValid_def] card_including_exec)+ - apply(simp only: cp_OclAnd[THEN sym], simp, rule impI, erule conjE) - apply(case_tac "(\<upsilon> x) \<tau> = true \<tau>", simp add: cp_OclAnd[of "\<delta> X" "\<upsilon> x"]) - by(drule valid_inject_true[of "x"], simp add: cp_OclAnd[of _ "\<upsilon> x"]) -qed - -lemma [simp,code_unfold]: "\<delta> ((X ->excluding\<^sub>B\<^sub>a\<^sub>g(x)) ->size\<^sub>B\<^sub>a\<^sub>g()) = (\<delta>(X->size\<^sub>B\<^sub>a\<^sub>g()) and \<upsilon>(x))" -proof - - have defined_inject_true : "\<And>\<tau> P. (\<delta> P) \<tau> \<noteq> true \<tau> \<Longrightarrow> (\<delta> P) \<tau> = false \<tau>" - apply(simp add: defined_def true_def false_def bot_fun_def bot_option_def - null_fun_def null_option_def) - by (case_tac " P \<tau> = \<bottom> \<or> P \<tau> = null", simp_all add: true_def) - - have valid_inject_true : "\<And>\<tau> P. (\<upsilon> P) \<tau> \<noteq> true \<tau> \<Longrightarrow> (\<upsilon> P) \<tau> = false \<tau>" - apply(simp add: valid_def true_def false_def bot_fun_def bot_option_def - null_fun_def null_option_def) - by (case_tac "P \<tau> = \<bottom>", simp_all add: true_def) - - have OclExcluding_finite_rep_set : "\<And>\<tau>. (\<delta> X and \<upsilon> x) \<tau> = true \<tau> \<Longrightarrow> - finite \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (X->excluding\<^sub>B\<^sub>a\<^sub>g(x) \<tau>)\<rceil>\<rceil> = - finite (Rep_Bag_base X \<tau>)" - apply(rule OclExcluding_finite_rep_set) - by(metis OclValid_def foundation5)+ - - have card_excluding_exec : "\<And>\<tau>. (\<delta> (\<lambda>_. \<lfloor>\<lfloor>int (card \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (X->excluding\<^sub>B\<^sub>a\<^sub>g(x) \<tau>)\<rceil>\<rceil>)\<rfloor>\<rfloor>)) \<tau> = - (\<delta> (\<lambda>_. \<lfloor>\<lfloor>int (card (Rep_Bag_base X \<tau>))\<rfloor>\<rfloor>)) \<tau>" - by(simp add: defined_def bot_fun_def bot_option_def null_fun_def null_option_def) - - show ?thesis - apply(rule ext, rename_tac \<tau>) - apply(case_tac "(\<delta> (X->excluding\<^sub>B\<^sub>a\<^sub>g(x)->size\<^sub>B\<^sub>a\<^sub>g())) \<tau> = true \<tau>", simp) - apply(subst cp_OclAnd, subst cp_defined, simp only: cp_defined[of "X->excluding\<^sub>B\<^sub>a\<^sub>g(x)->size\<^sub>B\<^sub>a\<^sub>g()"], - simp add: OclSize_def) - apply(case_tac "((\<delta> X and \<upsilon> x) \<tau> = true \<tau> \<and> finite \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (X->excluding\<^sub>B\<^sub>a\<^sub>g(x) \<tau>)\<rceil>\<rceil>)", simp) - apply(erule conjE, - simp add: OclExcluding_finite_rep_set[simplified OclValid_def] card_excluding_exec - cp_OclAnd[of "\<delta> X" "\<upsilon> x"] - cp_OclAnd[of "true", THEN sym]) - apply(subgoal_tac "(\<delta> X) \<tau> = true \<tau> \<and> (\<upsilon> x) \<tau> = true \<tau>", simp) - apply(rule foundation5[of _ "\<delta> X" "\<upsilon> x", simplified OclValid_def], - simp only: cp_OclAnd[THEN sym]) - apply(simp, simp add: defined_def true_def false_def bot_fun_def bot_option_def) - - apply(drule defined_inject_true[of "X->excluding\<^sub>B\<^sub>a\<^sub>g(x)->size\<^sub>B\<^sub>a\<^sub>g()"], - simp, - simp only: cp_OclAnd[of "\<delta> (X->size\<^sub>B\<^sub>a\<^sub>g())" "\<upsilon> x"], - simp add: cp_defined[of "X->excluding\<^sub>B\<^sub>a\<^sub>g(x)->size\<^sub>B\<^sub>a\<^sub>g()" ] cp_defined[of "X->size\<^sub>B\<^sub>a\<^sub>g()" ], - simp add: OclSize_def card_excluding_exec) - apply(case_tac "(\<delta> X and \<upsilon> x) \<tau> = true \<tau> \<and> finite (Rep_Bag_base X \<tau>)", - simp add: OclExcluding_finite_rep_set[simplified OclValid_def] card_excluding_exec, - simp only: cp_OclAnd[THEN sym], - simp add: defined_def bot_fun_def) - - apply(split if_split_asm) - apply(simp add: OclExcluding_finite_rep_set[simplified OclValid_def] card_excluding_exec)+ - apply(simp only: cp_OclAnd[THEN sym], simp, rule impI, erule conjE) - apply(case_tac "(\<upsilon> x) \<tau> = true \<tau>", simp add: cp_OclAnd[of "\<delta> X" "\<upsilon> x"]) - by(drule valid_inject_true[of "x"], simp add: cp_OclAnd[of _ "\<upsilon> x"]) -qed - -lemma [simp]: - assumes X_finite: "\<And>\<tau>. finite (Rep_Bag_base X \<tau>)" - shows "\<delta> ((X ->including\<^sub>B\<^sub>a\<^sub>g(x)) ->size\<^sub>B\<^sub>a\<^sub>g()) = (\<delta>(X) and \<upsilon>(x))" -by(simp add: size_defined[OF X_finite] del: OclSize_including_exec) - - -text{* OclForall *} - -lemma OclForall_rep_set_false: - assumes "\<tau> \<Turnstile> \<delta> X" - shows "(OclForall X P \<tau> = false \<tau>) = (\<exists>x \<in> (Rep_Bag_base X \<tau>). P (\<lambda>\<tau>. x) \<tau> = false \<tau>)" -by(insert assms, simp add: OclForall_def OclValid_def false_def true_def invalid_def - bot_fun_def bot_option_def null_fun_def null_option_def) - -lemma OclForall_rep_set_true: - assumes "\<tau> \<Turnstile> \<delta> X" - shows "(\<tau> \<Turnstile> OclForall X P) = (\<forall>x \<in> (Rep_Bag_base X \<tau>). \<tau> \<Turnstile> P (\<lambda>\<tau>. x))" -proof - - have destruct_ocl : "\<And>x \<tau>. x = true \<tau> \<or> x = false \<tau> \<or> x = null \<tau> \<or> x = \<bottom> \<tau>" - apply(case_tac x) apply (metis bot_Boolean_def) - apply(rename_tac x', case_tac x') apply (metis null_Boolean_def) - apply(rename_tac x'', case_tac x'') apply (metis (full_types) true_def) - by (metis (full_types) false_def) - - have disjE4 : "\<And> P1 P2 P3 P4 R. - (P1 \<or> P2 \<or> P3 \<or> P4) \<Longrightarrow> (P1 \<Longrightarrow> R) \<Longrightarrow> (P2 \<Longrightarrow> R) \<Longrightarrow> (P3 \<Longrightarrow> R) \<Longrightarrow> (P4 \<Longrightarrow> R) \<Longrightarrow> R" - by metis - show ?thesis - apply(simp add: OclForall_def OclValid_def true_def false_def invalid_def - bot_fun_def bot_option_def null_fun_def null_option_def split: if_split_asm) - apply(rule conjI, rule impI) apply (metis drop.simps option.distinct(1) invalid_def) - apply(rule impI, rule conjI, rule impI) apply (metis option.distinct(1)) - apply(rule impI, rule conjI, rule impI) apply (metis drop.simps) - apply(intro conjI impI ballI) - proof - fix x show "\<forall>x\<in>(Rep_Bag_base X \<tau>). P (\<lambda>_. x) \<tau> \<noteq> \<lfloor>None\<rfloor> \<Longrightarrow> - \<forall>x\<in>(Rep_Bag_base X \<tau>). \<exists>y. P (\<lambda>_. x) \<tau> = \<lfloor>y\<rfloor> \<Longrightarrow> - \<forall>x\<in>(Rep_Bag_base X \<tau>). P (\<lambda>_. x) \<tau> \<noteq> \<lfloor>\<lfloor>False\<rfloor>\<rfloor> \<Longrightarrow> - x \<in> (Rep_Bag_base X \<tau>) \<Longrightarrow> P (\<lambda>\<tau>. x) \<tau> = \<lfloor>\<lfloor>True\<rfloor>\<rfloor>" - apply(erule_tac x = x in ballE)+ - by(rule disjE4[OF destruct_ocl[of "P (\<lambda>\<tau>. x) \<tau>"]], - (simp add: true_def false_def null_fun_def null_option_def bot_fun_def bot_option_def)+) - qed(simp add: assms[simplified OclValid_def true_def])+ -qed - -lemma OclForall_includes : - assumes x_def : "\<tau> \<Turnstile> \<delta> x" - and y_def : "\<tau> \<Turnstile> \<delta> y" - shows "(\<tau> \<Turnstile> OclForall x (OclIncludes y)) = (\<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (x \<tau>)\<rceil>\<rceil> \<subseteq> \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (y \<tau>)\<rceil>\<rceil>)" - apply(simp add: OclForall_rep_set_true[OF x_def], - simp add: OclIncludes_def OclValid_def y_def[simplified OclValid_def]) - apply(insert Set_inv_lemma[OF x_def], simp add: valid_def false_def true_def bot_fun_def) -by(rule iffI, simp add: subsetI, simp add: subsetD) - -lemma OclForall_not_includes : - assumes x_def : "\<tau> \<Turnstile> \<delta> x" - and y_def : "\<tau> \<Turnstile> \<delta> y" - shows "(OclForall x (OclIncludes y) \<tau> = false \<tau>) = (\<not> \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (x \<tau>)\<rceil>\<rceil> \<subseteq> \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (y \<tau>)\<rceil>\<rceil>)" - apply(simp add: OclForall_rep_set_false[OF x_def], - simp add: OclIncludes_def OclValid_def y_def[simplified OclValid_def]) - apply(insert Set_inv_lemma[OF x_def], simp add: valid_def false_def true_def bot_fun_def) -by(rule iffI, metis set_rev_mp, metis subsetI) - -lemma OclForall_iterate: - assumes S_finite: "finite \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil>" - shows "S->forAll\<^sub>B\<^sub>a\<^sub>g(x | P x) \<tau> = (S->iterate\<^sub>B\<^sub>a\<^sub>g(x; acc = true | acc and P x)) \<tau>" -proof - - have and_comm : "comp_fun_commute (\<lambda>x acc. acc and P x)" - apply(simp add: comp_fun_commute_def comp_def) - by (metis OclAnd_assoc OclAnd_commute) - - have ex_insert : "\<And>x F P. (\<exists>x\<in>insert x F. P x) = (P x \<or> (\<exists>x\<in>F. P x))" - by (metis insert_iff) - - have destruct_ocl : "\<And>x \<tau>. x = true \<tau> \<or> x = false \<tau> \<or> x = null \<tau> \<or> x = \<bottom> \<tau>" - apply(case_tac x) apply (metis bot_Boolean_def) - apply(rename_tac x', case_tac x') apply (metis null_Boolean_def) - apply(rename_tac x'', case_tac x'') apply (metis (full_types) true_def) - by (metis (full_types) false_def) - - have disjE4 : "\<And> P1 P2 P3 P4 R. - (P1 \<or> P2 \<or> P3 \<or> P4) \<Longrightarrow> (P1 \<Longrightarrow> R) \<Longrightarrow> (P2 \<Longrightarrow> R) \<Longrightarrow> (P3 \<Longrightarrow> R) \<Longrightarrow> (P4 \<Longrightarrow> R) \<Longrightarrow> R" - by metis - - let ?P_eq = "\<lambda>x b \<tau>. P (\<lambda>_. x) \<tau> = b \<tau>" - let ?P = "\<lambda>set b \<tau>. \<exists>x\<in>set. ?P_eq x b \<tau>" - let ?if = "\<lambda>f b c. if f b \<tau> then b \<tau> else c" - let ?forall = "\<lambda>P. ?if P false (?if P invalid (?if P null (true \<tau>)))" - show ?thesis - apply(simp only: OclForall_def OclIterate_def) - apply(case_tac "\<tau> \<Turnstile> \<delta> S", simp only: OclValid_def) - apply(subgoal_tac "let set = \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil> in - ?forall (?P set) = - Finite_Set.fold (\<lambda>x acc. acc and P x) true ((\<lambda>a \<tau>. a) ` set) \<tau>", - simp only: Let_def, simp add: S_finite, simp only: Let_def) - apply(case_tac "\<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil> = {}", simp) - apply(rule finite_ne_induct[OF S_finite], simp) - (* *) - apply(simp only: image_insert) - apply(subst comp_fun_commute.fold_insert[OF and_comm], simp) - apply (metis empty_iff image_empty) - apply(simp add: invalid_def) - apply (metis bot_fun_def destruct_ocl null_fun_def) - (* *) - apply(simp only: image_insert) - apply(subst comp_fun_commute.fold_insert[OF and_comm], simp) - apply (metis (mono_tags) imageE) - - (* *) - apply(subst cp_OclAnd) apply(drule sym, drule sym, simp only:, drule sym, simp only:) - apply(simp only: ex_insert) - apply(subgoal_tac "\<exists>x. x\<in>F") prefer 2 - apply(metis all_not_in_conv) - proof - fix x F show "(\<delta> S) \<tau> = true \<tau> \<Longrightarrow> \<exists>x. x \<in> F \<Longrightarrow> - ?forall (\<lambda>b \<tau>. ?P_eq x b \<tau> \<or> ?P F b \<tau>) = - ((\<lambda>_. ?forall (?P F)) and (\<lambda>_. P (\<lambda>\<tau>. x) \<tau>)) \<tau>" - apply(rule disjE4[OF destruct_ocl[where x1 = "P (\<lambda>\<tau>. x) \<tau>"]]) - apply(simp_all add: true_def false_def invalid_def OclAnd_def - null_fun_def null_option_def bot_fun_def bot_option_def) - by (metis (lifting) option.distinct(1))+ - qed(simp add: OclValid_def)+ -qed - -lemma OclForall_cong: - assumes "\<And>x. x \<in> (Rep_Bag_base X \<tau>) \<Longrightarrow> \<tau> \<Turnstile> P (\<lambda>\<tau>. x) \<Longrightarrow> \<tau> \<Turnstile> Q (\<lambda>\<tau>. x)" - assumes P: "\<tau> \<Turnstile> OclForall X P" - shows "\<tau> \<Turnstile> OclForall X Q" -proof - - have def_X: "\<tau> \<Turnstile> \<delta> X" - by(insert P, simp add: OclForall_def OclValid_def bot_option_def true_def split: if_split_asm) - show ?thesis - apply(insert P) - apply(subst (asm) OclForall_rep_set_true[OF def_X], subst OclForall_rep_set_true[OF def_X]) - by (simp add: assms) -qed - -lemma OclForall_cong': - assumes "\<And>x. x \<in> (Rep_Bag_base X \<tau>) \<Longrightarrow> \<tau> \<Turnstile> P (\<lambda>\<tau>. x) \<Longrightarrow> \<tau> \<Turnstile> Q (\<lambda>\<tau>. x) \<Longrightarrow> \<tau> \<Turnstile> R (\<lambda>\<tau>. x)" - assumes P: "\<tau> \<Turnstile> OclForall X P" - assumes Q: "\<tau> \<Turnstile> OclForall X Q" - shows "\<tau> \<Turnstile> OclForall X R" -proof - - have def_X: "\<tau> \<Turnstile> \<delta> X" - by(insert P, simp add: OclForall_def OclValid_def bot_option_def true_def split: if_split_asm) - show ?thesis - apply(insert P Q) - apply(subst (asm) (1 2) OclForall_rep_set_true[OF def_X], subst OclForall_rep_set_true[OF def_X]) - by (simp add: assms) -qed - -text{* Strict Equality *} - -lemma StrictRefEq\<^sub>B\<^sub>a\<^sub>g_defined : - assumes x_def: "\<tau> \<Turnstile> \<delta> x" - assumes y_def: "\<tau> \<Turnstile> \<delta> y" - shows "((x::('\<AA>,'\<alpha>::null)Set) \<doteq> y) \<tau> = - (x->forAll\<^sub>B\<^sub>a\<^sub>g(z| y->includes\<^sub>B\<^sub>a\<^sub>g(z)) and (y->forAll\<^sub>B\<^sub>a\<^sub>g(z| x->includes\<^sub>B\<^sub>a\<^sub>g(z)))) \<tau>" -proof - - have rep_set_inj : "\<And>\<tau>. (\<delta> x) \<tau> = true \<tau> \<Longrightarrow> - (\<delta> y) \<tau> = true \<tau> \<Longrightarrow> - x \<tau> \<noteq> y \<tau> \<Longrightarrow> - \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (y \<tau>)\<rceil>\<rceil> \<noteq> \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (x \<tau>)\<rceil>\<rceil>" - apply(simp add: defined_def) - apply(split if_split_asm, simp add: false_def true_def)+ - apply(simp add: null_fun_def null_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def bot_fun_def bot_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def) - - apply(case_tac "x \<tau>", rename_tac x') - apply(case_tac x', simp_all, rename_tac x'') - apply(case_tac x'', simp_all) - - apply(case_tac "y \<tau>", rename_tac y') - apply(case_tac y', simp_all, rename_tac y'') - apply(case_tac y'', simp_all) - - apply(simp add: Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inverse) - by(blast) - - show ?thesis - apply(simp add: StrictRefEq\<^sub>B\<^sub>a\<^sub>g StrongEq_def - foundation20[OF x_def, simplified OclValid_def] - foundation20[OF y_def, simplified OclValid_def]) - apply(subgoal_tac "\<lfloor>\<lfloor>x \<tau> = y \<tau>\<rfloor>\<rfloor> = true \<tau> \<or> \<lfloor>\<lfloor>x \<tau> = y \<tau>\<rfloor>\<rfloor> = false \<tau>") - prefer 2 - apply(simp add: false_def true_def) - (* *) - apply(erule disjE) - apply(simp add: true_def) - - apply(subgoal_tac "(\<tau> \<Turnstile> OclForall x (OclIncludes y)) \<and> (\<tau> \<Turnstile> OclForall y (OclIncludes x))") - apply(subst cp_OclAnd, simp add: true_def OclValid_def) - apply(simp add: OclForall_includes[OF x_def y_def] - OclForall_includes[OF y_def x_def]) - - (* *) - apply(simp) - - apply(subgoal_tac "OclForall x (OclIncludes y) \<tau> = false \<tau> \<or> - OclForall y (OclIncludes x) \<tau> = false \<tau>") - apply(subst cp_OclAnd, metis OclAnd_false1 OclAnd_false2 cp_OclAnd) - apply(simp only: OclForall_not_includes[OF x_def y_def, simplified OclValid_def] - OclForall_not_includes[OF y_def x_def, simplified OclValid_def], - simp add: false_def) - by (metis OclValid_def rep_set_inj subset_antisym x_def y_def) -qed - -lemma StrictRefEq\<^sub>B\<^sub>a\<^sub>g_exec[simp,code_unfold] : -"((x::('\<AA>,'\<alpha>::null)Set) \<doteq> y) = - (if \<delta> x then (if \<delta> y - then ((x->forAll\<^sub>B\<^sub>a\<^sub>g(z| y->includes\<^sub>B\<^sub>a\<^sub>g(z)) and (y->forAll\<^sub>B\<^sub>a\<^sub>g(z| x->includes\<^sub>B\<^sub>a\<^sub>g(z))))) - else if \<upsilon> y - then false (* x'->includes = null *) - else invalid - endif - endif) - else if \<upsilon> x (* null = ??? *) - then if \<upsilon> y then not(\<delta> y) else invalid endif - else invalid - endif - endif)" -proof - - have defined_inject_true : "\<And>\<tau> P. (\<not> (\<tau> \<Turnstile> \<delta> P)) = ((\<delta> P) \<tau> = false \<tau>)" - by (metis bot_fun_def OclValid_def defined_def foundation16 null_fun_def) - - have valid_inject_true : "\<And>\<tau> P. (\<not> (\<tau> \<Turnstile> \<upsilon> P)) = ((\<upsilon> P) \<tau> = false \<tau>)" - by (metis bot_fun_def OclIf_true' OclIncludes_charn0 OclIncludes_charn0' OclValid_def valid_def - foundation6 foundation9) - show ?thesis - apply(rule ext, rename_tac \<tau>) - (* *) - apply(simp add: OclIf_def - defined_inject_true[simplified OclValid_def] - valid_inject_true[simplified OclValid_def], - subst false_def, subst true_def, simp) - apply(subst (1 2) cp_OclNot, simp, simp add: cp_OclNot[symmetric]) - apply(simp add: StrictRefEq\<^sub>B\<^sub>a\<^sub>g_defined[simplified OclValid_def]) - by(simp add: StrictRefEq\<^sub>B\<^sub>a\<^sub>g StrongEq_def false_def true_def valid_def defined_def) -qed - -lemma StrictRefEq\<^sub>B\<^sub>a\<^sub>g_L_subst1 : "cp P \<Longrightarrow> \<tau> \<Turnstile> \<upsilon> x \<Longrightarrow> \<tau> \<Turnstile> \<upsilon> y \<Longrightarrow> \<tau> \<Turnstile> \<upsilon> P x \<Longrightarrow> \<tau> \<Turnstile> \<upsilon> P y \<Longrightarrow> - \<tau> \<Turnstile> (x::('\<AA>,'\<alpha>::null)Set) \<doteq> y \<Longrightarrow> \<tau> \<Turnstile> (P x ::('\<AA>,'\<alpha>::null)Set) \<doteq> P y" - apply(simp only: StrictRefEq\<^sub>B\<^sub>a\<^sub>g OclValid_def) - apply(split if_split_asm) - apply(simp add: StrongEq_L_subst1[simplified OclValid_def]) -by (simp add: invalid_def bot_option_def true_def) - -lemma OclIncluding_cong' : -shows "\<tau> \<Turnstile> \<delta> s \<Longrightarrow> \<tau> \<Turnstile> \<delta> t \<Longrightarrow> \<tau> \<Turnstile> \<upsilon> x \<Longrightarrow> - \<tau> \<Turnstile> ((s::('\<AA>,'a::null)Set) \<doteq> t) \<Longrightarrow> \<tau> \<Turnstile> (s->including\<^sub>B\<^sub>a\<^sub>g(x) \<doteq> (t->including\<^sub>B\<^sub>a\<^sub>g(x)))" -proof - - have cp: "cp (\<lambda>s. (s->including\<^sub>B\<^sub>a\<^sub>g(x)))" - apply(simp add: cp_def, subst OclIncluding.cp0) - by (rule_tac x = "(\<lambda>xab ab. ((\<lambda>_. xab)->including\<^sub>B\<^sub>a\<^sub>g(\<lambda>_. x ab)) ab)" in exI, simp) - - show "\<tau> \<Turnstile> \<delta> s \<Longrightarrow> \<tau> \<Turnstile> \<delta> t \<Longrightarrow> \<tau> \<Turnstile> \<upsilon> x \<Longrightarrow> \<tau> \<Turnstile> (s \<doteq> t) \<Longrightarrow> ?thesis" - apply(rule_tac P = "\<lambda>s. (s->including\<^sub>B\<^sub>a\<^sub>g(x))" in StrictRefEq\<^sub>B\<^sub>a\<^sub>g_L_subst1) - apply(rule cp) - apply(simp add: foundation20) apply(simp add: foundation20) - apply (simp add: foundation10 foundation6)+ - done -qed - -lemma OclIncluding_cong : "\<And>(s::('\<AA>,'a::null)Set) t x y \<tau>. \<tau> \<Turnstile> \<delta> t \<Longrightarrow> \<tau> \<Turnstile> \<upsilon> y \<Longrightarrow> - \<tau> \<Turnstile> s \<doteq> t \<Longrightarrow> x = y \<Longrightarrow> \<tau> \<Turnstile> s->including\<^sub>B\<^sub>a\<^sub>g(x) \<doteq> (t->including\<^sub>B\<^sub>a\<^sub>g(y))" - apply(simp only:) - apply(rule OclIncluding_cong', simp_all only:) -by(auto simp: OclValid_def OclIf_def invalid_def bot_option_def OclNot_def split : if_split_asm) -*) -(* < *) -(*lemma const_StrictRefEq\<^sub>B\<^sub>a\<^sub>g_empty : "const X \<Longrightarrow> const (X \<doteq> Set{})" - apply(rule StrictRefEq\<^sub>B\<^sub>a\<^sub>g.const, assumption) -by(simp) - -lemma const_StrictRefEq\<^sub>B\<^sub>a\<^sub>g_including : - "const a \<Longrightarrow> const S \<Longrightarrow> const X \<Longrightarrow> const (X \<doteq> S->including\<^sub>B\<^sub>a\<^sub>g(a))" - apply(rule StrictRefEq\<^sub>B\<^sub>a\<^sub>g.const, assumption) -by(rule const_OclIncluding) -*) -subsection{* Test Statements *} - -(*Assert "(\<tau> \<Turnstile> (Bag{\<lambda>_. \<lfloor>\<lfloor>x\<rfloor>\<rfloor>} \<doteq> Bag{\<lambda>_. \<lfloor>\<lfloor>x\<rfloor>\<rfloor>}))" -Assert "(\<tau> \<Turnstile> (Bag{\<lambda>_. \<lfloor>x\<rfloor>} \<doteq> Bag{\<lambda>_. \<lfloor>x\<rfloor>}))"*) - -(* (*TODO.*) -open problem: An executable code-generator setup for the Bag type. Some bits and pieces -so far : -instantiation int :: equal -begin - -definition - "HOL.equal k l \<longleftrightarrow> k = (l::int)" - -instance by default (rule equal_int_def) - -end - -lemma equal_int_code [code]: - "HOL.equal 0 (0::int) \<longleftrightarrow> True" - "HOL.equal 0 (Pos l) \<longleftrightarrow> False" - "HOL.equal 0 (Neg l) \<longleftrightarrow> False" - "HOL.equal (Pos k) 0 \<longleftrightarrow> False" - "HOL.equal (Pos k) (Pos l) \<longleftrightarrow> HOL.equal k l" - "HOL.equal (Pos k) (Neg l) \<longleftrightarrow> False" - "HOL.equal (Neg k) 0 \<longleftrightarrow> False" - "HOL.equal (Neg k) (Pos l) \<longleftrightarrow> False" - "HOL.equal (Neg k) (Neg l) \<longleftrightarrow> HOL.equal k l" - by (auto simp add: equal) -*) - - -instantiation Bag\<^sub>b\<^sub>a\<^sub>s\<^sub>e :: (equal)equal -begin - definition "HOL.equal k l \<longleftrightarrow> (k::('a::equal)Bag\<^sub>b\<^sub>a\<^sub>s\<^sub>e) = l" - instance by standard (rule equal_Bag\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def) -end - -lemma equal_Bag\<^sub>b\<^sub>a\<^sub>s\<^sub>e_code [code]: - "HOL.equal k (l::('a::{equal,null})Bag\<^sub>b\<^sub>a\<^sub>s\<^sub>e) \<longleftrightarrow> Rep_Bag\<^sub>b\<^sub>a\<^sub>s\<^sub>e k = Rep_Bag\<^sub>b\<^sub>a\<^sub>s\<^sub>e l" - by (auto simp add: equal Bag\<^sub>b\<^sub>a\<^sub>s\<^sub>e.Rep_Bag\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inject) - -Assert "\<tau> \<Turnstile> (Bag{} \<doteq> Bag{})" - -(* TODO Frederic ?: -Assert "\<tau> \<Turnstile> not(Bag{\<one>,\<one>} \<triangleq> Bag{\<one>})" -Assert "\<tau> \<Turnstile> (Bag{\<one>,\<two>} \<triangleq> Bag{\<two>,\<one>}" -Assert "\<tau> \<Turnstile> (Bag{\<one>,null} \<triangleq> Bag{null,\<one>}" -Assert "\<tau> \<Turnstile> (Bag{\<one>,invalid,\<two>} \<triangleq> invalid)" -Assert "\<tau> \<Turnstile> (Bag{\<one>,\<two>}->including\<^sub>B\<^sub>a\<^sub>g(null) \<triangleq> Bag{\<one>,\<two>,null})" -*) - -(* > *) - -end diff --git a/Citadelle/src/collection_types/UML_Pair.thy b/Citadelle/src/collection_types/UML_Pair.thy deleted file mode 100644 index e8827d4880b53418da882fc7fa39048cb0c88cee..0000000000000000000000000000000000000000 --- a/Citadelle/src/collection_types/UML_Pair.thy +++ /dev/null @@ -1,248 +0,0 @@ -(****************************************************************************** - * 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_Pair -imports "../UML_PropertyProfiles" -begin - -section{* Collection Type Pairs: Operations \label{sec:collection_pairs} *} - -text{* The OCL standard provides the concept of \emph{Tuples}, \ie{} a family of record-types -with projection functions. In FeatherWeight OCL, only the theory of a special case is -developped, namely the type of Pairs, which is, however, sufficient for all applications -since it can be used to mimick all tuples. In particular, it can be used to express operations -with multiple arguments, roles of n-ary associations, ... *} - -subsection{* Semantic Properties of the Type Constructor *} - -lemma A[simp]:"Rep_Pair\<^sub>b\<^sub>a\<^sub>s\<^sub>e x \<noteq> None \<Longrightarrow> Rep_Pair\<^sub>b\<^sub>a\<^sub>s\<^sub>e x \<noteq> null \<Longrightarrow> (fst \<lceil>\<lceil>Rep_Pair\<^sub>b\<^sub>a\<^sub>s\<^sub>e x\<rceil>\<rceil>) \<noteq> bot" -by(insert Rep_Pair\<^sub>b\<^sub>a\<^sub>s\<^sub>e[of x],auto simp:null_option_def bot_option_def) - -lemma A'[simp]:" x \<noteq> bot \<Longrightarrow> x \<noteq> null \<Longrightarrow> (fst \<lceil>\<lceil>Rep_Pair\<^sub>b\<^sub>a\<^sub>s\<^sub>e x\<rceil>\<rceil>) \<noteq> bot" -apply(insert Rep_Pair\<^sub>b\<^sub>a\<^sub>s\<^sub>e[of x], simp add: bot_Pair\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def null_Pair\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def) -apply(auto simp:null_option_def bot_option_def) -apply(erule contrapos_np[of "x = Abs_Pair\<^sub>b\<^sub>a\<^sub>s\<^sub>e None"]) -apply(subst Rep_Pair\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inject[symmetric], simp) -apply(subst Pair\<^sub>b\<^sub>a\<^sub>s\<^sub>e.Abs_Pair\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inverse, simp_all,simp add: bot_option_def) -apply(erule contrapos_np[of "x = Abs_Pair\<^sub>b\<^sub>a\<^sub>s\<^sub>e \<lfloor>None\<rfloor>"]) -apply(subst Rep_Pair\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inject[symmetric], simp) -apply(subst Pair\<^sub>b\<^sub>a\<^sub>s\<^sub>e.Abs_Pair\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inverse, simp_all,simp add: null_option_def bot_option_def) -done - -lemma B[simp]:"Rep_Pair\<^sub>b\<^sub>a\<^sub>s\<^sub>e x \<noteq> None \<Longrightarrow> Rep_Pair\<^sub>b\<^sub>a\<^sub>s\<^sub>e x \<noteq> null \<Longrightarrow> (snd \<lceil>\<lceil>Rep_Pair\<^sub>b\<^sub>a\<^sub>s\<^sub>e x\<rceil>\<rceil>) \<noteq> bot" -by(insert Rep_Pair\<^sub>b\<^sub>a\<^sub>s\<^sub>e[of x],auto simp:null_option_def bot_option_def) - -lemma B'[simp]:"x \<noteq> bot \<Longrightarrow> x \<noteq> null \<Longrightarrow> (snd \<lceil>\<lceil>Rep_Pair\<^sub>b\<^sub>a\<^sub>s\<^sub>e x\<rceil>\<rceil>) \<noteq> bot" -apply(insert Rep_Pair\<^sub>b\<^sub>a\<^sub>s\<^sub>e[of x], simp add: bot_Pair\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def null_Pair\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def) -apply(auto simp:null_option_def bot_option_def) -apply(erule contrapos_np[of "x = Abs_Pair\<^sub>b\<^sub>a\<^sub>s\<^sub>e None"]) -apply(subst Rep_Pair\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inject[symmetric], simp) -apply(subst Pair\<^sub>b\<^sub>a\<^sub>s\<^sub>e.Abs_Pair\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inverse, simp_all,simp add: bot_option_def) -apply(erule contrapos_np[of "x = Abs_Pair\<^sub>b\<^sub>a\<^sub>s\<^sub>e \<lfloor>None\<rfloor>"]) -apply(subst Rep_Pair\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inject[symmetric], simp) -apply(subst Pair\<^sub>b\<^sub>a\<^sub>s\<^sub>e.Abs_Pair\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inverse, simp_all,simp add: null_option_def bot_option_def) -done - -subsection{* Fundamental Properties of Strict Equality \label{sec:pair-strict-eq}*} - -text{* After the part of foundational operations on sets, we detail here equality on sets. -Strong equality is inherited from the OCL core, but we have to consider -the case of the strict equality. We decide to overload strict equality in the -same way we do for other value's in OCL:*} - -overloading - StrictRefEq \<equiv> "StrictRefEq :: [('\<AA>,'\<alpha>::null,'\<beta>::null)Pair,('\<AA>,'\<alpha>::null,'\<beta>::null)Pair] \<Rightarrow> ('\<AA>)Boolean" -begin - definition StrictRefEq\<^sub>P\<^sub>a\<^sub>i\<^sub>r : - "((x::('\<AA>,'\<alpha>::null,'\<beta>::null)Pair) \<doteq> y) \<equiv> (\<lambda> \<tau>. if (\<upsilon> x) \<tau> = true \<tau> \<and> (\<upsilon> y) \<tau> = true \<tau> - then (x \<triangleq> y)\<tau> - else invalid \<tau>)" -end - -text{* Property proof in terms of @{term "profile_bin\<^sub>S\<^sub>t\<^sub>r\<^sub>o\<^sub>n\<^sub>g\<^sub>E\<^sub>q_\<^sub>v_\<^sub>v"}*} -interpretation StrictRefEq\<^sub>P\<^sub>a\<^sub>i\<^sub>r : profile_bin\<^sub>S\<^sub>t\<^sub>r\<^sub>o\<^sub>n\<^sub>g\<^sub>E\<^sub>q_\<^sub>v_\<^sub>v "\<lambda> x y. (x::('\<AA>,'\<alpha>::null,'\<beta>::null)Pair) \<doteq> y" - by unfold_locales (auto simp: StrictRefEq\<^sub>P\<^sub>a\<^sub>i\<^sub>r) - -subsection{* Standard Operations Definitions *} - -text{* This part provides a collection of operators for the Pair type. *} - -subsubsection{* Definition: Pair Constructor *} - -definition OclPair::"('\<AA>, '\<alpha>) val \<Rightarrow> - ('\<AA>, '\<beta>) val \<Rightarrow> - ('\<AA>,'\<alpha>::null,'\<beta>::null) Pair" ("Pair{(_),(_)}") -where "Pair{X,Y} \<equiv> (\<lambda> \<tau>. if (\<upsilon> X) \<tau> = true \<tau> \<and> (\<upsilon> Y) \<tau> = true \<tau> - then Abs_Pair\<^sub>b\<^sub>a\<^sub>s\<^sub>e \<lfloor>\<lfloor>(X \<tau>, Y \<tau>)\<rfloor>\<rfloor> - else invalid \<tau>)" - -interpretation OclPair : profile_bin\<^sub>v_\<^sub>v - OclPair "\<lambda> x y. Abs_Pair\<^sub>b\<^sub>a\<^sub>s\<^sub>e \<lfloor>\<lfloor>(x, y)\<rfloor>\<rfloor>" - apply(unfold_locales, auto simp: OclPair_def bot_Pair\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def null_Pair\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def) - by(auto simp: Abs_Pair\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inject null_option_def bot_option_def) - - -subsubsection{* Definition: First *} - -definition OclFirst::" ('\<AA>,'\<alpha>::null,'\<beta>::null) Pair \<Rightarrow> ('\<AA>, '\<alpha>) val" (" _ .First'(')") -where "X .First() \<equiv> (\<lambda> \<tau>. if (\<delta> X) \<tau> = true \<tau> - then fst \<lceil>\<lceil>Rep_Pair\<^sub>b\<^sub>a\<^sub>s\<^sub>e (X \<tau>)\<rceil>\<rceil> - else invalid \<tau>)" - - -interpretation OclFirst : profile_mono\<^sub>d OclFirst "\<lambda>x. fst \<lceil>\<lceil>Rep_Pair\<^sub>b\<^sub>a\<^sub>s\<^sub>e (x)\<rceil>\<rceil>" - by unfold_locales (auto simp: OclFirst_def) - -subsubsection{* Definition: Second *} - -definition OclSecond::" ('\<AA>,'\<alpha>::null,'\<beta>::null) Pair \<Rightarrow> ('\<AA>, '\<beta>) val" ("_ .Second'(')") -where "X .Second() \<equiv> (\<lambda> \<tau>. if (\<delta> X) \<tau> = true \<tau> - then snd \<lceil>\<lceil>Rep_Pair\<^sub>b\<^sub>a\<^sub>s\<^sub>e (X \<tau>)\<rceil>\<rceil> - else invalid \<tau>)" - -interpretation OclSecond : profile_mono\<^sub>d OclSecond "\<lambda>x. snd \<lceil>\<lceil>Rep_Pair\<^sub>b\<^sub>a\<^sub>s\<^sub>e (x)\<rceil>\<rceil>" - by unfold_locales (auto simp: OclSecond_def) - -subsection{* Logical Properties *} - -lemma 1 : "\<tau> \<Turnstile> \<upsilon> Y \<Longrightarrow> \<tau> \<Turnstile> Pair{X,Y} .First() \<triangleq> X" -apply(case_tac "\<not>(\<tau> \<Turnstile> \<upsilon> X)") -apply(erule foundation7'[THEN iffD2, THEN foundation15[THEN iffD2, - THEN StrongEq_L_subst2_rev]],simp_all add:foundation18') -apply(auto simp: OclValid_def valid_def defined_def StrongEq_def OclFirst_def OclPair_def - true_def false_def invalid_def bot_fun_def null_fun_def) -apply(auto simp: Abs_Pair\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inject null_option_def bot_option_def bot_Pair\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def null_Pair\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def) -by(simp add: Abs_Pair\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inverse) - -lemma 2 : "\<tau> \<Turnstile> \<upsilon> X \<Longrightarrow> \<tau> \<Turnstile> Pair{X,Y} .Second() \<triangleq> Y" -apply(case_tac "\<not>(\<tau> \<Turnstile> \<upsilon> Y)") -apply(erule foundation7'[THEN iffD2, THEN foundation15[THEN iffD2, - THEN StrongEq_L_subst2_rev]],simp_all add:foundation18') -apply(auto simp: OclValid_def valid_def defined_def StrongEq_def OclSecond_def OclPair_def - true_def false_def invalid_def bot_fun_def null_fun_def) -apply(auto simp: Abs_Pair\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inject null_option_def bot_option_def bot_Pair\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def null_Pair\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def) -by(simp add: Abs_Pair\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inverse) - -subsection{* Algebraic Execution Properties *} - -lemma proj1_exec [simp, code_unfold] : "Pair{X,Y} .First() = (if (\<upsilon> Y) then X else invalid endif)" -apply(rule ext, rename_tac "\<tau>", simp add: foundation22[symmetric]) -apply(case_tac "\<not>(\<tau> \<Turnstile> \<upsilon> Y)") -apply(erule foundation7'[THEN iffD2, - THEN foundation15[THEN iffD2, - THEN StrongEq_L_subst2_rev]],simp_all) -apply(subgoal_tac "\<tau> \<Turnstile> \<upsilon> Y") -apply(erule foundation13[THEN iffD2, THEN StrongEq_L_subst2_rev], simp_all) -by(erule 1) - -lemma proj2_exec [simp, code_unfold] : "Pair{X,Y} .Second() = (if (\<upsilon> X) then Y else invalid endif)" -apply(rule ext, rename_tac "\<tau>", simp add: foundation22[symmetric]) -apply(case_tac "\<not>(\<tau> \<Turnstile> \<upsilon> X)") -apply(erule foundation7'[THEN iffD2, THEN foundation15[THEN iffD2, - THEN StrongEq_L_subst2_rev]],simp_all) -apply(subgoal_tac "\<tau> \<Turnstile> \<upsilon> X") -apply(erule foundation13[THEN iffD2, THEN StrongEq_L_subst2_rev], simp_all) -by(erule 2) - -(* < *) - -subsection{* Test Statements*} -(* -Assert "(\<tau> \<Turnstile> (Pair{\<lambda>_. \<lfloor>\<lfloor>x\<rfloor>\<rfloor>,\<lambda>_. \<lfloor>\<lfloor>x\<rfloor>\<rfloor>} \<doteq> Pair{\<lambda>_. \<lfloor>\<lfloor>x\<rfloor>\<rfloor>,\<lambda>_. \<lfloor>\<lfloor>x\<rfloor>\<rfloor>}))" -Assert "(\<tau> \<Turnstile> (Pair{\<lambda>_. \<lfloor>x\<rfloor>,\<lambda>_. \<lfloor>x\<rfloor>} \<doteq> Pair{\<lambda>_. \<lfloor>x\<rfloor>,\<lambda>_. \<lfloor>x\<rfloor>}))" -*) -(* (*TODO.*) -open problem: An executable code-generator setup for the Pair type. Some bits and pieces -so far : -instantiation int :: equal -begin - -definition - "HOL.equal k l \<longleftrightarrow> k = (l::int)" - -instance by default (rule equal_int_def) - -end - -lemma equal_int_code [code]: - "HOL.equal 0 (0::int) \<longleftrightarrow> True" - "HOL.equal 0 (Pos l) \<longleftrightarrow> False" - "HOL.equal 0 (Neg l) \<longleftrightarrow> False" - "HOL.equal (Pos k) 0 \<longleftrightarrow> False" - "HOL.equal (Pos k) (Pos l) \<longleftrightarrow> HOL.equal k l" - "HOL.equal (Pos k) (Neg l) \<longleftrightarrow> False" - "HOL.equal (Neg k) 0 \<longleftrightarrow> False" - "HOL.equal (Neg k) (Pos l) \<longleftrightarrow> False" - "HOL.equal (Neg k) (Neg l) \<longleftrightarrow> HOL.equal k l" - by (auto simp add: equal) -*) - - -instantiation Pair\<^sub>b\<^sub>a\<^sub>s\<^sub>e :: (equal,equal)equal -begin - definition "HOL.equal k l \<longleftrightarrow> (k::('a::equal,'b::equal)Pair\<^sub>b\<^sub>a\<^sub>s\<^sub>e) = l" - instance by standard (rule equal_Pair\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def) -end - -lemma equal_Pair\<^sub>b\<^sub>a\<^sub>s\<^sub>e_code [code]: - "HOL.equal k (l::('a::{equal,null},'b::{equal,null})Pair\<^sub>b\<^sub>a\<^sub>s\<^sub>e) \<longleftrightarrow> Rep_Pair\<^sub>b\<^sub>a\<^sub>s\<^sub>e k = Rep_Pair\<^sub>b\<^sub>a\<^sub>s\<^sub>e l" - by (auto simp add: equal Pair\<^sub>b\<^sub>a\<^sub>s\<^sub>e.Rep_Pair\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inject) - -Assert "\<tau> \<Turnstile> invalid .First() \<triangleq> invalid " -Assert "\<tau> \<Turnstile> null .First() \<triangleq> invalid " -Assert "\<tau> \<Turnstile> null .Second() \<triangleq> invalid .Second() " -Assert "\<tau> \<Turnstile> Pair{invalid, true} \<triangleq> invalid " -Assert "\<tau> \<Turnstile> \<upsilon>(Pair{null, true}.First())" -Assert "\<tau> \<Turnstile> (Pair{null, true}).First() \<triangleq> null " -Assert "\<tau> \<Turnstile> (Pair{null, Pair{true,invalid}}).First() \<triangleq> invalid " - - -(* TODO Frederic ?: -Assert "\<not> (\<tau> \<Turnstile> (Pair{\<one>,\<two>} \<doteq> Pair{\<two>,\<one>}))" -*) - -(* > *) - -end diff --git a/Citadelle/src/collection_types/UML_Sequence.thy b/Citadelle/src/collection_types/UML_Sequence.thy deleted file mode 100644 index f250c33846501d90336fd86a33f55695ef2d156c..0000000000000000000000000000000000000000 --- a/Citadelle/src/collection_types/UML_Sequence.thy +++ /dev/null @@ -1,627 +0,0 @@ -(****************************************************************************** - * 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_Sequence -imports "../basic_types/UML_Boolean" - "../basic_types/UML_Integer" -begin - -no_notation None ("\<bottom>") -section{* Collection Type Sequence: Operations *} - -subsection{* Basic Properties of the Sequence Type *} - -text{* Every element in a defined sequence is valid. *} - -lemma Sequence_inv_lemma: "\<tau> \<Turnstile> (\<delta> X) \<Longrightarrow> \<forall>x\<in>set \<lceil>\<lceil>Rep_Sequence\<^sub>b\<^sub>a\<^sub>s\<^sub>e (X \<tau>)\<rceil>\<rceil>. x \<noteq> bot" -apply(insert Rep_Sequence\<^sub>b\<^sub>a\<^sub>s\<^sub>e [of "X \<tau>"], simp) -apply(auto simp: OclValid_def defined_def false_def true_def cp_def - bot_fun_def bot_Sequence\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def null_Sequence\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def null_fun_def - split:if_split_asm) - apply(erule contrapos_pp [of "Rep_Sequence\<^sub>b\<^sub>a\<^sub>s\<^sub>e (X \<tau>) = bot"]) - apply(subst Abs_Sequence\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inject[symmetric], rule Rep_Sequence\<^sub>b\<^sub>a\<^sub>s\<^sub>e, simp) - apply(simp add: Rep_Sequence\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inverse bot_Sequence\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def bot_option_def) -apply(erule contrapos_pp [of "Rep_Sequence\<^sub>b\<^sub>a\<^sub>s\<^sub>e (X \<tau>) = null"]) -apply(subst Abs_Sequence\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inject[symmetric], rule Rep_Sequence\<^sub>b\<^sub>a\<^sub>s\<^sub>e, simp) -apply(simp add: Rep_Sequence\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inverse null_option_def) -by (simp add: bot_option_def) - -subsection{* Definition: Strict Equality \label{sec:seq-strict-equality}*} - -text{* After the part of foundational operations on sets, we detail here equality on sets. -Strong equality is inherited from the OCL core, but we have to consider -the case of the strict equality. We decide to overload strict equality in the -same way we do for other value's in OCL:*} - -overloading - StrictRefEq \<equiv> "StrictRefEq :: [('\<AA>,'\<alpha>::null)Sequence,('\<AA>,'\<alpha>::null)Sequence] \<Rightarrow> ('\<AA>)Boolean" -begin - definition StrictRefEq\<^sub>S\<^sub>e\<^sub>q : - "((x::('\<AA>,'\<alpha>::null)Sequence) \<doteq> y) \<equiv> (\<lambda> \<tau>. if (\<upsilon> x) \<tau> = true \<tau> \<and> (\<upsilon> y) \<tau> = true \<tau> - then (x \<triangleq> y)\<tau> - else invalid \<tau>)" -end - -text_raw{* \isatagafp *} -text{* One might object here that for the case of objects, this is an empty definition. -The answer is no, we will restrain later on states and objects such that any object -has its oid stored inside the object (so the ref, under which an object can be referenced -in the store will represented in the object itself). For such well-formed stores that satisfy -this invariant (the WFF-invariant), the referential equality and the -strong equality---and therefore the strict equality on sequences in the sense above---coincides.*} -text_raw{* \endisatagafp *} - -text{* Property proof in terms of @{term "profile_bin\<^sub>S\<^sub>t\<^sub>r\<^sub>o\<^sub>n\<^sub>g\<^sub>E\<^sub>q_\<^sub>v_\<^sub>v"}*} -interpretation StrictRefEq\<^sub>S\<^sub>e\<^sub>q : profile_bin\<^sub>S\<^sub>t\<^sub>r\<^sub>o\<^sub>n\<^sub>g\<^sub>E\<^sub>q_\<^sub>v_\<^sub>v "\<lambda> x y. (x::('\<AA>,'\<alpha>::null)Sequence) \<doteq> y" - by unfold_locales (auto simp: StrictRefEq\<^sub>S\<^sub>e\<^sub>q) - - - -subsection{* Constants: mtSequence *} -definition mtSequence ::"('\<AA>,'\<alpha>::null) Sequence" ("Sequence{}") -where "Sequence{} \<equiv> (\<lambda> \<tau>. Abs_Sequence\<^sub>b\<^sub>a\<^sub>s\<^sub>e \<lfloor>\<lfloor>[]::'\<alpha> list\<rfloor>\<rfloor> )" - - -lemma mtSequence_defined[simp,code_unfold]:"\<delta>(Sequence{}) = true" -apply(rule ext, auto simp: mtSequence_def defined_def null_Sequence\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def - bot_Sequence\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def bot_fun_def null_fun_def) -by(simp_all add: Abs_Sequence\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inject bot_option_def null_option_def) - -lemma mtSequence_valid[simp,code_unfold]:"\<upsilon>(Sequence{}) = true" -apply(rule ext,auto simp: mtSequence_def valid_def null_Sequence\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def - bot_Sequence\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def bot_fun_def null_fun_def) -by(simp_all add: Abs_Sequence\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inject bot_option_def null_option_def) - -lemma mtSequence_rep_set: "\<lceil>\<lceil>Rep_Sequence\<^sub>b\<^sub>a\<^sub>s\<^sub>e (Sequence{} \<tau>)\<rceil>\<rceil> = []" - apply(simp add: mtSequence_def, subst Abs_Sequence\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inverse) -by(simp add: bot_option_def)+ - -text_raw{* \isatagafp *} - -lemma [simp,code_unfold]: "const Sequence{}" -by(simp add: const_def mtSequence_def) - -text{* Note that the collection types in OCL allow for null to be included; - however, there is the null-collection into which inclusion yields invalid. *} - -text_raw{* \endisatagafp *} - - -subsection{* Definition: Prepend *} -definition OclPrepend :: "[('\<AA>,'\<alpha>::null) Sequence,('\<AA>,'\<alpha>) val] \<Rightarrow> ('\<AA>,'\<alpha>) Sequence" -where "OclPrepend x y = (\<lambda> \<tau>. if (\<delta> x) \<tau> = true \<tau> \<and> (\<upsilon> y) \<tau> = true \<tau> - then Abs_Sequence\<^sub>b\<^sub>a\<^sub>s\<^sub>e \<lfloor>\<lfloor> (y \<tau>)#\<lceil>\<lceil>Rep_Sequence\<^sub>b\<^sub>a\<^sub>s\<^sub>e (x \<tau>)\<rceil>\<rceil> \<rfloor>\<rfloor> - else invalid \<tau> )" -notation OclPrepend ("_->prepend\<^sub>S\<^sub>e\<^sub>q'(_')") - -interpretation OclPrepend:profile_bin\<^sub>d_\<^sub>v OclPrepend "\<lambda>x y. Abs_Sequence\<^sub>b\<^sub>a\<^sub>s\<^sub>e\<lfloor>\<lfloor>y#\<lceil>\<lceil>Rep_Sequence\<^sub>b\<^sub>a\<^sub>s\<^sub>e x\<rceil>\<rceil>\<rfloor>\<rfloor>" -proof - - have A : "\<And>x y. x \<noteq> bot \<Longrightarrow> x \<noteq> null \<Longrightarrow> y \<noteq> bot \<Longrightarrow> - \<lfloor>\<lfloor>y#\<lceil>\<lceil>Rep_Sequence\<^sub>b\<^sub>a\<^sub>s\<^sub>e x\<rceil>\<rceil>\<rfloor>\<rfloor> \<in> {X. X = bot \<or> X = null \<or> (\<forall>x\<in>set \<lceil>\<lceil>X\<rceil>\<rceil>. x \<noteq> bot)}" - by(auto intro!:Sequence_inv_lemma[simplified OclValid_def - defined_def false_def true_def null_fun_def bot_fun_def]) - - show "profile_bin\<^sub>d_\<^sub>v OclPrepend (\<lambda>x y. Abs_Sequence\<^sub>b\<^sub>a\<^sub>s\<^sub>e \<lfloor>\<lfloor>y#\<lceil>\<lceil>Rep_Sequence\<^sub>b\<^sub>a\<^sub>s\<^sub>e x\<rceil>\<rceil>\<rfloor>\<rfloor>)" - apply unfold_locales - apply(auto simp:OclPrepend_def bot_option_def null_option_def null_Sequence\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def - bot_Sequence\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def) - apply(erule_tac Q="Abs_Sequence\<^sub>b\<^sub>a\<^sub>s\<^sub>e \<lfloor>\<lfloor>y#\<lceil>\<lceil>Rep_Sequence\<^sub>b\<^sub>a\<^sub>s\<^sub>e x\<rceil>\<rceil>\<rfloor>\<rfloor> = Abs_Sequence\<^sub>b\<^sub>a\<^sub>s\<^sub>e None" - in contrapos_pp) - apply(subst Abs_Sequence\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inject [OF A]) - apply(simp_all add: null_Sequence\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def bot_Sequence\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def bot_option_def) - apply(erule_tac Q="Abs_Sequence\<^sub>b\<^sub>a\<^sub>s\<^sub>e\<lfloor>\<lfloor>y#\<lceil>\<lceil>Rep_Sequence\<^sub>b\<^sub>a\<^sub>s\<^sub>e x\<rceil>\<rceil>\<rfloor>\<rfloor> = Abs_Sequence\<^sub>b\<^sub>a\<^sub>s\<^sub>e \<lfloor>None\<rfloor>" - in contrapos_pp) - apply(subst Abs_Sequence\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inject[OF A]) - apply(simp_all add: null_Sequence\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def bot_Sequence\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def - bot_option_def null_option_def) - done -qed - -syntax - "_OclFinsequence" :: "args => ('\<AA>,'a::null) Sequence" ("Sequence{(_)}") -translations - "Sequence{x, xs}" == "CONST OclPrepend (Sequence{xs}) x" - "Sequence{x}" == "CONST OclPrepend (Sequence{}) x " - -subsection{* Definition: Including *} - -definition OclIncluding :: "[('\<AA>,'\<alpha>::null) Sequence,('\<AA>,'\<alpha>) val] \<Rightarrow> ('\<AA>,'\<alpha>) Sequence" -where "OclIncluding x y = (\<lambda> \<tau>. if (\<delta> x) \<tau> = true \<tau> \<and> (\<upsilon> y) \<tau> = true \<tau> - then Abs_Sequence\<^sub>b\<^sub>a\<^sub>s\<^sub>e \<lfloor>\<lfloor> \<lceil>\<lceil>Rep_Sequence\<^sub>b\<^sub>a\<^sub>s\<^sub>e (x \<tau>)\<rceil>\<rceil> @ [y \<tau>] \<rfloor>\<rfloor> - else invalid \<tau> )" -notation OclIncluding ("_->including\<^sub>S\<^sub>e\<^sub>q'(_')") - -interpretation OclIncluding : - profile_bin\<^sub>d_\<^sub>v OclIncluding "\<lambda>x y. Abs_Sequence\<^sub>b\<^sub>a\<^sub>s\<^sub>e\<lfloor>\<lfloor>\<lceil>\<lceil>Rep_Sequence\<^sub>b\<^sub>a\<^sub>s\<^sub>e x\<rceil>\<rceil> @ [y]\<rfloor>\<rfloor>" -proof - - have A : "\<And>x y. x \<noteq> bot \<Longrightarrow> x \<noteq> null \<Longrightarrow> y \<noteq> bot \<Longrightarrow> - \<lfloor>\<lfloor>\<lceil>\<lceil>Rep_Sequence\<^sub>b\<^sub>a\<^sub>s\<^sub>e x\<rceil>\<rceil> @ [y]\<rfloor>\<rfloor> \<in> {X. X = bot \<or> X = null \<or> (\<forall>x\<in>set \<lceil>\<lceil>X\<rceil>\<rceil>. x \<noteq> bot)}" - by(auto intro!:Sequence_inv_lemma[simplified OclValid_def - defined_def false_def true_def null_fun_def bot_fun_def]) - - show "profile_bin\<^sub>d_\<^sub>v OclIncluding (\<lambda>x y. Abs_Sequence\<^sub>b\<^sub>a\<^sub>s\<^sub>e \<lfloor>\<lfloor>\<lceil>\<lceil>Rep_Sequence\<^sub>b\<^sub>a\<^sub>s\<^sub>e x\<rceil>\<rceil> @ [y]\<rfloor>\<rfloor>)" - apply unfold_locales - apply(auto simp:OclIncluding_def bot_option_def null_option_def null_Sequence\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def - bot_Sequence\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def) - apply(erule_tac Q="Abs_Sequence\<^sub>b\<^sub>a\<^sub>s\<^sub>e \<lfloor>\<lfloor>\<lceil>\<lceil>Rep_Sequence\<^sub>b\<^sub>a\<^sub>s\<^sub>e x\<rceil>\<rceil> @ [y]\<rfloor>\<rfloor> = Abs_Sequence\<^sub>b\<^sub>a\<^sub>s\<^sub>e None" - in contrapos_pp) - apply(subst Abs_Sequence\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inject [OF A]) - apply(simp_all add: null_Sequence\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def bot_Sequence\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def bot_option_def) - apply(erule_tac Q="Abs_Sequence\<^sub>b\<^sub>a\<^sub>s\<^sub>e\<lfloor>\<lfloor>\<lceil>\<lceil>Rep_Sequence\<^sub>b\<^sub>a\<^sub>s\<^sub>e x\<rceil>\<rceil> @ [y]\<rfloor>\<rfloor> = Abs_Sequence\<^sub>b\<^sub>a\<^sub>s\<^sub>e \<lfloor>None\<rfloor>" - in contrapos_pp) - apply(subst Abs_Sequence\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inject[OF A]) - apply(simp_all add: null_Sequence\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def bot_Sequence\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def bot_option_def null_option_def) - done -qed - -lemma [simp,code_unfold] : "(Sequence{}->including\<^sub>S\<^sub>e\<^sub>q(a)) = (Sequence{}->prepend\<^sub>S\<^sub>e\<^sub>q(a))" - apply(simp add: OclIncluding_def OclPrepend_def mtSequence_def) - apply(subst (1 2) Abs_Sequence\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inverse, simp) -by auto - -lemma [simp,code_unfold] : "((S->prepend\<^sub>S\<^sub>e\<^sub>q(a))->including\<^sub>S\<^sub>e\<^sub>q(b)) = ((S->including\<^sub>S\<^sub>e\<^sub>q(b))->prepend\<^sub>S\<^sub>e\<^sub>q(a))" - proof - - have A: "\<And>S b \<tau>. S \<noteq> \<bottom> \<Longrightarrow> S \<noteq> null \<Longrightarrow> b \<noteq> \<bottom> \<Longrightarrow> - \<lfloor>\<lfloor>\<lceil>\<lceil>Rep_Sequence\<^sub>b\<^sub>a\<^sub>s\<^sub>e S\<rceil>\<rceil> @ [b]\<rfloor>\<rfloor> \<in> {X. X = bot \<or> X = null \<or> (\<forall>x\<in>set \<lceil>\<lceil>X\<rceil>\<rceil>. x \<noteq> \<bottom>)}" - by(auto intro!:Sequence_inv_lemma[simplified OclValid_def - defined_def false_def true_def null_fun_def bot_fun_def]) - have B: "\<And>S a \<tau>. S \<noteq> \<bottom> \<Longrightarrow> S \<noteq> null \<Longrightarrow> a \<noteq> \<bottom> \<Longrightarrow> - \<lfloor>\<lfloor>a # \<lceil>\<lceil>Rep_Sequence\<^sub>b\<^sub>a\<^sub>s\<^sub>e S\<rceil>\<rceil>\<rfloor>\<rfloor> \<in> {X. X = bot \<or> X = null \<or> (\<forall>x\<in>set \<lceil>\<lceil>X\<rceil>\<rceil>. x \<noteq> \<bottom>)}" - by(auto intro!:Sequence_inv_lemma[simplified OclValid_def - defined_def false_def true_def null_fun_def bot_fun_def]) - show ?thesis - apply(simp add: OclIncluding_def OclPrepend_def mtSequence_def, rule ext) - apply(subst (2 5) cp_defined, simp split:) - apply(intro conjI impI) - apply(subst Abs_Sequence\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inverse[OF B], - (simp add: foundation16[simplified OclValid_def] foundation18'[simplified OclValid_def])+) - apply(subst Abs_Sequence\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inverse[OF A], - (simp add: foundation16[simplified OclValid_def] foundation18'[simplified OclValid_def])+) - apply(simp add: OclIncluding.def_body) - apply (metis OclValid_def foundation16 invalid_def) - apply (metis (no_types) OclPrepend.def_body' OclValid_def foundation16) - by (metis OclValid_def foundation16 invalid_def)+ -qed - -subsection{* Definition: Excluding *} -definition OclExcluding :: "[('\<AA>,'\<alpha>::null) Sequence,('\<AA>,'\<alpha>) val] \<Rightarrow> ('\<AA>,'\<alpha>) Sequence" -where "OclExcluding x y = (\<lambda> \<tau>. if (\<delta> x) \<tau> = true \<tau> \<and> (\<upsilon> y) \<tau> = true \<tau> - then Abs_Sequence\<^sub>b\<^sub>a\<^sub>s\<^sub>e \<lfloor>\<lfloor> filter (\<lambda>x. x = y \<tau>) - \<lceil>\<lceil>Rep_Sequence\<^sub>b\<^sub>a\<^sub>s\<^sub>e (x \<tau>)\<rceil>\<rceil>\<rfloor>\<rfloor> - else invalid \<tau> )" -notation OclExcluding ("_->excluding\<^sub>S\<^sub>e\<^sub>q'(_')") - -interpretation OclExcluding:profile_bin\<^sub>d_\<^sub>v OclExcluding - "\<lambda>x y. Abs_Sequence\<^sub>b\<^sub>a\<^sub>s\<^sub>e \<lfloor>\<lfloor> filter (\<lambda>x. x = y) \<lceil>\<lceil>Rep_Sequence\<^sub>b\<^sub>a\<^sub>s\<^sub>e (x)\<rceil>\<rceil>\<rfloor>\<rfloor>" -proof - - show "profile_bin\<^sub>d_\<^sub>v OclExcluding (\<lambda>x y. Abs_Sequence\<^sub>b\<^sub>a\<^sub>s\<^sub>e \<lfloor>\<lfloor>[x\<leftarrow>\<lceil>\<lceil>Rep_Sequence\<^sub>b\<^sub>a\<^sub>s\<^sub>e x\<rceil>\<rceil> . x = y]\<rfloor>\<rfloor>)" - apply unfold_locales - apply(auto simp:OclExcluding_def bot_option_def null_option_def - null_Sequence\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def bot_Sequence\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def) - apply(subst (asm) Abs_Sequence\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inject, - simp_all add: null_Sequence\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def bot_Sequence\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def bot_option_def null_option_def)+ - done -qed - -subsection{* Definition: Append *} -text{* Identical to OclIncluding. *} -definition OclAppend :: "[('\<AA>,'\<alpha>::null) Sequence,('\<AA>,'\<alpha>) val] \<Rightarrow> ('\<AA>,'\<alpha>) Sequence" -where "OclAppend = OclIncluding" -notation OclAppend ("_->append\<^sub>S\<^sub>e\<^sub>q'(_')") - -interpretation OclAppend : - profile_bin\<^sub>d_\<^sub>v OclAppend "\<lambda>x y. Abs_Sequence\<^sub>b\<^sub>a\<^sub>s\<^sub>e\<lfloor>\<lfloor>\<lceil>\<lceil>Rep_Sequence\<^sub>b\<^sub>a\<^sub>s\<^sub>e x\<rceil>\<rceil> @ [y]\<rfloor>\<rfloor>" - apply unfold_locales - by(auto simp: OclAppend_def bin_def bin'_def - OclIncluding.def_scheme OclIncluding.def_body) - -subsection{* Definition: Union *} -definition OclUnion :: "[('\<AA>,'\<alpha>::null) Sequence,('\<AA>,'\<alpha>) Sequence] \<Rightarrow> ('\<AA>,'\<alpha>) Sequence" -where "OclUnion x y = (\<lambda> \<tau>. if (\<delta> x) \<tau> = true \<tau> \<and> (\<delta> y) \<tau> = true \<tau> - then Abs_Sequence\<^sub>b\<^sub>a\<^sub>s\<^sub>e \<lfloor>\<lfloor> \<lceil>\<lceil>Rep_Sequence\<^sub>b\<^sub>a\<^sub>s\<^sub>e (x \<tau>)\<rceil>\<rceil> @ - \<lceil>\<lceil>Rep_Sequence\<^sub>b\<^sub>a\<^sub>s\<^sub>e (y \<tau>)\<rceil>\<rceil>\<rfloor>\<rfloor> - else invalid \<tau> )" -notation OclUnion ("_->union\<^sub>S\<^sub>e\<^sub>q'(_')") - -interpretation OclUnion : - profile_bin\<^sub>d_\<^sub>d OclUnion "\<lambda>x y. Abs_Sequence\<^sub>b\<^sub>a\<^sub>s\<^sub>e\<lfloor>\<lfloor>\<lceil>\<lceil>Rep_Sequence\<^sub>b\<^sub>a\<^sub>s\<^sub>e x\<rceil>\<rceil> @ \<lceil>\<lceil>Rep_Sequence\<^sub>b\<^sub>a\<^sub>s\<^sub>e y\<rceil>\<rceil>\<rfloor>\<rfloor>" -proof - - have A : "\<And>x y. x \<noteq> \<bottom> \<Longrightarrow> x \<noteq> null \<Longrightarrow> \<forall>x\<in>set \<lceil>\<lceil>Rep_Sequence\<^sub>b\<^sub>a\<^sub>s\<^sub>e x\<rceil>\<rceil>. x \<noteq> \<bottom> " - apply(rule Sequence_inv_lemma[of \<tau>]) - by(simp add: defined_def OclValid_def bot_fun_def null_fun_def false_def true_def) - show "profile_bin\<^sub>d_\<^sub>d OclUnion (\<lambda>x y. Abs_Sequence\<^sub>b\<^sub>a\<^sub>s\<^sub>e\<lfloor>\<lfloor>\<lceil>\<lceil>Rep_Sequence\<^sub>b\<^sub>a\<^sub>s\<^sub>e x\<rceil>\<rceil>@\<lceil>\<lceil>Rep_Sequence\<^sub>b\<^sub>a\<^sub>s\<^sub>e y\<rceil>\<rceil>\<rfloor>\<rfloor>)" - apply unfold_locales - apply(auto simp:OclUnion_def bot_option_def null_option_def - null_Sequence\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def bot_Sequence\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def) - by(subst (asm) Abs_Sequence\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inject, - simp_all add: bot_option_def null_option_def Set.ball_Un A null_Sequence\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def bot_Sequence\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def)+ -qed - -subsection{* Definition: At *} -definition OclAt :: "[('\<AA>,'\<alpha>::null) Sequence,('\<AA>) Integer] \<Rightarrow> ('\<AA>,'\<alpha>) val" -where "OclAt x y = (\<lambda> \<tau>. if (\<delta> x) \<tau> = true \<tau> \<and> (\<delta> y) \<tau> = true \<tau> - then if 1 \<le> \<lceil>\<lceil>y \<tau>\<rceil>\<rceil> \<and> \<lceil>\<lceil>y \<tau>\<rceil>\<rceil> \<le> length\<lceil>\<lceil>Rep_Sequence\<^sub>b\<^sub>a\<^sub>s\<^sub>e (x \<tau>)\<rceil>\<rceil> - then \<lceil>\<lceil>Rep_Sequence\<^sub>b\<^sub>a\<^sub>s\<^sub>e (x \<tau>)\<rceil>\<rceil> ! (nat \<lceil>\<lceil>y \<tau>\<rceil>\<rceil> - 1) - else invalid \<tau> - else invalid \<tau> )" -notation OclAt ("_->at\<^sub>S\<^sub>e\<^sub>q'(_')") -(*TODO Locale - Equivalent*) - - -subsection{* Definition: First *} -definition OclFirst :: "[('\<AA>,'\<alpha>::null) Sequence] \<Rightarrow> ('\<AA>,'\<alpha>) val" -where "OclFirst x = (\<lambda> \<tau>. if (\<delta> x) \<tau> = true \<tau> then - case \<lceil>\<lceil>Rep_Sequence\<^sub>b\<^sub>a\<^sub>s\<^sub>e (x \<tau>)\<rceil>\<rceil> of [] \<Rightarrow> invalid \<tau> - | x # _ \<Rightarrow> x - else invalid \<tau> )" -notation OclFirst ("_->first\<^sub>S\<^sub>e\<^sub>q'(_')") -(*TODO Locale - Equivalent*) - - -subsection{* Definition: Last *} -definition OclLast :: "[('\<AA>,'\<alpha>::null) Sequence] \<Rightarrow> ('\<AA>,'\<alpha>) val" -where "OclLast x = (\<lambda> \<tau>. if (\<delta> x) \<tau> = true \<tau> then - if \<lceil>\<lceil>Rep_Sequence\<^sub>b\<^sub>a\<^sub>s\<^sub>e (x \<tau>)\<rceil>\<rceil> = [] then - invalid \<tau> - else - last \<lceil>\<lceil>Rep_Sequence\<^sub>b\<^sub>a\<^sub>s\<^sub>e (x \<tau>)\<rceil>\<rceil> - else invalid \<tau> )" -notation OclLast ("_->last\<^sub>S\<^sub>e\<^sub>q'(_')") -(*TODO Locale - Equivalent*) - -subsection{* Definition: Iterate *} - -definition OclIterate :: "[('\<AA>,'\<alpha>::null) Sequence,('\<AA>,'\<beta>::null)val, - ('\<AA>,'\<alpha>)val\<Rightarrow>('\<AA>,'\<beta>)val\<Rightarrow>('\<AA>,'\<beta>)val] \<Rightarrow> ('\<AA>,'\<beta>)val" -where "OclIterate S A F = (\<lambda> \<tau>. if (\<delta> S) \<tau> = true \<tau> \<and> (\<upsilon> A) \<tau> = true \<tau> - then (foldr (F) (map (\<lambda>a \<tau>. a) \<lceil>\<lceil>Rep_Sequence\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil>))(A)\<tau> - else \<bottom>)" -syntax - "_OclIterateSeq" :: "[('\<AA>,'\<alpha>::null) Sequence, idt, idt, '\<alpha>, '\<beta>] => ('\<AA>,'\<gamma>)val" - ("_ ->iterate\<^sub>S\<^sub>e\<^sub>q'(_;_=_ | _')" (*[71,100,70]50*)) -translations - "X->iterate\<^sub>S\<^sub>e\<^sub>q(a; x = A | P)" == "CONST OclIterate X A (%a. (% x. P))" - -(*TODO Locale - Equivalent*) - - - -subsection{* Definition: Forall *} -definition OclForall :: "[('\<AA>,'\<alpha>::null) Sequence,('\<AA>,'\<alpha>)val\<Rightarrow>('\<AA>)Boolean] \<Rightarrow> '\<AA> Boolean" -where "OclForall S P = (S->iterate\<^sub>S\<^sub>e\<^sub>q(b; x = true | x and (P b)))" - -syntax - "_OclForallSeq" :: "[('\<AA>,'\<alpha>::null) Sequence,id,('\<AA>)Boolean] \<Rightarrow> '\<AA> Boolean" ("(_)->forAll\<^sub>S\<^sub>e\<^sub>q'(_|_')") -translations - "X->forAll\<^sub>S\<^sub>e\<^sub>q(x | P)" == "CONST UML_Sequence.OclForall X (%x. P)" - -(*TODO Locale - Equivalent*) - -subsection{* Definition: Exists *} -definition OclExists :: "[('\<AA>,'\<alpha>::null) Sequence,('\<AA>,'\<alpha>)val\<Rightarrow>('\<AA>)Boolean] \<Rightarrow> '\<AA> Boolean" -where "OclExists S P = (S->iterate\<^sub>S\<^sub>e\<^sub>q(b; x = false | x or (P b)))" - -syntax - "_OclExistSeq" :: "[('\<AA>,'\<alpha>::null) Sequence,id,('\<AA>)Boolean] \<Rightarrow> '\<AA> Boolean" ("(_)->exists\<^sub>S\<^sub>e\<^sub>q'(_|_')") -translations - "X->exists\<^sub>S\<^sub>e\<^sub>q(x | P)" == "CONST OclExists X (%x. P)" - -(*TODO Locale - Equivalent*) - -subsection{* Definition: Collect *} -definition OclCollect :: "[('\<AA>,'\<alpha>::null)Sequence,('\<AA>,'\<alpha>)val\<Rightarrow>('\<AA>,'\<beta>)val]\<Rightarrow>('\<AA>,'\<beta>::null)Sequence" -where "OclCollect S P = (S->iterate\<^sub>S\<^sub>e\<^sub>q(b; x = Sequence{} | x->prepend\<^sub>S\<^sub>e\<^sub>q(P b)))" - -syntax - "_OclCollectSeq" :: "[('\<AA>,'\<alpha>::null) Sequence,id,('\<AA>)Boolean] \<Rightarrow> '\<AA> Boolean" ("(_)->collect\<^sub>S\<^sub>e\<^sub>q'(_|_')") -translations - "X->collect\<^sub>S\<^sub>e\<^sub>q(x | P)" == "CONST OclCollect X (%x. P)" - -(*TODO Locale - Equivalent*) - -subsection{* Definition: Select *} -definition OclSelect :: "[('\<AA>,'\<alpha>::null)Sequence,('\<AA>,'\<alpha>)val\<Rightarrow>('\<AA>)Boolean]\<Rightarrow>('\<AA>,'\<alpha>::null)Sequence" -where "OclSelect S P = - (S->iterate\<^sub>S\<^sub>e\<^sub>q(b; x = Sequence{} | if P b then x->prepend\<^sub>S\<^sub>e\<^sub>q(b) else x endif))" - -syntax - "_OclSelectSeq" :: "[('\<AA>,'\<alpha>::null) Sequence,id,('\<AA>)Boolean] \<Rightarrow> '\<AA> Boolean" ("(_)->select\<^sub>S\<^sub>e\<^sub>q'(_|_')") -translations - "X->select\<^sub>S\<^sub>e\<^sub>q(x | P)" == "CONST UML_Sequence.OclSelect X (%x. P)" - -(*TODO Locale - Equivalent*) - -subsection{* Definition: Size *} -definition OclSize :: "[('\<AA>,'\<alpha>::null)Sequence]\<Rightarrow>('\<AA>)Integer" ("(_)->size\<^sub>S\<^sub>e\<^sub>q'(')") -where "OclSize S = (S->iterate\<^sub>S\<^sub>e\<^sub>q(b; x = \<zero> | x +\<^sub>i\<^sub>n\<^sub>t \<one> ))" - -(*TODO Locale - Equivalent*) - -subsection{* Definition: IsEmpty *} -definition OclIsEmpty :: "('\<AA>,'\<alpha>::null) Sequence \<Rightarrow> '\<AA> Boolean" -where "OclIsEmpty x = ((\<upsilon> x and not (\<delta> x)) or ((OclSize x) \<doteq> \<zero>))" -notation OclIsEmpty ("_->isEmpty\<^sub>S\<^sub>e\<^sub>q'(')" (*[66]*)) - -(*TODO Locale - Equivalent*) - -subsection{* Definition: NotEmpty *} - -definition OclNotEmpty :: "('\<AA>,'\<alpha>::null) Sequence \<Rightarrow> '\<AA> Boolean" -where "OclNotEmpty x = not(OclIsEmpty x)" -notation OclNotEmpty ("_->notEmpty\<^sub>S\<^sub>e\<^sub>q'(')" (*[66]*)) - -(*TODO Locale - Equivalent*) - -subsection{* Definition: Any *} - -(* Slight breach of naming convention in order to avoid naming conflict on constant.*) -definition OclANY :: "[('\<AA>,'\<alpha>::null) Sequence] \<Rightarrow> ('\<AA>,'\<alpha>) val" -where "OclANY x = (\<lambda> \<tau>. if (\<upsilon> x) \<tau> = true \<tau> - then if (\<delta> x and OclNotEmpty x) \<tau> = true \<tau> - then hd \<lceil>\<lceil>Rep_Sequence\<^sub>b\<^sub>a\<^sub>s\<^sub>e (x \<tau>)\<rceil>\<rceil> - else null \<tau> - else \<bottom> )" -notation OclANY ("_->any\<^sub>S\<^sub>e\<^sub>q'(')") - -(*TODO Locale - Equivalent*) - -(* actually, this definition covers only: X->any\<^sub>S\<^sub>e\<^sub>q(true) of the standard, which foresees -a (totally correct) high-level definition -source->any\<^sub>S\<^sub>e\<^sub>q(iterator | body) = -source->select(iterator | body)->asSequence()->first(). Since we don't have sequences, -we have to go for a direct---restricted---definition. *) - -subsection{* Definition (future operators) *} - -consts (* abstract set collection operations *) - OclCount :: "[('\<AA>,'\<alpha>::null) Sequence,('\<AA>,'\<alpha>) Sequence] \<Rightarrow> '\<AA> Integer" - (*OclFlatten*) - (*OclInsertAt*) - (*OclSubSequence*) - (*OclIndexOf*) - (*OclReverse*) - OclSum :: " ('\<AA>,'\<alpha>::null) Sequence \<Rightarrow> '\<AA> Integer" - -notation OclCount ("_->count\<^sub>S\<^sub>e\<^sub>q'(_')" (*[66,65]65*)) -notation OclSum ("_->sum\<^sub>S\<^sub>e\<^sub>q'(')" (*[66]*)) - -subsection{* Logical Properties *} - -subsection{* Execution Laws with Invalid or Null as Argument *} - -text{* OclIterate *} - -lemma OclIterate_invalid[simp,code_unfold]:"invalid->iterate\<^sub>S\<^sub>e\<^sub>q(a; x = A | P a x) = invalid" -by(simp add: OclIterate_def false_def true_def, simp add: invalid_def) - -lemma OclIterate_null[simp,code_unfold]:"null->iterate\<^sub>S\<^sub>e\<^sub>q(a; x = A | P a x) = invalid" -by(simp add: OclIterate_def false_def true_def, simp add: invalid_def) - -lemma OclIterate_invalid_args[simp,code_unfold]:"S->iterate\<^sub>S\<^sub>e\<^sub>q(a; x = invalid | P a x) = invalid" -by(simp add: bot_fun_def invalid_def OclIterate_def defined_def valid_def false_def true_def) - -text_raw{* \isatagafp *} - -subsubsection{* Context Passing *} - -lemma cp_OclIncluding: -"(X->including\<^sub>S\<^sub>e\<^sub>q(x)) \<tau> = ((\<lambda> _. X \<tau>)->including\<^sub>S\<^sub>e\<^sub>q(\<lambda> _. x \<tau>)) \<tau>" -by(auto simp: OclIncluding_def StrongEq_def invalid_def - cp_defined[symmetric] cp_valid[symmetric]) - -lemma cp_OclIterate: - "(X->iterate\<^sub>S\<^sub>e\<^sub>q(a; x = A | P a x)) \<tau> = - ((\<lambda> _. X \<tau>)->iterate\<^sub>S\<^sub>e\<^sub>q(a; x = A | P a x)) \<tau>" -by(simp add: OclIterate_def cp_defined[symmetric]) - -lemmas cp_intro''\<^sub>S\<^sub>e\<^sub>q[intro!,simp,code_unfold] = - cp_OclIncluding [THEN allI[THEN allI[THEN allI[THEN cpI2]], of "OclIncluding"]] - -subsubsection{* Const *} - -text_raw{* \endisatagafp *} - -subsection{* General Algebraic Execution Rules *} -subsubsection{* Execution Rules on Iterate *} - -lemma OclIterate_empty[simp,code_unfold]:"Sequence{}->iterate\<^sub>S\<^sub>e\<^sub>q(a; x = A | P a x) = A" -apply(simp add: OclIterate_def foundation22[symmetric] foundation13, - rule ext, rename_tac "\<tau>") -apply(case_tac "\<tau> \<Turnstile> \<upsilon> A", simp_all add: foundation18') -apply(simp add: mtSequence_def) -apply(subst Abs_Sequence\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inverse) by auto - -text{* In particular, this does hold for A = null. *} - -lemma OclIterate_including[simp,code_unfold]: -assumes strict1 : "\<And>X. P invalid X = invalid" -and P_valid_arg: "\<And> \<tau>. (\<upsilon> A) \<tau> = (\<upsilon> (P a A)) \<tau>" -and P_cp : "\<And> x y \<tau>. P x y \<tau> = P (\<lambda> _. x \<tau>) y \<tau>" -and P_cp' : "\<And> x y \<tau>. P x y \<tau> = P x (\<lambda> _. y \<tau>) \<tau>" -shows "(S->including\<^sub>S\<^sub>e\<^sub>q(a))->iterate\<^sub>S\<^sub>e\<^sub>q(b; x = A | P b x) = S->iterate\<^sub>S\<^sub>e\<^sub>q(b; x = P a A| P b x)" - apply(rule ext) -proof - - have A: "\<And>S b \<tau>. S \<noteq> \<bottom> \<Longrightarrow> S \<noteq> null \<Longrightarrow> b \<noteq> \<bottom> \<Longrightarrow> - \<lfloor>\<lfloor>\<lceil>\<lceil>Rep_Sequence\<^sub>b\<^sub>a\<^sub>s\<^sub>e S\<rceil>\<rceil> @ [b]\<rfloor>\<rfloor> \<in> {X. X = bot \<or> X = null \<or> (\<forall>x\<in>set \<lceil>\<lceil>X\<rceil>\<rceil>. x \<noteq> \<bottom>)}" - by(auto intro!:Sequence_inv_lemma[simplified OclValid_def - defined_def false_def true_def null_fun_def bot_fun_def]) - have P: "\<And>l A A' \<tau>. A \<tau> = A' \<tau> \<Longrightarrow> foldr P l A \<tau> = foldr P l A' \<tau>" - apply(rule list.induct, simp, simp) - by(subst (1 2) P_cp', simp) - - fix \<tau> - show "OclIterate (S->including\<^sub>S\<^sub>e\<^sub>q(a)) A P \<tau> = OclIterate S (P a A) P \<tau>" - apply(subst cp_OclIterate, subst OclIncluding_def, simp split:) - apply(intro conjI impI) - - apply(simp add: OclIterate_def) - apply(intro conjI impI) - apply(subst Abs_Sequence\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inverse[OF A], - (simp add: foundation16[simplified OclValid_def] foundation18'[simplified OclValid_def])+) - apply(rule P, metis P_cp) - apply (metis P_valid_arg) - apply(simp add: P_valid_arg[symmetric]) - apply (metis (lifting, no_types) OclIncluding.def_body' OclValid_def foundation16) - apply(simp add: OclIterate_def defined_def invalid_def bot_option_def bot_fun_def false_def true_def) - apply(intro impI, simp add: false_def true_def P_valid_arg) - by (metis P_cp P_valid_arg UML_Types.bot_fun_def cp_valid invalid_def strict1 true_def valid1 valid_def) -qed - -lemma OclIterate_prepend[simp,code_unfold]: -assumes strict1 : "\<And>X. P invalid X = invalid" -and strict2 : "\<And>X. P X invalid = invalid" -and P_cp : "\<And> x y \<tau>. P x y \<tau> = P (\<lambda> _. x \<tau>) y \<tau>" -and P_cp' : "\<And> x y \<tau>. P x y \<tau> = P x (\<lambda> _. y \<tau>) \<tau>" -shows "(S->prepend\<^sub>S\<^sub>e\<^sub>q(a))->iterate\<^sub>S\<^sub>e\<^sub>q(b; x = A | P b x) = P a (S->iterate\<^sub>S\<^sub>e\<^sub>q(b; x = A| P b x))" - apply(rule ext) -proof - - have B: "\<And>S a \<tau>. S \<noteq> \<bottom> \<Longrightarrow> S \<noteq> null \<Longrightarrow> a \<noteq> \<bottom> \<Longrightarrow> - \<lfloor>\<lfloor>a # \<lceil>\<lceil>Rep_Sequence\<^sub>b\<^sub>a\<^sub>s\<^sub>e S\<rceil>\<rceil>\<rfloor>\<rfloor> \<in> {X. X = bot \<or> X = null \<or> (\<forall>x\<in>set \<lceil>\<lceil>X\<rceil>\<rceil>. x \<noteq> \<bottom>)}" - by(auto intro!:Sequence_inv_lemma[simplified OclValid_def - defined_def false_def true_def null_fun_def bot_fun_def]) - fix \<tau> - show "OclIterate (S->prepend\<^sub>S\<^sub>e\<^sub>q(a)) A P \<tau> = P a (OclIterate S A P) \<tau>" - apply(subst cp_OclIterate, subst OclPrepend_def, simp split:) - apply(intro conjI impI) - - apply(subst P_cp') - apply(simp add: OclIterate_def) - apply(intro conjI impI) - apply(subst Abs_Sequence\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inverse[OF B], - (simp add: foundation16[simplified OclValid_def] foundation18'[simplified OclValid_def])+) - apply(simp add: P_cp'[symmetric]) - apply(subst P_cp, simp add: P_cp[symmetric]) - apply (metis (no_types) OclPrepend.def_body' OclValid_def foundation16) - apply (metis P_cp' invalid_def strict2 valid_def) - - apply(subst P_cp', - simp add: OclIterate_def defined_def invalid_def bot_option_def bot_fun_def false_def true_def, - intro conjI impI) - apply (metis P_cp' invalid_def strict2 valid_def) - apply (metis P_cp' invalid_def strict2 valid_def) - apply (metis (no_types) P_cp invalid_def strict1 true_def valid1 valid_def) - apply (metis P_cp' invalid_def strict2 valid_def) - done -qed - -subsubsection{* Execution Rules on Size *} - -lemma [simp,code_unfold]: "Sequence{} ->size\<^sub>S\<^sub>e\<^sub>q() = \<zero>" -by(simp add: OclSize_def) - -subsubsection{* Execution Rules on IsEmpty *} - -lemma [simp,code_unfold]: "Sequence{}->isEmpty\<^sub>S\<^sub>e\<^sub>q() = true" -by(simp add: OclIsEmpty_def) - -subsubsection{* Execution Rules on NotEmpty *} - -lemma [simp,code_unfold]: "Sequence{}->notEmpty\<^sub>S\<^sub>e\<^sub>q() = false" -by(simp add: OclNotEmpty_def) - -subsubsection{* Execution Rules on Any *} - -lemma [simp,code_unfold]: "Sequence{}->any\<^sub>S\<^sub>e\<^sub>q() = null" -by(rule ext, simp add: OclANY_def, simp add: false_def true_def) - -(* < *) - -subsection{* Test Statements *} -(* -Assert "(\<tau> \<Turnstile> (Sequence{\<lambda>_. \<lfloor>\<lfloor>x\<rfloor>\<rfloor>} \<doteq> Sequence{\<lambda>_. \<lfloor>\<lfloor>x\<rfloor>\<rfloor>}))" -Assert "(\<tau> \<Turnstile> (Sequence{\<lambda>_. \<lfloor>x\<rfloor>} \<doteq> Sequence{\<lambda>_. \<lfloor>x\<rfloor>}))" -*) -(* (*TODO.*) -open problem: An executable code-generator setup for the Sequence type. Some bits and pieces -so far : -instantiation int :: equal -begin - -definition - "HOL.equal k l \<longleftrightarrow> k = (l::int)" - -instance by default (rule equal_int_def) - -end - -lemma equal_int_code [code]: - "HOL.equal 0 (0::int) \<longleftrightarrow> True" - "HOL.equal 0 (Pos l) \<longleftrightarrow> False" - "HOL.equal 0 (Neg l) \<longleftrightarrow> False" - "HOL.equal (Pos k) 0 \<longleftrightarrow> False" - "HOL.equal (Pos k) (Pos l) \<longleftrightarrow> HOL.equal k l" - "HOL.equal (Pos k) (Neg l) \<longleftrightarrow> False" - "HOL.equal (Neg k) 0 \<longleftrightarrow> False" - "HOL.equal (Neg k) (Pos l) \<longleftrightarrow> False" - "HOL.equal (Neg k) (Neg l) \<longleftrightarrow> HOL.equal k l" - by (auto simp add: equal) -*) - - -instantiation Sequence\<^sub>b\<^sub>a\<^sub>s\<^sub>e :: (equal)equal -begin - definition "HOL.equal k l \<longleftrightarrow> (k::('a::equal)Sequence\<^sub>b\<^sub>a\<^sub>s\<^sub>e) = l" - instance by standard (rule equal_Sequence\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def) -end - -lemma equal_Sequence\<^sub>b\<^sub>a\<^sub>s\<^sub>e_code [code]: - "HOL.equal k (l::('a::{equal,null})Sequence\<^sub>b\<^sub>a\<^sub>s\<^sub>e) \<longleftrightarrow> Rep_Sequence\<^sub>b\<^sub>a\<^sub>s\<^sub>e k = Rep_Sequence\<^sub>b\<^sub>a\<^sub>s\<^sub>e l" - by (auto simp add: equal Sequence\<^sub>b\<^sub>a\<^sub>s\<^sub>e.Rep_Sequence\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inject) - -Assert "\<tau> \<Turnstile> (Sequence{} \<doteq> Sequence{})" -Assert "\<tau> \<Turnstile> (Sequence{\<one>,\<two>} \<triangleq> Sequence{}->prepend\<^sub>S\<^sub>e\<^sub>q(\<two>)->prepend\<^sub>S\<^sub>e\<^sub>q(\<one>))" -Assert "\<tau> \<Turnstile> (Sequence{\<one>,invalid,\<two>} \<triangleq> invalid)" -Assert "\<tau> \<Turnstile> (Sequence{\<one>,\<two>}->prepend\<^sub>S\<^sub>e\<^sub>q(null) \<triangleq> Sequence{null,\<one>,\<two>})" -Assert "\<tau> \<Turnstile> (Sequence{\<one>,\<two>}->including\<^sub>S\<^sub>e\<^sub>q(null) \<triangleq> Sequence{\<one>,\<two>,null})" - -(* TODO Frederic ?: -Assert "\<not> (\<tau> \<Turnstile> (Sequence{\<one>,\<one>,\<two>} \<doteq> Sequence{\<one>,\<two>}))" -Assert "\<not> (\<tau> \<Turnstile> (Sequence{\<one>,\<two>} \<doteq> Sequence{\<two>,\<one>}))" -*) - -(* > *) - -end diff --git a/Citadelle/src/collection_types/UML_Set.thy b/Citadelle/src/collection_types/UML_Set.thy deleted file mode 100644 index ee0784eecee306e5606dc530f5d033ece4f790e1..0000000000000000000000000000000000000000 --- a/Citadelle/src/collection_types/UML_Set.thy +++ /dev/null @@ -1,3304 +0,0 @@ -(****************************************************************************** - * 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_Set -imports "../basic_types/UML_Void" - "../basic_types/UML_Boolean" - "../basic_types/UML_Integer" - "../basic_types/UML_String" - "../basic_types/UML_Real" -begin - -no_notation None ("\<bottom>") -section{* Collection Type Set: Operations \label{formal-set}*} - -subsection{* As a Motivation for the (infinite) Type Construction: Type-Extensions as Sets - \label{sec:set-type-extensions}*} - -text{* Our notion of typed set goes beyond the usual notion of a finite executable set and -is powerful enough to capture \emph{the extension of a type} in UML and OCL. This means -we can have in Featherweight OCL Sets containing all possible elements of a type, not only -those (finite) ones representable in a state. This holds for base types as well as class types, -although the notion for class-types --- involving object id's not occurring in a state --- -requires some care. - -In a world with @{term invalid} and @{term null}, there are two notions extensions possible: -\begin{enumerate} -\item the set of all \emph{defined} values of a type @{term T} - (for which we will introduce the constant @{term T}) -\item the set of all \emph{valid} values of a type @{term T}, so including @{term null} - (for which we will introduce the constant @{term T\<^sub>n\<^sub>u\<^sub>l\<^sub>l}). -\end{enumerate} -*} - -text{* We define the set extensions for the base type @{term Integer} as follows: *} -definition Integer :: "('\<AA>,Integer\<^sub>b\<^sub>a\<^sub>s\<^sub>e) Set" -where "Integer \<equiv> (\<lambda> \<tau>. (Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e o Some o Some) ((Some o Some) ` (UNIV::int set)))" - -definition Integer\<^sub>n\<^sub>u\<^sub>l\<^sub>l :: "('\<AA>,Integer\<^sub>b\<^sub>a\<^sub>s\<^sub>e) Set" -where "Integer\<^sub>n\<^sub>u\<^sub>l\<^sub>l \<equiv> (\<lambda> \<tau>. (Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e o Some o Some) (Some ` (UNIV::int option set)))" - -lemma Integer_defined : "\<delta> Integer = true" -apply(rule ext, auto simp: Integer_def defined_def false_def true_def - bot_fun_def null_fun_def null_option_def) -by(simp_all add: Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inject bot_option_def bot_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def null_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def null_option_def) - -lemma Integer\<^sub>n\<^sub>u\<^sub>l\<^sub>l_defined : "\<delta> Integer\<^sub>n\<^sub>u\<^sub>l\<^sub>l = true" -apply(rule ext, auto simp: Integer\<^sub>n\<^sub>u\<^sub>l\<^sub>l_def defined_def false_def true_def - bot_fun_def null_fun_def null_option_def) -by(simp_all add: Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inject bot_option_def bot_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def null_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def null_option_def) - -text{* This allows the theorems: - - @{text "\<tau> \<Turnstile> \<delta> x \<Longrightarrow> \<tau> \<Turnstile> (Integer->includes\<^sub>S\<^sub>e\<^sub>t(x))"} - @{text "\<tau> \<Turnstile> \<delta> x \<Longrightarrow> \<tau> \<Turnstile> Integer \<triangleq> (Integer->including\<^sub>S\<^sub>e\<^sub>t(x))"} - -and - - @{text "\<tau> \<Turnstile> \<upsilon> x \<Longrightarrow> \<tau> \<Turnstile> (Integer\<^sub>n\<^sub>u\<^sub>l\<^sub>l->includes\<^sub>S\<^sub>e\<^sub>t(x))"} - @{text "\<tau> \<Turnstile> \<upsilon> x \<Longrightarrow> \<tau> \<Turnstile> Integer\<^sub>n\<^sub>u\<^sub>l\<^sub>l \<triangleq> (Integer\<^sub>n\<^sub>u\<^sub>l\<^sub>l->including\<^sub>S\<^sub>e\<^sub>t(x))"} - -which characterize the infiniteness of these sets by a recursive property on these sets. -*} - -text{* In the same spirit, we proceed similarly for the remaining base types: *} - -definition Void\<^sub>n\<^sub>u\<^sub>l\<^sub>l :: "('\<AA>,Void\<^sub>b\<^sub>a\<^sub>s\<^sub>e) Set" -where "Void\<^sub>n\<^sub>u\<^sub>l\<^sub>l \<equiv> (\<lambda> \<tau>. (Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e o Some o Some) {Abs_Void\<^sub>b\<^sub>a\<^sub>s\<^sub>e (Some None)})" - -definition Void\<^sub>e\<^sub>m\<^sub>p\<^sub>t\<^sub>y :: "('\<AA>,Void\<^sub>b\<^sub>a\<^sub>s\<^sub>e) Set" -where "Void\<^sub>e\<^sub>m\<^sub>p\<^sub>t\<^sub>y \<equiv> (\<lambda> \<tau>. (Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e o Some o Some) {})" - -lemma Void\<^sub>n\<^sub>u\<^sub>l\<^sub>l_defined : "\<delta> Void\<^sub>n\<^sub>u\<^sub>l\<^sub>l = true" -apply(rule ext, auto simp: Void\<^sub>n\<^sub>u\<^sub>l\<^sub>l_def defined_def false_def true_def - bot_fun_def null_fun_def null_option_def - bot_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def null_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def) -by((subst (asm) Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inject, auto simp add: bot_option_def null_option_def bot_Void_def), - (subst (asm) Abs_Void\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inject, auto simp add: bot_option_def null_option_def))+ - -lemma Void\<^sub>e\<^sub>m\<^sub>p\<^sub>t\<^sub>y_defined : "\<delta> Void\<^sub>e\<^sub>m\<^sub>p\<^sub>t\<^sub>y = true" -apply(rule ext, auto simp: Void\<^sub>e\<^sub>m\<^sub>p\<^sub>t\<^sub>y_def defined_def false_def true_def - bot_fun_def null_fun_def null_option_def - bot_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def null_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def) -by((subst (asm) Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inject, auto simp add: bot_option_def null_option_def bot_Void_def))+ - -lemma assumes "\<tau> \<Turnstile> \<delta> (V :: ('\<AA>,Void\<^sub>b\<^sub>a\<^sub>s\<^sub>e) Set)" - shows "\<tau> \<Turnstile> V \<triangleq> Void\<^sub>n\<^sub>u\<^sub>l\<^sub>l \<or> \<tau> \<Turnstile> V \<triangleq> Void\<^sub>e\<^sub>m\<^sub>p\<^sub>t\<^sub>y" -proof - - have A:"\<And>x y. x \<noteq> {} \<Longrightarrow> \<exists>y. y\<in> x" - by (metis all_not_in_conv) -show "?thesis" - apply(case_tac "V \<tau>") - proof - fix y show "V \<tau> = Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e y \<Longrightarrow> - y \<in> {X. X = \<bottom> \<or> X = null \<or> (\<forall>x\<in>\<lceil>\<lceil>X\<rceil>\<rceil>. x \<noteq> \<bottom>)} \<Longrightarrow> - \<tau> \<Turnstile> V \<triangleq> Void\<^sub>n\<^sub>u\<^sub>l\<^sub>l \<or> \<tau> \<Turnstile> V \<triangleq> Void\<^sub>e\<^sub>m\<^sub>p\<^sub>t\<^sub>y" - apply(insert assms, case_tac y, simp add: bot_option_def, simp add: bot_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def foundation16) - apply(simp add: bot_option_def null_option_def) - apply(erule disjE, metis OclValid_def defined_def foundation2 null_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def null_fun_def true_def) - proof - fix a show "V \<tau> = Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e \<lfloor>a\<rfloor> \<Longrightarrow> \<forall>x\<in>\<lceil>a\<rceil>. x \<noteq> \<bottom> \<Longrightarrow> \<tau> \<Turnstile> V \<triangleq> Void\<^sub>n\<^sub>u\<^sub>l\<^sub>l \<or> \<tau> \<Turnstile> V \<triangleq> Void\<^sub>e\<^sub>m\<^sub>p\<^sub>t\<^sub>y" - apply(case_tac a, simp, insert assms, metis OclValid_def foundation16 null_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def true_def) - apply(simp) - proof - fix aa show " V \<tau> = Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e \<lfloor>\<lfloor>aa\<rfloor>\<rfloor> \<Longrightarrow> \<forall>x\<in>aa. x \<noteq> \<bottom> \<Longrightarrow> \<tau> \<Turnstile> V \<triangleq> Void\<^sub>n\<^sub>u\<^sub>l\<^sub>l \<or> \<tau> \<Turnstile> V \<triangleq> Void\<^sub>e\<^sub>m\<^sub>p\<^sub>t\<^sub>y" - apply(case_tac "aa = {}", - rule disjI2, - insert assms, - simp add: Void\<^sub>e\<^sub>m\<^sub>p\<^sub>t\<^sub>y_def OclValid_def StrongEq_def true_def, - rule disjI1) - apply(subgoal_tac "aa = {Abs_Void\<^sub>b\<^sub>a\<^sub>s\<^sub>e \<lfloor>None\<rfloor>}", simp add: StrongEq_def OclValid_def true_def Void\<^sub>n\<^sub>u\<^sub>l\<^sub>l_def) - apply(drule A, erule exE) - proof - fix y show "V \<tau> = Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e \<lfloor>\<lfloor>aa\<rfloor>\<rfloor> \<Longrightarrow> - \<forall>x\<in>aa. x \<noteq> \<bottom> \<Longrightarrow> - \<tau> \<Turnstile> \<delta> V \<Longrightarrow> - y \<in> aa \<Longrightarrow> - aa = {Abs_Void\<^sub>b\<^sub>a\<^sub>s\<^sub>e \<lfloor>None\<rfloor>}" - apply(rule equalityI, rule subsetI, simp) - proof - fix x show " V \<tau> = Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e \<lfloor>\<lfloor>aa\<rfloor>\<rfloor> \<Longrightarrow> - \<forall>x\<in>aa. x \<noteq> \<bottom> \<Longrightarrow> \<tau> \<Turnstile> \<delta> V \<Longrightarrow> y \<in> aa \<Longrightarrow> x \<in> aa \<Longrightarrow> x = Abs_Void\<^sub>b\<^sub>a\<^sub>s\<^sub>e \<lfloor>None\<rfloor>" - apply(case_tac x, simp) - by (metis bot_Void_def bot_option_def null_option_def) - apply_end(simp_all) - - apply_end(erule ballE[where x = y], simp_all) - apply_end(case_tac y, - simp add: bot_option_def null_option_def OclValid_def defined_def split: if_split_asm, - simp add: false_def true_def) - qed (erule disjE, simp add: bot_Void_def, simp) -qed qed qed qed qed - -definition Boolean :: "('\<AA>,Boolean\<^sub>b\<^sub>a\<^sub>s\<^sub>e) Set" -where "Boolean \<equiv> (\<lambda> \<tau>. (Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e o Some o Some) ((Some o Some) ` (UNIV::bool set)))" - -definition Boolean\<^sub>n\<^sub>u\<^sub>l\<^sub>l :: "('\<AA>,Boolean\<^sub>b\<^sub>a\<^sub>s\<^sub>e) Set" -where "Boolean\<^sub>n\<^sub>u\<^sub>l\<^sub>l \<equiv> (\<lambda> \<tau>. (Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e o Some o Some) (Some ` (UNIV::bool option set)))" - -lemma Boolean_defined : "\<delta> Boolean = true" -apply(rule ext, auto simp: Boolean_def defined_def false_def true_def - bot_fun_def null_fun_def null_option_def) -by(simp_all add: Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inject bot_option_def bot_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def null_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def null_option_def) - -lemma Boolean\<^sub>n\<^sub>u\<^sub>l\<^sub>l_defined : "\<delta> Boolean\<^sub>n\<^sub>u\<^sub>l\<^sub>l = true" -apply(rule ext, auto simp: Boolean\<^sub>n\<^sub>u\<^sub>l\<^sub>l_def defined_def false_def true_def - bot_fun_def null_fun_def null_option_def) -by(simp_all add: Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inject bot_option_def bot_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def null_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def null_option_def) - -definition String :: "('\<AA>,String\<^sub>b\<^sub>a\<^sub>s\<^sub>e) Set" -where "String \<equiv> (\<lambda> \<tau>. (Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e o Some o Some) ((Some o Some) ` (UNIV::string set)))" - -definition String\<^sub>n\<^sub>u\<^sub>l\<^sub>l :: "('\<AA>,String\<^sub>b\<^sub>a\<^sub>s\<^sub>e) Set" -where "String\<^sub>n\<^sub>u\<^sub>l\<^sub>l \<equiv> (\<lambda> \<tau>. (Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e o Some o Some) (Some ` (UNIV::string option set)))" - -lemma String_defined : "\<delta> String = true" -apply(rule ext, auto simp: String_def defined_def false_def true_def - bot_fun_def null_fun_def null_option_def) -by(simp_all add: Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inject bot_option_def bot_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def null_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def null_option_def) - -lemma String\<^sub>n\<^sub>u\<^sub>l\<^sub>l_defined : "\<delta> String\<^sub>n\<^sub>u\<^sub>l\<^sub>l = true" -apply(rule ext, auto simp: String\<^sub>n\<^sub>u\<^sub>l\<^sub>l_def defined_def false_def true_def - bot_fun_def null_fun_def null_option_def) -by(simp_all add: Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inject bot_option_def bot_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def null_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def null_option_def) - -definition Real :: "('\<AA>,Real\<^sub>b\<^sub>a\<^sub>s\<^sub>e) Set" -where "Real \<equiv> (\<lambda> \<tau>. (Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e o Some o Some) ((Some o Some) ` (UNIV::real set)))" - -definition Real\<^sub>n\<^sub>u\<^sub>l\<^sub>l :: "('\<AA>,Real\<^sub>b\<^sub>a\<^sub>s\<^sub>e) Set" -where "Real\<^sub>n\<^sub>u\<^sub>l\<^sub>l \<equiv> (\<lambda> \<tau>. (Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e o Some o Some) (Some ` (UNIV::real option set)))" - -lemma Real_defined : "\<delta> Real = true" -apply(rule ext, auto simp: Real_def defined_def false_def true_def - bot_fun_def null_fun_def null_option_def) -by(simp_all add: Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inject bot_option_def bot_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def null_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def null_option_def) - -lemma Real\<^sub>n\<^sub>u\<^sub>l\<^sub>l_defined : "\<delta> Real\<^sub>n\<^sub>u\<^sub>l\<^sub>l = true" -apply(rule ext, auto simp: Real\<^sub>n\<^sub>u\<^sub>l\<^sub>l_def defined_def false_def true_def - bot_fun_def null_fun_def null_option_def) -by(simp_all add: Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inject bot_option_def bot_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def null_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def null_option_def) - -subsection{* Basic Properties of the Set Type*} - -text{* Every element in a defined set is valid. *} - -lemma Set_inv_lemma: "\<tau> \<Turnstile> (\<delta> X) \<Longrightarrow> \<forall>x\<in>\<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (X \<tau>)\<rceil>\<rceil>. x \<noteq> bot" -apply(insert Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e [of "X \<tau>"], simp) -apply(auto simp: OclValid_def defined_def false_def true_def cp_def - bot_fun_def bot_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def null_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def null_fun_def - split:if_split_asm) - apply(erule contrapos_pp [of "Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (X \<tau>) = bot"]) - apply(subst Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inject[symmetric], rule Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e, simp) - apply(simp add: Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inverse bot_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def bot_option_def) -apply(erule contrapos_pp [of "Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (X \<tau>) = null"]) -apply(subst Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inject[symmetric], rule Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e, simp) -apply(simp add: Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inverse null_option_def) -by (simp add: bot_option_def) - -lemma Set_inv_lemma' : - assumes x_def : "\<tau> \<Turnstile> \<delta> X" - and e_mem : "e \<in> \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (X \<tau>)\<rceil>\<rceil>" - shows "\<tau> \<Turnstile> \<upsilon> (\<lambda>_. e)" - apply(rule Set_inv_lemma[OF x_def, THEN ballE[where x = e]]) - apply(simp add: foundation18') -by(simp add: e_mem) - -lemma abs_rep_simp' : - assumes S_all_def : "\<tau> \<Turnstile> \<delta> S" - shows "Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e \<lfloor>\<lfloor>\<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil>\<rfloor>\<rfloor> = S \<tau>" -proof - - have discr_eq_false_true : "\<And>\<tau>. (false \<tau> = true \<tau>) = False" by(simp add: false_def true_def) - show ?thesis - apply(insert S_all_def, simp add: OclValid_def defined_def) - apply(rule mp[OF Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_induct[where P = "\<lambda>S. (if S = \<bottom> \<tau> \<or> S = null \<tau> - then false \<tau> else true \<tau>) = true \<tau> \<longrightarrow> - Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e \<lfloor>\<lfloor>\<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e S\<rceil>\<rceil>\<rfloor>\<rfloor> = S"]], - rename_tac S') - apply(simp add: Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inverse discr_eq_false_true) - apply(case_tac S') apply(simp add: bot_fun_def bot_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def)+ - apply(rename_tac S'', case_tac S'') apply(simp add: null_fun_def null_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def)+ - done -qed - -lemma S_lift' : - assumes S_all_def : "(\<tau> :: '\<AA> st) \<Turnstile> \<delta> S" - shows "\<exists>S'. (\<lambda>a (_::'\<AA> st). a) ` \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil> = (\<lambda>a (_::'\<AA> st). \<lfloor>a\<rfloor>) ` S'" - apply(rule_tac x = "(\<lambda>a. \<lceil>a\<rceil>) ` \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil>" in exI) - apply(simp only: image_comp) - apply(simp add: comp_def) - apply(rule image_cong, fast) - (* *) - apply(drule Set_inv_lemma'[OF S_all_def]) -by(case_tac x, (simp add: bot_option_def foundation18')+) - -lemma invalid_set_OclNot_defined [simp,code_unfold]:"\<delta>(invalid::('\<AA>,'\<alpha>::null) Set) = false" by simp -lemma null_set_OclNot_defined [simp,code_unfold]:"\<delta>(null::('\<AA>,'\<alpha>::null) Set) = false" -by(simp add: defined_def null_fun_def) -lemma invalid_set_valid [simp,code_unfold]:"\<upsilon>(invalid::('\<AA>,'\<alpha>::null) Set) = false" -by simp -lemma null_set_valid [simp,code_unfold]:"\<upsilon>(null::('\<AA>,'\<alpha>::null) Set) = true" -apply(simp add: valid_def null_fun_def bot_fun_def bot_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def null_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def) -apply(subst Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inject,simp_all add: null_option_def bot_option_def) -done - -text{* ... which means that we can have a type @{text "('\<AA>,('\<AA>,('\<AA>) Integer) Set) Set"} -corresponding exactly to Set(Set(Integer)) in OCL notation. Note that the parameter -@{text "'\<AA>"} still refers to the object universe; making the OCL semantics entirely parametric -in the object universe makes it possible to study (and prove) its properties -independently from a concrete class diagram. *} - -subsection{* Definition: Strict Equality \label{sec:set-strict-equality}*} - -text{* After the part of foundational operations on sets, we detail here equality on sets. -Strong equality is inherited from the OCL core, but we have to consider -the case of the strict equality. We decide to overload strict equality in the -same way we do for other value's in OCL:*} - -overloading - StrictRefEq \<equiv> "StrictRefEq :: [('\<AA>,'\<alpha>::null)Set,('\<AA>,'\<alpha>::null)Set] \<Rightarrow> ('\<AA>)Boolean" -begin - definition StrictRefEq\<^sub>S\<^sub>e\<^sub>t : - "(x::('\<AA>,'\<alpha>::null)Set) \<doteq> y \<equiv> \<lambda> \<tau>. if (\<upsilon> x) \<tau> = true \<tau> \<and> (\<upsilon> y) \<tau> = true \<tau> - then (x \<triangleq> y)\<tau> - else invalid \<tau>" -end - -text{* One might object here that for the case of objects, this is an empty definition. -The answer is no, we will restrain later on states and objects such that any object -has its oid stored inside the object (so the ref, under which an object can be referenced -in the store will represented in the object itself). For such well-formed stores that satisfy -this invariant (the WFF-invariant), the referential equality and the -strong equality---and therefore the strict equality on sets in the sense above---coincides.*} - -text{* Property proof in terms of @{term "profile_bin\<^sub>S\<^sub>t\<^sub>r\<^sub>o\<^sub>n\<^sub>g\<^sub>E\<^sub>q_\<^sub>v_\<^sub>v"}*} -interpretation StrictRefEq\<^sub>S\<^sub>e\<^sub>t : profile_bin\<^sub>S\<^sub>t\<^sub>r\<^sub>o\<^sub>n\<^sub>g\<^sub>E\<^sub>q_\<^sub>v_\<^sub>v "\<lambda> x y. (x::('\<AA>,'\<alpha>::null)Set) \<doteq> y" - by unfold_locales (auto simp: StrictRefEq\<^sub>S\<^sub>e\<^sub>t) - - - -subsection{* Constants: mtSet *} -definition mtSet::"('\<AA>,'\<alpha>::null) Set" ("Set{}") -where "Set{} \<equiv> (\<lambda> \<tau>. Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e \<lfloor>\<lfloor>{}::'\<alpha> set\<rfloor>\<rfloor> )" - - -lemma mtSet_defined[simp,code_unfold]:"\<delta>(Set{}) = true" -apply(rule ext, auto simp: mtSet_def defined_def null_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def - bot_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def bot_fun_def null_fun_def) -by(simp_all add: Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inject bot_option_def null_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def null_option_def) - -lemma mtSet_valid[simp,code_unfold]:"\<upsilon>(Set{}) = true" -apply(rule ext,auto simp: mtSet_def valid_def null_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def - bot_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def bot_fun_def null_fun_def) -by(simp_all add: Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inject bot_option_def null_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def null_option_def) - -lemma mtSet_rep_set: "\<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (Set{} \<tau>)\<rceil>\<rceil> = {}" - apply(simp add: mtSet_def, subst Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inverse) -by(simp add: bot_option_def)+ - -lemma [simp,code_unfold]: "const Set{}" -by(simp add: const_def mtSet_def) - - -text{* Note that the collection types in OCL allow for null to be included; - however, there is the null-collection into which inclusion yields invalid. *} - -subsection{* Definition: Including *} - -definition OclIncluding :: "[('\<AA>,'\<alpha>::null) Set,('\<AA>,'\<alpha>) val] \<Rightarrow> ('\<AA>,'\<alpha>) Set" -where "OclIncluding x y = (\<lambda> \<tau>. if (\<delta> x) \<tau> = true \<tau> \<and> (\<upsilon> y) \<tau> = true \<tau> - then Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e \<lfloor>\<lfloor> \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (x \<tau>)\<rceil>\<rceil> \<union> {y \<tau>} \<rfloor>\<rfloor> - else invalid \<tau> )" -notation OclIncluding ("_->including\<^sub>S\<^sub>e\<^sub>t'(_')") - -interpretation OclIncluding : profile_bin\<^sub>d_\<^sub>v OclIncluding "\<lambda>x y. Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e\<lfloor>\<lfloor>\<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e x\<rceil>\<rceil> \<union> {y}\<rfloor>\<rfloor>" -proof - - have A : "None \<in> {X. X = bot \<or> X = null \<or> (\<forall>x\<in>\<lceil>\<lceil>X\<rceil>\<rceil>. x \<noteq> bot)}" by(simp add: bot_option_def) - have B : "\<lfloor>None\<rfloor> \<in> {X. X = bot \<or> X = null \<or> (\<forall>x\<in>\<lceil>\<lceil>X\<rceil>\<rceil>. x \<noteq> bot)}" - by(simp add: null_option_def bot_option_def) - have C : "\<And>x y. x \<noteq> \<bottom> \<Longrightarrow> x \<noteq> null \<Longrightarrow> y \<noteq> \<bottom> \<Longrightarrow> - \<lfloor>\<lfloor>insert y \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e x\<rceil>\<rceil>\<rfloor>\<rfloor> \<in> {X. X = bot \<or> X = null \<or> (\<forall>x\<in>\<lceil>\<lceil>X\<rceil>\<rceil>. x \<noteq> bot)}" - by(auto intro!:Set_inv_lemma[simplified OclValid_def - defined_def false_def true_def null_fun_def bot_fun_def]) - show "profile_bin\<^sub>d_\<^sub>v OclIncluding (\<lambda>x y. Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e\<lfloor>\<lfloor>\<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e x\<rceil>\<rceil> \<union> {y}\<rfloor>\<rfloor>)" - apply unfold_locales - apply(auto simp:OclIncluding_def bot_option_def null_option_def null_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def bot_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def) - apply(erule_tac Q="Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e\<lfloor>\<lfloor>insert y \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e x\<rceil>\<rceil>\<rfloor>\<rfloor> = Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e None" in contrapos_pp) - apply(subst Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inject[OF C A]) - apply(simp_all add: null_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def bot_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def bot_option_def) - apply(erule_tac Q="Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e\<lfloor>\<lfloor>insert y \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e x\<rceil>\<rceil>\<rfloor>\<rfloor> = Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e \<lfloor>None\<rfloor>" in contrapos_pp) - apply(subst Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inject[OF C B]) - apply(simp_all add: null_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def bot_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def bot_option_def) - done -qed - -syntax - "_OclFinset" :: "args => ('\<AA>,'a::null) Set" ("Set{(_)}") -translations - "Set{x, xs}" == "CONST OclIncluding (Set{xs}) x" - "Set{x}" == "CONST OclIncluding (Set{}) x " - - -subsection{* Definition: Excluding *} - -definition OclExcluding :: "[('\<AA>,'\<alpha>::null) Set,('\<AA>,'\<alpha>) val] \<Rightarrow> ('\<AA>,'\<alpha>) Set" -where "OclExcluding x y = (\<lambda> \<tau>. if (\<delta> x) \<tau> = true \<tau> \<and> (\<upsilon> y) \<tau> = true \<tau> - then Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e \<lfloor>\<lfloor> \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (x \<tau>)\<rceil>\<rceil> - {y \<tau>} \<rfloor>\<rfloor> - else \<bottom> )" -notation OclExcluding ("_->excluding\<^sub>S\<^sub>e\<^sub>t'(_')") - - -lemma OclExcluding_inv: "(x:: Set('b::{null})) \<noteq> \<bottom> \<Longrightarrow> x \<noteq> null \<Longrightarrow> y \<noteq> \<bottom> \<Longrightarrow> - \<lfloor>\<lfloor>\<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e x\<rceil>\<rceil> - {y}\<rfloor>\<rfloor> \<in> {X. X = bot \<or> X = null \<or> (\<forall>x\<in>\<lceil>\<lceil>X\<rceil>\<rceil>. x \<noteq> bot)}" - proof - fix X :: "'a state \<times> 'a state \<Rightarrow> Set('b)" fix \<tau> - show "x \<noteq> \<bottom> \<Longrightarrow> x \<noteq> null \<Longrightarrow> y \<noteq> \<bottom> \<Longrightarrow> ?thesis" - when "x = X \<tau>" - by(simp add: that Set_inv_lemma[simplified OclValid_def - defined_def null_fun_def bot_fun_def, of X \<tau>]) -qed simp_all - -interpretation OclExcluding : profile_bin\<^sub>d_\<^sub>v OclExcluding "\<lambda>x y. Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e\<lfloor>\<lfloor>\<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e x\<rceil>\<rceil> - {y}\<rfloor>\<rfloor>" -proof - - have A : "None \<in> {X. X = bot \<or> X = null \<or> (\<forall>x\<in>\<lceil>\<lceil>X\<rceil>\<rceil>. x \<noteq> bot)}" by(simp add: bot_option_def) - have B : "\<lfloor>None\<rfloor> \<in> {X. X = bot \<or> X = null \<or> (\<forall>x\<in>\<lceil>\<lceil>X\<rceil>\<rceil>. x \<noteq> bot)}" - by(simp add: null_option_def bot_option_def) - show "profile_bin\<^sub>d_\<^sub>v OclExcluding (\<lambda>x y. Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e\<lfloor>\<lfloor>\<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (x:: Set('b))\<rceil>\<rceil> - {y}\<rfloor>\<rfloor>)" - apply unfold_locales - apply(auto simp:OclExcluding_def bot_option_def null_option_def null_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def bot_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def invalid_def) - apply(erule_tac Q="Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e\<lfloor>\<lfloor>\<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e x\<rceil>\<rceil> - {y}\<rfloor>\<rfloor> = Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e None" in contrapos_pp) - apply(subst Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inject[OF OclExcluding_inv A]) - apply(simp_all add: null_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def bot_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def bot_option_def) - apply(erule_tac Q="Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e\<lfloor>\<lfloor>\<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e x\<rceil>\<rceil> - {y}\<rfloor>\<rfloor> = Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e \<lfloor>None\<rfloor>" in contrapos_pp) - apply(subst Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inject[OF OclExcluding_inv B]) - apply(simp_all add: null_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def bot_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def bot_option_def) - done -qed - - -subsection{* Definition: Includes *} - -definition OclIncludes :: "[('\<AA>,'\<alpha>::null) Set,('\<AA>,'\<alpha>) val] \<Rightarrow> '\<AA> Boolean" -where "OclIncludes x y = (\<lambda> \<tau>. if (\<delta> x) \<tau> = true \<tau> \<and> (\<upsilon> y) \<tau> = true \<tau> - then \<lfloor>\<lfloor>(y \<tau>) \<in> \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (x \<tau>)\<rceil>\<rceil> \<rfloor>\<rfloor> - else \<bottom> )" -notation OclIncludes ("_->includes\<^sub>S\<^sub>e\<^sub>t'(_')" (*[66,65]65*)) - -interpretation OclIncludes : profile_bin\<^sub>d_\<^sub>v OclIncludes "\<lambda>x y. \<lfloor>\<lfloor>y \<in> \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e x\<rceil>\<rceil>\<rfloor>\<rfloor>" -by(unfold_locales, auto simp:OclIncludes_def bot_option_def null_option_def invalid_def) - - -subsection{* Definition: Excludes *} - -definition OclExcludes :: "[('\<AA>,'\<alpha>::null) Set,('\<AA>,'\<alpha>) val] \<Rightarrow> '\<AA> Boolean" -where "OclExcludes x y = (not(OclIncludes x y))" -notation OclExcludes ("_->excludes\<^sub>S\<^sub>e\<^sub>t'(_')" (*[66,65]65*)) - -text{* The case of the size definition is somewhat special, we admit -explicitly in Featherweight OCL the possibility of infinite sets. For -the size definition, this requires an extra condition that assures -that the cardinality of the set is actually a defined integer. *} - -interpretation OclExcludes : profile_bin\<^sub>d_\<^sub>v OclExcludes "\<lambda>x y. \<lfloor>\<lfloor>y \<notin> \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e x\<rceil>\<rceil>\<rfloor>\<rfloor>" -by(unfold_locales, auto simp:OclExcludes_def OclIncludes_def OclNot_def bot_option_def null_option_def invalid_def) - -subsection{* Definition: Size *} - -definition OclSize :: "('\<AA>,'\<alpha>::null)Set \<Rightarrow> '\<AA> Integer" -where "OclSize x = (\<lambda> \<tau>. if (\<delta> x) \<tau> = true \<tau> \<and> finite(\<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (x \<tau>)\<rceil>\<rceil>) - then \<lfloor>\<lfloor> int(card \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (x \<tau>)\<rceil>\<rceil>) \<rfloor>\<rfloor> - else \<bottom> )" -notation (* standard ascii syntax *) - OclSize ("_->size\<^sub>S\<^sub>e\<^sub>t'(')" (*[66]*)) - -text{* The following definition follows the requirement of the -standard to treat null as neutral element of sets. It is -a well-documented exception from the general strictness -rule and the rule that the distinguished argument self should -be non-null. *} - -(*TODO Locale - Equivalent*) - - -subsection{* Definition: IsEmpty *} - -definition OclIsEmpty :: "('\<AA>,'\<alpha>::null) Set \<Rightarrow> '\<AA> Boolean" -where "OclIsEmpty x = ((\<upsilon> x and not (\<delta> x)) or ((OclSize x) \<doteq> \<zero>))" -notation OclIsEmpty ("_->isEmpty\<^sub>S\<^sub>e\<^sub>t'(')" (*[66]*)) - -(*TODO Locale - Equivalent*) - - -subsection{* Definition: NotEmpty *} - -definition OclNotEmpty :: "('\<AA>,'\<alpha>::null) Set \<Rightarrow> '\<AA> Boolean" -where "OclNotEmpty x = not(OclIsEmpty x)" -notation OclNotEmpty ("_->notEmpty\<^sub>S\<^sub>e\<^sub>t'(')" (*[66]*)) - -(*TODO Locale - Equivalent*) - -subsection{* Definition: Any *} - -(* Slight breach of naming convention in order to avoid naming conflict on constant.*) -definition OclANY :: "[('\<AA>,'\<alpha>::null) Set] \<Rightarrow> ('\<AA>,'\<alpha>) val" -where "OclANY x = (\<lambda> \<tau>. if (\<upsilon> x) \<tau> = true \<tau> - then if (\<delta> x and OclNotEmpty x) \<tau> = true \<tau> - then SOME y. y \<in> \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (x \<tau>)\<rceil>\<rceil> - else null \<tau> - else \<bottom> )" -notation OclANY ("_->any\<^sub>S\<^sub>e\<^sub>t'(')") - -(*TODO Locale - Equivalent*) - -(* actually, this definition covers only: X->any\<^sub>S\<^sub>e\<^sub>t(true) of the standard, which foresees -a (totally correct) high-level definition -source->any\<^sub>S\<^sub>e\<^sub>t(iterator | body) = -source->select(iterator | body)->asSequence()->first(). Since we don't have sequences, -we have to go for a direct---restricted---definition. *) - - - -subsection{* Definition: Forall *} - -text{* The definition of OclForall mimics the one of @{term "OclAnd"}: -OclForall is not a strict operation. *} -definition OclForall :: "[('\<AA>,'\<alpha>::null)Set,('\<AA>,'\<alpha>)val\<Rightarrow>('\<AA>)Boolean] \<Rightarrow> '\<AA> Boolean" -where "OclForall S P = (\<lambda> \<tau>. if (\<delta> S) \<tau> = true \<tau> - then if (\<exists>x\<in>\<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil>. P(\<lambda> _. x) \<tau> = false \<tau>) - then false \<tau> - else if (\<exists>x\<in>\<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil>. P(\<lambda> _. x) \<tau> = invalid \<tau>) - then invalid \<tau> - else if (\<exists>x\<in>\<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil>. P(\<lambda> _. x) \<tau> = null \<tau>) - then null \<tau> - else true \<tau> - else \<bottom>)" -syntax - "_OclForallSet" :: "[('\<AA>,'\<alpha>::null) Set,id,('\<AA>)Boolean] \<Rightarrow> '\<AA> Boolean" ("(_)->forAll\<^sub>S\<^sub>e\<^sub>t'(_|_')") -translations - "X->forAll\<^sub>S\<^sub>e\<^sub>t(x | P)" == "CONST UML_Set.OclForall X (%x. P)" - -(*TODO Locale - Equivalent*) - -subsection{* Definition: Exists *} - -text{* Like OclForall, OclExists is also not strict. *} -definition OclExists :: "[('\<AA>,'\<alpha>::null) Set,('\<AA>,'\<alpha>)val\<Rightarrow>('\<AA>)Boolean] \<Rightarrow> '\<AA> Boolean" -where "OclExists S P = not(UML_Set.OclForall S (\<lambda> X. not (P X)))" - -syntax - "_OclExistSet" :: "[('\<AA>,'\<alpha>::null) Set,id,('\<AA>)Boolean] \<Rightarrow> '\<AA> Boolean" ("(_)->exists\<^sub>S\<^sub>e\<^sub>t'(_|_')") -translations - "X->exists\<^sub>S\<^sub>e\<^sub>t(x | P)" == "CONST UML_Set.OclExists X (%x. P)" - -(*TODO Locale - Equivalent*) - -subsection{* Definition: Iterate *} - -definition OclIterate :: "[('\<AA>,'\<alpha>::null) Set,('\<AA>,'\<beta>::null)val, - ('\<AA>,'\<alpha>)val\<Rightarrow>('\<AA>,'\<beta>)val\<Rightarrow>('\<AA>,'\<beta>)val] \<Rightarrow> ('\<AA>,'\<beta>)val" -where "OclIterate S A F = (\<lambda> \<tau>. if (\<delta> S) \<tau> = true \<tau> \<and> (\<upsilon> A) \<tau> = true \<tau> \<and> finite\<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil> - then (Finite_Set.fold (F) (A) ((\<lambda>a \<tau>. a) ` \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil>))\<tau> - else \<bottom>)" -syntax - "_OclIterateSet" :: "[('\<AA>,'\<alpha>::null) Set, idt, idt, '\<alpha>, '\<beta>] => ('\<AA>,'\<gamma>)val" - ("_ ->iterate\<^sub>S\<^sub>e\<^sub>t'(_;_=_ | _')" (*[71,100,70]50*)) -translations - "X->iterate\<^sub>S\<^sub>e\<^sub>t(a; x = A | P)" == "CONST OclIterate X A (%a. (% x. P))" - -(*TODO Locale - Equivalent*) - -subsection{* Definition: Select *} - -definition OclSelect :: "[('\<AA>,'\<alpha>::null)Set,('\<AA>,'\<alpha>)val\<Rightarrow>('\<AA>)Boolean] \<Rightarrow> ('\<AA>,'\<alpha>)Set" -where "OclSelect S P = (\<lambda>\<tau>. if (\<delta> S) \<tau> = true \<tau> - then if (\<exists>x\<in>\<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil>. P(\<lambda> _. x) \<tau> = invalid \<tau>) - then invalid \<tau> - else Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e \<lfloor>\<lfloor>{x\<in>\<lceil>\<lceil> Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil>. P (\<lambda>_. x) \<tau> \<noteq> false \<tau>}\<rfloor>\<rfloor> - else invalid \<tau>)" -syntax - "_OclSelectSet" :: "[('\<AA>,'\<alpha>::null) Set,id,('\<AA>)Boolean] \<Rightarrow> '\<AA> Boolean" ("(_)->select\<^sub>S\<^sub>e\<^sub>t'(_|_')") -translations - "X->select\<^sub>S\<^sub>e\<^sub>t(x | P)" == "CONST OclSelect X (% x. P)" - -(*TODO Locale - Equivalent*) - -subsection{* Definition: Reject *} - -definition OclReject :: "[('\<AA>,'\<alpha>::null)Set,('\<AA>,'\<alpha>)val\<Rightarrow>('\<AA>)Boolean] \<Rightarrow> ('\<AA>,'\<alpha>::null)Set" -where "OclReject S P = OclSelect S (not o P)" -syntax - "_OclRejectSet" :: "[('\<AA>,'\<alpha>::null) Set,id,('\<AA>)Boolean] \<Rightarrow> '\<AA> Boolean" ("(_)->reject\<^sub>S\<^sub>e\<^sub>t'(_|_')") -translations - "X->reject\<^sub>S\<^sub>e\<^sub>t(x | P)" == "CONST OclReject X (% x. P)" - -(*TODO Locale - Equivalent*) - -subsection{* Definition: IncludesAll *} - -definition OclIncludesAll :: "[('\<AA>,'\<alpha>::null) Set,('\<AA>,'\<alpha>) Set] \<Rightarrow> '\<AA> Boolean" -where "OclIncludesAll x y = (\<lambda> \<tau>. if (\<delta> x) \<tau> = true \<tau> \<and> (\<delta> y) \<tau> = true \<tau> - then \<lfloor>\<lfloor>\<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (y \<tau>)\<rceil>\<rceil> \<subseteq> \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (x \<tau>)\<rceil>\<rceil> \<rfloor>\<rfloor> - else \<bottom> )" -notation OclIncludesAll ("_->includesAll\<^sub>S\<^sub>e\<^sub>t'(_')" (*[66,65]65*)) - -interpretation OclIncludesAll : profile_bin\<^sub>d_\<^sub>d OclIncludesAll "\<lambda>x y. \<lfloor>\<lfloor>\<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e y\<rceil>\<rceil> \<subseteq> \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e x\<rceil>\<rceil>\<rfloor>\<rfloor>" -by(unfold_locales, auto simp:OclIncludesAll_def bot_option_def null_option_def invalid_def) - -subsection{* Definition: ExcludesAll *} - -definition OclExcludesAll :: "[('\<AA>,'\<alpha>::null) Set,('\<AA>,'\<alpha>) Set] \<Rightarrow> '\<AA> Boolean" -where "OclExcludesAll x y = (\<lambda> \<tau>. if (\<delta> x) \<tau> = true \<tau> \<and> (\<delta> y) \<tau> = true \<tau> - then \<lfloor>\<lfloor>\<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (y \<tau>)\<rceil>\<rceil> \<inter> \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (x \<tau>)\<rceil>\<rceil> = {} \<rfloor>\<rfloor> - else \<bottom> )" -notation OclExcludesAll ("_->excludesAll\<^sub>S\<^sub>e\<^sub>t'(_')" (*[66,65]65*)) - -interpretation OclExcludesAll : profile_bin\<^sub>d_\<^sub>d OclExcludesAll "\<lambda>x y. \<lfloor>\<lfloor>\<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e y\<rceil>\<rceil> \<inter> \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e x\<rceil>\<rceil> = {}\<rfloor>\<rfloor>" -by(unfold_locales, auto simp:OclExcludesAll_def bot_option_def null_option_def invalid_def) - -subsection{* Definition: Union *} - -definition OclUnion :: "[('\<AA>,'\<alpha>::null) Set,('\<AA>,'\<alpha>) Set] \<Rightarrow> ('\<AA>,'\<alpha>) Set" -where "OclUnion x y = (\<lambda> \<tau>. if (\<delta> x) \<tau> = true \<tau> \<and> (\<delta> y) \<tau> = true \<tau> - then Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e\<lfloor>\<lfloor>\<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (y \<tau>)\<rceil>\<rceil> \<union> \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (x \<tau>)\<rceil>\<rceil> \<rfloor>\<rfloor> - else \<bottom> )" -notation OclUnion ("_->union\<^sub>S\<^sub>e\<^sub>t'(_')" (*[66,65]65*)) - -lemma OclUnion_inv: "(x:: Set('b::{null})) \<noteq> \<bottom> \<Longrightarrow> x \<noteq> null \<Longrightarrow> y \<noteq> \<bottom> \<Longrightarrow> y \<noteq> null \<Longrightarrow> - \<lfloor>\<lfloor>\<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e y\<rceil>\<rceil> \<union> \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e x\<rceil>\<rceil>\<rfloor>\<rfloor> \<in> {X. X = bot \<or> X = null \<or> (\<forall>x\<in>\<lceil>\<lceil>X\<rceil>\<rceil>. x \<noteq> bot)}" - proof - fix X Y :: "'a state \<times> 'a state \<Rightarrow> Set('b)" fix \<tau> - show "x \<noteq> \<bottom> \<Longrightarrow> x \<noteq> null \<Longrightarrow> y \<noteq> \<bottom> \<Longrightarrow> y \<noteq> null \<Longrightarrow> ?thesis" - when "x = X \<tau>" "y = Y \<tau>" - by(auto simp: that, - insert - Set_inv_lemma[simplified OclValid_def - defined_def null_fun_def bot_fun_def, of Y \<tau>] - Set_inv_lemma[simplified OclValid_def - defined_def null_fun_def bot_fun_def, of X \<tau>], - auto) -qed simp_all - -interpretation OclUnion : profile_bin\<^sub>d_\<^sub>d OclUnion "\<lambda>x y. Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e\<lfloor>\<lfloor>\<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e y\<rceil>\<rceil> \<union> \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e x\<rceil>\<rceil>\<rfloor>\<rfloor>" -proof - - have A : "None \<in> {X. X = bot \<or> X = null \<or> (\<forall>x\<in>\<lceil>\<lceil>X\<rceil>\<rceil>. x \<noteq> bot)}" by(simp add: bot_option_def) - have B : "\<lfloor>None\<rfloor> \<in> {X. X = bot \<or> X = null \<or> (\<forall>x\<in>\<lceil>\<lceil>X\<rceil>\<rceil>. x \<noteq> bot)}" - by(simp add: null_option_def bot_option_def) - show "profile_bin\<^sub>d_\<^sub>d OclUnion (\<lambda>x y. Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e\<lfloor>\<lfloor>\<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e y\<rceil>\<rceil> \<union> \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e x\<rceil>\<rceil>\<rfloor>\<rfloor>)" - apply unfold_locales - apply(auto simp:OclUnion_def bot_option_def null_option_def null_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def bot_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def invalid_def) - apply(erule_tac Q="Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e\<lfloor>\<lfloor>\<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e y\<rceil>\<rceil> \<union> \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e x\<rceil>\<rceil>\<rfloor>\<rfloor> = Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e None" in contrapos_pp) - apply(subst Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inject[OF OclUnion_inv A]) - apply(simp_all add: null_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def bot_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def bot_option_def) - apply(erule_tac Q="Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e\<lfloor>\<lfloor>\<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e y\<rceil>\<rceil> \<union> \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e x\<rceil>\<rceil>\<rfloor>\<rfloor> = Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e \<lfloor>None\<rfloor>" in contrapos_pp) - apply(subst Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inject[OF OclUnion_inv B]) - apply(simp_all add: null_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def bot_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def bot_option_def) - done -qed - -subsection{* Definition: Intersection *} - -definition OclIntersection :: "[('\<AA>,'\<alpha>::null) Set,('\<AA>,'\<alpha>) Set] \<Rightarrow> ('\<AA>,'\<alpha>) Set" -where "OclIntersection x y = (\<lambda> \<tau>. if (\<delta> x) \<tau> = true \<tau> \<and> (\<delta> y) \<tau> = true \<tau> - then Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e\<lfloor>\<lfloor>\<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (y \<tau>)\<rceil>\<rceil> - \<inter> \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (x \<tau>)\<rceil>\<rceil>\<rfloor>\<rfloor> - else \<bottom> )" -notation OclIntersection("_->intersection\<^sub>S\<^sub>e\<^sub>t'(_')" (*[71,70]70*)) - -lemma OclIntersection_inv: "(x:: Set('b::{null})) \<noteq> \<bottom> \<Longrightarrow> x \<noteq> null \<Longrightarrow> y \<noteq> \<bottom> \<Longrightarrow> y \<noteq> null \<Longrightarrow> - \<lfloor>\<lfloor>\<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e y\<rceil>\<rceil> \<inter> \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e x\<rceil>\<rceil>\<rfloor>\<rfloor> \<in> {X. X = bot \<or> X = null \<or> (\<forall>x\<in>\<lceil>\<lceil>X\<rceil>\<rceil>. x \<noteq> bot)}" - proof - fix X Y :: "'a state \<times> 'a state \<Rightarrow> Set('b)" fix \<tau> - show "x \<noteq> \<bottom> \<Longrightarrow> x \<noteq> null \<Longrightarrow> y \<noteq> \<bottom> \<Longrightarrow> y \<noteq> null \<Longrightarrow> ?thesis" - when "x = X \<tau>" "y = Y \<tau>" - by(auto simp: that, - insert - Set_inv_lemma[simplified OclValid_def - defined_def null_fun_def bot_fun_def, of Y \<tau>] - Set_inv_lemma[simplified OclValid_def - defined_def null_fun_def bot_fun_def, of X \<tau>], - auto) -qed simp_all - -interpretation OclIntersection : profile_bin\<^sub>d_\<^sub>d OclIntersection "\<lambda>x y. Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e\<lfloor>\<lfloor>\<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e y\<rceil>\<rceil> \<inter> \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e x\<rceil>\<rceil>\<rfloor>\<rfloor>" -proof - - have A : "None \<in> {X. X = bot \<or> X = null \<or> (\<forall>x\<in>\<lceil>\<lceil>X\<rceil>\<rceil>. x \<noteq> bot)}" by(simp add: bot_option_def) - have B : "\<lfloor>None\<rfloor> \<in> {X. X = bot \<or> X = null \<or> (\<forall>x\<in>\<lceil>\<lceil>X\<rceil>\<rceil>. x \<noteq> bot)}" - by(simp add: null_option_def bot_option_def) - show "profile_bin\<^sub>d_\<^sub>d OclIntersection (\<lambda>x y. Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e\<lfloor>\<lfloor>\<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e y\<rceil>\<rceil> \<inter> \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e x\<rceil>\<rceil>\<rfloor>\<rfloor>)" - apply unfold_locales - apply(auto simp:OclIntersection_def bot_option_def null_option_def null_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def bot_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def invalid_def) - apply(erule_tac Q="Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e\<lfloor>\<lfloor>\<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e y\<rceil>\<rceil> \<inter> \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e x\<rceil>\<rceil>\<rfloor>\<rfloor> = Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e None" in contrapos_pp) - apply(subst Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inject[OF OclIntersection_inv A]) - apply(simp_all add: null_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def bot_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def bot_option_def) - apply(erule_tac Q="Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e\<lfloor>\<lfloor>\<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e y\<rceil>\<rceil> \<inter> \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e x\<rceil>\<rceil>\<rfloor>\<rfloor> = Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e \<lfloor>None\<rfloor>" in contrapos_pp) - apply(subst Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inject[OF OclIntersection_inv B]) - apply(simp_all add: null_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def bot_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def bot_option_def) - done -qed - -subsection{* Definition (future operators) *} - -consts (* abstract set collection operations *) - OclCount :: "[('\<AA>,'\<alpha>::null) Set,('\<AA>,'\<alpha>) Set] \<Rightarrow> '\<AA> Integer" - OclSum :: " ('\<AA>,'\<alpha>::null) Set \<Rightarrow> '\<AA> Integer" - -notation OclCount ("_->count\<^sub>S\<^sub>e\<^sub>t'(_')" (*[66,65]65*)) -notation OclSum ("_->sum\<^sub>S\<^sub>e\<^sub>t'(')" (*[66]*)) - -subsection{* Logical Properties *} - -text{* OclIncluding *} - -lemma OclIncluding_valid_args_valid: -"(\<tau> \<Turnstile> \<upsilon>(X->including\<^sub>S\<^sub>e\<^sub>t(x))) = ((\<tau> \<Turnstile>(\<delta> X)) \<and> (\<tau> \<Turnstile>(\<upsilon> x)))" -by (metis (hide_lams, no_types) OclIncluding.def_valid_then_def OclIncluding.defined_args_valid) - -lemma OclIncluding_valid_args_valid''[simp,code_unfold]: -"\<upsilon>(X->including\<^sub>S\<^sub>e\<^sub>t(x)) = ((\<delta> X) and (\<upsilon> x))" -by (simp add: OclIncluding.def_valid_then_def) - -text{* etc. etc. *} -text_raw{* \isatagafp *} - -text{* OclExcluding *} - -lemma OclExcluding_valid_args_valid: -"(\<tau> \<Turnstile> \<upsilon>(X->excluding\<^sub>S\<^sub>e\<^sub>t(x))) = ((\<tau> \<Turnstile>(\<delta> X)) \<and> (\<tau> \<Turnstile>(\<upsilon> x)))" -by (metis OclExcluding.def_valid_then_def OclExcluding.defined_args_valid) - -lemma OclExcluding_valid_args_valid''[simp,code_unfold]: -"\<upsilon>(X->excluding\<^sub>S\<^sub>e\<^sub>t(x)) = ((\<delta> X) and (\<upsilon> x))" -by (simp add: OclExcluding.def_valid_then_def) - -text{* OclIncludes *} - -lemma OclIncludes_valid_args_valid: -"(\<tau> \<Turnstile> \<upsilon>(X->includes\<^sub>S\<^sub>e\<^sub>t(x))) = ((\<tau> \<Turnstile>(\<delta> X)) \<and> (\<tau> \<Turnstile>(\<upsilon> x)))" -by (simp add: OclIncludes.def_valid_then_def foundation10') - -lemma OclIncludes_valid_args_valid''[simp,code_unfold]: -"\<upsilon>(X->includes\<^sub>S\<^sub>e\<^sub>t(x)) = ((\<delta> X) and (\<upsilon> x))" -by (simp add: OclIncludes.def_valid_then_def) - -text{* OclExcludes *} - -lemma OclExcludes_valid_args_valid: -"(\<tau> \<Turnstile> \<upsilon>(X->excludes\<^sub>S\<^sub>e\<^sub>t(x))) = ((\<tau> \<Turnstile>(\<delta> X)) \<and> (\<tau> \<Turnstile>(\<upsilon> x)))" -by (simp add: OclExcludes.def_valid_then_def foundation10') - -lemma OclExcludes_valid_args_valid''[simp,code_unfold]: -"\<upsilon>(X->excludes\<^sub>S\<^sub>e\<^sub>t(x)) = ((\<delta> X) and (\<upsilon> x))" -by (simp add: OclExcludes.def_valid_then_def) - -text{* OclSize *} - -lemma OclSize_defined_args_valid: "\<tau> \<Turnstile> \<delta> (X->size\<^sub>S\<^sub>e\<^sub>t()) \<Longrightarrow> \<tau> \<Turnstile> \<delta> X" -by(auto simp: OclSize_def OclValid_def true_def valid_def false_def StrongEq_def - defined_def invalid_def bot_fun_def null_fun_def - split: bool.split_asm HOL.if_split_asm option.split) - -lemma OclSize_infinite: -assumes non_finite:"\<tau> \<Turnstile> not(\<delta>(S->size\<^sub>S\<^sub>e\<^sub>t()))" -shows "(\<tau> \<Turnstile> not(\<delta>(S))) \<or> \<not> finite \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil>" -apply(insert non_finite, simp) -apply(rule impI) -apply(simp add: OclSize_def OclValid_def defined_def) -apply(case_tac "finite \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil>", - simp_all add:null_fun_def null_option_def bot_fun_def bot_option_def) -done - -lemma "\<tau> \<Turnstile> \<delta> X \<Longrightarrow> \<not> finite \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (X \<tau>)\<rceil>\<rceil> \<Longrightarrow> \<not> \<tau> \<Turnstile> \<delta> (X->size\<^sub>S\<^sub>e\<^sub>t())" -by(simp add: OclSize_def OclValid_def defined_def bot_fun_def false_def true_def) - -lemma size_defined: - assumes X_finite: "\<And>\<tau>. finite \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (X \<tau>)\<rceil>\<rceil>" - shows "\<delta> (X->size\<^sub>S\<^sub>e\<^sub>t()) = \<delta> X" - apply(rule ext, simp add: cp_defined[of "X->size\<^sub>S\<^sub>e\<^sub>t()"] OclSize_def) - apply(simp add: defined_def bot_option_def bot_fun_def null_option_def null_fun_def X_finite) -done - -lemma size_defined': - assumes X_finite: "finite \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (X \<tau>)\<rceil>\<rceil>" - shows "(\<tau> \<Turnstile> \<delta> (X->size\<^sub>S\<^sub>e\<^sub>t())) = (\<tau> \<Turnstile> \<delta> X)" - apply(simp add: cp_defined[of "X->size\<^sub>S\<^sub>e\<^sub>t()"] OclSize_def OclValid_def) - apply(simp add: defined_def bot_option_def bot_fun_def null_option_def null_fun_def X_finite) -done - -text{* OclIsEmpty *} - -lemma OclIsEmpty_defined_args_valid:"\<tau> \<Turnstile> \<delta> (X->isEmpty\<^sub>S\<^sub>e\<^sub>t()) \<Longrightarrow> \<tau> \<Turnstile> \<upsilon> X" - apply(auto simp: OclIsEmpty_def OclValid_def defined_def valid_def false_def true_def - bot_fun_def null_fun_def OclAnd_def OclOr_def OclNot_def - split: if_split_asm) - apply(case_tac "(X->size\<^sub>S\<^sub>e\<^sub>t() \<doteq> \<zero>) \<tau>", simp add: bot_option_def, simp, rename_tac x) - apply(case_tac x, simp add: null_option_def bot_option_def, simp) - apply(simp add: OclSize_def StrictRefEq\<^sub>I\<^sub>n\<^sub>t\<^sub>e\<^sub>g\<^sub>e\<^sub>r valid_def) -by (metis (hide_lams, no_types) - bot_fun_def OclValid_def defined_def foundation2 invalid_def) - -lemma "\<tau> \<Turnstile> \<delta> (null->isEmpty\<^sub>S\<^sub>e\<^sub>t())" -by(auto simp: OclIsEmpty_def OclValid_def defined_def valid_def false_def true_def - bot_fun_def null_fun_def OclAnd_def OclOr_def OclNot_def null_is_valid - split: if_split_asm) - -lemma OclIsEmpty_infinite: "\<tau> \<Turnstile> \<delta> X \<Longrightarrow> \<not> finite \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (X \<tau>)\<rceil>\<rceil> \<Longrightarrow> \<not> \<tau> \<Turnstile> \<delta> (X->isEmpty\<^sub>S\<^sub>e\<^sub>t())" - apply(auto simp: OclIsEmpty_def OclValid_def defined_def valid_def false_def true_def - bot_fun_def null_fun_def OclAnd_def OclOr_def OclNot_def - split: if_split_asm) - apply(case_tac "(X->size\<^sub>S\<^sub>e\<^sub>t() \<doteq> \<zero>) \<tau>", simp add: bot_option_def, simp, rename_tac x) - apply(case_tac x, simp add: null_option_def bot_option_def, simp) -by(simp add: OclSize_def StrictRefEq\<^sub>I\<^sub>n\<^sub>t\<^sub>e\<^sub>g\<^sub>e\<^sub>r valid_def bot_fun_def false_def true_def invalid_def) - -text{* OclNotEmpty *} - -lemma OclNotEmpty_defined_args_valid:"\<tau> \<Turnstile> \<delta> (X->notEmpty\<^sub>S\<^sub>e\<^sub>t()) \<Longrightarrow> \<tau> \<Turnstile> \<upsilon> X" -by (metis (hide_lams, no_types) OclNotEmpty_def OclNot_defargs OclNot_not foundation6 foundation9 - OclIsEmpty_defined_args_valid) - -lemma "\<tau> \<Turnstile> \<delta> (null->notEmpty\<^sub>S\<^sub>e\<^sub>t())" -by (metis (hide_lams, no_types) OclNotEmpty_def OclAnd_false1 OclAnd_idem OclIsEmpty_def - OclNot3 OclNot4 OclOr_def defined2 defined4 transform1 valid2) - -lemma OclNotEmpty_infinite: "\<tau> \<Turnstile> \<delta> X \<Longrightarrow> \<not> finite \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (X \<tau>)\<rceil>\<rceil> \<Longrightarrow> \<not> \<tau> \<Turnstile> \<delta> (X->notEmpty\<^sub>S\<^sub>e\<^sub>t())" - apply(simp add: OclNotEmpty_def) - apply(drule OclIsEmpty_infinite, simp) -by (metis OclNot_defargs OclNot_not foundation6 foundation9) - -lemma OclNotEmpty_has_elt : "\<tau> \<Turnstile> \<delta> X \<Longrightarrow> - \<tau> \<Turnstile> X->notEmpty\<^sub>S\<^sub>e\<^sub>t() \<Longrightarrow> - \<exists>e. e \<in> \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (X \<tau>)\<rceil>\<rceil>" - apply(simp add: OclNotEmpty_def OclIsEmpty_def deMorgan1 deMorgan2, drule foundation5) - apply(subst (asm) (2) OclNot_def, - simp add: OclValid_def StrictRefEq\<^sub>I\<^sub>n\<^sub>t\<^sub>e\<^sub>g\<^sub>e\<^sub>r StrongEq_def - split: if_split_asm) - prefer 2 - apply(simp add: invalid_def bot_option_def true_def) - apply(simp add: OclSize_def valid_def split: if_split_asm, - simp_all add: false_def true_def bot_option_def bot_fun_def OclInt0_def) -by (metis equals0I) - -text{* OclANY *} - -lemma OclANY_defined_args_valid: "\<tau> \<Turnstile> \<delta> (X->any\<^sub>S\<^sub>e\<^sub>t()) \<Longrightarrow> \<tau> \<Turnstile> \<delta> X" -by(auto simp: OclANY_def OclValid_def true_def valid_def false_def StrongEq_def - defined_def invalid_def bot_fun_def null_fun_def OclAnd_def - split: bool.split_asm HOL.if_split_asm option.split) - -lemma "\<tau> \<Turnstile> \<delta> X \<Longrightarrow> \<tau> \<Turnstile> X->isEmpty\<^sub>S\<^sub>e\<^sub>t() \<Longrightarrow> \<not> \<tau> \<Turnstile> \<delta> (X->any\<^sub>S\<^sub>e\<^sub>t())" - apply(simp add: OclANY_def OclValid_def) - apply(subst cp_defined, subst cp_OclAnd, simp add: OclNotEmpty_def, subst (1 2) cp_OclNot, - simp add: cp_OclNot[symmetric] cp_OclAnd[symmetric] cp_defined[symmetric], - simp add: false_def true_def) -by(drule foundation20[simplified OclValid_def true_def], simp) - -lemma OclANY_valid_args_valid: -"(\<tau> \<Turnstile> \<upsilon>(X->any\<^sub>S\<^sub>e\<^sub>t())) = (\<tau> \<Turnstile> \<upsilon> X)" -proof - - have A: "(\<tau> \<Turnstile> \<upsilon>(X->any\<^sub>S\<^sub>e\<^sub>t())) \<Longrightarrow> ((\<tau> \<Turnstile>(\<upsilon> X)))" - by(auto simp: OclANY_def OclValid_def true_def valid_def false_def StrongEq_def - defined_def invalid_def bot_fun_def null_fun_def - split: bool.split_asm HOL.if_split_asm option.split) - have B: "(\<tau> \<Turnstile>(\<upsilon> X)) \<Longrightarrow> (\<tau> \<Turnstile> \<upsilon>(X->any\<^sub>S\<^sub>e\<^sub>t()))" - apply(auto simp: OclANY_def OclValid_def true_def false_def StrongEq_def - defined_def invalid_def valid_def bot_fun_def null_fun_def - bot_option_def null_option_def null_is_valid - OclAnd_def - split: bool.split_asm HOL.if_split_asm option.split) - apply(frule Set_inv_lemma[OF foundation16[THEN iffD2], OF conjI], simp) - apply(subgoal_tac "(\<delta> X) \<tau> = true \<tau>") - prefer 2 - apply (metis (hide_lams, no_types) OclValid_def foundation16) - apply(simp add: true_def, - drule OclNotEmpty_has_elt[simplified OclValid_def true_def], simp) - by(erule exE, - insert someI2[where Q = "\<lambda>x. x \<noteq> \<bottom>" and P = "\<lambda>y. y \<in> \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (X \<tau>)\<rceil>\<rceil>"], - simp) - show ?thesis by(auto dest:A intro:B) -qed - -lemma OclANY_valid_args_valid''[simp,code_unfold]: -"\<upsilon>(X->any\<^sub>S\<^sub>e\<^sub>t()) = (\<upsilon> X)" -by(auto intro!: OclANY_valid_args_valid transform2_rev) - -(* and higher order ones : forall, exists, iterate, select, reject... *) -text_raw{* \endisatagafp *} - -subsection{* Execution Laws with Invalid or Null or Infinite Set as Argument *} - -text{* OclIncluding *} (* properties already generated by the corresponding locale *) - -text{* OclExcluding *} (* properties already generated by the corresponding locale *) - -text{* OclIncludes *} (* properties already generated by the corresponding locale *) - -text{* OclExcludes *} (* properties already generated by the corresponding locale *) - -text{* OclSize *} - -lemma OclSize_invalid[simp,code_unfold]:"(invalid->size\<^sub>S\<^sub>e\<^sub>t()) = invalid" -by(simp add: bot_fun_def OclSize_def invalid_def defined_def valid_def false_def true_def) - -lemma OclSize_null[simp,code_unfold]:"(null->size\<^sub>S\<^sub>e\<^sub>t()) = invalid" -by(rule ext, - simp add: bot_fun_def null_fun_def null_is_valid OclSize_def - invalid_def defined_def valid_def false_def true_def) - -text{* OclIsEmpty *} - -lemma OclIsEmpty_invalid[simp,code_unfold]:"(invalid->isEmpty\<^sub>S\<^sub>e\<^sub>t()) = invalid" -by(simp add: OclIsEmpty_def) - -lemma OclIsEmpty_null[simp,code_unfold]:"(null->isEmpty\<^sub>S\<^sub>e\<^sub>t()) = true" -by(simp add: OclIsEmpty_def) - -text{* OclNotEmpty *} - -lemma OclNotEmpty_invalid[simp,code_unfold]:"(invalid->notEmpty\<^sub>S\<^sub>e\<^sub>t()) = invalid" -by(simp add: OclNotEmpty_def) - -lemma OclNotEmpty_null[simp,code_unfold]:"(null->notEmpty\<^sub>S\<^sub>e\<^sub>t()) = false" -by(simp add: OclNotEmpty_def) - -text{* OclANY *} - -lemma OclANY_invalid[simp,code_unfold]:"(invalid->any\<^sub>S\<^sub>e\<^sub>t()) = invalid" -by(simp add: bot_fun_def OclANY_def invalid_def defined_def valid_def false_def true_def) - -lemma OclANY_null[simp,code_unfold]:"(null->any\<^sub>S\<^sub>e\<^sub>t()) = null" -by(simp add: OclANY_def false_def true_def) - -text{* OclForall *} - -lemma OclForall_invalid[simp,code_unfold]:"invalid->forAll\<^sub>S\<^sub>e\<^sub>t(a| P a) = invalid" -by(simp add: bot_fun_def invalid_def OclForall_def defined_def valid_def false_def true_def) - -lemma OclForall_null[simp,code_unfold]:"null->forAll\<^sub>S\<^sub>e\<^sub>t(a | P a) = invalid" -by(simp add: bot_fun_def invalid_def OclForall_def defined_def valid_def false_def true_def) - -text{* OclExists *} - -lemma OclExists_invalid[simp,code_unfold]:"invalid->exists\<^sub>S\<^sub>e\<^sub>t(a| P a) = invalid" -by(simp add: OclExists_def) - -lemma OclExists_null[simp,code_unfold]:"null->exists\<^sub>S\<^sub>e\<^sub>t(a | P a) = invalid" -by(simp add: OclExists_def) - -text{* OclIterate *} - -lemma OclIterate_invalid[simp,code_unfold]:"invalid->iterate\<^sub>S\<^sub>e\<^sub>t(a; x = A | P a x) = invalid" -by(simp add: bot_fun_def invalid_def OclIterate_def defined_def valid_def false_def true_def) - -lemma OclIterate_null[simp,code_unfold]:"null->iterate\<^sub>S\<^sub>e\<^sub>t(a; x = A | P a x) = invalid" -by(simp add: bot_fun_def invalid_def OclIterate_def defined_def valid_def false_def true_def) - - -lemma OclIterate_invalid_args[simp,code_unfold]:"S->iterate\<^sub>S\<^sub>e\<^sub>t(a; x = invalid | P a x) = invalid" -by(simp add: bot_fun_def invalid_def OclIterate_def defined_def valid_def false_def true_def) - -text{* An open question is this ... *} -lemma (*OclIterate_null_args[simp,code_unfold]:*) "S->iterate\<^sub>S\<^sub>e\<^sub>t(a; x = null | P a x) = invalid" -oops -(* In the definition above, this does not hold in general. - And I believe, this is how it should be ... *) - -lemma OclIterate_infinite: -assumes non_finite: "\<tau> \<Turnstile> not(\<delta>(S->size\<^sub>S\<^sub>e\<^sub>t()))" -shows "(OclIterate S A F) \<tau> = invalid \<tau>" -apply(insert non_finite [THEN OclSize_infinite]) -apply(subst (asm) foundation9, simp) -by(metis OclIterate_def OclValid_def invalid_def) - -text{* OclSelect *} - -lemma OclSelect_invalid[simp,code_unfold]:"invalid->select\<^sub>S\<^sub>e\<^sub>t(a | P a) = invalid" -by(simp add: bot_fun_def invalid_def OclSelect_def defined_def valid_def false_def true_def) - -lemma OclSelect_null[simp,code_unfold]:"null->select\<^sub>S\<^sub>e\<^sub>t(a | P a) = invalid" -by(simp add: bot_fun_def invalid_def OclSelect_def defined_def valid_def false_def true_def) - -text{* OclReject *} - -lemma OclReject_invalid[simp,code_unfold]:"invalid->reject\<^sub>S\<^sub>e\<^sub>t(a | P a) = invalid" -by(simp add: OclReject_def) - -lemma OclReject_null[simp,code_unfold]:"null->reject\<^sub>S\<^sub>e\<^sub>t(a | P a) = invalid" -by(simp add: OclReject_def) - -text_raw{* \isatagafp *} - -subsubsection{* Context Passing *} - -lemma cp_OclIncludes1: -"(X->includes\<^sub>S\<^sub>e\<^sub>t(x)) \<tau> = (X->includes\<^sub>S\<^sub>e\<^sub>t(\<lambda> _. x \<tau>)) \<tau>" -by(auto simp: OclIncludes_def StrongEq_def invalid_def - cp_defined[symmetric] cp_valid[symmetric]) - -lemma cp_OclSize: "X->size\<^sub>S\<^sub>e\<^sub>t() \<tau> = ((\<lambda>_. X \<tau>)->size\<^sub>S\<^sub>e\<^sub>t()) \<tau>" -by(simp add: OclSize_def cp_defined[symmetric]) - -lemma cp_OclIsEmpty: "X->isEmpty\<^sub>S\<^sub>e\<^sub>t() \<tau> = ((\<lambda>_. X \<tau>)->isEmpty\<^sub>S\<^sub>e\<^sub>t()) \<tau>" - apply(simp only: OclIsEmpty_def) - apply(subst (2) cp_OclOr, - subst cp_OclAnd, - subst cp_OclNot, - subst StrictRefEq\<^sub>I\<^sub>n\<^sub>t\<^sub>e\<^sub>g\<^sub>e\<^sub>r.cp0) -by(simp add: cp_defined[symmetric] cp_valid[symmetric] StrictRefEq\<^sub>I\<^sub>n\<^sub>t\<^sub>e\<^sub>g\<^sub>e\<^sub>r.cp0[symmetric] - cp_OclSize[symmetric] cp_OclNot[symmetric] cp_OclAnd[symmetric] cp_OclOr[symmetric]) - -lemma cp_OclNotEmpty: "X->notEmpty\<^sub>S\<^sub>e\<^sub>t() \<tau> = ((\<lambda>_. X \<tau>)->notEmpty\<^sub>S\<^sub>e\<^sub>t()) \<tau>" - apply(simp only: OclNotEmpty_def) - apply(subst (2) cp_OclNot) -by(simp add: cp_OclNot[symmetric] cp_OclIsEmpty[symmetric]) - -lemma cp_OclANY: "X->any\<^sub>S\<^sub>e\<^sub>t() \<tau> = ((\<lambda>_. X \<tau>)->any\<^sub>S\<^sub>e\<^sub>t()) \<tau>" - apply(simp only: OclANY_def) - apply(subst (2) cp_OclAnd) -by(simp only: cp_OclAnd[symmetric] cp_defined[symmetric] cp_valid[symmetric] - cp_OclNotEmpty[symmetric]) - -lemma cp_OclForall: -"(S->forAll\<^sub>S\<^sub>e\<^sub>t(x | P x)) \<tau> = ((\<lambda> _. S \<tau>)->forAll\<^sub>S\<^sub>e\<^sub>t(x | P (\<lambda> _. x \<tau>))) \<tau>" -by(simp add: OclForall_def cp_defined[symmetric]) - -(* first-order version !*) -lemma cp_OclForall1 [simp,intro!]: -"cp S \<Longrightarrow> cp (\<lambda>X. ((S X)->forAll\<^sub>S\<^sub>e\<^sub>t(x | P x)))" -apply(simp add: cp_def) -apply(erule exE, rule exI, intro allI) -apply(erule_tac x=X in allE) -by(subst cp_OclForall, simp) - -lemma (*cp_OclForall2 [simp,intro!]:*) -"cp (\<lambda>X St x. P (\<lambda>\<tau>. x) X St) \<Longrightarrow> cp S \<Longrightarrow> cp (\<lambda>X. (S X)->forAll\<^sub>S\<^sub>e\<^sub>t(x|P x X)) " -apply(simp only: cp_def) -oops - -lemma (*cp_OclForall:*) -"cp S \<Longrightarrow> - (\<And> x. cp(P x)) \<Longrightarrow> - cp(\<lambda>X. ((S X)->forAll\<^sub>S\<^sub>e\<^sub>t(x | P x X)))" -oops - -(* old proof in HOL-OCL based on Isabelle2005: - -lemma cp_OclForall2 [simp,intro!]: -"\<lbrakk> cp (\<lambda> X St.(\<lambda>x. P (\<lambda>\<tau>. x) X St)); - cp (S :: (('a,'c)VAL \<Rightarrow> ('a,('b::bot))Set)) \<rbrakk> - \<Longrightarrow> cp(\<lambda>X. \<MathOclForAll> Y \<in> S X \<bullet> P (Y::'a \<Rightarrow> 'b) X) " -apply(simp only: cp_def OclForAll_def) -apply(erule exE)+ -apply(rule exI, rule allI, rule allI) -apply (simp only:) -apply(rule_tac t = "(\<lambda>x. P (\<lambda>\<tau>. x) X \<tau> )" and - s = "f (X \<tau> ) \<tau> " in subst) -prefer 2 -ML{* Unify.search_bound:=1000; *} -apply(rule refl) -ML{* Unify.search_bound:=20; *} -(* Miracle ! This works. Definitively a unification problem !!! *) -apply simp -done (* temporary solution. *) - (* TODO: improve !!! *) - -*) - -lemma cp_OclExists: -"(S->exists\<^sub>S\<^sub>e\<^sub>t(x | P x)) \<tau> = ((\<lambda> _. S \<tau>)->exists\<^sub>S\<^sub>e\<^sub>t(x | P (\<lambda> _. x \<tau>))) \<tau>" -by(simp add: OclExists_def OclNot_def, subst cp_OclForall, simp) - -(* first-order version !*) -lemma cp_OclExists1 [simp,intro!]: -"cp S \<Longrightarrow> cp (\<lambda>X. ((S X)->exists\<^sub>S\<^sub>e\<^sub>t(x | P x)))" -apply(simp add: cp_def) -apply(erule exE, rule exI, intro allI) -apply(erule_tac x=X in allE) -by(subst cp_OclExists,simp) - -lemma cp_OclIterate: - "(X->iterate\<^sub>S\<^sub>e\<^sub>t(a; x = A | P a x)) \<tau> = - ((\<lambda> _. X \<tau>)->iterate\<^sub>S\<^sub>e\<^sub>t(a; x = A | P a x)) \<tau>" -by(simp add: OclIterate_def cp_defined[symmetric]) - -lemma cp_OclSelect: "(X->select\<^sub>S\<^sub>e\<^sub>t(a | P a)) \<tau> = - ((\<lambda> _. X \<tau>)->select\<^sub>S\<^sub>e\<^sub>t(a | P a)) \<tau>" -by(simp add: OclSelect_def cp_defined[symmetric]) - -lemma cp_OclReject: "(X->reject\<^sub>S\<^sub>e\<^sub>t(a | P a)) \<tau> = ((\<lambda> _. X \<tau>)->reject\<^sub>S\<^sub>e\<^sub>t(a | P a)) \<tau>" -by(simp add: OclReject_def, subst cp_OclSelect, simp) - -lemmas cp_intro''\<^sub>S\<^sub>e\<^sub>t[intro!,simp,code_unfold] = - cp_OclSize [THEN allI[THEN allI[THEN cpI1], of "OclSize"]] - cp_OclIsEmpty [THEN allI[THEN allI[THEN cpI1], of "OclIsEmpty"]] - cp_OclNotEmpty [THEN allI[THEN allI[THEN cpI1], of "OclNotEmpty"]] - cp_OclANY [THEN allI[THEN allI[THEN cpI1], of "OclANY"]] - -subsubsection{* Const *} - -lemma const_OclIncluding[simp,code_unfold] : - assumes const_x : "const x" - and const_S : "const S" - shows "const (S->including\<^sub>S\<^sub>e\<^sub>t(x))" - proof - - have A:"\<And>\<tau> \<tau>'. \<not> (\<tau> \<Turnstile> \<upsilon> x) \<Longrightarrow> (S->including\<^sub>S\<^sub>e\<^sub>t(x) \<tau>) = (S->including\<^sub>S\<^sub>e\<^sub>t(x) \<tau>')" - apply(simp add: foundation18) - apply(erule const_subst[OF const_x const_invalid],simp_all) - by(rule const_charn[OF const_invalid]) - have B: "\<And> \<tau> \<tau>'. \<not> (\<tau> \<Turnstile> \<delta> S) \<Longrightarrow> (S->including\<^sub>S\<^sub>e\<^sub>t(x) \<tau>) = (S->including\<^sub>S\<^sub>e\<^sub>t(x) \<tau>')" - apply(simp add: foundation16', elim disjE) - apply(erule const_subst[OF const_S const_invalid],simp_all) - apply(rule const_charn[OF const_invalid]) - apply(erule const_subst[OF const_S const_null],simp_all) - by(rule const_charn[OF const_invalid]) - show ?thesis - apply(simp only: const_def,intro allI, rename_tac \<tau> \<tau>') - apply(case_tac "\<not> (\<tau> \<Turnstile> \<upsilon> x)", simp add: A) - apply(case_tac "\<not> (\<tau> \<Turnstile> \<delta> S)", simp_all add: B) - apply(frule_tac \<tau>'1= \<tau>' in const_OclValid2[OF const_x, THEN iffD1]) - apply(frule_tac \<tau>'1= \<tau>' in const_OclValid1[OF const_S, THEN iffD1]) - apply(simp add: OclIncluding_def OclValid_def) - apply(subst const_charn[OF const_x]) - apply(subst const_charn[OF const_S]) - by simp -qed -text_raw{* \endisatagafp *} - - -(* -lemma const_OclForall : - assumes "const X" - assumes "\<And>x \<tau>1 \<tau>2. x \<tau>1 = x \<tau>2 \<Longrightarrow> X' x \<tau>1 = X' x \<tau>2" - shows "const (OclForall X X')" - apply(simp only: const_def, intro allI) - proof - fix \<tau>1 \<tau>2 show "OclForall X X' \<tau>1 = OclForall X X' \<tau>2" - apply(subst (1 2) cp_OclForall, simp only: OclForall_def cp_defined[symmetric]) - by(simp only: const_defined[OF assms(1), simplified const_def, THEN spec, THEN spec, of \<tau>1 \<tau>2] - const_true[simplified const_def, THEN spec, THEN spec, of \<tau>1 \<tau>2] - const_false[simplified const_def, THEN spec, THEN spec, of \<tau>1 \<tau>2] - const_null[simplified const_def, THEN spec, THEN spec, of \<tau>1 \<tau>2] - const_bot[simplified const_def, THEN spec, THEN spec, of \<tau>1 \<tau>2] - assms(1)[simplified const_def, THEN spec, THEN spec, of \<tau>1 \<tau>2] - assms(2)[of _ \<tau>1 \<tau>2]) -qed - -lemma const_OclIncludes : - assumes "const X" - assumes "const X'" - shows "const (OclIncludes X X')" - apply(rule const_imply3[OF _ assms], subst (1 2) cp_OclIncludes, simp only: OclIncludes_def cp_defined[symmetric] cp_valid[symmetric]) - apply(simp add: - const_defined[OF assms(1), simplified const_def, THEN spec, THEN spec] - const_valid[OF assms(2), simplified const_def, THEN spec, THEN spec] - const_true[simplified const_def, THEN spec, THEN spec] assms[simplified const_def] - bot_option_def) -by (metis (no_types) const_def const_defined const_true const_valid cp_defined cp_valid) - -*) -subsection{* General Algebraic Execution Rules *} -subsubsection{* Execution Rules on Including *} - -lemma OclIncluding_finite_rep_set : - assumes X_def : "\<tau> \<Turnstile> \<delta> X" - and x_val : "\<tau> \<Turnstile> \<upsilon> x" - shows "finite \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (X->including\<^sub>S\<^sub>e\<^sub>t(x) \<tau>)\<rceil>\<rceil> = finite \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (X \<tau>)\<rceil>\<rceil>" - proof - - have C : "\<lfloor>\<lfloor>insert (x \<tau>) \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (X \<tau>)\<rceil>\<rceil>\<rfloor>\<rfloor> \<in> {X. X = bot \<or> X = null \<or> (\<forall>x\<in>\<lceil>\<lceil>X\<rceil>\<rceil>. x \<noteq> bot)}" - by(insert X_def x_val, frule Set_inv_lemma, simp add: foundation18 invalid_def) - show "?thesis" - by(insert X_def x_val, - auto simp: OclIncluding_def Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inverse[OF C] - dest: foundation13[THEN iffD2, THEN foundation22[THEN iffD1]]) -qed - -lemma OclIncluding_rep_set: - assumes S_def: "\<tau> \<Turnstile> \<delta> S" - shows "\<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S->including\<^sub>S\<^sub>e\<^sub>t(\<lambda>_. \<lfloor>\<lfloor>x\<rfloor>\<rfloor>) \<tau>)\<rceil>\<rceil> = insert \<lfloor>\<lfloor>x\<rfloor>\<rfloor> \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil>" - apply(simp add: OclIncluding_def S_def[simplified OclValid_def]) - apply(subst Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inverse, simp add: bot_option_def null_option_def) - apply(insert Set_inv_lemma[OF S_def], metis bot_option_def not_Some_eq) - by(simp) - -lemma OclIncluding_notempty_rep_set: - assumes X_def: "\<tau> \<Turnstile> \<delta> X" - and a_val: "\<tau> \<Turnstile> \<upsilon> a" - shows "\<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (X->including\<^sub>S\<^sub>e\<^sub>t(a) \<tau>)\<rceil>\<rceil> \<noteq> {}" - apply(simp add: OclIncluding_def X_def[simplified OclValid_def] a_val[simplified OclValid_def]) - apply(subst Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inverse, simp add: bot_option_def null_option_def) - apply(insert Set_inv_lemma[OF X_def], metis a_val foundation18') - by(simp) - -lemma OclIncluding_includes0: - assumes "\<tau> \<Turnstile> X->includes\<^sub>S\<^sub>e\<^sub>t(x)" - shows "X->including\<^sub>S\<^sub>e\<^sub>t(x) \<tau> = X \<tau>" -proof - - have includes_def: "\<tau> \<Turnstile> X->includes\<^sub>S\<^sub>e\<^sub>t(x) \<Longrightarrow> \<tau> \<Turnstile> \<delta> X" - by (metis bot_fun_def OclIncludes_def OclValid_def defined3 foundation16) - - have includes_val: "\<tau> \<Turnstile> X->includes\<^sub>S\<^sub>e\<^sub>t(x) \<Longrightarrow> \<tau> \<Turnstile> \<upsilon> x" - using foundation5 foundation6 by fastforce - - show ?thesis - apply(insert includes_def[OF assms] includes_val[OF assms] assms, - simp add: OclIncluding_def OclIncludes_def OclValid_def true_def) - apply(drule insert_absorb, simp, subst abs_rep_simp') - by(simp_all add: OclValid_def true_def) -qed - -lemma OclIncluding_includes: - assumes "\<tau> \<Turnstile> X->includes\<^sub>S\<^sub>e\<^sub>t(x)" - shows "\<tau> \<Turnstile> X->including\<^sub>S\<^sub>e\<^sub>t(x) \<triangleq> X" -by(simp add: StrongEq_def OclValid_def true_def OclIncluding_includes0[OF assms]) - -lemma OclIncluding_commute0 : - assumes S_def : "\<tau> \<Turnstile> \<delta> S" - and i_val : "\<tau> \<Turnstile> \<upsilon> i" - and j_val : "\<tau> \<Turnstile> \<upsilon> j" - shows "\<tau> \<Turnstile> ((S :: ('\<AA>, 'a::null) Set)->including\<^sub>S\<^sub>e\<^sub>t(i)->including\<^sub>S\<^sub>e\<^sub>t(j) \<triangleq> (S->including\<^sub>S\<^sub>e\<^sub>t(j)->including\<^sub>S\<^sub>e\<^sub>t(i)))" -proof - - have A : "\<lfloor>\<lfloor>insert (i \<tau>) \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil>\<rfloor>\<rfloor> \<in> {X. X = bot \<or> X = null \<or> (\<forall>x\<in>\<lceil>\<lceil>X\<rceil>\<rceil>. x \<noteq> bot)}" - by(insert S_def i_val, frule Set_inv_lemma, simp add: foundation18 invalid_def) - have B : "\<lfloor>\<lfloor>insert (j \<tau>) \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil>\<rfloor>\<rfloor> \<in> {X. X = bot \<or> X = null \<or> (\<forall>x\<in>\<lceil>\<lceil>X\<rceil>\<rceil>. x \<noteq> bot)}" - by(insert S_def j_val, frule Set_inv_lemma, simp add: foundation18 invalid_def) - - have G1 : "Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e \<lfloor>\<lfloor>insert (i \<tau>) \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil>\<rfloor>\<rfloor> \<noteq> Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e None" - by(insert A, simp add: Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inject bot_option_def null_option_def) - have G2 : "Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e \<lfloor>\<lfloor>insert (i \<tau>) \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil>\<rfloor>\<rfloor> \<noteq> Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e \<lfloor>None\<rfloor>" - by(insert A, simp add: Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inject bot_option_def null_option_def) - have G3 : "Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e \<lfloor>\<lfloor>insert (j \<tau>) \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil>\<rfloor>\<rfloor> \<noteq> Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e None" - by(insert B, simp add: Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inject bot_option_def null_option_def) - have G4 : "Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e \<lfloor>\<lfloor>insert (j \<tau>) \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil>\<rfloor>\<rfloor> \<noteq> Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e \<lfloor>None\<rfloor>" - by(insert B, simp add: Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inject bot_option_def null_option_def) - - have * : "(\<delta> (\<lambda>_. Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e \<lfloor>\<lfloor>insert (i \<tau>) \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil>\<rfloor>\<rfloor>)) \<tau> = \<lfloor>\<lfloor>True\<rfloor>\<rfloor>" - by(auto simp: OclValid_def false_def defined_def null_fun_def true_def - bot_fun_def bot_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def null_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def S_def i_val G1 G2) - - have ** : "(\<delta> (\<lambda>_. Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e \<lfloor>\<lfloor>insert (j \<tau>) \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil>\<rfloor>\<rfloor>)) \<tau> = \<lfloor>\<lfloor>True\<rfloor>\<rfloor>" - by(auto simp: OclValid_def false_def defined_def null_fun_def true_def - bot_fun_def bot_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def null_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def S_def i_val G3 G4) - - have *** : "Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e \<lfloor>\<lfloor>insert(j \<tau>)\<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e(Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e\<lfloor>\<lfloor>insert(i \<tau>)\<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e(S \<tau>)\<rceil>\<rceil>\<rfloor>\<rfloor>)\<rceil>\<rceil>\<rfloor>\<rfloor> = - Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e \<lfloor>\<lfloor>insert(i \<tau>)\<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e(Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e\<lfloor>\<lfloor>insert(j \<tau>)\<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e(S \<tau>)\<rceil>\<rceil>\<rfloor>\<rfloor>)\<rceil>\<rceil>\<rfloor>\<rfloor>" - by(simp add: Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inverse[OF A] Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inverse[OF B] Set.insert_commute) - show ?thesis - apply(simp add: OclIncluding_def S_def[simplified OclValid_def] - i_val[simplified OclValid_def] j_val[simplified OclValid_def] - true_def OclValid_def StrongEq_def) - apply(subst cp_defined, - simp add: S_def[simplified OclValid_def] - i_val[simplified OclValid_def] j_val[simplified OclValid_def] true_def *) - apply(subst cp_defined, - simp add: S_def[simplified OclValid_def] - i_val[simplified OclValid_def] j_val[simplified OclValid_def] true_def ** ***) - apply(subst cp_defined, - simp add: S_def[simplified OclValid_def] - i_val[simplified OclValid_def] j_val[simplified OclValid_def] true_def *) - apply(subst cp_defined, - simp add: S_def[simplified OclValid_def] - i_val[simplified OclValid_def] j_val[simplified OclValid_def] true_def * ) - apply(subst cp_defined, - simp add: S_def[simplified OclValid_def] - i_val[simplified OclValid_def] j_val[simplified OclValid_def] true_def * **) - done -qed - - -lemma OclIncluding_commute[simp,code_unfold]: -"((S :: ('\<AA>, 'a::null) Set)->including\<^sub>S\<^sub>e\<^sub>t(i)->including\<^sub>S\<^sub>e\<^sub>t(j) = (S->including\<^sub>S\<^sub>e\<^sub>t(j)->including\<^sub>S\<^sub>e\<^sub>t(i)))" -proof - - have A: "\<And> \<tau>. \<tau> \<Turnstile> (i \<triangleq> invalid) \<Longrightarrow> (S->including\<^sub>S\<^sub>e\<^sub>t(i)->including\<^sub>S\<^sub>e\<^sub>t(j)) \<tau> = invalid \<tau>" - apply(rule foundation22[THEN iffD1]) - by(erule StrongEq_L_subst2_rev, simp,simp) - have A': "\<And> \<tau>. \<tau> \<Turnstile> (i \<triangleq> invalid) \<Longrightarrow> (S->including\<^sub>S\<^sub>e\<^sub>t(j)->including\<^sub>S\<^sub>e\<^sub>t(i)) \<tau> = invalid \<tau>" - apply(rule foundation22[THEN iffD1]) - by(erule StrongEq_L_subst2_rev, simp,simp) - have B:"\<And> \<tau>. \<tau> \<Turnstile> (j \<triangleq> invalid) \<Longrightarrow> (S->including\<^sub>S\<^sub>e\<^sub>t(i)->including\<^sub>S\<^sub>e\<^sub>t(j)) \<tau> = invalid \<tau>" - apply(rule foundation22[THEN iffD1]) - by(erule StrongEq_L_subst2_rev, simp,simp) - have B':"\<And> \<tau>. \<tau> \<Turnstile> (j \<triangleq> invalid) \<Longrightarrow> (S->including\<^sub>S\<^sub>e\<^sub>t(j)->including\<^sub>S\<^sub>e\<^sub>t(i)) \<tau> = invalid \<tau>" - apply(rule foundation22[THEN iffD1]) - by(erule StrongEq_L_subst2_rev, simp,simp) - have C: "\<And> \<tau>. \<tau> \<Turnstile> (S \<triangleq> invalid) \<Longrightarrow> (S->including\<^sub>S\<^sub>e\<^sub>t(i)->including\<^sub>S\<^sub>e\<^sub>t(j)) \<tau> = invalid \<tau>" - apply(rule foundation22[THEN iffD1]) - by(erule StrongEq_L_subst2_rev, simp,simp) - have C': "\<And> \<tau>. \<tau> \<Turnstile> (S \<triangleq> invalid) \<Longrightarrow> (S->including\<^sub>S\<^sub>e\<^sub>t(j)->including\<^sub>S\<^sub>e\<^sub>t(i)) \<tau> = invalid \<tau>" - apply(rule foundation22[THEN iffD1]) - by(erule StrongEq_L_subst2_rev, simp,simp) - have D: "\<And> \<tau>. \<tau> \<Turnstile> (S \<triangleq> null) \<Longrightarrow> (S->including\<^sub>S\<^sub>e\<^sub>t(i)->including\<^sub>S\<^sub>e\<^sub>t(j)) \<tau> = invalid \<tau>" - apply(rule foundation22[THEN iffD1]) - by(erule StrongEq_L_subst2_rev, simp,simp) - have D': "\<And> \<tau>. \<tau> \<Turnstile> (S \<triangleq> null) \<Longrightarrow> (S->including\<^sub>S\<^sub>e\<^sub>t(j)->including\<^sub>S\<^sub>e\<^sub>t(i)) \<tau> = invalid \<tau>" - apply(rule foundation22[THEN iffD1]) - by(erule StrongEq_L_subst2_rev, simp,simp) - show ?thesis - apply(rule ext, rename_tac \<tau>) - apply(case_tac "\<tau> \<Turnstile> (\<upsilon> i)") - apply(case_tac "\<tau> \<Turnstile> (\<upsilon> j)") - apply(case_tac "\<tau> \<Turnstile> (\<delta> S)") - apply(simp only: OclIncluding_commute0[THEN foundation22[THEN iffD1]]) - apply(simp add: foundation16', elim disjE) - apply(simp add: C[OF foundation22[THEN iffD2]] C'[OF foundation22[THEN iffD2]]) - apply(simp add: D[OF foundation22[THEN iffD2]] D'[OF foundation22[THEN iffD2]]) - apply(simp add:foundation18 B[OF foundation22[THEN iffD2]] B'[OF foundation22[THEN iffD2]]) - apply(simp add:foundation18 A[OF foundation22[THEN iffD2]] A'[OF foundation22[THEN iffD2]]) - done -qed - - -subsubsection{* Execution Rules on Excluding *} - -lemma OclExcluding_finite_rep_set : - assumes X_def : "\<tau> \<Turnstile> \<delta> X" - and x_val : "\<tau> \<Turnstile> \<upsilon> x" - shows "finite \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (X->excluding\<^sub>S\<^sub>e\<^sub>t(x) \<tau>)\<rceil>\<rceil> = finite \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (X \<tau>)\<rceil>\<rceil>" - proof - - have C : "\<lfloor>\<lfloor>\<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (X \<tau>)\<rceil>\<rceil> - {x \<tau>}\<rfloor>\<rfloor> \<in> {X. X = bot \<or> X = null \<or> (\<forall>x\<in>\<lceil>\<lceil>X\<rceil>\<rceil>. x \<noteq> bot)}" - apply(insert X_def x_val, frule Set_inv_lemma) - apply(simp add: foundation18 invalid_def) - done - show "?thesis" - by(insert X_def x_val, - auto simp: OclExcluding_def Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inverse[OF C] - dest: foundation13[THEN iffD2, THEN foundation22[THEN iffD1]]) -qed - -lemma OclExcluding_rep_set: - assumes S_def: "\<tau> \<Turnstile> \<delta> S" - shows "\<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S->excluding\<^sub>S\<^sub>e\<^sub>t(\<lambda>_. \<lfloor>\<lfloor>x\<rfloor>\<rfloor>) \<tau>)\<rceil>\<rceil> = \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil> - {\<lfloor>\<lfloor>x\<rfloor>\<rfloor>}" - apply(simp add: OclExcluding_def S_def[simplified OclValid_def]) - apply(subst Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inverse, simp add: bot_option_def null_option_def) - apply(insert Set_inv_lemma[OF S_def], metis Diff_iff bot_option_def not_None_eq) -by(simp) - -lemma OclExcluding_excludes0: - assumes "\<tau> \<Turnstile> X->excludes\<^sub>S\<^sub>e\<^sub>t(x)" - shows "X->excluding\<^sub>S\<^sub>e\<^sub>t(x) \<tau> = X \<tau>" -proof - - have excludes_def: "\<tau> \<Turnstile> X->excludes\<^sub>S\<^sub>e\<^sub>t(x) \<Longrightarrow> \<tau> \<Turnstile> \<delta> X" - by (metis OclExcludes.def_valid_then_def OclExcludes_valid_args_valid'' foundation10' foundation6) - - have excludes_val: "\<tau> \<Turnstile> X->excludes\<^sub>S\<^sub>e\<^sub>t(x) \<Longrightarrow> \<tau> \<Turnstile> \<upsilon> x" - by (metis OclExcludes.def_valid_then_def OclExcludes_valid_args_valid'' foundation10' foundation6) - - show ?thesis - apply(insert excludes_def[OF assms] excludes_val[OF assms] assms, - simp add: OclExcluding_def OclExcludes_def OclIncludes_def OclNot_def OclValid_def true_def) - by (metis (hide_lams, no_types) abs_rep_simp' assms excludes_def) -qed - -lemma OclExcluding_excludes: - assumes "\<tau> \<Turnstile> X->excludes\<^sub>S\<^sub>e\<^sub>t(x)" - shows "\<tau> \<Turnstile> X->excluding\<^sub>S\<^sub>e\<^sub>t(x) \<triangleq> X" -by(simp add: StrongEq_def OclValid_def true_def OclExcluding_excludes0[OF assms]) - -lemma OclExcluding_charn0[simp]: -assumes val_x:"\<tau> \<Turnstile> (\<upsilon> x)" -shows "\<tau> \<Turnstile> ((Set{}->excluding\<^sub>S\<^sub>e\<^sub>t(x)) \<triangleq> Set{})" -proof - - have A : "\<lfloor>None\<rfloor> \<in> {X. X = bot \<or> X = null \<or> (\<forall>x\<in>\<lceil>\<lceil>X\<rceil>\<rceil>. x \<noteq> bot)}" - by(simp add: null_option_def bot_option_def) - have B : "\<lfloor>\<lfloor>{}\<rfloor>\<rfloor> \<in> {X. X = bot \<or> X = null \<or> (\<forall>x\<in>\<lceil>\<lceil>X\<rceil>\<rceil>. x \<noteq> bot)}" by(simp add: mtSet_def) - - show ?thesis using val_x - apply(auto simp: OclValid_def OclIncludes_def OclNot_def false_def true_def StrongEq_def - OclExcluding_def mtSet_def defined_def bot_fun_def null_fun_def null_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def) - apply(auto simp: mtSet_def Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e.Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inverse - Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e.Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inject[OF B A]) - done -qed - -lemma OclExcluding_commute0 : - assumes S_def : "\<tau> \<Turnstile> \<delta> S" - and i_val : "\<tau> \<Turnstile> \<upsilon> i" - and j_val : "\<tau> \<Turnstile> \<upsilon> j" - shows "\<tau> \<Turnstile> ((S :: ('\<AA>, 'a::null) Set)->excluding\<^sub>S\<^sub>e\<^sub>t(i)->excluding\<^sub>S\<^sub>e\<^sub>t(j) \<triangleq> (S->excluding\<^sub>S\<^sub>e\<^sub>t(j)->excluding\<^sub>S\<^sub>e\<^sub>t(i)))" -proof - - have A : "\<lfloor>\<lfloor>\<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil> - {i \<tau>}\<rfloor>\<rfloor> \<in> {X. X = bot \<or> X = null \<or> (\<forall>x\<in>\<lceil>\<lceil>X\<rceil>\<rceil>. x \<noteq> bot)}" - by(insert S_def i_val, frule Set_inv_lemma, simp add: foundation18 invalid_def) - have B : "\<lfloor>\<lfloor>\<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil> - {j \<tau>}\<rfloor>\<rfloor> \<in> {X. X = bot \<or> X = null \<or> (\<forall>x\<in>\<lceil>\<lceil>X\<rceil>\<rceil>. x \<noteq> bot)}" - by(insert S_def j_val, frule Set_inv_lemma, simp add: foundation18 invalid_def) - - have G1 : "Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e \<lfloor>\<lfloor>\<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil> - {i \<tau>}\<rfloor>\<rfloor> \<noteq> Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e None" - by(insert A, simp add: Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inject bot_option_def null_option_def) - have G2 : "Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e \<lfloor>\<lfloor>\<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil> - {i \<tau>}\<rfloor>\<rfloor> \<noteq> Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e \<lfloor>None\<rfloor>" - by(insert A, simp add: Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inject bot_option_def null_option_def) - have G3 : "Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e \<lfloor>\<lfloor>\<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil> - {j \<tau>}\<rfloor>\<rfloor> \<noteq> Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e None" - by(insert B, simp add: Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inject bot_option_def null_option_def) - have G4 : "Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e \<lfloor>\<lfloor>\<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil> - {j \<tau>}\<rfloor>\<rfloor> \<noteq> Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e \<lfloor>None\<rfloor>" - by(insert B, simp add: Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inject bot_option_def null_option_def) - - have * : "(\<delta> (\<lambda>_. Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e \<lfloor>\<lfloor>\<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil> - {i \<tau>}\<rfloor>\<rfloor>)) \<tau> = \<lfloor>\<lfloor>True\<rfloor>\<rfloor>" - by(auto simp: OclValid_def false_def defined_def null_fun_def true_def - bot_fun_def bot_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def null_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def S_def i_val G1 G2) - - have ** : "(\<delta> (\<lambda>_. Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e \<lfloor>\<lfloor>\<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil> - {j \<tau>}\<rfloor>\<rfloor>)) \<tau> = \<lfloor>\<lfloor>True\<rfloor>\<rfloor>" - by(auto simp: OclValid_def false_def defined_def null_fun_def true_def - bot_fun_def bot_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def null_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def S_def i_val G3 G4) - - have *** : "Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e \<lfloor>\<lfloor>\<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e(Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e\<lfloor>\<lfloor>\<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e(S \<tau>)\<rceil>\<rceil>-{i \<tau>}\<rfloor>\<rfloor>)\<rceil>\<rceil>-{j \<tau>}\<rfloor>\<rfloor> = - Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e \<lfloor>\<lfloor>\<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e(Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e\<lfloor>\<lfloor>\<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e(S \<tau>)\<rceil>\<rceil>-{j \<tau>}\<rfloor>\<rfloor>)\<rceil>\<rceil>-{i \<tau>}\<rfloor>\<rfloor>" - apply(simp add: Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inverse[OF A] Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inverse[OF B]) - by (metis Diff_insert2 insert_commute) - show ?thesis - apply(simp add: OclExcluding_def S_def[simplified OclValid_def] - i_val[simplified OclValid_def] j_val[simplified OclValid_def] - true_def OclValid_def StrongEq_def) - apply(subst cp_defined, - simp add: S_def[simplified OclValid_def] - i_val[simplified OclValid_def] j_val[simplified OclValid_def] true_def *) - apply(subst cp_defined, - simp add: S_def[simplified OclValid_def] - i_val[simplified OclValid_def] j_val[simplified OclValid_def] true_def ** ***) - apply(subst cp_defined, - simp add: S_def[simplified OclValid_def] - i_val[simplified OclValid_def] j_val[simplified OclValid_def] true_def *) - apply(subst cp_defined, - simp add: S_def[simplified OclValid_def] - i_val[simplified OclValid_def] j_val[simplified OclValid_def] true_def * ) - apply(subst cp_defined, - simp add: S_def[simplified OclValid_def] - i_val[simplified OclValid_def] j_val[simplified OclValid_def] true_def * **) - done -qed - - -lemma OclExcluding_commute[simp,code_unfold]: -"((S :: ('\<AA>, 'a::null) Set)->excluding\<^sub>S\<^sub>e\<^sub>t(i)->excluding\<^sub>S\<^sub>e\<^sub>t(j) = (S->excluding\<^sub>S\<^sub>e\<^sub>t(j)->excluding\<^sub>S\<^sub>e\<^sub>t(i)))" -proof - - have A: "\<And> \<tau>. \<tau> \<Turnstile> i \<triangleq> invalid \<Longrightarrow> (S->excluding\<^sub>S\<^sub>e\<^sub>t(i)->excluding\<^sub>S\<^sub>e\<^sub>t(j)) \<tau> = invalid \<tau>" - apply(rule foundation22[THEN iffD1]) - by(erule StrongEq_L_subst2_rev, simp,simp) - have A': "\<And> \<tau>. \<tau> \<Turnstile> i \<triangleq> invalid \<Longrightarrow> (S->excluding\<^sub>S\<^sub>e\<^sub>t(j)->excluding\<^sub>S\<^sub>e\<^sub>t(i)) \<tau> = invalid \<tau>" - apply(rule foundation22[THEN iffD1]) - by(erule StrongEq_L_subst2_rev, simp,simp) - have B:"\<And> \<tau>. \<tau> \<Turnstile> j \<triangleq> invalid \<Longrightarrow> (S->excluding\<^sub>S\<^sub>e\<^sub>t(i)->excluding\<^sub>S\<^sub>e\<^sub>t(j)) \<tau> = invalid \<tau>" - apply(rule foundation22[THEN iffD1]) - by(erule StrongEq_L_subst2_rev, simp,simp) - have B':"\<And> \<tau>. \<tau> \<Turnstile> j \<triangleq> invalid \<Longrightarrow> (S->excluding\<^sub>S\<^sub>e\<^sub>t(j)->excluding\<^sub>S\<^sub>e\<^sub>t(i)) \<tau> = invalid \<tau>" - apply(rule foundation22[THEN iffD1]) - by(erule StrongEq_L_subst2_rev, simp,simp) - have C: "\<And> \<tau>. \<tau> \<Turnstile> S \<triangleq> invalid \<Longrightarrow> (S->excluding\<^sub>S\<^sub>e\<^sub>t(i)->excluding\<^sub>S\<^sub>e\<^sub>t(j)) \<tau> = invalid \<tau>" - apply(rule foundation22[THEN iffD1]) - by(erule StrongEq_L_subst2_rev, simp,simp) - have C': "\<And> \<tau>. \<tau> \<Turnstile> S \<triangleq> invalid \<Longrightarrow> (S->excluding\<^sub>S\<^sub>e\<^sub>t(j)->excluding\<^sub>S\<^sub>e\<^sub>t(i)) \<tau> = invalid \<tau>" - apply(rule foundation22[THEN iffD1]) - by(erule StrongEq_L_subst2_rev, simp,simp) - have D: "\<And> \<tau>. \<tau> \<Turnstile> S \<triangleq> null \<Longrightarrow> (S->excluding\<^sub>S\<^sub>e\<^sub>t(i)->excluding\<^sub>S\<^sub>e\<^sub>t(j)) \<tau> = invalid \<tau>" - apply(rule foundation22[THEN iffD1]) - by(erule StrongEq_L_subst2_rev, simp,simp) - have D': "\<And> \<tau>. \<tau> \<Turnstile> S \<triangleq> null \<Longrightarrow> (S->excluding\<^sub>S\<^sub>e\<^sub>t(j)->excluding\<^sub>S\<^sub>e\<^sub>t(i)) \<tau> = invalid \<tau>" - apply(rule foundation22[THEN iffD1]) - by(erule StrongEq_L_subst2_rev, simp,simp) - show ?thesis - apply(rule ext, rename_tac \<tau>) - apply(case_tac "\<tau> \<Turnstile> (\<upsilon> i)") - apply(case_tac "\<tau> \<Turnstile> (\<upsilon> j)") - apply(case_tac "\<tau> \<Turnstile> (\<delta> S)") - apply(simp only: OclExcluding_commute0[THEN foundation22[THEN iffD1]]) - apply(simp add: foundation16', elim disjE) - apply(simp add: C[OF foundation22[THEN iffD2]] C'[OF foundation22[THEN iffD2]]) - apply(simp add: D[OF foundation22[THEN iffD2]] D'[OF foundation22[THEN iffD2]]) - apply(simp add:foundation18 B[OF foundation22[THEN iffD2]] B'[OF foundation22[THEN iffD2]]) - apply(simp add:foundation18 A[OF foundation22[THEN iffD2]] A'[OF foundation22[THEN iffD2]]) - done -qed - - -lemma OclExcluding_charn0_exec[simp,code_unfold]: -"(Set{}->excluding\<^sub>S\<^sub>e\<^sub>t(x)) = (if (\<upsilon> x) then Set{} else invalid endif)" -proof - - have A: "\<And> \<tau>. (Set{}->excluding\<^sub>S\<^sub>e\<^sub>t(invalid)) \<tau> = (if (\<upsilon> invalid) then Set{} else invalid endif) \<tau>" - by simp - have B: "\<And> \<tau> x. \<tau> \<Turnstile> (\<upsilon> x) \<Longrightarrow> - (Set{}->excluding\<^sub>S\<^sub>e\<^sub>t(x)) \<tau> = (if (\<upsilon> x) then Set{} else invalid endif) \<tau>" - by(simp add: OclExcluding_charn0[THEN foundation22[THEN iffD1]]) - show ?thesis - apply(rule ext, rename_tac \<tau>) - apply(case_tac "\<tau> \<Turnstile> (\<upsilon> x)") - apply(simp add: B) - apply(simp add: foundation18) - apply(subst OclExcluding.cp0, simp) - apply(simp add: cp_OclIf[symmetric] OclExcluding.cp0[symmetric] cp_valid[symmetric] A) - done -qed - -lemma OclExcluding_charn1: -assumes def_X:"\<tau> \<Turnstile> (\<delta> X)" -and val_x:"\<tau> \<Turnstile> (\<upsilon> x)" -and val_y:"\<tau> \<Turnstile> (\<upsilon> y)" -and neq :"\<tau> \<Turnstile> not(x \<triangleq> y)" -shows "\<tau> \<Turnstile> ((X->including\<^sub>S\<^sub>e\<^sub>t(x))->excluding\<^sub>S\<^sub>e\<^sub>t(y)) \<triangleq> ((X->excluding\<^sub>S\<^sub>e\<^sub>t(y))->including\<^sub>S\<^sub>e\<^sub>t(x))" -proof - - have C : "\<lfloor>\<lfloor>insert (x \<tau>) \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (X \<tau>)\<rceil>\<rceil>\<rfloor>\<rfloor> \<in> {X. X = bot \<or> X = null \<or> (\<forall>x\<in>\<lceil>\<lceil>X\<rceil>\<rceil>. x \<noteq> bot)}" - by(insert def_X val_x, frule Set_inv_lemma, simp add: foundation18 invalid_def) - have D : "\<lfloor>\<lfloor>\<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (X \<tau>)\<rceil>\<rceil> - {y \<tau>}\<rfloor>\<rfloor> \<in> {X. X = bot \<or> X = null \<or> (\<forall>x\<in>\<lceil>\<lceil>X\<rceil>\<rceil>. x \<noteq> bot)}" - by(insert def_X val_x, frule Set_inv_lemma, simp add: foundation18 invalid_def) - have E : "x \<tau> \<noteq> y \<tau>" - by(insert neq, - auto simp: OclValid_def bot_fun_def OclIncluding_def OclIncludes_def - false_def true_def defined_def valid_def bot_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def - null_fun_def null_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def StrongEq_def OclNot_def) - - have G1 : "Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e \<lfloor>\<lfloor>insert (x \<tau>) \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (X \<tau>)\<rceil>\<rceil>\<rfloor>\<rfloor> \<noteq> Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e None" - by(insert C, simp add: Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inject bot_option_def null_option_def) - have G2 : "Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e \<lfloor>\<lfloor>insert (x \<tau>) \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (X \<tau>)\<rceil>\<rceil>\<rfloor>\<rfloor> \<noteq> Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e \<lfloor>None\<rfloor>" - by(insert C, simp add: Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inject bot_option_def null_option_def) - have G : "(\<delta> (\<lambda>_. Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e \<lfloor>\<lfloor>insert (x \<tau>) \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (X \<tau>)\<rceil>\<rceil>\<rfloor>\<rfloor>)) \<tau> = true \<tau>" - by(auto simp: OclValid_def false_def true_def defined_def - bot_fun_def bot_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def null_fun_def null_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def G1 G2) - - have H1 : "Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e \<lfloor>\<lfloor>\<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (X \<tau>)\<rceil>\<rceil> - {y \<tau>}\<rfloor>\<rfloor> \<noteq> Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e None" - by(insert D, simp add: Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inject bot_option_def null_option_def) - have H2 : "Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e \<lfloor>\<lfloor>\<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (X \<tau>)\<rceil>\<rceil> - {y \<tau>}\<rfloor>\<rfloor> \<noteq> Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e \<lfloor>None\<rfloor>" - by(insert D, simp add: Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inject bot_option_def null_option_def) - have H : "(\<delta> (\<lambda>_. Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e \<lfloor>\<lfloor>\<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (X \<tau>)\<rceil>\<rceil> - {y \<tau>}\<rfloor>\<rfloor>)) \<tau> = true \<tau>" - by(auto simp: OclValid_def false_def true_def defined_def - bot_fun_def bot_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def null_fun_def null_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def H1 H2) - - have Z : "insert (x \<tau>) \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (X \<tau>)\<rceil>\<rceil> - {y \<tau>} = insert (x \<tau>) (\<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (X \<tau>)\<rceil>\<rceil> - {y \<tau>})" - by(auto simp: E) - show ?thesis - apply(insert def_X[THEN foundation13[THEN iffD2]] val_x[THEN foundation13[THEN iffD2]] - val_y[THEN foundation13[THEN iffD2]]) - apply(simp add: foundation22 OclIncluding_def OclExcluding_def def_X[THEN foundation16[THEN iffD1]]) - apply(subst cp_defined, simp)+ - apply(simp add: G H Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inverse[OF C] Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inverse[OF D] Z) - done -qed - - - -lemma OclExcluding_charn2: -assumes def_X:"\<tau> \<Turnstile> (\<delta> X)" -and val_x:"\<tau> \<Turnstile> (\<upsilon> x)" -shows "\<tau> \<Turnstile> (((X->including\<^sub>S\<^sub>e\<^sub>t(x))->excluding\<^sub>S\<^sub>e\<^sub>t(x)) \<triangleq> (X->excluding\<^sub>S\<^sub>e\<^sub>t(x)))" -proof - - have C : "\<lfloor>\<lfloor>insert (x \<tau>) \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (X \<tau>)\<rceil>\<rceil>\<rfloor>\<rfloor> \<in> {X. X = bot \<or> X = null \<or> (\<forall>x\<in>\<lceil>\<lceil>X\<rceil>\<rceil>. x \<noteq> bot)}" - by(insert def_X val_x, frule Set_inv_lemma, simp add: foundation18 invalid_def) - have G1 : "Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e \<lfloor>\<lfloor>insert (x \<tau>) \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (X \<tau>)\<rceil>\<rceil>\<rfloor>\<rfloor> \<noteq> Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e None" - by(insert C, simp add: Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inject bot_option_def null_option_def) - have G2 : "Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e \<lfloor>\<lfloor>insert (x \<tau>) \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (X \<tau>)\<rceil>\<rceil>\<rfloor>\<rfloor> \<noteq> Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e \<lfloor>None\<rfloor>" - by(insert C, simp add: Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inject bot_option_def null_option_def) - show ?thesis - apply(insert def_X[THEN foundation16[THEN iffD1]] - val_x[THEN foundation18[THEN iffD1]]) - apply(auto simp: OclValid_def bot_fun_def OclIncluding_def OclIncludes_def false_def true_def - invalid_def defined_def valid_def bot_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def null_fun_def null_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def - StrongEq_def) - apply(subst OclExcluding.cp0) - apply(auto simp:OclExcluding_def) - apply(simp add: Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inverse[OF C]) - apply(simp_all add: false_def true_def defined_def valid_def - null_fun_def bot_fun_def null_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def bot_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def - split: bool.split_asm HOL.if_split_asm option.split) - apply(auto simp: G1 G2) - done -qed - - - - -theorem OclExcluding_charn3: "((X->including\<^sub>S\<^sub>e\<^sub>t(x))->excluding\<^sub>S\<^sub>e\<^sub>t(x)) = (X->excluding\<^sub>S\<^sub>e\<^sub>t(x))" -proof - - have A1 : "\<And>\<tau>. \<tau> \<Turnstile> (X \<triangleq> invalid) \<Longrightarrow> (X->including\<^sub>S\<^sub>e\<^sub>t(x)->excluding\<^sub>S\<^sub>e\<^sub>t(x)) \<tau> = invalid \<tau>" - apply(rule foundation22[THEN iffD1]) - by(erule StrongEq_L_subst2_rev, simp,simp) - have A1': "\<And>\<tau>. \<tau> \<Turnstile> (X \<triangleq> invalid) \<Longrightarrow> (X->excluding\<^sub>S\<^sub>e\<^sub>t(x)) \<tau> = invalid \<tau>" - apply(rule foundation22[THEN iffD1]) - by(erule StrongEq_L_subst2_rev, simp,simp) - have A2 : "\<And>\<tau>. \<tau> \<Turnstile> (X \<triangleq> null) \<Longrightarrow> (X->including\<^sub>S\<^sub>e\<^sub>t(x)->excluding\<^sub>S\<^sub>e\<^sub>t(x)) \<tau> = invalid \<tau>" - apply(rule foundation22[THEN iffD1]) - by(erule StrongEq_L_subst2_rev, simp,simp) - have A2': "\<And>\<tau>. \<tau> \<Turnstile> (X \<triangleq> null) \<Longrightarrow> (X->excluding\<^sub>S\<^sub>e\<^sub>t(x)) \<tau> = invalid \<tau>" - apply(rule foundation22[THEN iffD1]) - by(erule StrongEq_L_subst2_rev, simp,simp) - have A3 : "\<And>\<tau>. \<tau> \<Turnstile> (x \<triangleq> invalid) \<Longrightarrow> (X->including\<^sub>S\<^sub>e\<^sub>t(x)->excluding\<^sub>S\<^sub>e\<^sub>t(x)) \<tau> = invalid \<tau>" - apply(rule foundation22[THEN iffD1]) - by(erule StrongEq_L_subst2_rev, simp,simp) - have A3': "\<And>\<tau>. \<tau> \<Turnstile> (x \<triangleq> invalid) \<Longrightarrow> (X->excluding\<^sub>S\<^sub>e\<^sub>t(x)) \<tau> = invalid \<tau>" - apply(rule foundation22[THEN iffD1]) - by(erule StrongEq_L_subst2_rev, simp,simp) - - show ?thesis - apply(rule ext, rename_tac "\<tau>") - apply(case_tac "\<tau> \<Turnstile> (\<upsilon> x)") - apply(case_tac "\<tau> \<Turnstile> (\<delta> X)") - apply(simp only: OclExcluding_charn2[THEN foundation22[THEN iffD1]]) - apply(simp add: foundation16', elim disjE) - apply(simp add: A1[OF foundation22[THEN iffD2]] A1'[OF foundation22[THEN iffD2]]) - apply(simp add: A2[OF foundation22[THEN iffD2]] A2'[OF foundation22[THEN iffD2]]) - apply(simp add:foundation18 A3[OF foundation22[THEN iffD2]] A3'[OF foundation22[THEN iffD2]]) - done -qed - - -text{* One would like a generic theorem of the form: -\begin{isar}[mathescape] -lemma OclExcluding_charn_exec: - "(X->including$_{Set}$(x::('$\mathfrak{A}$,'a::null)val)->excluding$_{Set}$(y)) = - (if \<delta> X then if x \<doteq> y - then X->excluding$_{Set}$(y) - else X->excluding$_{Set}$(y)->including$_{Set}$(x) - endif - else invalid endif)" -\end{isar} -Unfortunately, this does not hold in general, since referential equality is -an overloaded concept and has to be defined for each type individually. -Consequently, it is only valid for concrete type instances for Boolean, -Integer, and Sets thereof... -*} - - -text{* The computational law \emph{OclExcluding-charn-exec} becomes generic since it -uses strict equality which in itself is generic. It is possible to prove -the following generic theorem and instantiate it later (using properties -that link the polymorphic logical strong equality with the concrete instance -of strict quality).*} -lemma OclExcluding_charn_exec: - assumes strict1: "(invalid \<doteq> y) = invalid" - and strict2: "(x \<doteq> invalid) = invalid" - and StrictRefEq_valid_args_valid: "\<And> (x::('\<AA>,'a::null)val) y \<tau>. - (\<tau> \<Turnstile> \<delta> (x \<doteq> y)) = ((\<tau> \<Turnstile> (\<upsilon> x)) \<and> (\<tau> \<Turnstile> \<upsilon> y))" - and cp_StrictRefEq: "\<And> (X::('\<AA>,'a::null)val) Y \<tau>. (X \<doteq> Y) \<tau> = ((\<lambda>_. X \<tau>) \<doteq> (\<lambda>_. Y \<tau>)) \<tau>" - and StrictRefEq_vs_StrongEq: "\<And> (x::('\<AA>,'a::null)val) y \<tau>. - \<tau> \<Turnstile> \<upsilon> x \<Longrightarrow> \<tau> \<Turnstile> \<upsilon> y \<Longrightarrow> (\<tau> \<Turnstile> ((x \<doteq> y) \<triangleq> (x \<triangleq> y)))" - shows "(X->including\<^sub>S\<^sub>e\<^sub>t(x::('\<AA>,'a::null)val)->excluding\<^sub>S\<^sub>e\<^sub>t(y)) = - (if \<delta> X then if x \<doteq> y - then X->excluding\<^sub>S\<^sub>e\<^sub>t(y) - else X->excluding\<^sub>S\<^sub>e\<^sub>t(y)->including\<^sub>S\<^sub>e\<^sub>t(x) - endif - else invalid endif)" -proof - - (* Lifting theorems, largely analogous OclIncludes_execute_generic, - with the same problems wrt. strict equality. *) - have A1: "\<And>\<tau>. \<tau> \<Turnstile> (X \<triangleq> invalid) \<Longrightarrow> - (X->including\<^sub>S\<^sub>e\<^sub>t(x)->includes\<^sub>S\<^sub>e\<^sub>t(y)) \<tau> = invalid \<tau>" - apply(rule foundation22[THEN iffD1]) - by(erule StrongEq_L_subst2_rev, simp,simp) - - have B1: "\<And>\<tau>. \<tau> \<Turnstile> (X \<triangleq> null) \<Longrightarrow> - (X->including\<^sub>S\<^sub>e\<^sub>t(x)->includes\<^sub>S\<^sub>e\<^sub>t(y)) \<tau> = invalid \<tau>" - apply(rule foundation22[THEN iffD1]) - by(erule StrongEq_L_subst2_rev, simp,simp) - - have A2: "\<And>\<tau>. \<tau> \<Turnstile> (X \<triangleq> invalid) \<Longrightarrow> X->including\<^sub>S\<^sub>e\<^sub>t(x)->excluding\<^sub>S\<^sub>e\<^sub>t(y) \<tau> = invalid \<tau>" - apply(rule foundation22[THEN iffD1]) - by(erule StrongEq_L_subst2_rev, simp,simp) - - have B2: "\<And>\<tau>. \<tau> \<Turnstile> (X \<triangleq> null) \<Longrightarrow> X->including\<^sub>S\<^sub>e\<^sub>t(x)->excluding\<^sub>S\<^sub>e\<^sub>t(y) \<tau> = invalid \<tau>" - apply(rule foundation22[THEN iffD1]) - by(erule StrongEq_L_subst2_rev, simp,simp) - - note [simp] = cp_StrictRefEq [THEN allI[THEN allI[THEN allI[THEN cpI2]], of "StrictRefEq"]] - - have C: "\<And>\<tau>. \<tau> \<Turnstile> (x \<triangleq> invalid) \<Longrightarrow> - (X->including\<^sub>S\<^sub>e\<^sub>t(x)->excluding\<^sub>S\<^sub>e\<^sub>t(y)) \<tau> = - (if x \<doteq> y then X->excluding\<^sub>S\<^sub>e\<^sub>t(y) else X->excluding\<^sub>S\<^sub>e\<^sub>t(y)->including\<^sub>S\<^sub>e\<^sub>t(x) endif) \<tau>" - apply(rule foundation22[THEN iffD1]) - apply(erule StrongEq_L_subst2_rev,simp,simp) - by(simp add: strict1) - - have D: "\<And>\<tau>. \<tau> \<Turnstile> (y \<triangleq> invalid) \<Longrightarrow> - (X->including\<^sub>S\<^sub>e\<^sub>t(x)->excluding\<^sub>S\<^sub>e\<^sub>t(y)) \<tau> = - (if x \<doteq> y then X->excluding\<^sub>S\<^sub>e\<^sub>t(y) else X->excluding\<^sub>S\<^sub>e\<^sub>t(y)->including\<^sub>S\<^sub>e\<^sub>t(x) endif) \<tau>" - apply(rule foundation22[THEN iffD1]) - apply(erule StrongEq_L_subst2_rev,simp,simp) - by (simp add: strict2) - - have E: "\<And>\<tau>. \<tau> \<Turnstile> \<upsilon> x \<Longrightarrow> \<tau> \<Turnstile> \<upsilon> y \<Longrightarrow> - (if x \<doteq> y then X->excluding\<^sub>S\<^sub>e\<^sub>t(y) else X->excluding\<^sub>S\<^sub>e\<^sub>t(y)->including\<^sub>S\<^sub>e\<^sub>t(x) endif) \<tau> = - (if x \<triangleq> y then X->excluding\<^sub>S\<^sub>e\<^sub>t(y) else X->excluding\<^sub>S\<^sub>e\<^sub>t(y)->including\<^sub>S\<^sub>e\<^sub>t(x) endif) \<tau>" - apply(subst cp_OclIf) - apply(subst StrictRefEq_vs_StrongEq[THEN foundation22[THEN iffD1]]) - by(simp_all add: cp_OclIf[symmetric]) - - have F: "\<And>\<tau>. \<tau> \<Turnstile> \<delta> X \<Longrightarrow> \<tau> \<Turnstile> \<upsilon> x \<Longrightarrow> \<tau> \<Turnstile> (x \<triangleq> y) \<Longrightarrow> - (X->including\<^sub>S\<^sub>e\<^sub>t(x)->excluding\<^sub>S\<^sub>e\<^sub>t(y) \<tau>) = (X->excluding\<^sub>S\<^sub>e\<^sub>t(y) \<tau>)" - apply(drule StrongEq_L_sym) - apply(rule foundation22[THEN iffD1]) - apply(erule StrongEq_L_subst2_rev,simp) - by(simp add: OclExcluding_charn2) - - show ?thesis - apply(rule ext, rename_tac "\<tau>") - apply(case_tac "\<not> (\<tau> \<Turnstile> (\<delta> X))", simp add:defined_split,elim disjE A1 B1 A2 B2) - apply(case_tac "\<not> (\<tau> \<Turnstile> (\<upsilon> x))", - simp add:foundation18 foundation22[symmetric], - drule StrongEq_L_sym) - apply(simp add: foundation22 C) - apply(case_tac "\<not> (\<tau> \<Turnstile> (\<upsilon> y))", - simp add:foundation18 foundation22[symmetric], - drule StrongEq_L_sym, simp add: foundation22 D, simp) - apply(subst E,simp_all) - apply(case_tac "\<tau> \<Turnstile> not (x \<triangleq> y)") - apply(simp add: OclExcluding_charn1[simplified foundation22] - OclExcluding_charn2[simplified foundation22]) - apply(simp add: foundation9 F) - done -qed - - -(* Hack to work around OF-Bug *) -schematic_goal OclExcluding_charn_exec\<^sub>I\<^sub>n\<^sub>t\<^sub>e\<^sub>g\<^sub>e\<^sub>r[simp,code_unfold]: "?X" -by(rule OclExcluding_charn_exec[OF StrictRefEq\<^sub>I\<^sub>n\<^sub>t\<^sub>e\<^sub>g\<^sub>e\<^sub>r.strict1 StrictRefEq\<^sub>I\<^sub>n\<^sub>t\<^sub>e\<^sub>g\<^sub>e\<^sub>r.strict2 - StrictRefEq\<^sub>I\<^sub>n\<^sub>t\<^sub>e\<^sub>g\<^sub>e\<^sub>r.defined_args_valid - StrictRefEq\<^sub>I\<^sub>n\<^sub>t\<^sub>e\<^sub>g\<^sub>e\<^sub>r.cp0 StrictRefEq\<^sub>I\<^sub>n\<^sub>t\<^sub>e\<^sub>g\<^sub>e\<^sub>r.StrictRefEq_vs_StrongEq], simp_all) - -schematic_goal OclExcluding_charn_exec\<^sub>B\<^sub>o\<^sub>o\<^sub>l\<^sub>e\<^sub>a\<^sub>n[simp,code_unfold]: "?X" -by(rule OclExcluding_charn_exec[OF StrictRefEq\<^sub>B\<^sub>o\<^sub>o\<^sub>l\<^sub>e\<^sub>a\<^sub>n.strict1 StrictRefEq\<^sub>B\<^sub>o\<^sub>o\<^sub>l\<^sub>e\<^sub>a\<^sub>n.strict2 - StrictRefEq\<^sub>B\<^sub>o\<^sub>o\<^sub>l\<^sub>e\<^sub>a\<^sub>n.defined_args_valid - StrictRefEq\<^sub>B\<^sub>o\<^sub>o\<^sub>l\<^sub>e\<^sub>a\<^sub>n.cp0 StrictRefEq\<^sub>B\<^sub>o\<^sub>o\<^sub>l\<^sub>e\<^sub>a\<^sub>n.StrictRefEq_vs_StrongEq], simp_all) - - -schematic_goal OclExcluding_charn_exec\<^sub>S\<^sub>e\<^sub>t[simp,code_unfold]: "?X" -by(rule OclExcluding_charn_exec[OF StrictRefEq\<^sub>S\<^sub>e\<^sub>t.strict1 StrictRefEq\<^sub>S\<^sub>e\<^sub>t.strict2 - StrictRefEq\<^sub>S\<^sub>e\<^sub>t.defined_args_valid - StrictRefEq\<^sub>S\<^sub>e\<^sub>t.cp0 StrictRefEq\<^sub>S\<^sub>e\<^sub>t.StrictRefEq_vs_StrongEq], simp_all) - - -subsubsection{* Execution Rules on Includes *} - -lemma OclIncludes_charn0[simp]: -assumes val_x:"\<tau> \<Turnstile> (\<upsilon> x)" -shows "\<tau> \<Turnstile> not(Set{}->includes\<^sub>S\<^sub>e\<^sub>t(x))" -using val_x -apply(auto simp: OclValid_def OclIncludes_def OclNot_def false_def true_def) -apply(auto simp: mtSet_def Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e.Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inverse) -done - - -lemma OclIncludes_charn0'[simp,code_unfold]: -"Set{}->includes\<^sub>S\<^sub>e\<^sub>t(x) = (if \<upsilon> x then false else invalid endif)" -proof - - have A: "\<And> \<tau>. (Set{}->includes\<^sub>S\<^sub>e\<^sub>t(invalid)) \<tau> = (if (\<upsilon> invalid) then false else invalid endif) \<tau>" - by simp - have B: "\<And> \<tau> x. \<tau> \<Turnstile> (\<upsilon> x) \<Longrightarrow> (Set{}->includes\<^sub>S\<^sub>e\<^sub>t(x)) \<tau> = (if \<upsilon> x then false else invalid endif) \<tau>" - apply(frule OclIncludes_charn0, simp add: OclValid_def) - apply(rule foundation21[THEN fun_cong, simplified StrongEq_def,simplified, - THEN iffD1, of _ _ "false"]) - by simp - show ?thesis - apply(rule ext, rename_tac \<tau>) - apply(case_tac "\<tau> \<Turnstile> (\<upsilon> x)") - apply(simp_all add: B foundation18) - apply(subst OclIncludes.cp0, simp add: OclIncludes.cp0[symmetric] A) - done -qed - -lemma OclIncludes_charn1: -assumes def_X:"\<tau> \<Turnstile> (\<delta> X)" -assumes val_x:"\<tau> \<Turnstile> (\<upsilon> x)" -shows "\<tau> \<Turnstile> (X->including\<^sub>S\<^sub>e\<^sub>t(x)->includes\<^sub>S\<^sub>e\<^sub>t(x))" -proof - - have C : "\<lfloor>\<lfloor>insert (x \<tau>) \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (X \<tau>)\<rceil>\<rceil>\<rfloor>\<rfloor> \<in> {X. X = bot \<or> X = null \<or> (\<forall>x\<in>\<lceil>\<lceil>X\<rceil>\<rceil>. x \<noteq> bot)}" - by(insert def_X val_x, frule Set_inv_lemma, simp add: foundation18 invalid_def) - show ?thesis - apply(subst OclIncludes_def, simp add: foundation10[simplified OclValid_def] OclValid_def - def_X[simplified OclValid_def] val_x[simplified OclValid_def]) - apply(simp add: OclIncluding_def def_X[simplified OclValid_def] val_x[simplified OclValid_def] - Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inverse[OF C] true_def) - done -qed - - - -lemma OclIncludes_charn2: -assumes def_X:"\<tau> \<Turnstile> (\<delta> X)" -and val_x:"\<tau> \<Turnstile> (\<upsilon> x)" -and val_y:"\<tau> \<Turnstile> (\<upsilon> y)" -and neq :"\<tau> \<Turnstile> not(x \<triangleq> y)" -shows "\<tau> \<Turnstile> (X->including\<^sub>S\<^sub>e\<^sub>t(x)->includes\<^sub>S\<^sub>e\<^sub>t(y)) \<triangleq> (X->includes\<^sub>S\<^sub>e\<^sub>t(y))" -proof - - have C : "\<lfloor>\<lfloor>insert (x \<tau>) \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (X \<tau>)\<rceil>\<rceil>\<rfloor>\<rfloor> \<in> {X. X = bot \<or> X = null \<or> (\<forall>x\<in>\<lceil>\<lceil>X\<rceil>\<rceil>. x \<noteq> bot)}" - by(insert def_X val_x, frule Set_inv_lemma, simp add: foundation18 invalid_def) - show ?thesis - apply(subst OclIncludes_def, - simp add: def_X[simplified OclValid_def] val_x[simplified OclValid_def] - val_y[simplified OclValid_def] foundation10[simplified OclValid_def] - OclValid_def StrongEq_def) - apply(simp add: OclIncluding_def OclIncludes_def def_X[simplified OclValid_def] - val_x[simplified OclValid_def] val_y[simplified OclValid_def] - Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inverse[OF C] true_def) - by(metis foundation22 foundation6 foundation9 neq) -qed - -text{* Here is again a generic theorem similar as above. *} - -lemma OclIncludes_execute_generic: -assumes strict1: "(invalid \<doteq> y) = invalid" -and strict2: "(x \<doteq> invalid) = invalid" -and cp_StrictRefEq: "\<And> (X::('\<AA>,'a::null)val) Y \<tau>. (X \<doteq> Y) \<tau> = ((\<lambda>_. X \<tau>) \<doteq> (\<lambda>_. Y \<tau>)) \<tau>" -and StrictRefEq_vs_StrongEq: "\<And> (x::('\<AA>,'a::null)val) y \<tau>. - \<tau> \<Turnstile> \<upsilon> x \<Longrightarrow> \<tau> \<Turnstile> \<upsilon> y \<Longrightarrow> (\<tau> \<Turnstile> ((x \<doteq> y) \<triangleq> (x \<triangleq> y)))" -shows - "(X->including\<^sub>S\<^sub>e\<^sub>t(x::('\<AA>,'a::null)val)->includes\<^sub>S\<^sub>e\<^sub>t(y)) = - (if \<delta> X then if x \<doteq> y then true else X->includes\<^sub>S\<^sub>e\<^sub>t(y) endif else invalid endif)" -proof - - have A: "\<And>\<tau>. \<tau> \<Turnstile> (X \<triangleq> invalid) \<Longrightarrow> - (X->including\<^sub>S\<^sub>e\<^sub>t(x)->includes\<^sub>S\<^sub>e\<^sub>t(y)) \<tau> = invalid \<tau>" - apply(rule foundation22[THEN iffD1]) - by(erule StrongEq_L_subst2_rev,simp,simp) - have B: "\<And>\<tau>. \<tau> \<Turnstile> (X \<triangleq> null) \<Longrightarrow> - (X->including\<^sub>S\<^sub>e\<^sub>t(x)->includes\<^sub>S\<^sub>e\<^sub>t(y)) \<tau> = invalid \<tau>" - apply(rule foundation22[THEN iffD1]) - by(erule StrongEq_L_subst2_rev,simp,simp) - - note [simp] = cp_StrictRefEq [THEN allI[THEN allI[THEN allI[THEN cpI2]], of "StrictRefEq"]] - - have C: "\<And>\<tau>. \<tau> \<Turnstile> (x \<triangleq> invalid) \<Longrightarrow> - (X->including\<^sub>S\<^sub>e\<^sub>t(x)->includes\<^sub>S\<^sub>e\<^sub>t(y)) \<tau> = - (if x \<doteq> y then true else X->includes\<^sub>S\<^sub>e\<^sub>t(y) endif) \<tau>" - apply(rule foundation22[THEN iffD1]) - apply(erule StrongEq_L_subst2_rev,simp,simp) - by (simp add: strict1) - have D:"\<And>\<tau>. \<tau> \<Turnstile> (y \<triangleq> invalid) \<Longrightarrow> - (X->including\<^sub>S\<^sub>e\<^sub>t(x)->includes\<^sub>S\<^sub>e\<^sub>t(y)) \<tau> = - (if x \<doteq> y then true else X->includes\<^sub>S\<^sub>e\<^sub>t(y) endif) \<tau>" - apply(rule foundation22[THEN iffD1]) - apply(erule StrongEq_L_subst2_rev,simp,simp) - by (simp add: strict2) - have E: "\<And>\<tau>. \<tau> \<Turnstile> \<upsilon> x \<Longrightarrow> \<tau> \<Turnstile> \<upsilon> y \<Longrightarrow> - (if x \<doteq> y then true else X->includes\<^sub>S\<^sub>e\<^sub>t(y) endif) \<tau> = - (if x \<triangleq> y then true else X->includes\<^sub>S\<^sub>e\<^sub>t(y) endif) \<tau>" - apply(subst cp_OclIf) - apply(subst StrictRefEq_vs_StrongEq[THEN foundation22[THEN iffD1]]) - by(simp_all add: cp_OclIf[symmetric]) - have F: "\<And>\<tau>. \<tau> \<Turnstile> (x \<triangleq> y) \<Longrightarrow> - (X->including\<^sub>S\<^sub>e\<^sub>t(x)->includes\<^sub>S\<^sub>e\<^sub>t(y)) \<tau> = (X->including\<^sub>S\<^sub>e\<^sub>t(x)->includes\<^sub>S\<^sub>e\<^sub>t(x)) \<tau>" - apply(rule foundation22[THEN iffD1]) - by(erule StrongEq_L_subst2_rev,simp, simp) - show ?thesis - apply(rule ext, rename_tac "\<tau>") - apply(case_tac "\<not> (\<tau> \<Turnstile> (\<delta> X))", simp add:defined_split,elim disjE A B) - apply(case_tac "\<not> (\<tau> \<Turnstile> (\<upsilon> x))", - simp add:foundation18 foundation22[symmetric], - drule StrongEq_L_sym) - apply(simp add: foundation22 C) - apply(case_tac "\<not> (\<tau> \<Turnstile> (\<upsilon> y))", - simp add:foundation18 foundation22[symmetric], - drule StrongEq_L_sym, simp add: foundation22 D, simp) - apply(subst E,simp_all) - apply(case_tac "\<tau> \<Turnstile> not(x \<triangleq> y)") - apply(simp add: OclIncludes_charn2[simplified foundation22]) - apply(simp add: foundation9 F - OclIncludes_charn1[THEN foundation13[THEN iffD2], - THEN foundation22[THEN iffD1]]) - done -qed - - -(* Hack to work around OF-Bug *) -schematic_goal OclIncludes_execute\<^sub>I\<^sub>n\<^sub>t\<^sub>e\<^sub>g\<^sub>e\<^sub>r[simp,code_unfold]: "?X" -by(rule OclIncludes_execute_generic[OF StrictRefEq\<^sub>I\<^sub>n\<^sub>t\<^sub>e\<^sub>g\<^sub>e\<^sub>r.strict1 StrictRefEq\<^sub>I\<^sub>n\<^sub>t\<^sub>e\<^sub>g\<^sub>e\<^sub>r.strict2 - StrictRefEq\<^sub>I\<^sub>n\<^sub>t\<^sub>e\<^sub>g\<^sub>e\<^sub>r.cp0 - StrictRefEq\<^sub>I\<^sub>n\<^sub>t\<^sub>e\<^sub>g\<^sub>e\<^sub>r.StrictRefEq_vs_StrongEq], simp_all) - - -schematic_goal OclIncludes_execute\<^sub>B\<^sub>o\<^sub>o\<^sub>l\<^sub>e\<^sub>a\<^sub>n[simp,code_unfold]: "?X" -by(rule OclIncludes_execute_generic[OF StrictRefEq\<^sub>B\<^sub>o\<^sub>o\<^sub>l\<^sub>e\<^sub>a\<^sub>n.strict1 StrictRefEq\<^sub>B\<^sub>o\<^sub>o\<^sub>l\<^sub>e\<^sub>a\<^sub>n.strict2 - StrictRefEq\<^sub>B\<^sub>o\<^sub>o\<^sub>l\<^sub>e\<^sub>a\<^sub>n.cp0 - StrictRefEq\<^sub>B\<^sub>o\<^sub>o\<^sub>l\<^sub>e\<^sub>a\<^sub>n.StrictRefEq_vs_StrongEq], simp_all) - - -schematic_goal OclIncludes_execute\<^sub>S\<^sub>e\<^sub>t[simp,code_unfold]: "?X" -by(rule OclIncludes_execute_generic[OF StrictRefEq\<^sub>S\<^sub>e\<^sub>t.strict1 StrictRefEq\<^sub>S\<^sub>e\<^sub>t.strict2 - StrictRefEq\<^sub>S\<^sub>e\<^sub>t.cp0 - StrictRefEq\<^sub>S\<^sub>e\<^sub>t.StrictRefEq_vs_StrongEq], simp_all) - -lemma OclIncludes_including_generic : - assumes OclIncludes_execute_generic [simp] : "\<And>X x y. - (X->including\<^sub>S\<^sub>e\<^sub>t(x::('\<AA>,'a::null)val)->includes\<^sub>S\<^sub>e\<^sub>t(y)) = - (if \<delta> X then if x \<doteq> y then true else X->includes\<^sub>S\<^sub>e\<^sub>t(y) endif else invalid endif)" - and StrictRefEq_strict'' : "\<And>x y. \<delta> ((x::('\<AA>,'a::null)val) \<doteq> y) = (\<upsilon>(x) and \<upsilon>(y))" - and a_val : "\<tau> \<Turnstile> \<upsilon> a" - and x_val : "\<tau> \<Turnstile> \<upsilon> x" - and S_incl : "\<tau> \<Turnstile> (S)->includes\<^sub>S\<^sub>e\<^sub>t((x::('\<AA>,'a::null)val))" - shows "\<tau> \<Turnstile> S->including\<^sub>S\<^sub>e\<^sub>t((a::('\<AA>,'a::null)val))->includes\<^sub>S\<^sub>e\<^sub>t(x)" -proof - - have discr_eq_bot1_true : "\<And>\<tau>. (\<bottom> \<tau> = true \<tau>) = False" - by (metis bot_fun_def foundation1 foundation18' valid3) - have discr_eq_bot2_true : "\<And>\<tau>. (\<bottom> = true \<tau>) = False" - by (metis bot_fun_def discr_eq_bot1_true) - have discr_neq_invalid_true : "\<And>\<tau>. (invalid \<tau> \<noteq> true \<tau>) = True" - by (metis discr_eq_bot2_true invalid_def) - have discr_eq_invalid_true : "\<And>\<tau>. (invalid \<tau> = true \<tau>) = False" - by (metis bot_option_def invalid_def option.simps(2) true_def) -show ?thesis - apply(simp) - apply(subgoal_tac "\<tau> \<Turnstile> \<delta> S") - prefer 2 - apply(insert S_incl[simplified OclIncludes_def], simp add: OclValid_def) - apply(metis discr_eq_bot2_true) - apply(simp add: cp_OclIf[of "\<delta> S"] OclValid_def OclIf_def x_val[simplified OclValid_def] - discr_neq_invalid_true discr_eq_invalid_true) - by (metis OclValid_def S_incl StrictRefEq_strict'' a_val foundation10 foundation6 x_val) -qed - -lemmas OclIncludes_including\<^sub>I\<^sub>n\<^sub>t\<^sub>e\<^sub>g\<^sub>e\<^sub>r = - OclIncludes_including_generic[OF OclIncludes_execute\<^sub>I\<^sub>n\<^sub>t\<^sub>e\<^sub>g\<^sub>e\<^sub>r StrictRefEq\<^sub>I\<^sub>n\<^sub>t\<^sub>e\<^sub>g\<^sub>e\<^sub>r.def_homo] - -subsubsection{* Execution Rules on Excludes *} - -lemma OclExcludes_charn1: -assumes def_X:"\<tau> \<Turnstile> (\<delta> X)" -assumes val_x:"\<tau> \<Turnstile> (\<upsilon> x)" -shows "\<tau> \<Turnstile> (X->excluding\<^sub>S\<^sub>e\<^sub>t(x)->excludes\<^sub>S\<^sub>e\<^sub>t(x))" -proof - - let ?OclSet = "\<lambda>S. \<lfloor>\<lfloor>S\<rfloor>\<rfloor> \<in> {X. X = \<bottom> \<or> X = null \<or> (\<forall>x\<in>\<lceil>\<lceil>X\<rceil>\<rceil>. x \<noteq> \<bottom>)}" - have diff_in_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e : "?OclSet (\<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (X \<tau>)\<rceil>\<rceil> - {x \<tau>})" - apply(simp, (rule disjI2)+) - by (metis (hide_lams, no_types) Diff_iff Set_inv_lemma def_X) - - show ?thesis - apply(subst OclExcludes_def, simp add: foundation10[simplified OclValid_def] OclValid_def - def_X[simplified OclValid_def] val_x[simplified OclValid_def]) - apply(subst OclIncludes_def, simp add: OclNot_def) - apply(simp add: OclExcluding_def def_X[simplified OclValid_def] val_x[simplified OclValid_def] - Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inverse[OF diff_in_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e] true_def) - by(simp add: OclAnd_def def_X[simplified OclValid_def] val_x[simplified OclValid_def] true_def) -qed - -subsubsection{* Execution Rules on Size *} - -lemma [simp,code_unfold]: "Set{} ->size\<^sub>S\<^sub>e\<^sub>t() = \<zero>" - apply(rule ext) - apply(simp add: defined_def mtSet_def OclSize_def - bot_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def bot_fun_def - null_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def null_fun_def) - apply(subst Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inject, simp_all add: bot_option_def null_option_def) + -by(simp add: Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inverse bot_option_def null_option_def OclInt0_def) - -lemma OclSize_including_exec[simp,code_unfold]: - "((X ->including\<^sub>S\<^sub>e\<^sub>t(x)) ->size\<^sub>S\<^sub>e\<^sub>t()) = (if \<delta> X and \<upsilon> x then - X ->size\<^sub>S\<^sub>e\<^sub>t() +\<^sub>i\<^sub>n\<^sub>t if X ->includes\<^sub>S\<^sub>e\<^sub>t(x) then \<zero> else \<one> endif - else - invalid - endif)" -proof - - - have valid_inject_true : "\<And>\<tau> P. (\<upsilon> P) \<tau> \<noteq> true \<tau> \<Longrightarrow> (\<upsilon> P) \<tau> = false \<tau>" - apply(simp add: valid_def true_def false_def bot_fun_def bot_option_def - null_fun_def null_option_def) - by (case_tac "P \<tau> = \<bottom>", simp_all add: true_def) - have defined_inject_true : "\<And>\<tau> P. (\<delta> P) \<tau> \<noteq> true \<tau> \<Longrightarrow> (\<delta> P) \<tau> = false \<tau>" - apply(simp add: defined_def true_def false_def bot_fun_def bot_option_def - null_fun_def null_option_def) - by (case_tac " P \<tau> = \<bottom> \<or> P \<tau> = null", simp_all add: true_def) - - show ?thesis - apply(rule ext, rename_tac \<tau>) - proof - - fix \<tau> - have includes_notin: "\<not> \<tau> \<Turnstile> X->includes\<^sub>S\<^sub>e\<^sub>t(x) \<Longrightarrow> (\<delta> X) \<tau> = true \<tau> \<and> (\<upsilon> x) \<tau> = true \<tau> \<Longrightarrow> - x \<tau> \<notin> \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (X \<tau>)\<rceil>\<rceil>" - by(simp add: OclIncludes_def OclValid_def true_def) - - have includes_def: "\<tau> \<Turnstile> X->includes\<^sub>S\<^sub>e\<^sub>t(x) \<Longrightarrow> \<tau> \<Turnstile> \<delta> X" - by (metis bot_fun_def OclIncludes_def OclValid_def defined3 foundation16) - - have includes_val: "\<tau> \<Turnstile> X->includes\<^sub>S\<^sub>e\<^sub>t(x) \<Longrightarrow> \<tau> \<Turnstile> \<upsilon> x" - using foundation5 foundation6 by fastforce - - have ins_in_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e: "\<tau> \<Turnstile> \<delta> X \<Longrightarrow> \<tau> \<Turnstile> \<upsilon> x \<Longrightarrow> - \<lfloor>\<lfloor>insert (x \<tau>) \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (X \<tau>)\<rceil>\<rceil>\<rfloor>\<rfloor> \<in> {X. X = \<bottom> \<or> X = null \<or> (\<forall>x\<in>\<lceil>\<lceil>X\<rceil>\<rceil>. x \<noteq> \<bottom>)}" - apply(simp add: bot_option_def null_option_def) - by (metis (hide_lams, no_types) Set_inv_lemma foundation18' foundation5) - - have m : "\<And>\<tau>. (\<lambda>_. \<bottom>) = (\<lambda>_. invalid \<tau>)" by(rule ext, simp add:invalid_def) - - show "X->including\<^sub>S\<^sub>e\<^sub>t(x)->size\<^sub>S\<^sub>e\<^sub>t() \<tau> = (if \<delta> X and \<upsilon> x - then X->size\<^sub>S\<^sub>e\<^sub>t() +\<^sub>i\<^sub>n\<^sub>t if X->includes\<^sub>S\<^sub>e\<^sub>t(x) then \<zero> else \<one> endif - else invalid endif) \<tau>" - apply(case_tac "\<tau> \<Turnstile> \<delta> X and \<upsilon> x", simp) - apply(subst OclAdd\<^sub>I\<^sub>n\<^sub>t\<^sub>e\<^sub>g\<^sub>e\<^sub>r.cp0) - apply(case_tac "\<tau> \<Turnstile> X->includes\<^sub>S\<^sub>e\<^sub>t(x)", simp add: OclAdd\<^sub>I\<^sub>n\<^sub>t\<^sub>e\<^sub>g\<^sub>e\<^sub>r.cp0[symmetric]) - apply(case_tac "\<tau> \<Turnstile> ((\<upsilon> (X->size\<^sub>S\<^sub>e\<^sub>t())) and not (\<delta> (X->size\<^sub>S\<^sub>e\<^sub>t())))", simp) - apply(drule foundation5[where P = "\<upsilon> X->size\<^sub>S\<^sub>e\<^sub>t()"], erule conjE) - apply(drule OclSize_infinite) - apply(frule includes_def, drule includes_val, simp) - apply(subst OclSize_def, subst OclIncluding_finite_rep_set, assumption+) - apply (metis (hide_lams, no_types) invalid_def) - - apply(subst OclIf_false', - metis (hide_lams, no_types) defined5 defined6 defined_and_I defined_not_I - foundation1 foundation9) - apply(subst cp_OclSize, simp add: OclIncluding_includes0 cp_OclSize[symmetric]) - (* *) - apply(subst OclIf_false', subst foundation9, auto, simp add: OclSize_def) - apply(drule foundation5) - apply(subst (1 2) OclIncluding_finite_rep_set, fast+) - apply(subst (1 2) cp_OclAnd, subst (1 2) OclAdd\<^sub>I\<^sub>n\<^sub>t\<^sub>e\<^sub>g\<^sub>e\<^sub>r.cp0, simp) - apply(rule conjI) - apply(simp add: OclIncluding_def) - apply(subst Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inverse[OF ins_in_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e], fast+) - apply(subst (asm) (2 3) OclValid_def, simp add: OclAdd\<^sub>I\<^sub>n\<^sub>t\<^sub>e\<^sub>g\<^sub>e\<^sub>r_def OclInt1_def) - apply(rule impI) - apply(drule Finite_Set.card.insert[where x = "x \<tau>"]) - apply(rule includes_notin, simp, simp) - apply (metis Suc_eq_plus1 of_nat_1 of_nat_add) - - apply(subst (1 2) m[of \<tau>], simp only: OclAdd\<^sub>I\<^sub>n\<^sub>t\<^sub>e\<^sub>g\<^sub>e\<^sub>r.cp0[symmetric],simp, simp add:invalid_def) - apply(subst OclIncluding_finite_rep_set, fast+, simp add: OclValid_def) - (* *) - apply(subst OclIf_false', metis (hide_lams, no_types) defined6 foundation1 foundation9 - OclExcluding_valid_args_valid'') - by (metis cp_OclSize foundation18' OclIncluding_valid_args_valid'' invalid_def OclSize_invalid) - qed -qed - -lemma OclSize_singleton: assumes X_val: "\<tau> \<Turnstile> \<upsilon> X" - shows "\<tau> \<Turnstile> ((Set{X}->size\<^sub>S\<^sub>e\<^sub>t()) \<triangleq> \<one>)" - proof - - let ?A = "\<lambda>x. if \<upsilon> X then x else invalid endif" - let ?B = "if ?A false then \<zero> else \<one> endif" - let ?C = "if \<upsilon> ?B and not (\<delta> ?B) then invalid else ?B endif" - note cpI = cp_OclIf note cpI\<^sub>s = cp_OclIf[symmetric] - note cpS = cp_StrongEq note cpS\<^sub>s = cp_StrongEq[symmetric] - show ?thesis - apply(simp, subst StrongEq_L_subst3_rev[where x = "?A ?C" and y = ?C]) - apply(simp add: OclValid_def, subst cpS, subst cpI) - apply(simp add: X_val[simplified OclValid_def], subst cpI\<^sub>s, simp, simp) - apply(subst StrongEq_L_subst3_rev[where x = ?C and y = ?B ]) - apply(simp add: OclValid_def, - subst cpS, subst cpI, subst cp_OclAnd, subst cp_OclNot, subst cp_valid, subst cp_defined) - apply(subgoal_tac "?B \<tau> = \<one> \<tau>") - apply(simp, subst cp_defined[symmetric], subst cp_valid[symmetric], subst cp_OclNot[symmetric], - subst cp_OclAnd[symmetric], subst cpI\<^sub>s, subst cpS\<^sub>s, simp) - apply(subst cpI, subst cpI) - apply(simp add: X_val[simplified OclValid_def], subst cpI\<^sub>s, subst cpI\<^sub>s, simp, simp) - apply(simp add: OclValid_def, subst cpS) - apply(subst cpI, subst cpI) - by(simp add: X_val[simplified OclValid_def], subst cpI\<^sub>s, subst cpI\<^sub>s, subst cpS\<^sub>s, simp) -qed - -subsubsection{* Execution Rules on IsEmpty *} - -lemma [simp,code_unfold]: "Set{}->isEmpty\<^sub>S\<^sub>e\<^sub>t() = true" -by(simp add: OclIsEmpty_def) - -lemma OclIsEmpty_including [simp]: -assumes X_def: "\<tau> \<Turnstile> \<delta> X" - and X_finite: "finite \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (X \<tau>)\<rceil>\<rceil>" - and a_val: "\<tau> \<Turnstile> \<upsilon> a" -shows "X->including\<^sub>S\<^sub>e\<^sub>t(a)->isEmpty\<^sub>S\<^sub>e\<^sub>t() \<tau> = false \<tau>" -proof - - have A1 : "\<And>\<tau> X. X \<tau> = true \<tau> \<or> X \<tau> = false \<tau> \<Longrightarrow> (X and not X) \<tau> = false \<tau>" - by (metis (no_types) OclAnd_false1 OclAnd_idem OclImplies_def OclNot3 OclNot_not OclOr_false1 - cp_OclAnd cp_OclNot deMorgan1 deMorgan2) - - have defined_inject_true : "\<And>\<tau> P. (\<delta> P) \<tau> \<noteq> true \<tau> \<Longrightarrow> (\<delta> P) \<tau> = false \<tau>" - apply(simp add: defined_def true_def false_def bot_fun_def bot_option_def - null_fun_def null_option_def) - by (case_tac " P \<tau> = \<bottom> \<or> P \<tau> = null", simp_all add: true_def) - - have B : "\<And>X \<tau>. \<tau> \<Turnstile> \<upsilon> X \<Longrightarrow> X \<tau> \<noteq> \<zero> \<tau> \<Longrightarrow> (X \<doteq> \<zero>) \<tau> = false \<tau>" - apply(simp add: foundation22[symmetric] foundation14 foundation9) - apply(erule StrongEq_L_subst4_rev[THEN iffD2, OF StrictRefEq\<^sub>I\<^sub>n\<^sub>t\<^sub>e\<^sub>g\<^sub>e\<^sub>r.StrictRefEq_vs_StrongEq]) - by(simp_all) - - show ?thesis - apply(simp add: OclIsEmpty_def del: OclSize_including_exec) - apply(subst cp_OclOr, subst A1) - apply (metis OclExcludes.def_homo defined_inject_true) - apply(simp add: cp_OclOr[symmetric] del: OclSize_including_exec) - apply(rule B, - rule foundation20, - metis OclIncluding.def_homo OclIncluding_finite_rep_set X_def X_finite a_val foundation10' size_defined') - apply(simp add: OclSize_def OclIncluding_finite_rep_set[OF X_def a_val] X_finite OclInt0_def) - by (metis OclValid_def X_def a_val foundation10 foundation6 - OclIncluding_notempty_rep_set[OF X_def a_val]) -qed - -subsubsection{* Execution Rules on NotEmpty *} - -lemma [simp,code_unfold]: "Set{}->notEmpty\<^sub>S\<^sub>e\<^sub>t() = false" -by(simp add: OclNotEmpty_def) - -lemma OclNotEmpty_including [simp,code_unfold]: -assumes X_def: "\<tau> \<Turnstile> \<delta> X" - and X_finite: "finite \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (X \<tau>)\<rceil>\<rceil>" - and a_val: "\<tau> \<Turnstile> \<upsilon> a" -shows "X->including\<^sub>S\<^sub>e\<^sub>t(a)->notEmpty\<^sub>S\<^sub>e\<^sub>t() \<tau> = true \<tau>" - apply(simp add: OclNotEmpty_def) - apply(subst cp_OclNot, subst OclIsEmpty_including, simp_all add: assms) -by (metis OclNot4 cp_OclNot) - -subsubsection{* Execution Rules on Any *} - -lemma [simp,code_unfold]: "Set{}->any\<^sub>S\<^sub>e\<^sub>t() = null" -by(rule ext, simp add: OclANY_def, simp add: false_def true_def) - -lemma OclANY_singleton_exec[simp,code_unfold]: - "(Set{}->including\<^sub>S\<^sub>e\<^sub>t(a))->any\<^sub>S\<^sub>e\<^sub>t() = a" - apply(rule ext, rename_tac \<tau>, simp add: mtSet_def OclANY_def) - apply(case_tac "\<tau> \<Turnstile> \<upsilon> a") - apply(simp add: OclValid_def mtSet_defined[simplified mtSet_def] - mtSet_valid[simplified mtSet_def] mtSet_rep_set[simplified mtSet_def]) - apply(subst (1 2) cp_OclAnd, - subst (1 2) OclNotEmpty_including[where X = "Set{}", simplified mtSet_def]) - apply(simp add: mtSet_defined[simplified mtSet_def]) - apply(metis (hide_lams, no_types) finite.emptyI mtSet_def mtSet_rep_set) - apply(simp add: OclValid_def) - apply(simp add: OclIncluding_def) - apply(rule conjI) - apply(subst (1 2) Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inverse, simp add: bot_option_def null_option_def) - apply(simp, metis OclValid_def foundation18') - apply(simp) - apply(simp add: mtSet_defined[simplified mtSet_def]) - (* *) - apply(subgoal_tac "a \<tau> = \<bottom>") - prefer 2 - apply(simp add: OclValid_def valid_def bot_fun_def split: if_split_asm) - apply(simp) - apply(subst (1 2 3 4) cp_OclAnd, - simp add: mtSet_defined[simplified mtSet_def] valid_def bot_fun_def) -by(simp add: cp_OclAnd[symmetric], rule impI, simp add: false_def true_def) - -subsubsection{* Execution Rules on Forall *} - -lemma OclForall_mtSet_exec[simp,code_unfold] :"((Set{})->forAll\<^sub>S\<^sub>e\<^sub>t(z| P(z))) = true" -apply(simp add: OclForall_def) -apply(subst mtSet_def)+ -apply(subst Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inverse, simp_all add: true_def)+ -done - - -text{* The following rule is a main theorem of our approach: From a denotational definition -that assures consistency, but may be --- as in the case of the @{term "X->forAll\<^sub>S\<^sub>e\<^sub>t(x | P x)"} --- -dauntingly complex, we derive operational rules that can serve as a gold-standard for operational -execution, since they may be evaluated in whatever situation and according to whatever strategy. -In the case of @{term "X->forAll\<^sub>S\<^sub>e\<^sub>t(x | P x)"}, the operational rule gives immediately a way to -evaluation in any finite (in terms of conventional OCL: denotable) set, although the rule also -holds for the infinite case: - -@{term "Integer\<^sub>n\<^sub>u\<^sub>l\<^sub>l ->forAll\<^sub>S\<^sub>e\<^sub>t(x | (Integer\<^sub>n\<^sub>u\<^sub>l\<^sub>l ->forAll\<^sub>S\<^sub>e\<^sub>t(y | x +\<^sub>i\<^sub>n\<^sub>t y \<triangleq> y +\<^sub>i\<^sub>n\<^sub>t x)))"} - -or even: - -@{term "Integer ->forAll\<^sub>S\<^sub>e\<^sub>t(x | (Integer ->forAll\<^sub>S\<^sub>e\<^sub>t(y | x +\<^sub>i\<^sub>n\<^sub>t y \<doteq> y +\<^sub>i\<^sub>n\<^sub>t x)))"} - -are valid OCL statements in any context $\tau$. -*} - -theorem OclForall_including_exec[simp,code_unfold] : - assumes cp0 : "cp P" - shows "((S->including\<^sub>S\<^sub>e\<^sub>t(x))->forAll\<^sub>S\<^sub>e\<^sub>t(z | P(z))) = (if \<delta> S and \<upsilon> x - then P x and (S->forAll\<^sub>S\<^sub>e\<^sub>t(z | P(z))) - else invalid - endif)" -proof - - have cp: "\<And>\<tau>. P x \<tau> = P (\<lambda>_. x \<tau>) \<tau>" by(insert cp0, auto simp: cp_def) - - have cp_eq : "\<And>\<tau> v. (P x \<tau> = v) = (P (\<lambda>_. x \<tau>) \<tau> = v)" by(subst cp, simp) - - have cp_OclNot_eq : "\<And>\<tau> v. (P x \<tau> \<noteq> v) = (P (\<lambda>_. x \<tau>) \<tau> \<noteq> v)" by(subst cp, simp) - - have insert_in_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e : "\<And>\<tau>. (\<tau> \<Turnstile>(\<delta> S)) \<Longrightarrow> (\<tau> \<Turnstile>(\<upsilon> x)) \<Longrightarrow> - \<lfloor>\<lfloor>insert (x \<tau>) \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil>\<rfloor>\<rfloor> \<in> - {X. X = bot \<or> X = null \<or> (\<forall>x\<in>\<lceil>\<lceil>X\<rceil>\<rceil>. x \<noteq> bot)}" - by(frule Set_inv_lemma, simp add: foundation18 invalid_def) - - have forall_including_invert : "\<And>\<tau> f. (f x \<tau> = f (\<lambda> _. x \<tau>) \<tau>) \<Longrightarrow> - \<tau> \<Turnstile> (\<delta> S and \<upsilon> x) \<Longrightarrow> - (\<forall>x\<in>\<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S->including\<^sub>S\<^sub>e\<^sub>t(x) \<tau>)\<rceil>\<rceil>. f (\<lambda>_. x) \<tau>) = - (f x \<tau> \<and> (\<forall>x\<in>\<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil>. f (\<lambda>_. x) \<tau>))" - apply(drule foundation5, simp add: OclIncluding_def) - apply(subst Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inverse) - apply(rule insert_in_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e, fast+) - by(simp add: OclValid_def) - - have exists_including_invert : "\<And>\<tau> f. (f x \<tau> = f (\<lambda> _. x \<tau>) \<tau>) \<Longrightarrow> - \<tau> \<Turnstile> (\<delta> S and \<upsilon> x) \<Longrightarrow> - (\<exists>x\<in>\<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S->including\<^sub>S\<^sub>e\<^sub>t(x) \<tau>)\<rceil>\<rceil>. f (\<lambda>_. x) \<tau>) = - (f x \<tau> \<or> (\<exists>x\<in>\<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil>. f (\<lambda>_. x) \<tau>))" - apply(subst arg_cong[where f = "\<lambda>x. \<not>x", - OF forall_including_invert[where f = "\<lambda>x \<tau>. \<not> (f x \<tau>)"], - simplified]) - by simp_all - - have contradict_Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e: "\<And>\<tau> S f. \<exists>x\<in>\<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e S\<rceil>\<rceil>. f (\<lambda>_. x) \<tau> \<Longrightarrow> - (\<forall>x\<in>\<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e S\<rceil>\<rceil>. \<not> (f (\<lambda>_. x) \<tau>)) = False" - by(case_tac "(\<forall>x\<in>\<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e S\<rceil>\<rceil>. \<not> (f (\<lambda>_. x) \<tau>)) = True", simp_all) - - have bot_invalid : "\<bottom> = invalid" by(rule ext, simp add: invalid_def bot_fun_def) - - have bot_invalid2 : "\<And>\<tau>. \<bottom> = invalid \<tau>" by(simp add: invalid_def) - - have C1 : "\<And>\<tau>. P x \<tau> = false \<tau> \<or> (\<exists>x\<in>\<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil>. P (\<lambda>_. x) \<tau> = false \<tau>) \<Longrightarrow> - \<tau> \<Turnstile> (\<delta> S and \<upsilon> x) \<Longrightarrow> - false \<tau> = (P x and OclForall S P) \<tau>" - apply(simp add: cp_OclAnd[of "P x"]) - apply(elim disjE, simp) - apply(simp only: cp_OclAnd[symmetric], simp) - apply(subgoal_tac "OclForall S P \<tau> = false \<tau>") - apply(simp only: cp_OclAnd[symmetric], simp) - apply(simp add: OclForall_def) - apply(fold OclValid_def, simp add: foundation10') - done - - have C2 : "\<And>\<tau>. \<tau> \<Turnstile> (\<delta> S and \<upsilon> x) \<Longrightarrow> - P x \<tau> = null \<tau> \<or> (\<exists>x\<in>\<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil>. P (\<lambda>_. x) \<tau> = null \<tau>) \<Longrightarrow> - P x \<tau> = invalid \<tau> \<or> (\<exists>x\<in>\<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil>. P (\<lambda>_. x) \<tau> = invalid \<tau>) \<Longrightarrow> - \<forall>x\<in>\<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S->including\<^sub>S\<^sub>e\<^sub>t(x) \<tau>)\<rceil>\<rceil>. P (\<lambda>_. x) \<tau> \<noteq> false \<tau> \<Longrightarrow> - invalid \<tau> = (P x and OclForall S P) \<tau>" - apply(subgoal_tac "(\<delta> S)\<tau> = true \<tau>") - prefer 2 apply(simp add: foundation10', simp add: OclValid_def) - apply(drule forall_including_invert[of "\<lambda> x \<tau>. P x \<tau> \<noteq> false \<tau>", OF cp_OclNot_eq, THEN iffD1]) - apply(assumption) - apply(simp add: cp_OclAnd[of "P x"],elim disjE, simp_all) - apply(simp add: invalid_def null_fun_def null_option_def bot_fun_def bot_option_def) - apply(subgoal_tac "OclForall S P \<tau> = invalid \<tau>") - apply(simp only:cp_OclAnd[symmetric],simp,simp add:invalid_def bot_fun_def) - apply(unfold OclForall_def, simp add: invalid_def false_def bot_fun_def,simp) - apply(simp add:cp_OclAnd[symmetric],simp) - apply(erule conjE) - apply(subgoal_tac "(P x \<tau> = invalid \<tau>) \<or> (P x \<tau> = null \<tau>) \<or> (P x \<tau> = true \<tau>) \<or> (P x \<tau> = false \<tau>)") - prefer 2 apply(rule bool_split_0) - apply(elim disjE, simp_all) - apply(simp only:cp_OclAnd[symmetric],simp)+ - done - - have A : "\<And>\<tau>. \<tau> \<Turnstile> (\<delta> S and \<upsilon> x) \<Longrightarrow> - OclForall (S->including\<^sub>S\<^sub>e\<^sub>t(x)) P \<tau> = (P x and OclForall S P) \<tau>" - proof - fix \<tau> - assume 0 : "\<tau> \<Turnstile> (\<delta> S and \<upsilon> x)" - let ?S = "\<lambda>ocl. P x \<tau> \<noteq> ocl \<tau> \<and> (\<forall>x\<in>\<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil>. P (\<lambda>_. x) \<tau> \<noteq> ocl \<tau>)" - let ?S' = "\<lambda>ocl. \<forall>x\<in>\<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S->including\<^sub>S\<^sub>e\<^sub>t(x) \<tau>)\<rceil>\<rceil>. P (\<lambda>_. x) \<tau> \<noteq> ocl \<tau>" - let ?assms_1 = "?S' null" - let ?assms_2 = "?S' invalid" - let ?assms_3 = "?S' false" - have 4 : "?assms_3 \<Longrightarrow> ?S false" - apply(subst forall_including_invert[of "\<lambda> x \<tau>. P x \<tau> \<noteq> false \<tau>",symmetric]) - by(simp_all add: cp_OclNot_eq 0) - have 5 : "?assms_2 \<Longrightarrow> ?S invalid" - apply(subst forall_including_invert[of "\<lambda> x \<tau>. P x \<tau> \<noteq> invalid \<tau>",symmetric]) - by(simp_all add: cp_OclNot_eq 0) - have 6 : "?assms_1 \<Longrightarrow> ?S null" - apply(subst forall_including_invert[of "\<lambda> x \<tau>. P x \<tau> \<noteq> null \<tau>",symmetric]) - by(simp_all add: cp_OclNot_eq 0) - have 7 : "(\<delta> S) \<tau> = true \<tau>" - by(insert 0, simp add: foundation10', simp add: OclValid_def) - show "?thesis \<tau>" - apply(subst OclForall_def) - apply(simp add: cp_OclAnd[THEN sym] OclValid_def contradict_Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e) - apply(intro conjI impI,fold OclValid_def) - apply(simp_all add: exists_including_invert[where f = "\<lambda> x \<tau>. P x \<tau> = null \<tau>", OF cp_eq]) - apply(simp_all add: exists_including_invert[where f = "\<lambda> x \<tau>. P x \<tau> = invalid \<tau>", OF cp_eq]) - apply(simp_all add: exists_including_invert[where f = "\<lambda> x \<tau>. P x \<tau> = false \<tau>", OF cp_eq]) - proof - - assume 1 : "P x \<tau> = null \<tau> \<or> (\<exists>x\<in>\<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil>. P (\<lambda>_. x) \<tau> = null \<tau>)" - and 2 : ?assms_2 - and 3 : ?assms_3 - show "null \<tau> = (P x and OclForall S P) \<tau>" - proof - - note 4 = 4[OF 3] - note 5 = 5[OF 2] - have 6 : "P x \<tau> = null \<tau> \<or> P x \<tau> = true \<tau>" - by(metis 4 5 bool_split_0) - show ?thesis - apply(insert 6, elim disjE) - apply(subst cp_OclAnd) - apply(simp add: OclForall_def 7 4[THEN conjunct2] 5[THEN conjunct2]) - apply(simp_all add:cp_OclAnd[symmetric]) - apply(subst cp_OclAnd, simp_all add:cp_OclAnd[symmetric] OclForall_def) - apply(simp add:4[THEN conjunct2] 5[THEN conjunct2] 0[simplified OclValid_def] 7) - apply(insert 1, elim disjE, auto) - done - qed - next - assume 1 : ?assms_1 - and 2 : "P x \<tau> = invalid \<tau> \<or> (\<exists>x\<in>\<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil>. P (\<lambda>_. x) \<tau> = invalid \<tau>)" - and 3 : ?assms_3 - show "invalid \<tau> = (P x and OclForall S P) \<tau>" - proof - - note 4 = 4[OF 3] - note 6 = 6[OF 1] - have 5 : "P x \<tau> = invalid \<tau> \<or> P x \<tau> = true \<tau>" - by(metis 4 6 bool_split_0) - show ?thesis - apply(insert 5, elim disjE) - apply(subst cp_OclAnd) - apply(simp add: OclForall_def 4[THEN conjunct2] 6[THEN conjunct2] 7) - apply(simp_all add:cp_OclAnd[symmetric]) - apply(subst cp_OclAnd, simp_all add:cp_OclAnd[symmetric] OclForall_def) - apply(insert 2, elim disjE, simp add: invalid_def true_def bot_option_def) - apply(simp add: 0[simplified OclValid_def] 4[THEN conjunct2] 6[THEN conjunct2] 7) - by(auto) - qed - next - assume 1 : ?assms_1 - and 2 : ?assms_2 - and 3 : ?assms_3 - show "true \<tau> = (P x and OclForall S P) \<tau>" - proof - - note 4 = 4[OF 3] - note 5 = 5[OF 2] - note 6 = 6[OF 1] - have 8 : "P x \<tau> = true \<tau>" - by(metis 4 5 6 bool_split_0) - show ?thesis - apply(subst cp_OclAnd, simp add: 8 cp_OclAnd[symmetric]) - by(simp add: OclForall_def 4 5 6 7) - qed - qed ( simp add: 0 - | rule C1, simp+ - | rule C2, simp add: 0 )+ - qed - - have B : "\<And>\<tau>. \<not> (\<tau> \<Turnstile> (\<delta> S and \<upsilon> x)) \<Longrightarrow> - OclForall (S->including\<^sub>S\<^sub>e\<^sub>t(x)) P \<tau> = invalid \<tau>" - apply(rule foundation22[THEN iffD1]) - apply(simp only: foundation10' de_Morgan_conj foundation18'', elim disjE) - apply(simp add: defined_split, elim disjE) - apply(erule StrongEq_L_subst2_rev, simp+)+ - done - - show ?thesis - apply(rule ext, rename_tac \<tau>) - apply(simp add: OclIf_def) - apply(simp add: cp_defined[of "\<delta> S and \<upsilon> x"] cp_defined[THEN sym]) - apply(intro conjI impI) - by(auto intro!: A B simp: OclValid_def) -qed - - -lemma OclForall_body_trivial0: - assumes S_defined: "\<tau> \<Turnstile> \<delta> S" - assumes S_not_emp: "\<tau> |\<noteq> (S \<triangleq> Set{})" - shows "(if \<exists>xa\<in>\<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil>. P then A else B) = (if P then A else B)" - apply (simp add: OclValid_def StrongEq_def true_def mtSet_def, intro impI) - apply(case_tac "S \<tau>", simp, subst (asm) Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inverse, simp) - apply(insert S_not_emp, simp add: OclValid_def StrongEq_def mtSet_def true_def) - proof - fix y show "\<lceil>\<lceil>y\<rceil>\<rceil> = {} \<Longrightarrow> S \<tau> = Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e y \<Longrightarrow> B = A" - apply(case_tac y, simp) - apply(insert S_defined, simp add: defined_def OclValid_def false_def true_def bot_fun_def bot_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def split: if_split_asm) - apply(simp) - proof - fix a show "\<lceil>a\<rceil> = {} \<Longrightarrow> S \<tau> = Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e \<lfloor>a\<rfloor> \<Longrightarrow> y = \<lfloor>a\<rfloor> \<Longrightarrow> B = A" - apply(case_tac a, simp) - apply(insert S_defined, simp add: defined_def OclValid_def false_def true_def null_fun_def null_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def split: if_split_asm) - apply(simp) - by(insert S_not_emp, simp add: OclValid_def StrongEq_def mtSet_def true_def) - qed -qed - -lemma OclForall_body_trivial: - assumes S_defined: "\<tau> \<Turnstile> \<delta> S" - shows "(\<tau> \<Turnstile> (S->forAll\<^sub>S\<^sub>e\<^sub>t(X|P) \<triangleq> (S \<triangleq> Set{} or P)))" -proof - - have A: "\<And>A B C. \<tau> \<Turnstile> (B \<triangleq> false) \<Longrightarrow> (\<tau> \<Turnstile> (A \<triangleq> (B or C))) = (\<tau> \<Turnstile> (A \<triangleq> C))" - apply(simp add: OclValid_def StrongEq_def true_def) - by(subst cp_OclOr, simp add: cp_OclOr[symmetric]) - - show ?thesis - apply(case_tac "\<tau> \<Turnstile> (S \<triangleq> Set{})") - apply(simp add: OclValid_def StrongEq_def Let_def true_def) - apply(subst cp_OclOr, subst cp_OclForall, simp, fold true_def, subst cp_OclForall[symmetric], simp) - - apply(subst A) - apply(simp add: OclValid_def StrongEq_def false_def true_def) - apply(simp add: OclValid_def, simp only: UML_Set.OclForall_def) - apply(subst cp_StrongEq, subst (1 2 3) OclForall_body_trivial0, - rule S_defined, simp add: OclValid_def, simp only: S_defined[simplified OclValid_def]) - by(simp add: StrongEq_def true_def, insert bool_split_0[of P \<tau>], auto simp add: true_def) -qed - - -subsubsection{* Execution Rules on Exists *} - -lemma OclExists_mtSet_exec[simp,code_unfold] : -"((Set{})->exists\<^sub>S\<^sub>e\<^sub>t(z | P(z))) = false" -by(simp add: OclExists_def) - -lemma OclExists_including_exec[simp,code_unfold] : - assumes cp: "cp P" - shows "((S->including\<^sub>S\<^sub>e\<^sub>t(x))->exists\<^sub>S\<^sub>e\<^sub>t(z | P(z))) = (if \<delta> S and \<upsilon> x - then P x or (S->exists\<^sub>S\<^sub>e\<^sub>t(z | P(z))) - else invalid - endif)" - by(simp add: OclExists_def OclOr_def cp OclNot_inject) - - -subsubsection{* Execution Rules on Iterate *} - -lemma OclIterate_empty[simp,code_unfold]: "((Set{})->iterate\<^sub>S\<^sub>e\<^sub>t(a; x = A | P a x)) = A" -proof - - have C : "\<And> \<tau>. (\<delta> (\<lambda>\<tau>. Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e \<lfloor>\<lfloor>{}\<rfloor>\<rfloor>)) \<tau> = true \<tau>" - by (metis (no_types) defined_def mtSet_def mtSet_defined null_fun_def) - show ?thesis - apply(simp add: OclIterate_def mtSet_def Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inverse valid_def C) - apply(rule ext, rename_tac \<tau>) - apply(case_tac "A \<tau> = \<bottom> \<tau>", simp_all, simp add:true_def false_def bot_fun_def) - apply(simp add: Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inverse) - done -qed - -text{* In particular, this does hold for A = null. *} - -lemma OclIterate_including: -assumes S_finite: "\<tau> \<Turnstile> \<delta>(S->size\<^sub>S\<^sub>e\<^sub>t())" -and F_valid_arg: "(\<upsilon> A) \<tau> = (\<upsilon> (F a A)) \<tau>" -and F_commute: "comp_fun_commute F" -and F_cp: "\<And> x y \<tau>. F x y \<tau> = F (\<lambda> _. x \<tau>) y \<tau>" -shows "((S->including\<^sub>S\<^sub>e\<^sub>t(a))->iterate\<^sub>S\<^sub>e\<^sub>t(a; x = A | F a x)) \<tau> = - ((S->excluding\<^sub>S\<^sub>e\<^sub>t(a))->iterate\<^sub>S\<^sub>e\<^sub>t(a; x = F a A | F a x)) \<tau>" -proof - - have insert_in_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e : "\<And>\<tau>. (\<tau> \<Turnstile>(\<delta> S)) \<Longrightarrow> (\<tau> \<Turnstile>(\<upsilon> a)) \<Longrightarrow> - \<lfloor>\<lfloor>insert (a \<tau>) \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil>\<rfloor>\<rfloor> \<in> {X. X = bot \<or> X = null \<or> (\<forall>x\<in>\<lceil>\<lceil>X\<rceil>\<rceil>. x \<noteq> bot)}" - by(frule Set_inv_lemma, simp add: foundation18 invalid_def) - - have insert_defined : "\<And>\<tau>. (\<tau> \<Turnstile>(\<delta> S)) \<Longrightarrow> (\<tau> \<Turnstile>(\<upsilon> a)) \<Longrightarrow> - (\<delta> (\<lambda>_. Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e \<lfloor>\<lfloor>insert (a \<tau>) \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil>\<rfloor>\<rfloor>)) \<tau> = true \<tau>" - apply(subst defined_def) - apply(simp add: bot_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def bot_fun_def null_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def null_fun_def) - by(subst Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inject, - rule insert_in_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e, simp_all add: null_option_def bot_option_def)+ - - have remove_finite : "finite \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil> \<Longrightarrow> - finite ((\<lambda>a \<tau>. a) ` (\<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil> - {a \<tau>}))" - by(simp) - - have remove_in_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e : "\<And>\<tau>. (\<tau> \<Turnstile>(\<delta> S)) \<Longrightarrow> (\<tau> \<Turnstile>(\<upsilon> a)) \<Longrightarrow> - \<lfloor>\<lfloor>\<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil> - {a \<tau>}\<rfloor>\<rfloor> \<in> {X. X = bot \<or> X = null \<or> (\<forall>x\<in>\<lceil>\<lceil>X\<rceil>\<rceil>. x \<noteq> bot)}" - by(frule Set_inv_lemma, simp add: foundation18 invalid_def) - - have remove_defined : "\<And>\<tau>. (\<tau> \<Turnstile>(\<delta> S)) \<Longrightarrow> (\<tau> \<Turnstile>(\<upsilon> a)) \<Longrightarrow> - (\<delta> (\<lambda>_. Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e \<lfloor>\<lfloor>\<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil> - {a \<tau>}\<rfloor>\<rfloor>)) \<tau> = true \<tau>" - apply(subst defined_def) - apply(simp add: bot_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def bot_fun_def null_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def null_fun_def) - by(subst Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inject, - rule remove_in_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e, simp_all add: null_option_def bot_option_def)+ - - have abs_rep: "\<And>x. \<lfloor>\<lfloor>x\<rfloor>\<rfloor> \<in> {X. X = bot \<or> X = null \<or> (\<forall>x\<in>\<lceil>\<lceil>X\<rceil>\<rceil>. x \<noteq> bot)} \<Longrightarrow> - \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e \<lfloor>\<lfloor>x\<rfloor>\<rfloor>)\<rceil>\<rceil> = x" - by(subst Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inverse, simp_all) - - have inject : "inj (\<lambda>a \<tau>. a)" - by(rule inj_fun, simp) - - show ?thesis - apply(subst (1 2) cp_OclIterate, subst OclIncluding_def, subst OclExcluding_def) - apply(case_tac "\<not> ((\<delta> S) \<tau> = true \<tau> \<and> (\<upsilon> a) \<tau> = true \<tau>)", simp add: invalid_def) - - apply(subgoal_tac "OclIterate (\<lambda>_. \<bottom>) A F \<tau> = OclIterate (\<lambda>_. \<bottom>) (F a A) F \<tau>", simp) - apply(rule conjI, blast+) - apply(simp add: OclIterate_def defined_def bot_option_def bot_fun_def false_def true_def) - - apply(simp add: OclIterate_def) - apply((subst abs_rep[OF insert_in_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e[simplified OclValid_def], of \<tau>], simp_all)+, - (subst abs_rep[OF remove_in_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e[simplified OclValid_def], of \<tau>], simp_all)+, - (subst insert_defined, simp_all add: OclValid_def)+, - (subst remove_defined, simp_all add: OclValid_def)+) - - apply(case_tac "\<not> ((\<upsilon> A) \<tau> = true \<tau>)", (simp add: F_valid_arg)+) - apply(rule impI, - subst Finite_Set.comp_fun_commute.fold_fun_left_comm[symmetric, OF F_commute], - rule remove_finite, simp) - - apply(subst image_set_diff[OF inject], simp) - apply(subgoal_tac "Finite_Set.fold F A (insert (\<lambda>\<tau>'. a \<tau>) ((\<lambda>a \<tau>. a) ` \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil>)) \<tau> = - F (\<lambda>\<tau>'. a \<tau>) (Finite_Set.fold F A ((\<lambda>a \<tau>. a) ` \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil> - {\<lambda>\<tau>'. a \<tau>})) \<tau>") - apply(subst F_cp, simp) - - by(subst Finite_Set.comp_fun_commute.fold_insert_remove[OF F_commute], simp+) -qed - -subsubsection{* Execution Rules on Select *} - -lemma OclSelect_mtSet_exec[simp,code_unfold]: "OclSelect mtSet P = mtSet" - apply(rule ext, rename_tac \<tau>) - apply(simp add: OclSelect_def mtSet_def defined_def false_def true_def - bot_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def bot_fun_def null_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def null_fun_def) -by(( subst (1 2 3 4 5) Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inverse - | subst Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inject), (simp add: null_option_def bot_option_def)+)+ - -definition "OclSelect_body :: _ \<Rightarrow> _ \<Rightarrow> _ \<Rightarrow> ('\<AA>, 'a option option) Set - \<equiv> (\<lambda>P x acc. if P x \<doteq> false then acc else acc->including\<^sub>S\<^sub>e\<^sub>t(x) endif)" - -theorem OclSelect_including_exec[simp,code_unfold]: - assumes P_cp : "cp P" - shows "OclSelect (X->including\<^sub>S\<^sub>e\<^sub>t(y)) P = OclSelect_body P y (OclSelect (X->excluding\<^sub>S\<^sub>e\<^sub>t(y)) P)" - (is "_ = ?select") -proof - - have P_cp: "\<And>x \<tau>. P x \<tau> = P (\<lambda>_. x \<tau>) \<tau>" by(insert P_cp, auto simp: cp_def) - - have ex_including : "\<And>f X y \<tau>. \<tau> \<Turnstile> \<delta> X \<Longrightarrow> \<tau> \<Turnstile> \<upsilon> y \<Longrightarrow> - (\<exists>x\<in>\<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (X->including\<^sub>S\<^sub>e\<^sub>t(y) \<tau>)\<rceil>\<rceil>. f (P (\<lambda>_. x)) \<tau>) = - (f (P (\<lambda>_. y \<tau>)) \<tau> \<or> (\<exists>x\<in>\<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (X \<tau>)\<rceil>\<rceil>. f (P (\<lambda>_. x)) \<tau>))" - apply(simp add: OclIncluding_def OclValid_def) - apply(subst Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inverse, simp, (rule disjI2)+) - by (metis (hide_lams, no_types) OclValid_def Set_inv_lemma foundation18',simp) - - have al_including : "\<And>f X y \<tau>. \<tau> \<Turnstile> \<delta> X \<Longrightarrow> \<tau> \<Turnstile> \<upsilon> y \<Longrightarrow> - (\<forall>x\<in>\<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (X->including\<^sub>S\<^sub>e\<^sub>t(y) \<tau>)\<rceil>\<rceil>. f (P (\<lambda>_. x)) \<tau>) = - (f (P (\<lambda>_. y \<tau>)) \<tau> \<and> (\<forall>x\<in>\<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (X \<tau>)\<rceil>\<rceil>. f (P (\<lambda>_. x)) \<tau>))" - apply(simp add: OclIncluding_def OclValid_def) - apply(subst Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inverse, simp, (rule disjI2)+) - by (metis (hide_lams, no_types) OclValid_def Set_inv_lemma foundation18', simp) - - have ex_excluding1 : "\<And>f X y \<tau>. \<tau> \<Turnstile> \<delta> X \<Longrightarrow> \<tau> \<Turnstile> \<upsilon> y \<Longrightarrow> \<not> (f (P (\<lambda>_. y \<tau>)) \<tau>) \<Longrightarrow> - (\<exists>x\<in>\<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (X \<tau>)\<rceil>\<rceil>. f (P (\<lambda>_. x)) \<tau>) = - (\<exists>x\<in>\<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (X->excluding\<^sub>S\<^sub>e\<^sub>t(y) \<tau>)\<rceil>\<rceil>. f (P (\<lambda>_. x)) \<tau>)" - apply(simp add: OclExcluding_def OclValid_def) - apply(subst Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inverse, simp, (rule disjI2)+) - by (metis (no_types) Diff_iff OclValid_def Set_inv_lemma) auto - - have al_excluding1 : "\<And>f X y \<tau>. \<tau> \<Turnstile> \<delta> X \<Longrightarrow> \<tau> \<Turnstile> \<upsilon> y \<Longrightarrow> f (P (\<lambda>_. y \<tau>)) \<tau> \<Longrightarrow> - (\<forall>x\<in>\<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (X \<tau>)\<rceil>\<rceil>. f (P (\<lambda>_. x)) \<tau>) = - (\<forall>x\<in>\<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (X->excluding\<^sub>S\<^sub>e\<^sub>t(y) \<tau>)\<rceil>\<rceil>. f (P (\<lambda>_. x)) \<tau>)" - apply(simp add: OclExcluding_def OclValid_def) - apply(subst Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inverse, simp, (rule disjI2)+) - by (metis (no_types) Diff_iff OclValid_def Set_inv_lemma) auto - - have in_including : "\<And>f X y \<tau>. \<tau> \<Turnstile> \<delta> X \<Longrightarrow> \<tau> \<Turnstile> \<upsilon> y \<Longrightarrow> - {x \<in> \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (X->including\<^sub>S\<^sub>e\<^sub>t(y) \<tau>)\<rceil>\<rceil>. f (P (\<lambda>_. x) \<tau>)} = - (let s = {x \<in> \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (X \<tau>)\<rceil>\<rceil>. f (P (\<lambda>_. x) \<tau>)} in - if f (P (\<lambda>_. y \<tau>) \<tau>) then insert (y \<tau>) s else s)" - apply(simp add: OclIncluding_def OclValid_def) - apply(subst Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inverse, simp, (rule disjI2)+) - apply (metis (hide_lams, no_types) OclValid_def Set_inv_lemma foundation18') - by(simp add: Let_def, auto) - - let ?OclSet = "\<lambda>S. \<lfloor>\<lfloor>S\<rfloor>\<rfloor> \<in> {X. X = \<bottom> \<or> X = null \<or> (\<forall>x\<in>\<lceil>\<lceil>X\<rceil>\<rceil>. x \<noteq> \<bottom>)}" - - have diff_in_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e : "\<And>\<tau>. (\<delta> X) \<tau> = true \<tau> \<Longrightarrow> ?OclSet (\<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (X \<tau>)\<rceil>\<rceil> - {y \<tau>})" - apply(simp, (rule disjI2)+) - by (metis (mono_tags) Diff_iff OclValid_def Set_inv_lemma) - - have ins_in_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e : "\<And>\<tau>. (\<delta> X) \<tau> = true \<tau> \<Longrightarrow> (\<upsilon> y) \<tau> = true \<tau> \<Longrightarrow> - ?OclSet (insert (y \<tau>) {x \<in> \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (X \<tau>)\<rceil>\<rceil>. P (\<lambda>_. x) \<tau> \<noteq> false \<tau>})" - apply(simp, (rule disjI2)+) - by (metis (hide_lams, no_types) OclValid_def Set_inv_lemma foundation18') - - have ins_in_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e' : "\<And>\<tau>. (\<delta> X) \<tau> = true \<tau> \<Longrightarrow> (\<upsilon> y) \<tau> = true \<tau> \<Longrightarrow> - ?OclSet (insert (y \<tau>) {x \<in> \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (X \<tau>)\<rceil>\<rceil>. x \<noteq> y \<tau> \<and> P (\<lambda>_. x) \<tau> \<noteq> false \<tau>})" - apply(simp, (rule disjI2)+) - by (metis (hide_lams, no_types) OclValid_def Set_inv_lemma foundation18') - - have ins_in_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e'' : "\<And>\<tau>. (\<delta> X) \<tau> = true \<tau> \<Longrightarrow> - ?OclSet {x \<in> \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (X \<tau>)\<rceil>\<rceil>. P (\<lambda>_. x) \<tau> \<noteq> false \<tau>}" - apply(simp, (rule disjI2)+) - by (metis (hide_lams, no_types) OclValid_def Set_inv_lemma) - - have ins_in_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e''' : "\<And>\<tau>. (\<delta> X) \<tau> = true \<tau> \<Longrightarrow> - ?OclSet {x \<in> \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (X \<tau>)\<rceil>\<rceil>. x \<noteq> y \<tau> \<and> P (\<lambda>_. x) \<tau> \<noteq> false \<tau>}" - apply(simp, (rule disjI2)+) - by(metis (hide_lams, no_types) OclValid_def Set_inv_lemma) - - have if_same : "\<And>a b c d \<tau>. \<tau> \<Turnstile> \<delta> a \<Longrightarrow> b \<tau> = d \<tau> \<Longrightarrow> c \<tau> = d \<tau> \<Longrightarrow> - (if a then b else c endif) \<tau> = d \<tau>" - by(simp add: OclIf_def OclValid_def) - - have invert_including : "\<And>P y \<tau>. P \<tau> = \<bottom> \<Longrightarrow> P->including\<^sub>S\<^sub>e\<^sub>t(y) \<tau> = \<bottom>" - by (metis (hide_lams, no_types) foundation16[THEN iffD1] - foundation18' OclIncluding_valid_args_valid) - - have exclude_defined : "\<And>\<tau>. \<tau> \<Turnstile> \<delta> X \<Longrightarrow> - (\<delta>(\<lambda>_. Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e \<lfloor>\<lfloor>{x\<in>\<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (X \<tau>)\<rceil>\<rceil>. x \<noteq> y \<tau> \<and> P (\<lambda>_. x) \<tau>\<noteq>false \<tau>}\<rfloor>\<rfloor>)) \<tau> = true \<tau>" - apply(subst defined_def, - simp add: false_def true_def bot_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def bot_fun_def null_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def null_fun_def) - by(subst Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inject[OF ins_in_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e'''[simplified false_def]], - (simp add: OclValid_def bot_option_def null_option_def)+)+ - - have if_eq : "\<And>x A B \<tau>. \<tau> \<Turnstile> \<upsilon> x \<Longrightarrow> \<tau> \<Turnstile> ((if x \<doteq> false then A else B endif) \<triangleq> - (if x \<triangleq> false then A else B endif))" - apply(simp add: StrictRefEq\<^sub>B\<^sub>o\<^sub>o\<^sub>l\<^sub>e\<^sub>a\<^sub>n OclValid_def) - apply(subst (2) StrongEq_def) - by(subst cp_OclIf, simp add: cp_OclIf[symmetric] true_def) - - have OclSelect_body_bot: "\<And>\<tau>. \<tau> \<Turnstile> \<delta> X \<Longrightarrow> \<tau> \<Turnstile> \<upsilon> y \<Longrightarrow> P y \<tau> \<noteq> \<bottom> \<Longrightarrow> - (\<exists>x\<in>\<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (X \<tau>)\<rceil>\<rceil>. P (\<lambda>_. x) \<tau> = \<bottom>) \<Longrightarrow> \<bottom> = ?select \<tau>" - apply(drule ex_excluding1[where X2 = X and y2 = y and f2 = "\<lambda>x \<tau>. x \<tau> = \<bottom>"], - (simp add: P_cp[symmetric])+) - apply(subgoal_tac "\<tau> \<Turnstile> (\<bottom> \<triangleq> ?select)", simp add: OclValid_def StrongEq_def true_def bot_fun_def) - apply(simp add: OclSelect_body_def) - apply(subst StrongEq_L_subst3[OF _ if_eq], simp, metis foundation18') - apply(simp add: OclValid_def, subst StrongEq_def, subst true_def, simp) - apply(subgoal_tac "\<exists>x\<in>\<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (X->excluding\<^sub>S\<^sub>e\<^sub>t(y) \<tau>)\<rceil>\<rceil>. P (\<lambda>_. x) \<tau> = \<bottom> \<tau>") - prefer 2 apply (metis bot_fun_def ) - apply(subst if_same[where d5 = "\<bottom>"]) - apply (metis defined7 transform1) - apply(simp add: OclSelect_def bot_option_def bot_fun_def invalid_def) - apply(subst invert_including) - by(simp add: OclSelect_def bot_option_def bot_fun_def invalid_def)+ - - - have d_and_v_inject : "\<And>\<tau> X y. (\<delta> X and \<upsilon> y) \<tau> \<noteq> true \<tau> \<Longrightarrow> (\<delta> X and \<upsilon> y) \<tau> = false \<tau>" - apply(fold OclValid_def, subst foundation22[symmetric]) - apply(auto simp:foundation10' defined_split) - apply(erule StrongEq_L_subst2_rev,simp,simp) - apply(erule StrongEq_L_subst2_rev,simp,simp) - by(erule foundation7'[THEN iffD2, THEN foundation15[THEN iffD2, - THEN StrongEq_L_subst2_rev]],simp,simp) - - - - - have OclSelect_body_bot': "\<And>\<tau>. (\<delta> X and \<upsilon> y) \<tau> \<noteq> true \<tau> \<Longrightarrow> \<bottom> = ?select \<tau>" - apply(drule d_and_v_inject) - apply(simp add: OclSelect_def OclSelect_body_def) - apply(subst cp_OclIf, subst OclIncluding.cp0, simp add: false_def true_def) - apply(subst cp_OclIf[symmetric], subst OclIncluding.cp0[symmetric]) - by (metis (lifting, no_types) OclIf_def foundation18 foundation18' invert_including) - - have conj_split2 : "\<And>a b c \<tau>. ((a \<triangleq> false) \<tau> = false \<tau> \<longrightarrow> b) \<and> ((a \<triangleq> false) \<tau> = true \<tau> \<longrightarrow> c) \<Longrightarrow> - (a \<tau> \<noteq> false \<tau> \<longrightarrow> b) \<and> (a \<tau> = false \<tau> \<longrightarrow> c)" - by (metis OclValid_def defined7 foundation14 foundation22 foundation9) - - have defined_inject_true : "\<And>\<tau> P. (\<delta> P) \<tau> \<noteq> true \<tau> \<Longrightarrow> (\<delta> P) \<tau> = false \<tau>" - apply(simp add: defined_def true_def false_def bot_fun_def bot_option_def - null_fun_def null_option_def) - by (case_tac " P \<tau> = \<bottom> \<or> P \<tau> = null", simp_all add: true_def) - - have cp_OclSelect_body : "\<And>\<tau>. ?select \<tau> = OclSelect_body P y (\<lambda>_.(OclSelect (X->excluding\<^sub>S\<^sub>e\<^sub>t(y))P)\<tau>)\<tau>" - apply(simp add: OclSelect_body_def) - by(subst (1 2) cp_OclIf, subst (1 2) OclIncluding.cp0, blast) - - have OclSelect_body_strict1 : "OclSelect_body P y invalid = invalid" - by(rule ext, simp add: OclSelect_body_def OclIf_def) - - have bool_invalid: "\<And>(x::('\<AA>)Boolean) y \<tau>. \<not> (\<tau> \<Turnstile> \<upsilon> x) \<Longrightarrow> \<tau> \<Turnstile> ((x \<doteq> y) \<triangleq> invalid)" - by(simp add: StrictRefEq\<^sub>B\<^sub>o\<^sub>o\<^sub>l\<^sub>e\<^sub>a\<^sub>n OclValid_def StrongEq_def true_def) - - have conj_comm : "\<And>p q r. (p \<and> q \<and> r) = ((p \<and> q) \<and> r)" by blast - - have inv_bot : "\<And>\<tau>. invalid \<tau> = \<bottom> \<tau>" by (metis bot_fun_def invalid_def) - have inv_bot' : "\<And>\<tau>. invalid \<tau> = \<bottom>" by (simp add: invalid_def) - - show ?thesis - apply(rule ext, rename_tac \<tau>) - apply(subst OclSelect_def) - apply(case_tac "(\<delta> (X->including\<^sub>S\<^sub>e\<^sub>t(y))) \<tau> = true \<tau>", simp) - apply(( subst ex_including | subst in_including), - metis OclValid_def foundation5, - metis OclValid_def foundation5)+ - apply(simp add: Let_def inv_bot) - apply(subst (2 4 7 9) bot_fun_def) - - apply(subst (4) false_def, subst (4) bot_fun_def, simp add: bot_option_def P_cp[symmetric]) - (* *) - apply(case_tac "\<not> (\<tau> \<Turnstile> (\<upsilon> P y))") - apply(subgoal_tac "P y \<tau> \<noteq> false \<tau>") - prefer 2 - apply (metis (hide_lams, no_types) foundation1 foundation18' valid4) - apply(simp) - (* *) - apply(subst conj_comm, rule conjI) - apply(drule_tac y11 = false in bool_invalid) - apply(simp only: OclSelect_body_def, - metis OclIf_def OclValid_def defined_def foundation2 foundation22 - bot_fun_def invalid_def) - (* *) - apply(drule foundation5[simplified OclValid_def], - subst al_including[simplified OclValid_def], - simp, - simp) - apply(simp add: P_cp[symmetric]) - apply (metis bot_fun_def foundation18') - - apply(simp add: foundation18' bot_fun_def OclSelect_body_bot OclSelect_body_bot') - (* *) - apply(subst (1 2) al_including, metis OclValid_def foundation5, metis OclValid_def foundation5) - apply(simp add: P_cp[symmetric], subst (4) false_def, subst (4) bot_option_def, simp) - - apply(simp add: OclSelect_def[simplified inv_bot'] OclSelect_body_def StrictRefEq\<^sub>B\<^sub>o\<^sub>o\<^sub>l\<^sub>e\<^sub>a\<^sub>n) - apply(subst (1 2 3 4) cp_OclIf, - subst (1 2 3 4) foundation18'[THEN iffD2, simplified OclValid_def], - simp, - simp only: cp_OclIf[symmetric] refl if_True) - apply(subst (1 2) OclIncluding.cp0, rule conj_split2, simp add: cp_OclIf[symmetric]) - apply(subst (1 2 3 4 5 6 7 8) cp_OclIf[symmetric], simp) - apply(( subst ex_excluding1[symmetric] - | subst al_excluding1[symmetric] ), - metis OclValid_def foundation5, - metis OclValid_def foundation5, - simp add: P_cp[symmetric] bot_fun_def)+ - apply(simp add: bot_fun_def) - apply(subst (1 2) invert_including, simp+) - (* *) - apply(rule conjI, blast) - apply(intro impI conjI) - apply(subst OclExcluding_def) - apply(drule foundation5[simplified OclValid_def], simp) - apply(subst Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inverse[OF diff_in_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e], fast) - apply(simp add: OclIncluding_def cp_valid[symmetric]) - apply((erule conjE)+, frule exclude_defined[simplified OclValid_def], simp) - apply(subst Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inverse[OF ins_in_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e'''], simp+) - apply(subst Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inject[OF ins_in_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e ins_in_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e'], fast+) - (* *) - apply(simp add: OclExcluding_def) - apply(simp add: foundation10[simplified OclValid_def]) - apply(subst Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inverse[OF diff_in_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e], simp+) - apply(subst Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inject[OF ins_in_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e'' ins_in_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e'''], simp+) - apply(subgoal_tac "P (\<lambda>_. y \<tau>) \<tau> = false \<tau>") - prefer 2 - apply(subst P_cp[symmetric], metis OclValid_def foundation22) - apply(rule equalityI) - apply(rule subsetI, simp, metis) - apply(rule subsetI, simp) - (* *) - apply(drule defined_inject_true) - apply(subgoal_tac "\<not> (\<tau> \<Turnstile> \<delta> X) \<or> \<not> (\<tau> \<Turnstile> \<upsilon> y)") - prefer 2 - apply (metis OclIncluding.def_homo OclIncluding_valid_args_valid OclIncluding_valid_args_valid'' OclValid_def foundation18 valid1) - apply(subst cp_OclSelect_body, subst cp_OclSelect, subst OclExcluding_def) - apply(simp add: OclValid_def false_def true_def, rule conjI, blast) - apply(simp add: OclSelect_invalid[simplified invalid_def] - OclSelect_body_strict1[simplified invalid_def] - inv_bot') - done -qed - -subsubsection{* Execution Rules on Reject *} - -lemma OclReject_mtSet_exec[simp,code_unfold]: "OclReject mtSet P = mtSet" -by(simp add: OclReject_def) - -lemma OclReject_including_exec[simp,code_unfold]: - assumes P_cp : "cp P" - shows "OclReject (X->including\<^sub>S\<^sub>e\<^sub>t(y)) P = OclSelect_body (not o P) y (OclReject (X->excluding\<^sub>S\<^sub>e\<^sub>t(y)) P)" - apply(simp add: OclReject_def comp_def, rule OclSelect_including_exec) -by (metis assms cp_intro'(5)) - -subsubsection{* Execution Rules Combining Previous Operators *} - -text{* OclIncluding *} - -(* logical level : *) -lemma OclIncluding_idem0 : - assumes "\<tau> \<Turnstile> \<delta> S" - and "\<tau> \<Turnstile> \<upsilon> i" - shows "\<tau> \<Turnstile> (S->including\<^sub>S\<^sub>e\<^sub>t(i)->including\<^sub>S\<^sub>e\<^sub>t(i) \<triangleq> (S->including\<^sub>S\<^sub>e\<^sub>t(i)))" -by(simp add: OclIncluding_includes OclIncludes_charn1 assms) - -(* Pure algebraic level *) -theorem OclIncluding_idem[simp,code_unfold]: "((S :: ('\<AA>,'a::null)Set)->including\<^sub>S\<^sub>e\<^sub>t(i)->including\<^sub>S\<^sub>e\<^sub>t(i) = (S->including\<^sub>S\<^sub>e\<^sub>t(i)))" -proof - - have A: "\<And> \<tau>. \<tau> \<Turnstile> (i \<triangleq> invalid) \<Longrightarrow> (S->including\<^sub>S\<^sub>e\<^sub>t(i)->including\<^sub>S\<^sub>e\<^sub>t(i)) \<tau> = invalid \<tau>" - apply(rule foundation22[THEN iffD1]) - by(erule StrongEq_L_subst2_rev, simp,simp) - have A':"\<And> \<tau>. \<tau> \<Turnstile> (i \<triangleq> invalid) \<Longrightarrow> (S->including\<^sub>S\<^sub>e\<^sub>t(i)) \<tau> = invalid \<tau>" - apply(rule foundation22[THEN iffD1]) - by(erule StrongEq_L_subst2_rev, simp,simp) - have C: "\<And> \<tau>. \<tau> \<Turnstile> (S \<triangleq> invalid) \<Longrightarrow> (S->including\<^sub>S\<^sub>e\<^sub>t(i)->including\<^sub>S\<^sub>e\<^sub>t(i)) \<tau> = invalid \<tau>" - apply(rule foundation22[THEN iffD1]) - by(erule StrongEq_L_subst2_rev, simp,simp) - have C': "\<And> \<tau>. \<tau> \<Turnstile> (S \<triangleq> invalid) \<Longrightarrow> (S->including\<^sub>S\<^sub>e\<^sub>t(i)) \<tau> = invalid \<tau>" - apply(rule foundation22[THEN iffD1]) - by(erule StrongEq_L_subst2_rev, simp,simp) - have D: "\<And> \<tau>. \<tau> \<Turnstile> (S \<triangleq> null) \<Longrightarrow> (S->including\<^sub>S\<^sub>e\<^sub>t(i)->including\<^sub>S\<^sub>e\<^sub>t(i)) \<tau> = invalid \<tau>" - apply(rule foundation22[THEN iffD1]) - by(erule StrongEq_L_subst2_rev, simp,simp) - have D': "\<And> \<tau>. \<tau> \<Turnstile> (S \<triangleq> null) \<Longrightarrow> (S->including\<^sub>S\<^sub>e\<^sub>t(i)) \<tau> = invalid \<tau>" - apply(rule foundation22[THEN iffD1]) - by(erule StrongEq_L_subst2_rev, simp,simp) - show ?thesis - apply(rule ext, rename_tac \<tau>) - apply(case_tac "\<tau> \<Turnstile> (\<upsilon> i)") - apply(case_tac "\<tau> \<Turnstile> (\<delta> S)") - apply(simp only: OclIncluding_idem0[THEN foundation22[THEN iffD1]]) - apply(simp add: foundation16', elim disjE) - apply(simp add: C[OF foundation22[THEN iffD2]] C'[OF foundation22[THEN iffD2]]) - apply(simp add: D[OF foundation22[THEN iffD2]] D'[OF foundation22[THEN iffD2]]) - apply(simp add:foundation18 A[OF foundation22[THEN iffD2]] A'[OF foundation22[THEN iffD2]]) - done -qed - -text{* OclExcluding *} - -(* logical level : *) -lemma OclExcluding_idem0 : - assumes "\<tau> \<Turnstile> \<delta> S" - and "\<tau> \<Turnstile> \<upsilon> i" - shows "\<tau> \<Turnstile> (S->excluding\<^sub>S\<^sub>e\<^sub>t(i)->excluding\<^sub>S\<^sub>e\<^sub>t(i) \<triangleq> (S->excluding\<^sub>S\<^sub>e\<^sub>t(i)))" -by(simp add: OclExcluding_excludes OclExcludes_charn1 assms) - -(* Pure algebraic level *) -theorem OclExcluding_idem[simp,code_unfold]: "((S->excluding\<^sub>S\<^sub>e\<^sub>t(i))->excluding\<^sub>S\<^sub>e\<^sub>t(i)) = (S->excluding\<^sub>S\<^sub>e\<^sub>t(i))" -proof - - have A: "\<And> \<tau>. \<tau> \<Turnstile> (i \<triangleq> invalid) \<Longrightarrow> (S->excluding\<^sub>S\<^sub>e\<^sub>t(i)->excluding\<^sub>S\<^sub>e\<^sub>t(i)) \<tau> = invalid \<tau>" - apply(rule foundation22[THEN iffD1]) - by(erule StrongEq_L_subst2_rev, simp,simp) - have A':"\<And> \<tau>. \<tau> \<Turnstile> (i \<triangleq> invalid) \<Longrightarrow> (S->excluding\<^sub>S\<^sub>e\<^sub>t(i)) \<tau> = invalid \<tau>" - apply(rule foundation22[THEN iffD1]) - by(erule StrongEq_L_subst2_rev, simp,simp) - have C: "\<And> \<tau>. \<tau> \<Turnstile> (S \<triangleq> invalid) \<Longrightarrow> (S->excluding\<^sub>S\<^sub>e\<^sub>t(i)->excluding\<^sub>S\<^sub>e\<^sub>t(i)) \<tau> = invalid \<tau>" - apply(rule foundation22[THEN iffD1]) - by(erule StrongEq_L_subst2_rev, simp,simp) - have C': "\<And> \<tau>. \<tau> \<Turnstile> (S \<triangleq> invalid) \<Longrightarrow> (S->excluding\<^sub>S\<^sub>e\<^sub>t(i)) \<tau> = invalid \<tau>" - apply(rule foundation22[THEN iffD1]) - by(erule StrongEq_L_subst2_rev, simp,simp) - have D: "\<And> \<tau>. \<tau> \<Turnstile> (S \<triangleq> null) \<Longrightarrow> (S->excluding\<^sub>S\<^sub>e\<^sub>t(i)->excluding\<^sub>S\<^sub>e\<^sub>t(i)) \<tau> = invalid \<tau>" - apply(rule foundation22[THEN iffD1]) - by(erule StrongEq_L_subst2_rev, simp,simp) - have D': "\<And> \<tau>. \<tau> \<Turnstile> (S \<triangleq> null) \<Longrightarrow> (S->excluding\<^sub>S\<^sub>e\<^sub>t(i)) \<tau> = invalid \<tau>" - apply(rule foundation22[THEN iffD1]) - by(erule StrongEq_L_subst2_rev, simp,simp) - show ?thesis - apply(rule ext, rename_tac \<tau>) - apply(case_tac "\<tau> \<Turnstile> (\<upsilon> i)") - apply(case_tac "\<tau> \<Turnstile> (\<delta> S)") - apply(simp only: OclExcluding_idem0[THEN foundation22[THEN iffD1]]) - apply(simp add: foundation16', elim disjE) - apply(simp add: C[OF foundation22[THEN iffD2]] C'[OF foundation22[THEN iffD2]]) - apply(simp add: D[OF foundation22[THEN iffD2]] D'[OF foundation22[THEN iffD2]]) - apply(simp add:foundation18 A[OF foundation22[THEN iffD2]] A'[OF foundation22[THEN iffD2]]) - done -qed - -text{* OclIncludes *} - - -lemma OclIncludes_any[simp,code_unfold]: - "X->includes\<^sub>S\<^sub>e\<^sub>t(X->any\<^sub>S\<^sub>e\<^sub>t()) = (if \<delta> X then - if \<delta> (X->size\<^sub>S\<^sub>e\<^sub>t()) then not(X->isEmpty\<^sub>S\<^sub>e\<^sub>t()) - else X->includes\<^sub>S\<^sub>e\<^sub>t(null) endif - else invalid endif)" -proof - - have defined_inject_true : "\<And>\<tau> P. (\<delta> P) \<tau> \<noteq> true \<tau> \<Longrightarrow> (\<delta> P) \<tau> = false \<tau>" - apply(simp add: defined_def true_def false_def bot_fun_def bot_option_def - null_fun_def null_option_def) - by (case_tac " P \<tau> = \<bottom> \<or> P \<tau> = null", simp_all add: true_def) - - have valid_inject_true : "\<And>\<tau> P. (\<upsilon> P) \<tau> \<noteq> true \<tau> \<Longrightarrow> (\<upsilon> P) \<tau> = false \<tau>" - apply(simp add: valid_def true_def false_def bot_fun_def bot_option_def - null_fun_def null_option_def) - by (case_tac "P \<tau> = \<bottom>", simp_all add: true_def) - - - - have notempty': "\<And>\<tau> X. \<tau> \<Turnstile> \<delta> X \<Longrightarrow> finite \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (X \<tau>)\<rceil>\<rceil> \<Longrightarrow> not (X->isEmpty\<^sub>S\<^sub>e\<^sub>t()) \<tau> \<noteq> true \<tau> \<Longrightarrow> - X \<tau> = Set{} \<tau>" - apply(case_tac "X \<tau>", rename_tac X', simp add: mtSet_def Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inject) - apply(erule disjE, metis (hide_lams, mono_tags) bot_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def bot_option_def foundation16) - apply(erule disjE, metis (hide_lams, no_types) bot_option_def - null_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def null_option_def foundation16[THEN iffD1]) - apply(case_tac X', simp, metis (hide_lams, no_types) bot_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def foundation16[THEN iffD1]) - apply(rename_tac X'', case_tac X'', simp) - apply (metis (hide_lams, no_types) foundation16[THEN iffD1] null_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def) - apply(simp add: OclIsEmpty_def OclSize_def) - apply(subst (asm) cp_OclNot, subst (asm) cp_OclOr, subst (asm) StrictRefEq\<^sub>I\<^sub>n\<^sub>t\<^sub>e\<^sub>g\<^sub>e\<^sub>r.cp0, - subst (asm) cp_OclAnd, subst (asm) cp_OclNot) - apply(simp only: OclValid_def foundation20[simplified OclValid_def] - cp_OclNot[symmetric] cp_OclAnd[symmetric] cp_OclOr[symmetric]) - apply(simp add: Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inverse split: if_split_asm) - by(simp add: true_def OclInt0_def OclNot_def StrictRefEq\<^sub>I\<^sub>n\<^sub>t\<^sub>e\<^sub>g\<^sub>e\<^sub>r StrongEq_def) - - have B: "\<And>X \<tau>. \<not> finite \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (X \<tau>)\<rceil>\<rceil> \<Longrightarrow> (\<delta> (X->size\<^sub>S\<^sub>e\<^sub>t())) \<tau> = false \<tau>" - apply(subst cp_defined) - apply(simp add: OclSize_def) - by (metis bot_fun_def defined_def) - - show ?thesis - apply(rule ext, rename_tac \<tau>, simp only: OclIncludes_def OclANY_def) - apply(subst cp_OclIf, subst (2) cp_valid) - apply(case_tac "(\<delta> X) \<tau> = true \<tau>", - simp only: foundation20[simplified OclValid_def] cp_OclIf[symmetric], simp, - subst (1 2) cp_OclAnd, simp add: cp_OclAnd[symmetric]) - apply(case_tac "finite \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (X \<tau>)\<rceil>\<rceil>") - apply(frule size_defined'[THEN iffD2, simplified OclValid_def], assumption) - apply(subst (1 2 3 4) cp_OclIf, simp) - apply(subst (1 2 3 4) cp_OclIf[symmetric], simp) - apply(case_tac "(X->notEmpty\<^sub>S\<^sub>e\<^sub>t()) \<tau> = true \<tau>", simp) - apply(frule OclNotEmpty_has_elt[simplified OclValid_def], simp) - apply(simp add: OclNotEmpty_def cp_OclIf[symmetric]) - apply(subgoal_tac "(SOME y. y \<in> \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (X \<tau>)\<rceil>\<rceil>) \<in> \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (X \<tau>)\<rceil>\<rceil>", simp add: true_def) - apply(metis OclValid_def Set_inv_lemma foundation18' null_option_def true_def) - apply(rule someI_ex, simp) - apply(simp add: OclNotEmpty_def cp_valid[symmetric]) - apply(subgoal_tac "\<not> (null \<tau> \<in> \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (X \<tau>)\<rceil>\<rceil>)", simp) - apply(subst OclIsEmpty_def, simp add: OclSize_def) - apply(subst cp_OclNot, subst cp_OclOr, subst StrictRefEq\<^sub>I\<^sub>n\<^sub>t\<^sub>e\<^sub>g\<^sub>e\<^sub>r.cp0, subst cp_OclAnd, - subst cp_OclNot, simp add: OclValid_def foundation20[simplified OclValid_def] - cp_OclNot[symmetric] cp_OclAnd[symmetric] cp_OclOr[symmetric]) - apply(frule notempty'[simplified OclValid_def], - (simp add: mtSet_def Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inverse OclInt0_def false_def)+) - apply(drule notempty'[simplified OclValid_def], simp, simp) - apply (metis (hide_lams, no_types) empty_iff mtSet_rep_set) - (* *) - apply(frule B) - apply(subst (1 2 3 4) cp_OclIf, simp) - apply(subst (1 2 3 4) cp_OclIf[symmetric], simp) - apply(case_tac "(X->notEmpty\<^sub>S\<^sub>e\<^sub>t()) \<tau> = true \<tau>", simp) - apply(frule OclNotEmpty_has_elt[simplified OclValid_def], simp) - apply(simp add: OclNotEmpty_def OclIsEmpty_def) - apply(subgoal_tac "X->size\<^sub>S\<^sub>e\<^sub>t() \<tau> = \<bottom>") - prefer 2 - apply (metis (hide_lams, no_types) OclSize_def) - apply(subst (asm) cp_OclNot, subst (asm) cp_OclOr, subst (asm) StrictRefEq\<^sub>I\<^sub>n\<^sub>t\<^sub>e\<^sub>g\<^sub>e\<^sub>r.cp0, - subst (asm) cp_OclAnd, subst (asm) cp_OclNot) - apply(simp add: OclValid_def foundation20[simplified OclValid_def] - cp_OclNot[symmetric] cp_OclAnd[symmetric] cp_OclOr[symmetric]) - apply(simp add: OclNot_def StrongEq_def StrictRefEq\<^sub>I\<^sub>n\<^sub>t\<^sub>e\<^sub>g\<^sub>e\<^sub>r valid_def false_def true_def - bot_option_def bot_fun_def invalid_def) - - apply (metis bot_fun_def null_fun_def null_is_valid valid_def) - by(drule defined_inject_true, - simp add: false_def true_def OclIf_false[simplified false_def] invalid_def) -qed - -text{* OclSize *} - -lemma [simp,code_unfold]: "\<delta> (Set{} ->size\<^sub>S\<^sub>e\<^sub>t()) = true" -by simp - - -lemma [simp,code_unfold]: "\<delta> ((X ->including\<^sub>S\<^sub>e\<^sub>t(x)) ->size\<^sub>S\<^sub>e\<^sub>t()) = (\<delta>(X->size\<^sub>S\<^sub>e\<^sub>t()) and \<upsilon>(x))" -proof - - have defined_inject_true : "\<And>\<tau> P. (\<delta> P) \<tau> \<noteq> true \<tau> \<Longrightarrow> (\<delta> P) \<tau> = false \<tau>" - apply(simp add: defined_def true_def false_def bot_fun_def bot_option_def - null_fun_def null_option_def) - by (case_tac " P \<tau> = \<bottom> \<or> P \<tau> = null", simp_all add: true_def) - - have valid_inject_true : "\<And>\<tau> P. (\<upsilon> P) \<tau> \<noteq> true \<tau> \<Longrightarrow> (\<upsilon> P) \<tau> = false \<tau>" - apply(simp add: valid_def true_def false_def bot_fun_def bot_option_def - null_fun_def null_option_def) - by (case_tac "P \<tau> = \<bottom>", simp_all add: true_def) - - have OclIncluding_finite_rep_set : "\<And>\<tau>. (\<delta> X and \<upsilon> x) \<tau> = true \<tau> \<Longrightarrow> - finite \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (X->including\<^sub>S\<^sub>e\<^sub>t(x) \<tau>)\<rceil>\<rceil> = finite \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (X \<tau>)\<rceil>\<rceil>" - apply(rule OclIncluding_finite_rep_set) - by(metis OclValid_def foundation5)+ - - have card_including_exec : "\<And>\<tau>. (\<delta> (\<lambda>_. \<lfloor>\<lfloor>int (card \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (X->including\<^sub>S\<^sub>e\<^sub>t(x) \<tau>)\<rceil>\<rceil>)\<rfloor>\<rfloor>)) \<tau> = - (\<delta> (\<lambda>_. \<lfloor>\<lfloor>int (card \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (X \<tau>)\<rceil>\<rceil>)\<rfloor>\<rfloor>)) \<tau>" - by(simp add: defined_def bot_fun_def bot_option_def null_fun_def null_option_def) - - show ?thesis - apply(rule ext, rename_tac \<tau>) - apply(case_tac "(\<delta> (X->including\<^sub>S\<^sub>e\<^sub>t(x)->size\<^sub>S\<^sub>e\<^sub>t())) \<tau> = true \<tau>", simp del: OclSize_including_exec) - apply(subst cp_OclAnd, subst cp_defined, simp only: cp_defined[of "X->including\<^sub>S\<^sub>e\<^sub>t(x)->size\<^sub>S\<^sub>e\<^sub>t()"], - simp add: OclSize_def) - apply(case_tac "((\<delta> X and \<upsilon> x) \<tau> = true \<tau> \<and> finite \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (X->including\<^sub>S\<^sub>e\<^sub>t(x) \<tau>)\<rceil>\<rceil>)", simp) - apply(erule conjE, - simp add: OclIncluding_finite_rep_set[simplified OclValid_def] card_including_exec - cp_OclAnd[of "\<delta> X" "\<upsilon> x"] - cp_OclAnd[of "true", THEN sym]) - apply(subgoal_tac "(\<delta> X) \<tau> = true \<tau> \<and> (\<upsilon> x) \<tau> = true \<tau>", simp) - apply(rule foundation5[of _ "\<delta> X" "\<upsilon> x", simplified OclValid_def], - simp only: cp_OclAnd[THEN sym]) - apply(simp, simp add: defined_def true_def false_def bot_fun_def bot_option_def) - - apply(drule defined_inject_true[of "X->including\<^sub>S\<^sub>e\<^sub>t(x)->size\<^sub>S\<^sub>e\<^sub>t()"], - simp del: OclSize_including_exec, - simp only: cp_OclAnd[of "\<delta> (X->size\<^sub>S\<^sub>e\<^sub>t())" "\<upsilon> x"], - simp add: cp_defined[of "X->including\<^sub>S\<^sub>e\<^sub>t(x)->size\<^sub>S\<^sub>e\<^sub>t()" ] cp_defined[of "X->size\<^sub>S\<^sub>e\<^sub>t()" ] - del: OclSize_including_exec, - simp add: OclSize_def card_including_exec - del: OclSize_including_exec) - apply(case_tac "(\<delta> X and \<upsilon> x) \<tau> = true \<tau> \<and> finite \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (X \<tau>)\<rceil>\<rceil>", - simp add: OclIncluding_finite_rep_set[simplified OclValid_def] card_including_exec, - simp only: cp_OclAnd[THEN sym], - simp add: defined_def bot_fun_def) - - apply(split if_split_asm) - apply(simp add: OclIncluding_finite_rep_set[simplified OclValid_def] card_including_exec)+ - apply(simp only: cp_OclAnd[THEN sym], simp, rule impI, erule conjE) - apply(case_tac "(\<upsilon> x) \<tau> = true \<tau>", simp add: cp_OclAnd[of "\<delta> X" "\<upsilon> x"]) - by(drule valid_inject_true[of "x"], simp add: cp_OclAnd[of _ "\<upsilon> x"]) -qed - -lemma [simp,code_unfold]: "\<delta> ((X ->excluding\<^sub>S\<^sub>e\<^sub>t(x)) ->size\<^sub>S\<^sub>e\<^sub>t()) = (\<delta>(X->size\<^sub>S\<^sub>e\<^sub>t()) and \<upsilon>(x))" -proof - - have defined_inject_true : "\<And>\<tau> P. (\<delta> P) \<tau> \<noteq> true \<tau> \<Longrightarrow> (\<delta> P) \<tau> = false \<tau>" - apply(simp add: defined_def true_def false_def bot_fun_def bot_option_def - null_fun_def null_option_def) - by (case_tac " P \<tau> = \<bottom> \<or> P \<tau> = null", simp_all add: true_def) - - have valid_inject_true : "\<And>\<tau> P. (\<upsilon> P) \<tau> \<noteq> true \<tau> \<Longrightarrow> (\<upsilon> P) \<tau> = false \<tau>" - apply(simp add: valid_def true_def false_def bot_fun_def bot_option_def - null_fun_def null_option_def) - by (case_tac "P \<tau> = \<bottom>", simp_all add: true_def) - - have OclExcluding_finite_rep_set : "\<And>\<tau>. (\<delta> X and \<upsilon> x) \<tau> = true \<tau> \<Longrightarrow> - finite \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (X->excluding\<^sub>S\<^sub>e\<^sub>t(x) \<tau>)\<rceil>\<rceil> = - finite \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (X \<tau>)\<rceil>\<rceil>" - apply(rule OclExcluding_finite_rep_set) - by(metis OclValid_def foundation5)+ - - have card_excluding_exec : "\<And>\<tau>. (\<delta> (\<lambda>_. \<lfloor>\<lfloor>int (card \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (X->excluding\<^sub>S\<^sub>e\<^sub>t(x) \<tau>)\<rceil>\<rceil>)\<rfloor>\<rfloor>)) \<tau> = - (\<delta> (\<lambda>_. \<lfloor>\<lfloor>int (card \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (X \<tau>)\<rceil>\<rceil>)\<rfloor>\<rfloor>)) \<tau>" - by(simp add: defined_def bot_fun_def bot_option_def null_fun_def null_option_def) - - show ?thesis - apply(rule ext, rename_tac \<tau>) - apply(case_tac "(\<delta> (X->excluding\<^sub>S\<^sub>e\<^sub>t(x)->size\<^sub>S\<^sub>e\<^sub>t())) \<tau> = true \<tau>", simp) - apply(subst cp_OclAnd, subst cp_defined, simp only: cp_defined[of "X->excluding\<^sub>S\<^sub>e\<^sub>t(x)->size\<^sub>S\<^sub>e\<^sub>t()"], - simp add: OclSize_def) - apply(case_tac "((\<delta> X and \<upsilon> x) \<tau> = true \<tau> \<and> finite \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (X->excluding\<^sub>S\<^sub>e\<^sub>t(x) \<tau>)\<rceil>\<rceil>)", simp) - apply(erule conjE, - simp add: OclExcluding_finite_rep_set[simplified OclValid_def] card_excluding_exec - cp_OclAnd[of "\<delta> X" "\<upsilon> x"] - cp_OclAnd[of "true", THEN sym]) - apply(subgoal_tac "(\<delta> X) \<tau> = true \<tau> \<and> (\<upsilon> x) \<tau> = true \<tau>", simp) - apply(rule foundation5[of _ "\<delta> X" "\<upsilon> x", simplified OclValid_def], - simp only: cp_OclAnd[THEN sym]) - apply(simp, simp add: defined_def true_def false_def bot_fun_def bot_option_def) - - apply(drule defined_inject_true[of "X->excluding\<^sub>S\<^sub>e\<^sub>t(x)->size\<^sub>S\<^sub>e\<^sub>t()"], - simp, - simp only: cp_OclAnd[of "\<delta> (X->size\<^sub>S\<^sub>e\<^sub>t())" "\<upsilon> x"], - simp add: cp_defined[of "X->excluding\<^sub>S\<^sub>e\<^sub>t(x)->size\<^sub>S\<^sub>e\<^sub>t()" ] cp_defined[of "X->size\<^sub>S\<^sub>e\<^sub>t()" ], - simp add: OclSize_def card_excluding_exec) - apply(case_tac "(\<delta> X and \<upsilon> x) \<tau> = true \<tau> \<and> finite \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (X \<tau>)\<rceil>\<rceil>", - simp add: OclExcluding_finite_rep_set[simplified OclValid_def] card_excluding_exec, - simp only: cp_OclAnd[THEN sym], - simp add: defined_def bot_fun_def) - - apply(split if_split_asm) - apply(simp add: OclExcluding_finite_rep_set[simplified OclValid_def] card_excluding_exec)+ - apply(simp only: cp_OclAnd[THEN sym], simp, rule impI, erule conjE) - apply(case_tac "(\<upsilon> x) \<tau> = true \<tau>", simp add: cp_OclAnd[of "\<delta> X" "\<upsilon> x"]) - by(drule valid_inject_true[of "x"], simp add: cp_OclAnd[of _ "\<upsilon> x"]) -qed - -lemma [simp]: - assumes X_finite: "\<And>\<tau>. finite \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (X \<tau>)\<rceil>\<rceil>" - shows "\<delta> ((X ->including\<^sub>S\<^sub>e\<^sub>t(x)) ->size\<^sub>S\<^sub>e\<^sub>t()) = (\<delta>(X) and \<upsilon>(x))" -by(simp add: size_defined[OF X_finite] del: OclSize_including_exec) - - -text{* OclForall *} - -lemma OclForall_rep_set_false: - assumes "\<tau> \<Turnstile> \<delta> X" - shows "(OclForall X P \<tau> = false \<tau>) = (\<exists>x \<in> \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (X \<tau>)\<rceil>\<rceil>. P (\<lambda>\<tau>. x) \<tau> = false \<tau>)" -by(insert assms, simp add: OclForall_def OclValid_def false_def true_def invalid_def - bot_fun_def bot_option_def null_fun_def null_option_def) - -lemma OclForall_rep_set_true: - assumes "\<tau> \<Turnstile> \<delta> X" - shows "(\<tau> \<Turnstile> OclForall X P) = (\<forall>x \<in> \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (X \<tau>)\<rceil>\<rceil>. \<tau> \<Turnstile> P (\<lambda>\<tau>. x))" - apply(simp add: OclForall_def OclValid_def true_def false_def invalid_def - bot_fun_def bot_option_def null_fun_def null_option_def split: if_split_asm) - apply(rule conjI, rule impI) - apply force - apply(intro conjI impI ballI) - apply force - apply force - apply force - apply force -by (metis OclValid_def assms true_def) - -lemma OclForall_includes : - assumes x_def : "\<tau> \<Turnstile> \<delta> x" - and y_def : "\<tau> \<Turnstile> \<delta> y" - shows "(\<tau> \<Turnstile> OclForall x (OclIncludes y)) = (\<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (x \<tau>)\<rceil>\<rceil> \<subseteq> \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (y \<tau>)\<rceil>\<rceil>)" - apply(simp add: OclForall_rep_set_true[OF x_def], - simp add: OclIncludes_def OclValid_def y_def[simplified OclValid_def]) - apply(insert Set_inv_lemma[OF x_def], simp add: valid_def false_def true_def bot_fun_def) -by(rule iffI, simp add: subsetI, simp add: subsetD) - -lemma OclForall_not_includes : - assumes x_def : "\<tau> \<Turnstile> \<delta> x" - and y_def : "\<tau> \<Turnstile> \<delta> y" - shows "(OclForall x (OclIncludes y) \<tau> = false \<tau>) = (\<not> \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (x \<tau>)\<rceil>\<rceil> \<subseteq> \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (y \<tau>)\<rceil>\<rceil>)" - apply(simp add: OclForall_rep_set_false[OF x_def], - simp add: OclIncludes_def OclValid_def y_def[simplified OclValid_def]) - apply(insert Set_inv_lemma[OF x_def], simp add: valid_def false_def true_def bot_fun_def) -by(rule iffI, metis set_rev_mp, metis subsetI) - -lemma OclForall_iterate: - assumes S_finite: "finite \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil>" - shows "S->forAll\<^sub>S\<^sub>e\<^sub>t(x | P x) \<tau> = (S->iterate\<^sub>S\<^sub>e\<^sub>t(x; acc = true | acc and P x)) \<tau>" -proof - - have and_comm : "comp_fun_commute (\<lambda>x acc. acc and P x)" - apply(simp add: comp_fun_commute_def comp_def) - by (metis OclAnd_assoc OclAnd_commute) - - have ex_insert : "\<And>x F P. (\<exists>x\<in>insert x F. P x) = (P x \<or> (\<exists>x\<in>F. P x))" - by (metis insert_iff) - - have destruct_ocl : "\<And>x \<tau>. x = true \<tau> \<or> x = false \<tau> \<or> x = null \<tau> \<or> x = \<bottom> \<tau>" - apply(case_tac x) apply (metis bot_Boolean_def) - apply(rename_tac x', case_tac x') apply (metis null_Boolean_def) - apply(rename_tac x'', case_tac x'') apply (metis (full_types) true_def) - by (metis (full_types) false_def) - - have disjE4 : "\<And> P1 P2 P3 P4 R. - (P1 \<or> P2 \<or> P3 \<or> P4) \<Longrightarrow> (P1 \<Longrightarrow> R) \<Longrightarrow> (P2 \<Longrightarrow> R) \<Longrightarrow> (P3 \<Longrightarrow> R) \<Longrightarrow> (P4 \<Longrightarrow> R) \<Longrightarrow> R" - by metis - - let ?P_eq = "\<lambda>x b \<tau>. P (\<lambda>_. x) \<tau> = b \<tau>" - let ?P = "\<lambda>set b \<tau>. \<exists>x\<in>set. ?P_eq x b \<tau>" - let ?if = "\<lambda>f b c. if f b \<tau> then b \<tau> else c" - let ?forall = "\<lambda>P. ?if P false (?if P invalid (?if P null (true \<tau>)))" - show ?thesis - apply(simp only: OclForall_def OclIterate_def) - apply(case_tac "\<tau> \<Turnstile> \<delta> S", simp only: OclValid_def) - apply(subgoal_tac "let set = \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil> in - ?forall (?P set) = - Finite_Set.fold (\<lambda>x acc. acc and P x) true ((\<lambda>a \<tau>. a) ` set) \<tau>", - simp only: Let_def, simp add: S_finite, simp only: Let_def) - apply(case_tac "\<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S \<tau>)\<rceil>\<rceil> = {}", simp) - apply(rule finite_ne_induct[OF S_finite], simp) - (* *) - apply(simp only: image_insert) - apply(subst comp_fun_commute.fold_insert[OF and_comm], simp) - apply (metis empty_iff image_empty) - apply(simp add: invalid_def) - apply (metis bot_fun_def destruct_ocl null_fun_def) - (* *) - apply(simp only: image_insert) - apply(subst comp_fun_commute.fold_insert[OF and_comm], simp) - apply (metis (mono_tags) imageE) - - (* *) - apply(subst cp_OclAnd) apply(drule sym, drule sym, simp only:, drule sym, simp only:) - apply(simp only: ex_insert) - apply(subgoal_tac "\<exists>x. x\<in>F") prefer 2 - apply(metis all_not_in_conv) - proof - fix x F show "(\<delta> S) \<tau> = true \<tau> \<Longrightarrow> \<exists>x. x \<in> F \<Longrightarrow> - ?forall (\<lambda>b \<tau>. ?P_eq x b \<tau> \<or> ?P F b \<tau>) = - ((\<lambda>_. ?forall (?P F)) and (\<lambda>_. P (\<lambda>\<tau>. x) \<tau>)) \<tau>" - apply(rule disjE4[OF destruct_ocl[where x1 = "P (\<lambda>\<tau>. x) \<tau>"]]) - apply(simp_all add: true_def false_def invalid_def OclAnd_def - null_fun_def null_option_def bot_fun_def bot_option_def) - by (metis (lifting) option.distinct(1))+ - qed(simp add: OclValid_def)+ -qed - -lemma OclForall_cong: - assumes "\<And>x. x \<in> \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (X \<tau>)\<rceil>\<rceil> \<Longrightarrow> \<tau> \<Turnstile> P (\<lambda>\<tau>. x) \<Longrightarrow> \<tau> \<Turnstile> Q (\<lambda>\<tau>. x)" - assumes P: "\<tau> \<Turnstile> OclForall X P" - shows "\<tau> \<Turnstile> OclForall X Q" -proof - - have def_X: "\<tau> \<Turnstile> \<delta> X" - by(insert P, simp add: OclForall_def OclValid_def bot_option_def true_def split: if_split_asm) - show ?thesis - apply(insert P) - apply(subst (asm) OclForall_rep_set_true[OF def_X], subst OclForall_rep_set_true[OF def_X]) - by (simp add: assms) -qed - -lemma OclForall_cong': - assumes "\<And>x. x \<in> \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (X \<tau>)\<rceil>\<rceil> \<Longrightarrow> \<tau> \<Turnstile> P (\<lambda>\<tau>. x) \<Longrightarrow> \<tau> \<Turnstile> Q (\<lambda>\<tau>. x) \<Longrightarrow> \<tau> \<Turnstile> R (\<lambda>\<tau>. x)" - assumes P: "\<tau> \<Turnstile> OclForall X P" - assumes Q: "\<tau> \<Turnstile> OclForall X Q" - shows "\<tau> \<Turnstile> OclForall X R" -proof - - have def_X: "\<tau> \<Turnstile> \<delta> X" - by(insert P, simp add: OclForall_def OclValid_def bot_option_def true_def split: if_split_asm) - show ?thesis - apply(insert P Q) - apply(subst (asm) (1 2) OclForall_rep_set_true[OF def_X], subst OclForall_rep_set_true[OF def_X]) - by (simp add: assms) -qed - -text{* Strict Equality *} - -lemma StrictRefEq\<^sub>S\<^sub>e\<^sub>t_defined : - assumes x_def: "\<tau> \<Turnstile> \<delta> x" - assumes y_def: "\<tau> \<Turnstile> \<delta> y" - shows "((x::('\<AA>,'\<alpha>::null)Set) \<doteq> y) \<tau> = - (x->forAll\<^sub>S\<^sub>e\<^sub>t(z| y->includes\<^sub>S\<^sub>e\<^sub>t(z)) and (y->forAll\<^sub>S\<^sub>e\<^sub>t(z| x->includes\<^sub>S\<^sub>e\<^sub>t(z)))) \<tau>" -proof - - have rep_set_inj : "\<And>\<tau>. (\<delta> x) \<tau> = true \<tau> \<Longrightarrow> - (\<delta> y) \<tau> = true \<tau> \<Longrightarrow> - x \<tau> \<noteq> y \<tau> \<Longrightarrow> - \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (y \<tau>)\<rceil>\<rceil> \<noteq> \<lceil>\<lceil>Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e (x \<tau>)\<rceil>\<rceil>" - apply(simp add: defined_def) - apply(split if_split_asm, simp add: false_def true_def)+ - apply(simp add: null_fun_def null_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def bot_fun_def bot_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def) - - apply(case_tac "x \<tau>", rename_tac x') - apply(case_tac x', simp_all, rename_tac x'') - apply(case_tac x'', simp_all) - - apply(case_tac "y \<tau>", rename_tac y') - apply(case_tac y', simp_all, rename_tac y'') - apply(case_tac y'', simp_all) - - apply(simp add: Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inverse) - by(blast) - - show ?thesis - apply(simp add: StrictRefEq\<^sub>S\<^sub>e\<^sub>t StrongEq_def - foundation20[OF x_def, simplified OclValid_def] - foundation20[OF y_def, simplified OclValid_def]) - apply(subgoal_tac "\<lfloor>\<lfloor>x \<tau> = y \<tau>\<rfloor>\<rfloor> = true \<tau> \<or> \<lfloor>\<lfloor>x \<tau> = y \<tau>\<rfloor>\<rfloor> = false \<tau>") - prefer 2 - apply(simp add: false_def true_def) - (* *) - apply(erule disjE) - apply(simp add: true_def) - - apply(subgoal_tac "(\<tau> \<Turnstile> OclForall x (OclIncludes y)) \<and> (\<tau> \<Turnstile> OclForall y (OclIncludes x))") - apply(subst cp_OclAnd, simp add: true_def OclValid_def) - apply(simp add: OclForall_includes[OF x_def y_def] - OclForall_includes[OF y_def x_def]) - - (* *) - apply(simp) - - apply(subgoal_tac "OclForall x (OclIncludes y) \<tau> = false \<tau> \<or> - OclForall y (OclIncludes x) \<tau> = false \<tau>") - apply(subst cp_OclAnd, metis OclAnd_false1 OclAnd_false2 cp_OclAnd) - apply(simp only: OclForall_not_includes[OF x_def y_def, simplified OclValid_def] - OclForall_not_includes[OF y_def x_def, simplified OclValid_def], - simp add: false_def) - by (metis OclValid_def rep_set_inj subset_antisym x_def y_def) -qed - -lemma StrictRefEq\<^sub>S\<^sub>e\<^sub>t_exec[simp,code_unfold] : -"((x::('\<AA>,'\<alpha>::null)Set) \<doteq> y) = - (if \<delta> x then (if \<delta> y - then ((x->forAll\<^sub>S\<^sub>e\<^sub>t(z| y->includes\<^sub>S\<^sub>e\<^sub>t(z)) and (y->forAll\<^sub>S\<^sub>e\<^sub>t(z| x->includes\<^sub>S\<^sub>e\<^sub>t(z))))) - else if \<upsilon> y - then false \<comment> \<open>\<open>x'->includes = null\<close>\<close> - else invalid - endif - endif) - else if \<upsilon> x \<comment> \<open>\<open>null = ???\<close>\<close> - then if \<upsilon> y then not(\<delta> y) else invalid endif - else invalid - endif - endif)" -proof - - have defined_inject_true : "\<And>\<tau> P. (\<not> (\<tau> \<Turnstile> \<delta> P)) = ((\<delta> P) \<tau> = false \<tau>)" - by (metis bot_fun_def OclValid_def defined_def foundation16 null_fun_def) - - have valid_inject_true : "\<And>\<tau> P. (\<not> (\<tau> \<Turnstile> \<upsilon> P)) = ((\<upsilon> P) \<tau> = false \<tau>)" - by (metis bot_fun_def OclIf_true' OclIncludes_charn0 OclIncludes_charn0' OclValid_def valid_def - foundation6 foundation9) - show ?thesis - apply(rule ext, rename_tac \<tau>) - (* *) - apply(simp add: OclIf_def - defined_inject_true[simplified OclValid_def] - valid_inject_true[simplified OclValid_def], - subst false_def, subst true_def, simp) - apply(subst (1 2) cp_OclNot, simp, simp add: cp_OclNot[symmetric]) - apply(simp add: StrictRefEq\<^sub>S\<^sub>e\<^sub>t_defined[simplified OclValid_def]) - by(simp add: StrictRefEq\<^sub>S\<^sub>e\<^sub>t StrongEq_def false_def true_def valid_def defined_def) -qed - -lemma StrictRefEq\<^sub>S\<^sub>e\<^sub>t_L_subst1 : "cp P \<Longrightarrow> \<tau> \<Turnstile> \<upsilon> x \<Longrightarrow> \<tau> \<Turnstile> \<upsilon> y \<Longrightarrow> \<tau> \<Turnstile> \<upsilon> P x \<Longrightarrow> \<tau> \<Turnstile> \<upsilon> P y \<Longrightarrow> - \<tau> \<Turnstile> (x::('\<AA>,'\<alpha>::null)Set) \<doteq> y \<Longrightarrow> \<tau> \<Turnstile> (P x ::('\<AA>,'\<alpha>::null)Set) \<doteq> P y" - apply(simp only: StrictRefEq\<^sub>S\<^sub>e\<^sub>t OclValid_def) - apply(split if_split_asm) - apply(simp add: StrongEq_L_subst1[simplified OclValid_def]) -by (simp add: invalid_def bot_option_def true_def) - -lemma OclIncluding_cong' : -shows "\<tau> \<Turnstile> \<delta> s \<Longrightarrow> \<tau> \<Turnstile> \<delta> t \<Longrightarrow> \<tau> \<Turnstile> \<upsilon> x \<Longrightarrow> - \<tau> \<Turnstile> ((s::('\<AA>,'a::null)Set) \<doteq> t) \<Longrightarrow> \<tau> \<Turnstile> (s->including\<^sub>S\<^sub>e\<^sub>t(x) \<doteq> (t->including\<^sub>S\<^sub>e\<^sub>t(x)))" -proof - - have cp: "cp (\<lambda>s. (s->including\<^sub>S\<^sub>e\<^sub>t(x)))" - apply(simp add: cp_def, subst OclIncluding.cp0) - by (rule_tac x = "(\<lambda>xab ab. ((\<lambda>_. xab)->including\<^sub>S\<^sub>e\<^sub>t(\<lambda>_. x ab)) ab)" in exI, simp) - - show "\<tau> \<Turnstile> \<delta> s \<Longrightarrow> \<tau> \<Turnstile> \<delta> t \<Longrightarrow> \<tau> \<Turnstile> \<upsilon> x \<Longrightarrow> \<tau> \<Turnstile> (s \<doteq> t) \<Longrightarrow> ?thesis" - apply(rule_tac P = "\<lambda>s. (s->including\<^sub>S\<^sub>e\<^sub>t(x))" in StrictRefEq\<^sub>S\<^sub>e\<^sub>t_L_subst1) - apply(rule cp) - apply(simp add: foundation20) apply(simp add: foundation20) - apply (simp add: foundation10 foundation6)+ - done -qed - -lemma OclIncluding_cong : "\<And>(s::('\<AA>,'a::null)Set) t x y \<tau>. \<tau> \<Turnstile> \<delta> t \<Longrightarrow> \<tau> \<Turnstile> \<upsilon> y \<Longrightarrow> - \<tau> \<Turnstile> s \<doteq> t \<Longrightarrow> x = y \<Longrightarrow> \<tau> \<Turnstile> s->including\<^sub>S\<^sub>e\<^sub>t(x) \<doteq> (t->including\<^sub>S\<^sub>e\<^sub>t(y))" - apply(simp only:) - apply(rule OclIncluding_cong', simp_all only:) -by(auto simp: OclValid_def OclIf_def invalid_def bot_option_def OclNot_def split : if_split_asm) - -(* < *) -lemma const_StrictRefEq\<^sub>S\<^sub>e\<^sub>t_empty : "const X \<Longrightarrow> const (X \<doteq> Set{})" - apply(rule StrictRefEq\<^sub>S\<^sub>e\<^sub>t.const, assumption) -by(simp) - -lemma const_StrictRefEq\<^sub>S\<^sub>e\<^sub>t_including : - "const a \<Longrightarrow> const S \<Longrightarrow> const X \<Longrightarrow> const (X \<doteq> S->including\<^sub>S\<^sub>e\<^sub>t(a))" - apply(rule StrictRefEq\<^sub>S\<^sub>e\<^sub>t.const, assumption) -by(rule const_OclIncluding) - -subsection{* Test Statements *} - -Assert "(\<tau> \<Turnstile> (Set{\<lambda>_. \<lfloor>\<lfloor>x\<rfloor>\<rfloor>} \<doteq> Set{\<lambda>_. \<lfloor>\<lfloor>x\<rfloor>\<rfloor>}))" -Assert "(\<tau> \<Turnstile> (Set{\<lambda>_. \<lfloor>x\<rfloor>} \<doteq> Set{\<lambda>_. \<lfloor>x\<rfloor>}))" - -(* (*TODO.*) -open problem: An executable code-generator setup for the Set type. Some bits and pieces -so far : -instantiation int :: equal -begin - -definition - "HOL.equal k l \<longleftrightarrow> k = (l::int)" - -instance by default (rule equal_int_def) - -end - -lemma equal_int_code [code]: - "HOL.equal 0 (0::int) \<longleftrightarrow> True" - "HOL.equal 0 (Pos l) \<longleftrightarrow> False" - "HOL.equal 0 (Neg l) \<longleftrightarrow> False" - "HOL.equal (Pos k) 0 \<longleftrightarrow> False" - "HOL.equal (Pos k) (Pos l) \<longleftrightarrow> HOL.equal k l" - "HOL.equal (Pos k) (Neg l) \<longleftrightarrow> False" - "HOL.equal (Neg k) 0 \<longleftrightarrow> False" - "HOL.equal (Neg k) (Pos l) \<longleftrightarrow> False" - "HOL.equal (Neg k) (Neg l) \<longleftrightarrow> HOL.equal k l" - by (auto simp add: equal) -*) - - -instantiation Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e :: (equal)equal -begin - definition "HOL.equal k l \<longleftrightarrow> (k::('a::equal)Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e) = l" - instance by standard (rule equal_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def) -end - -lemma equal_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_code [code]: - "HOL.equal k (l::('a::{equal,null})Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e) \<longleftrightarrow> Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e k = Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e l" - by (auto simp add: equal Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e.Rep_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inject) - -Assert "\<tau> \<Turnstile> (Set{} \<doteq> Set{})" -Assert "\<tau> \<Turnstile> (Set{\<one>,\<two>} \<triangleq> Set{}->including\<^sub>S\<^sub>e\<^sub>t(\<two>)->including\<^sub>S\<^sub>e\<^sub>t(\<one>))" -Assert "\<tau> \<Turnstile> (Set{\<one>,invalid,\<two>} \<triangleq> invalid)" -Assert "\<tau> \<Turnstile> (Set{\<one>,\<two>}->including\<^sub>S\<^sub>e\<^sub>t(null) \<triangleq> Set{null,\<one>,\<two>})" -Assert "\<tau> \<Turnstile> (Set{\<one>,\<two>}->including\<^sub>S\<^sub>e\<^sub>t(null) \<triangleq> Set{\<one>,\<two>,null})" - -Assert "\<tau> \<Turnstile> (Set{Set{\<two>},null} \<triangleq> Set{null,Set{\<two>},null})" - -(* TODO Frederic ?: -Assert "\<not> (\<tau> \<Turnstile> (Set{\<one>,\<one>,\<two>} \<doteq> Set{\<one>,\<two>}))" -Assert "\<not> (\<tau> \<Turnstile> (Set{\<one>,\<two>} \<doteq> Set{\<two>,\<one>}))" -*) - -(* > *) - -end diff --git a/Citadelle/src/compiler/Aux_proof.thy b/Citadelle/src/compiler/Aux_proof.thy deleted file mode 100644 index 8c0b4859ca108b484cee787609e4e796408e04f7..0000000000000000000000000000000000000000 --- a/Citadelle/src/compiler/Aux_proof.thy +++ /dev/null @@ -1,210 +0,0 @@ -(****************************************************************************** - * 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\<open>Part ...\<close> - -theory Aux_proof -imports Main -begin - -section\<open>On the Semantics of Object-oriented Data Structures and Path Expressions\<close> - -subsection\<open>Basic modelization of attributes\<close> - -datatype oid = Oid -datatype attr_own = Attr_own -datatype attr_inh = Attr_inh -datatype '\<alpha> recurse = R nat '\<alpha> - -subsection\<open>Datatype definition of the class type and class type extension (version 1)\<close> - -datatype t1_ext = T1_ext attr_own "(t1_ext recurse) option" -datatype t1 = T1 oid attr_own attr_inh "(t1_ext recurse) option" - -subsection\<open>Datatype definition of the class type and class type extension (version 2)\<close> - -datatype t2_ext = T2_ext_oid oid attr_inh - | T2_ext_rec "t2 recurse" - and t2 = T2 t2_ext attr_own - -fun get2_oid where - "get2_oid v = (\<lambda> T2 (T2_ext_oid oid _) _ \<Rightarrow> oid - | T2 (T2_ext_rec (R _ t)) _ \<Rightarrow> get2_oid t) v" - -fun get2_inh where - "get2_inh v = (\<lambda> T2 (T2_ext_oid _ inh) _ \<Rightarrow> inh - | T2 (T2_ext_rec (R _ t)) _ \<Rightarrow> get2_inh t) v" - -subsection\<open>Datatype definition of the class type and class type extension (version 3)\<close> - -datatype t3_ext = T3_ext_oid oid attr_inh attr_own - | T3_ext_rec "t3 recurse" - and t3 = T3 t3_ext - -fun get3_oid where - "get3_oid v = (\<lambda> T3 (T3_ext_oid oid _ _) \<Rightarrow> oid - | T3 (T3_ext_rec (R _ t)) \<Rightarrow> get3_oid t) v" - -fun get3_inh where - "get3_inh v = (\<lambda> T3 (T3_ext_oid _ inh _) \<Rightarrow> inh - | T3 (T3_ext_rec (R _ t)) \<Rightarrow> get3_inh t) v" - -fun get3_own where - "get3_own v = (\<lambda> T3 (T3_ext_oid _ _ own) \<Rightarrow> own - | T3 (T3_ext_rec (R _ t)) \<Rightarrow> get3_own t) v" - -subsection\<open>Conversion t2 of t1\<close> - -fun m2_of_m1_ext where - "m2_of_m1_ext oid attr_inh m1 = (\<lambda> T1_ext attr_own opt \<Rightarrow> T2 (case opt - of None \<Rightarrow> T2_ext_oid oid attr_inh - | Some (R ide m1) \<Rightarrow> T2_ext_rec (R ide (m2_of_m1_ext oid attr_inh m1))) attr_own) m1" - -definition "m2_of_m1 = (\<lambda> T1 oid attr_own attr_inh opt \<Rightarrow> T2 (case opt - of None \<Rightarrow> T2_ext_oid oid attr_inh - | Some (R ide m1) \<Rightarrow> T2_ext_rec (R ide (m2_of_m1_ext oid attr_inh m1))) attr_own)" - -subsection\<open>Conversion t1 of t2\<close> - -fun m1_ext_of_m2 where - "m1_ext_of_m2 m2 = - (\<lambda> T2 (T2_ext_oid _ _) attr_own \<Rightarrow> T1_ext attr_own None - | T2 (T2_ext_rec (R ide m2)) attr_own \<Rightarrow> T1_ext attr_own (Some (R ide (m1_ext_of_m2 m2)))) m2" - -definition "m1_of_m2 = - (\<lambda> T2 (T2_ext_oid oid attr_inh) attr_own \<Rightarrow> T1 oid attr_own attr_inh None - | T2 (T2_ext_rec (R ide m2)) attr_own \<Rightarrow> T1 (get2_oid m2) attr_own (get2_inh m2) (Some (R ide (m1_ext_of_m2 m2))))" - -subsection\<open>Bijectivity proofs\<close> - -lemma "m1_of_m2 (m2_of_m1 X) = X" - apply(case_tac X, simp) - subgoal for oid attr_own attr_inh option - apply(case_tac option, simp add: m1_of_m2_def m2_of_m1_def, simp) - subgoal for a - apply(case_tac a) - apply(rule t1_ext.induct[where P = "\<lambda>x2. \<forall>a x1. a = R x1 x2 \<longrightarrow> - m1_of_m2 (m2_of_m1 (T1 oid attr_own attr_inh (Some a))) = T1 oid attr_own attr_inh (Some a)", - THEN spec, THEN spec, THEN mp]) - apply(intro allI impI) - subgoal for _ _ _ x2a - apply(case_tac x2a, simp add: m1_of_m2_def m2_of_m1_def, simp) - subgoal for aa - by(case_tac aa, simp add: m1_of_m2_def m2_of_m1_def) - done - by simp - done -done - -lemma t2_ext_t2_induct : - assumes H1 [simp]: "(\<And>oid attr_inh. P1 (T2_ext_oid oid attr_inh))" - assumes H2 [simp]: "(\<And>recurse. P3 recurse \<Longrightarrow> P1 (T2_ext_rec recurse))" - assumes H3 [simp]: "(\<And>t2_ext attr_own. P1 t2_ext \<Longrightarrow> P2 (T2 t2_ext attr_own))" - assumes H4 [simp]: "(\<And>nat t2. P2 t2 \<Longrightarrow> P3 (R nat t2))" - shows "P1 t2_ext \<and> P2 t2_0 \<and> P3 recurse" -proof - - have X1: "\<And>t2_ext. P1 t2_ext" - apply(rule t2_ext.induct[of _ "\<lambda>xa. \<forall>n. P3 (R n xa)"], simp) - subgoal for _ x - by(case_tac x, simp) - by auto - - have X2: "\<And>t2_0. P2 t2_0" - apply(rule t2.induct[of "\<lambda>t2_ext. P1 t2_ext \<and> (case t2_ext of T2_ext_rec (R n xa) \<Rightarrow> P3 (R n xa) - | _ \<Rightarrow> True)"], - simp, simp) - subgoal for x - by(case_tac x, simp) - by simp - - show ?thesis - apply(intro conjI) - apply(rule X1) - apply(rule X2) - - apply(case_tac recurse, simp) - subgoal for _ x2 - apply(subgoal_tac "P2 x2", simp) - by(rule X2) - done -qed - -lemma "m2_of_m1 (m1_of_m2 X) = X" - apply(case_tac X, simp) - proof - - fix t2_ext attr_own - define P where "P \<equiv> \<lambda>X. m2_of_m1 (m1_of_m2 X) = X" - show "m2_of_m1 (m1_of_m2 (T2 t2_ext attr_own)) = T2 t2_ext attr_own" - apply(rule t2_ext_t2_induct[ of "\<lambda>t2_ext. \<forall>attr_own. P (T2 t2_ext attr_own)" - "\<lambda>recurse. \<forall>attr_own. P (T2 (T2_ext_rec recurse) attr_own)" - "\<lambda>option. \<forall>nat attr_own. P (T2 (T2_ext_rec (R nat option)) attr_own)" - , THEN conjunct1, THEN spec, simplified Let_def P_def]) - apply(auto) - apply(subst m1_of_m2_def, subst m2_of_m1_def, auto)+ - - subgoal for t2_ext x - apply(subgoal_tac "( - let oid = case t2_ext of T2_ext_oid oid _ \<Rightarrow> oid | T2_ext_rec (R _ xb) \<Rightarrow> get2_oid xb - ; inh = case t2_ext of T2_ext_oid _ inh \<Rightarrow> inh | T2_ext_rec (R _ xb) \<Rightarrow> get2_inh xb in - - T2 (case t2_ext of T2_ext_oid _ _ \<Rightarrow> T2_ext_oid oid inh | T2_ext_rec (R ide m2) \<Rightarrow> T2_ext_rec (R ide (m2_of_m1_ext oid inh (m1_ext_of_m2 m2))) ) x) = - T2 t2_ext x") - apply(simp add: Let_def) apply(case_tac t2_ext, simp, simp) subgoal for x2 by(case_tac x2, simp) - - apply(case_tac t2_ext, simp, simp) - apply(subst (asm) m2_of_m1_def, subst (asm) m1_of_m2_def, simp) - proof - - define P where "P \<equiv> \<lambda>recurse. (case recurse of R ide m2 \<Rightarrow> T2_ext_rec (R ide (m2_of_m1_ext (case recurse of R xa x \<Rightarrow> get2_oid x) (case recurse of R xa x \<Rightarrow> get2_inh x) (m1_ext_of_m2 m2)))) = - T2_ext_rec recurse" - fix recurse - show "P recurse" - apply(rule t2_ext_t2_induct[ of "\<lambda>t2_ext. \<forall>nat attr_own. P (R nat (T2 t2_ext attr_own))" - "\<lambda>recurse. P recurse" - "\<lambda>t2. \<forall>nat attr_own. P (R nat t2)" - , THEN conjunct2, THEN conjunct2], simp_all add: P_def) - subgoal for recurse - by(case_tac recurse, simp) - done - qed - done -qed - -end diff --git a/Citadelle/src/compiler/Aux_tactic.thy b/Citadelle/src/compiler/Aux_tactic.thy deleted file mode 100644 index 14a92f149bade9bdc1496983b9ebed6678a0dc01..0000000000000000000000000000000000000000 --- a/Citadelle/src/compiler/Aux_tactic.thy +++ /dev/null @@ -1,92 +0,0 @@ -(****************************************************************************** - * Citadelle - * - * 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\<open>Part ...\<close> - -theory Aux_tactic -imports Main - keywords "fun_sorry" "fun_quick" - :: thy_decl -begin - -subsection\<open>Infra-structure that skip lengthy termination proofs\<close> - -ML\<open> -structure Fun_quick = struct -val quick_dirty = false - (* false: "fun_quick" behaves as "fun" - true: "fun_quick" behaves as "fun", but it proves completeness and termination with "sorry" *) - -val proof_by_patauto = Proof.global_terminal_proof - ( let open Method in - ( Combinator - ( no_combinator_info - , Then - , [ Basic (fn ctxt => SIMPLE_METHOD (Pat_Completeness.pat_completeness_tac ctxt 1) ) - , Basic (fn ctxt => SIMPLE_METHOD (auto_tac (ctxt addsimps [])))]) - , (Position.none, Position.none)) end - , NONE) -val proof_by_sorry = Proof.global_skip_proof true - -fun mk_fun quick_dirty cmd_spec tac = - Outer_Syntax.local_theory' cmd_spec - "define general recursive functions (short version)" - (Function_Common.function_parser - (if quick_dirty then - Function_Common.FunctionConfig { sequential=true, default=NONE - , domintros=false, partials=true} - else - Function_Fun.fun_config) - >> (if quick_dirty then - fn (config, (fixes, statements)) => fn b => fn ctxt => - ctxt |> Function.function_cmd fixes statements config b - |> tac - |> Function.termination_cmd NONE - |> proof_by_sorry - else - fn (config, (fixes, statements)) => Function_Fun.add_fun_cmd fixes statements config)) - -val () = mk_fun quick_dirty @{command_keyword fun_quick} proof_by_sorry -val () = mk_fun true @{command_keyword fun_sorry} proof_by_patauto -end -\<close> - -end diff --git a/Citadelle/src/compiler/Aux_text.thy b/Citadelle/src/compiler/Aux_text.thy deleted file mode 100644 index 87e62b708900ede02e9be29116a37ae141d8fe52..0000000000000000000000000000000000000000 --- a/Citadelle/src/compiler/Aux_text.thy +++ /dev/null @@ -1,263 +0,0 @@ -(****************************************************************************** - * Citadelle - * - * 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\<open>Part ...\<close> - -theory Aux_text -imports Main - keywords "lazy_text" :: thy_decl - and "reset_text" :: thy_decl - and "apply_text" :: thy_decl -begin - -ML\<open> -datatype code_printing = Code_printing of string - -structure Data_code = Theory_Data - (type T = code_printing list Symtab.table - val empty = Symtab.empty - val extend = I - val merge = Symtab.merge (K true)) - -val code_empty = "" - -val _ = - Outer_Syntax.command - @{command_keyword lazy_text} "" - (Parse.opt_target -- Parse.document_source - >> (fn (_, code) => - let val _ = writeln (@{make_string} code) in - Toplevel.theory (Data_code.map (Symtab.map_default (code_empty, []) (fn l => Code_printing (Input.source_content code) :: l))) - end)) - -fun of_text s = - let val s = String.substring (s, 2, String.size s - 4) - val langle = "\<langle>" - val rangle = "\<rangle>" in - String.concat - [ "txt'' [ " ^ langle ^ "\<open>", str #"\n", " ", s, "\<close>" ^ rangle ^ " ]", str #"\n" ] - end - -fun apply_code_printing thy = - (case Symtab.lookup (Data_code.get thy) code_empty of SOME l => rev l | _ => []) - |> (fn l => - let val (thy, l) = - fold (fn Code_printing s => fn (thy, l) => (thy, of_text s :: l)) l (thy, []) - ; val _ = writeln (Active.sendback_markup_command ("definition \<open>t txt'' = [\n " ^ String.concatWith " , " (rev l) ^ "]\<close>")) in - thy - end) - -val () = - Outer_Syntax.command @{command_keyword apply_text} "" - (Parse.$$$ "(" -- Parse.$$$ ")" >> K (Toplevel.theory apply_code_printing)) - -val () = - Outer_Syntax.command @{command_keyword reset_text} "" - (Parse.$$$ "(" -- Parse.$$$ ")" >> K (Toplevel.theory (Data_code.map (Symtab.map_default (code_empty, []) (fn _ => []))))) -\<close> - -section\<open>Design\<close> - -lazy_text\<open>\label{ex:employee-design:uml}\<close> -lazy_text\<open> - For certain concepts like classes and class-types, only a generic - definition for its resulting semantics can be given. Generic means, - there is a function outside HOL that ``compiles'' a concrete, - closed-world class diagram into a ``theory'' of this data model, - consisting of a bunch of definitions for classes, accessors, method, - casts, and tests for actual types, as well as proofs for the - fundamental properties of these operations in this concrete data - model.\<close> -lazy_text\<open>Such generic function or ``compiler'' can be implemented in - Isabelle on the ML level. This has been done, for a semantics - following the open-world assumption, for UML 2.0 - in~\cite{brucker.ea:extensible:2008-b, brucker:interactive:2007}. In - this paper, we follow another approach for UML 2.4: we define the - concepts of the compilation informally, and present a concrete - example which is verified in Isabelle/HOL.\<close> -lazy_text\<open>We are presenting here a ``design-model'' of the (slightly -modified) example Figure 7.3, page 20 of -the OCL standard~\cite{omg:ocl:2012}. To be precise, this theory contains the formalization of -the data-part covered by the UML class model (see \autoref{fig:person}):\<close> -lazy_text\<open> -\begin{figure} - \centering\scalebox{.3}{\includegraphics{figures/person.png}}% - \caption{A simple UML class model drawn from Figure 7.3, - page 20 of~\cite{omg:ocl:2012}. \label{fig:person}} -\end{figure} -\<close> -lazy_text\<open>This means that the association (attached to the association class -\inlineocl{EmployeeRanking}) with the association ends \inlineocl+boss+ and \inlineocl+employees+ is implemented -by the attribute \inlineocl+boss+ and the operation \inlineocl+employees+ (to be discussed in the OCL part -captured by the subsequent theory). -\<close> -lazy_text\<open>Ideally, the following is generated automatically from a UML class model.\<close> -lazy_text\<open>Our data universe consists in the concrete class diagram just of node's, -and implicitly of the class object. Each class implies the existence of a class -type defined for the corresponding object representations as follows:\<close> -lazy_text\<open>Now, we construct a concrete ``universe of OclAny types'' by injection into a -sum type containing the class types. This type of OclAny will be used as instance -for all respective type-variables.\<close> -lazy_text\<open>Having fixed the object universe, we can introduce type synonyms that exactly correspond -to OCL types. Again, we exploit that our representation of OCL is a ``shallow embedding'' with a -one-to-one correspondance of OCL-types to types of the meta-language HOL.\<close> -lazy_text\<open>Just a little check:\<close> -lazy_text\<open>To reuse key-elements of the library like referential equality, we have -to show that the object universe belongs to the type class ``oclany,'' \ie, - each class type has to provide a function @{term oid_of} yielding the object id (oid) of the object.\<close> -lazy_text\<open>We instantiate the referential equality -on @{text "Person"} and @{text "OclAny"}\<close> -lazy_text\<open>For each Class \emph{C}, we will have a casting operation \inlineocl{.oclAsType($C$)}, - a test on the actual type \inlineocl{.oclIsTypeOf($C$)} as well as its relaxed form - \inlineocl{.oclIsKindOf($C$)} (corresponding exactly to Java's \verb+instanceof+-operator. -\<close> -lazy_text\<open>Thus, since we have two class-types in our concrete class hierarchy, we have -two operations to declare and to provide two overloading definitions for the two static types. -\<close> -lazy_text\<open>To denote OCL-types occurring in OCL expressions syntactically---as, for example, as -``argument'' of \inlineisar{oclAllInstances()}---we use the inverses of the injection -functions into the object universes; we show that this is sufficient ``characterization.''\<close> -lazy_text\<open>\label{sec:edm-accessors}\<close> -lazy_text\<open>Should be generated entirely from a class-diagram.\<close> -lazy_text\<open>pointer undefined in state or not referencing a type conform object representation\<close> -lazy_text\<open> -The example we are defining in this section comes from the figure~\ref{fig:edm1_system-states}. -\begin{figure} -\includegraphics[width=\textwidth]{figures/pre-post.pdf} -\caption{(a) pre-state $\sigma_1$ and - (b) post-state $\sigma_1'$.} -\label{fig:edm1_system-states} -\end{figure} -\<close> - -apply_text () reset_text () - -section\<open>Analysis\<close> - -lazy_text\<open>\label{ex:employee-analysis:uml}\<close> -lazy_text\<open> - For certain concepts like classes and class-types, only a generic - definition for its resulting semantics can be given. Generic means, - there is a function outside HOL that ``compiles'' a concrete, - closed-world class diagram into a ``theory'' of this data model, - consisting of a bunch of definitions for classes, accessors, method, - casts, and tests for actual types, as well as proofs for the - fundamental properties of these operations in this concrete data - model.\<close> -lazy_text\<open>Such generic function or ``compiler'' can be implemented in - Isabelle on the ML level. This has been done, for a semantics - following the open-world assumption, for UML 2.0 - in~\cite{brucker.ea:extensible:2008-b, brucker:interactive:2007}. In - this paper, we follow another approach for UML 2.4: we define the - concepts of the compilation informally, and present a concrete - example which is verified in Isabelle/HOL.\<close> -lazy_text\<open>We are presenting here an ``analysis-model'' of the (slightly -modified) example Figure 7.3, page 20 of -the OCL standard~\cite{omg:ocl:2012}. -Here, analysis model means that associations -were really represented as relation on objects on the state---as is -intended by the standard---rather by pointers between objects as is -done in our ``design model'' (see \autoref{ex:employee-design:uml}). -To be precise, this theory contains the formalization of the data-part -covered by the UML class model (see \autoref{fig:person-ana}):\<close> -lazy_text\<open> -\begin{figure} - \centering\scalebox{.3}{\includegraphics{figures/person.png}}% - \caption{A simple UML class model drawn from Figure 7.3, - page 20 of~\cite{omg:ocl:2012}. \label{fig:person-ana}} -\end{figure} -\<close> -lazy_text\<open>This means that the association (attached to the association class -\inlineocl{EmployeeRanking}) with the association ends \inlineocl+boss+ and \inlineocl+employees+ is implemented -by the attribute \inlineocl+boss+ and the operation \inlineocl+employees+ (to be discussed in the OCL part -captured by the subsequent theory). -\<close> -lazy_text\<open>Ideally, the following is generated automatically from a UML class model.\<close> -lazy_text\<open>Our data universe consists in the concrete class diagram just of node's, -and implicitly of the class object. Each class implies the existence of a class -type defined for the corresponding object representations as follows:\<close> -lazy_text\<open>Now, we construct a concrete ``universe of OclAny types'' by injection into a -sum type containing the class types. This type of OclAny will be used as instance -for all respective type-variables.\<close> -lazy_text\<open>Having fixed the object universe, we can introduce type synonyms that exactly correspond -to OCL types. Again, we exploit that our representation of OCL is a ``shallow embedding'' with a -one-to-one correspondance of OCL-types to types of the meta-language HOL.\<close> -lazy_text\<open>To reuse key-elements of the library like referential equality, we have -to show that the object universe belongs to the type class ``oclany,'' \ie, - each class type has to provide a function @{term oid_of} yielding the object id (oid) of the object.\<close> -lazy_text\<open>We instantiate the referential equality -on @{text "Person"} and @{text "OclAny"}\<close> -lazy_text\<open>For each Class \emph{C}, we will have a casting operation \inlineocl{.oclAsType($C$)}, - a test on the actual type \inlineocl{.oclIsTypeOf($C$)} as well as its relaxed form - \inlineocl{.oclIsKindOf($C$)} (corresponding exactly to Java's \verb+instanceof+-operator. -\<close> -lazy_text\<open>Thus, since we have two class-types in our concrete class hierarchy, we have -two operations to declare and to provide two overloading definitions for the two static types. -\<close> -lazy_text\<open>To denote OCL-types occurring in OCL expressions syntactically---as, for example, as -``argument'' of \inlineisar{oclAllInstances()}---we use the inverses of the injection -functions into the object universes; we show that this is sufficient ``characterization.''\<close> -lazy_text\<open>\label{sec:eam-accessors}\<close> -lazy_text\<open>Should be generated entirely from a class-diagram.\<close> -lazy_text\<open>We start with a oid for the association; this oid can be used -in presence of association classes to represent the association inside an object, -pretty much similar to the \inlineisar+Employee_DesignModel_UMLPart+, where we stored -an \verb+oid+ inside the class as ``pointer.''\<close> -lazy_text\<open>From there on, we can already define an empty state which must contain -for $\mathit{oid}_{Person}\mathcal{BOSS}$ the empty relation (encoded as association list, since there are -associations with a Sequence-like structure).\<close> -lazy_text\<open>The @{text pre_post}-parameter is configured with @{text fst} or -@{text snd}, the @{text to_from}-parameter either with the identity @{term id} or -the following combinator @{text switch}:\<close> -lazy_text\<open>pointer undefined in state or not referencing a type conform object representation\<close> -lazy_text\<open> -The example we are defining in this section comes from the figure~\ref{fig:eam1_system-states}. -\begin{figure} -\includegraphics[width=\textwidth]{figures/pre-post.pdf} -\caption{(a) pre-state $\sigma_1$ and - (b) post-state $\sigma_1'$.} -\label{fig:eam1_system-states} -\end{figure} -\<close> - -apply_text () reset_text () - -end diff --git a/Citadelle/src/compiler/Core.thy b/Citadelle/src/compiler/Core.thy deleted file mode 100644 index 56636085047abcd671c899e7455665d8e9e579fa..0000000000000000000000000000000000000000 --- a/Citadelle/src/compiler/Core.thy +++ /dev/null @@ -1,733 +0,0 @@ -(****************************************************************************** - * Citadelle - * - * 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. - ******************************************************************************) - -section\<open>General Environment for the Translation: Conclusion\<close> - -theory Core -imports "core/Floor1_enum" - "core/Floor1_infra" - "core/Floor1_astype" - "core/Floor1_istypeof" - "core/Floor1_iskindof" - "core/Floor1_allinst" - "core/Floor1_access" - "core/Floor1_examp" - "core/Floor2_examp" - "core/Floor1_ctxt" - "core/Floor2_ctxt" - "core/Floor1_haskabelle" -begin - -subsection\<open>Preliminaries\<close> - -datatype 'a embedding_fun = Embedding_fun_info string 'a - | Embedding_fun_simple 'a - -datatype ('a, 'b) embedding = Embed_theories "('a \<Rightarrow> 'b \<Rightarrow> all_meta list \<times> 'b) embedding_fun list" - | Embed_locale "('a \<Rightarrow> 'b \<Rightarrow> all_meta list \<times> 'b) embedding_fun list" - "'a \<Rightarrow> 'b \<Rightarrow> semi__locale \<times> 'b" - "('a \<Rightarrow> 'b \<Rightarrow> semi__theory list \<times> 'b) list" - "('a \<Rightarrow> 'b \<Rightarrow> all_meta list \<times> 'b) embedding_fun list" - -type_synonym 'a embedding' = "('a, compiler_env_config) embedding" \<comment> \<open>polymorphism weakening needed by \<^theory_text>\<open>code_reflect\<close>\<close> - -definition "L_fold f = - (let f_locale = \<lambda>loc_data l. - f (Embedding_fun_simple (\<lambda>a b. - let (loc_data, b) = loc_data a b - ; (l, b) = List.fold (\<lambda>f0. \<lambda>(l, b) \<Rightarrow> let (x, b) = f0 a b in (x # l, b)) l ([], b) in - ([META_semi__theories (Theories_locale loc_data (rev l))], b))) in - \<lambda> Embed_theories l \<Rightarrow> List.fold f l - | Embed_locale l_th1 loc_data l_loc l_th2 \<Rightarrow> List.fold f l_th2 o f_locale loc_data l_loc o List.fold f l_th1)" - -subsection\<open>Preliminaries: Setting Up Aliases Names\<close> - -ML\<open> -local -fun definition s = (#2 oo Specification.definition_cmd NONE [] [] (Binding.empty_atts, s)) true -fun def_info lhs rhs = definition (lhs ^ " = " ^ - @{const_name Embedding_fun_info} ^ - " (\<open>" ^ rhs ^ "\<close>) " ^ - rhs) -fun name_print x = String.implode (case String.explode (Long_Name.base_name x) of - #"p" :: #"r" :: #"i" :: #"n" :: #"t" :: #"_" :: l => l - | _ => error "'print' expected") -fun name x = "PRINT_" ^ name_print x -fun name1 x = "floor1_PRINT_" ^ name_print x -fun name2 x = "floor2_PRINT_" ^ name_print x -in -fun embedding_fun_info rhs = def_info (name rhs) rhs -fun embedding_fun_simple rhs = definition (name rhs ^ " = " ^ - @{const_name Embedding_fun_simple} ^ " (" ^ rhs ^ ")") -fun embedding_fun_info_f1 rhs = def_info (name1 rhs) rhs -fun embedding_fun_simple_f1 rhs = definition (name1 rhs ^ " = " ^ - @{const_name Embedding_fun_simple} ^ " (" ^ rhs ^ ")") -fun embedding_fun_info_f2 rhs = def_info (name2 rhs) rhs -fun embedding_fun_simple_f2 rhs = definition (name2 rhs ^ " = " ^ - @{const_name Embedding_fun_simple} ^ " (" ^ rhs ^ ")") -fun emb_info rhs = def_info (Long_Name.base_name rhs ^ "\<^sub>i\<^sub>n\<^sub>f\<^sub>o") rhs -fun emb_simple rhs = definition (Long_Name.base_name rhs ^ "\<^sub>s\<^sub>i\<^sub>m\<^sub>p\<^sub>l\<^sub>e" ^ " = " ^ - @{const_name Embedding_fun_simple} ^ " (" ^ rhs ^ ")") -end -\<close> - -(* TODO use antiquotations in cartouches *) -local_setup \<open>embedding_fun_info @{const_name print_infra_enum_synonym}\<close> -local_setup \<open>embedding_fun_info @{const_name print_latex_infra_datatype_class}\<close> -local_setup \<open>embedding_fun_info @{const_name print_infra_datatype_class_1}\<close> -local_setup \<open>embedding_fun_info @{const_name print_infra_datatype_class_2}\<close> -local_setup \<open>embedding_fun_info @{const_name print_infra_datatype_equiv_2of1}\<close> -local_setup \<open>embedding_fun_info @{const_name print_infra_datatype_equiv_1of2}\<close> -local_setup \<open>embedding_fun_info @{const_name print_infra_datatype_equiv_1_idempo}\<close> -local_setup \<open>embedding_fun_info @{const_name print_infra_datatype_universe}\<close> -local_setup \<open>embedding_fun_info @{const_name print_infra_type_synonym_class}\<close> -local_setup \<open>embedding_fun_info @{const_name print_infra_type_synonym_class_higher}\<close> -local_setup \<open>embedding_fun_info @{const_name print_infra_type_synonym_class_rec}\<close> -local_setup \<open>embedding_fun_info @{const_name print_infra_enum_syn}\<close> -local_setup \<open>embedding_fun_info @{const_name print_infra_instantiation_class}\<close> -local_setup \<open>embedding_fun_info @{const_name print_infra_instantiation_universe}\<close> -local_setup \<open>embedding_fun_info @{const_name print_instantia_def_strictrefeq}\<close> -local_setup \<open>embedding_fun_info @{const_name print_instantia_lemmas_strictrefeq}\<close> -local_setup \<open>embedding_fun_info @{const_name print_astype_consts}\<close> -local_setup \<open>embedding_fun_info @{const_name print_astype_class}\<close> -local_setup \<open>embedding_fun_info @{const_name print_astype_from_universe}\<close> -local_setup \<open>embedding_fun_info @{const_name print_astype_lemmas_id}\<close> -local_setup \<open>embedding_fun_info @{const_name print_astype_lemma_cp}\<close> -local_setup \<open>embedding_fun_info @{const_name print_astype_lemmas_cp}\<close> -local_setup \<open>embedding_fun_info @{const_name print_astype_lemma_strict}\<close> -local_setup \<open>embedding_fun_info @{const_name print_astype_lemmas_strict}\<close> -local_setup \<open>embedding_fun_info @{const_name print_astype_defined}\<close> -local_setup \<open>embedding_fun_info @{const_name print_astype_up_d_cast0}\<close> -local_setup \<open>embedding_fun_info @{const_name print_astype_up_d_cast}\<close> -local_setup \<open>embedding_fun_info @{const_name print_astype_d_up_cast}\<close> -local_setup \<open>embedding_fun_info @{const_name print_astype_lemma_const}\<close> -local_setup \<open>embedding_fun_info @{const_name print_astype_lemmas_const}\<close> -local_setup \<open>embedding_fun_info @{const_name print_istypeof_consts}\<close> -local_setup \<open>embedding_fun_info @{const_name print_istypeof_class}\<close> -local_setup \<open>embedding_fun_info @{const_name print_istypeof_from_universe}\<close> -local_setup \<open>embedding_fun_info @{const_name print_istypeof_lemmas_id}\<close> -local_setup \<open>embedding_fun_info @{const_name print_istypeof_lemma_cp}\<close> -local_setup \<open>embedding_fun_info @{const_name print_istypeof_lemmas_cp}\<close> -local_setup \<open>embedding_fun_info @{const_name print_istypeof_lemma_strict}\<close> -local_setup \<open>embedding_fun_info @{const_name print_istypeof_lemmas_strict}\<close> -local_setup \<open>embedding_fun_info @{const_name print_istypeof_defined}\<close> -local_setup \<open>embedding_fun_info @{const_name print_istypeof_defined'}\<close> -local_setup \<open>embedding_fun_info @{const_name print_istypeof_up_larger}\<close> -local_setup \<open>embedding_fun_info @{const_name print_istypeof_up_d_cast}\<close> -local_setup \<open>embedding_fun_info @{const_name print_iskindof_consts}\<close> -local_setup \<open>embedding_fun_info @{const_name print_iskindof_class}\<close> -local_setup \<open>embedding_fun_info @{const_name print_iskindof_from_universe}\<close> -local_setup \<open>embedding_fun_info @{const_name print_iskindof_lemmas_id}\<close> -local_setup \<open>embedding_fun_info @{const_name print_iskindof_lemma_cp}\<close> -local_setup \<open>embedding_fun_info @{const_name print_iskindof_lemmas_cp}\<close> -local_setup \<open>embedding_fun_info @{const_name print_iskindof_lemma_strict}\<close> -local_setup \<open>embedding_fun_info @{const_name print_iskindof_lemmas_strict}\<close> -local_setup \<open>embedding_fun_info @{const_name print_iskindof_defined}\<close> -local_setup \<open>embedding_fun_info @{const_name print_iskindof_defined'}\<close> -local_setup \<open>embedding_fun_info @{const_name print_iskindof_up_eq_asty}\<close> -local_setup \<open>embedding_fun_info @{const_name print_iskindof_up_larger}\<close> -local_setup \<open>embedding_fun_info @{const_name print_iskindof_up_istypeof_unfold}\<close> -local_setup \<open>embedding_fun_info @{const_name print_iskindof_up_istypeof}\<close> -local_setup \<open>embedding_fun_info @{const_name print_iskindof_up_d_cast}\<close> -local_setup \<open>embedding_fun_info @{const_name print_allinst_def_id}\<close> -local_setup \<open>embedding_fun_info @{const_name print_allinst_lemmas_id}\<close> -local_setup \<open>embedding_fun_info @{const_name print_allinst_astype}\<close> -local_setup \<open>embedding_fun_info @{const_name print_allinst_exec}\<close> -local_setup \<open>embedding_fun_info @{const_name print_allinst_istypeof_pre}\<close> -local_setup \<open>embedding_fun_info @{const_name print_allinst_istypeof}\<close> -local_setup \<open>embedding_fun_info @{const_name print_allinst_iskindof_eq}\<close> -local_setup \<open>embedding_fun_info @{const_name print_allinst_iskindof_larger}\<close> -local_setup \<open>embedding_fun_info @{const_name print_access_oid_uniq_ml}\<close> -local_setup \<open>embedding_fun_info @{const_name print_access_oid_uniq}\<close> -local_setup \<open>embedding_fun_info @{const_name print_access_eval_extract}\<close> -local_setup \<open>embedding_fun_info @{const_name print_access_choose_ml}\<close> -local_setup \<open>embedding_fun_info @{const_name print_access_choose}\<close> -local_setup \<open>embedding_fun_info @{const_name print_access_deref_oid}\<close> -local_setup \<open>embedding_fun_info @{const_name print_access_deref_assocs}\<close> -local_setup \<open>embedding_fun_info @{const_name print_access_select}\<close> -local_setup \<open>embedding_fun_info @{const_name print_access_select_obj}\<close> -local_setup \<open>embedding_fun_info @{const_name print_access_dot_consts}\<close> -local_setup \<open>embedding_fun_info @{const_name print_access_dot}\<close> -local_setup \<open>embedding_fun_info @{const_name print_access_dot_lemmas_id}\<close> -local_setup \<open>embedding_fun_info @{const_name print_access_dot_cp_lemmas}\<close> -local_setup \<open>embedding_fun_info @{const_name print_access_dot_lemma_cp}\<close> -local_setup \<open>embedding_fun_info @{const_name print_access_dot_lemmas_cp}\<close> -local_setup \<open>embedding_fun_info @{const_name print_access_lemma_strict}\<close> -local_setup \<open>embedding_fun_info @{const_name print_access_def_mono}\<close> -local_setup \<open>embedding_fun_info @{const_name print_access_is_repr}\<close> -local_setup \<open>embedding_fun_info @{const_name print_access_repr_allinst}\<close> -local_setup \<open>embedding_fun_info @{const_name print_examp_def_st_defs}\<close> -local_setup \<open>embedding_fun_info @{const_name print_astype_lemmas_id2}\<close> -local_setup \<open>embedding_fun_info @{const_name print_enum}\<close> -local_setup \<open>embedding_fun_info @{const_name print_examp_instance_defassoc_typecheck_var}\<close> -local_setup \<open>embedding_fun_info @{const_name print_examp_instance_defassoc}\<close> -local_setup \<open>embedding_fun_info @{const_name print_examp_instance}\<close> -local_setup \<open>embedding_fun_info @{const_name print_examp_instance_defassoc_typecheck}\<close> -local_setup \<open>embedding_fun_info @{const_name print_examp_oclbase}\<close> -local_setup \<open>embedding_fun_info_f1 @{const_name Floor1_examp.print_examp_def_st_typecheck_var}\<close> -local_setup \<open>embedding_fun_info_f1 @{const_name Floor1_examp.print_examp_def_st1}\<close> -local_setup \<open>embedding_fun_info_f2 @{const_name Floor2_examp.print_examp_def_st_locale}\<close> -local_setup \<open>embedding_fun_info_f2 @{const_name Floor2_examp.print_examp_def_st2}\<close> -local_setup \<open>embedding_fun_info_f2 @{const_name Floor2_examp.print_examp_def_st_dom}\<close> -local_setup \<open>embedding_fun_info_f2 @{const_name Floor2_examp.print_examp_def_st_dom_lemmas}\<close> -local_setup \<open>embedding_fun_info_f2 @{const_name Floor2_examp.print_examp_def_st_perm}\<close> -local_setup \<open>embedding_fun_info_f2 @{const_name Floor2_examp.print_examp_def_st_allinst}\<close> -local_setup \<open>embedding_fun_info_f2 @{const_name Floor2_examp.print_examp_def_st_defassoc_typecheck}\<close> -local_setup \<open>embedding_fun_info_f2 @{const_name Floor2_examp.print_examp_def_st_def_interp}\<close> -local_setup \<open>embedding_fun_info_f1 @{const_name Floor1_examp.print_transition}\<close> -local_setup \<open>embedding_fun_info_f2 @{const_name Floor2_examp.print_transition_locale}\<close> -local_setup \<open>embedding_fun_info_f2 @{const_name Floor2_examp.print_transition_interp}\<close> -local_setup \<open>embedding_fun_info_f2 @{const_name Floor2_examp.print_transition_def_state}\<close> -local_setup \<open>embedding_fun_info_f2 @{const_name Floor2_examp.print_transition_wff}\<close> -local_setup \<open>embedding_fun_info_f2 @{const_name Floor2_examp.print_transition_where}\<close> -local_setup \<open>embedding_fun_info_f2 @{const_name Floor2_examp.print_transition_def_interp}\<close> -local_setup \<open>embedding_fun_info_f2 @{const_name Floor2_examp.print_transition_lemmas_oid}\<close> -local_setup \<open>embedding_fun_info_f1 @{const_name Floor1_ctxt.print_ctxt}\<close> -local_setup \<open>embedding_fun_info_f2 @{const_name Floor2_ctxt.print_ctxt_pre_post}\<close> -local_setup \<open>embedding_fun_info_f2 @{const_name Floor2_ctxt.print_ctxt_inv}\<close> -local_setup \<open>embedding_fun_info_f2 @{const_name Floor2_ctxt.print_ctxt_thm}\<close> -local_setup \<open>embedding_fun_info @{const_name print_meta_setup_def_state}\<close> -local_setup \<open>embedding_fun_info @{const_name print_meta_setup_def_transition}\<close> -local_setup \<open>embedding_fun_info @{const_name print_haskell}\<close> - -subsection\<open>Assembling Translations\<close> - -definition "section_aux n s = start_map' (\<lambda>_. [ O.section (Section n s) ])" -definition "section = section_aux 0" -definition "subsection = section_aux 1" -definition "subsubsection = section_aux 2" -definition "section' = Embedding_fun_simple o section" -definition "subsection' = Embedding_fun_simple o subsection" -definition "txt f = Embedding_fun_simple (start_map'''''' O.text o (\<lambda>_ n_thy design_analysis. [Text (f n_thy design_analysis)]))" -definition "txt_raw f = Embedding_fun_simple (start_map'''''' O.text_raw o (\<lambda>_ n_thy design_analysis. [Text_raw (f n_thy design_analysis)]))" -definition "txt' s = txt (\<lambda>_ _. s)" -definition "txt'' = txt' o S.flatten" -definition "txt''d s = txt (\<lambda> _. \<lambda> Gen_only_design \<Rightarrow> S.flatten (s) | _ \<Rightarrow> \<open>\<close>)" -definition "txt''d' s = txt (\<lambda> n_thy. \<lambda> Gen_only_design \<Rightarrow> S.flatten (s n_thy) | _ \<Rightarrow> \<open>\<close>)" -definition "txt_raw''d' s = txt_raw (\<lambda> n_thy. \<lambda> Gen_only_design \<Rightarrow> S.flatten (s n_thy) | _ \<Rightarrow> \<open>\<close>)" -definition "txt''a s = txt (\<lambda> _. \<lambda> Gen_only_design \<Rightarrow> \<open>\<close> | _ \<Rightarrow> S.flatten s)" -definition "txt''a' s = txt (\<lambda> n_thy. \<lambda> Gen_only_design \<Rightarrow> \<open>\<close> | _ \<Rightarrow> S.flatten (s n_thy))" -definition "txt_raw''a' s = txt_raw (\<lambda> n_thy. \<lambda> Gen_only_design \<Rightarrow> \<open>\<close> | _ \<Rightarrow> S.flatten (s n_thy))" - -definition thy_class :: - \<comment> \<open>polymorphism weakening needed by \<^theory_text>\<open>code_reflect\<close>\<close> - "_ embedding'" where \<open>thy_class = - (let section = section' o (\<lambda>s. \<open>Class Model: \<close> @@ s) - ; subsection = subsection' - ; subsection_def = subsection \<open>Definition\<close> - ; subsection_cp = subsection \<open>Context Passing\<close> - ; subsection_exec = subsection \<open>Execution with Invalid or Null as Argument\<close> - ; subsection_defined = subsection \<open>Validity and Definedness Properties\<close> - ; subsection_up = subsection \<open>Up Down Casting\<close> - ; subsection_const = subsection \<open>Const\<close> in - (Embed_theories o L.flatten) - [ [ PRINT_infra_enum_synonym ] - , [ txt''d' (\<lambda>n_thy. [ \<open> - \label{ex:\<close> @@ n_thy \<open>employee-design:uml\<close> @@ \<open>} \<close> ]) - , txt''a' (\<lambda>n_thy. [ \<open> - \label{ex:\<close> @@ n_thy \<open>employee-analysis:uml\<close> @@ \<open>} \<close> ]) - , section \<open>Introduction\<close> - , txt'' [ \<open> - - For certain concepts like classes and class-types, only a generic - definition for its resulting semantics can be given. Generic means, - there is a function outside \HOL that ``compiles'' a concrete, - closed-world class diagram into a ``theory'' of this data model, - consisting of a bunch of definitions for classes, accessors, method, - casts, and tests for actual types, as well as proofs for the - fundamental properties of these operations in this concrete data - model. \<close> ] - , txt'' [ \<open> - Such generic function or ``compiler'' can be implemented in - Isabelle on the \ML level. This has been done, for a semantics - following the open-world assumption, for \UML 2.0 - in~\cite{brucker.ea:extensible:2008-b, brucker:interactive:2007}. In - this paper, we follow another approach for \UML 2.4: we define the - concepts of the compilation informally, and present a concrete - example which is verified in Isabelle/\HOL. \<close> ] - , subsection \<open>Outlining the Example\<close> - , txt''d' (\<lambda>n_thy. [ \<open> - We are presenting here a ``design-model'' of the (slightly -modified) example Figure 7.3, page 20 of -the \OCL standard~\cite{omg:ocl:2012}. To be precise, this theory contains the formalization of -the data-part covered by the \UML class model (see \autoref{fig:\<close> @@ n_thy \<open>person\<close> @@ \<open>}):\<close> ]) - , txt''a' (\<lambda>n_thy. [ \<open> - We are presenting here an ``analysis-model'' of the (slightly -modified) example Figure 7.3, page 20 of -the \OCL standard~\cite{omg:ocl:2012}. -Here, analysis model means that associations -were really represented as relation on objects on the state---as is -intended by the standard---rather by pointers between objects as is -done in our ``design model''. -To be precise, this theory contains the formalization of the data-part -covered by the \UML class model (see \autoref{fig:\<close> @@ n_thy \<open>person-ana\<close> @@ \<open>}):\<close> -(* (see \autoref{ex:employee-design:uml})*) ]) - , txt_raw''d' (\<lambda> n_thy. [ \<open> - -\begin{figure} - \centering\scalebox{.3}{\includegraphics{figures/person.png}}% - \caption{A simple \UML class model drawn from Figure 7.3, - page 20 of~\cite{omg:ocl:2012}. \label{fig:\<close> @@ n_thy \<open>person\<close> @@ \<open>}} -\end{figure} -\<close> ]) - , txt_raw''a' (\<lambda> n_thy. [ \<open> - -\begin{figure} - \centering\scalebox{.3}{\includegraphics{figures/person.png}}% - \caption{A simple \UML class model drawn from Figure 7.3, - page 20 of~\cite{omg:ocl:2012}. \label{fig:\<close> @@ n_thy \<open>person-ana\<close> @@ \<open>}} -\end{figure} -\<close> ]) - , txt'' [ \<open> - This means that the association (attached to the association class -\inlineocl{EmployeeRanking}) with the association ends \inlineocl+boss+ and \inlineocl+employees+ is implemented -by the attribute \inlineocl+boss+ and the operation \inlineocl+employees+ (to be discussed in the \OCL part -captured by the subsequent theory). -\<close> ] - , section \<open>The Construction of the Object Universe\<close> - (*, txt'' [ \<open> - Ideally, the following is generated automatically from a \UML class model. \<close> ] - *), txt'' [ \<open> - Our data universe consists in the concrete class diagram just of node's, -and implicitly of the class object. Each class implies the existence of a class -type defined for the corresponding object representations as follows: \<close> ] - (*, PRINT_latex_infra_datatype_class*) - , PRINT_infra_datatype_class_1 - , PRINT_infra_datatype_class_2 - , PRINT_infra_datatype_equiv_2of1 - , PRINT_infra_datatype_equiv_1of2 - (*, PRINT_infra_datatype_equiv_1_idempo*) - , txt'' [ \<open> - Now, we construct a concrete ``universe of OclAny types'' by injection into a -sum type containing the class types. This type of OclAny will be used as instance -for all respective type-variables. \<close> ] - , PRINT_infra_datatype_universe - , txt'' [ \<open> - Having fixed the object universe, we can introduce type synonyms that exactly correspond -to \OCL types. Again, we exploit that our representation of \OCL is a ``shallow embedding'' with a -one-to-one correspondance of \OCL-types to types of the meta-language \HOL. \<close> ] - , PRINT_infra_type_synonym_class - , PRINT_infra_type_synonym_class_higher - , PRINT_infra_type_synonym_class_rec - , PRINT_infra_enum_syn - (*, txt'' [ \<open> - Just a little check: \<close> ] - *), txt'' [ \<open> - To reuse key-elements of the library like referential equality, we have -to show that the object universe belongs to the type class ``oclany,'' \ie, - each class type has to provide a function @{term oid_of} yielding the Object ID (oid) of the object. \<close> ] - , PRINT_infra_instantiation_class - , PRINT_infra_instantiation_universe - - , section \<open>Instantiation of the Generic Strict Equality\<close> - , txt'' [ \<open> - We instantiate the referential equality -on @{text "Person"} and @{text "OclAny"} \<close> ] - , PRINT_instantia_def_strictrefeq - , PRINT_instantia_lemmas_strictrefeq - , txt'' [ \<open> - For each Class \emph{C}, we will have a casting operation \inlineocl{.oclAsType($C$)}, - a test on the actual type \inlineocl{.oclIsTypeOf($C$)} as well as its relaxed form - \inlineocl{.oclIsKindOf($C$)} (corresponding exactly to Java's \verb+instanceof+-operator. -\<close> ] - , txt'' [ \<open> - Thus, since we have two class-types in our concrete class hierarchy, we have -two operations to declare and to provide two overloading definitions for the two static types. -\<close> ] ] - - , L.flatten (L.map (\<lambda>(title, body_def, body_cp, body_exec, body_defined, body_up, body_const). - section title # L.flatten [ subsection_def # body_def - , subsection_cp # body_cp - , subsection_exec # body_exec - , subsection_defined # body_defined - , subsection_up # body_up - , subsection_const # body_const ]) - [ (\<open>OclAsType\<close>, - [ PRINT_astype_consts - , PRINT_astype_class - , PRINT_astype_from_universe - , PRINT_astype_lemmas_id ] - , [ PRINT_astype_lemma_cp - , PRINT_astype_lemmas_cp ] - , [ PRINT_astype_lemma_strict - , PRINT_astype_lemmas_strict ] - , [ PRINT_astype_defined ] - , [ PRINT_astype_up_d_cast0 - , PRINT_astype_up_d_cast - , PRINT_astype_d_up_cast ] - , [ PRINT_astype_lemma_const - , PRINT_astype_lemmas_const ]) - - , (\<open>OclIsTypeOf\<close>, - [ PRINT_istypeof_consts - , PRINT_istypeof_class - , PRINT_istypeof_from_universe - , PRINT_istypeof_lemmas_id ] - , [ PRINT_istypeof_lemma_cp - , PRINT_istypeof_lemmas_cp ] - , [ PRINT_istypeof_lemma_strict - , PRINT_istypeof_lemmas_strict ] - , [ PRINT_istypeof_defined - , PRINT_istypeof_defined' ] - , [ PRINT_istypeof_up_larger - , PRINT_istypeof_up_d_cast ] - , []) - - , (\<open>OclIsKindOf\<close>, - [ PRINT_iskindof_consts - , PRINT_iskindof_class - , PRINT_iskindof_from_universe - , PRINT_iskindof_lemmas_id ] - , [ PRINT_iskindof_lemma_cp - , PRINT_iskindof_lemmas_cp ] - , [ PRINT_iskindof_lemma_strict - , PRINT_iskindof_lemmas_strict ] - , [ PRINT_iskindof_defined - , PRINT_iskindof_defined' ] - , [ PRINT_iskindof_up_eq_asty - , PRINT_iskindof_up_larger - , PRINT_iskindof_up_istypeof_unfold - , PRINT_iskindof_up_istypeof - , PRINT_iskindof_up_d_cast ] - , []) ]) - - , [ section \<open>OclAllInstances\<close> - , txt'' [ \<open> - To denote \OCL-types occurring in \OCL expressions syntactically---as, for example, as -``argument'' of \inlineisar{oclAllInstances()}---we use the inverses of the injection -functions into the object universes; we show that this is sufficient ``characterization.'' \<close> ] - , PRINT_allinst_def_id - , PRINT_allinst_lemmas_id - , PRINT_allinst_astype - , PRINT_allinst_exec - , subsection \<open>OclIsTypeOf\<close> - , PRINT_allinst_istypeof_pre - , PRINT_allinst_istypeof - , subsection \<open>OclIsKindOf\<close> - , PRINT_allinst_iskindof_eq - , PRINT_allinst_iskindof_larger - - , section \<open>The Accessors\<close> - , txt''d' (\<lambda>n_thy. [ \<open> - \label{sec:\<close> @@ n_thy \<open>edm-accessors\<close> @@ \<open>}\<close> ]) - , txt''a' (\<lambda>n_thy. [ \<open> - \label{sec:\<close> @@ n_thy \<open>eam-accessors\<close> @@ \<open>}\<close> ]) - (*, txt'' [ \<open> - Should be generated entirely from a class-diagram. \<close> ] - *), subsection_def - , txt''a [ \<open> - We start with a oid for the association; this oid can be used -in presence of association classes to represent the association inside an object, -pretty much similar to the \inlineisar+Employee_DesignModel_UMLPart+, where we stored -an \verb+oid+ inside the class as ``pointer.'' \<close> ] - , PRINT_access_oid_uniq_ml - , PRINT_access_oid_uniq - , txt''a [ \<open> - From there on, we can already define an empty state which must contain -for $\mathit{oid}_{Person}\mathcal{BOSS}$ the empty relation (encoded as association list, since there are -associations with a Sequence-like structure).\<close> ] - , PRINT_access_eval_extract - , txt''a [ \<open> - The @{text pre_post}-parameter is configured with @{text fst} or -@{text snd}, the @{text to_from}-parameter either with the identity @{term id} or -the following combinator @{text switch}: \<close> ] - , PRINT_access_choose_ml - , PRINT_access_choose - , PRINT_access_deref_oid - , PRINT_access_deref_assocs - , txt'' [ \<open> - pointer undefined in state or not referencing a type conform object representation \<close> ] - , PRINT_access_select - , PRINT_access_select_obj - , PRINT_access_dot_consts - , PRINT_access_dot - , PRINT_access_dot_lemmas_id - , subsection_cp - , PRINT_access_dot_cp_lemmas - , PRINT_access_dot_lemma_cp - , PRINT_access_dot_lemmas_cp - , subsection_exec - , PRINT_access_lemma_strict - , subsection \<open>Representation in States\<close> - , PRINT_access_def_mono - , PRINT_access_is_repr - , PRINT_access_repr_allinst - - , section \<open>Towards the Object Instances\<close> - , txt''d' (\<lambda>n_thy. [ \<open> - -The example we are defining in this section comes from the \autoref{fig:\<close> @@ n_thy \<open>edm1_system-states\<close> @@ \<open>}. -\<close> ]) - , txt_raw''d' (\<lambda>n_thy. [ \<open> -\begin{figure} -\includegraphics[width=\textwidth]{figures/pre-post.pdf} -\caption{(a) pre-state $\sigma_1$ and - (b) post-state $\sigma_1'$.} -\label{fig:\<close> @@ n_thy \<open>edm1_system-states\<close> @@ \<open>} -\end{figure} -\<close> ]) - , txt''a' (\<lambda>n_thy. [ \<open> - -The example we are defining in this section comes from the \autoref{fig:\<close> @@ n_thy \<open>eam1_system-states\<close> @@ \<open>}. -\<close> ]) - , txt_raw''a' (\<lambda>n_thy. [ \<open> -\begin{figure} -\includegraphics[width=\textwidth]{figures/pre-post.pdf} -\caption{(a) pre-state $\sigma_1$ and - (b) post-state $\sigma_1'$.} -\label{fig:\<close> @@ n_thy \<open>eam1_system-states\<close> @@ \<open>} -\end{figure} -\<close> ]) - , PRINT_examp_def_st_defs - , PRINT_astype_lemmas_id2 ] ])\<close> - -definition "thy_enum_flat = Embed_theories []" -definition thy_enum :: \<comment> \<open>polymorphism weakening needed by \<^theory_text>\<open>code_reflect\<close>\<close> "_ embedding'" where - "thy_enum = Embed_theories [ section' \<open>Enum\<close> - , PRINT_enum ]" -definition thy_haskell :: \<comment> \<open>polymorphism weakening needed by \<^theory_text>\<open>code_reflect\<close>\<close> "_ embedding'" where - "thy_haskell = Embed_theories [ section' \<open>Haskell\<close> - , PRINT_haskell ]" -definition "thy_class_synonym = Embed_theories []" -definition "thy_class_tree = Embed_theories []" -definition "thy_class_flat = Embed_theories []" -definition "thy_association = Embed_theories []" -definition thy_instance :: \<comment> \<open>polymorphism weakening needed by \<^theory_text>\<open>code_reflect\<close>\<close> "_ embedding'" where - "thy_instance = Embed_theories - [ section' \<open>Instance\<close> - , PRINT_examp_instance_defassoc_typecheck_var - , PRINT_examp_instance_defassoc - , PRINT_examp_instance - , PRINT_examp_instance_defassoc_typecheck ]" -definition thy_def_base_l :: \<comment> \<open>polymorphism weakening needed by \<^theory_text>\<open>code_reflect\<close>\<close> "_ embedding'" where - "thy_def_base_l = Embed_theories [ section' \<open>BaseType\<close> - , PRINT_examp_oclbase ]" -definition "thy_def_state = (\<lambda> Floor1 \<Rightarrow> Embed_theories - [ section' \<open>State (Floor 1)\<close> - , floor1_PRINT_examp_def_st_typecheck_var - , floor1_PRINT_examp_def_st1 ] - | Floor2 \<Rightarrow> Embed_locale - [ section' \<open>State (Floor 2)\<close> ] - Floor2_examp.print_examp_def_st_locale - [ Floor2_examp.print_examp_def_st2 - , Floor2_examp.print_examp_def_st_dom - , Floor2_examp.print_examp_def_st_dom_lemmas - , Floor2_examp.print_examp_def_st_perm - , Floor2_examp.print_examp_def_st_allinst - , Floor2_examp.print_examp_def_st_defassoc_typecheck ] - [ floor2_PRINT_examp_def_st_def_interp ])" -definition "thy_def_transition = (\<lambda> Floor1 \<Rightarrow> Embed_theories - [ section' \<open>Transition (Floor 1)\<close> - , floor1_PRINT_transition ] - | Floor2 \<Rightarrow> Embed_locale - [ section' \<open>Transition (Floor 2)\<close> ] - Floor2_examp.print_transition_locale - [ Floor2_examp.print_transition_interp - , Floor2_examp.print_transition_def_state - , Floor2_examp.print_transition_wff - , Floor2_examp.print_transition_where ] - [ floor2_PRINT_transition_def_interp - , floor2_PRINT_transition_lemmas_oid ])" -definition "thy_ctxt = (\<lambda> Floor1 \<Rightarrow> Embed_theories - [ section' \<open>Context (Floor 1)\<close> - , floor1_PRINT_ctxt ] - | Floor2 \<Rightarrow> Embed_theories - [ section' \<open>Context (Floor 2)\<close> - , floor2_PRINT_ctxt_pre_post - , floor2_PRINT_ctxt_inv - , floor2_PRINT_ctxt_thm ])" -definition "thy_flush_all = Embed_theories []" -definition "thy_generic = Embed_theories []" -(* NOTE typechecking functions can be put at the end, however checking already defined constants can be done earlier *) - -subsection\<open>Combinators Folding the Compiling Environment\<close> - -definition "compiler_env_config_reset_all env = - (let env = compiler_env_config_reset_no_env env in - ( env \<lparr> D_input_meta := [] \<rparr> - , let (l_class, l_env) = find_class_ass env in - L.flatten - [ l_class - , List.filter (\<lambda> META_flush_all _ \<Rightarrow> False | _ \<Rightarrow> True) l_env - , [META_flush_all OclFlushAll] ] ))" - -definition "fold_thy0 meta thy_object0 f = - L_fold (\<lambda>x (acc1, acc2). - let (sorry, dirty) = D_output_sorry_dirty acc1 - ; (msg, x) = case x of Embedding_fun_info msg x \<Rightarrow> (Some msg, x) - | Embedding_fun_simple x \<Rightarrow> (None, x) - ; (l, acc1) = x meta acc1 in - (f msg - (if sorry = Some Gen_sorry | sorry = None & dirty then - L.map (map_semi__theory (map_lemma (\<lambda> Lemma n spec _ _ \<Rightarrow> Lemma n spec [] C.sorry - | Lemma_assumes n spec1 spec2 _ _ \<Rightarrow> Lemma_assumes n spec1 spec2 [] C.sorry))) l - else - l) acc1 acc2)) thy_object0" - -definition "comp_env_input_class_rm f_fold f env_accu = - (let (env, accu) = f_fold f env_accu in - (env \<lparr> D_input_class := None \<rparr>, accu))" - -definition "comp_env_save ast f_fold f env_accu = - (let (env, accu) = f_fold f env_accu in - (env \<lparr> D_input_meta := ast # D_input_meta env \<rparr>, accu))" - -definition "comp_env_save_deep ast f_fold = - comp_env_save ast (\<lambda>f. map_prod - (case ast of META_def_state Floor1 meta \<Rightarrow> Floor1_examp.print_meta_setup_def_state meta - | META_def_transition Floor1 meta \<Rightarrow> Floor1_examp.print_meta_setup_def_transition meta - | _ \<Rightarrow> id) - id o - f_fold f)" - -definition "comp_env_input_class_mk f_try f_accu_reset f_fold f = - (\<lambda> (env, accu). - f_fold f - (case D_input_class env of Some _ \<Rightarrow> (env, accu) | None \<Rightarrow> - let (l_class, l_env) = find_class_ass env - ; (l_enum, l_env) = partition (\<lambda>META_enum _ \<Rightarrow> True | _ \<Rightarrow> False) l_env in - (f_try (\<lambda> () \<Rightarrow> - let D_input_meta0 = D_input_meta env - ; (env, accu) = - let meta = class_unflat' (arrange_ass True (D_ocl_semantics env \<noteq> Gen_default) l_class (L.map (\<lambda> META_enum e \<Rightarrow> e) l_enum)) - ; (env, accu) = List.fold (\<lambda> ast. comp_env_save ast (case ast of META_enum meta \<Rightarrow> fold_thy0 meta thy_enum) f) - l_enum - (let env = compiler_env_config_reset_no_env env in - (env \<lparr> D_input_meta := List.filter (\<lambda> META_enum _ \<Rightarrow> False | _ \<Rightarrow> True) (D_input_meta env) \<rparr>, f_accu_reset env accu)) - ; (env, accu) = fold_thy0 meta thy_class f (env, accu) in - (env \<lparr> D_input_class := Some meta \<rparr>, accu) - ; (env, accu) = - List.fold - (\<lambda>ast. comp_env_save ast (case ast of - META_haskell meta \<Rightarrow> fold_thy0 meta thy_haskell - | META_instance meta \<Rightarrow> fold_thy0 meta thy_instance - | META_def_base_l meta \<Rightarrow> fold_thy0 meta thy_def_base_l - | META_def_state floor meta \<Rightarrow> fold_thy0 meta (thy_def_state floor) - | META_def_transition floor meta \<Rightarrow> fold_thy0 meta (thy_def_transition floor) - | META_ctxt floor meta \<Rightarrow> fold_thy0 meta (thy_ctxt floor) - | META_flush_all meta \<Rightarrow> fold_thy0 meta thy_flush_all) - f) - l_env - (env \<lparr> D_input_meta := L.flatten [l_class, l_enum] \<rparr>, accu) in - (env \<lparr> D_input_meta := D_input_meta0 \<rparr>, accu)))))" - -definition "comp_env_input_class_bind l f = - List.fold (\<lambda>x. x f) l" - -definition "fold_thy' f_env_save f_try f_accu_reset = - (let comp_env_input_class_mk = comp_env_input_class_mk f_try f_accu_reset in - (\<lambda> f. - let fold_m = \<lambda>ast. - f_env_save ast (case ast of - META_enum meta \<Rightarrow> comp_env_input_class_rm (fold_thy0 meta thy_enum_flat) - | META_class_raw Floor1 meta \<Rightarrow> comp_env_input_class_rm (fold_thy0 meta thy_class_flat) - | META_association meta \<Rightarrow> comp_env_input_class_rm (fold_thy0 meta thy_association) - | META_ass_class Floor1 (OclAssClass meta_ass meta_class) \<Rightarrow> - comp_env_input_class_rm (comp_env_input_class_bind [ fold_thy0 meta_ass thy_association - , fold_thy0 meta_class thy_class_flat ]) - | META_haskell meta \<Rightarrow> comp_env_input_class_mk (fold_thy0 meta thy_haskell) - | META_class_synonym meta \<Rightarrow> comp_env_input_class_rm (fold_thy0 meta thy_class_synonym) - | META_class_tree meta \<Rightarrow> comp_env_input_class_rm (fold_thy0 meta thy_class_tree) - | META_instance meta \<Rightarrow> comp_env_input_class_mk (fold_thy0 meta thy_instance) - | META_def_base_l meta \<Rightarrow> fold_thy0 meta thy_def_base_l - | META_def_state floor meta \<Rightarrow> comp_env_input_class_mk (fold_thy0 meta (thy_def_state floor)) - | META_def_transition floor meta \<Rightarrow> fold_thy0 meta (thy_def_transition floor) - | META_ctxt floor meta \<Rightarrow> comp_env_input_class_mk (fold_thy0 meta (thy_ctxt floor)) - | META_flush_all meta \<Rightarrow> comp_env_input_class_mk (fold_thy0 meta thy_flush_all) - | META_generic meta \<Rightarrow> fold_thy0 meta thy_generic) f in - \<lambda> Fold_meta ast \<Rightarrow> fold_m ast - | Fold_custom l_meta \<Rightarrow> - List.fold (\<lambda> META_all_meta_embedding ast \<Rightarrow> fold_m ast - | meta \<Rightarrow> fold_thy0 () (Embed_theories [Embedding_fun_simple (\<lambda>_. Pair [meta])]) f) - l_meta))" - -definition "fold_thy'' f_env_save f_try f_accu_reset f = - List.fold (fold_thy' f_env_save f_try f_accu_reset f) o map Fold_meta" - -definition "compiler_env_config_update f env = - \<comment> \<open>WARNING The semantics of the meta-embedded language is not intended to be reset here (like \<open>oid_start\<close>), only syntactic configurations of the compiler (path, etc...)\<close> - (let env' = f env in - if D_input_meta env = [] then - env' - \<lparr> D_output_disable_thy := D_output_disable_thy env - , D_output_header_thy := D_output_header_thy env - (*D_ocl_oid_start*) - (*D_output_position*) - , D_ocl_semantics := D_ocl_semantics env - (*D_input_class*) - (*D_input_meta*) - (*D_input_instance*) - (*D_input_state*) - (*D_output_header_force*) - (*D_output_auto_bootstrap*) - (*D_ocl_accessor*) - (*D_ocl_HO_type*) - , D_output_sorry_dirty := D_output_sorry_dirty env \<rparr> - else - fst (fold_thy'' - comp_env_save_deep - (\<lambda>f. f ()) - (\<lambda>_. id) - (\<lambda>_ _. Pair) - (D_input_meta env') - (env, ())))" - -definition "fold_thy_shallow f_try f_accu_reset x = - fold_thy' - comp_env_save - f_try - f_accu_reset - (\<lambda>name l acc1. - map_prod (\<lambda> env. env \<lparr> D_input_meta := D_input_meta acc1 \<rparr>) id - o x name l - o Pair acc1)" - -definition "fold_thy_deep obj env = - (case fold_thy' - comp_env_save_deep - (\<lambda>f. f ()) - (\<lambda>env _. D_output_position env) - (\<lambda>_ l acc1 (i, cpt). (acc1, (Succ i, natural_of_nat (List.length l) + cpt))) - obj - (env, D_output_position env) of - (env, output_position) \<Rightarrow> env \<lparr> D_output_position := output_position \<rparr>)" - -end diff --git a/Citadelle/src/compiler/Generator_dynamic_concurrent.thy b/Citadelle/src/compiler/Generator_dynamic_concurrent.thy deleted file mode 100644 index fb0e79e9317642528ccfdfa640a955eabc1864bf..0000000000000000000000000000000000000000 --- a/Citadelle/src/compiler/Generator_dynamic_concurrent.thy +++ /dev/null @@ -1,2262 +0,0 @@ -(****************************************************************************** - * Citadelle - * - * 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. - ******************************************************************************) - -section\<open>Dynamic Meta Embedding with Reflection\<close> - -theory Generator_dynamic_concurrent -imports "FOCL.Printer" - "FOCL.Isabelle_Main2" - "FOCL.Old_Datatype" - keywords (* OCL (USE tool) *) - "Between" - "Attributes" "Operations" "Constraints" - "Role" - "Ordered" "Subsets" "Union" "Redefines" "Derived" "Qualifier" - "Existential" "Inv" "Pre" "Post" - (* OCL (added) *) - "self" - "Nonunique" "Sequence_" - "with_only" - (* Haskabelle *) - "datatype_old" "datatype_old_atomic" "datatype_old_atomic_sub" - "try_import" "only_types" "base_path" "ignore_not_in_scope" "abstract_mutual_data_params" - "concat_modules" "load" "meta" "meta_cmd" - - (* Isabelle syntax *) - "output_directory" - "THEORY" "IMPORTS" "SECTION" "SORRY" "no_dirty" - "deep" "shallow" "syntax_print" "skip_export" - "generation_semantics" - "flush_all" - - (* Isabelle semantics (parameterizing the semantics of OCL) *) - "design" "analysis" "oid_start" - - and (* OCL (USE tool) *) - "Enum" - "Abstract_class" "Class" - "Association" "Composition" "Aggregation" - "Abstract_associationclass" "Associationclass" - "Context" - (* OCL (added) *) - "End" "Instance" "BaseType" "State" "Transition" "Tree" - (* Haskabelle *) - "Haskell" "Haskell_file" "meta_language" "language" "meta_command" "meta_command'" - - (* Isabelle syntax *) - "generation_syntax" - - :: thy_decl -begin - -text\<open>In the ``dynamic'' solution: the exportation is automatically handled inside Isabelle/jEdit. -Inputs are provided using the syntax of OCL, and in output -we basically have two options: -\begin{itemize} -\item The first is to generate an Isabelle file for inspection or debugging. -The generated file can interactively be loaded in Isabelle/jEdit, or saved to the hard disk. -This mode is called the ``deep exportation'' mode or shortly the ``deep'' mode. -The aim is to maximally automate the process one is manually performing in -\<^file>\<open>Generator_static.thy\<close>. -\item On the other hand, it is also possible to directly execute -in Isabelle/jEdit the generated file from the random access memory. -This mode corresponds to the ``shallow reflection'' mode or shortly ``shallow'' mode. -\end{itemize} -In both modes, the reflection is necessary since the main part used by both -was defined at Isabelle side. -As a consequence, experimentations in ``deep'' and ``shallow'' are performed -without leaving the editing session, in the same as the one the meta-compiler is actually running.\<close> - -apply_code_printing_reflect \<open> - val stdout_file = Unsynchronized.ref "" -\<close> text\<open>This variable is not used in this theory (only in \<^file>\<open>Generator_static.thy\<close>), - but needed for well typechecking the reflected SML code.\<close> - -code_reflect' open META - functions (* executing the compiler as monadic combinators for deep and shallow *) - fold_thy_deep fold_thy_shallow - - (* printing the HOL AST to (shallow Isabelle) string *) - write_file0 write_file - - (* manipulating the compiling environment *) - compiler_env_config_reset_all - compiler_env_config_update - oidInit - D_output_header_thy_update - map2_ctxt_term - check_export_code - - (* printing the input AST to (deep Isabelle) string *) - isabelle_apply isabelle_of_compiler_env_config - -subsection\<open>Interface Between the Reflected and the Native\<close> - -ML\<open> -val To_string0 = META.meta_of_logic -val To_nat = Code_Numeral.integer_of_natural - -exception THY_REQUIRED of Position.T -fun get_thy pos f = fn NONE => raise (THY_REQUIRED pos) | SOME thy => f thy - -infix 1 #~> |>:: -fun f #~> g = uncurry g oo f -fun x |>:: f = cons f x -\<close> - -ML\<open> -structure From = struct - val string = META.SS_base o META.ST - val binding = string o Binding.name_of - (*fun term ctxt s = string (YXML.content_of (Syntax.string_of_term ctxt s))*) - val nat = Code_Numeral.natural_of_integer - val internal_oid = META.Oid o nat - val option = Option.map - val list = List.map - fun pair f1 f2 (x, y) = (f1 x, f2 y) - fun pair3 f1 f2 f3 (x, y, z) = (f1 x, f2 y, f3 z) - - structure Pure = struct - val indexname = pair string nat - val class = string - val sort = list class - fun typ e = (fn - Type (s, l) => (META.Typea o pair string (list typ)) (s, l) - | TFree (s, s0) => (META.TFree o pair string sort) (s, s0) - | TVar (i, s0) => (META.TVara o pair indexname sort) (i, s0) - ) e - fun term e = (fn - Const (s, t) => (META.Consta o pair string typ) (s, t) - | Free (s, t) => (META.Free o pair string typ) (s, t) - | Var (i, t) => (META.Var o pair indexname typ) (i, t) - | Bound i => (META.Bound o nat) i - | Abs (s, ty, t) => (META.Absa o pair3 string typ term) (s, ty, t) - | op $ (term1, term2) => (META.Appa o pair term term) (term1, term2) - ) e - end - - fun read_term thy expr = - META.T_pure (Pure.term (Syntax.read_term (get_thy \<^here> Proof_Context.init_global thy) expr), SOME (string expr)) -end -\<close> - -ML\<open> -fun List_mapi f = META.mapi (f o To_nat) -fun out_intensify s1 s2 = Output.state ((s1 |> Markup.markup Markup.intensify) ^ s2) -fun out_intensify' tps fmt = out_intensify (Timing.message (Timing.result tps) |> Markup.markup fmt) - -structure Toplevel' = struct - fun keep_theory f = Toplevel.keep (f o Toplevel.theory_of) - fun keep f tr = (\<^command_keyword>\<open>print_syntax\<close>, Toplevel.keep f) :: tr - fun read_write_keep rw = (\<^command_keyword>\<open>setup\<close>, fn tr => tr |> Toplevel.read_write rw |> Toplevel.keep (K ())) - fun setup_theory (res, tr) f = rev ((\<^command_keyword>\<open>setup\<close>, Toplevel.theory (f res)) :: tr) - fun keep_output tps fmt msg = cons (\<^command_keyword>\<open>print_syntax\<close>, Toplevel.keep (fn _ => out_intensify' tps fmt msg)) -end - -structure Resources' = struct - fun check_path' check_file ctxt dir (name, pos) = - let - fun err msg pos = error (msg ^ Position.here pos) - val _ = Context_Position.report ctxt pos Markup.language_path; - - val path = Path.append dir (Path.explode name) handle ERROR msg => err msg pos; - val path' = Path.expand path handle ERROR msg => err msg pos; - val _ = Context_Position.report ctxt pos (Markup.path (Path.smart_implode path)); - val _ = - (case check_file of - NONE => path - | SOME check => (check path handle ERROR msg => err msg pos)); - in Path.implode path' end - - fun check_dir thy = check_path' (SOME File.check_dir) - (Proof_Context.init_global thy) - (Resources.master_directory thy) -end -\<close> - -ML\<open> -structure Ty' = struct -fun check l_oid l = - let val Mp = META.map_prod - val Me = String.explode - val Mi = String.implode - val Ml = map in - META.check_export_code - (writeln o Mi) - (warning o Mi) - (fn s => writeln (Markup.markup (Markup.bad ()) (Mi s))) - (error o To_string0) - (Ml (Mp I Me) l_oid) - ((META.SS_base o META.ST) l) - end -end -\<close> - -subsection\<open>Binding of the Reflected API to the Native API\<close> - -ML\<open> -structure META_overload = struct - val of_semi__typ = META.of_semi_typ To_string0 - val of_semi__term = META.of_semi_terma To_string0 - val of_semi__term' = META.of_semi_term To_string0 - val fold = fold -end -\<close> - -ML\<open> -type ('a, 'b) toplevel_dual = { par: 'a, seq: 'b } -type ('transitionM, 'Proof_stateM, 'state) toplevel = - { context_of: 'state -> local_theory - - , keep: ('state -> unit) -> 'transitionM - , generic_theory: (generic_theory -> generic_theory) -> 'transitionM - , theory: (theory -> theory) -> 'transitionM - , begin_local_theory: bool -> (theory -> local_theory) -> 'transitionM - , local_theory': (bool * Position.T) option -> (xstring * Position.T) option -> - (bool -> local_theory -> local_theory) -> 'transitionM - , local_theory: (bool * Position.T) option -> (xstring * Position.T) option -> - (local_theory -> local_theory) -> 'transitionM - , local_theory_to_proof': (bool * Position.T) option -> (xstring * Position.T) option -> - (bool -> local_theory -> Proof.state) -> 'transitionM - , local_theory_to_proof: (bool * Position.T) option -> (xstring * Position.T) option -> - (local_theory -> Proof.state) -> 'transitionM - , proof': (bool -> Proof.state -> Proof.state) -> 'Proof_stateM - , proofs: (Proof.state -> Proof.state Seq.result Seq.seq) -> 'Proof_stateM - , proof: (Proof.state -> Proof.state) -> 'Proof_stateM - (* *) - , tr_report: Method.text_range -> 'transitionM -> 'transitionM - , tr_report_o: Method.text_range option -> 'transitionM -> 'transitionM - , tr_raw: (Toplevel.transition -> Toplevel.transition) -> 'transitionM - , pr_report: Method.text_range -> 'Proof_stateM -> 'Proof_stateM - , pr_report_o: Method.text_range option -> 'Proof_stateM -> 'Proof_stateM - , dual: (Toplevel.transition -> Toplevel.transition, Proof.state -> Proof.state) toplevel_dual -> 'Proof_stateM } - -structure Bind_Isabelle = struct -fun To_binding s = Binding.make (s, Position.none) -val To_sbinding = To_binding o To_string0 - -fun semi__method_simp g f = Method.Basic (fn ctxt => SIMPLE_METHOD (g (asm_full_simp_tac (f ctxt)))) -val semi__method_simp_one = semi__method_simp (fn f => f 1) -val semi__method_simp_all = semi__method_simp (CHANGED_PROP o PARALLEL_GOALS o ALLGOALS) - -datatype semi__thm' = Thms_single' of thm - | Thms_mult' of thm list - -fun semi__thm_attribute ctxt = let open META open META_overload val S = fn Thms_single' t => t in - fn Thm_thm s => Thms_single' (Proof_Context.get_thm ctxt (To_string0 s)) - | Thm_thms s => Thms_mult' (Proof_Context.get_thms ctxt (To_string0 s)) - | Thm_THEN (e1, e2) => - (case (semi__thm_attribute ctxt e1, semi__thm_attribute ctxt e2) of - (Thms_single' e1, Thms_single' e2) => Thms_single' (e1 RSN (1, e2)) - | (Thms_mult' e1, Thms_mult' e2) => Thms_mult' (e1 RLN (1, e2))) - | Thm_simplified (e1, e2) => - Thms_single' (asm_full_simplify (clear_simpset ctxt addsimps [S (semi__thm_attribute ctxt e2)]) - (S (semi__thm_attribute ctxt e1))) - | Thm_OF (e1, e2) => - Thms_single' ([S (semi__thm_attribute ctxt e2)] MRS (S (semi__thm_attribute ctxt e1))) - | Thm_where (nth, l) => - Thms_single' (Rule_Insts.where_rule - ctxt - (List.map (fn (var, expr) => - (((To_string0 var, 0), Position.none), of_semi__term expr)) l) - [] - (S (semi__thm_attribute ctxt nth))) - | Thm_symmetric e1 => - let val e2 = S (semi__thm_attribute ctxt (Thm_thm (From.string "sym"))) in - case semi__thm_attribute ctxt e1 of - Thms_single' e1 => Thms_single' (e1 RSN (1, e2)) - | Thms_mult' e1 => Thms_mult' (e1 RLN (1, [e2])) - end - | Thm_of (nth, l) => - Thms_single' (Rule_Insts.of_rule - ctxt - (List.map (SOME o of_semi__term) l, []) - [] - (S (semi__thm_attribute ctxt nth))) -end - -fun semi__thm_attribute_single ctxt s = case (semi__thm_attribute ctxt s) of Thms_single' t => t - -fun semi__thm_mult ctxt = - let fun f thy = case (semi__thm_attribute ctxt thy) of Thms_mult' t => t - | Thms_single' t => [t] in - fn META.Thms_single thy => f thy - | META.Thms_mult thy => f thy - end - -fun semi__thm_mult_l ctxt l = List.concat (map (semi__thm_mult ctxt) l) - -fun semi__method_simp_only l ctxt = clear_simpset ctxt addsimps (semi__thm_mult_l ctxt l) -fun semi__method_simp_add_del_split (l_add, l_del, l_split) ctxt = - fold Splitter.add_split (semi__thm_mult_l ctxt l_split) - (ctxt addsimps (semi__thm_mult_l ctxt l_add) - delsimps (semi__thm_mult_l ctxt l_del)) - -fun semi__method expr = let open META open Method open META_overload in case expr of - Method_rule o_s => Basic (fn ctxt => - METHOD (HEADGOAL o Classical.rule_tac - ctxt - (case o_s of NONE => [] - | SOME s => [semi__thm_attribute_single ctxt s]))) - | Method_drule s => Basic (fn ctxt => drule ctxt 0 [semi__thm_attribute_single ctxt s]) - | Method_erule s => Basic (fn ctxt => erule ctxt 0 [semi__thm_attribute_single ctxt s]) - | Method_elim s => Basic (fn ctxt => elim ctxt [semi__thm_attribute_single ctxt s]) - | Method_intro l => Basic (fn ctxt => intro ctxt (map (semi__thm_attribute_single ctxt) l)) - | Method_subst (asm, l, s) => Basic (fn ctxt => - SIMPLE_METHOD' ((if asm then EqSubst.eqsubst_asm_tac else EqSubst.eqsubst_tac) - ctxt - (map (the o Int.fromString o To_string0) l) - [semi__thm_attribute_single ctxt s])) - | Method_insert l => Basic (fn ctxt => insert (semi__thm_mult_l ctxt l)) - | Method_plus t => Combinator ( no_combinator_info - , Repeat1 - , [Combinator (no_combinator_info, Then, List.map semi__method t)]) - | Method_option t => Combinator ( no_combinator_info - , Try - , [Combinator (no_combinator_info, Then, List.map semi__method t)]) - | Method_or t => Combinator (no_combinator_info, Orelse, List.map semi__method t) - | Method_one (Method_simp_only l) => semi__method_simp_one (semi__method_simp_only l) - | Method_one (Method_simp_add_del_split l) => semi__method_simp_one (semi__method_simp_add_del_split l) - | Method_all (Method_simp_only l) => semi__method_simp_all (semi__method_simp_only l) - | Method_all (Method_simp_add_del_split l) => semi__method_simp_all (semi__method_simp_add_del_split l) - | Method_auto_simp_add_split (l_simp, l_split) => - Basic (fn ctxt => SIMPLE_METHOD (auto_tac (fold (fn (f, l) => fold f l) - [(Simplifier.add_simp, semi__thm_mult_l ctxt l_simp) - ,(Splitter.add_split, List.map (Proof_Context.get_thm ctxt o To_string0) l_split)] - ctxt))) - | Method_rename_tac l => Basic (K (SIMPLE_METHOD' (Tactic.rename_tac (List.map To_string0 l)))) - | Method_case_tac e => - Basic (fn ctxt => SIMPLE_METHOD' (Induct_Tacs.case_tac ctxt (of_semi__term e) [] NONE)) - | Method_blast n => - Basic (case n of NONE => SIMPLE_METHOD' o blast_tac - | SOME lim => fn ctxt => SIMPLE_METHOD' (depth_tac ctxt (To_nat lim))) - | Method_clarify => Basic (fn ctxt => (SIMPLE_METHOD' (fn i => CHANGED_PROP (clarify_tac ctxt i)))) - | Method_metis (l_opt, l) => - Basic (fn ctxt => (METHOD oo Metis_Tactic.metis_method) - ( (if l_opt = [] then NONE else SOME (map To_string0 l_opt), NONE) - , map (semi__thm_attribute_single ctxt) l) - ctxt) -end - -fun then_tactic l = let open Method in - (Combinator (no_combinator_info, Then, map semi__method l), (Position.none, Position.none)) -end - -fun terminal_proof0 f1 f2 f3 top o_by = let open META in case o_by of - Command_done => (\<^command_keyword>\<open>done\<close>, #dual top { par = Isar_Cmd.done_proof - , seq = f1 }) - | Command_sorry => (\<^command_keyword>\<open>sorry\<close>, #dual top { par = Isar_Cmd.skip_proof - , seq = f2 true }) - | Command_by l_apply => (\<^command_keyword>\<open>by\<close>, let val (m1, m2) = (then_tactic l_apply, NONE) in - #pr_report top m1 - (#pr_report_o top m2 - (#dual top { par = Isar_Cmd.terminal_proof (m1, m2) - , seq = f3 (m1, m2) })) end) -end - -fun terminal_proof_dual top = - terminal_proof0 Proof.local_done_proof Proof.local_skip_proof Proof.local_terminal_proof top - -fun proof_show_gen top f (thes, thes_when) st = st - |>:: (\<^command_keyword>\<open>proof\<close>, - let val m = SOME ( Method.Source [Token.make_string ("-", Position.none)] - , (Position.none, Position.none)) in - (#pr_report_o top m (#proofs top (Proof.proof m))) end) - |> f - |>:: (\<^command_keyword>\<open>show\<close>, #proof' top (fn int => Proof.show_cmd - (thes_when = []) - NONE - (K I) - [] - (if thes_when = [] then [] else [(Binding.empty_atts, map (fn t => (t, [])) thes_when)]) - [(Binding.empty_atts, [(thes, [])])] - int #> #2)) - -fun semi__command_state top (META.Command_apply_end l) = let open META_overload in - cons (\<^command_keyword>\<open>apply_end\<close>, let val m = then_tactic l in - #pr_report top m (#proofs top (Proof.apply_end m)) end) -end - -fun semi__command_proof top = let open META_overload - val thesis = "?thesis" - fun cons_proof_show f = proof_show_gen top f (thesis, []) - fun cons_let (e1, e2) = - cons (\<^command_keyword>\<open>let\<close>, #proof top - (Proof.let_bind_cmd [([of_semi__term e1], of_semi__term e2)])) in - fn META.Command_apply l => - cons (\<^command_keyword>\<open>apply\<close>, let val m = then_tactic l in - #pr_report top m (#proofs top (Proof.apply m)) end) - | META.Command_using l => - cons (\<^command_keyword>\<open>using\<close>, #proof top (fn st => - Proof.using [map (fn s => ([s], [])) (semi__thm_mult_l (Proof.context_of st) l)] st)) - | META.Command_unfolding l => - cons (\<^command_keyword>\<open>unfolding\<close>, #proof top (fn st => - Proof.unfolding [map (fn s => ([s], [])) (semi__thm_mult_l (Proof.context_of st) l)] st)) - | META.Command_let e => - cons_proof_show (cons_let e) - | META.Command_have (n, b, e, e_pr) => (fn st => st - |> cons_proof_show (fn st => st - |>:: (\<^command_keyword>\<open>have\<close>, #proof' top (fn int => - Proof.have_cmd true NONE (K I) [] [] - [( (To_sbinding n, if b then [[Token.make_string ("simp", Position.none)]] else []) - , [(of_semi__term e, [])])] int #> #2)) - |>:: terminal_proof_dual top e_pr)) - | META.Command_fix_let (l, l_let, o_exp, _) => (fn st => st - |> proof_show_gen top (fn st => st - |>:: (\<^command_keyword>\<open>fix\<close>, #proof top - (Proof.fix_cmd (List.map (fn i => (To_sbinding i, NONE, NoSyn)) l))) - |> fold cons_let l_let) - ( case o_exp of NONE => thesis | SOME (l_spec, _) => - (String.concatWith (" \<Longrightarrow> ") - (List.map of_semi__term l_spec)) - , case o_exp of NONE => [] | SOME (_, l_when) => List.map of_semi__term l_when)) -end - -fun end' top = - (\<^command_keyword>\<open>end\<close>, #tr_raw top (Toplevel.exit o Toplevel.end_local_theory o Toplevel.close_target o - Toplevel.end_proof (K Proof.end_notepad))) - -structure Cmd = struct open META open META_overload -fun input_source ml = Input.source false (of_semi__term' ml) (Position.none, Position.none) - -fun datatype' top (Datatypea (version, l)) = - case version of Datatype_new => #local_theory top NONE NONE - (BNF_FP_Def_Sugar.co_datatype_cmd - BNF_Util.Least_FP - BNF_LFP.construct_lfp - (Ctr_Sugar.default_ctr_options_cmd, - (map (fn ((n, v), l) => - ( ( ( ((map (fn v => (SOME (To_binding ""), (To_string0 v, NONE))) v, To_sbinding n), NoSyn) - , List.map (fn (n, l) => ( ( (To_binding "", To_sbinding n) - , List.map (fn s => (To_binding "", of_semi__typ s)) l) - , NoSyn)) l) - , (To_binding "", To_binding "", To_binding "")) - , [])) l))) - | _ => #theory top - ((snd oo Old_Datatype.add_datatype_cmd - (Old_Datatype_Aux.default_config' - (case version of Datatype_old => 0 | Datatype_old_atomic => 1 | _ => 2))) - (map (fn ((n, v), l) => - ( (To_sbinding n, map (fn v => (To_string0 v, NONE)) v, NoSyn) - , List.map (fn (n, l) => (To_sbinding n, List.map of_semi__typ l, NoSyn)) l)) - l)) - -fun type_synonym top (Type_synonym ((n, v), l)) = #theory top (fn thy => let val s_bind = To_sbinding n in - (snd o Typedecl.abbrev_global - (s_bind, map To_string0 v, NoSyn) - (Isabelle_Typedecl.abbrev_cmd0 (SOME s_bind) thy (of_semi__typ l))) thy end) - -fun type_notation top (Type_notation (n, e)) = #local_theory top NONE NONE - (Specification.type_notation_cmd true ("", true) [(To_string0 n, Mixfix (Input.string (To_string0 e), [], 1000, Position.no_range))]) - -fun instantiation1 name thy = thy - |> Class.instantiation ([ let val Term.Type (s, _) = Isabelle_Typedecl.abbrev_cmd0 NONE thy name in s end ], - [], - Syntax.read_sort (Proof_Context.init_global thy) "object") - -fun instantiation2 name n_def expr = - Specification.definition_cmd NONE [] [] ( (To_binding (To_string0 n_def ^ "_" ^ name ^ "_def"), []) - , of_semi__term expr) - -fun overloading1 n_c e_c = Overloading.overloading_cmd [(To_string0 n_c, of_semi__term e_c, true)] - -fun overloading2 n e = - #2 oo Specification.definition_cmd NONE [] [] ((To_sbinding n, []), of_semi__term e) - -fun consts top (Consts (n, ty, symb)) = #theory top - (Sign.add_consts_cmd [( To_sbinding n - , of_semi__typ ty - , Mixfix (Input.string ("(_) " ^ To_string0 symb), [], 1000, Position.no_range))]) - -fun definition top def = #local_theory' top NONE NONE - let val (def, e) = case def of - Definitiona e => (NONE, e) - | Definition_where1 (name, (abbrev, prio), e) => - (SOME ( To_sbinding name - , NONE - , Mixfix (Input.string ("(1" ^ of_semi__term abbrev ^ ")"), [], To_nat prio, Position.no_range)), e) - | Definition_where2 (name, abbrev, e) => - (SOME ( To_sbinding name - , NONE - , Mixfix (Input.string ("(" ^ of_semi__term abbrev ^ ")"), [], 1000, Position.no_range)), e) in fn ctxt => ctxt - |> #2 oo Specification.definition_cmd def [] [] (Binding.empty_atts, of_semi__term e) end - -fun lemmas top lemmas = #local_theory' top NONE NONE (fn disp => fn lthy => - let val (simp, s, l) = - case lemmas of Lemmas_simp_thm (simp, s, l) => - (simp, s, map (fn x => ([semi__thm_attribute_single lthy x], [])) l) - | Lemmas_simp_thms (s, l) => - (true, s, map (fn x => (Proof_Context.get_thms lthy (To_string0 x), [])) l) in - (#2 o Specification.theorems Thm.theoremK - [((To_sbinding s, List.map (fn s => Attrib.check_src lthy [Token.make_string (s, Position.none)]) - (if simp then ["simp", "code_unfold"] else [])), - l)] - [] - disp) lthy end) - -fun lemma1 n l_spec = Specification.theorem_cmd true Thm.theoremK NONE (K I) - Binding.empty_atts [] [] (Element.Shows [((To_sbinding n, []) - ,[((String.concatWith (" \<Longrightarrow> ") - (List.map of_semi__term l_spec)), [])])]) - -fun lemma1' n l_spec concl = Specification.theorem_cmd true Thm.theoremK NONE (K I) - (To_sbinding n, []) - [] - (List.map (fn (n, (b, e)) => - Element.Assumes [( ( To_sbinding n - , if b then [[Token.make_string ("simp", Position.none)]] else []) - , [(of_semi__term e, [])])]) - l_spec) - (Element.Shows [(Binding.empty_atts,[(of_semi__term concl, [])])]) - -fun lemma3 l_apply = map_filter (fn META.Command_let _ => SOME [] - | META.Command_have _ => SOME [] - | META.Command_fix_let (_, _, _, l) => SOME l - | _ => NONE) - (rev l_apply) - -fun axiomatization top (Axiomatization (n, e)) = #theory top - (#2 o Specification.axiomatization_cmd [] [] [] [((To_sbinding n, []), of_semi__term e)]) - -fun section n s _ = - let fun mk s n = if n <= 0 then s else mk (" " ^ s) (n - 1) in - out_intensify (mk (Markup.markup Markup.keyword3 (To_string0 s)) n) "" - end - -fun ml top (SMLa ml) = #generic_theory top - (ML_Context.exec let val source = input_source ml in - fn () => ML_Context.eval_source (ML_Compiler.verbose true ML_Compiler.flags) source - end #> - Local_Theory.propagate_ml_env) - -fun setup top (Setup ml) = #theory top (Isar_Cmd.setup (input_source ml)) - -fun thm top (Thm thm) = #keep top (fn state => - let val lthy = #context_of top state in - Print_Mode.with_modes [] (fn () => writeln - (Pretty.string_of - (Proof_Context.pretty_fact lthy ("", List.map (semi__thm_attribute_single lthy) thm)))) () - end) - -fun interpretation1 n loc_n loc_param = - Interpretation.interpretation_cmd ( [ ( (To_string0 loc_n, Position.none) - , ( (To_string0 n, true) - , ( if loc_param = [] then - Expression.Named [] - else - Expression.Positional (map (SOME o of_semi__term) - loc_param) - , [])))] - , []) - -fun hide_const top (Hide_const (fully, args)) = #theory top (fn thy => - fold (Sign.hide_const (not fully) o ((#1 o dest_Const) oo Proof_Context.read_const {proper = true, strict = false}) - (Proof_Context.init_global thy)) - (map To_string0 args) - thy) - -fun abbreviation top (Abbreviation e) = #local_theory' top NONE NONE - (Specification.abbreviation_cmd ("", true) NONE [] (of_semi__term e)) - -fun code_reflect' top (Code_reflect (all_public, module_name, raw_functions)) = #theory top - (Code_Runtime'.code_reflect_cmd all_public [] (map To_string0 raw_functions) (To_string0 module_name) NONE) - -end - -structure Command_Transition = struct - -fun semi__theory (top : ('transitionM, 'transitionM, 'state) toplevel) = let open META open META_overload - in (*let val f = *)fn - Theory_datatype datatype' => - cons (\<^command_keyword>\<open>datatype\<close>, Cmd.datatype' top datatype') -| Theory_type_synonym type_synonym => (*Toplevel.local_theory*) - cons (\<^command_keyword>\<open>type_synonym\<close>, Cmd.type_synonym top type_synonym) -| Theory_type_notation type_notation => - cons (\<^command_keyword>\<open>type_notation\<close>, Cmd.type_notation top type_notation) -| Theory_instantiation (Instantiation (n, n_def, expr)) => let val name = To_string0 n in fn acc => acc - |>:: (\<^command_keyword>\<open>instantiation\<close>, #begin_local_theory top true (Cmd.instantiation1 name)) - |>:: (\<^command_keyword>\<open>definition\<close>, #local_theory' top NONE NONE (#2 oo Cmd.instantiation2 name n_def expr)) - |>:: (\<^command_keyword>\<open>instance\<close>, #local_theory_to_proof top NONE NONE (Class.instantiation_instance I)) - |>:: (\<^command_keyword>\<open>..\<close>, #tr_raw top Isar_Cmd.default_proof) - |>:: end' top end -| Theory_overloading (Overloading (n_c, e_c, n, e)) => (fn acc => acc - |>:: (\<^command_keyword>\<open>overloading\<close>, #begin_local_theory top true (Cmd.overloading1 n_c e_c)) - |>:: (\<^command_keyword>\<open>definition\<close>, #local_theory' top NONE NONE (Cmd.overloading2 n e)) - |>:: end' top) -| Theory_consts consts => - cons (\<^command_keyword>\<open>consts\<close>, Cmd.consts top consts) -| Theory_definition definition => - cons (\<^command_keyword>\<open>definition\<close>, Cmd.definition top definition) -| Theory_lemmas lemmas => - cons (\<^command_keyword>\<open>lemmas\<close>, Cmd.lemmas top lemmas) -| Theory_lemma (Lemma (n, l_spec, l_apply, o_by)) => (fn acc => acc - |>:: (\<^command_keyword>\<open>lemma\<close>, #local_theory_to_proof' top NONE NONE (Cmd.lemma1 n l_spec)) - |> fold (semi__command_proof top o META.Command_apply) l_apply - |>:: terminal_proof_dual top o_by) -| Theory_lemma (Lemma_assumes (n, l_spec, concl, l_apply, o_by)) => (fn acc => acc - |>:: (\<^command_keyword>\<open>lemma\<close>, #local_theory_to_proof' top NONE NONE (Cmd.lemma1' n l_spec concl)) - |> fold (semi__command_proof top) l_apply - |> (fn st => st - |>:: terminal_proof_dual top o_by - |> (case Cmd.lemma3 l_apply of - [] => I - | _ :: l => - let fun cons_qed m = - cons (\<^command_keyword>\<open>qed\<close>, #tr_report_o top m (#tr_raw top (Isar_Cmd.qed m))) in fn st => st - |> fold (fn l => fold (semi__command_state top) l o cons_qed NONE) l - |> cons_qed NONE end))) -| Theory_axiomatization axiomatization => - cons (\<^command_keyword>\<open>axiomatization\<close>, Cmd.axiomatization top axiomatization) -| Theory_section (Section (n, s)) => let val n = To_nat n in fn st => st - |>:: (case n of 0 => - \<^command_keyword>\<open>section\<close> | 1 => - \<^command_keyword>\<open>subsection\<close> | _ => - \<^command_keyword>\<open>subsubsection\<close>, - #tr_raw top (Pure_Syn.document_command {markdown = false} (NONE, Input.string (To_string0 s)))) - |>:: (\<^command_keyword>\<open>print_syntax\<close>, #keep top (Cmd.section n s)) end -| Theory_text (Text s) => - cons (\<^command_keyword>\<open>text\<close>, - #tr_raw top (Pure_Syn.document_command {markdown = true} (NONE, Input.string (To_string0 s)))) -| Theory_text_raw (Text_raw s) => - cons (\<^command_keyword>\<open>text_raw\<close>, - #tr_raw top (Pure_Syn.document_command {markdown = true} (NONE, Input.string (To_string0 s)))) -| Theory_ML ml => - cons (\<^command_keyword>\<open>ML\<close>, Cmd.ml top ml) -| Theory_setup setup => - cons (\<^command_keyword>\<open>setup\<close>, Cmd.setup top setup) -| Theory_thm thm => - cons (\<^command_keyword>\<open>thm\<close>, Cmd.thm top thm) -| Theory_interpretation (Interpretation (n, loc_n, loc_param, o_by)) => (fn st => st - |>:: (\<^command_keyword>\<open>interpretation\<close>, #local_theory_to_proof top NONE NONE - (Cmd.interpretation1 n loc_n loc_param)) - |>:: terminal_proof_dual top o_by) -| Theory_hide_const hide_const => - cons (\<^command_keyword>\<open>hide_const\<close>, Cmd.hide_const top hide_const) -| Theory_abbreviation abbreviation => - cons (\<^command_keyword>\<open>abbreviation\<close>, Cmd.abbreviation top abbreviation) -| Theory_code_reflect code_reflect' => - cons (\<^command_keyword>\<open>code_reflect'\<close>, Cmd.code_reflect' top code_reflect') -(*in fn t => fn thy => f t thy handle ERROR s => (warning s; thy) - end*) -end -end - -structure Command_Theory = struct - -fun local_terminal_proof o_by = let open META in case o_by of - Command_done => Proof.local_done_proof - | Command_sorry => Proof.local_skip_proof true - | Command_by l_apply => Proof.local_terminal_proof (then_tactic l_apply, NONE) -end - -fun global_terminal_proof o_by = let open META in case o_by of - Command_done => Proof.global_done_proof - | Command_sorry => Proof.global_skip_proof true - | Command_by l_apply => Proof.global_terminal_proof (then_tactic l_apply, NONE) -end - -fun semi__command_state' top pr = fold snd (rev (semi__command_state top pr [])) -fun semi__command_proof' top pr = fold snd (rev (semi__command_proof top pr [])) - -fun semi__theory top = let open META open META_overload in (*let val f = *)fn - Theory_datatype datatype' => Cmd.datatype' top datatype' -| Theory_type_synonym type_synonym => Cmd.type_synonym top type_synonym -| Theory_type_notation type_notation => Cmd.type_notation top type_notation -| Theory_instantiation (Instantiation (n, n_def, expr)) => #theory top (fn thy => let val name = To_string0 n in thy - |> Cmd.instantiation1 name - |> (fn thy => let val ((_, (_, ty)), thy) = Cmd.instantiation2 name n_def expr false thy in ([ty], thy) end) - |-> Class.prove_instantiation_exit_result (map o Morphism.thm) (fn ctxt => fn thms => - Class.intro_classes_tac ctxt [] THEN ALLGOALS (Proof_Context.fact_tac ctxt thms)) - |-> K I end) -| Theory_overloading (Overloading (n_c, e_c, n, e)) => #theory top (fn thy => thy - |> Cmd.overloading1 n_c e_c - |> Cmd.overloading2 n e false - |> Local_Theory.exit_global) -| Theory_consts consts => Cmd.consts top consts -| Theory_definition definition => Cmd.definition top definition -| Theory_lemmas lemmas => Cmd.lemmas top lemmas -| Theory_lemma (Lemma (n, l_spec, l_apply, o_by)) => #local_theory top NONE NONE (fn lthy => lthy - |> Cmd.lemma1 n l_spec false - |> fold (semi__command_proof' top o META.Command_apply) l_apply - |> global_terminal_proof o_by) -| Theory_lemma (Lemma_assumes (n, l_spec, concl, l_apply, o_by)) => #local_theory top NONE NONE (fn lthy => lthy - |> Cmd.lemma1' n l_spec concl false - |> fold (semi__command_proof' top) l_apply - |> (case Cmd.lemma3 l_apply of - [] => global_terminal_proof o_by - | _ :: l => let val arg = (NONE, true) in fn st => st - |> local_terminal_proof o_by - |> fold (fn l => fold (semi__command_state' top) l o Proof.local_qed arg) l - |> Proof.global_qed arg end)) -| Theory_axiomatization axiomatization => Cmd.axiomatization top axiomatization -| Theory_section (Section (n, s)) => #keep top (Cmd.section (To_nat n) s) -| Theory_text _ => #keep top (K ()) -| Theory_text_raw _ => #keep top (K ()) -| Theory_ML ml => Cmd.ml top ml -| Theory_setup setup => Cmd.setup top setup -| Theory_thm thm => Cmd.thm top thm -| Theory_interpretation (Interpretation (n, loc_n, loc_param, o_by)) => #local_theory top NONE NONE (fn lthy => lthy - |> Cmd.interpretation1 n loc_n loc_param - |> global_terminal_proof o_by) -| Theory_hide_const hide_const => Cmd.hide_const top hide_const -| Theory_abbreviation abbreviation => Cmd.abbreviation top abbreviation -| Theory_code_reflect code_reflect' => Cmd.code_reflect' top code_reflect' -(*in fn t => fn thy => f t thy handle ERROR s => (warning s; thy) - end*) -end -end - -end - -structure Bind_META = struct open Bind_Isabelle - -structure Meta_Cmd_Data = Theory_Data - (open META - type T = META.all_meta list - val empty = [] - val extend = I - val merge = #2) - -fun ML_context_exec source = - ML_Context.exec (fn () => - ML_Context.eval_source (ML_Compiler.verbose false ML_Compiler.flags) source) #> - Local_Theory.propagate_ml_env - -fun meta_command0 s_put f_get source = - Context.Theory - #> ML_context_exec (Input.string ("let open META val ML = META.SML in Context.>> (Context.map_theory (" ^ s_put ^ " (" ^ source ^ "))) end")) - #> Context.map_theory_result (fn thy => (f_get thy, thy)) - #> fst - -val meta_command = meta_command0 "Bind_META.Meta_Cmd_Data.put" Meta_Cmd_Data.get - -local - open META - open META_overload - open Library - - fun semi__locale data thy = thy - |> ( Expression.add_locale_cmd - (To_sbinding (META.holThyLocale_name data)) - Binding.empty - ([], []) - (List.concat - (map - (fn (fixes, assumes) => List.concat - [ map (fn (e,ty) => Element.Fixes [( To_binding (of_semi__term e) - , SOME (of_semi__typ ty) - , NoSyn)]) fixes - , case assumes of NONE => [] - | SOME (n, e) => [Element.Assumes [( (To_sbinding n, []) - , [(of_semi__term e, [])])]]]) - (META.holThyLocale_header data))) - #> #2) - - fun semi__aux thy = - map2_ctxt_term - (fn T_pure x => T_pure x - | e => - let fun aux e = case e of - T_to_be_parsed (s, _) => SOME let val t = Syntax.read_term (get_thy \<^here> Proof_Context.init_global thy) - (To_string0 s) in - (t, s, Term.add_frees t []) - end - | T_lambda (a, e) => - Option.map - (fn (e, s, l_free) => - let val a0 = To_string0 a - val (t, l_free) = case List.partition (fn (x, _) => x = a0) l_free of - ([], l_free) => (Term.TFree ("'a", ["HOL.type"]), l_free) - | ([(_, t)], l_free) => (t, l_free) in - (lambda ( Term.Free (a0, t)) e - , META.String_concatWith (From.string "", [From.string "(% ", a, From.string ". ", s, From.string ")"]) - , l_free) - end) - (aux e) - | _ => NONE in - case aux e of - NONE => error "nested pure expression not expected" - | SOME (e, s, _) => META.T_pure (From.Pure.term e, SOME s) - end) -in - -fun all_meta_tr aux top thy_o = fn - META_semi_theories theo => apsnd - (case theo of - Theories_one theo => Command_Transition.semi__theory top theo - | Theories_locale (data, l) => fn acc => acc - |>:: (\<^command_keyword>\<open>locale\<close>, #begin_local_theory top true (semi__locale data)) - |> fold (fold (Command_Transition.semi__theory top)) l - |>:: end' top) -| META_boot_generation_syntax _ => I -| META_boot_setup_env _ => I -| META_all_meta_embedding (META_generic (OclGeneric source)) => - (fn (env, tr) => - all_meta_trs - aux - top - thy_o - (get_thy \<^here> - (fn thy => - get_thy \<^here> - (meta_command (To_string0 source)) - (if forall (fn ((key, _), _) => - Keyword.is_vacuous (Thy_Header.get_keywords thy) key) - tr - then SOME thy else NONE)) - thy_o) - (env, tr)) -| META_all_meta_embedding meta => aux (semi__aux NONE meta) - -and all_meta_trs aux = fold oo all_meta_tr aux - -fun all_meta_thy aux top_theory top_local_theory = fn - META_semi_theories theo => apsnd - (case theo of - Theories_one theo => Command_Theory.semi__theory top_theory theo - | Theories_locale (data, l) => (*Toplevel.begin_local_theory*) fn thy => thy - |> semi__locale data - |> fold (fold (Command_Theory.semi__theory top_local_theory)) l - |> Local_Theory.exit_global) -| META_boot_generation_syntax _ => I -| META_boot_setup_env _ => I -| META_all_meta_embedding (META_generic (OclGeneric source)) => - (fn (env, thy) => - all_meta_thys aux top_theory top_local_theory (meta_command (To_string0 source) thy) (env, thy)) -| META_all_meta_embedding meta => fn (env, thy) => aux (semi__aux (SOME thy) meta) (env, thy) - -and all_meta_thys aux = fold oo all_meta_thy aux - -end -end -\<close> - -subsection\<open>Directives of Compilation for Target Languages\<close> - -ML\<open> -structure Deep0 = struct - -fun apply_hs_code_identifiers ml_module thy = - let fun mod_hs (fic, ml_module) = Code_Symbol.Module (fic, [("Haskell", SOME ml_module)]) in - fold (Code_Target.set_identifiers o mod_hs) - (map (fn x => (Context.theory_name x, ml_module)) - (* list of .hs files that will be merged together in "ml_module" *) - ( thy - :: (* we over-approximate the set of compiler files *) - Context.ancestors_of thy)) thy end - -structure Export_code_env = struct - structure Isabelle = struct - val function = "write_file" - val argument_main = "main" - end - - structure Haskell = struct - val function = "Function" - val argument = "Argument" - val main = "Main" - structure Filename = struct - fun hs_function ext = function ^ "." ^ ext - fun hs_argument ext = argument ^ "." ^ ext - fun hs_main ext = main ^ "." ^ ext - end - end - - structure OCaml = struct - val make = "write" - structure Filename = struct - fun function ext = "function." ^ ext - fun argument ext = "argument." ^ ext - fun main_fic ext = "main." ^ ext - fun makefile ext = make ^ "." ^ ext - end - end - - structure Scala = struct - structure Filename = struct - fun function ext = "Function." ^ ext - fun argument ext = "Argument." ^ ext - end - end - - structure SML = struct - val main = "Run" - structure Filename = struct - fun function ext = "Function." ^ ext - fun argument ext = "Argument." ^ ext - fun stdout ext = "Stdout." ^ ext - fun main_fic ext = main ^ "." ^ ext - end - end - - datatype file_input = File - | Directory -end - -fun compile l cmd = - let val (l, rc) = fold (fn cmd => (fn (l, 0) => - let val {out, err, rc, ...} = Bash.process cmd in - ((out, err) :: l, rc) end - | x => x)) l ([], 0) - val l = rev l in - if rc = 0 then - (l, Isabelle_System.bash_output cmd) - else - let val () = fold (fn (out, err) => K (warning err; writeln out)) l () in - error "Compilation failed" - end - end - -val check = - fold (fn (cmd, msg) => fn () => - let val (out, rc) = Isabelle_System.bash_output cmd in - if rc = 0 then - () - else - ( writeln out - ; error msg) - end) - -val compiler = [] - -structure Find = struct - -fun find ml_compiler = - case List.find (fn (ml_compiler0, _, _, _, _, _, _) => ml_compiler0 = ml_compiler) compiler of - SOME v => v - | NONE => error ("Not registered compiler: " ^ ml_compiler) - -fun ext ml_compiler = case find ml_compiler of (_, ext, _, _, _, _, _) => ext - -fun export_mode ml_compiler = case find ml_compiler of (_, _, mode, _, _, _, _) => mode - -fun function ml_compiler = case find ml_compiler of (_, _, _, f, _, _, _) => f - -fun check_compil ml_compiler = case find ml_compiler of (_, _, _, _, build, _, _) => build - -fun init ml_compiler = case find ml_compiler of (_, _, _, _, _, build, _) => build - -fun build ml_compiler = case find ml_compiler of (_, _, _, _, _, _, build) => build -end - -end -\<close> - -ML\<open> -structure Deep = struct - -fun absolute_path thy filename = - Path.implode (Path.append (Resources.master_directory thy) (Path.explode filename)) - -fun export_code_tmp_file seris g = - fold - (fn ((ml_compiler, ml_module), export_arg) => fn f => fn g => - f (fn accu => - let val tmp_name = Context.theory_name \<^theory> in - (if Deep0.Find.export_mode ml_compiler = Deep0.Export_code_env.Directory then - Isabelle_System.with_tmp_dir tmp_name - else - Isabelle_System.with_tmp_file tmp_name (Deep0.Find.ext ml_compiler)) - (fn filename => - g (((((ml_compiler, ml_module), (Path.implode filename, Position.none)), export_arg) :: accu))) - end)) - seris - (fn f => f []) - (g o rev) - -fun mk_path_export_code tmp_export_code ml_compiler i = - Path.append tmp_export_code (Path.make [ml_compiler ^ Int.toString i]) - -fun export_code_cmd' seris tmp_export_code f_err raw_cs thy = - export_code_tmp_file seris - (fn seris => - let val mem_scala = List.exists (fn ((("Scala", _), _), _) => true | _ => false) seris - val _ = Isabelle_Code_Target.export_code_cmd - false - (if mem_scala then Deep0.Export_code_env.Isabelle.function :: raw_cs else raw_cs) - seris - (Proof_Context.init_global - let val v = Deep0.apply_hs_code_identifiers Deep0.Export_code_env.Haskell.argument thy in - if mem_scala then Code_printing.apply_code_printing v else v end) in - List_mapi - (fn i => fn seri => case seri of (((ml_compiler, _), (filename, _)), _) => - let val (l, (out, err)) = - Deep0.Find.build - ml_compiler - (mk_path_export_code tmp_export_code ml_compiler i) - filename - val _ = f_err seri err in - (l, out) - end) seris - end) - -fun mk_term ctxt s = - fst (Scan.pass (Context.Proof ctxt) Args.term (Token.explode0 (Thy_Header.get_keywords' ctxt) s)) - -fun mk_free ctxt s l = - let val t_s = mk_term ctxt s in - if Term.is_Free t_s then s else - let val l = (s, "") :: l in - mk_free ctxt (fst (hd (Term.variant_frees t_s l))) l - end - end - -val list_all_eq = fn x0 :: xs => - List.all (fn x1 => x0 = x1) xs - -end -\<close> - -subsection\<open>Saving the History of Meta Commands\<close> - -ML\<open> -fun p_gen f g = f "[" "]" g - (*|| f "{" "}" g*) - || f "(" ")" g -fun paren f = p_gen (fn s1 => fn s2 => fn f => Parse.$$$ s1 |-- f --| Parse.$$$ s2) f -fun parse_l f = Parse.$$$ "[" |-- Parse.!!! (Parse.list f --| Parse.$$$ "]") -fun parse_l_with f = Parse.$$$ "[" |-- Scan.optional (Parse.binding --| \<^keyword>\<open>with_only\<close> >> SOME) NONE - -- Parse.!!! (Parse.list f --| Parse.$$$ "]") -fun parse_l' f = Parse.$$$ "[" |-- Parse.list f --| Parse.$$$ "]" -fun parse_l1' f = Parse.$$$ "[" |-- Parse.list1 f --| Parse.$$$ "]" -fun annot_ty f = Parse.$$$ "(" |-- f --| Parse.$$$ "::" -- Parse.binding --| Parse.$$$ ")" -\<close> - -ML\<open> -structure Generation_mode = struct - -type internal_deep = - { output_header_thy : (string * (string list (* imports *) * string (* import optional (bootstrap) *))) option - , seri_args : ((bstring (* compiler *) * bstring (* main module *) ) * Token.T list) list - , filename_thy : bstring option - , tmp_export_code : Path.T (* dir *) - , skip_exportation : bool (* true: skip preview of code exportation *) } - -datatype ('a, 'b, 'c) generation_mode0 = Gen_deep of 'a | Gen_shallow of 'b | Gen_syntax_print of 'c - -type ('compiler_env_config_ext, 'a) generation_mode = - { deep : ('compiler_env_config_ext * internal_deep) list - , shallow : ('compiler_env_config_ext * 'a (* theory init *)) list - , syntax_print : int option list } - -fun mapM_syntax_print f (mode : ('compiler_env_config_ext, 'a) generation_mode) tr = tr - |> f (#syntax_print mode) - |> apfst (fn syntax_print => { syntax_print = syntax_print - , deep = #deep mode - , shallow = #shallow mode }) - -fun mapM_shallow f (mode : ('compiler_env_config_ext, 'a) generation_mode) tr = tr - |> f (#shallow mode) - |> apfst (fn shallow => { syntax_print = #syntax_print mode - , deep = #deep mode - , shallow = shallow }) - -fun mapM_deep f (mode : ('compiler_env_config_ext, 'a) generation_mode) tr = tr - |> f (#deep mode) - |> apfst (fn deep => { syntax_print = #syntax_print mode - , deep = deep - , shallow = #shallow mode }) - -structure Data_gen = Theory_Data - (type T = (unit META.compiler_env_config_ext, theory) generation_mode - val empty = {deep = [], shallow = [], syntax_print = [NONE]} - val extend = I - fun merge (e1, e2) = { deep = #deep e1 @ #deep e2 - , shallow = #shallow e1 @ #shallow e2 - , syntax_print = #syntax_print e1 @ #syntax_print e2 }) - -val code_expr_argsP = Scan.optional (\<^keyword>\<open>(\<close> |-- Parse.args --| \<^keyword>\<open>)\<close>) [] - -val parse_scheme = - \<^keyword>\<open>design\<close> >> K META.Gen_only_design || \<^keyword>\<open>analysis\<close> >> K META.Gen_only_analysis - -val parse_sorry_mode = - Scan.optional ( \<^keyword>\<open>SORRY\<close> >> K (SOME META.Gen_sorry) - || \<^keyword>\<open>no_dirty\<close> >> K (SOME META.Gen_no_dirty)) NONE - -val parse_deep = - Scan.optional (\<^keyword>\<open>skip_export\<close> >> K true) false - -- Scan.optional (((Parse.$$$ "(" -- \<^keyword>\<open>THEORY\<close>) |-- Parse.name -- ((Parse.$$$ ")" - -- Parse.$$$ "(" -- \<^keyword>\<open>IMPORTS\<close>) |-- parse_l' Parse.name -- Parse.name) - --| Parse.$$$ ")") >> SOME) NONE - -- Scan.optional (\<^keyword>\<open>SECTION\<close> >> K true) false - -- parse_sorry_mode - -- (* code_expr_inP *) parse_l1' (\<^keyword>\<open>in\<close> |-- ((\<^keyword>\<open>self\<close> || Parse.name) - -- Scan.optional (\<^keyword>\<open>module_name\<close> |-- Parse.name) "" - -- code_expr_argsP)) - -- Scan.optional - ((Parse.$$$ "(" -- \<^keyword>\<open>output_directory\<close>) |-- Parse.name --| Parse.$$$ ")" >> SOME) - NONE - -val parse_semantics = - let val z = 0 in - Scan.optional - (paren (\<^keyword>\<open>generation_semantics\<close> - |-- paren (parse_scheme - -- Scan.optional ((Parse.$$$ "," -- \<^keyword>\<open>oid_start\<close>) |-- Parse.nat) - z))) - (META.Gen_default, z) - end - -val mode = - let fun mk_env output_disable_thy output_header_thy oid_start design_analysis sorry_mode ctxt = - META.compiler_env_config_empty - output_disable_thy - (From.option (From.pair From.string (From.pair (From.list From.string) From.string)) - output_header_thy) - (META.oidInit (From.internal_oid oid_start)) - design_analysis - (sorry_mode, Config.get ctxt quick_and_dirty) in - - \<^keyword>\<open>deep\<close> |-- parse_semantics -- parse_deep >> - (fn ( (design_analysis, oid_start) - , ( ((((skip_exportation, output_header_thy), output_disable_thy), sorry_mode), seri_args) - , filename_thy)) => - Gen_deep ( mk_env (not output_disable_thy) - output_header_thy - oid_start - design_analysis - sorry_mode - , { output_header_thy = output_header_thy - , seri_args = seri_args - , filename_thy = filename_thy - , tmp_export_code = Isabelle_System.create_tmp_path "deep_export_code" "" - , skip_exportation = skip_exportation })) - || \<^keyword>\<open>shallow\<close> |-- parse_semantics -- parse_sorry_mode >> - (fn ((design_analysis, oid_start), sorry_mode) => - Gen_shallow (mk_env true - NONE - oid_start - design_analysis - sorry_mode)) - || (\<^keyword>\<open>syntax_print\<close> |-- Scan.optional (Parse.number >> SOME) NONE) >> - (fn n => Gen_syntax_print (case n of NONE => NONE | SOME n => Int.fromString n)) - end - -fun f_command l_mode = - Toplevel'.setup_theory - (META.mapM - (fn Gen_shallow env => - pair (fn thy => Gen_shallow (env (Proof_Context.init_global thy), thy)) - o cons (Toplevel'.read_write_keep (Toplevel.Load_previous, Toplevel.Store_backup)) - | Gen_syntax_print n => pair (K (Gen_syntax_print n)) - | Gen_deep (env, i_deep) => - pair (fn thy => Gen_deep (env (Proof_Context.init_global thy), i_deep)) - o cons - (\<^command_keyword>\<open>export_code\<close>, Toplevel'.keep_theory (fn thy => - let val seri_args' = - List_mapi - (fn i => fn ((ml_compiler, ml_module), export_arg) => - let val tmp_export_code = Deep.mk_path_export_code (#tmp_export_code i_deep) ml_compiler i - fun mk_fic s = Path.append tmp_export_code (Path.make [s]) - val () = Deep0.Find.check_compil ml_compiler () - val () = Isabelle_System.mkdirs tmp_export_code in - (( ( (ml_compiler, ml_module) - , ( Path.implode (if Deep0.Find.export_mode ml_compiler = Deep0.Export_code_env.Directory then - tmp_export_code - else - mk_fic (Deep0.Find.function ml_compiler (Deep0.Find.ext ml_compiler))) - , Position.none)) - , export_arg), mk_fic) - end) - (List.filter (fn (("self", _), _) => false | _ => true) (#seri_args i_deep)) - val _ = - case seri_args' of [] => () | _ => - let val _ = - warning ("After closing Isabelle/jEdit, we may still need to remove this directory (by hand): " ^ - Path.implode (Path.expand (#tmp_export_code i_deep))) in - thy - |> Deep0.apply_hs_code_identifiers Deep0.Export_code_env.Haskell.function - |> Code_printing.apply_code_printing - |> Proof_Context.init_global - |> - Isabelle_Code_Target.export_code_cmd - (List.exists (fn (((("SML", _), _), _), _) => true | _ => false) seri_args') - [Deep0.Export_code_env.Isabelle.function] - (List.map fst seri_args') - end in - List.app (fn ((((ml_compiler, ml_module), _), _), mk_fic) => - Deep0.Find.init ml_compiler mk_fic ml_module Deep.mk_free thy) seri_args' end))) - l_mode - []) - (fn l_mode => fn thy => - let val l_mode = map (fn f => f thy) l_mode - in Data_gen.put { deep = map_filter (fn Gen_deep x => SOME x | _ => NONE) l_mode - , shallow = map_filter (fn Gen_shallow x => SOME x | _ => NONE) l_mode - , syntax_print = map_filter (fn Gen_syntax_print x => SOME x | _ => NONE) l_mode } thy end) - -fun update_compiler_config f = - Data_gen.map - (fn mode => { deep = map (apfst (META.compiler_env_config_update f)) (#deep mode) - , shallow = map (apfst (META.compiler_env_config_update f)) (#shallow mode) - , syntax_print = #syntax_print mode }) - -fun meta_command0 s_put f_get f_get0 source = - Context.Theory - #> Bind_META.ML_context_exec (Input.string ("let open META val ML = META.SML in Context.>> (Context.map_theory (fn thy => " ^ s_put ^ " ((" ^ source ^ ") (" ^ f_get0 ^ " thy)) thy)) end")) - #> Context.map_theory_result (fn thy => (f_get thy, thy)) - #> fst - -val meta_command = meta_command0 "Bind_META.Meta_Cmd_Data.put" - Bind_META.Meta_Cmd_Data.get - "Generation_mode.Data_gen.get" -end -\<close> - -subsection\<open>Factoring All Meta Commands Together\<close> - -setup\<open>ML_Antiquotation.inline \<^binding>\<open>mk_string\<close> (Scan.succeed -"(fn ctxt => fn x => ML_Pretty.string_of_polyml (ML_system_pretty (x, FixedInt.fromInt (Config.get ctxt ML_Print_Depth.print_depth))))") -\<close> - -ML\<open> - -local - val partition_self = List.partition (fn ((s,_),_) => s = "self") -in - -fun exec_deep0 {output_header_thy, seri_args, filename_thy, tmp_export_code, ...} (env, l_obj) = -let open Generation_mode - val of_arg = META.isabelle_of_compiler_env_config META.isabelle_apply I - fun def s = Named_Target.theory_map (snd o Specification.definition_cmd NONE [] [] (Binding.empty_atts, s) false) - val (seri_args0, seri_args) = partition_self seri_args - in - fn thy0 => - let - val env = META.compiler_env_config_more_map - (fn () => (l_obj, From.option - From.string - (Option.map (Deep.absolute_path thy0) filename_thy))) - env - val l = case seri_args of [] => [] | _ => - let val name_main = Deep.mk_free (Proof_Context.init_global thy0) - Deep0.Export_code_env.Isabelle.argument_main [] - in thy0 - |> def (String.concatWith " " - ( "(" (* polymorphism weakening needed by export_code *) - ^ name_main ^ " :: (_ \<times> abr_string option) compiler_env_config_scheme)" - :: "=" - :: To_string0 (of_arg env) - :: [])) - |> Deep.export_code_cmd' seri_args - tmp_export_code - (fn (((_, _), (msg, _)), _) => fn err => if err <> 0 then error msg else ()) - [name_main] - end - in - case seri_args0 of [] => l - | _ => ([], case (output_header_thy, filename_thy) of - (SOME _, SOME _) => let val _ = META.write_file env in "" end - | _ => String.concat (map (fn s => s ^ "\n") (snd (META.write_file0 env))) - (* TODO: further optimize "string" as "string list" *)) - :: l - end - |> (fn l => let val (l_warn, l) = (map fst l, map snd l) in - if Deep.list_all_eq l then - (List.concat l_warn, hd l) - else - error "There is an extracted language which does not produce a similar Isabelle content as the others" - end) - |> (fn (l_warn, s) => - let val () = writeln - (case (output_header_thy, filename_thy) of - (SOME _, SOME _) => s - | _ => String.concat (map ( (fn s => s ^ "\n") - o Active.sendback_markup_command - o trim_line) - (String.tokens (fn c => Char.ord c = META.integer_escape) s))) - in List.app (fn (out, err) => ( writeln (Markup.markup Markup.keyword2 err) - ; case trim_line out of "" => () - | out => writeln (Markup.markup Markup.keyword1 out))) - l_warn end) -end - -fun exec_deep i_deep e = - let val (seri_args0, seri_args) = partition_self (#seri_args i_deep) - in cons - ( case (seri_args0, seri_args) of ([_], []) => \<^command_keyword>\<open>print_syntax\<close> - | _ => \<^command_keyword>\<open>export_code\<close> - , Toplevel'.keep_theory (exec_deep0 i_deep e)) - end -end - -local - -fun fold_thy_shallow f = - META.fold_thy_shallow - (fn f => f () handle ERROR e => - ( warning "Shallow Backtracking: (true) Isabelle declarations occurring among the META-simulated ones are ignored (if any)" - (* TODO automatically determine if there is such Isabelle declarations, - for raising earlier a specific error message *) - ; error e)) - f - -fun disp_time toplevel_keep_output = - let - val tps = Timing.start () - val disp_time = fn NONE => I | SOME msg => - toplevel_keep_output tps Markup.antiquote - let val msg = To_string0 msg - in " " ^ Pretty.string_of - (Pretty.mark (Name_Space.markup (Proof_Context.const_space \<^context>) msg) - (Pretty.str msg)) end - in (tps, disp_time) end - -fun thy_deep exec_deep exec_info l_obj = - Generation_mode.mapM_deep - (META.mapM (fn (env, i_deep) => - pair (META.fold_thy_deep l_obj env, i_deep) - o (if #skip_exportation i_deep then - I - else - let fun exec l_obj = - exec_deep { output_header_thy = #output_header_thy i_deep - , seri_args = #seri_args i_deep - , filename_thy = NONE - , tmp_export_code = #tmp_export_code i_deep - , skip_exportation = #skip_exportation i_deep } - ( META.d_output_header_thy_update (K NONE) env, l_obj) - in - case l_obj of - META.Fold_meta obj => exec [obj] - | META.Fold_custom l_obj => - let val l_obj' = map_filter (fn META.META_all_meta_embedding x => SOME x - | _ => NONE) - l_obj - in if length l_obj' = length l_obj - then exec l_obj' - else - exec_info - (fn _ => - app ( writeln - o Active.sendback_markup_command - o META.print META.of_all_meta (META.d_output_header_thy_update (K NONE) env)) - l_obj) - end - end))) - -fun report m f = (Method.report m; f) -fun report_o o' f = (Option.map Method.report o'; f) - -fun thy_shallow l_obj get_all_meta_embed = - Generation_mode.mapM_shallow - (fn l_shallow => fn thy => META.mapM - (fn (env, thy0) => fn (thy, l_obj) => - let val (_, disp_time) = disp_time (tap o K ooo out_intensify') - fun aux x = - fold_thy_shallow - (K o K thy0) - (fn msg => - let val () = disp_time msg () - fun in_self f lthy = lthy - |> Local_Theory.new_group - |> f - |> Local_Theory.reset_group - |> Local_Theory.reset - fun not_used p _ = error ("not used " ^ Position.here p) - val context_of = I - fun proof' f = f true - fun proofs f s = s |> f |> Seq.the_result "" - val proof = I - val dual = #seq in - Bind_META.all_meta_thys (aux o META.Fold_meta) - - { (* specialized part *) - theory = I - , local_theory = K o K Named_Target.theory_map - , local_theory' = K o K (fn f => Named_Target.theory_map (f false)) - , keep = fn f => Named_Target.theory_map (fn lthy => (f lthy ; lthy)) - , generic_theory = Context.theory_map - (* generic part *) - , context_of = context_of, dual = dual - , proof' = proof', proofs = proofs, proof = proof - , tr_report = report, tr_report_o = report_o - , pr_report = report, pr_report_o = report_o - (* irrelevant part *) - , begin_local_theory = K o not_used \<^here> - , local_theory_to_proof' = K o K not_used \<^here> - , local_theory_to_proof = K o K not_used \<^here> - , tr_raw = not_used \<^here> } - - { (* specialized part *) - theory = Local_Theory.background_theory - , local_theory = K o K in_self - , local_theory' = K o K (fn f => in_self (f false)) - , keep = fn f => in_self (fn lthy => (f lthy ; lthy)) - , generic_theory = Context.proof_map - (* generic part *) - , context_of = context_of, dual = dual - , proof' = proof', proofs = proofs, proof = proof - , tr_report = report, tr_report_o = report_o - , pr_report = report, pr_report_o = report_o - (* irrelevant part *) - , begin_local_theory = K o not_used \<^here> - , local_theory_to_proof' = K o K not_used \<^here> - , local_theory_to_proof = K o K not_used \<^here> - , tr_raw = not_used \<^here> } - end) - x - val (env, thy) = - let - fun disp_time f x = - let val (s, r) = Timing.timing f x - val () = out_intensify (Timing.message s |> Markup.markup Markup.operator) "" in - r - end - in disp_time (fn x => aux x (env, thy)) (l_obj ()) end - in ((env, thy0), (thy, fn _ => get_all_meta_embed (SOME thy))) end) - l_shallow - (thy, case l_obj of SOME f => f | NONE => fn _ => get_all_meta_embed (SOME thy)) - |> META.map_prod I fst) - -fun thy_switch pos1 pos2 f mode tr = - ( ( mode - , Toplevel'.keep - (fn _ => Output.information ( "Theory required while transitions were being built" - ^ Position.here pos1 - ^ ": Commands will not be concurrently considered. " - ^ Markup.markup - (Markup.properties (Position.properties_of pos2) Markup.position) - "(Handled here\092<^here>)")) tr) - , f #~> Generation_mode.Data_gen.put) - -in - -fun outer_syntax_commands''' is_safe mk_string cmd_spec cmd_descr parser get_all_meta_embed = - let open Generation_mode in - Outer_Syntax.commands' cmd_spec cmd_descr - (parser >> (fn name => fn thy => fn _ => - (* WARNING: Whenever there would be errors raised by functions taking "thy" as input, - they will not be shown. - So the use of this "thy" can be considered as safe, as long as errors do not happen. *) - let - val get_all_m = get_all_meta_embed name - val m_tr = (Data_gen.get thy, []) - |-> mapM_syntax_print (META.mapM (fn n => - pair n - o cons (\<^command_keyword>\<open>print_syntax\<close>, - Toplevel'.keep_theory (fn thy => - writeln (mk_string - (Proof_Context.init_global - (case n of NONE => thy - | SOME n => Config.put_global ML_Print_Depth.print_depth n thy)) - name))))) - in let - val thy_o = is_safe thy - val l_obj = get_all_m thy_o - (* In principle, it is fine if (SOME thy) is provided to - get_all_m. However, because certain types of errors are most of the - time happening whenever certain specific operations depending on thy - are explicitly performed, and because get_all_m was intentionally set - to not interactively manage such errors, then these errors (whenever - they are happening) could possibly not appear in the output - window. Although the computation would be in any case interrupted as - usual (but with only minimal debugging information, such as a simple - red underlining color). - - Generally, whenever get_all_m is called during the evaluating commands - coming from generated files (which is not the case here, but will be - later), this restriction can normally be removed (i.e., by writing - (SOME thy)), as for the case of generated files, we are taking the - assumption that errors (if they are happening) are as hard to detect - as if an error was raised somewhere else by the generator itself. - Another assumption nevertheless related with the generator is that it - is supposed to explicitly not raise errors, however here this - get_all_m is not situated below a generating part. This is why we are - tempted to mostly give NONE to get_all_m, unless the calling command - is explicitly taking the responsibility of a potential failure. *) - val m_tr = m_tr - |-> thy_deep exec_deep Toplevel'.keep l_obj - in ( m_tr - |-> mapM_shallow (META.mapM (fn (env, thy_init) => fn acc => - let val (tps, disp_time) = disp_time Toplevel'.keep_output - fun aux thy_o = - fold_thy_shallow - (K (cons (Toplevel'.read_write_keep (Toplevel.Load_backup, Toplevel.Store_default)))) - (fn msg => fn l => - apsnd (disp_time msg) - #> Bind_META.all_meta_trs (aux thy_o o META.Fold_meta) - { context_of = Toplevel.context_of - , keep = Toplevel.keep - , generic_theory = Toplevel.generic_theory - , theory = Toplevel.theory - , begin_local_theory = Toplevel.begin_local_theory - , local_theory' = Toplevel.local_theory' - , local_theory = Toplevel.local_theory - , local_theory_to_proof' = Toplevel.local_theory_to_proof' - , local_theory_to_proof = Toplevel.local_theory_to_proof - , proof' = Toplevel.proof' - , proofs = Toplevel.proofs - , proof = Toplevel.proof - (* *) - , dual = #par, tr_raw = I - , tr_report = report, tr_report_o = report_o - , pr_report = report, pr_report_o = report_o } - thy_o - l) - in aux thy_o l_obj (env, acc) - |> META.map_prod - (fn env => (env, thy_init)) - (Toplevel'.keep_output tps Markup.operator "") end)) - , Data_gen.put) - handle THY_REQUIRED pos => - m_tr |-> thy_switch pos \<^here> (thy_shallow NONE get_all_m) - end - handle THY_REQUIRED pos => - m_tr |-> thy_switch pos \<^here> (fn mode => fn thy => - let val l_obj = get_all_m (SOME thy) in - (thy_deep (tap oo exec_deep0) tap l_obj - #~> thy_shallow (SOME (K l_obj)) get_all_m) mode thy - end) - end - |> uncurry Toplevel'.setup_theory)) - end -end - -fun outer_syntax_commands'' mk_string = outer_syntax_commands''' (K NONE) mk_string - -fun outer_syntax_commands' mk_string cmd_spec cmd_descr parser get_all_meta_embed = - outer_syntax_commands'' mk_string cmd_spec cmd_descr parser (META.Fold_meta oo get_all_meta_embed) - -fun outer_syntax_commands'2 mk_string cmd_spec cmd_descr parser get_all_meta_embed = - outer_syntax_commands''' SOME mk_string cmd_spec cmd_descr parser (META.Fold_meta oo get_all_meta_embed) -\<close> - -subsection\<open>Parameterizing the Semantics of Embedded Languages\<close> - -ML\<open> -val () = let open Generation_mode in - Outer_Syntax.commands' \<^command_keyword>\<open>generation_syntax\<close> "set the generating list" - (( mode >> (fn x => SOME [x]) - || parse_l' mode >> SOME - || \<^keyword>\<open>deep\<close> -- \<^keyword>\<open>flush_all\<close> >> K NONE) >> - (fn SOME x => K (K (f_command x)) - | NONE => fn thy => fn _ => [] - |> fold (fn (env, i_deep) => exec_deep i_deep (META.compiler_env_config_reset_all env)) - (#deep (Data_gen.get thy)) - |> (fn [] => Toplevel'.keep (fn _ => warning "Nothing performed.") [] - | l => l))) -end -\<close> - -subsection\<open>Common Parser for OCL\<close> - -ML\<open> -structure USE_parse = struct - datatype ('a, 'b) use_context = USE_context_invariant of 'a - | USE_context_pre_post of 'b - - fun optional f = Scan.optional (f >> SOME) NONE - val colon = Parse.$$$ ":" - fun repeat2 scan = scan ::: Scan.repeat1 scan - - fun xml_unescape s = YXML.content_of s |> Symbol_Pos.explode0 |> Symbol_Pos.implode |> From.string - - fun outer_syntax_commands2 mk_string cmd_spec cmd_descr parser v_true v_false get_all_meta_embed = - outer_syntax_commands' mk_string cmd_spec cmd_descr - (optional (paren \<^keyword>\<open>shallow\<close>) -- parser) - (fn (is_shallow, use) => fn thy => - get_all_meta_embed - (if is_shallow = NONE then - ( fn s => - META.T_to_be_parsed ( From.string s - , xml_unescape s) - , v_true) - else - (From.read_term thy, v_false)) - use) - - (* *) - - val ident_dot_dot = let val f = Parse.sym_ident >> (fn "\<bullet>" => "\<bullet>" | _ => Scan.fail "Syntax error") in - f -- f end - val ident_star = Parse.sym_ident (* "*" *) - - (* *) - - fun natural0 s = case Int.fromString s of SOME i => From.nat i - | NONE => Scan.fail "Syntax error" - - val natural = Parse.number >> natural0 - - val unlimited_natural = ident_star >> (fn "*" => META.Mult_star - | "\<infinity>" => META.Mult_infinity - | _ => Scan.fail "Syntax error") - || Parse.number >> (META.Mult_nat o natural0) - - val term_base = - Parse.number >> (META.OclDefInteger o From.string) - || Parse.float_number >> (META.OclDefReal o (From.pair From.string From.string o - (fn s => case String.tokens (fn #"." => true - | _ => false) s of [l1,l2] => (l1,l2) - | _ => Scan.fail "Syntax error"))) - || Parse.string >> (META.OclDefString o From.string) - - val multiplicity = parse_l' (unlimited_natural -- optional (ident_dot_dot |-- unlimited_natural)) - - fun uml_term x = - ( term_base >> META.ShallB_term - || Parse.binding >> (META.ShallB_str o From.binding) - || \<^keyword>\<open>self\<close> |-- Parse.nat >> (fn n => META.ShallB_self (From.internal_oid n)) - || paren (Parse.list uml_term) >> (* untyped, corresponds to Set, Sequence or Pair *) - (* WARNING for Set: we are describing a finite set *) - META.ShallB_list) x - - val name_object = optional (Parse.list1 Parse.binding --| colon) -- Parse.binding - - val type_object_weak = - let val name_object = Parse.binding >> (fn s => (NONE, s)) in - name_object -- Scan.repeat (Parse.$$$ "<" |-- Parse.list1 name_object) >> - let val f = fn (_, s) => META.OclTyCore_pre (From.binding s) in - fn (s, l) => META.OclTyObj (f s, map (map f) l) - end - end - - val type_object = name_object -- Scan.repeat (Parse.$$$ "<" |-- Parse.list1 name_object) >> - let val f = fn (_, s) => META.OclTyCore_pre (From.binding s) in - fn (s, l) => META.OclTyObj (f s, map (map f) l) - end - - val category = - multiplicity - -- optional (\<^keyword>\<open>Role\<close> |-- Parse.binding) - -- Scan.repeat ( \<^keyword>\<open>Ordered\<close> >> K META.Ordered0 - || \<^keyword>\<open>Subsets\<close> |-- Parse.binding >> K META.Subsets0 - || \<^keyword>\<open>Union\<close> >> K META.Union0 - || \<^keyword>\<open>Redefines\<close> |-- Parse.binding >> K META.Redefines0 - || \<^keyword>\<open>Derived\<close> -- Parse.$$$ "=" |-- Parse.term >> K META.Derived0 - || \<^keyword>\<open>Qualifier\<close> |-- Parse.term >> K META.Qualifier0 - || \<^keyword>\<open>Nonunique\<close> >> K META.Nonunique0 - || \<^keyword>\<open>Sequence_\<close> >> K META.Sequence) >> - (fn ((l_mult, role), l) => - META.Ocl_multiplicity_ext (l_mult, From.option From.binding role, l, ())) - - val type_base = Parse.reserved "Void" >> K META.OclTy_base_void - || Parse.reserved "Boolean" >> K META.OclTy_base_boolean - || Parse.reserved "Integer" >> K META.OclTy_base_integer - || Parse.reserved "UnlimitedNatural" >> K META.OclTy_base_unlimitednatural - || Parse.reserved "Real" >> K META.OclTy_base_real - || Parse.reserved "String" >> K META.OclTy_base_string - - fun use_type_gen type_object v = - ((* collection *) - Parse.reserved "Set" |-- use_type >> - (fn l => META.OclTy_collection (META.Ocl_multiplicity_ext ([], NONE, [META.Set], ()), l)) - || Parse.reserved "Sequence" |-- use_type >> - (fn l => META.OclTy_collection (META.Ocl_multiplicity_ext ([], NONE, [META.Sequence], ()), l)) - || category -- use_type >> META.OclTy_collection - - (* pair *) - || Parse.reserved "Pair" |-- - ( use_type -- use_type - || Parse.$$$ "(" |-- use_type --| Parse.$$$ "," -- use_type --| Parse.$$$ ")") >> META.OclTy_pair - - (* base *) - || type_base - - (* raw HOL *) - || Parse.sym_ident (* "\<acute>" *) |-- Parse.typ --| Parse.sym_ident (* "\<acute>" *) >> - (META.OclTy_raw o xml_unescape) - - (* object type *) - || type_object >> META.OclTy_object - - || ((Parse.$$$ "(" |-- Parse.list ( (Parse.binding --| colon >> (From.option From.binding o SOME)) - -- ( Parse.$$$ "(" |-- use_type --| Parse.$$$ ")" - || use_type_gen type_object_weak) >> META.OclTy_binding - ) --| Parse.$$$ ")" - >> (fn ty_arg => case rev ty_arg of - [] => META.OclTy_base_void - | ty_arg => fold (fn x => fn acc => META.OclTy_pair (x, acc)) - (tl ty_arg) - (hd ty_arg))) - -- optional (colon |-- use_type)) - >> (fn (ty_arg, ty_out) => case ty_out of NONE => ty_arg - | SOME ty_out => META.OclTy_arrow (ty_arg, ty_out)) - || (Parse.$$$ "(" |-- use_type --| Parse.$$$ ")" >> (fn s => META.OclTy_binding (NONE, s)))) v - and use_type x = use_type_gen type_object x - - val use_prop = - (optional (optional (Parse.binding >> From.binding) --| Parse.$$$ ":") >> (fn NONE => NONE - | SOME x => x)) - -- Parse.term --| optional (Parse.$$$ ";") >> (fn (n, e) => fn from_expr => - META.OclProp_ctxt (n, from_expr e)) - - (* *) - - val association_end = - type_object - -- category - --| optional (Parse.$$$ ";") - - val association = optional \<^keyword>\<open>Between\<close> |-- Scan.optional (repeat2 association_end) [] - - val invariant = - optional \<^keyword>\<open>Constraints\<close> - |-- Scan.optional (\<^keyword>\<open>Existential\<close> >> K true) false - --| \<^keyword>\<open>Inv\<close> - -- use_prop - - structure Outer_syntax_Association = struct - fun make ass_ty l = META.Ocl_association_ext (ass_ty, META.OclAssRel l, ()) - end - - (* *) - - val context = - Scan.repeat - (( optional (\<^keyword>\<open>Operations\<close> || Parse.$$$ "::") - |-- Parse.binding - -- use_type - --| optional (Parse.$$$ "=" |-- Parse.term || Parse.term) - -- Scan.repeat - ( (\<^keyword>\<open>Pre\<close> || \<^keyword>\<open>Post\<close>) - -- use_prop >> USE_context_pre_post - || invariant >> USE_context_invariant) - --| optional (Parse.$$$ ";")) >> - (fn ((name_fun, ty), expr) => fn from_expr => - META.Ctxt_pp - (META.Ocl_ctxt_pre_post_ext - ( From.binding name_fun - , ty - , From.list (fn USE_context_pre_post (pp, expr) => - META.T_pp (if pp = "Pre" then - META.OclCtxtPre - else - META.OclCtxtPost, expr from_expr) - | USE_context_invariant (b, expr) => - META.T_invariant (META.T_inv (b, expr from_expr))) expr - , ()))) - || - invariant >> (fn (b, expr) => fn from_expr => META.Ctxt_inv (META.T_inv (b, expr from_expr)))) - - val class = - optional \<^keyword>\<open>Attributes\<close> - |-- Scan.repeat (Parse.binding --| colon -- use_type - --| optional (Parse.$$$ ";")) - -- context - - datatype use_classDefinition = USE_class | USE_class_abstract - datatype ('a, 'b) use_classDefinition_content = USE_class_content of 'a | USE_class_synonym of 'b - - structure Outer_syntax_Class = struct - fun make from_expr abstract ty_object attribute oper = - META.Ocl_class_raw_ext - ( ty_object - , From.list (From.pair From.binding I) attribute - , From.list (fn f => f from_expr) oper - , abstract - , ()) - end - - (* *) - - val term_object = parse_l_with ( optional ( Parse.$$$ "(" - |-- Parse.binding - --| Parse.$$$ "," - -- Parse.binding - --| Parse.$$$ ")" - --| (Parse.sym_ident >> (fn "|=" => Scan.succeed - | _ => Scan.fail ""))) - -- Parse.binding - -- ( Parse.$$$ "=" - |-- uml_term)) - - val list_attr' = term_object >> (fn res => (res, [] : binding list)) - fun object_cast e = - ( annot_ty term_object - -- Scan.repeat ( (Parse.sym_ident >> (fn "->" => Scan.succeed - | "\<leadsto>" => Scan.succeed - | "\<rightarrow>" => Scan.succeed - | _ => Scan.fail "")) - |-- ( Parse.reserved "oclAsType" - |-- Parse.$$$ "(" - |-- Parse.binding - --| Parse.$$$ ")" - || Parse.binding)) >> (fn ((res, x), l) => (res, rev (x :: l)))) e - val object_cast' = object_cast >> (fn (res, l) => (res, rev l)) - - fun get_oclinst l = - META.OclInstance (map (fn ((name,typ), ((l_attr_with, l_attr), is_cast)) => - let val f = map (fn ((pre_post, attr), data) => - ( From.option (From.pair From.binding From.binding) pre_post - , ( From.binding attr - , data))) - val l_attr = - fold - (fn b => fn acc => META.OclAttrCast (From.binding b, acc, [])) - is_cast - (META.OclAttrNoCast (f l_attr)) in - META.Ocl_instance_single_ext - ( From.option From.binding name - , From.option From.binding typ - , From.option From.binding l_attr_with - , l_attr - , ()) end) l) - - val parse_instance = (Parse.binding >> SOME) - -- optional (\<^keyword>\<open>::\<close> |-- Parse.binding) --| \<^keyword>\<open>=\<close> - -- (list_attr' || object_cast') - - (* *) - - datatype state_content = - ST_l_attr of (binding option * (((binding * binding) option * binding) * META.ocl_data_shallow) list) * binding list - | ST_binding of binding - - val state_parse = parse_l' ( object_cast >> ST_l_attr - || Parse.binding >> ST_binding) - - val mk_state = - map (fn ST_l_attr l => - META.OclDefCoreAdd - (case get_oclinst (map (fn (l_i, l_ty) => - ((NONE, SOME (hd l_ty)), (l_i, rev (tl l_ty)))) [l]) of - META.OclInstance [x] => x) - | ST_binding b => META.OclDefCoreBinding (From.binding b)) - - (* *) - - datatype state_pp_content = ST_PP_l_attr of state_content list - | ST_PP_binding of binding - - val state_pp_parse = state_parse >> ST_PP_l_attr - || Parse.binding >> ST_PP_binding - - val mk_pp_state = fn ST_PP_l_attr l => META.OclDefPPCoreAdd (mk_state l) - | ST_PP_binding s => META.OclDefPPCoreBinding (From.binding s) - - (* *) - - fun optional_b key = Scan.optional (key >> K true) false - val haskell_parse = Scan.optional let fun k x = K (true, From.nat x) - in \<^keyword>\<open>datatype_old\<close> >> k 0 - || \<^keyword>\<open>datatype_old_atomic\<close> >> k 1 - || \<^keyword>\<open>datatype_old_atomic_sub\<close> >> k 2 end - (false, From.nat 0) - -- optional_b \<^keyword>\<open>try_import\<close> - -- optional_b \<^keyword>\<open>only_types\<close> - -- optional_b \<^keyword>\<open>ignore_not_in_scope\<close> - -- optional_b \<^keyword>\<open>abstract_mutual_data_params\<close> - -- optional_b \<^keyword>\<open>concat_modules\<close> - -- Scan.option (\<^keyword>\<open>base_path\<close> |-- Parse.position Parse.path) - -- Scan.optional (parse_l' (Parse.name -- Scan.option ((\<^keyword>\<open>\<rightharpoonup>\<close> || \<^keyword>\<open>=>\<close>) |-- Parse.name))) [] -end -\<close> - -subsection\<open>Setup of Meta Commands for a Generic Usage: @{command meta_command}, @{command meta_command'}\<close> - -ML\<open> -local - fun outer_syntax_commands'''2 command_keyword meta_command = - outer_syntax_commands''' SOME \<^mk_string> command_keyword "" - Parse.ML_source - (fn source => - get_thy \<^here> (meta_command (Input.source_content source) #> META.Fold_custom)) -in -val () = outer_syntax_commands'''2 \<^command_keyword>\<open>meta_command\<close> Bind_META.meta_command -val () = outer_syntax_commands'''2 \<^command_keyword>\<open>meta_command'\<close> Generation_mode.meta_command -end -\<close> - -subsection\<open>Setup of Meta Commands for OCL: @{command Enum}\<close> - -ML\<open> -val () = - outer_syntax_commands' \<^mk_string> \<^command_keyword>\<open>Enum\<close> "" - (Parse.binding -- parse_l1' Parse.binding) - (fn (n1, n2) => - K (META.META_enum (META.OclEnum (From.binding n1, From.list From.binding n2)))) -\<close> - -subsection\<open>Setup of Meta Commands for OCL: (abstract) @{command Class}\<close> - -ML\<open> -local - open USE_parse - - fun mk_classDefinition abstract cmd_spec = - outer_syntax_commands2 \<^mk_string> cmd_spec "Class generation" - ( Parse.binding --| Parse.$$$ "=" -- USE_parse.type_base >> USE_class_synonym - || type_object - -- class >> USE_class_content) - (curry META.META_class_raw META.Floor1) - (curry META.META_class_raw META.Floor2) - (fn (from_expr, META_class_raw) => - fn USE_class_content (ty_object, (attribute, oper)) => - META_class_raw (Outer_syntax_Class.make - from_expr - (abstract = USE_class_abstract) - ty_object - attribute - oper) - | USE_class_synonym (n1, n2) => - META.META_class_synonym (META.OclClassSynonym (From.binding n1, n2))) -in -val () = mk_classDefinition USE_class \<^command_keyword>\<open>Class\<close> -val () = mk_classDefinition USE_class_abstract \<^command_keyword>\<open>Abstract_class\<close> -end -\<close> - -subsection\<open>Setup of Meta Commands for OCL: @{command Association}, @{command Composition}, @{command Aggregation}\<close> - -ML\<open> -local - open USE_parse - - fun mk_associationDefinition ass_ty cmd_spec = - outer_syntax_commands' \<^mk_string> cmd_spec "" - ( repeat2 association_end - || optional Parse.binding - |-- association) - (K o META.META_association o Outer_syntax_Association.make ass_ty) -in -val () = mk_associationDefinition META.OclAssTy_association \<^command_keyword>\<open>Association\<close> -val () = mk_associationDefinition META.OclAssTy_composition \<^command_keyword>\<open>Composition\<close> -val () = mk_associationDefinition META.OclAssTy_aggregation \<^command_keyword>\<open>Aggregation\<close> -end -\<close> - -subsection\<open>Setup of Meta Commands for OCL: (abstract) @{command Associationclass}\<close> - -ML\<open> - -local - open USE_parse - - datatype use_associationClassDefinition = USE_associationclass | USE_associationclass_abstract - - fun mk_associationClassDefinition abstract cmd_spec = - outer_syntax_commands2 \<^mk_string> cmd_spec "" - ( type_object - -- association - -- class - -- optional (Parse.reserved "aggregation" || Parse.reserved "composition")) - (curry META.META_ass_class META.Floor1) - (curry META.META_ass_class META.Floor2) - (fn (from_expr, META_ass_class) => - fn (((ty_object, l_ass), (attribute, oper)), assty) => - META_ass_class - (META.OclAssClass - ( Outer_syntax_Association.make - (case assty of SOME "aggregation" => META.OclAssTy_aggregation - | SOME "composition" => META.OclAssTy_composition - | _ => META.OclAssTy_association) - l_ass - , Outer_syntax_Class.make - from_expr - (abstract = USE_associationclass_abstract) - ty_object - attribute - oper))) -in -val () = mk_associationClassDefinition USE_associationclass \<^command_keyword>\<open>Associationclass\<close> -val () = mk_associationClassDefinition USE_associationclass_abstract \<^command_keyword>\<open>Abstract_associationclass\<close> -end -\<close> - -subsection\<open>Setup of Meta Commands for OCL: @{command Context}\<close> - -ML\<open> -local - open USE_parse -in -val () = - outer_syntax_commands2 \<^mk_string> \<^command_keyword>\<open>Context\<close> "" - (optional (Parse.list1 Parse.binding --| colon) - -- Parse.binding - -- context) - (curry META.META_ctxt META.Floor1) - (curry META.META_ctxt META.Floor2) - (fn (from_expr, META_ctxt) => - (fn ((l_param, name), l) => - META_ctxt - (META.Ocl_ctxt_ext - ( case l_param of NONE => [] | SOME l => From.list From.binding l - , META.OclTyObj (META.OclTyCore_pre (From.binding name), []) - , From.list (fn f => f from_expr) l - , ())))) -end -\<close> - -subsection\<open>Setup of Meta Commands for OCL: @{command End}\<close> - -ML\<open> -val () = - outer_syntax_commands'' \<^mk_string> \<^command_keyword>\<open>End\<close> "Class generation" - (Scan.optional ( Parse.$$$ "[" -- Parse.reserved "forced" -- Parse.$$$ "]" >> K true - || Parse.$$$ "!" >> K true) false) - (fn b => - K (if b then - META.Fold_meta (META.META_flush_all META.OclFlushAll) - else - META.Fold_custom [])) -\<close> - -subsection\<open>Setup of Meta Commands for OCL: @{command BaseType}, @{command Instance}, @{command State}\<close> - -ML\<open> -val () = - outer_syntax_commands' \<^mk_string> \<^command_keyword>\<open>BaseType\<close> "" - (parse_l' USE_parse.term_base) - (K o META.META_def_base_l o META.OclDefBase) - -local - open USE_parse -in -val () = - outer_syntax_commands' \<^mk_string> \<^command_keyword>\<open>Instance\<close> "" - (Scan.optional (parse_instance -- Scan.repeat (optional \<^keyword>\<open>and\<close> |-- parse_instance) >> - (fn (x, xs) => x :: xs)) []) - (K o META.META_instance o get_oclinst) - -val () = - outer_syntax_commands' \<^mk_string> \<^command_keyword>\<open>State\<close> "" - (USE_parse.optional (paren \<^keyword>\<open>shallow\<close>) -- Parse.binding --| \<^keyword>\<open>=\<close> - -- state_parse) - (fn ((is_shallow, name), l) => - (K o META.META_def_state) - ( if is_shallow = NONE then META.Floor1 else META.Floor2 - , META.OclDefSt (From.binding name, mk_state l))) -end -\<close> - -subsection\<open>Setup of Meta Commands for OCL: @{command Transition}\<close> - -ML\<open> -local - open USE_parse -in -val () = - outer_syntax_commands' \<^mk_string> \<^command_keyword>\<open>Transition\<close> "" - (USE_parse.optional (paren \<^keyword>\<open>shallow\<close>) - -- USE_parse.optional (Parse.binding --| \<^keyword>\<open>=\<close>) - -- state_pp_parse - -- USE_parse.optional state_pp_parse) - (fn (((is_shallow, n), s_pre), s_post) => - (K o META.META_def_transition) - ( if is_shallow = NONE then META.Floor1 else META.Floor2 - , META.OclDefPP ( From.option From.binding n - , mk_pp_state s_pre - , From.option mk_pp_state s_post))) -end -\<close> - -subsection\<open>Setup of Meta Commands for OCL: @{command Tree}\<close> - -ML\<open> -local - open USE_parse -in -val () = - outer_syntax_commands' \<^mk_string> \<^command_keyword>\<open>Tree\<close> "" - (natural -- natural) - (K o META.META_class_tree o META.OclClassTree) -end -\<close> - -subsection\<open>Setup of Meta Commands for Haskabelle: @{command Haskell}, @{command Haskell_file}\<close> - -ML\<open> -structure Haskabelle_Data = Theory_Data - (open META - type T = module list * ((Code_Numeral.natural * Code_Numeral.natural) * (abr_string * (abr_string * abr_string) list)) list list - val empty = ([], []) - val extend = I - val merge = #2) - -local - fun haskabelle_path hkb_home l = Path.appends (Path.variable hkb_home :: map Path.explode l) - val haskabelle_bin = haskabelle_path "HASKABELLE_HOME" ["bin", "haskabelle_bin"] - val haskabelle_default = haskabelle_path "HASKABELLE_HOME_USER" ["default"] -in - fun parse meta_parse_shallow meta_parse_imports meta_parse_code meta_parse_functions hsk_name check_dir hsk_str ((((((((old_datatype, try_import), only_types), ignore_not_in_scope), abstract_mutual_data_params), concat_modules), base_path_abs), l_rewrite), (content, pos)) thy = - let fun string_of_bool b = if b then "true" else "false" - val st = - Bash.process - (space_implode " " - ( [ Path.implode haskabelle_bin - , "--internal", Path.implode haskabelle_default - , "--export", "false" - , "--try-import", string_of_bool try_import - , "--only-types", string_of_bool only_types - , "--base-path-abs", case base_path_abs of NONE => "" | SOME s => check_dir thy s - , "--ignore-not-in-scope", string_of_bool ignore_not_in_scope - , "--abstract-mutual-data-params", string_of_bool abstract_mutual_data_params - , "--dump-output" - , "--meta-parse-shallow", string_of_bool meta_parse_shallow - , "--meta-parse-load"] @ map_filter (fn (true, s) => SOME (Bash.string s) | _ => NONE) meta_parse_imports @ - [ "--meta-parse-imports"] @ map (Bash.string o snd) meta_parse_imports @ - [ "--meta-parse-code" ] @ map Bash.string (the_list meta_parse_code) @ - [ "--hsk-name" ] @ the_list hsk_name - @ (case - if hsk_str then - ([ Bash.string content ], []) - else - ([], [ Resources'.check_path' (SOME File.check_file) (Proof_Context.init_global thy) Path.current (content, pos) ]) - of (cts, files) => List.concat [ ["--hsk-contents"], cts, ["--files"], files ]))) - in - if #rc st = 0 then - Bind_META.meta_command0 "Haskabelle_Data.put" Haskabelle_Data.get (#out st) thy - |> (fn (l_mod, l_rep) => - let - val _ = - List.app - (fn l_rep => - let fun advance_offset n = - if n = 0 then I - else fn (x :: xs, p) => - advance_offset (n - String.size x) (xs, Position.advance x p) - val l_rep = - fold (fn ((offset, end_offset), (markup, prop)) => fn (content, (pos, pos_o), acc) => - let val offset = To_nat offset - val end_offset = To_nat end_offset - val (content, pos0) = advance_offset (offset - pos_o) (content, pos) - val (content, pos1) = advance_offset (end_offset - offset) (content, pos0) - in ( content - , (pos1, end_offset) - , ( Position.range_position (pos0, pos1) - , (To_string0 markup, map (META.map_prod To_string0 To_string0) prop)) - :: acc) - end) - l_rep - (Symbol.explode content, (Position.advance_offsets 1 pos, 0), []) - |> #3 - in Position.reports l_rep end) - l_rep - in l_mod |> (fn m => META.IsaUnit ( old_datatype - , map (META.map_prod From.string (Option.map From.string)) l_rewrite - , meta_parse_functions - , From.string (Context.theory_name thy) - , (m, concat_modules))) - |> META.META_haskell end) - |> tap (fn _ => warning (#err st)) - else - let val _ = #terminate st () - in error (if #err st = "" then - "Failed executing the ML process (" ^ Int.toString (#rc st) ^ ")" - else #err st |> String.explode |> trim (fn #"\n" => true | _ => false) |> String.implode) end - end - val parse' = parse false [] NONE META.Gen_no_apply NONE Resources'.check_dir -end - -local - type haskell_parse = - (((((((bool * Code_Numeral.natural) * bool) * bool) * bool) * bool) * bool) * (string * Position.T) option) - * (string * string option) list - - structure Data_lang = Theory_Data - (type T = (haskell_parse * string option * (bool * string) list * string * (META.abr_string -> META.gen_meta)) Name_Space.table - val empty = Name_Space.empty_table "meta_language" - val extend = I - val merge = Name_Space.merge_tables) - - open USE_parse -in -val () = - outer_syntax_commands'2 \<^mk_string> \<^command_keyword>\<open>Haskell\<close> "" - (haskell_parse -- Parse.position Parse.cartouche) - (get_thy \<^here> o parse' true) - -val () = - outer_syntax_commands'2 \<^mk_string> \<^command_keyword>\<open>Haskell_file\<close> "" - (haskell_parse -- Parse.position Parse.path) - (get_thy \<^here> o parse' false) - -val () = - Outer_Syntax.command \<^command_keyword>\<open>meta_language\<close> "" - (Parse.binding - -- haskell_parse - -- Scan.optional - (Parse.where_ |-- Parse.$$$ "imports" - |-- Parse.!!! - (Scan.repeat1 (Parse.cartouche >> pair false - || Parse.$$$ "(" - |-- Parse.$$$ "load" - |-- Parse.cartouche --| Parse.$$$ ")" >> pair true))) [] - --| Parse.where_ --| Parse.$$$ "defines" -- Parse.cartouche - -- Scan.optional ( Parse.where_ - |-- Parse.$$$ "functions" - |-- let val parse_name = Parse.name >> From.string in - \<^keyword>\<open>meta\<close> |-- parse_name >> (K o META.Gen_apply_sml) - || \<^keyword>\<open>meta_cmd\<close> |-- parse_name >> curry META.Gen_apply_sml_cmd - || parse_name >> (K o META.Gen_apply_hol) - end) - (K META.Gen_no_apply) - >> (fn ((((lang, hsk_arg as ((_, base_path), _)), imports), defines), functions) => - let val _ = if exists (fn #"\n" => true | _ => false) (String.explode defines) then - error "Haskell indentation rules are not yet supported" - else () - in Toplevel.theory - (fn thy => - Data_lang.map - (#2 o Name_Space.define - (Context.Theory thy) - true - (lang, (hsk_arg, Option.map (Resources'.check_dir thy) base_path, imports, defines, functions))) - thy) - end)) - -val () = - outer_syntax_commands'2 \<^mk_string> \<^command_keyword>\<open>language\<close> "" - (Scan.optional (\<^keyword>\<open>meta\<close> >> K true) false - -- Parse.binding --| Parse.$$$ "::" -- Parse.position Parse.name --| Parse.where_ -- Parse.position Parse.cartouche) - (fn (((is_shallow, prog), lang), code) => - get_thy \<^here> - (fn thy => - let val (_, (hsk_arg, hsk_path, imports, defines, functions)) = - Name_Space.check (Context.Theory thy) (Data_lang.get thy) lang - val prog' = Binding.name_of prog - in parse is_shallow - imports - (SOME defines) - (functions (From.string prog')) - (SOME prog') - (K (K (case hsk_path of NONE => "" | SOME s => s))) - true - (hsk_arg, code) - thy - end)) -end -(*val _ = print_depth 100*) -\<close> - -end diff --git a/Citadelle/src/compiler/Generator_dynamic_export_testing.thy b/Citadelle/src/compiler/Generator_dynamic_export_testing.thy deleted file mode 100644 index 27cdfb5eb450a9993c0f36dbda3a1697478abde0..0000000000000000000000000000000000000000 --- a/Citadelle/src/compiler/Generator_dynamic_export_testing.thy +++ /dev/null @@ -1,1726 +0,0 @@ -(****************************************************************************** - * Citadelle - * - * 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. - ******************************************************************************) - -section\<open>Dynamic Meta Embedding with Reflection\<close> - -theory Generator_dynamic_export_testing -imports "FOCL.Printer" - "FOCL.Isabelle_Main2" - "FOCL.Old_Datatype" - keywords (* OCL (USE tool) *) - "Between" - "Attributes" "Operations" "Constraints" - "Role" - "Ordered" "Subsets" "Union" "Redefines" "Derived" "Qualifier" - "Existential" "Inv" "Pre" "Post" - (* OCL (added) *) - "self" - "Nonunique" "Sequence_" - "with_only" - (* Haskabelle *) - "datatype_old" "datatype_old_atomic" "datatype_old_atomic_sub" - "try_import" "only_types" "base_path" "ignore_not_in_scope" "abstract_mutual_data_params" - "concat_modules" "load" "meta" "meta_cmd" - - (* Isabelle syntax *) - "output_directory" - "THEORY" "IMPORTS" "SECTION" "SORRY" "no_dirty" - "deep" "shallow" "syntax_print" "skip_export" - "generation_semantics" - "flush_all" - - (* Isabelle semantics (parameterizing the semantics of OCL) *) - "design" "analysis" "oid_start" - - and (* Isabelle syntax *) - "generation_syntax" - - :: thy_decl -begin - -text\<open>In the ``dynamic'' solution: the exportation is automatically handled inside Isabelle/jEdit. -Inputs are provided using the syntax of OCL, and in output -we basically have two options: -\begin{itemize} -\item The first is to generate an Isabelle file for inspection or debugging. -The generated file can interactively be loaded in Isabelle/jEdit, or saved to the hard disk. -This mode is called the ``deep exportation'' mode or shortly the ``deep'' mode. -The aim is to maximally automate the process one is manually performing in -\<^file>\<open>Generator_static.thy\<close>. -\item On the other hand, it is also possible to directly execute -in Isabelle/jEdit the generated file from the random access memory. -This mode corresponds to the ``shallow reflection'' mode or shortly ``shallow'' mode. -\end{itemize} -In both modes, the reflection is necessary since the main part used by both -was defined at Isabelle side. -As a consequence, experimentations in ``deep'' and ``shallow'' are performed -without leaving the editing session, in the same as the one the meta-compiler is actually running.\<close> - -apply_code_printing_reflect \<open> - val stdout_file = Unsynchronized.ref "" -\<close> text\<open>This variable is not used in this theory (only in \<^file>\<open>Generator_static.thy\<close>), - but needed for well typechecking the reflected SML code.\<close> - -code_reflect' open META - functions (* executing the compiler as monadic combinators for deep and shallow *) - fold_thy_deep fold_thy_shallow - - (* printing the HOL AST to (shallow Isabelle) string *) - write_file0 write_file - - (* manipulating the compiling environment *) - compiler_env_config_reset_all - compiler_env_config_update - oidInit - D_output_header_thy_update - map2_ctxt_term - check_export_code - - (* printing the input AST to (deep Isabelle) string *) - isabelle_apply isabelle_of_compiler_env_config - -subsection\<open>Interface Between the Reflected and the Native\<close> - -ML\<open> -val To_string0 = META.meta_of_logic -val To_nat = Code_Numeral.integer_of_natural - -exception THY_REQUIRED of Position.T -fun get_thy pos f = fn NONE => raise (THY_REQUIRED pos) | SOME thy => f thy - -infix 1 #~> |>:: -fun f #~> g = uncurry g oo f -fun x |>:: f = cons f x -\<close> - -ML\<open> -structure From = struct - val string = META.SS_base o META.ST - val binding = string o Binding.name_of - (*fun term ctxt s = string (YXML.content_of (Syntax.string_of_term ctxt s))*) - val nat = Code_Numeral.natural_of_integer - val internal_oid = META.Oid o nat - val option = Option.map - val list = List.map - fun pair f1 f2 (x, y) = (f1 x, f2 y) - fun pair3 f1 f2 f3 (x, y, z) = (f1 x, f2 y, f3 z) - - structure Pure = struct - val indexname = pair string nat - val class = string - val sort = list class - fun typ e = (fn - Type (s, l) => (META.Typea o pair string (list typ)) (s, l) - | TFree (s, s0) => (META.TFree o pair string sort) (s, s0) - | TVar (i, s0) => (META.TVara o pair indexname sort) (i, s0) - ) e - fun term e = (fn - Const (s, t) => (META.Consta o pair string typ) (s, t) - | Free (s, t) => (META.Free o pair string typ) (s, t) - | Var (i, t) => (META.Var o pair indexname typ) (i, t) - | Bound i => (META.Bound o nat) i - | Abs (s, ty, t) => (META.Absa o pair3 string typ term) (s, ty, t) - | op $ (term1, term2) => (META.Appa o pair term term) (term1, term2) - ) e - end - - fun read_term thy expr = - META.T_pure (Pure.term (Syntax.read_term (get_thy \<^here> Proof_Context.init_global thy) expr), SOME (string expr)) -end -\<close> - -ML\<open> -fun List_mapi f = META.mapi (f o To_nat) -fun out_intensify s1 s2 = Output.state ((s1 |> Markup.markup Markup.intensify) ^ s2) -fun out_intensify' tps fmt = out_intensify (Timing.message (Timing.result tps) |> Markup.markup fmt) - -structure Toplevel' = struct - fun keep_theory f = Toplevel.keep (f o Toplevel.theory_of) - fun keep f tr = (\<^command_keyword>\<open>print_syntax\<close>, Toplevel.keep f) :: tr - fun read_write_keep rw = (\<^command_keyword>\<open>setup\<close>, fn tr => tr |> Toplevel.read_write rw |> Toplevel.keep (K ())) - fun setup_theory (res, tr) f = rev ((\<^command_keyword>\<open>setup\<close>, Toplevel.theory (f res)) :: tr) - fun keep_output tps fmt msg = cons (\<^command_keyword>\<open>print_syntax\<close>, Toplevel.keep (fn _ => out_intensify' tps fmt msg)) -end - -structure Resources' = struct - fun check_path' check_file ctxt dir (name, pos) = - let - fun err msg pos = error (msg ^ Position.here pos) - val _ = Context_Position.report ctxt pos Markup.language_path; - - val path = Path.append dir (Path.explode name) handle ERROR msg => err msg pos; - val path' = Path.expand path handle ERROR msg => err msg pos; - val _ = Context_Position.report ctxt pos (Markup.path (Path.smart_implode path)); - val _ = - (case check_file of - NONE => path - | SOME check => (check path handle ERROR msg => err msg pos)); - in Path.implode path' end - - fun check_dir thy = check_path' (SOME File.check_dir) - (Proof_Context.init_global thy) - (Resources.master_directory thy) -end -\<close> - -ML\<open> -structure Ty' = struct -fun check l_oid l = - let val Mp = META.map_prod - val Me = String.explode - val Mi = String.implode - val Ml = map in - META.check_export_code - (writeln o Mi) - (warning o Mi) - (fn s => writeln (Markup.markup (Markup.bad ()) (Mi s))) - (error o To_string0) - (Ml (Mp I Me) l_oid) - ((META.SS_base o META.ST) l) - end -end -\<close> - -subsection\<open>Binding of the Reflected API to the Native API\<close> - -ML\<open> -structure META_overload = struct - val of_semi__typ = META.of_semi_typ To_string0 - val of_semi__term = META.of_semi_terma To_string0 - val of_semi__term' = META.of_semi_term To_string0 - val fold = fold -end -\<close> - -ML\<open> -type ('a, 'b) toplevel_dual = { par: 'a, seq: 'b } -type ('transitionM, 'Proof_stateM, 'state) toplevel = - { context_of: 'state -> local_theory - - , keep: ('state -> unit) -> 'transitionM - , generic_theory: (generic_theory -> generic_theory) -> 'transitionM - , theory: (theory -> theory) -> 'transitionM - , begin_local_theory: bool -> (theory -> local_theory) -> 'transitionM - , local_theory': (bool * Position.T) option -> (xstring * Position.T) option -> - (bool -> local_theory -> local_theory) -> 'transitionM - , local_theory: (bool * Position.T) option -> (xstring * Position.T) option -> - (local_theory -> local_theory) -> 'transitionM - , local_theory_to_proof': (bool * Position.T) option -> (xstring * Position.T) option -> - (bool -> local_theory -> Proof.state) -> 'transitionM - , local_theory_to_proof: (bool * Position.T) option -> (xstring * Position.T) option -> - (local_theory -> Proof.state) -> 'transitionM - , proof': (bool -> Proof.state -> Proof.state) -> 'Proof_stateM - , proofs: (Proof.state -> Proof.state Seq.result Seq.seq) -> 'Proof_stateM - , proof: (Proof.state -> Proof.state) -> 'Proof_stateM - (* *) - , tr_report: Method.text_range -> 'transitionM -> 'transitionM - , tr_report_o: Method.text_range option -> 'transitionM -> 'transitionM - , tr_raw: (Toplevel.transition -> Toplevel.transition) -> 'transitionM - , pr_report: Method.text_range -> 'Proof_stateM -> 'Proof_stateM - , pr_report_o: Method.text_range option -> 'Proof_stateM -> 'Proof_stateM - , dual: (Toplevel.transition -> Toplevel.transition, Proof.state -> Proof.state) toplevel_dual -> 'Proof_stateM } - -structure Bind_Isabelle = struct -fun To_binding s = Binding.make (s, Position.none) -val To_sbinding = To_binding o To_string0 - -fun semi__method_simp g f = Method.Basic (fn ctxt => SIMPLE_METHOD (g (asm_full_simp_tac (f ctxt)))) -val semi__method_simp_one = semi__method_simp (fn f => f 1) -val semi__method_simp_all = semi__method_simp (CHANGED_PROP o PARALLEL_GOALS o ALLGOALS) - -datatype semi__thm' = Thms_single' of thm - | Thms_mult' of thm list - -fun semi__thm_attribute ctxt = let open META open META_overload val S = fn Thms_single' t => t in - fn Thm_thm s => Thms_single' (Proof_Context.get_thm ctxt (To_string0 s)) - | Thm_thms s => Thms_mult' (Proof_Context.get_thms ctxt (To_string0 s)) - | Thm_THEN (e1, e2) => - (case (semi__thm_attribute ctxt e1, semi__thm_attribute ctxt e2) of - (Thms_single' e1, Thms_single' e2) => Thms_single' (e1 RSN (1, e2)) - | (Thms_mult' e1, Thms_mult' e2) => Thms_mult' (e1 RLN (1, e2))) - | Thm_simplified (e1, e2) => - Thms_single' (asm_full_simplify (clear_simpset ctxt addsimps [S (semi__thm_attribute ctxt e2)]) - (S (semi__thm_attribute ctxt e1))) - | Thm_OF (e1, e2) => - Thms_single' ([S (semi__thm_attribute ctxt e2)] MRS (S (semi__thm_attribute ctxt e1))) - | Thm_where (nth, l) => - Thms_single' (Rule_Insts.where_rule - ctxt - (List.map (fn (var, expr) => - (((To_string0 var, 0), Position.none), of_semi__term expr)) l) - [] - (S (semi__thm_attribute ctxt nth))) - | Thm_symmetric e1 => - let val e2 = S (semi__thm_attribute ctxt (Thm_thm (From.string "sym"))) in - case semi__thm_attribute ctxt e1 of - Thms_single' e1 => Thms_single' (e1 RSN (1, e2)) - | Thms_mult' e1 => Thms_mult' (e1 RLN (1, [e2])) - end - | Thm_of (nth, l) => - Thms_single' (Rule_Insts.of_rule - ctxt - (List.map (SOME o of_semi__term) l, []) - [] - (S (semi__thm_attribute ctxt nth))) -end - -fun semi__thm_attribute_single ctxt s = case (semi__thm_attribute ctxt s) of Thms_single' t => t - -fun semi__thm_mult ctxt = - let fun f thy = case (semi__thm_attribute ctxt thy) of Thms_mult' t => t - | Thms_single' t => [t] in - fn META.Thms_single thy => f thy - | META.Thms_mult thy => f thy - end - -fun semi__thm_mult_l ctxt l = List.concat (map (semi__thm_mult ctxt) l) - -fun semi__method_simp_only l ctxt = clear_simpset ctxt addsimps (semi__thm_mult_l ctxt l) -fun semi__method_simp_add_del_split (l_add, l_del, l_split) ctxt = - fold Splitter.add_split (semi__thm_mult_l ctxt l_split) - (ctxt addsimps (semi__thm_mult_l ctxt l_add) - delsimps (semi__thm_mult_l ctxt l_del)) - -fun semi__method expr = let open META open Method open META_overload in case expr of - Method_rule o_s => Basic (fn ctxt => - METHOD (HEADGOAL o Classical.rule_tac - ctxt - (case o_s of NONE => [] - | SOME s => [semi__thm_attribute_single ctxt s]))) - | Method_drule s => Basic (fn ctxt => drule ctxt 0 [semi__thm_attribute_single ctxt s]) - | Method_erule s => Basic (fn ctxt => erule ctxt 0 [semi__thm_attribute_single ctxt s]) - | Method_elim s => Basic (fn ctxt => elim ctxt [semi__thm_attribute_single ctxt s]) - | Method_intro l => Basic (fn ctxt => intro ctxt (map (semi__thm_attribute_single ctxt) l)) - | Method_subst (asm, l, s) => Basic (fn ctxt => - SIMPLE_METHOD' ((if asm then EqSubst.eqsubst_asm_tac else EqSubst.eqsubst_tac) - ctxt - (map (the o Int.fromString o To_string0) l) - [semi__thm_attribute_single ctxt s])) - | Method_insert l => Basic (fn ctxt => insert (semi__thm_mult_l ctxt l)) - | Method_plus t => Combinator ( no_combinator_info - , Repeat1 - , [Combinator (no_combinator_info, Then, List.map semi__method t)]) - | Method_option t => Combinator ( no_combinator_info - , Try - , [Combinator (no_combinator_info, Then, List.map semi__method t)]) - | Method_or t => Combinator (no_combinator_info, Orelse, List.map semi__method t) - | Method_one (Method_simp_only l) => semi__method_simp_one (semi__method_simp_only l) - | Method_one (Method_simp_add_del_split l) => semi__method_simp_one (semi__method_simp_add_del_split l) - | Method_all (Method_simp_only l) => semi__method_simp_all (semi__method_simp_only l) - | Method_all (Method_simp_add_del_split l) => semi__method_simp_all (semi__method_simp_add_del_split l) - | Method_auto_simp_add_split (l_simp, l_split) => - Basic (fn ctxt => SIMPLE_METHOD (auto_tac (fold (fn (f, l) => fold f l) - [(Simplifier.add_simp, semi__thm_mult_l ctxt l_simp) - ,(Splitter.add_split, List.map (Proof_Context.get_thm ctxt o To_string0) l_split)] - ctxt))) - | Method_rename_tac l => Basic (K (SIMPLE_METHOD' (Tactic.rename_tac (List.map To_string0 l)))) - | Method_case_tac e => - Basic (fn ctxt => SIMPLE_METHOD' (Induct_Tacs.case_tac ctxt (of_semi__term e) [] NONE)) - | Method_blast n => - Basic (case n of NONE => SIMPLE_METHOD' o blast_tac - | SOME lim => fn ctxt => SIMPLE_METHOD' (depth_tac ctxt (To_nat lim))) - | Method_clarify => Basic (fn ctxt => (SIMPLE_METHOD' (fn i => CHANGED_PROP (clarify_tac ctxt i)))) - | Method_metis (l_opt, l) => - Basic (fn ctxt => (METHOD oo Metis_Tactic.metis_method) - ( (if l_opt = [] then NONE else SOME (map To_string0 l_opt), NONE) - , map (semi__thm_attribute_single ctxt) l) - ctxt) -end - -fun then_tactic l = let open Method in - (Combinator (no_combinator_info, Then, map semi__method l), (Position.none, Position.none)) -end - -fun terminal_proof0 f1 f2 f3 top o_by = let open META in case o_by of - Command_done => (\<^command_keyword>\<open>done\<close>, #dual top { par = Isar_Cmd.done_proof - , seq = f1 }) - | Command_sorry => (\<^command_keyword>\<open>sorry\<close>, #dual top { par = Isar_Cmd.skip_proof - , seq = f2 true }) - | Command_by l_apply => (\<^command_keyword>\<open>by\<close>, let val (m1, m2) = (then_tactic l_apply, NONE) in - #pr_report top m1 - (#pr_report_o top m2 - (#dual top { par = Isar_Cmd.terminal_proof (m1, m2) - , seq = f3 (m1, m2) })) end) -end - -fun terminal_proof_dual top = - terminal_proof0 Proof.local_done_proof Proof.local_skip_proof Proof.local_terminal_proof top - -fun proof_show_gen top f (thes, thes_when) st = st - |>:: (\<^command_keyword>\<open>proof\<close>, - let val m = SOME ( Method.Source [Token.make_string ("-", Position.none)] - , (Position.none, Position.none)) in - (#pr_report_o top m (#proofs top (Proof.proof m))) end) - |> f - |>:: (\<^command_keyword>\<open>show\<close>, #proof' top (fn int => Proof.show_cmd - (thes_when = []) - NONE - (K I) - [] - (if thes_when = [] then [] else [(Binding.empty_atts, map (fn t => (t, [])) thes_when)]) - [(Binding.empty_atts, [(thes, [])])] - int #> #2)) - -fun semi__command_state top (META.Command_apply_end l) = let open META_overload in - cons (\<^command_keyword>\<open>apply_end\<close>, let val m = then_tactic l in - #pr_report top m (#proofs top (Proof.apply_end m)) end) -end - -fun semi__command_proof top = let open META_overload - val thesis = "?thesis" - fun cons_proof_show f = proof_show_gen top f (thesis, []) - fun cons_let (e1, e2) = - cons (\<^command_keyword>\<open>let\<close>, #proof top - (Proof.let_bind_cmd [([of_semi__term e1], of_semi__term e2)])) in - fn META.Command_apply l => - cons (\<^command_keyword>\<open>apply\<close>, let val m = then_tactic l in - #pr_report top m (#proofs top (Proof.apply m)) end) - | META.Command_using l => - cons (\<^command_keyword>\<open>using\<close>, #proof top (fn st => - Proof.using [map (fn s => ([s], [])) (semi__thm_mult_l (Proof.context_of st) l)] st)) - | META.Command_unfolding l => - cons (\<^command_keyword>\<open>unfolding\<close>, #proof top (fn st => - Proof.unfolding [map (fn s => ([s], [])) (semi__thm_mult_l (Proof.context_of st) l)] st)) - | META.Command_let e => - cons_proof_show (cons_let e) - | META.Command_have (n, b, e, e_pr) => (fn st => st - |> cons_proof_show (fn st => st - |>:: (\<^command_keyword>\<open>have\<close>, #proof' top (fn int => - Proof.have_cmd true NONE (K I) [] [] - [( (To_sbinding n, if b then [[Token.make_string ("simp", Position.none)]] else []) - , [(of_semi__term e, [])])] int #> #2)) - |>:: terminal_proof_dual top e_pr)) - | META.Command_fix_let (l, l_let, o_exp, _) => (fn st => st - |> proof_show_gen top (fn st => st - |>:: (\<^command_keyword>\<open>fix\<close>, #proof top - (Proof.fix_cmd (List.map (fn i => (To_sbinding i, NONE, NoSyn)) l))) - |> fold cons_let l_let) - ( case o_exp of NONE => thesis | SOME (l_spec, _) => - (String.concatWith (" \<Longrightarrow> ") - (List.map of_semi__term l_spec)) - , case o_exp of NONE => [] | SOME (_, l_when) => List.map of_semi__term l_when)) -end - -fun end' top = - (\<^command_keyword>\<open>end\<close>, #tr_raw top (Toplevel.exit o Toplevel.end_local_theory o Toplevel.close_target o - Toplevel.end_proof (K Proof.end_notepad))) - -structure Cmd = struct open META open META_overload -fun input_source ml = Input.source false (of_semi__term' ml) (Position.none, Position.none) - -fun datatype' top (Datatypea (version, l)) = - case version of Datatype_new => #local_theory top NONE NONE - (BNF_FP_Def_Sugar.co_datatype_cmd - BNF_Util.Least_FP - BNF_LFP.construct_lfp - (Ctr_Sugar.default_ctr_options_cmd, - (map (fn ((n, v), l) => - ( ( ( ((map (fn v => (SOME (To_binding ""), (To_string0 v, NONE))) v, To_sbinding n), NoSyn) - , List.map (fn (n, l) => ( ( (To_binding "", To_sbinding n) - , List.map (fn s => (To_binding "", of_semi__typ s)) l) - , NoSyn)) l) - , (To_binding "", To_binding "", To_binding "")) - , [])) l))) - | _ => #theory top - ((snd oo Old_Datatype.add_datatype_cmd - (Old_Datatype_Aux.default_config' - (case version of Datatype_old => 0 | Datatype_old_atomic => 1 | _ => 2))) - (map (fn ((n, v), l) => - ( (To_sbinding n, map (fn v => (To_string0 v, NONE)) v, NoSyn) - , List.map (fn (n, l) => (To_sbinding n, List.map of_semi__typ l, NoSyn)) l)) - l)) - -fun type_synonym top (Type_synonym ((n, v), l)) = #theory top (fn thy => let val s_bind = To_sbinding n in - (snd o Typedecl.abbrev_global - (s_bind, map To_string0 v, NoSyn) - (Isabelle_Typedecl.abbrev_cmd0 (SOME s_bind) thy (of_semi__typ l))) thy end) - -fun type_notation top (Type_notation (n, e)) = #local_theory top NONE NONE - (Specification.type_notation_cmd true ("", true) [(To_string0 n, Mixfix (Input.string (To_string0 e), [], 1000, Position.no_range))]) - -fun instantiation1 name thy = thy - |> Class.instantiation ([ let val Term.Type (s, _) = Isabelle_Typedecl.abbrev_cmd0 NONE thy name in s end ], - [], - Syntax.read_sort (Proof_Context.init_global thy) "object") - -fun instantiation2 name n_def expr = - Specification.definition_cmd NONE [] [] ( (To_binding (To_string0 n_def ^ "_" ^ name ^ "_def"), []) - , of_semi__term expr) - -fun overloading1 n_c e_c = Overloading.overloading_cmd [(To_string0 n_c, of_semi__term e_c, true)] - -fun overloading2 n e = - #2 oo Specification.definition_cmd NONE [] [] ((To_sbinding n, []), of_semi__term e) - -fun consts top (Consts (n, ty, symb)) = #theory top - (Sign.add_consts_cmd [( To_sbinding n - , of_semi__typ ty - , Mixfix (Input.string ("(_) " ^ To_string0 symb), [], 1000, Position.no_range))]) - -fun definition top def = #local_theory' top NONE NONE - let val (def, e) = case def of - Definitiona e => (NONE, e) - | Definition_where1 (name, (abbrev, prio), e) => - (SOME ( To_sbinding name - , NONE - , Mixfix (Input.string ("(1" ^ of_semi__term abbrev ^ ")"), [], To_nat prio, Position.no_range)), e) - | Definition_where2 (name, abbrev, e) => - (SOME ( To_sbinding name - , NONE - , Mixfix (Input.string ("(" ^ of_semi__term abbrev ^ ")"), [], 1000, Position.no_range)), e) in fn ctxt => ctxt - |> #2 oo Specification.definition_cmd def [] [] (Binding.empty_atts, of_semi__term e) end - -fun lemmas top lemmas = #local_theory' top NONE NONE (fn disp => fn lthy => - let val (simp, s, l) = - case lemmas of Lemmas_simp_thm (simp, s, l) => - (simp, s, map (fn x => ([semi__thm_attribute_single lthy x], [])) l) - | Lemmas_simp_thms (s, l) => - (true, s, map (fn x => (Proof_Context.get_thms lthy (To_string0 x), [])) l) in - (#2 o Specification.theorems Thm.theoremK - [((To_sbinding s, List.map (fn s => Attrib.check_src lthy [Token.make_string (s, Position.none)]) - (if simp then ["simp", "code_unfold"] else [])), - l)] - [] - disp) lthy end) - -fun lemma1 n l_spec = Specification.theorem_cmd true Thm.theoremK NONE (K I) - Binding.empty_atts [] [] (Element.Shows [((To_sbinding n, []) - ,[((String.concatWith (" \<Longrightarrow> ") - (List.map of_semi__term l_spec)), [])])]) - -fun lemma1' n l_spec concl = Specification.theorem_cmd true Thm.theoremK NONE (K I) - (To_sbinding n, []) - [] - (List.map (fn (n, (b, e)) => - Element.Assumes [( ( To_sbinding n - , if b then [[Token.make_string ("simp", Position.none)]] else []) - , [(of_semi__term e, [])])]) - l_spec) - (Element.Shows [(Binding.empty_atts,[(of_semi__term concl, [])])]) - -fun lemma3 l_apply = map_filter (fn META.Command_let _ => SOME [] - | META.Command_have _ => SOME [] - | META.Command_fix_let (_, _, _, l) => SOME l - | _ => NONE) - (rev l_apply) - -fun axiomatization top (Axiomatization (n, e)) = #theory top - (#2 o Specification.axiomatization_cmd [] [] [] [((To_sbinding n, []), of_semi__term e)]) - -fun section n s _ = - let fun mk s n = if n <= 0 then s else mk (" " ^ s) (n - 1) in - out_intensify (mk (Markup.markup Markup.keyword3 (To_string0 s)) n) "" - end - -fun ml top (SMLa ml) = #generic_theory top - (ML_Context.exec let val source = input_source ml in - fn () => ML_Context.eval_source (ML_Compiler.verbose true ML_Compiler.flags) source - end #> - Local_Theory.propagate_ml_env) - -fun setup top (Setup ml) = #theory top (Isar_Cmd.setup (input_source ml)) - -fun thm top (Thm thm) = #keep top (fn state => - let val lthy = #context_of top state in - Print_Mode.with_modes [] (fn () => writeln - (Pretty.string_of - (Proof_Context.pretty_fact lthy ("", List.map (semi__thm_attribute_single lthy) thm)))) () - end) - -fun interpretation1 n loc_n loc_param = - Interpretation.interpretation_cmd ( [ ( (To_string0 loc_n, Position.none) - , ( (To_string0 n, true) - , ( if loc_param = [] then - Expression.Named [] - else - Expression.Positional (map (SOME o of_semi__term) - loc_param) - , [])))] - , []) - -fun hide_const top (Hide_const (fully, args)) = #theory top (fn thy => - fold (Sign.hide_const (not fully) o ((#1 o dest_Const) oo Proof_Context.read_const {proper = true, strict = false}) - (Proof_Context.init_global thy)) - (map To_string0 args) - thy) - -fun abbreviation top (Abbreviation e) = #local_theory' top NONE NONE - (Specification.abbreviation_cmd ("", true) NONE [] (of_semi__term e)) - -fun code_reflect' top (Code_reflect (all_public, module_name, raw_functions)) = #theory top - (Code_Runtime'.code_reflect_cmd all_public [] (map To_string0 raw_functions) (To_string0 module_name) NONE) - -end - -structure Command_Transition = struct - -fun semi__theory (top : ('transitionM, 'transitionM, 'state) toplevel) = let open META open META_overload - in (*let val f = *)fn - Theory_datatype datatype' => - cons (\<^command_keyword>\<open>datatype\<close>, Cmd.datatype' top datatype') -| Theory_type_synonym type_synonym => (*Toplevel.local_theory*) - cons (\<^command_keyword>\<open>type_synonym\<close>, Cmd.type_synonym top type_synonym) -| Theory_type_notation type_notation => - cons (\<^command_keyword>\<open>type_notation\<close>, Cmd.type_notation top type_notation) -| Theory_instantiation (Instantiation (n, n_def, expr)) => let val name = To_string0 n in fn acc => acc - |>:: (\<^command_keyword>\<open>instantiation\<close>, #begin_local_theory top true (Cmd.instantiation1 name)) - |>:: (\<^command_keyword>\<open>definition\<close>, #local_theory' top NONE NONE (#2 oo Cmd.instantiation2 name n_def expr)) - |>:: (\<^command_keyword>\<open>instance\<close>, #local_theory_to_proof top NONE NONE (Class.instantiation_instance I)) - |>:: (\<^command_keyword>\<open>..\<close>, #tr_raw top Isar_Cmd.default_proof) - |>:: end' top end -| Theory_overloading (Overloading (n_c, e_c, n, e)) => (fn acc => acc - |>:: (\<^command_keyword>\<open>overloading\<close>, #begin_local_theory top true (Cmd.overloading1 n_c e_c)) - |>:: (\<^command_keyword>\<open>definition\<close>, #local_theory' top NONE NONE (Cmd.overloading2 n e)) - |>:: end' top) -| Theory_consts consts => - cons (\<^command_keyword>\<open>consts\<close>, Cmd.consts top consts) -| Theory_definition definition => - cons (\<^command_keyword>\<open>definition\<close>, Cmd.definition top definition) -| Theory_lemmas lemmas => - cons (\<^command_keyword>\<open>lemmas\<close>, Cmd.lemmas top lemmas) -| Theory_lemma (Lemma (n, l_spec, l_apply, o_by)) => (fn acc => acc - |>:: (\<^command_keyword>\<open>lemma\<close>, #local_theory_to_proof' top NONE NONE (Cmd.lemma1 n l_spec)) - |> fold (semi__command_proof top o META.Command_apply) l_apply - |>:: terminal_proof_dual top o_by) -| Theory_lemma (Lemma_assumes (n, l_spec, concl, l_apply, o_by)) => (fn acc => acc - |>:: (\<^command_keyword>\<open>lemma\<close>, #local_theory_to_proof' top NONE NONE (Cmd.lemma1' n l_spec concl)) - |> fold (semi__command_proof top) l_apply - |> (fn st => st - |>:: terminal_proof_dual top o_by - |> (case Cmd.lemma3 l_apply of - [] => I - | _ :: l => - let fun cons_qed m = - cons (\<^command_keyword>\<open>qed\<close>, #tr_report_o top m (#tr_raw top (Isar_Cmd.qed m))) in fn st => st - |> fold (fn l => fold (semi__command_state top) l o cons_qed NONE) l - |> cons_qed NONE end))) -| Theory_axiomatization axiomatization => - cons (\<^command_keyword>\<open>axiomatization\<close>, Cmd.axiomatization top axiomatization) -| Theory_section (Section (n, s)) => let val n = To_nat n in fn st => st - |>:: (case n of 0 => - \<^command_keyword>\<open>section\<close> | 1 => - \<^command_keyword>\<open>subsection\<close> | _ => - \<^command_keyword>\<open>subsubsection\<close>, - #tr_raw top (Pure_Syn.document_command {markdown = false} (NONE, Input.string (To_string0 s)))) - |>:: (\<^command_keyword>\<open>print_syntax\<close>, #keep top (Cmd.section n s)) end -| Theory_text (Text s) => - cons (\<^command_keyword>\<open>text\<close>, - #tr_raw top (Pure_Syn.document_command {markdown = true} (NONE, Input.string (To_string0 s)))) -| Theory_text_raw (Text_raw s) => - cons (\<^command_keyword>\<open>text_raw\<close>, - #tr_raw top (Pure_Syn.document_command {markdown = true} (NONE, Input.string (To_string0 s)))) -| Theory_ML ml => - cons (\<^command_keyword>\<open>ML\<close>, Cmd.ml top ml) -| Theory_setup setup => - cons (\<^command_keyword>\<open>setup\<close>, Cmd.setup top setup) -| Theory_thm thm => - cons (\<^command_keyword>\<open>thm\<close>, Cmd.thm top thm) -| Theory_interpretation (Interpretation (n, loc_n, loc_param, o_by)) => (fn st => st - |>:: (\<^command_keyword>\<open>interpretation\<close>, #local_theory_to_proof top NONE NONE - (Cmd.interpretation1 n loc_n loc_param)) - |>:: terminal_proof_dual top o_by) -| Theory_hide_const hide_const => - cons (\<^command_keyword>\<open>hide_const\<close>, Cmd.hide_const top hide_const) -| Theory_abbreviation abbreviation => - cons (\<^command_keyword>\<open>abbreviation\<close>, Cmd.abbreviation top abbreviation) -| Theory_code_reflect code_reflect' => - cons (\<^command_keyword>\<open>code_reflect'\<close>, Cmd.code_reflect' top code_reflect') -(*in fn t => fn thy => f t thy handle ERROR s => (warning s; thy) - end*) -end -end - -structure Command_Theory = struct - -fun local_terminal_proof o_by = let open META in case o_by of - Command_done => Proof.local_done_proof - | Command_sorry => Proof.local_skip_proof true - | Command_by l_apply => Proof.local_terminal_proof (then_tactic l_apply, NONE) -end - -fun global_terminal_proof o_by = let open META in case o_by of - Command_done => Proof.global_done_proof - | Command_sorry => Proof.global_skip_proof true - | Command_by l_apply => Proof.global_terminal_proof (then_tactic l_apply, NONE) -end - -fun semi__command_state' top pr = fold snd (rev (semi__command_state top pr [])) -fun semi__command_proof' top pr = fold snd (rev (semi__command_proof top pr [])) - -fun semi__theory top = let open META open META_overload in (*let val f = *)fn - Theory_datatype datatype' => Cmd.datatype' top datatype' -| Theory_type_synonym type_synonym => Cmd.type_synonym top type_synonym -| Theory_type_notation type_notation => Cmd.type_notation top type_notation -| Theory_instantiation (Instantiation (n, n_def, expr)) => #theory top (fn thy => let val name = To_string0 n in thy - |> Cmd.instantiation1 name - |> (fn thy => let val ((_, (_, ty)), thy) = Cmd.instantiation2 name n_def expr false thy in ([ty], thy) end) - |-> Class.prove_instantiation_exit_result (map o Morphism.thm) (fn ctxt => fn thms => - Class.intro_classes_tac ctxt [] THEN ALLGOALS (Proof_Context.fact_tac ctxt thms)) - |-> K I end) -| Theory_overloading (Overloading (n_c, e_c, n, e)) => #theory top (fn thy => thy - |> Cmd.overloading1 n_c e_c - |> Cmd.overloading2 n e false - |> Local_Theory.exit_global) -| Theory_consts consts => Cmd.consts top consts -| Theory_definition definition => Cmd.definition top definition -| Theory_lemmas lemmas => Cmd.lemmas top lemmas -| Theory_lemma (Lemma (n, l_spec, l_apply, o_by)) => #local_theory top NONE NONE (fn lthy => lthy - |> Cmd.lemma1 n l_spec false - |> fold (semi__command_proof' top o META.Command_apply) l_apply - |> global_terminal_proof o_by) -| Theory_lemma (Lemma_assumes (n, l_spec, concl, l_apply, o_by)) => #local_theory top NONE NONE (fn lthy => lthy - |> Cmd.lemma1' n l_spec concl false - |> fold (semi__command_proof' top) l_apply - |> (case Cmd.lemma3 l_apply of - [] => global_terminal_proof o_by - | _ :: l => let val arg = (NONE, true) in fn st => st - |> local_terminal_proof o_by - |> fold (fn l => fold (semi__command_state' top) l o Proof.local_qed arg) l - |> Proof.global_qed arg end)) -| Theory_axiomatization axiomatization => Cmd.axiomatization top axiomatization -| Theory_section (Section (n, s)) => #keep top (Cmd.section (To_nat n) s) -| Theory_text _ => #keep top (K ()) -| Theory_text_raw _ => #keep top (K ()) -| Theory_ML ml => Cmd.ml top ml -| Theory_setup setup => Cmd.setup top setup -| Theory_thm thm => Cmd.thm top thm -| Theory_interpretation (Interpretation (n, loc_n, loc_param, o_by)) => #local_theory top NONE NONE (fn lthy => lthy - |> Cmd.interpretation1 n loc_n loc_param - |> global_terminal_proof o_by) -| Theory_hide_const hide_const => Cmd.hide_const top hide_const -| Theory_abbreviation abbreviation => Cmd.abbreviation top abbreviation -| Theory_code_reflect code_reflect' => Cmd.code_reflect' top code_reflect' -(*in fn t => fn thy => f t thy handle ERROR s => (warning s; thy) - end*) -end -end - -end - -structure Bind_META = struct open Bind_Isabelle - -structure Meta_Cmd_Data = Theory_Data - (open META - type T = META.all_meta list - val empty = [] - val extend = I - val merge = #2) - -fun ML_context_exec source = - ML_Context.exec (fn () => - ML_Context.eval_source (ML_Compiler.verbose false ML_Compiler.flags) source) #> - Local_Theory.propagate_ml_env - -fun meta_command0 s_put f_get source = - Context.Theory - #> ML_context_exec (Input.string ("let open META val ML = META.SML in Context.>> (Context.map_theory (" ^ s_put ^ " (" ^ source ^ "))) end")) - #> Context.map_theory_result (fn thy => (f_get thy, thy)) - #> fst - -val meta_command = meta_command0 "Bind_META.Meta_Cmd_Data.put" Meta_Cmd_Data.get - -local - open META - open META_overload - open Library - - fun semi__locale data thy = thy - |> ( Expression.add_locale_cmd - (To_sbinding (META.holThyLocale_name data)) - Binding.empty - ([], []) - (List.concat - (map - (fn (fixes, assumes) => List.concat - [ map (fn (e,ty) => Element.Fixes [( To_binding (of_semi__term e) - , SOME (of_semi__typ ty) - , NoSyn)]) fixes - , case assumes of NONE => [] - | SOME (n, e) => [Element.Assumes [( (To_sbinding n, []) - , [(of_semi__term e, [])])]]]) - (META.holThyLocale_header data))) - #> #2) - - fun semi__aux thy = - map2_ctxt_term - (fn T_pure x => T_pure x - | e => - let fun aux e = case e of - T_to_be_parsed (s, _) => SOME let val t = Syntax.read_term (get_thy \<^here> Proof_Context.init_global thy) - (To_string0 s) in - (t, s, Term.add_frees t []) - end - | T_lambda (a, e) => - Option.map - (fn (e, s, l_free) => - let val a0 = To_string0 a - val (t, l_free) = case List.partition (fn (x, _) => x = a0) l_free of - ([], l_free) => (Term.TFree ("'a", ["HOL.type"]), l_free) - | ([(_, t)], l_free) => (t, l_free) in - (lambda ( Term.Free (a0, t)) e - , META.String_concatWith (From.string "", [From.string "(% ", a, From.string ". ", s, From.string ")"]) - , l_free) - end) - (aux e) - | _ => NONE in - case aux e of - NONE => error "nested pure expression not expected" - | SOME (e, s, _) => META.T_pure (From.Pure.term e, SOME s) - end) -in - -fun all_meta_tr aux top thy_o = fn - META_semi_theories theo => apsnd - (case theo of - Theories_one theo => Command_Transition.semi__theory top theo - | Theories_locale (data, l) => fn acc => acc - |>:: (\<^command_keyword>\<open>locale\<close>, #begin_local_theory top true (semi__locale data)) - |> fold (fold (Command_Transition.semi__theory top)) l - |>:: end' top) -| META_boot_generation_syntax _ => I -| META_boot_setup_env _ => I -| META_all_meta_embedding (META_generic (OclGeneric source)) => - (fn (env, tr) => - all_meta_trs - aux - top - thy_o - (get_thy \<^here> - (fn thy => - get_thy \<^here> - (meta_command (To_string0 source)) - (if forall (fn ((key, _), _) => - Keyword.is_vacuous (Thy_Header.get_keywords thy) key) - tr - then SOME thy else NONE)) - thy_o) - (env, tr)) -| META_all_meta_embedding meta => aux (semi__aux NONE meta) - -and all_meta_trs aux = fold oo all_meta_tr aux - -fun all_meta_thy aux top_theory top_local_theory = fn - META_semi_theories theo => apsnd - (case theo of - Theories_one theo => Command_Theory.semi__theory top_theory theo - | Theories_locale (data, l) => (*Toplevel.begin_local_theory*) fn thy => thy - |> semi__locale data - |> fold (fold (Command_Theory.semi__theory top_local_theory)) l - |> Local_Theory.exit_global) -| META_boot_generation_syntax _ => I -| META_boot_setup_env _ => I -| META_all_meta_embedding (META_generic (OclGeneric source)) => - (fn (env, thy) => - all_meta_thys aux top_theory top_local_theory (meta_command (To_string0 source) thy) (env, thy)) -| META_all_meta_embedding meta => fn (env, thy) => aux (semi__aux (SOME thy) meta) (env, thy) - -and all_meta_thys aux = fold oo all_meta_thy aux - -end -end -\<close> - -subsection\<open>Directives of Compilation for Target Languages\<close> - -ML\<open> -structure Deep0 = struct - -fun apply_hs_code_identifiers ml_module thy = - let fun mod_hs (fic, ml_module) = Code_Symbol.Module (fic, [("Haskell", SOME ml_module)]) in - fold (Code_Target.set_identifiers o mod_hs) - (map (fn x => (Context.theory_name x, ml_module)) - (* list of .hs files that will be merged together in "ml_module" *) - ( thy - :: (* we over-approximate the set of compiler files *) - Context.ancestors_of thy)) thy end - -structure Export_code_env = struct - structure Isabelle = struct - val function = "write_file" - val argument_main = "main" - end - - structure Haskell = struct - val function = "Function" - val argument = "Argument" - val main = "Main" - structure Filename = struct - fun hs_function ext = function ^ "." ^ ext - fun hs_argument ext = argument ^ "." ^ ext - fun hs_main ext = main ^ "." ^ ext - end - end - - structure OCaml = struct - val make = "write" - structure Filename = struct - fun function ext = "function." ^ ext - fun argument ext = "argument." ^ ext - fun main_fic ext = "main." ^ ext - fun makefile ext = make ^ "." ^ ext - end - end - - structure Scala = struct - structure Filename = struct - fun function ext = "Function." ^ ext - fun argument ext = "Argument." ^ ext - end - end - - structure SML = struct - val main = "Run" - structure Filename = struct - fun function ext = "Function." ^ ext - fun argument ext = "Argument." ^ ext - fun stdout ext = "Stdout." ^ ext - fun main_fic ext = main ^ "." ^ ext - end - end - - datatype file_input = File - | Directory -end - -fun compile l cmd = - let val (l, rc) = fold (fn cmd => (fn (l, 0) => - let val {out, err, rc, ...} = Bash.process cmd in - ((out, err) :: l, rc) end - | x => x)) l ([], 0) - val l = rev l in - if rc = 0 then - (l, Isabelle_System.bash_output cmd) - else - let val () = fold (fn (out, err) => K (warning err; writeln out)) l () in - error "Compilation failed" - end - end - -val check = - fold (fn (cmd, msg) => fn () => - let val (out, rc) = Isabelle_System.bash_output cmd in - if rc = 0 then - () - else - ( writeln out - ; error msg) - end) - -val compiler = let open Export_code_env in - [ let val ml_ext = "hs" in - ( "Haskell", ml_ext, Directory, Haskell.Filename.hs_function - , check [("ghc --version", "ghc is not installed (required for compiling a Haskell project)")] - , (fn mk_fic => fn _ => fn mk_free => fn thy => - File.write (mk_fic ("Main." ^ ml_ext)) - (String.concatWith "; " [ "import qualified Unsafe.Coerce" - , "import qualified " ^ Haskell.function - , "import qualified " ^ Haskell.argument - , "main :: IO ()" - , "main = " ^ Haskell.function ^ "." ^ Isabelle.function ^ - " (Unsafe.Coerce.unsafeCoerce " ^ Haskell.argument ^ "." ^ - mk_free (Proof_Context.init_global thy) - Isabelle.argument_main ([]: (string * string) list) ^ - ")"])) - , fn tmp_export_code => fn tmp_file => - compile [ "mv " ^ tmp_file ^ "/" ^ Haskell.Filename.hs_argument ml_ext ^ " " ^ - Path.implode tmp_export_code - , "cd " ^ Path.implode tmp_export_code ^ - " && ghc -outputdir _build " ^ Haskell.Filename.hs_main ml_ext ] - (Path.implode (Path.append tmp_export_code (Path.make [Haskell.main])))) - end - , let val ml_ext = "ml" in - ( "OCaml", ml_ext, File, OCaml.Filename.function - , check [("ocp-build -version", "ocp-build is not installed (required for compiling an OCaml project)") - ,("ocamlopt -version", "ocamlopt is not installed (required for compiling an OCaml project)")] - , fn mk_fic => fn ml_module => fn mk_free => fn thy => - let val () = - File.write - (mk_fic (OCaml.Filename.makefile "ocp")) - (String.concat - [ "comp += \"-g\" link += \"-g\" " - , "begin generated = true begin library \"nums\" end end " - , "begin program \"", OCaml.make, "\" sort = true files = [ \"", OCaml.Filename.function ml_ext - , "\" \"", OCaml.Filename.argument ml_ext - , "\" \"", OCaml.Filename.main_fic ml_ext - , "\" ]" - , "requires = [\"nums\"] " - , "end" ]) in - File.write (mk_fic (OCaml.Filename.main_fic ml_ext)) - ("let _ = Function." ^ ml_module ^ "." ^ Isabelle.function ^ - " (Obj.magic (Argument." ^ ml_module ^ "." ^ - mk_free (Proof_Context.init_global thy) - Isabelle.argument_main - ([]: (string * string) list) ^ "))") - end - , fn tmp_export_code => fn tmp_file => - compile - [ "mv " ^ tmp_file ^ " " ^ - Path.implode (Path.append tmp_export_code (Path.make [OCaml.Filename.argument ml_ext])) - , "cd " ^ Path.implode tmp_export_code ^ - " && ocp-build -init -scan -no-bytecode 2>&1" ] - (Path.implode (Path.append tmp_export_code (Path.make [ "_obuild" - , OCaml.make - , OCaml.make ^ ".asm"])))) - end - , let val ml_ext = "scala" - val ml_module = Unsynchronized.ref ("", "") in - ( "Scala", ml_ext, File, Scala.Filename.function - , check [("scala -e 0", "scala is not installed (required for compiling a Scala project)")] - , (fn _ => fn ml_mod => fn mk_free => fn thy => - ml_module := (ml_mod, mk_free (Proof_Context.init_global thy) - Isabelle.argument_main - ([]: (string * string) list))) - , fn tmp_export_code => fn tmp_file => - let val l = File.read_lines (Path.explode tmp_file) - val (ml_module, ml_main) = Unsynchronized.! ml_module - val () = - File.write_list - (Path.append tmp_export_code (Path.make [Scala.Filename.argument ml_ext])) - (List.map - (fn s => s ^ "\n") - ("object " ^ ml_module ^ " { def main (__ : Array [String]) = " ^ - ml_module ^ "." ^ Isabelle.function ^ " (" ^ ml_module ^ "." ^ ml_main ^ ")" - :: l @ ["}"])) in - compile [] - ("scala -nowarn " ^ Path.implode (Path.append tmp_export_code - (Path.make [Scala.Filename.argument ml_ext]))) - end) - end - , let val ml_ext_thy = "thy" - val ml_ext_ml = "ML" in - ( "SML", ml_ext_ml, File, SML.Filename.function - , check [ let open Path val isa = "isabelle" in - ( implode (expand (append (variable "ISABELLE_HOME") (make ["bin", isa]))) ^ " version" - , isa ^ " is not installed (required for compiling a SML project)") - end ] - , fn mk_fic => fn ml_module => fn mk_free => fn thy => - let val esc_star = "*" - fun ml l = - List.concat - [ [ "ML{" ^ esc_star ] - , map (fn s => s ^ ";") l - , [ esc_star ^ "}"] ] - val () = - let val fic = mk_fic (SML.Filename.function ml_ext_ml) in - (* replace ("\\" ^ "<") by ("\\\060") in 'fic' *) - File.write_list fic - (map (fn s => - (if s = "" then - "" - else - String.concatWith "\\" - (map (fn s => - let val l = String.size s in - if l > 0 andalso String.sub (s,0) = #"<" then - "\\060" ^ String.substring (s, 1, String.size s - 1) - else - s end) - (String.fields (fn c => c = #"\\") s))) ^ "\n") - (File.read_lines fic)) - end in - File.write_list (mk_fic (SML.Filename.main_fic ml_ext_thy)) - (map (fn s => s ^ "\n") (List.concat - [ [ "theory " ^ SML.main - , "imports Main" - , "begin" - , "declare [[ML_print_depth = 500]]" - (* any large number so that @{make_string} displays all the expression *) ] - , ml [ "val stdout_file = Unsynchronized.ref (File.read (Path.make [\"" ^ - SML.Filename.stdout ml_ext_ml ^ "\"]))" - , "use \"" ^ SML.Filename.argument ml_ext_ml ^ "\"" ] - , ml let val arg = "argument" in - [ "val " ^ arg ^ " = YXML.content_of (@{make_string} (" ^ - ml_module ^ "." ^ - mk_free (Proof_Context.init_global thy) - Isabelle.argument_main - ([]: (string * string) list) ^ "))" - , "use \"" ^ SML.Filename.function ml_ext_ml ^ "\"" - , "ML_Context.eval_source (ML_Compiler.verbose false ML_Compiler.flags) (Input.source false (\"let open " ^ - ml_module ^ " in " ^ Isabelle.function ^ " (\" ^ " ^ arg ^ - " ^ \") end\") (Position.none, Position.none) )" ] - end - , [ "end" ]])) - end - , fn tmp_export_code => fn tmp_file => - let open Path - val stdout_file = Isabelle_System.create_tmp_path "stdout_file" "thy" - val () = File.write (append tmp_export_code (make [SML.Filename.stdout ml_ext_ml])) - (implode (expand stdout_file)) - val (l, (_, exit_st)) = - compile - [ "mv " ^ tmp_file ^ " " ^ implode (append tmp_export_code - (make [SML.Filename.argument ml_ext_ml])) - , "cd " ^ implode tmp_export_code ^ - " && echo 'use_thy \"" ^ SML.main ^ "\";' | " ^ - implode (expand (append (variable "ISABELLE_HOME") (make ["bin", "isabelle"]))) ^ - " console" ] - "true" - val stdout = File.read stdout_file |> (fn s => let val () = File.rm stdout_file in s end) - in (l, (stdout, if List.exists (fn (err, _) => - List.exists (fn "*** Error" => true | _ => false) - (String.tokens (fn #"\n" => true | _ => false) err)) l then - List.app (fn (out, err) => (warning err; writeln out)) l |> K 1 - else exit_st)) - end) - end ] -end - -structure Find = struct - -fun find ml_compiler = - case List.find (fn (ml_compiler0, _, _, _, _, _, _) => ml_compiler0 = ml_compiler) compiler of - SOME v => v - | NONE => error ("Not registered compiler: " ^ ml_compiler) - -fun ext ml_compiler = case find ml_compiler of (_, ext, _, _, _, _, _) => ext - -fun export_mode ml_compiler = case find ml_compiler of (_, _, mode, _, _, _, _) => mode - -fun function ml_compiler = case find ml_compiler of (_, _, _, f, _, _, _) => f - -fun check_compil ml_compiler = case find ml_compiler of (_, _, _, _, build, _, _) => build - -fun init ml_compiler = case find ml_compiler of (_, _, _, _, _, build, _) => build - -fun build ml_compiler = case find ml_compiler of (_, _, _, _, _, _, build) => build -end - -end -\<close> - -ML\<open> -structure Deep = struct - -fun absolute_path thy filename = - Path.implode (Path.append (Resources.master_directory thy) (Path.explode filename)) - -fun export_code_tmp_file seris g = - fold - (fn ((ml_compiler, ml_module), export_arg) => fn f => fn g => - f (fn accu => - let val tmp_name = Context.theory_name \<^theory> in - (if Deep0.Find.export_mode ml_compiler = Deep0.Export_code_env.Directory then - Isabelle_System.with_tmp_dir tmp_name - else - Isabelle_System.with_tmp_file tmp_name (Deep0.Find.ext ml_compiler)) - (fn filename => - g (((((ml_compiler, ml_module), (Path.implode filename, Position.none)), export_arg) :: accu))) - end)) - seris - (fn f => f []) - (g o rev) - -fun mk_path_export_code tmp_export_code ml_compiler i = - Path.append tmp_export_code (Path.make [ml_compiler ^ Int.toString i]) - -fun export_code_cmd' seris tmp_export_code f_err raw_cs thy = - export_code_tmp_file seris - (fn seris => - let val mem_scala = List.exists (fn ((("Scala", _), _), _) => true | _ => false) seris - val _ = Isabelle_Code_Target.export_code_cmd - false - (if mem_scala then Deep0.Export_code_env.Isabelle.function :: raw_cs else raw_cs) - seris - (Proof_Context.init_global - let val v = Deep0.apply_hs_code_identifiers Deep0.Export_code_env.Haskell.argument thy in - if mem_scala then Code_printing.apply_code_printing v else v end) in - List_mapi - (fn i => fn seri => case seri of (((ml_compiler, _), (filename, _)), _) => - let val (l, (out, err)) = - Deep0.Find.build - ml_compiler - (mk_path_export_code tmp_export_code ml_compiler i) - filename - val _ = f_err seri err in - (l, out) - end) seris - end) - -fun mk_term ctxt s = - fst (Scan.pass (Context.Proof ctxt) Args.term (Token.explode0 (Thy_Header.get_keywords' ctxt) s)) - -fun mk_free ctxt s l = - let val t_s = mk_term ctxt s in - if Term.is_Free t_s then s else - let val l = (s, "") :: l in - mk_free ctxt (fst (hd (Term.variant_frees t_s l))) l - end - end - -val list_all_eq = fn x0 :: xs => - List.all (fn x1 => x0 = x1) xs - -end -\<close> - -subsection\<open>Saving the History of Meta Commands\<close> - -ML\<open> -fun p_gen f g = f "[" "]" g - (*|| f "{" "}" g*) - || f "(" ")" g -fun paren f = p_gen (fn s1 => fn s2 => fn f => Parse.$$$ s1 |-- f --| Parse.$$$ s2) f -fun parse_l f = Parse.$$$ "[" |-- Parse.!!! (Parse.list f --| Parse.$$$ "]") -fun parse_l_with f = Parse.$$$ "[" |-- Scan.optional (Parse.binding --| \<^keyword>\<open>with_only\<close> >> SOME) NONE - -- Parse.!!! (Parse.list f --| Parse.$$$ "]") -fun parse_l' f = Parse.$$$ "[" |-- Parse.list f --| Parse.$$$ "]" -fun parse_l1' f = Parse.$$$ "[" |-- Parse.list1 f --| Parse.$$$ "]" -fun annot_ty f = Parse.$$$ "(" |-- f --| Parse.$$$ "::" -- Parse.binding --| Parse.$$$ ")" -\<close> - -ML\<open> -structure Generation_mode = struct - -type internal_deep = - { output_header_thy : (string * (string list (* imports *) * string (* import optional (bootstrap) *))) option - , seri_args : ((bstring (* compiler *) * bstring (* main module *) ) * Token.T list) list - , filename_thy : bstring option - , tmp_export_code : Path.T (* dir *) - , skip_exportation : bool (* true: skip preview of code exportation *) } - -datatype ('a, 'b, 'c) generation_mode0 = Gen_deep of 'a | Gen_shallow of 'b | Gen_syntax_print of 'c - -type ('compiler_env_config_ext, 'a) generation_mode = - { deep : ('compiler_env_config_ext * internal_deep) list - , shallow : ('compiler_env_config_ext * 'a (* theory init *)) list - , syntax_print : int option list } - -fun mapM_syntax_print f (mode : ('compiler_env_config_ext, 'a) generation_mode) tr = tr - |> f (#syntax_print mode) - |> apfst (fn syntax_print => { syntax_print = syntax_print - , deep = #deep mode - , shallow = #shallow mode }) - -fun mapM_shallow f (mode : ('compiler_env_config_ext, 'a) generation_mode) tr = tr - |> f (#shallow mode) - |> apfst (fn shallow => { syntax_print = #syntax_print mode - , deep = #deep mode - , shallow = shallow }) - -fun mapM_deep f (mode : ('compiler_env_config_ext, 'a) generation_mode) tr = tr - |> f (#deep mode) - |> apfst (fn deep => { syntax_print = #syntax_print mode - , deep = deep - , shallow = #shallow mode }) - -structure Data_gen = Theory_Data - (type T = (unit META.compiler_env_config_ext, theory) generation_mode - val empty = {deep = [], shallow = [], syntax_print = [NONE]} - val extend = I - fun merge (e1, e2) = { deep = #deep e1 @ #deep e2 - , shallow = #shallow e1 @ #shallow e2 - , syntax_print = #syntax_print e1 @ #syntax_print e2 }) - -val code_expr_argsP = Scan.optional (\<^keyword>\<open>(\<close> |-- Parse.args --| \<^keyword>\<open>)\<close>) [] - -val parse_scheme = - \<^keyword>\<open>design\<close> >> K META.Gen_only_design || \<^keyword>\<open>analysis\<close> >> K META.Gen_only_analysis - -val parse_sorry_mode = - Scan.optional ( \<^keyword>\<open>SORRY\<close> >> K (SOME META.Gen_sorry) - || \<^keyword>\<open>no_dirty\<close> >> K (SOME META.Gen_no_dirty)) NONE - -val parse_deep = - Scan.optional (\<^keyword>\<open>skip_export\<close> >> K true) false - -- Scan.optional (((Parse.$$$ "(" -- \<^keyword>\<open>THEORY\<close>) |-- Parse.name -- ((Parse.$$$ ")" - -- Parse.$$$ "(" -- \<^keyword>\<open>IMPORTS\<close>) |-- parse_l' Parse.name -- Parse.name) - --| Parse.$$$ ")") >> SOME) NONE - -- Scan.optional (\<^keyword>\<open>SECTION\<close> >> K true) false - -- parse_sorry_mode - -- (* code_expr_inP *) parse_l1' (\<^keyword>\<open>in\<close> |-- ((\<^keyword>\<open>self\<close> || Parse.name) - -- Scan.optional (\<^keyword>\<open>module_name\<close> |-- Parse.name) "" - -- code_expr_argsP)) - -- Scan.optional - ((Parse.$$$ "(" -- \<^keyword>\<open>output_directory\<close>) |-- Parse.name --| Parse.$$$ ")" >> SOME) - NONE - -val parse_semantics = - let val z = 0 in - Scan.optional - (paren (\<^keyword>\<open>generation_semantics\<close> - |-- paren (parse_scheme - -- Scan.optional ((Parse.$$$ "," -- \<^keyword>\<open>oid_start\<close>) |-- Parse.nat) - z))) - (META.Gen_default, z) - end - -val mode = - let fun mk_env output_disable_thy output_header_thy oid_start design_analysis sorry_mode ctxt = - META.compiler_env_config_empty - output_disable_thy - (From.option (From.pair From.string (From.pair (From.list From.string) From.string)) - output_header_thy) - (META.oidInit (From.internal_oid oid_start)) - design_analysis - (sorry_mode, Config.get ctxt quick_and_dirty) in - - \<^keyword>\<open>deep\<close> |-- parse_semantics -- parse_deep >> - (fn ( (design_analysis, oid_start) - , ( ((((skip_exportation, output_header_thy), output_disable_thy), sorry_mode), seri_args) - , filename_thy)) => - Gen_deep ( mk_env (not output_disable_thy) - output_header_thy - oid_start - design_analysis - sorry_mode - , { output_header_thy = output_header_thy - , seri_args = seri_args - , filename_thy = filename_thy - , tmp_export_code = Isabelle_System.create_tmp_path "deep_export_code" "" - , skip_exportation = skip_exportation })) - || \<^keyword>\<open>shallow\<close> |-- parse_semantics -- parse_sorry_mode >> - (fn ((design_analysis, oid_start), sorry_mode) => - Gen_shallow (mk_env true - NONE - oid_start - design_analysis - sorry_mode)) - || (\<^keyword>\<open>syntax_print\<close> |-- Scan.optional (Parse.number >> SOME) NONE) >> - (fn n => Gen_syntax_print (case n of NONE => NONE | SOME n => Int.fromString n)) - end - -fun f_command l_mode = - Toplevel'.setup_theory - (META.mapM - (fn Gen_shallow env => - pair (fn thy => Gen_shallow (env (Proof_Context.init_global thy), thy)) - o cons (Toplevel'.read_write_keep (Toplevel.Load_previous, Toplevel.Store_backup)) - | Gen_syntax_print n => pair (K (Gen_syntax_print n)) - | Gen_deep (env, i_deep) => - pair (fn thy => Gen_deep (env (Proof_Context.init_global thy), i_deep)) - o cons - (\<^command_keyword>\<open>export_code\<close>, Toplevel'.keep_theory (fn thy => - let val seri_args' = - List_mapi - (fn i => fn ((ml_compiler, ml_module), export_arg) => - let val tmp_export_code = Deep.mk_path_export_code (#tmp_export_code i_deep) ml_compiler i - fun mk_fic s = Path.append tmp_export_code (Path.make [s]) - val () = Deep0.Find.check_compil ml_compiler () - val () = Isabelle_System.mkdirs tmp_export_code in - (( ( (ml_compiler, ml_module) - , ( Path.implode (if Deep0.Find.export_mode ml_compiler = Deep0.Export_code_env.Directory then - tmp_export_code - else - mk_fic (Deep0.Find.function ml_compiler (Deep0.Find.ext ml_compiler))) - , Position.none)) - , export_arg), mk_fic) - end) - (List.filter (fn (("self", _), _) => false | _ => true) (#seri_args i_deep)) - val _ = - case seri_args' of [] => () | _ => - let val _ = - warning ("After closing Isabelle/jEdit, we may still need to remove this directory (by hand): " ^ - Path.implode (Path.expand (#tmp_export_code i_deep))) in - thy - |> Deep0.apply_hs_code_identifiers Deep0.Export_code_env.Haskell.function - |> Code_printing.apply_code_printing - |> Proof_Context.init_global - |> - Isabelle_Code_Target.export_code_cmd - (List.exists (fn (((("SML", _), _), _), _) => true | _ => false) seri_args') - [Deep0.Export_code_env.Isabelle.function] - (List.map fst seri_args') - end in - List.app (fn ((((ml_compiler, ml_module), _), _), mk_fic) => - Deep0.Find.init ml_compiler mk_fic ml_module Deep.mk_free thy) seri_args' end))) - l_mode - []) - (fn l_mode => fn thy => - let val l_mode = map (fn f => f thy) l_mode - in Data_gen.put { deep = map_filter (fn Gen_deep x => SOME x | _ => NONE) l_mode - , shallow = map_filter (fn Gen_shallow x => SOME x | _ => NONE) l_mode - , syntax_print = map_filter (fn Gen_syntax_print x => SOME x | _ => NONE) l_mode } thy end) - -fun update_compiler_config f = - Data_gen.map - (fn mode => { deep = map (apfst (META.compiler_env_config_update f)) (#deep mode) - , shallow = map (apfst (META.compiler_env_config_update f)) (#shallow mode) - , syntax_print = #syntax_print mode }) - -fun meta_command0 s_put f_get f_get0 source = - Context.Theory - #> Bind_META.ML_context_exec (Input.string ("let open META val ML = META.SML in Context.>> (Context.map_theory (fn thy => " ^ s_put ^ " ((" ^ source ^ ") (" ^ f_get0 ^ " thy)) thy)) end")) - #> Context.map_theory_result (fn thy => (f_get thy, thy)) - #> fst - -val meta_command = meta_command0 "Bind_META.Meta_Cmd_Data.put" - Bind_META.Meta_Cmd_Data.get - "Generation_mode.Data_gen.get" -end -\<close> - -subsection\<open>Factoring All Meta Commands Together\<close> - -setup\<open>ML_Antiquotation.inline \<^binding>\<open>mk_string\<close> (Scan.succeed -"(fn ctxt => fn x => ML_Pretty.string_of_polyml (ML_system_pretty (x, FixedInt.fromInt (Config.get ctxt ML_Print_Depth.print_depth))))") -\<close> - -ML\<open> - -local - val partition_self = List.partition (fn ((s,_),_) => s = "self") -in - -fun exec_deep0 {output_header_thy, seri_args, filename_thy, tmp_export_code, ...} (env, l_obj) = -let open Generation_mode - val of_arg = META.isabelle_of_compiler_env_config META.isabelle_apply I - fun def s = Named_Target.theory_map (snd o Specification.definition_cmd NONE [] [] (Binding.empty_atts, s) false) - val (seri_args0, seri_args) = partition_self seri_args - in - fn thy0 => - let - val env = META.compiler_env_config_more_map - (fn () => (l_obj, From.option - From.string - (Option.map (Deep.absolute_path thy0) filename_thy))) - env - val l = case seri_args of [] => [] | _ => - let val name_main = Deep.mk_free (Proof_Context.init_global thy0) - Deep0.Export_code_env.Isabelle.argument_main [] - in thy0 - |> def (String.concatWith " " - ( "(" (* polymorphism weakening needed by export_code *) - ^ name_main ^ " :: (_ \<times> abr_string option) compiler_env_config_scheme)" - :: "=" - :: To_string0 (of_arg env) - :: [])) - |> Deep.export_code_cmd' seri_args - tmp_export_code - (fn (((_, _), (msg, _)), _) => fn err => if err <> 0 then error msg else ()) - [name_main] - end - in - case seri_args0 of [] => l - | _ => ([], case (output_header_thy, filename_thy) of - (SOME _, SOME _) => let val _ = META.write_file env in "" end - | _ => String.concat (map (fn s => s ^ "\n") (snd (META.write_file0 env))) - (* TODO: further optimize "string" as "string list" *)) - :: l - end - |> (fn l => let val (l_warn, l) = (map fst l, map snd l) in - if Deep.list_all_eq l then - (List.concat l_warn, hd l) - else - error "There is an extracted language which does not produce a similar Isabelle content as the others" - end) - |> (fn (l_warn, s) => - let val () = writeln - (case (output_header_thy, filename_thy) of - (SOME _, SOME _) => s - | _ => String.concat (map ( (fn s => s ^ "\n") - o Active.sendback_markup_command - o trim_line) - (String.tokens (fn c => Char.ord c = META.integer_escape) s))) - in List.app (fn (out, err) => ( writeln (Markup.markup Markup.keyword2 err) - ; case trim_line out of "" => () - | out => writeln (Markup.markup Markup.keyword1 out))) - l_warn end) -end - -fun exec_deep i_deep e = - let val (seri_args0, seri_args) = partition_self (#seri_args i_deep) - in cons - ( case (seri_args0, seri_args) of ([_], []) => \<^command_keyword>\<open>print_syntax\<close> - | _ => \<^command_keyword>\<open>export_code\<close> - , Toplevel'.keep_theory (exec_deep0 i_deep e)) - end -end - -local - -fun fold_thy_shallow f = - META.fold_thy_shallow - (fn f => f () handle ERROR e => - ( warning "Shallow Backtracking: (true) Isabelle declarations occurring among the META-simulated ones are ignored (if any)" - (* TODO automatically determine if there is such Isabelle declarations, - for raising earlier a specific error message *) - ; error e)) - f - -fun disp_time toplevel_keep_output = - let - val tps = Timing.start () - val disp_time = fn NONE => I | SOME msg => - toplevel_keep_output tps Markup.antiquote - let val msg = To_string0 msg - in " " ^ Pretty.string_of - (Pretty.mark (Name_Space.markup (Proof_Context.const_space \<^context>) msg) - (Pretty.str msg)) end - in (tps, disp_time) end - -fun thy_deep exec_deep exec_info l_obj = - Generation_mode.mapM_deep - (META.mapM (fn (env, i_deep) => - pair (META.fold_thy_deep l_obj env, i_deep) - o (if #skip_exportation i_deep then - I - else - let fun exec l_obj = - exec_deep { output_header_thy = #output_header_thy i_deep - , seri_args = #seri_args i_deep - , filename_thy = NONE - , tmp_export_code = #tmp_export_code i_deep - , skip_exportation = #skip_exportation i_deep } - ( META.d_output_header_thy_update (K NONE) env, l_obj) - in - case l_obj of - META.Fold_meta obj => exec [obj] - | META.Fold_custom l_obj => - let val l_obj' = map_filter (fn META.META_all_meta_embedding x => SOME x - | _ => NONE) - l_obj - in if length l_obj' = length l_obj - then exec l_obj' - else - exec_info - (fn _ => - app ( writeln - o Active.sendback_markup_command - o META.print META.of_all_meta (META.d_output_header_thy_update (K NONE) env)) - l_obj) - end - end))) - -fun report m f = (Method.report m; f) -fun report_o o' f = (Option.map Method.report o'; f) - -fun thy_shallow l_obj get_all_meta_embed = - Generation_mode.mapM_shallow - (fn l_shallow => fn thy => META.mapM - (fn (env, thy0) => fn (thy, l_obj) => - let val (_, disp_time) = disp_time (tap o K ooo out_intensify') - fun aux x = - fold_thy_shallow - (K o K thy0) - (fn msg => - let val () = disp_time msg () - fun in_self f lthy = lthy - |> Local_Theory.new_group - |> f - |> Local_Theory.reset_group - |> Local_Theory.reset - fun not_used p _ = error ("not used " ^ Position.here p) - val context_of = I - fun proof' f = f true - fun proofs f s = s |> f |> Seq.the_result "" - val proof = I - val dual = #seq in - Bind_META.all_meta_thys (aux o META.Fold_meta) - - { (* specialized part *) - theory = I - , local_theory = K o K Named_Target.theory_map - , local_theory' = K o K (fn f => Named_Target.theory_map (f false)) - , keep = fn f => Named_Target.theory_map (fn lthy => (f lthy ; lthy)) - , generic_theory = Context.theory_map - (* generic part *) - , context_of = context_of, dual = dual - , proof' = proof', proofs = proofs, proof = proof - , tr_report = report, tr_report_o = report_o - , pr_report = report, pr_report_o = report_o - (* irrelevant part *) - , begin_local_theory = K o not_used \<^here> - , local_theory_to_proof' = K o K not_used \<^here> - , local_theory_to_proof = K o K not_used \<^here> - , tr_raw = not_used \<^here> } - - { (* specialized part *) - theory = Local_Theory.background_theory - , local_theory = K o K in_self - , local_theory' = K o K (fn f => in_self (f false)) - , keep = fn f => in_self (fn lthy => (f lthy ; lthy)) - , generic_theory = Context.proof_map - (* generic part *) - , context_of = context_of, dual = dual - , proof' = proof', proofs = proofs, proof = proof - , tr_report = report, tr_report_o = report_o - , pr_report = report, pr_report_o = report_o - (* irrelevant part *) - , begin_local_theory = K o not_used \<^here> - , local_theory_to_proof' = K o K not_used \<^here> - , local_theory_to_proof = K o K not_used \<^here> - , tr_raw = not_used \<^here> } - end) - x - val (env, thy) = - let - fun disp_time f x = - let val (s, r) = Timing.timing f x - val () = out_intensify (Timing.message s |> Markup.markup Markup.operator) "" in - r - end - in disp_time (fn x => aux x (env, thy)) (l_obj ()) end - in ((env, thy0), (thy, fn _ => get_all_meta_embed (SOME thy))) end) - l_shallow - (thy, case l_obj of SOME f => f | NONE => fn _ => get_all_meta_embed (SOME thy)) - |> META.map_prod I fst) - -fun thy_switch pos1 pos2 f mode tr = - ( ( mode - , Toplevel'.keep - (fn _ => Output.information ( "Theory required while transitions were being built" - ^ Position.here pos1 - ^ ": Commands will not be concurrently considered. " - ^ Markup.markup - (Markup.properties (Position.properties_of pos2) Markup.position) - "(Handled here\092<^here>)")) tr) - , f #~> Generation_mode.Data_gen.put) - -in - -fun outer_syntax_commands''' is_safe mk_string cmd_spec cmd_descr parser get_all_meta_embed = - let open Generation_mode in - Outer_Syntax.commands' cmd_spec cmd_descr - (parser >> (fn name => fn thy => fn _ => - (* WARNING: Whenever there would be errors raised by functions taking "thy" as input, - they will not be shown. - So the use of this "thy" can be considered as safe, as long as errors do not happen. *) - let - val get_all_m = get_all_meta_embed name - val m_tr = (Data_gen.get thy, []) - |-> mapM_syntax_print (META.mapM (fn n => - pair n - o cons (\<^command_keyword>\<open>print_syntax\<close>, - Toplevel'.keep_theory (fn thy => - writeln (mk_string - (Proof_Context.init_global - (case n of NONE => thy - | SOME n => Config.put_global ML_Print_Depth.print_depth n thy)) - name))))) - in let - val thy_o = is_safe thy - val l_obj = get_all_m thy_o - (* In principle, it is fine if (SOME thy) is provided to - get_all_m. However, because certain types of errors are most of the - time happening whenever certain specific operations depending on thy - are explicitly performed, and because get_all_m was intentionally set - to not interactively manage such errors, then these errors (whenever - they are happening) could possibly not appear in the output - window. Although the computation would be in any case interrupted as - usual (but with only minimal debugging information, such as a simple - red underlining color). - - Generally, whenever get_all_m is called during the evaluating commands - coming from generated files (which is not the case here, but will be - later), this restriction can normally be removed (i.e., by writing - (SOME thy)), as for the case of generated files, we are taking the - assumption that errors (if they are happening) are as hard to detect - as if an error was raised somewhere else by the generator itself. - Another assumption nevertheless related with the generator is that it - is supposed to explicitly not raise errors, however here this - get_all_m is not situated below a generating part. This is why we are - tempted to mostly give NONE to get_all_m, unless the calling command - is explicitly taking the responsibility of a potential failure. *) - val m_tr = m_tr - |-> thy_deep exec_deep Toplevel'.keep l_obj - in ( m_tr - |-> mapM_shallow (META.mapM (fn (env, thy_init) => fn acc => - let val (tps, disp_time) = disp_time Toplevel'.keep_output - fun aux thy_o = - fold_thy_shallow - (K (cons (Toplevel'.read_write_keep (Toplevel.Load_backup, Toplevel.Store_default)))) - (fn msg => fn l => - apsnd (disp_time msg) - #> Bind_META.all_meta_trs (aux thy_o o META.Fold_meta) - { context_of = Toplevel.context_of - , keep = Toplevel.keep - , generic_theory = Toplevel.generic_theory - , theory = Toplevel.theory - , begin_local_theory = Toplevel.begin_local_theory - , local_theory' = Toplevel.local_theory' - , local_theory = Toplevel.local_theory - , local_theory_to_proof' = Toplevel.local_theory_to_proof' - , local_theory_to_proof = Toplevel.local_theory_to_proof - , proof' = Toplevel.proof' - , proofs = Toplevel.proofs - , proof = Toplevel.proof - (* *) - , dual = #par, tr_raw = I - , tr_report = report, tr_report_o = report_o - , pr_report = report, pr_report_o = report_o } - thy_o - l) - in aux thy_o l_obj (env, acc) - |> META.map_prod - (fn env => (env, thy_init)) - (Toplevel'.keep_output tps Markup.operator "") end)) - , Data_gen.put) - handle THY_REQUIRED pos => - m_tr |-> thy_switch pos \<^here> (thy_shallow NONE get_all_m) - end - handle THY_REQUIRED pos => - m_tr |-> thy_switch pos \<^here> (fn mode => fn thy => - let val l_obj = get_all_m (SOME thy) in - (thy_deep (tap oo exec_deep0) tap l_obj - #~> thy_shallow (SOME (K l_obj)) get_all_m) mode thy - end) - end - |> uncurry Toplevel'.setup_theory)) - end -end - -fun outer_syntax_commands'' mk_string = outer_syntax_commands''' (K NONE) mk_string - -fun outer_syntax_commands' mk_string cmd_spec cmd_descr parser get_all_meta_embed = - outer_syntax_commands'' mk_string cmd_spec cmd_descr parser (META.Fold_meta oo get_all_meta_embed) - -fun outer_syntax_commands'2 mk_string cmd_spec cmd_descr parser get_all_meta_embed = - outer_syntax_commands''' SOME mk_string cmd_spec cmd_descr parser (META.Fold_meta oo get_all_meta_embed) -\<close> - -subsection\<open>Parameterizing the Semantics of Embedded Languages\<close> - -ML\<open> -val () = let open Generation_mode in - Outer_Syntax.commands' \<^command_keyword>\<open>generation_syntax\<close> "set the generating list" - (( mode >> (fn x => SOME [x]) - || parse_l' mode >> SOME - || \<^keyword>\<open>deep\<close> -- \<^keyword>\<open>flush_all\<close> >> K NONE) >> - (fn SOME x => K (K (f_command x)) - | NONE => fn thy => fn _ => [] - |> fold (fn (env, i_deep) => exec_deep i_deep (META.compiler_env_config_reset_all env)) - (#deep (Data_gen.get thy)) - |> (fn [] => Toplevel'.keep (fn _ => warning "Nothing performed.") [] - | l => l))) -end -\<close> - -end diff --git a/Citadelle/src/compiler/Generator_dynamic_sequential.thy b/Citadelle/src/compiler/Generator_dynamic_sequential.thy deleted file mode 100644 index fc9ffa7e40ac74e72fa1cd54992f1ca43f399296..0000000000000000000000000000000000000000 --- a/Citadelle/src/compiler/Generator_dynamic_sequential.thy +++ /dev/null @@ -1,2295 +0,0 @@ -(****************************************************************************** - * Citadelle - * - * 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. - ******************************************************************************) - -section\<open>Dynamic Meta Embedding with Reflection\<close> - -theory Generator_dynamic_sequential -imports Printer - "../compiler_generic/isabelle_home/src/HOL/Isabelle_Main2" - "~~/src/HOL/Library/Old_Datatype" - keywords (* OCL (USE tool) *) - "Between" - "Attributes" "Operations" "Constraints" - "Role" - "Ordered" "Subsets" "Union" "Redefines" "Derived" "Qualifier" - "Existential" "Inv" "Pre" "Post" - (* OCL (added) *) - "self" - "Nonunique" "Sequence_" - "with_only" - (* Haskabelle *) - "datatype_old" "datatype_old_atomic" "datatype_old_atomic_sub" - "try_import" "only_types" "base_path" "ignore_not_in_scope" "abstract_mutual_data_params" - "concat_modules" "load" "meta" "meta_cmd" - - (* Isabelle syntax *) - "output_directory" - "THEORY" "IMPORTS" "SECTION" "SORRY" "no_dirty" - "deep" "shallow" "syntax_print" "skip_export" - "generation_semantics" - "flush_all" - - (* Isabelle semantics (parameterizing the semantics of OCL) *) - "design" "analysis" "oid_start" - - and (* OCL (USE tool) *) - "Enum" - "Abstract_class" "Class" - "Association" "Composition" "Aggregation" - "Abstract_associationclass" "Associationclass" - "Context" - (* OCL (added) *) - "End" "Instance" "BaseType" "State" "Transition" "Tree" - (* Haskabelle *) - "Haskell" "Haskell_file" "meta_language" "language" "meta_command" "meta_command'" - - (* Isabelle syntax *) - "generation_syntax" - - :: thy_decl -begin - -text\<open>In the ``dynamic'' solution: the exportation is automatically handled inside Isabelle/jEdit. -Inputs are provided using the syntax of OCL, and in output -we basically have two options: -\begin{itemize} -\item The first is to generate an Isabelle file for inspection or debugging. -The generated file can interactively be loaded in Isabelle/jEdit, or saved to the hard disk. -This mode is called the ``deep exportation'' mode or shortly the ``deep'' mode. -The aim is to maximally automate the process one is manually performing in -\<^file>\<open>Generator_static.thy\<close>. -\item On the other hand, it is also possible to directly execute -in Isabelle/jEdit the generated file from the random access memory. -This mode corresponds to the ``shallow reflection'' mode or shortly ``shallow'' mode. -\end{itemize} -In both modes, the reflection is necessary since the main part used by both -was defined at Isabelle side. -As a consequence, experimentations in ``deep'' and ``shallow'' are performed -without leaving the editing session, in the same as the one the meta-compiler is actually running.\<close> - -apply_code_printing_reflect \<open> - val stdout_file = Unsynchronized.ref "" -\<close> text\<open>This variable is not used in this theory (only in \<^file>\<open>Generator_static.thy\<close>), - but needed for well typechecking the reflected SML code.\<close> - -code_reflect' open META - functions (* executing the compiler as monadic combinators for deep and shallow *) - fold_thy_deep fold_thy_shallow - - (* printing the HOL AST to (shallow Isabelle) string *) - write_file0 write_file - - (* manipulating the compiling environment *) - compiler_env_config_reset_all - compiler_env_config_update - oidInit - D_output_header_thy_update - map2_ctxt_term - check_export_code - - (* printing the input AST to (deep Isabelle) string *) - isabelle_apply isabelle_of_compiler_env_config - -subsection\<open>Interface Between the Reflected and the Native\<close> - -ML\<open> -val To_string0 = META.meta_of_logic -val To_nat = Code_Numeral.integer_of_natural - -exception THY_REQUIRED of Position.T -fun get_thy pos f = fn NONE => raise (THY_REQUIRED pos) | SOME thy => f thy - -infix 1 #~> |>:: -fun f #~> g = uncurry g oo f -fun x |>:: f = cons f x -\<close> - -ML\<open> -structure From = struct - val string = META.SS_base o META.ST - val binding = string o Binding.name_of - (*fun term ctxt s = string (YXML.content_of (Syntax.string_of_term ctxt s))*) - val nat = Code_Numeral.natural_of_integer - val internal_oid = META.Oid o nat - val option = Option.map - val list = List.map - fun pair f1 f2 (x, y) = (f1 x, f2 y) - fun pair3 f1 f2 f3 (x, y, z) = (f1 x, f2 y, f3 z) - - structure Pure = struct - val indexname = pair string nat - val class = string - val sort = list class - fun typ e = (fn - Type (s, l) => (META.Typea o pair string (list typ)) (s, l) - | TFree (s, s0) => (META.TFree o pair string sort) (s, s0) - | TVar (i, s0) => (META.TVara o pair indexname sort) (i, s0) - ) e - fun term e = (fn - Const (s, t) => (META.Consta o pair string typ) (s, t) - | Free (s, t) => (META.Free o pair string typ) (s, t) - | Var (i, t) => (META.Var o pair indexname typ) (i, t) - | Bound i => (META.Bound o nat) i - | Abs (s, ty, t) => (META.Absa o pair3 string typ term) (s, ty, t) - | op $ (term1, term2) => (META.Appa o pair term term) (term1, term2) - ) e - end - - fun read_term thy expr = - META.T_pure (Pure.term (Syntax.read_term (get_thy \<^here> Proof_Context.init_global thy) expr), SOME (string expr)) -end -\<close> - -ML\<open> -fun List_mapi f = META.mapi (f o To_nat) -fun out_intensify s1 s2 = Output.state ((s1 |> Markup.markup Markup.intensify) ^ s2) -fun out_intensify' tps fmt = out_intensify (Timing.message (Timing.result tps) |> Markup.markup fmt) - -structure Toplevel' = struct - datatype state_read = Load_backup | Load_previous - datatype state_write = Store_backup | Store_default - - datatype toplevel = Theory of theory -> theory - | Keep of theory -> unit - | Read_Write of state_read * state_write - - structure T = struct - val theory = cons o Theory - val keep = cons o Keep - val read_write = cons o Read_Write - end - - val keep_theory = T.keep - fun keep f tr = (\<^command_keyword>\<open>print_syntax\<close>, T.keep f) :: tr - fun read_write_keep rw = (\<^command_keyword>\<open>setup\<close>, fn tr => tr |> T.read_write rw |> T.keep (K ())) - fun setup_theory (res, tr) f = rev ((\<^command_keyword>\<open>setup\<close>, T.theory (f res)) :: tr) - fun keep_output tps fmt msg = cons (\<^command_keyword>\<open>print_syntax\<close>, T.keep (fn _ => out_intensify' tps fmt msg)) -end - -structure Outer_Syntax' = struct - fun command name_pos comment parse = - Outer_Syntax.command name_pos comment - (parse >> (fn f => - Toplevel.theory (fn thy => - fold snd (f thy NONE) [] |> rev - |> (fn tr => fold (fn Toplevel'.Theory f => f - | Toplevel'.Keep f => tap f - | Toplevel'.Read_Write _ => I) tr thy)))) -end - -structure Old_Datatype_Aux' = struct - fun default_config' n = - if n = 0 then - Old_Datatype_Aux.default_config - else - let val _ = warning "Type of datatype not available in this running version of Isabelle" - in Old_Datatype_Aux.default_config end -end - -structure Resources' = struct - fun check_path' check_file ctxt dir (name, pos) = - let - fun err msg pos = error (msg ^ Position.here pos) - val _ = Context_Position.report ctxt pos Markup.language_path; - - val path = Path.append dir (Path.explode name) handle ERROR msg => err msg pos; - val path' = Path.expand path handle ERROR msg => err msg pos; - val _ = Context_Position.report ctxt pos (Markup.path (Path.smart_implode path)); - val _ = - (case check_file of - NONE => path - | SOME check => (check path handle ERROR msg => err msg pos)); - in Path.implode path' end - - fun check_dir thy = check_path' (SOME File.check_dir) - (Proof_Context.init_global thy) - (Resources.master_directory thy) -end -\<close> - -ML\<open> -structure Ty' = struct -fun check l_oid l = - let val Mp = META.map_prod - val Me = String.explode - val Mi = String.implode - val Ml = map in - META.check_export_code - (writeln o Mi) - (warning o Mi) - (fn s => writeln (Markup.markup (Markup.bad ()) (Mi s))) - (error o To_string0) - (Ml (Mp I Me) l_oid) - ((META.SS_base o META.ST) l) - end -end -\<close> - -subsection\<open>Binding of the Reflected API to the Native API\<close> - -ML\<open> -structure META_overload = struct - val of_semi__typ = META.of_semi_typ To_string0 - val of_semi__term = META.of_semi_terma To_string0 - val of_semi__term' = META.of_semi_term To_string0 - val fold = fold -end -\<close> - -ML\<open> -type ('a, 'b) toplevel_dual = { par: 'a, seq: 'b } -type ('transitionM, 'Proof_stateM, 'state) toplevel = - { context_of: 'state -> local_theory - - , keep: ('state -> unit) -> 'transitionM - , generic_theory: (generic_theory -> generic_theory) -> 'transitionM - , theory: (theory -> theory) -> 'transitionM - , begin_local_theory: bool -> (theory -> local_theory) -> 'transitionM - , local_theory': (bool * Position.T) option -> (xstring * Position.T) option -> - (bool -> local_theory -> local_theory) -> 'transitionM - , local_theory: (bool * Position.T) option -> (xstring * Position.T) option -> - (local_theory -> local_theory) -> 'transitionM - , local_theory_to_proof': (bool * Position.T) option -> (xstring * Position.T) option -> - (bool -> local_theory -> Proof.state) -> 'transitionM - , local_theory_to_proof: (bool * Position.T) option -> (xstring * Position.T) option -> - (local_theory -> Proof.state) -> 'transitionM - , proof': (bool -> Proof.state -> Proof.state) -> 'Proof_stateM - , proofs: (Proof.state -> Proof.state Seq.result Seq.seq) -> 'Proof_stateM - , proof: (Proof.state -> Proof.state) -> 'Proof_stateM - (* *) - , tr_report: Method.text_range -> 'transitionM -> 'transitionM - , tr_report_o: Method.text_range option -> 'transitionM -> 'transitionM - , tr_raw: (Toplevel.transition -> Toplevel.transition) -> 'transitionM - , pr_report: Method.text_range -> 'Proof_stateM -> 'Proof_stateM - , pr_report_o: Method.text_range option -> 'Proof_stateM -> 'Proof_stateM - , dual: (Toplevel.transition -> Toplevel.transition, Proof.state -> Proof.state) toplevel_dual -> 'Proof_stateM } - -structure Bind_Isabelle = struct -fun To_binding s = Binding.make (s, Position.none) -val To_sbinding = To_binding o To_string0 - -fun semi__method_simp g f = Method.Basic (fn ctxt => SIMPLE_METHOD (g (asm_full_simp_tac (f ctxt)))) -val semi__method_simp_one = semi__method_simp (fn f => f 1) -val semi__method_simp_all = semi__method_simp (CHANGED_PROP o PARALLEL_GOALS o ALLGOALS) - -datatype semi__thm' = Thms_single' of thm - | Thms_mult' of thm list - -fun semi__thm_attribute ctxt = let open META open META_overload val S = fn Thms_single' t => t in - fn Thm_thm s => Thms_single' (Proof_Context.get_thm ctxt (To_string0 s)) - | Thm_thms s => Thms_mult' (Proof_Context.get_thms ctxt (To_string0 s)) - | Thm_THEN (e1, e2) => - (case (semi__thm_attribute ctxt e1, semi__thm_attribute ctxt e2) of - (Thms_single' e1, Thms_single' e2) => Thms_single' (e1 RSN (1, e2)) - | (Thms_mult' e1, Thms_mult' e2) => Thms_mult' (e1 RLN (1, e2))) - | Thm_simplified (e1, e2) => - Thms_single' (asm_full_simplify (clear_simpset ctxt addsimps [S (semi__thm_attribute ctxt e2)]) - (S (semi__thm_attribute ctxt e1))) - | Thm_OF (e1, e2) => - Thms_single' ([S (semi__thm_attribute ctxt e2)] MRS (S (semi__thm_attribute ctxt e1))) - | Thm_where (nth, l) => - Thms_single' (Rule_Insts.where_rule - ctxt - (List.map (fn (var, expr) => - (((To_string0 var, 0), Position.none), of_semi__term expr)) l) - [] - (S (semi__thm_attribute ctxt nth))) - | Thm_symmetric e1 => - let val e2 = S (semi__thm_attribute ctxt (Thm_thm (From.string "sym"))) in - case semi__thm_attribute ctxt e1 of - Thms_single' e1 => Thms_single' (e1 RSN (1, e2)) - | Thms_mult' e1 => Thms_mult' (e1 RLN (1, [e2])) - end - | Thm_of (nth, l) => - Thms_single' (Rule_Insts.of_rule - ctxt - (List.map (SOME o of_semi__term) l, []) - [] - (S (semi__thm_attribute ctxt nth))) -end - -fun semi__thm_attribute_single ctxt s = case (semi__thm_attribute ctxt s) of Thms_single' t => t - -fun semi__thm_mult ctxt = - let fun f thy = case (semi__thm_attribute ctxt thy) of Thms_mult' t => t - | Thms_single' t => [t] in - fn META.Thms_single thy => f thy - | META.Thms_mult thy => f thy - end - -fun semi__thm_mult_l ctxt l = List.concat (map (semi__thm_mult ctxt) l) - -fun semi__method_simp_only l ctxt = clear_simpset ctxt addsimps (semi__thm_mult_l ctxt l) -fun semi__method_simp_add_del_split (l_add, l_del, l_split) ctxt = - fold Splitter.add_split (semi__thm_mult_l ctxt l_split) - (ctxt addsimps (semi__thm_mult_l ctxt l_add) - delsimps (semi__thm_mult_l ctxt l_del)) - -fun semi__method expr = let open META open Method open META_overload in case expr of - Method_rule o_s => Basic (fn ctxt => - METHOD (HEADGOAL o Classical.rule_tac - ctxt - (case o_s of NONE => [] - | SOME s => [semi__thm_attribute_single ctxt s]))) - | Method_drule s => Basic (fn ctxt => drule ctxt 0 [semi__thm_attribute_single ctxt s]) - | Method_erule s => Basic (fn ctxt => erule ctxt 0 [semi__thm_attribute_single ctxt s]) - | Method_elim s => Basic (fn ctxt => elim ctxt [semi__thm_attribute_single ctxt s]) - | Method_intro l => Basic (fn ctxt => intro ctxt (map (semi__thm_attribute_single ctxt) l)) - | Method_subst (asm, l, s) => Basic (fn ctxt => - SIMPLE_METHOD' ((if asm then EqSubst.eqsubst_asm_tac else EqSubst.eqsubst_tac) - ctxt - (map (the o Int.fromString o To_string0) l) - [semi__thm_attribute_single ctxt s])) - | Method_insert l => Basic (fn ctxt => insert (semi__thm_mult_l ctxt l)) - | Method_plus t => Combinator ( no_combinator_info - , Repeat1 - , [Combinator (no_combinator_info, Then, List.map semi__method t)]) - | Method_option t => Combinator ( no_combinator_info - , Try - , [Combinator (no_combinator_info, Then, List.map semi__method t)]) - | Method_or t => Combinator (no_combinator_info, Orelse, List.map semi__method t) - | Method_one (Method_simp_only l) => semi__method_simp_one (semi__method_simp_only l) - | Method_one (Method_simp_add_del_split l) => semi__method_simp_one (semi__method_simp_add_del_split l) - | Method_all (Method_simp_only l) => semi__method_simp_all (semi__method_simp_only l) - | Method_all (Method_simp_add_del_split l) => semi__method_simp_all (semi__method_simp_add_del_split l) - | Method_auto_simp_add_split (l_simp, l_split) => - Basic (fn ctxt => SIMPLE_METHOD (auto_tac (fold (fn (f, l) => fold f l) - [(Simplifier.add_simp, semi__thm_mult_l ctxt l_simp) - ,(Splitter.add_split, List.map (Proof_Context.get_thm ctxt o To_string0) l_split)] - ctxt))) - | Method_rename_tac l => Basic (K (SIMPLE_METHOD' (Tactic.rename_tac (List.map To_string0 l)))) - | Method_case_tac e => - Basic (fn ctxt => SIMPLE_METHOD' (Induct_Tacs.case_tac ctxt (of_semi__term e) [] NONE)) - | Method_blast n => - Basic (case n of NONE => SIMPLE_METHOD' o blast_tac - | SOME lim => fn ctxt => SIMPLE_METHOD' (depth_tac ctxt (To_nat lim))) - | Method_clarify => Basic (fn ctxt => (SIMPLE_METHOD' (fn i => CHANGED_PROP (clarify_tac ctxt i)))) - | Method_metis (l_opt, l) => - Basic (fn ctxt => (METHOD oo Metis_Tactic.metis_method) - ( (if l_opt = [] then NONE else SOME (map To_string0 l_opt), NONE) - , map (semi__thm_attribute_single ctxt) l) - ctxt) -end - -fun then_tactic l = let open Method in - (Combinator (no_combinator_info, Then, map semi__method l), (Position.none, Position.none)) -end - -fun terminal_proof0 f1 f2 f3 top o_by = let open META in case o_by of - Command_done => (\<^command_keyword>\<open>done\<close>, #dual top { par = Isar_Cmd.done_proof - , seq = f1 }) - | Command_sorry => (\<^command_keyword>\<open>sorry\<close>, #dual top { par = Isar_Cmd.skip_proof - , seq = f2 true }) - | Command_by l_apply => (\<^command_keyword>\<open>by\<close>, let val (m1, m2) = (then_tactic l_apply, NONE) in - #pr_report top m1 - (#pr_report_o top m2 - (#dual top { par = Isar_Cmd.terminal_proof (m1, m2) - , seq = f3 (m1, m2) })) end) -end - -fun terminal_proof_dual top = - terminal_proof0 Proof.local_done_proof Proof.local_skip_proof Proof.local_terminal_proof top - -fun proof_show_gen top f (thes, thes_when) st = st - |>:: (\<^command_keyword>\<open>proof\<close>, - let val m = SOME ( Method.Source [Token.make_string ("-", Position.none)] - , (Position.none, Position.none)) in - (#pr_report_o top m (#proofs top (Proof.proof m))) end) - |> f - |>:: (\<^command_keyword>\<open>show\<close>, #proof' top (fn int => Proof.show_cmd - (thes_when = []) - NONE - (K I) - [] - (if thes_when = [] then [] else [(Binding.empty_atts, map (fn t => (t, [])) thes_when)]) - [(Binding.empty_atts, [(thes, [])])] - int #> #2)) - -fun semi__command_state top (META.Command_apply_end l) = let open META_overload in - cons (\<^command_keyword>\<open>apply_end\<close>, let val m = then_tactic l in - #pr_report top m (#proofs top (Proof.apply_end m)) end) -end - -fun semi__command_proof top = let open META_overload - val thesis = "?thesis" - fun cons_proof_show f = proof_show_gen top f (thesis, []) - fun cons_let (e1, e2) = - cons (\<^command_keyword>\<open>let\<close>, #proof top - (Proof.let_bind_cmd [([of_semi__term e1], of_semi__term e2)])) in - fn META.Command_apply l => - cons (\<^command_keyword>\<open>apply\<close>, let val m = then_tactic l in - #pr_report top m (#proofs top (Proof.apply m)) end) - | META.Command_using l => - cons (\<^command_keyword>\<open>using\<close>, #proof top (fn st => - Proof.using [map (fn s => ([s], [])) (semi__thm_mult_l (Proof.context_of st) l)] st)) - | META.Command_unfolding l => - cons (\<^command_keyword>\<open>unfolding\<close>, #proof top (fn st => - Proof.unfolding [map (fn s => ([s], [])) (semi__thm_mult_l (Proof.context_of st) l)] st)) - | META.Command_let e => - cons_proof_show (cons_let e) - | META.Command_have (n, b, e, e_pr) => (fn st => st - |> cons_proof_show (fn st => st - |>:: (\<^command_keyword>\<open>have\<close>, #proof' top (fn int => - Proof.have_cmd true NONE (K I) [] [] - [( (To_sbinding n, if b then [[Token.make_string ("simp", Position.none)]] else []) - , [(of_semi__term e, [])])] int #> #2)) - |>:: terminal_proof_dual top e_pr)) - | META.Command_fix_let (l, l_let, o_exp, _) => (fn st => st - |> proof_show_gen top (fn st => st - |>:: (\<^command_keyword>\<open>fix\<close>, #proof top - (Proof.fix_cmd (List.map (fn i => (To_sbinding i, NONE, NoSyn)) l))) - |> fold cons_let l_let) - ( case o_exp of NONE => thesis | SOME (l_spec, _) => - (String.concatWith (" \<Longrightarrow> ") - (List.map of_semi__term l_spec)) - , case o_exp of NONE => [] | SOME (_, l_when) => List.map of_semi__term l_when)) -end - -fun end' top = - (\<^command_keyword>\<open>end\<close>, #tr_raw top (Toplevel.exit o Toplevel.end_local_theory o Toplevel.close_target o - Toplevel.end_proof (K Proof.end_notepad))) - -structure Cmd = struct open META open META_overload -fun input_source ml = Input.source false (of_semi__term' ml) (Position.none, Position.none) - -fun datatype' top (Datatypea (version, l)) = - case version of Datatype_new => #local_theory top NONE NONE - (BNF_FP_Def_Sugar.co_datatype_cmd - BNF_Util.Least_FP - BNF_LFP.construct_lfp - (Ctr_Sugar.default_ctr_options_cmd, - (map (fn ((n, v), l) => - ( ( ( ((map (fn v => (SOME (To_binding ""), (To_string0 v, NONE))) v, To_sbinding n), NoSyn) - , List.map (fn (n, l) => ( ( (To_binding "", To_sbinding n) - , List.map (fn s => (To_binding "", of_semi__typ s)) l) - , NoSyn)) l) - , (To_binding "", To_binding "", To_binding "")) - , [])) l))) - | _ => #theory top - ((snd oo Old_Datatype.add_datatype_cmd - (Old_Datatype_Aux'.default_config' - (case version of Datatype_old => 0 | Datatype_old_atomic => 1 | _ => 2))) - (map (fn ((n, v), l) => - ( (To_sbinding n, map (fn v => (To_string0 v, NONE)) v, NoSyn) - , List.map (fn (n, l) => (To_sbinding n, List.map of_semi__typ l, NoSyn)) l)) - l)) - -fun type_synonym top (Type_synonym ((n, v), l)) = #theory top (fn thy => let val s_bind = To_sbinding n in - (snd o Typedecl.abbrev_global - (s_bind, map To_string0 v, NoSyn) - (Isabelle_Typedecl.abbrev_cmd0 (SOME s_bind) thy (of_semi__typ l))) thy end) - -fun type_notation top (Type_notation (n, e)) = #local_theory top NONE NONE - (Specification.type_notation_cmd true ("", true) [(To_string0 n, Mixfix (Input.string (To_string0 e), [], 1000, Position.no_range))]) - -fun instantiation1 name thy = thy - |> Class.instantiation ([ let val Term.Type (s, _) = Isabelle_Typedecl.abbrev_cmd0 NONE thy name in s end ], - [], - Syntax.read_sort (Proof_Context.init_global thy) "object") - -fun instantiation2 name n_def expr = - Specification.definition_cmd NONE [] [] ( (To_binding (To_string0 n_def ^ "_" ^ name ^ "_def"), []) - , of_semi__term expr) - -fun overloading1 n_c e_c = Overloading.overloading_cmd [(To_string0 n_c, of_semi__term e_c, true)] - -fun overloading2 n e = - #2 oo Specification.definition_cmd NONE [] [] ((To_sbinding n, []), of_semi__term e) - -fun consts top (Consts (n, ty, symb)) = #theory top - (Sign.add_consts_cmd [( To_sbinding n - , of_semi__typ ty - , Mixfix (Input.string ("(_) " ^ To_string0 symb), [], 1000, Position.no_range))]) - -fun definition top def = #local_theory' top NONE NONE - let val (def, e) = case def of - Definitiona e => (NONE, e) - | Definition_where1 (name, (abbrev, prio), e) => - (SOME ( To_sbinding name - , NONE - , Mixfix (Input.string ("(1" ^ of_semi__term abbrev ^ ")"), [], To_nat prio, Position.no_range)), e) - | Definition_where2 (name, abbrev, e) => - (SOME ( To_sbinding name - , NONE - , Mixfix (Input.string ("(" ^ of_semi__term abbrev ^ ")"), [], 1000, Position.no_range)), e) in fn ctxt => ctxt - |> #2 oo Specification.definition_cmd def [] [] (Binding.empty_atts, of_semi__term e) end - -fun lemmas top lemmas = #local_theory' top NONE NONE (fn disp => fn lthy => - let val (simp, s, l) = - case lemmas of Lemmas_simp_thm (simp, s, l) => - (simp, s, map (fn x => ([semi__thm_attribute_single lthy x], [])) l) - | Lemmas_simp_thms (s, l) => - (true, s, map (fn x => (Proof_Context.get_thms lthy (To_string0 x), [])) l) in - (#2 o Specification.theorems Thm.theoremK - [((To_sbinding s, List.map (fn s => Attrib.check_src lthy [Token.make_string (s, Position.none)]) - (if simp then ["simp", "code_unfold"] else [])), - l)] - [] - disp) lthy end) - -fun lemma1 n l_spec = Specification.theorem_cmd true Thm.theoremK NONE (K I) - Binding.empty_atts [] [] (Element.Shows [((To_sbinding n, []) - ,[((String.concatWith (" \<Longrightarrow> ") - (List.map of_semi__term l_spec)), [])])]) - -fun lemma1' n l_spec concl = Specification.theorem_cmd true Thm.theoremK NONE (K I) - (To_sbinding n, []) - [] - (List.map (fn (n, (b, e)) => - Element.Assumes [( ( To_sbinding n - , if b then [[Token.make_string ("simp", Position.none)]] else []) - , [(of_semi__term e, [])])]) - l_spec) - (Element.Shows [(Binding.empty_atts,[(of_semi__term concl, [])])]) - -fun lemma3 l_apply = map_filter (fn META.Command_let _ => SOME [] - | META.Command_have _ => SOME [] - | META.Command_fix_let (_, _, _, l) => SOME l - | _ => NONE) - (rev l_apply) - -fun axiomatization top (Axiomatization (n, e)) = #theory top - (#2 o Specification.axiomatization_cmd [] [] [] [((To_sbinding n, []), of_semi__term e)]) - -fun section n s _ = - let fun mk s n = if n <= 0 then s else mk (" " ^ s) (n - 1) in - out_intensify (mk (Markup.markup Markup.keyword3 (To_string0 s)) n) "" - end - -fun ml top (SMLa ml) = #generic_theory top - (ML_Context.exec let val source = input_source ml in - fn () => ML_Context.eval_source (ML_Compiler.verbose true ML_Compiler.flags) source - end #> - Local_Theory.propagate_ml_env) - -fun setup top (Setup ml) = #theory top (Isar_Cmd.setup (input_source ml)) - -fun thm top (Thm thm) = #keep top (fn state => - let val lthy = #context_of top state in - Print_Mode.with_modes [] (fn () => writeln - (Pretty.string_of - (Proof_Context.pretty_fact lthy ("", List.map (semi__thm_attribute_single lthy) thm)))) () - end) - -fun interpretation1 n loc_n loc_param = - Interpretation.interpretation_cmd ( [ ( (To_string0 loc_n, Position.none) - , ( (To_string0 n, true) - , ( if loc_param = [] then - Expression.Named [] - else - Expression.Positional (map (SOME o of_semi__term) - loc_param) - , [])))] - , []) - -fun hide_const top (Hide_const (fully, args)) = #theory top (fn thy => - fold (Sign.hide_const (not fully) o ((#1 o dest_Const) oo Proof_Context.read_const {proper = true, strict = false}) - (Proof_Context.init_global thy)) - (map To_string0 args) - thy) - -fun abbreviation top (Abbreviation e) = #local_theory' top NONE NONE - (Specification.abbreviation_cmd ("", true) NONE [] (of_semi__term e)) - -fun code_reflect' top (Code_reflect (all_public, module_name, raw_functions)) = #theory top - (Code_Runtime'.code_reflect_cmd all_public [] (map To_string0 raw_functions) (To_string0 module_name) NONE) - -end - -structure Command_Transition = struct - -fun semi__theory (top : ('transitionM, 'transitionM, 'state) toplevel) = let open META open META_overload - in (*let val f = *)fn - Theory_datatype datatype' => - cons (\<^command_keyword>\<open>datatype\<close>, Cmd.datatype' top datatype') -| Theory_type_synonym type_synonym => (*Toplevel.local_theory*) - cons (\<^command_keyword>\<open>type_synonym\<close>, Cmd.type_synonym top type_synonym) -| Theory_type_notation type_notation => - cons (\<^command_keyword>\<open>type_notation\<close>, Cmd.type_notation top type_notation) -| Theory_instantiation (Instantiation (n, n_def, expr)) => let val name = To_string0 n in fn acc => acc - |>:: (\<^command_keyword>\<open>instantiation\<close>, #begin_local_theory top true (Cmd.instantiation1 name)) - |>:: (\<^command_keyword>\<open>definition\<close>, #local_theory' top NONE NONE (#2 oo Cmd.instantiation2 name n_def expr)) - |>:: (\<^command_keyword>\<open>instance\<close>, #local_theory_to_proof top NONE NONE (Class.instantiation_instance I)) - |>:: (\<^command_keyword>\<open>..\<close>, #tr_raw top Isar_Cmd.default_proof) - |>:: end' top end -| Theory_overloading (Overloading (n_c, e_c, n, e)) => (fn acc => acc - |>:: (\<^command_keyword>\<open>overloading\<close>, #begin_local_theory top true (Cmd.overloading1 n_c e_c)) - |>:: (\<^command_keyword>\<open>definition\<close>, #local_theory' top NONE NONE (Cmd.overloading2 n e)) - |>:: end' top) -| Theory_consts consts => - cons (\<^command_keyword>\<open>consts\<close>, Cmd.consts top consts) -| Theory_definition definition => - cons (\<^command_keyword>\<open>definition\<close>, Cmd.definition top definition) -| Theory_lemmas lemmas => - cons (\<^command_keyword>\<open>lemmas\<close>, Cmd.lemmas top lemmas) -| Theory_lemma (Lemma (n, l_spec, l_apply, o_by)) => (fn acc => acc - |>:: (\<^command_keyword>\<open>lemma\<close>, #local_theory_to_proof' top NONE NONE (Cmd.lemma1 n l_spec)) - |> fold (semi__command_proof top o META.Command_apply) l_apply - |>:: terminal_proof_dual top o_by) -| Theory_lemma (Lemma_assumes (n, l_spec, concl, l_apply, o_by)) => (fn acc => acc - |>:: (\<^command_keyword>\<open>lemma\<close>, #local_theory_to_proof' top NONE NONE (Cmd.lemma1' n l_spec concl)) - |> fold (semi__command_proof top) l_apply - |> (fn st => st - |>:: terminal_proof_dual top o_by - |> (case Cmd.lemma3 l_apply of - [] => I - | _ :: l => - let fun cons_qed m = - cons (\<^command_keyword>\<open>qed\<close>, #tr_report_o top m (#tr_raw top (Isar_Cmd.qed m))) in fn st => st - |> fold (fn l => fold (semi__command_state top) l o cons_qed NONE) l - |> cons_qed NONE end))) -| Theory_axiomatization axiomatization => - cons (\<^command_keyword>\<open>axiomatization\<close>, Cmd.axiomatization top axiomatization) -| Theory_section (Section (n, s)) => let val n = To_nat n in fn st => st - |>:: (case n of 0 => - \<^command_keyword>\<open>section\<close> | 1 => - \<^command_keyword>\<open>subsection\<close> | _ => - \<^command_keyword>\<open>subsubsection\<close>, - #tr_raw top (Pure_Syn.document_command {markdown = false} (NONE, Input.string (To_string0 s)))) - |>:: (\<^command_keyword>\<open>print_syntax\<close>, #keep top (Cmd.section n s)) end -| Theory_text (Text s) => - cons (\<^command_keyword>\<open>text\<close>, - #tr_raw top (Pure_Syn.document_command {markdown = true} (NONE, Input.string (To_string0 s)))) -| Theory_text_raw (Text_raw s) => - cons (\<^command_keyword>\<open>text_raw\<close>, - #tr_raw top (Pure_Syn.document_command {markdown = true} (NONE, Input.string (To_string0 s)))) -| Theory_ML ml => - cons (\<^command_keyword>\<open>ML\<close>, Cmd.ml top ml) -| Theory_setup setup => - cons (\<^command_keyword>\<open>setup\<close>, Cmd.setup top setup) -| Theory_thm thm => - cons (\<^command_keyword>\<open>thm\<close>, Cmd.thm top thm) -| Theory_interpretation (Interpretation (n, loc_n, loc_param, o_by)) => (fn st => st - |>:: (\<^command_keyword>\<open>interpretation\<close>, #local_theory_to_proof top NONE NONE - (Cmd.interpretation1 n loc_n loc_param)) - |>:: terminal_proof_dual top o_by) -| Theory_hide_const hide_const => - cons (\<^command_keyword>\<open>hide_const\<close>, Cmd.hide_const top hide_const) -| Theory_abbreviation abbreviation => - cons (\<^command_keyword>\<open>abbreviation\<close>, Cmd.abbreviation top abbreviation) -| Theory_code_reflect code_reflect' => - cons (\<^command_keyword>\<open>code_reflect'\<close>, Cmd.code_reflect' top code_reflect') -(*in fn t => fn thy => f t thy handle ERROR s => (warning s; thy) - end*) -end -end - -structure Command_Theory = struct - -fun local_terminal_proof o_by = let open META in case o_by of - Command_done => Proof.local_done_proof - | Command_sorry => Proof.local_skip_proof true - | Command_by l_apply => Proof.local_terminal_proof (then_tactic l_apply, NONE) -end - -fun global_terminal_proof o_by = let open META in case o_by of - Command_done => Proof.global_done_proof - | Command_sorry => Proof.global_skip_proof true - | Command_by l_apply => Proof.global_terminal_proof (then_tactic l_apply, NONE) -end - -fun semi__command_state' top pr = fold snd (rev (semi__command_state top pr [])) -fun semi__command_proof' top pr = fold snd (rev (semi__command_proof top pr [])) - -fun semi__theory top = let open META open META_overload in (*let val f = *)fn - Theory_datatype datatype' => Cmd.datatype' top datatype' -| Theory_type_synonym type_synonym => Cmd.type_synonym top type_synonym -| Theory_type_notation type_notation => Cmd.type_notation top type_notation -| Theory_instantiation (Instantiation (n, n_def, expr)) => #theory top (fn thy => let val name = To_string0 n in thy - |> Cmd.instantiation1 name - |> (fn thy => let val ((_, (_, ty)), thy) = Cmd.instantiation2 name n_def expr false thy in ([ty], thy) end) - |-> Class.prove_instantiation_exit_result (map o Morphism.thm) (fn ctxt => fn thms => - Class.intro_classes_tac ctxt [] THEN ALLGOALS (Proof_Context.fact_tac ctxt thms)) - |-> K I end) -| Theory_overloading (Overloading (n_c, e_c, n, e)) => #theory top (fn thy => thy - |> Cmd.overloading1 n_c e_c - |> Cmd.overloading2 n e false - |> Local_Theory.exit_global) -| Theory_consts consts => Cmd.consts top consts -| Theory_definition definition => Cmd.definition top definition -| Theory_lemmas lemmas => Cmd.lemmas top lemmas -| Theory_lemma (Lemma (n, l_spec, l_apply, o_by)) => #local_theory top NONE NONE (fn lthy => lthy - |> Cmd.lemma1 n l_spec false - |> fold (semi__command_proof' top o META.Command_apply) l_apply - |> global_terminal_proof o_by) -| Theory_lemma (Lemma_assumes (n, l_spec, concl, l_apply, o_by)) => #local_theory top NONE NONE (fn lthy => lthy - |> Cmd.lemma1' n l_spec concl false - |> fold (semi__command_proof' top) l_apply - |> (case Cmd.lemma3 l_apply of - [] => global_terminal_proof o_by - | _ :: l => let val arg = (NONE, true) in fn st => st - |> local_terminal_proof o_by - |> fold (fn l => fold (semi__command_state' top) l o Proof.local_qed arg) l - |> Proof.global_qed arg end)) -| Theory_axiomatization axiomatization => Cmd.axiomatization top axiomatization -| Theory_section (Section (n, s)) => #keep top (Cmd.section (To_nat n) s) -| Theory_text _ => #keep top (K ()) -| Theory_text_raw _ => #keep top (K ()) -| Theory_ML ml => Cmd.ml top ml -| Theory_setup setup => Cmd.setup top setup -| Theory_thm thm => Cmd.thm top thm -| Theory_interpretation (Interpretation (n, loc_n, loc_param, o_by)) => #local_theory top NONE NONE (fn lthy => lthy - |> Cmd.interpretation1 n loc_n loc_param - |> global_terminal_proof o_by) -| Theory_hide_const hide_const => Cmd.hide_const top hide_const -| Theory_abbreviation abbreviation => Cmd.abbreviation top abbreviation -| Theory_code_reflect code_reflect' => Cmd.code_reflect' top code_reflect' -(*in fn t => fn thy => f t thy handle ERROR s => (warning s; thy) - end*) -end -end - -end - -structure Bind_META = struct open Bind_Isabelle - -structure Meta_Cmd_Data = Theory_Data - (open META - type T = META.all_meta list - val empty = [] - val extend = I - val merge = #2) - -fun ML_context_exec source = - ML_Context.exec (fn () => - ML_Context.eval_source (ML_Compiler.verbose false ML_Compiler.flags) source) #> - Local_Theory.propagate_ml_env - -fun meta_command0 s_put f_get source = - Context.Theory - #> ML_context_exec (Input.string ("let open META val ML = META.SML in Context.>> (Context.map_theory (" ^ s_put ^ " (" ^ source ^ "))) end")) - #> Context.map_theory_result (fn thy => (f_get thy, thy)) - #> fst - -val meta_command = meta_command0 "Bind_META.Meta_Cmd_Data.put" Meta_Cmd_Data.get - -local - open META - open META_overload - open Library - - fun semi__locale data thy = thy - |> ( Expression.add_locale_cmd - (To_sbinding (META.holThyLocale_name data)) - Binding.empty - ([], []) - (List.concat - (map - (fn (fixes, assumes) => List.concat - [ map (fn (e,ty) => Element.Fixes [( To_binding (of_semi__term e) - , SOME (of_semi__typ ty) - , NoSyn)]) fixes - , case assumes of NONE => [] - | SOME (n, e) => [Element.Assumes [( (To_sbinding n, []) - , [(of_semi__term e, [])])]]]) - (META.holThyLocale_header data))) - #> #2) - - fun semi__aux thy = - map2_ctxt_term - (fn T_pure x => T_pure x - | e => - let fun aux e = case e of - T_to_be_parsed (s, _) => SOME let val t = Syntax.read_term (get_thy \<^here> Proof_Context.init_global thy) - (To_string0 s) in - (t, s, Term.add_frees t []) - end - | T_lambda (a, e) => - Option.map - (fn (e, s, l_free) => - let val a0 = To_string0 a - val (t, l_free) = case List.partition (fn (x, _) => x = a0) l_free of - ([], l_free) => (Term.TFree ("'a", ["HOL.type"]), l_free) - | ([(_, t)], l_free) => (t, l_free) in - (lambda ( Term.Free (a0, t)) e - , META.String_concatWith (From.string "", [From.string "(% ", a, From.string ". ", s, From.string ")"]) - , l_free) - end) - (aux e) - | _ => NONE in - case aux e of - NONE => error "nested pure expression not expected" - | SOME (e, s, _) => META.T_pure (From.Pure.term e, SOME s) - end) -in - -fun all_meta_tr aux top thy_o = fn - META_semi_theories theo => apsnd - (case theo of - Theories_one theo => Command_Transition.semi__theory top theo - | Theories_locale (data, l) => fn acc => acc - |>:: (\<^command_keyword>\<open>locale\<close>, #begin_local_theory top true (semi__locale data)) - |> fold (fold (Command_Transition.semi__theory top)) l - |>:: end' top) -| META_boot_generation_syntax _ => I -| META_boot_setup_env _ => I -| META_all_meta_embedding (META_generic (OclGeneric source)) => - (fn (env, tr) => - all_meta_trs - aux - top - thy_o - (get_thy \<^here> - (fn thy => - get_thy \<^here> - (meta_command (To_string0 source)) - (if forall (fn ((key, _), _) => - Keyword.is_vacuous (Thy_Header.get_keywords thy) key) - tr - then SOME thy else NONE)) - thy_o) - (env, tr)) -| META_all_meta_embedding meta => aux (semi__aux NONE meta) - -and all_meta_trs aux = fold oo all_meta_tr aux - -fun all_meta_thy aux top_theory top_local_theory = fn - META_semi_theories theo => apsnd - (case theo of - Theories_one theo => Command_Theory.semi__theory top_theory theo - | Theories_locale (data, l) => (*Toplevel.begin_local_theory*) fn thy => thy - |> semi__locale data - |> fold (fold (Command_Theory.semi__theory top_local_theory)) l - |> Local_Theory.exit_global) -| META_boot_generation_syntax _ => I -| META_boot_setup_env _ => I -| META_all_meta_embedding (META_generic (OclGeneric source)) => - (fn (env, thy) => - all_meta_thys aux top_theory top_local_theory (meta_command (To_string0 source) thy) (env, thy)) -| META_all_meta_embedding meta => fn (env, thy) => aux (semi__aux (SOME thy) meta) (env, thy) - -and all_meta_thys aux = fold oo all_meta_thy aux - -end -end -\<close> - -subsection\<open>Directives of Compilation for Target Languages\<close> - -ML\<open> -structure Deep0 = struct - -fun apply_hs_code_identifiers ml_module thy = - let fun mod_hs (fic, ml_module) = Code_Symbol.Module (fic, [("Haskell", SOME ml_module)]) in - fold (Code_Target.set_identifiers o mod_hs) - (map (fn x => (Context.theory_name x, ml_module)) - (* list of .hs files that will be merged together in "ml_module" *) - ( thy - :: (* we over-approximate the set of compiler files *) - Context.ancestors_of thy)) thy end - -structure Export_code_env = struct - structure Isabelle = struct - val function = "write_file" - val argument_main = "main" - end - - structure Haskell = struct - val function = "Function" - val argument = "Argument" - val main = "Main" - structure Filename = struct - fun hs_function ext = function ^ "." ^ ext - fun hs_argument ext = argument ^ "." ^ ext - fun hs_main ext = main ^ "." ^ ext - end - end - - structure OCaml = struct - val make = "write" - structure Filename = struct - fun function ext = "function." ^ ext - fun argument ext = "argument." ^ ext - fun main_fic ext = "main." ^ ext - fun makefile ext = make ^ "." ^ ext - end - end - - structure Scala = struct - structure Filename = struct - fun function ext = "Function." ^ ext - fun argument ext = "Argument." ^ ext - end - end - - structure SML = struct - val main = "Run" - structure Filename = struct - fun function ext = "Function." ^ ext - fun argument ext = "Argument." ^ ext - fun stdout ext = "Stdout." ^ ext - fun main_fic ext = main ^ "." ^ ext - end - end - - datatype file_input = File - | Directory -end - -fun compile l cmd = - let val (l, rc) = fold (fn cmd => (fn (l, 0) => - let val {out, err, rc, ...} = Bash.process cmd in - ((out, err) :: l, rc) end - | x => x)) l ([], 0) - val l = rev l in - if rc = 0 then - (l, Isabelle_System.bash_output cmd) - else - let val () = fold (fn (out, err) => K (warning err; writeln out)) l () in - error "Compilation failed" - end - end - -val check = - fold (fn (cmd, msg) => fn () => - let val (out, rc) = Isabelle_System.bash_output cmd in - if rc = 0 then - () - else - ( writeln out - ; error msg) - end) - -val compiler = [] - -structure Find = struct - -fun find ml_compiler = - case List.find (fn (ml_compiler0, _, _, _, _, _, _) => ml_compiler0 = ml_compiler) compiler of - SOME v => v - | NONE => error ("Not registered compiler: " ^ ml_compiler) - -fun ext ml_compiler = case find ml_compiler of (_, ext, _, _, _, _, _) => ext - -fun export_mode ml_compiler = case find ml_compiler of (_, _, mode, _, _, _, _) => mode - -fun function ml_compiler = case find ml_compiler of (_, _, _, f, _, _, _) => f - -fun check_compil ml_compiler = case find ml_compiler of (_, _, _, _, build, _, _) => build - -fun init ml_compiler = case find ml_compiler of (_, _, _, _, _, build, _) => build - -fun build ml_compiler = case find ml_compiler of (_, _, _, _, _, _, build) => build -end - -end -\<close> - -ML\<open> -structure Deep = struct - -fun absolute_path thy filename = - Path.implode (Path.append (Resources.master_directory thy) (Path.explode filename)) - -fun export_code_tmp_file seris g = - fold - (fn ((ml_compiler, ml_module), export_arg) => fn f => fn g => - f (fn accu => - let val tmp_name = Context.theory_name \<^theory> in - (if Deep0.Find.export_mode ml_compiler = Deep0.Export_code_env.Directory then - Isabelle_System.with_tmp_dir tmp_name - else - Isabelle_System.with_tmp_file tmp_name (Deep0.Find.ext ml_compiler)) - (fn filename => - g (((((ml_compiler, ml_module), (Path.implode filename, Position.none)), export_arg) :: accu))) - end)) - seris - (fn f => f []) - (g o rev) - -fun mk_path_export_code tmp_export_code ml_compiler i = - Path.append tmp_export_code (Path.make [ml_compiler ^ Int.toString i]) - -fun export_code_cmd' seris tmp_export_code f_err raw_cs thy = - export_code_tmp_file seris - (fn seris => - let val mem_scala = List.exists (fn ((("Scala", _), _), _) => true | _ => false) seris - val _ = Isabelle_Code_Target.export_code_cmd - false - (if mem_scala then Deep0.Export_code_env.Isabelle.function :: raw_cs else raw_cs) - seris - (Proof_Context.init_global - let val v = Deep0.apply_hs_code_identifiers Deep0.Export_code_env.Haskell.argument thy in - if mem_scala then Code_printing.apply_code_printing v else v end) in - List_mapi - (fn i => fn seri => case seri of (((ml_compiler, _), (filename, _)), _) => - let val (l, (out, err)) = - Deep0.Find.build - ml_compiler - (mk_path_export_code tmp_export_code ml_compiler i) - filename - val _ = f_err seri err in - (l, out) - end) seris - end) - -fun mk_term ctxt s = - fst (Scan.pass (Context.Proof ctxt) Args.term (Token.explode0 (Thy_Header.get_keywords' ctxt) s)) - -fun mk_free ctxt s l = - let val t_s = mk_term ctxt s in - if Term.is_Free t_s then s else - let val l = (s, "") :: l in - mk_free ctxt (fst (hd (Term.variant_frees t_s l))) l - end - end - -val list_all_eq = fn x0 :: xs => - List.all (fn x1 => x0 = x1) xs - -end -\<close> - -subsection\<open>Saving the History of Meta Commands\<close> - -ML\<open> -fun p_gen f g = f "[" "]" g - (*|| f "{" "}" g*) - || f "(" ")" g -fun paren f = p_gen (fn s1 => fn s2 => fn f => Parse.$$$ s1 |-- f --| Parse.$$$ s2) f -fun parse_l f = Parse.$$$ "[" |-- Parse.!!! (Parse.list f --| Parse.$$$ "]") -fun parse_l_with f = Parse.$$$ "[" |-- Scan.optional (Parse.binding --| \<^keyword>\<open>with_only\<close> >> SOME) NONE - -- Parse.!!! (Parse.list f --| Parse.$$$ "]") -fun parse_l' f = Parse.$$$ "[" |-- Parse.list f --| Parse.$$$ "]" -fun parse_l1' f = Parse.$$$ "[" |-- Parse.list1 f --| Parse.$$$ "]" -fun annot_ty f = Parse.$$$ "(" |-- f --| Parse.$$$ "::" -- Parse.binding --| Parse.$$$ ")" -\<close> - -ML\<open> -structure Generation_mode = struct - -type internal_deep = - { output_header_thy : (string * (string list (* imports *) * string (* import optional (bootstrap) *))) option - , seri_args : ((bstring (* compiler *) * bstring (* main module *) ) * Token.T list) list - , filename_thy : bstring option - , tmp_export_code : Path.T (* dir *) - , skip_exportation : bool (* true: skip preview of code exportation *) } - -datatype ('a, 'b, 'c) generation_mode0 = Gen_deep of 'a | Gen_shallow of 'b | Gen_syntax_print of 'c - -type ('compiler_env_config_ext, 'a) generation_mode = - { deep : ('compiler_env_config_ext * internal_deep) list - , shallow : ('compiler_env_config_ext * 'a (* theory init *)) list - , syntax_print : int option list } - -fun mapM_syntax_print f (mode : ('compiler_env_config_ext, 'a) generation_mode) tr = tr - |> f (#syntax_print mode) - |> apfst (fn syntax_print => { syntax_print = syntax_print - , deep = #deep mode - , shallow = #shallow mode }) - -fun mapM_shallow f (mode : ('compiler_env_config_ext, 'a) generation_mode) tr = tr - |> f (#shallow mode) - |> apfst (fn shallow => { syntax_print = #syntax_print mode - , deep = #deep mode - , shallow = shallow }) - -fun mapM_deep f (mode : ('compiler_env_config_ext, 'a) generation_mode) tr = tr - |> f (#deep mode) - |> apfst (fn deep => { syntax_print = #syntax_print mode - , deep = deep - , shallow = #shallow mode }) - -structure Data_gen = Theory_Data - (type T = (unit META.compiler_env_config_ext, theory) generation_mode - val empty = {deep = [], shallow = [], syntax_print = [NONE]} - val extend = I - fun merge (e1, e2) = { deep = #deep e1 @ #deep e2 - , shallow = #shallow e1 @ #shallow e2 - , syntax_print = #syntax_print e1 @ #syntax_print e2 }) - -val code_expr_argsP = Scan.optional (\<^keyword>\<open>(\<close> |-- Parse.args --| \<^keyword>\<open>)\<close>) [] - -val parse_scheme = - \<^keyword>\<open>design\<close> >> K META.Gen_only_design || \<^keyword>\<open>analysis\<close> >> K META.Gen_only_analysis - -val parse_sorry_mode = - Scan.optional ( \<^keyword>\<open>SORRY\<close> >> K (SOME META.Gen_sorry) - || \<^keyword>\<open>no_dirty\<close> >> K (SOME META.Gen_no_dirty)) NONE - -val parse_deep = - Scan.optional (\<^keyword>\<open>skip_export\<close> >> K true) false - -- Scan.optional (((Parse.$$$ "(" -- \<^keyword>\<open>THEORY\<close>) |-- Parse.name -- ((Parse.$$$ ")" - -- Parse.$$$ "(" -- \<^keyword>\<open>IMPORTS\<close>) |-- parse_l' Parse.name -- Parse.name) - --| Parse.$$$ ")") >> SOME) NONE - -- Scan.optional (\<^keyword>\<open>SECTION\<close> >> K true) false - -- parse_sorry_mode - -- (* code_expr_inP *) parse_l1' (\<^keyword>\<open>in\<close> |-- ((\<^keyword>\<open>self\<close> || Parse.name) - -- Scan.optional (\<^keyword>\<open>module_name\<close> |-- Parse.name) "" - -- code_expr_argsP)) - -- Scan.optional - ((Parse.$$$ "(" -- \<^keyword>\<open>output_directory\<close>) |-- Parse.name --| Parse.$$$ ")" >> SOME) - NONE - -val parse_semantics = - let val z = 0 in - Scan.optional - (paren (\<^keyword>\<open>generation_semantics\<close> - |-- paren (parse_scheme - -- Scan.optional ((Parse.$$$ "," -- \<^keyword>\<open>oid_start\<close>) |-- Parse.nat) - z))) - (META.Gen_default, z) - end - -val mode = - let fun mk_env output_disable_thy output_header_thy oid_start design_analysis sorry_mode ctxt = - META.compiler_env_config_empty - output_disable_thy - (From.option (From.pair From.string (From.pair (From.list From.string) From.string)) - output_header_thy) - (META.oidInit (From.internal_oid oid_start)) - design_analysis - (sorry_mode, Config.get ctxt quick_and_dirty) in - - \<^keyword>\<open>deep\<close> |-- parse_semantics -- parse_deep >> - (fn ( (design_analysis, oid_start) - , ( ((((skip_exportation, output_header_thy), output_disable_thy), sorry_mode), seri_args) - , filename_thy)) => - Gen_deep ( mk_env (not output_disable_thy) - output_header_thy - oid_start - design_analysis - sorry_mode - , { output_header_thy = output_header_thy - , seri_args = seri_args - , filename_thy = filename_thy - , tmp_export_code = Isabelle_System.create_tmp_path "deep_export_code" "" - , skip_exportation = skip_exportation })) - || \<^keyword>\<open>shallow\<close> |-- parse_semantics -- parse_sorry_mode >> - (fn ((design_analysis, oid_start), sorry_mode) => - Gen_shallow (mk_env true - NONE - oid_start - design_analysis - sorry_mode)) - || (\<^keyword>\<open>syntax_print\<close> |-- Scan.optional (Parse.number >> SOME) NONE) >> - (fn n => Gen_syntax_print (case n of NONE => NONE | SOME n => Int.fromString n)) - end - -fun f_command l_mode = - Toplevel'.setup_theory - (META.mapM - (fn Gen_shallow env => - pair (fn thy => Gen_shallow (env (Proof_Context.init_global thy), thy)) - o cons (Toplevel'.read_write_keep (Toplevel'.Load_previous, Toplevel'.Store_backup)) - | Gen_syntax_print n => pair (K (Gen_syntax_print n)) - | Gen_deep (env, i_deep) => - pair (fn thy => Gen_deep (env (Proof_Context.init_global thy), i_deep)) - o cons - (\<^command_keyword>\<open>export_code\<close>, Toplevel'.keep_theory (fn thy => - let val seri_args' = - List_mapi - (fn i => fn ((ml_compiler, ml_module), export_arg) => - let val tmp_export_code = Deep.mk_path_export_code (#tmp_export_code i_deep) ml_compiler i - fun mk_fic s = Path.append tmp_export_code (Path.make [s]) - val () = Deep0.Find.check_compil ml_compiler () - val () = Isabelle_System.mkdirs tmp_export_code in - (( ( (ml_compiler, ml_module) - , ( Path.implode (if Deep0.Find.export_mode ml_compiler = Deep0.Export_code_env.Directory then - tmp_export_code - else - mk_fic (Deep0.Find.function ml_compiler (Deep0.Find.ext ml_compiler))) - , Position.none)) - , export_arg), mk_fic) - end) - (List.filter (fn (("self", _), _) => false | _ => true) (#seri_args i_deep)) - val _ = - case seri_args' of [] => () | _ => - let val _ = - warning ("After closing Isabelle/jEdit, we may still need to remove this directory (by hand): " ^ - Path.implode (Path.expand (#tmp_export_code i_deep))) in - thy - |> Deep0.apply_hs_code_identifiers Deep0.Export_code_env.Haskell.function - |> Code_printing.apply_code_printing - |> Proof_Context.init_global - |> - Isabelle_Code_Target.export_code_cmd - (List.exists (fn (((("SML", _), _), _), _) => true | _ => false) seri_args') - [Deep0.Export_code_env.Isabelle.function] - (List.map fst seri_args') - end in - List.app (fn ((((ml_compiler, ml_module), _), _), mk_fic) => - Deep0.Find.init ml_compiler mk_fic ml_module Deep.mk_free thy) seri_args' end))) - l_mode - []) - (fn l_mode => fn thy => - let val l_mode = map (fn f => f thy) l_mode - in Data_gen.put { deep = map_filter (fn Gen_deep x => SOME x | _ => NONE) l_mode - , shallow = map_filter (fn Gen_shallow x => SOME x | _ => NONE) l_mode - , syntax_print = map_filter (fn Gen_syntax_print x => SOME x | _ => NONE) l_mode } thy end) - -fun update_compiler_config f = - Data_gen.map - (fn mode => { deep = map (apfst (META.compiler_env_config_update f)) (#deep mode) - , shallow = map (apfst (META.compiler_env_config_update f)) (#shallow mode) - , syntax_print = #syntax_print mode }) - -fun meta_command0 s_put f_get f_get0 source = - Context.Theory - #> Bind_META.ML_context_exec (Input.string ("let open META val ML = META.SML in Context.>> (Context.map_theory (fn thy => " ^ s_put ^ " ((" ^ source ^ ") (" ^ f_get0 ^ " thy)) thy)) end")) - #> Context.map_theory_result (fn thy => (f_get thy, thy)) - #> fst - -val meta_command = meta_command0 "Bind_META.Meta_Cmd_Data.put" - Bind_META.Meta_Cmd_Data.get - "Generation_mode.Data_gen.get" -end -\<close> - -subsection\<open>Factoring All Meta Commands Together\<close> - -setup\<open>ML_Antiquotation.inline \<^binding>\<open>mk_string\<close> (Scan.succeed -"(fn ctxt => fn x => ML_Pretty.string_of_polyml (ML_system_pretty (x, FixedInt.fromInt (Config.get ctxt ML_Print_Depth.print_depth))))") -\<close> - -ML\<open> - -local - val partition_self = List.partition (fn ((s,_),_) => s = "self") -in - -fun exec_deep0 {output_header_thy, seri_args, filename_thy, tmp_export_code, ...} (env, l_obj) = -let open Generation_mode - val of_arg = META.isabelle_of_compiler_env_config META.isabelle_apply I - fun def s = Named_Target.theory_map (snd o Specification.definition_cmd NONE [] [] (Binding.empty_atts, s) false) - val (seri_args0, seri_args) = partition_self seri_args - in - fn thy0 => - let - val env = META.compiler_env_config_more_map - (fn () => (l_obj, From.option - From.string - (Option.map (Deep.absolute_path thy0) filename_thy))) - env - val l = case seri_args of [] => [] | _ => - let val name_main = Deep.mk_free (Proof_Context.init_global thy0) - Deep0.Export_code_env.Isabelle.argument_main [] - in thy0 - |> def (String.concatWith " " - ( "(" (* polymorphism weakening needed by export_code *) - ^ name_main ^ " :: (_ \<times> abr_string option) compiler_env_config_scheme)" - :: "=" - :: To_string0 (of_arg env) - :: [])) - |> Deep.export_code_cmd' seri_args - tmp_export_code - (fn (((_, _), (msg, _)), _) => fn err => if err <> 0 then error msg else ()) - [name_main] - end - in - case seri_args0 of [] => l - | _ => ([], case (output_header_thy, filename_thy) of - (SOME _, SOME _) => let val _ = META.write_file env in "" end - | _ => String.concat (map (fn s => s ^ "\n") (snd (META.write_file0 env))) - (* TODO: further optimize "string" as "string list" *)) - :: l - end - |> (fn l => let val (l_warn, l) = (map fst l, map snd l) in - if Deep.list_all_eq l then - (List.concat l_warn, hd l) - else - error "There is an extracted language which does not produce a similar Isabelle content as the others" - end) - |> (fn (l_warn, s) => - let val () = writeln - (case (output_header_thy, filename_thy) of - (SOME _, SOME _) => s - | _ => String.concat (map ( (fn s => s ^ "\n") - o Active.sendback_markup_command - o trim_line) - (String.tokens (fn c => Char.ord c = META.integer_escape) s))) - in List.app (fn (out, err) => ( writeln (Markup.markup Markup.keyword2 err) - ; case trim_line out of "" => () - | out => writeln (Markup.markup Markup.keyword1 out))) - l_warn end) -end - -fun exec_deep i_deep e = - let val (seri_args0, seri_args) = partition_self (#seri_args i_deep) - in cons - ( case (seri_args0, seri_args) of ([_], []) => \<^command_keyword>\<open>print_syntax\<close> - | _ => \<^command_keyword>\<open>export_code\<close> - , Toplevel'.keep_theory (exec_deep0 i_deep e)) - end -end - -local - -fun fold_thy_shallow f = - META.fold_thy_shallow - (fn f => f () handle ERROR e => - ( warning "Shallow Backtracking: (true) Isabelle declarations occurring among the META-simulated ones are ignored (if any)" - (* TODO automatically determine if there is such Isabelle declarations, - for raising earlier a specific error message *) - ; error e)) - f - -fun disp_time toplevel_keep_output = - let - val tps = Timing.start () - val disp_time = fn NONE => I | SOME msg => - toplevel_keep_output tps Markup.antiquote - let val msg = To_string0 msg - in " " ^ Pretty.string_of - (Pretty.mark (Name_Space.markup (Proof_Context.const_space \<^context>) msg) - (Pretty.str msg)) end - in (tps, disp_time) end - -fun thy_deep exec_deep exec_info l_obj = - Generation_mode.mapM_deep - (META.mapM (fn (env, i_deep) => - pair (META.fold_thy_deep l_obj env, i_deep) - o (if #skip_exportation i_deep then - I - else - let fun exec l_obj = - exec_deep { output_header_thy = #output_header_thy i_deep - , seri_args = #seri_args i_deep - , filename_thy = NONE - , tmp_export_code = #tmp_export_code i_deep - , skip_exportation = #skip_exportation i_deep } - ( META.d_output_header_thy_update (K NONE) env, l_obj) - in - case l_obj of - META.Fold_meta obj => exec [obj] - | META.Fold_custom l_obj => - let val l_obj' = map_filter (fn META.META_all_meta_embedding x => SOME x - | _ => NONE) - l_obj - in if length l_obj' = length l_obj - then exec l_obj' - else - exec_info - (fn _ => - app ( writeln - o Active.sendback_markup_command - o META.print META.of_all_meta (META.d_output_header_thy_update (K NONE) env)) - l_obj) - end - end))) - -fun report m f = (Method.report m; f) -fun report_o o' f = (Option.map Method.report o'; f) - -fun thy_shallow l_obj get_all_meta_embed = - Generation_mode.mapM_shallow - (fn l_shallow => fn thy => META.mapM - (fn (env, thy0) => fn (thy, l_obj) => - let val (_, disp_time) = disp_time (tap o K ooo out_intensify') - fun aux x = - fold_thy_shallow - (K o K thy0) - (fn msg => - let val () = disp_time msg () - fun in_self f lthy = lthy - |> Local_Theory.new_group - |> f - |> Local_Theory.reset_group - |> Local_Theory.reset - fun not_used p _ = error ("not used " ^ Position.here p) - val context_of = I - fun proof' f = f true - fun proofs f s = s |> f |> Seq.the_result "" - val proof = I - val dual = #seq in - Bind_META.all_meta_thys (aux o META.Fold_meta) - - { (* specialized part *) - theory = I - , local_theory = K o K Named_Target.theory_map - , local_theory' = K o K (fn f => Named_Target.theory_map (f false)) - , keep = fn f => Named_Target.theory_map (fn lthy => (f lthy ; lthy)) - , generic_theory = Context.theory_map - (* generic part *) - , context_of = context_of, dual = dual - , proof' = proof', proofs = proofs, proof = proof - , tr_report = report, tr_report_o = report_o - , pr_report = report, pr_report_o = report_o - (* irrelevant part *) - , begin_local_theory = K o not_used \<^here> - , local_theory_to_proof' = K o K not_used \<^here> - , local_theory_to_proof = K o K not_used \<^here> - , tr_raw = not_used \<^here> } - - { (* specialized part *) - theory = Local_Theory.background_theory - , local_theory = K o K in_self - , local_theory' = K o K (fn f => in_self (f false)) - , keep = fn f => in_self (fn lthy => (f lthy ; lthy)) - , generic_theory = Context.proof_map - (* generic part *) - , context_of = context_of, dual = dual - , proof' = proof', proofs = proofs, proof = proof - , tr_report = report, tr_report_o = report_o - , pr_report = report, pr_report_o = report_o - (* irrelevant part *) - , begin_local_theory = K o not_used \<^here> - , local_theory_to_proof' = K o K not_used \<^here> - , local_theory_to_proof = K o K not_used \<^here> - , tr_raw = not_used \<^here> } - end) - x - val (env, thy) = - let - fun disp_time f x = - let val (s, r) = Timing.timing f x - val () = out_intensify (Timing.message s |> Markup.markup Markup.operator) "" in - r - end - in disp_time (fn x => aux x (env, thy)) (l_obj ()) end - in ((env, thy0), (thy, fn _ => get_all_meta_embed (SOME thy))) end) - l_shallow - (thy, case l_obj of SOME f => f | NONE => fn _ => get_all_meta_embed (SOME thy)) - |> META.map_prod I fst) - -fun thy_switch \<^cancel>\<open>pos1 pos2\<close> f mode tr = - ( ( mode - , \<^cancel>\<open>Toplevel'.keep - (fn _ => Output.information ( "Theory required while transitions were being built" - ^ Position.here pos1 - ^ ": Commands will not be concurrently considered. " - ^ Markup.markup - (Markup.properties (Position.properties_of pos2) Markup.position) - "(Handled here\092<^here>)"))\<close> tr) - , f #~> Generation_mode.Data_gen.put) - -in - -fun outer_syntax_commands''' is_safe mk_string cmd_spec cmd_descr parser get_all_meta_embed = - let open Generation_mode in - Outer_Syntax'.command cmd_spec cmd_descr - (parser >> (fn name => fn thy => fn _ => - (* WARNING: Whenever there would be errors raised by functions taking "thy" as input, - they will not be shown. - So the use of this "thy" can be considered as safe, as long as errors do not happen. *) - let - val get_all_m = get_all_meta_embed name - val m_tr = (Data_gen.get thy, []) - |-> mapM_syntax_print (META.mapM (fn n => - pair n - o cons (\<^command_keyword>\<open>print_syntax\<close>, - Toplevel'.keep_theory (fn thy => - writeln (mk_string - (Proof_Context.init_global - (case n of NONE => thy - | SOME n => Config.put_global ML_Print_Depth.print_depth n thy)) - name))))) - in \<^cancel>\<open>let - val thy_o = is_safe thy - val l_obj = get_all_m thy_o - (* In principle, it is fine if (SOME thy) is provided to - get_all_m. However, because certain types of errors are most of the - time happening whenever certain specific operations depending on thy - are explicitly performed, and because get_all_m was intentionally set - to not interactively manage such errors, then these errors (whenever - they are happening) could possibly not appear in the output - window. Although the computation would be in any case interrupted as - usual (but with only minimal debugging information, such as a simple - red underlining color). - - Generally, whenever get_all_m is called during the evaluating commands - coming from generated files (which is not the case here, but will be - later), this restriction can normally be removed (i.e., by writing - (SOME thy)), as for the case of generated files, we are taking the - assumption that errors (if they are happening) are as hard to detect - as if an error was raised somewhere else by the generator itself. - Another assumption nevertheless related with the generator is that it - is supposed to explicitly not raise errors, however here this - get_all_m is not situated below a generating part. This is why we are - tempted to mostly give NONE to get_all_m, unless the calling command - is explicitly taking the responsibility of a potential failure. *) - val m_tr = m_tr - |-> thy_deep exec_deep Toplevel'.keep l_obj - in ( m_tr - |-> mapM_shallow (META.mapM (fn (env, thy_init) => fn acc => - let val (tps, disp_time) = disp_time Toplevel'.keep_output - fun aux thy_o = - fold_thy_shallow - (K (cons (Toplevel'.read_write_keep (Toplevel.Load_backup, Toplevel.Store_default)))) - (fn msg => fn l => - apsnd (disp_time msg) - #> Bind_META.all_meta_trs (aux thy_o o META.Fold_meta) - { context_of = Toplevel.context_of - , keep = Toplevel.keep - , generic_theory = Toplevel.generic_theory - , theory = Toplevel.theory - , begin_local_theory = Toplevel.begin_local_theory - , local_theory' = Toplevel.local_theory' - , local_theory = Toplevel.local_theory - , local_theory_to_proof' = Toplevel.local_theory_to_proof' - , local_theory_to_proof = Toplevel.local_theory_to_proof - , proof' = Toplevel.proof' - , proofs = Toplevel.proofs - , proof = Toplevel.proof - (* *) - , dual = #par, tr_raw = I - , tr_report = report, tr_report_o = report_o - , pr_report = report, pr_report_o = report_o } - thy_o - l) - in aux thy_o l_obj (env, acc) - |> META.map_prod - (fn env => (env, thy_init)) - (Toplevel'.keep_output tps Markup.operator "") end)) - , Data_gen.put) - handle THY_REQUIRED pos => - m_tr |-> thy_switch pos \<^here> (thy_shallow NONE get_all_m) - end - handle THY_REQUIRED pos => - \<close>m_tr |-> thy_switch \<^cancel>\<open>pos \<^here>\<close> (fn mode => fn thy => - let val l_obj = get_all_m (SOME thy) in - (thy_deep (tap oo exec_deep0) tap l_obj - #~> thy_shallow (SOME (K l_obj)) get_all_m) mode thy - end) - end - |> uncurry Toplevel'.setup_theory)) - end -end - -fun outer_syntax_commands'' mk_string = outer_syntax_commands''' (K NONE) mk_string - -fun outer_syntax_commands' mk_string cmd_spec cmd_descr parser get_all_meta_embed = - outer_syntax_commands'' mk_string cmd_spec cmd_descr parser (META.Fold_meta oo get_all_meta_embed) - -fun outer_syntax_commands'2 mk_string cmd_spec cmd_descr parser get_all_meta_embed = - outer_syntax_commands''' SOME mk_string cmd_spec cmd_descr parser (META.Fold_meta oo get_all_meta_embed) -\<close> - -subsection\<open>Parameterizing the Semantics of Embedded Languages\<close> - -ML\<open> -val () = let open Generation_mode in - Outer_Syntax'.command \<^command_keyword>\<open>generation_syntax\<close> "set the generating list" - (( mode >> (fn x => SOME [x]) - || parse_l' mode >> SOME - || \<^keyword>\<open>deep\<close> -- \<^keyword>\<open>flush_all\<close> >> K NONE) >> - (fn SOME x => K (K (f_command x)) - | NONE => fn thy => fn _ => [] - |> fold (fn (env, i_deep) => exec_deep i_deep (META.compiler_env_config_reset_all env)) - (#deep (Data_gen.get thy)) - |> (fn [] => Toplevel'.keep (fn _ => warning "Nothing performed.") [] - | l => l))) -end -\<close> - -subsection\<open>Common Parser for OCL\<close> - -ML\<open> -structure USE_parse = struct - datatype ('a, 'b) use_context = USE_context_invariant of 'a - | USE_context_pre_post of 'b - - fun optional f = Scan.optional (f >> SOME) NONE - val colon = Parse.$$$ ":" - fun repeat2 scan = scan ::: Scan.repeat1 scan - - fun xml_unescape s = YXML.content_of s |> Symbol_Pos.explode0 |> Symbol_Pos.implode |> From.string - - fun outer_syntax_commands2 mk_string cmd_spec cmd_descr parser v_true v_false get_all_meta_embed = - outer_syntax_commands' mk_string cmd_spec cmd_descr - (optional (paren \<^keyword>\<open>shallow\<close>) -- parser) - (fn (is_shallow, use) => fn thy => - get_all_meta_embed - (if is_shallow = NONE then - ( fn s => - META.T_to_be_parsed ( From.string s - , xml_unescape s) - , v_true) - else - (From.read_term thy, v_false)) - use) - - (* *) - - val ident_dot_dot = let val f = Parse.sym_ident >> (fn "\<bullet>" => "\<bullet>" | _ => Scan.fail "Syntax error") in - f -- f end - val ident_star = Parse.sym_ident (* "*" *) - - (* *) - - fun natural0 s = case Int.fromString s of SOME i => From.nat i - | NONE => Scan.fail "Syntax error" - - val natural = Parse.number >> natural0 - - val unlimited_natural = ident_star >> (fn "*" => META.Mult_star - | "\<infinity>" => META.Mult_infinity - | _ => Scan.fail "Syntax error") - || Parse.number >> (META.Mult_nat o natural0) - - val term_base = - Parse.number >> (META.OclDefInteger o From.string) - || Parse.float_number >> (META.OclDefReal o (From.pair From.string From.string o - (fn s => case String.tokens (fn #"." => true - | _ => false) s of [l1,l2] => (l1,l2) - | _ => Scan.fail "Syntax error"))) - || Parse.string >> (META.OclDefString o From.string) - - val multiplicity = parse_l' (unlimited_natural -- optional (ident_dot_dot |-- unlimited_natural)) - - fun uml_term x = - ( term_base >> META.ShallB_term - || Parse.binding >> (META.ShallB_str o From.binding) - || \<^keyword>\<open>self\<close> |-- Parse.nat >> (fn n => META.ShallB_self (From.internal_oid n)) - || paren (Parse.list uml_term) >> (* untyped, corresponds to Set, Sequence or Pair *) - (* WARNING for Set: we are describing a finite set *) - META.ShallB_list) x - - val name_object = optional (Parse.list1 Parse.binding --| colon) -- Parse.binding - - val type_object_weak = - let val name_object = Parse.binding >> (fn s => (NONE, s)) in - name_object -- Scan.repeat (Parse.$$$ "<" |-- Parse.list1 name_object) >> - let val f = fn (_, s) => META.OclTyCore_pre (From.binding s) in - fn (s, l) => META.OclTyObj (f s, map (map f) l) - end - end - - val type_object = name_object -- Scan.repeat (Parse.$$$ "<" |-- Parse.list1 name_object) >> - let val f = fn (_, s) => META.OclTyCore_pre (From.binding s) in - fn (s, l) => META.OclTyObj (f s, map (map f) l) - end - - val category = - multiplicity - -- optional (\<^keyword>\<open>Role\<close> |-- Parse.binding) - -- Scan.repeat ( \<^keyword>\<open>Ordered\<close> >> K META.Ordered0 - || \<^keyword>\<open>Subsets\<close> |-- Parse.binding >> K META.Subsets0 - || \<^keyword>\<open>Union\<close> >> K META.Union0 - || \<^keyword>\<open>Redefines\<close> |-- Parse.binding >> K META.Redefines0 - || \<^keyword>\<open>Derived\<close> -- Parse.$$$ "=" |-- Parse.term >> K META.Derived0 - || \<^keyword>\<open>Qualifier\<close> |-- Parse.term >> K META.Qualifier0 - || \<^keyword>\<open>Nonunique\<close> >> K META.Nonunique0 - || \<^keyword>\<open>Sequence_\<close> >> K META.Sequence) >> - (fn ((l_mult, role), l) => - META.Ocl_multiplicity_ext (l_mult, From.option From.binding role, l, ())) - - val type_base = Parse.reserved "Void" >> K META.OclTy_base_void - || Parse.reserved "Boolean" >> K META.OclTy_base_boolean - || Parse.reserved "Integer" >> K META.OclTy_base_integer - || Parse.reserved "UnlimitedNatural" >> K META.OclTy_base_unlimitednatural - || Parse.reserved "Real" >> K META.OclTy_base_real - || Parse.reserved "String" >> K META.OclTy_base_string - - fun use_type_gen type_object v = - ((* collection *) - Parse.reserved "Set" |-- use_type >> - (fn l => META.OclTy_collection (META.Ocl_multiplicity_ext ([], NONE, [META.Set], ()), l)) - || Parse.reserved "Sequence" |-- use_type >> - (fn l => META.OclTy_collection (META.Ocl_multiplicity_ext ([], NONE, [META.Sequence], ()), l)) - || category -- use_type >> META.OclTy_collection - - (* pair *) - || Parse.reserved "Pair" |-- - ( use_type -- use_type - || Parse.$$$ "(" |-- use_type --| Parse.$$$ "," -- use_type --| Parse.$$$ ")") >> META.OclTy_pair - - (* base *) - || type_base - - (* raw HOL *) - || Parse.sym_ident (* "\<acute>" *) |-- Parse.typ --| Parse.sym_ident (* "\<acute>" *) >> - (META.OclTy_raw o xml_unescape) - - (* object type *) - || type_object >> META.OclTy_object - - || ((Parse.$$$ "(" |-- Parse.list ( (Parse.binding --| colon >> (From.option From.binding o SOME)) - -- ( Parse.$$$ "(" |-- use_type --| Parse.$$$ ")" - || use_type_gen type_object_weak) >> META.OclTy_binding - ) --| Parse.$$$ ")" - >> (fn ty_arg => case rev ty_arg of - [] => META.OclTy_base_void - | ty_arg => fold (fn x => fn acc => META.OclTy_pair (x, acc)) - (tl ty_arg) - (hd ty_arg))) - -- optional (colon |-- use_type)) - >> (fn (ty_arg, ty_out) => case ty_out of NONE => ty_arg - | SOME ty_out => META.OclTy_arrow (ty_arg, ty_out)) - || (Parse.$$$ "(" |-- use_type --| Parse.$$$ ")" >> (fn s => META.OclTy_binding (NONE, s)))) v - and use_type x = use_type_gen type_object x - - val use_prop = - (optional (optional (Parse.binding >> From.binding) --| Parse.$$$ ":") >> (fn NONE => NONE - | SOME x => x)) - -- Parse.term --| optional (Parse.$$$ ";") >> (fn (n, e) => fn from_expr => - META.OclProp_ctxt (n, from_expr e)) - - (* *) - - val association_end = - type_object - -- category - --| optional (Parse.$$$ ";") - - val association = optional \<^keyword>\<open>Between\<close> |-- Scan.optional (repeat2 association_end) [] - - val invariant = - optional \<^keyword>\<open>Constraints\<close> - |-- Scan.optional (\<^keyword>\<open>Existential\<close> >> K true) false - --| \<^keyword>\<open>Inv\<close> - -- use_prop - - structure Outer_syntax_Association = struct - fun make ass_ty l = META.Ocl_association_ext (ass_ty, META.OclAssRel l, ()) - end - - (* *) - - val context = - Scan.repeat - (( optional (\<^keyword>\<open>Operations\<close> || Parse.$$$ "::") - |-- Parse.binding - -- use_type - --| optional (Parse.$$$ "=" |-- Parse.term || Parse.term) - -- Scan.repeat - ( (\<^keyword>\<open>Pre\<close> || \<^keyword>\<open>Post\<close>) - -- use_prop >> USE_context_pre_post - || invariant >> USE_context_invariant) - --| optional (Parse.$$$ ";")) >> - (fn ((name_fun, ty), expr) => fn from_expr => - META.Ctxt_pp - (META.Ocl_ctxt_pre_post_ext - ( From.binding name_fun - , ty - , From.list (fn USE_context_pre_post (pp, expr) => - META.T_pp (if pp = "Pre" then - META.OclCtxtPre - else - META.OclCtxtPost, expr from_expr) - | USE_context_invariant (b, expr) => - META.T_invariant (META.T_inv (b, expr from_expr))) expr - , ()))) - || - invariant >> (fn (b, expr) => fn from_expr => META.Ctxt_inv (META.T_inv (b, expr from_expr)))) - - val class = - optional \<^keyword>\<open>Attributes\<close> - |-- Scan.repeat (Parse.binding --| colon -- use_type - --| optional (Parse.$$$ ";")) - -- context - - datatype use_classDefinition = USE_class | USE_class_abstract - datatype ('a, 'b) use_classDefinition_content = USE_class_content of 'a | USE_class_synonym of 'b - - structure Outer_syntax_Class = struct - fun make from_expr abstract ty_object attribute oper = - META.Ocl_class_raw_ext - ( ty_object - , From.list (From.pair From.binding I) attribute - , From.list (fn f => f from_expr) oper - , abstract - , ()) - end - - (* *) - - val term_object = parse_l_with ( optional ( Parse.$$$ "(" - |-- Parse.binding - --| Parse.$$$ "," - -- Parse.binding - --| Parse.$$$ ")" - --| (Parse.sym_ident >> (fn "|=" => Scan.succeed - | _ => Scan.fail ""))) - -- Parse.binding - -- ( Parse.$$$ "=" - |-- uml_term)) - - val list_attr' = term_object >> (fn res => (res, [] : binding list)) - fun object_cast e = - ( annot_ty term_object - -- Scan.repeat ( (Parse.sym_ident >> (fn "->" => Scan.succeed - | "\<leadsto>" => Scan.succeed - | "\<rightarrow>" => Scan.succeed - | _ => Scan.fail "")) - |-- ( Parse.reserved "oclAsType" - |-- Parse.$$$ "(" - |-- Parse.binding - --| Parse.$$$ ")" - || Parse.binding)) >> (fn ((res, x), l) => (res, rev (x :: l)))) e - val object_cast' = object_cast >> (fn (res, l) => (res, rev l)) - - fun get_oclinst l = - META.OclInstance (map (fn ((name,typ), ((l_attr_with, l_attr), is_cast)) => - let val f = map (fn ((pre_post, attr), data) => - ( From.option (From.pair From.binding From.binding) pre_post - , ( From.binding attr - , data))) - val l_attr = - fold - (fn b => fn acc => META.OclAttrCast (From.binding b, acc, [])) - is_cast - (META.OclAttrNoCast (f l_attr)) in - META.Ocl_instance_single_ext - ( From.option From.binding name - , From.option From.binding typ - , From.option From.binding l_attr_with - , l_attr - , ()) end) l) - - val parse_instance = (Parse.binding >> SOME) - -- optional (\<^keyword>\<open>::\<close> |-- Parse.binding) --| \<^keyword>\<open>=\<close> - -- (list_attr' || object_cast') - - (* *) - - datatype state_content = - ST_l_attr of (binding option * (((binding * binding) option * binding) * META.ocl_data_shallow) list) * binding list - | ST_binding of binding - - val state_parse = parse_l' ( object_cast >> ST_l_attr - || Parse.binding >> ST_binding) - - val mk_state = - map (fn ST_l_attr l => - META.OclDefCoreAdd - (case get_oclinst (map (fn (l_i, l_ty) => - ((NONE, SOME (hd l_ty)), (l_i, rev (tl l_ty)))) [l]) of - META.OclInstance [x] => x) - | ST_binding b => META.OclDefCoreBinding (From.binding b)) - - (* *) - - datatype state_pp_content = ST_PP_l_attr of state_content list - | ST_PP_binding of binding - - val state_pp_parse = state_parse >> ST_PP_l_attr - || Parse.binding >> ST_PP_binding - - val mk_pp_state = fn ST_PP_l_attr l => META.OclDefPPCoreAdd (mk_state l) - | ST_PP_binding s => META.OclDefPPCoreBinding (From.binding s) - - (* *) - - fun optional_b key = Scan.optional (key >> K true) false - val haskell_parse = Scan.optional let fun k x = K (true, From.nat x) - in \<^keyword>\<open>datatype_old\<close> >> k 0 - || \<^keyword>\<open>datatype_old_atomic\<close> >> k 1 - || \<^keyword>\<open>datatype_old_atomic_sub\<close> >> k 2 end - (false, From.nat 0) - -- optional_b \<^keyword>\<open>try_import\<close> - -- optional_b \<^keyword>\<open>only_types\<close> - -- optional_b \<^keyword>\<open>ignore_not_in_scope\<close> - -- optional_b \<^keyword>\<open>abstract_mutual_data_params\<close> - -- optional_b \<^keyword>\<open>concat_modules\<close> - -- Scan.option (\<^keyword>\<open>base_path\<close> |-- Parse.position Parse.path) - -- Scan.optional (parse_l' (Parse.name -- Scan.option ((\<^keyword>\<open>\<rightharpoonup>\<close> || \<^keyword>\<open>=>\<close>) |-- Parse.name))) [] -end -\<close> - -subsection\<open>Setup of Meta Commands for a Generic Usage: @{command meta_command}, @{command meta_command'}\<close> - -ML\<open> -local - fun outer_syntax_commands'''2 command_keyword meta_command = - outer_syntax_commands''' SOME \<^mk_string> command_keyword "" - Parse.ML_source - (fn source => - get_thy \<^here> (meta_command (Input.source_content source) #> META.Fold_custom)) -in -val () = outer_syntax_commands'''2 \<^command_keyword>\<open>meta_command\<close> Bind_META.meta_command -val () = outer_syntax_commands'''2 \<^command_keyword>\<open>meta_command'\<close> Generation_mode.meta_command -end -\<close> - -subsection\<open>Setup of Meta Commands for OCL: @{command Enum}\<close> - -ML\<open> -val () = - outer_syntax_commands' \<^mk_string> \<^command_keyword>\<open>Enum\<close> "" - (Parse.binding -- parse_l1' Parse.binding) - (fn (n1, n2) => - K (META.META_enum (META.OclEnum (From.binding n1, From.list From.binding n2)))) -\<close> - -subsection\<open>Setup of Meta Commands for OCL: (abstract) @{command Class}\<close> - -ML\<open> -local - open USE_parse - - fun mk_classDefinition abstract cmd_spec = - outer_syntax_commands2 \<^mk_string> cmd_spec "Class generation" - ( Parse.binding --| Parse.$$$ "=" -- USE_parse.type_base >> USE_class_synonym - || type_object - -- class >> USE_class_content) - (curry META.META_class_raw META.Floor1) - (curry META.META_class_raw META.Floor2) - (fn (from_expr, META_class_raw) => - fn USE_class_content (ty_object, (attribute, oper)) => - META_class_raw (Outer_syntax_Class.make - from_expr - (abstract = USE_class_abstract) - ty_object - attribute - oper) - | USE_class_synonym (n1, n2) => - META.META_class_synonym (META.OclClassSynonym (From.binding n1, n2))) -in -val () = mk_classDefinition USE_class \<^command_keyword>\<open>Class\<close> -val () = mk_classDefinition USE_class_abstract \<^command_keyword>\<open>Abstract_class\<close> -end -\<close> - -subsection\<open>Setup of Meta Commands for OCL: @{command Association}, @{command Composition}, @{command Aggregation}\<close> - -ML\<open> -local - open USE_parse - - fun mk_associationDefinition ass_ty cmd_spec = - outer_syntax_commands' \<^mk_string> cmd_spec "" - ( repeat2 association_end - || optional Parse.binding - |-- association) - (K o META.META_association o Outer_syntax_Association.make ass_ty) -in -val () = mk_associationDefinition META.OclAssTy_association \<^command_keyword>\<open>Association\<close> -val () = mk_associationDefinition META.OclAssTy_composition \<^command_keyword>\<open>Composition\<close> -val () = mk_associationDefinition META.OclAssTy_aggregation \<^command_keyword>\<open>Aggregation\<close> -end -\<close> - -subsection\<open>Setup of Meta Commands for OCL: (abstract) @{command Associationclass}\<close> - -ML\<open> - -local - open USE_parse - - datatype use_associationClassDefinition = USE_associationclass | USE_associationclass_abstract - - fun mk_associationClassDefinition abstract cmd_spec = - outer_syntax_commands2 \<^mk_string> cmd_spec "" - ( type_object - -- association - -- class - -- optional (Parse.reserved "aggregation" || Parse.reserved "composition")) - (curry META.META_ass_class META.Floor1) - (curry META.META_ass_class META.Floor2) - (fn (from_expr, META_ass_class) => - fn (((ty_object, l_ass), (attribute, oper)), assty) => - META_ass_class - (META.OclAssClass - ( Outer_syntax_Association.make - (case assty of SOME "aggregation" => META.OclAssTy_aggregation - | SOME "composition" => META.OclAssTy_composition - | _ => META.OclAssTy_association) - l_ass - , Outer_syntax_Class.make - from_expr - (abstract = USE_associationclass_abstract) - ty_object - attribute - oper))) -in -val () = mk_associationClassDefinition USE_associationclass \<^command_keyword>\<open>Associationclass\<close> -val () = mk_associationClassDefinition USE_associationclass_abstract \<^command_keyword>\<open>Abstract_associationclass\<close> -end -\<close> - -subsection\<open>Setup of Meta Commands for OCL: @{command Context}\<close> - -ML\<open> -local - open USE_parse -in -val () = - outer_syntax_commands2 \<^mk_string> \<^command_keyword>\<open>Context\<close> "" - (optional (Parse.list1 Parse.binding --| colon) - -- Parse.binding - -- context) - (curry META.META_ctxt META.Floor1) - (curry META.META_ctxt META.Floor2) - (fn (from_expr, META_ctxt) => - (fn ((l_param, name), l) => - META_ctxt - (META.Ocl_ctxt_ext - ( case l_param of NONE => [] | SOME l => From.list From.binding l - , META.OclTyObj (META.OclTyCore_pre (From.binding name), []) - , From.list (fn f => f from_expr) l - , ())))) -end -\<close> - -subsection\<open>Setup of Meta Commands for OCL: @{command End}\<close> - -ML\<open> -val () = - outer_syntax_commands'' \<^mk_string> \<^command_keyword>\<open>End\<close> "Class generation" - (Scan.optional ( Parse.$$$ "[" -- Parse.reserved "forced" -- Parse.$$$ "]" >> K true - || Parse.$$$ "!" >> K true) false) - (fn b => - K (if b then - META.Fold_meta (META.META_flush_all META.OclFlushAll) - else - META.Fold_custom [])) -\<close> - -subsection\<open>Setup of Meta Commands for OCL: @{command BaseType}, @{command Instance}, @{command State}\<close> - -ML\<open> -val () = - outer_syntax_commands' \<^mk_string> \<^command_keyword>\<open>BaseType\<close> "" - (parse_l' USE_parse.term_base) - (K o META.META_def_base_l o META.OclDefBase) - -local - open USE_parse -in -val () = - outer_syntax_commands' \<^mk_string> \<^command_keyword>\<open>Instance\<close> "" - (Scan.optional (parse_instance -- Scan.repeat (optional \<^keyword>\<open>and\<close> |-- parse_instance) >> - (fn (x, xs) => x :: xs)) []) - (K o META.META_instance o get_oclinst) - -val () = - outer_syntax_commands' \<^mk_string> \<^command_keyword>\<open>State\<close> "" - (USE_parse.optional (paren \<^keyword>\<open>shallow\<close>) -- Parse.binding --| \<^keyword>\<open>=\<close> - -- state_parse) - (fn ((is_shallow, name), l) => - (K o META.META_def_state) - ( if is_shallow = NONE then META.Floor1 else META.Floor2 - , META.OclDefSt (From.binding name, mk_state l))) -end -\<close> - -subsection\<open>Setup of Meta Commands for OCL: @{command Transition}\<close> - -ML\<open> -local - open USE_parse -in -val () = - outer_syntax_commands' \<^mk_string> \<^command_keyword>\<open>Transition\<close> "" - (USE_parse.optional (paren \<^keyword>\<open>shallow\<close>) - -- USE_parse.optional (Parse.binding --| \<^keyword>\<open>=\<close>) - -- state_pp_parse - -- USE_parse.optional state_pp_parse) - (fn (((is_shallow, n), s_pre), s_post) => - (K o META.META_def_transition) - ( if is_shallow = NONE then META.Floor1 else META.Floor2 - , META.OclDefPP ( From.option From.binding n - , mk_pp_state s_pre - , From.option mk_pp_state s_post))) -end -\<close> - -subsection\<open>Setup of Meta Commands for OCL: @{command Tree}\<close> - -ML\<open> -local - open USE_parse -in -val () = - outer_syntax_commands' \<^mk_string> \<^command_keyword>\<open>Tree\<close> "" - (natural -- natural) - (K o META.META_class_tree o META.OclClassTree) -end -\<close> - -subsection\<open>Setup of Meta Commands for Haskabelle: @{command Haskell}, @{command Haskell_file}\<close> - -ML\<open> -structure Haskabelle_Data = Theory_Data - (open META - type T = module list * ((Code_Numeral.natural * Code_Numeral.natural) * (abr_string * (abr_string * abr_string) list)) list list - val empty = ([], []) - val extend = I - val merge = #2) - -local - fun haskabelle_path hkb_home l = Path.appends (Path.variable hkb_home :: map Path.explode l) - val haskabelle_bin = haskabelle_path "HASKABELLE_HOME" ["bin", "haskabelle_bin"] - val haskabelle_default = haskabelle_path "HASKABELLE_HOME_USER" ["default"] -in - fun parse meta_parse_shallow meta_parse_imports meta_parse_code meta_parse_functions hsk_name check_dir hsk_str ((((((((old_datatype, try_import), only_types), ignore_not_in_scope), abstract_mutual_data_params), concat_modules), base_path_abs), l_rewrite), (content, pos)) thy = - let fun string_of_bool b = if b then "true" else "false" - val st = - Bash.process - (space_implode " " - ( [ Path.implode haskabelle_bin - , "--internal", Path.implode haskabelle_default - , "--export", "false" - , "--try-import", string_of_bool try_import - , "--only-types", string_of_bool only_types - , "--base-path-abs", case base_path_abs of NONE => "" | SOME s => check_dir thy s - , "--ignore-not-in-scope", string_of_bool ignore_not_in_scope - , "--abstract-mutual-data-params", string_of_bool abstract_mutual_data_params - , "--dump-output" - , "--meta-parse-shallow", string_of_bool meta_parse_shallow - , "--meta-parse-load"] @ map_filter (fn (true, s) => SOME (Bash.string s) | _ => NONE) meta_parse_imports @ - [ "--meta-parse-imports"] @ map (Bash.string o snd) meta_parse_imports @ - [ "--meta-parse-code" ] @ map Bash.string (the_list meta_parse_code) @ - [ "--hsk-name" ] @ the_list hsk_name - @ (case - if hsk_str then - ([ Bash.string content ], []) - else - ([], [ Resources'.check_path' (SOME File.check_file) (Proof_Context.init_global thy) Path.current (content, pos) ]) - of (cts, files) => List.concat [ ["--hsk-contents"], cts, ["--files"], files ]))) - in - if #rc st = 0 then - Bind_META.meta_command0 "Haskabelle_Data.put" Haskabelle_Data.get (#out st) thy - |> (fn (l_mod, l_rep) => - let - val _ = - List.app - (fn l_rep => - let fun advance_offset n = - if n = 0 then I - else fn (x :: xs, p) => - advance_offset (n - String.size x) (xs, Position.advance x p) - val l_rep = - fold (fn ((offset, end_offset), (markup, prop)) => fn (content, (pos, pos_o), acc) => - let val offset = To_nat offset - val end_offset = To_nat end_offset - val (content, pos0) = advance_offset (offset - pos_o) (content, pos) - val (content, pos1) = advance_offset (end_offset - offset) (content, pos0) - in ( content - , (pos1, end_offset) - , ( Position.range_position (pos0, pos1) - , (To_string0 markup, map (META.map_prod To_string0 To_string0) prop)) - :: acc) - end) - l_rep - (Symbol.explode content, (Position.advance_offsets 1 pos, 0), []) - |> #3 - in Position.reports l_rep end) - l_rep - in l_mod |> (fn m => META.IsaUnit ( old_datatype - , map (META.map_prod From.string (Option.map From.string)) l_rewrite - , meta_parse_functions - , From.string (Context.theory_name thy) - , (m, concat_modules))) - |> META.META_haskell end) - |> tap (fn _ => warning (#err st)) - else - let val _ = #terminate st () - in error (if #err st = "" then - "Failed executing the ML process (" ^ Int.toString (#rc st) ^ ")" - else #err st |> String.explode |> trim (fn #"\n" => true | _ => false) |> String.implode) end - end - val parse' = parse false [] NONE META.Gen_no_apply NONE Resources'.check_dir -end - -local - type haskell_parse = - (((((((bool * Code_Numeral.natural) * bool) * bool) * bool) * bool) * bool) * (string * Position.T) option) - * (string * string option) list - - structure Data_lang = Theory_Data - (type T = (haskell_parse * string option * (bool * string) list * string * (META.abr_string -> META.gen_meta)) Name_Space.table - val empty = Name_Space.empty_table "meta_language" - val extend = I - val merge = Name_Space.merge_tables) - - open USE_parse -in -val () = - outer_syntax_commands'2 \<^mk_string> \<^command_keyword>\<open>Haskell\<close> "" - (haskell_parse -- Parse.position Parse.cartouche) - (get_thy \<^here> o parse' true) - -val () = - outer_syntax_commands'2 \<^mk_string> \<^command_keyword>\<open>Haskell_file\<close> "" - (haskell_parse -- Parse.position Parse.path) - (get_thy \<^here> o parse' false) - -val () = - Outer_Syntax.command \<^command_keyword>\<open>meta_language\<close> "" - (Parse.binding - -- haskell_parse - -- Scan.optional - (Parse.where_ |-- Parse.$$$ "imports" - |-- Parse.!!! - (Scan.repeat1 (Parse.cartouche >> pair false - || Parse.$$$ "(" - |-- Parse.$$$ "load" - |-- Parse.cartouche --| Parse.$$$ ")" >> pair true))) [] - --| Parse.where_ --| Parse.$$$ "defines" -- Parse.cartouche - -- Scan.optional ( Parse.where_ - |-- Parse.$$$ "functions" - |-- let val parse_name = Parse.name >> From.string in - \<^keyword>\<open>meta\<close> |-- parse_name >> (K o META.Gen_apply_sml) - || \<^keyword>\<open>meta_cmd\<close> |-- parse_name >> curry META.Gen_apply_sml_cmd - || parse_name >> (K o META.Gen_apply_hol) - end) - (K META.Gen_no_apply) - >> (fn ((((lang, hsk_arg as ((_, base_path), _)), imports), defines), functions) => - let val _ = if exists (fn #"\n" => true | _ => false) (String.explode defines) then - error "Haskell indentation rules are not yet supported" - else () - in Toplevel.theory - (fn thy => - Data_lang.map - (#2 o Name_Space.define - (Context.Theory thy) - true - (lang, (hsk_arg, Option.map (Resources'.check_dir thy) base_path, imports, defines, functions))) - thy) - end)) - -val () = - outer_syntax_commands'2 \<^mk_string> \<^command_keyword>\<open>language\<close> "" - (Scan.optional (\<^keyword>\<open>meta\<close> >> K true) false - -- Parse.binding --| Parse.$$$ "::" -- Parse.position Parse.name --| Parse.where_ -- Parse.position Parse.cartouche) - (fn (((is_shallow, prog), lang), code) => - get_thy \<^here> - (fn thy => - let val (_, (hsk_arg, hsk_path, imports, defines, functions)) = - Name_Space.check (Context.Theory thy) (Data_lang.get thy) lang - val prog' = Binding.name_of prog - in parse is_shallow - imports - (SOME defines) - (functions (From.string prog')) - (SOME prog') - (K (K (case hsk_path of NONE => "" | SOME s => s))) - true - (hsk_arg, code) - thy - end)) -end -(*val _ = print_depth 100*) -\<close> - -end diff --git a/Citadelle/src/compiler/Generator_static.thy b/Citadelle/src/compiler/Generator_static.thy deleted file mode 100644 index 499900b87d7004fec22b19d746450bb4c15436b9..0000000000000000000000000000000000000000 --- a/Citadelle/src/compiler/Generator_static.thy +++ /dev/null @@ -1,105 +0,0 @@ -(****************************************************************************** - * Citadelle - * - * 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. - ******************************************************************************) - -text\<open>We present two solutions for obtaining an Isabelle file.\<close> - -section\<open>Static Meta Embedding with Exportation\<close> - -theory Generator_static -imports FOCL.Printer -begin -ML_file "~~/src/Doc/antiquote_setup.ML" - -declare[[cartouche_type' = "abr_string"]] - -text \<open>In the ``static'' solution: the user manually generates -the Isabelle file after writing by hand an OCL input to translate. -The input is not written with the syntax of OCL, -but with raw Isabelle constructors.\<close> - -subsection\<open>Giving an Input to Translate\<close> - -definition "Design = - (let n = \<lambda>n1 n2. OclTyObj (OclTyCore_pre n1) (case n2 of None \<Rightarrow> [] | Some n2 \<Rightarrow> [[OclTyCore_pre n2]]) - ; mk = \<lambda>n l. ocl_class_raw.make n l [] False in - [ mk (n \<open>Galaxy\<close> None) [(\<open>sound\<close>, OclTy_raw \<open>unit\<close>), (\<open>moving\<close>, OclTy_raw \<open>bool\<close>)] - , mk (n \<open>Planet\<close> (Some \<open>Galaxy\<close>)) [(\<open>weight\<close>, OclTy_raw \<open>nat\<close>)] - , mk (n \<open>Person\<close> (Some \<open>Planet\<close>)) [(\<open>salary\<close>, OclTy_raw \<open>int\<close>)] ])" - -text \<open>Since we are in a Isabelle session, at this time, it becomes possible to inspect with -the command @{command value} the result of the translations applied with @{term Design}. -A suitable environment should nevertheless be provided, -one can typically experiment this by copying-pasting the following environment -initialized below in @{text main}:\<close> - -definition "main = - (let n = \<lambda>n1. OclTyObj (OclTyCore_pre n1) [] - ; OclMult = \<lambda>m r. ocl_multiplicity.make [m] r [Set] in - write_file - (compiler_env_config.extend - (compiler_env_config_empty True None (oidInit (Oid 0)) Gen_only_design (None, False) - \<lparr> D_output_disable_thy := False - , D_output_header_thy := Some (\<open>Employee_DesignModel_UMLPart_generated\<close> - ,[\<open>../src/OCL_main\<close>] - ,\<open>../src/compiler/Generator_dynamic_sequential\<close>) \<rparr>) - ( L.map (META_class_raw Floor1) Design - @@@@ [ META_association (ocl_association.make - OclAssTy_association - (OclAssRel [ (n \<open>Person\<close>, OclMult (Mult_star, None) None) - , (n \<open>Person\<close>, OclMult (Mult_nat 0, Some (Mult_nat 1)) (Some \<open>boss\<close>))])) - , META_flush_all OclFlushAll] - , None)))" - -subsection\<open>Statically Executing the Exportation\<close> - -text\<open> -@{verbatim "apply_code_printing ()"} \\ -@{verbatim "export_code main"} \\ -@{verbatim " (* in Haskell *)"} \\ -@{verbatim " (* in OCaml module_name M *)"} \\ -@{verbatim " (* in Scala module_name M *)"} \\ -@{verbatim " (* in SML module_name M *)"} -\<close> - -text\<open>After the exportation and executing the exported, we obtain an Isabelle \verb|.thy| file -containing the generated code associated to the above input.\<close> - -end diff --git a/Citadelle/src/compiler/Init_rbt.thy b/Citadelle/src/compiler/Init_rbt.thy deleted file mode 100644 index b4cc1aac4d4f8bc1b1d83762756c7d154184ca4a..0000000000000000000000000000000000000000 --- a/Citadelle/src/compiler/Init_rbt.thy +++ /dev/null @@ -1,83 +0,0 @@ -(****************************************************************************** - * Citadelle - * - * 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. - ******************************************************************************) - -section\<open>Basic Extension of the Standard Library (Depending on RBT)\<close> - -theory Init_rbt -imports "../compiler_generic/Init" - "HOL-Library.RBT" - "HOL-Library.Char_ord" - "HOL-Library.List_Lexorder" - "HOL-Library.Product_Lexorder" -begin - -locale RBT -begin -definition "modify_def v k f rbt = - (case RBT.lookup rbt k of None \<Rightarrow> RBT.insert k (f v) rbt - | Some _ \<Rightarrow> RBT.map_entry k f rbt)" -definition "lookup2 rbt = (\<lambda>(x1, x2). Option.bind (RBT.lookup rbt x1) (\<lambda>rbt. RBT.lookup rbt x2))" -definition "insert2 = (\<lambda>(x1, x2) v. RBT.modify_def RBT.empty x1 (RBT.insert x2 v))" -end -lemmas [code] = - \<comment> \<open>def\<close> - RBT.modify_def_def - RBT.lookup2_def - RBT.insert2_def - -context L -begin -definition "unique f l = List.map_filter id (fst - (mapM - (\<lambda> (cpt, v) rbt. - let f_cpt = f cpt in - if RBT.lookup rbt f_cpt = None then - (Some (cpt, v), RBT.insert f_cpt () rbt) - else - (None, rbt)) - l - RBT.empty))" -end -lemmas [code] = - \<comment> \<open>def\<close> - L.unique_def - -end diff --git a/Citadelle/src/compiler/Printer.thy b/Citadelle/src/compiler/Printer.thy deleted file mode 100644 index b726cfa38cefd3479c871f7438cb62ef618625af..0000000000000000000000000000000000000000 --- a/Citadelle/src/compiler/Printer.thy +++ /dev/null @@ -1,100 +0,0 @@ -(****************************************************************************** - * Citadelle - * - * 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. - ******************************************************************************) - -section\<open>Finalizing the Printer\<close> - -theory Printer -imports Core - "meta/Printer_META" -begin - -definition "List_iterM f l = - List.fold (\<lambda>x m. bind m (\<lambda> () \<Rightarrow> f x)) l (return ())" - -context Print -begin - -declare[[cartouche_type' = "String.literal"]] - -definition "(write_file0 :: _ \<Rightarrow> (((_ \<Rightarrow> String.literal \<Rightarrow> _) \<Rightarrow> _) \<Rightarrow> _) \<times> _) env = - (let (l_thy, Sys_argv) = compiler_env_config.more env - ; (is_file, f_output) = case (D_output_header_thy env, Sys_argv) - of (Some (file_out, _), Some dir) \<Rightarrow> - let dir = To_string dir in - (True, \<lambda>f. bind (Sys_is_directory2 dir) (\<lambda> Sys_is_directory2_dir. - out_file1 f (if Sys_is_directory2_dir then sprint2 \<open>%s/%s.thy\<close>\<acute> dir (To_string file_out) else dir))) - | _ \<Rightarrow> (False, out_stand1) - ; (env, l) = - fold_thy'' - comp_env_save_deep - (\<lambda>f. f ()) - (\<lambda>_ _. []) - (\<lambda>msg x acc1 acc2. (acc1, Cons (msg, x) acc2)) - (fst (compiler_env_config.more env)) - (compiler_env_config.truncate env, []) in - (f_output, of_all_meta_lists (compiler_env_config_more_map (\<lambda>_. is_file) env) (rev l)))" - -definition "write_file env = - (let (f_output, l) = write_file0 env in - f_output - (\<lambda>fprintf1. - List_iterM (fprintf1 \<open>%s -\<close> ) - l))" -end - -definition "print f = f String.meta_of_logic (ToNat integer_of_natural)" -definition "write_file0 = print Print.write_file0" -definition "write_file = print Print.write_file" - -lemmas [code] = - \<comment> \<open>def\<close> - Print.write_file0_def - Print.write_file_def - - \<comment> \<open>fun\<close> - -section\<open>Miscellaneous: Garbage Collection of Notations\<close> - -no_type_notation natural ("nat") -no_type_notation abr_string ("string") - -end diff --git a/Citadelle/src/compiler/README.md b/Citadelle/src/compiler/README.md deleted file mode 100644 index 57b5562680d27571987fa8afc0798b173b3338df..0000000000000000000000000000000000000000 --- a/Citadelle/src/compiler/README.md +++ /dev/null @@ -1,37 +0,0 @@ -# Citadelle - -## Authors -* [Achim D. Brucker](http://www.brucker.ch/) -* Frédéric Tuong -* [Burkhart Wolff](https://www.lri.fr/~wolff/) - -## Acronyms of Citadelle -Due to space and unlimited tweaking reasons, all known acronyms of -Citadelle (only those judged gorgeous) were deconstructed, once and -for all, then sorted together: -* and - AST - Castra - Cementing - Citadelle - Coding - Constructive - - Costras - Down - Earth's - Fortify - Generic - in - Invalid's - - Isabelle - Isabelle's - Languages' - Meta - ML-like's - Models - - Null's - Reflected - Supporting - to - Top - Transformer - UML/OCL's - -The creation of the initial acronyms were nevertheless following -certain rules relieving from combinatorial blow-ups, for instance: -* Length: Unrestricted, but to fit in a top header file, first line - words are arranged to total less than N characters without breaking - any words, and for subsequent lines: N + the length of Citadelle. -* Order: They all contain in case insensitive increasing ordering the - title letters Citadelle. -* Sonority: Each element of the list is normally used only once, but - elements with similar consonances can be better consecutively - regrouped to reverberate the melody Citadelle. -* Tail Recursivity: Each acronym has in its ending tail position the - supposedly reflect of itself, namely Citadelle. -* Persistence: By clearing away the last and generally all words - Citadelle, it is still possible to find at least another hidden - sequence of Citadelle. -* Laziness: Here, avoiding laziness is as simple as: starting to - mention the title letters somewhere, and finally starting to make - all rules embellishing themselves to the point of gorgeousness. - -## License -This project is licensed under a 3-clause BSD-style license. diff --git a/Citadelle/src/compiler/Rail.thy b/Citadelle/src/compiler/Rail.thy deleted file mode 100644 index 3419a853f9556a786faac559046c5bb215afb278..0000000000000000000000000000000000000000 --- a/Citadelle/src/compiler/Rail.thy +++ /dev/null @@ -1,523 +0,0 @@ -(****************************************************************************** - * Citadelle - * - * 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 Rail -imports OCL.UML_Types - Aux_text - FOCL.Generator_dynamic_sequential -begin -ML_file "~~/src/Doc/antiquote_setup.ML" -(*>*) - -section\<open>Main Setup of Meta Commands\<close> - -text \<open> -\begin{matharray}{rcl} - @{command_def generation_syntax} & : & @{text "theory \<rightarrow> theory"} -\end{matharray} - -@{rail \<open> - @@{command generation_syntax} - ( '[' (@{syntax syntax} * ',') ']' - | @{syntax syntax} - | @'deep' @'flush_all') - ; - @{syntax_def syntax}: - @'deep' @{syntax semantics} @{syntax deep_embedding} - | @'shallow' @{syntax semantics} @{syntax long_or_dirty} - | @'syntax_print' number? - ; - @{syntax_def semantics}: - ('(' @'generation_semantics' \<newline> - ('[' (@'design' | @'analysis') (',' @'oid_start' nat)? ']') ')')? - ; - @{syntax_def deep_embedding}: - (@'skip_export')? \<newline> - ('(' @'THEORY' name ')' \<newline> - '(' @'IMPORTS' '[' (name * ',') ']' name ')')? \<newline> - (@'SECTION')? \<newline> - @{syntax long_or_dirty} \<newline> - ('[' (@{syntax export_code} + ',') ']') \<newline> - ('(' @'output_directory' name ')')? - ; - @{syntax_def export_code}: - @'in' ( @'self' - | 'Haskell' - | (( 'OCaml' - | 'Scala' - | 'SML') @'module_name' name)) ( '(' args ')' ) ? - ; - @{syntax_def long_or_dirty}: - (@'SORRY' | @'no_dirty')? - ; -\<close>} -\<close> - -text\<open> -@{command generation_syntax} sets the behavior of all incoming meta-commands. -By default, without firstly writing @{command generation_syntax}, -meta-commands will only print in output what they have parsed, -this is similar as giving to @{command generation_syntax} -a non-empty list having only @{keyword "syntax_print"} as elements -(on the other hand, nothing is printed when an empty list is received). -Additionally @{keyword "syntax_print"} can be followed by an integer -indicating the printing depth in output, similar as declaring -@{attribute "ML_print_depth"} with an integer, -but the global option @{keyword "syntax_print"} is restricted to meta-commands. -Besides the printing of syntaxes, several options are provided to further analyze -the semantics of languages being embedded, -and tell if their evaluation should occur immediately using the @{keyword "shallow"} mode, -or to only display what would have been evaluated using the @{keyword "deep"} mode -(i.e., to only show the generated Isabelle content in the output window). - -Since several occurrences of - @{keyword "deep"}, @{keyword "shallow"} or @{keyword "syntax_print"} -can appear in the parameterizing list, -for each meta-command the overall evaluation respects the order of events -given in the list (from head to tail). -At the time of writing, it is only possible to evaluate this list sequentially: -the execution stops as soon as one first error is raised, thus ignoring remaining events. - -@{command generation_syntax} @{keyword "deep"} @{keyword "flush_all"} -performs as side effect the writing of all the generated Isabelle contents -to the hard disk (all at the calling time), -by iterating the saving for each @{keyword "deep"} mode in the list. -In particular, this is only effective -if there is at least one @{keyword "deep"} mode earlier declared. - -As a side note, target languages for the @{keyword "deep"} mode currently supported are: - Haskell, OCaml, Scala and SML. -So in principle, all these targets generate the same Isabelle content and exit correctly. -However, depending on the intended use, exporting with some targets may be more appropriate -than other targets: -\begin{itemize} -\item For efficiency reasons, the meta-compiler has implemented a particular optimization -for accelerating the process of evaluating incoming meta-commands. -By default in Haskell and OCaml, the meta-compiler (at HOL side) is exported only once, -during the @{command generation_syntax} step. -Then all incoming meta-commands are considered as arguments sent to the exported meta-compiler. -As a compositionality aspect, these arguments are compiled then linked together -with the (already compiled) meta-compiler, but -this implies the use of one call of -@{text "unsafeCoerce"} in Haskell and one @{text "Obj.magic"} statement in OCaml -(otherwise another solution would be to extract the meta-compiler as a functor). -Similar optimizations are not yet implemented for Scala and are only half-implemented for the SML target -(which basically performs a step of marshalling to string in Isabelle/ML). -\item For safety reasons, it simply suffices to extract all the meta-compiler together with the respective -arguments in front of each incoming meta-commands everytime, then the overall needs to be newly -compiled everytime. -This is the current implemented behavior for Scala. -For Haskell, OCaml and SML, it was also the default behavior in a prototyping version of the compiler, -as a consequence one can restore that functionality for future versions. -\end{itemize} -The keyword @{keyword "self"} is another option to call the own reflected meta-compiler, -and execute the full generation without leaving the own Isabelle process being executed. - -Concerning the semantics of generated contents, if lemmas and proofs are generated, -@{keyword "SORRY"} allows to explicitly skip the evaluation of all proofs, -irrespective of the presence of @{command sorry} or not in generated proofs. -In any cases, the semantics of @{command sorry} has not been overloaded, e.g., -red background may appear as usual. - -Finally @{keyword "generation_semantics"} is a container for specifying various options -for varying the semantics of languages being embedded. -For example, @{keyword "design"} and @{keyword "analysis"} are two options for specifying how -the modelling of objects will be represented in the Toy Language. -Similarly, this would be a typical place for options like -@{text eager} or @{text lazy} for choosing how the evaluation should happen... -\<close> - -section\<open>All Meta Commands of UML/OCL\<close> - -text \<open> -\begin{matharray}{rcl} - @{command_def Class} & : & @{text "theory \<rightarrow> theory"} \\ - @{command_def Abstract_class} & : & @{text "theory \<rightarrow> theory"} \\ -\end{matharray} - -@{rail \<open> - ( @@{command Class} - | @@{command Abstract_class}) - ( binding '=' @{syntax type_base} - | @{syntax type_object} - @{syntax class}) - ; - @{syntax_def class}: - @'Attributes'? ((binding ':' @{syntax uml_type}) * (';'?)) \<newline> - @{syntax context} - ; - @{syntax_def context}: - (( ((() | @'Operations' | '::') - binding @{syntax uml_type} \<newline> - ('=' term | term)? (((@'Pre' | @'Post') @{syntax use_prop} - | @{syntax invariant}) * ()) - ) - | @{syntax invariant}) * ()) - ; - @{syntax_def invariant}: - @'Constraints'? @'Existential'? @'Inv' @{syntax use_prop} - ; -\<close>} -\<close> - -text \<open> -\begin{matharray}{rcl} - @{command_def Aggregation} & : & @{text "theory \<rightarrow> theory"} \\ - @{command_def Association} & : & @{text "theory \<rightarrow> theory"} \\ - @{command_def Composition} & : & @{text "theory \<rightarrow> theory"} -\end{matharray} - -@{rail \<open> - ( @@{command Aggregation} - | @@{command Association} - | @@{command Composition}) binding? @{syntax association} - ; - @{syntax_def association}: - @'Between'? (@{syntax association_end} (@{syntax association_end}+))? - ; - @{syntax_def association_end}: - @{syntax type_object} - @{syntax category} - ';'? - ; -\<close>} -\<close> - -text \<open> -\begin{matharray}{rcl} - @{command_def Associationclass} & : & @{text "theory \<rightarrow> theory"} \\ - @{command_def Abstract_associationclass} & : & @{text "theory \<rightarrow> theory"} -\end{matharray} - -@{rail \<open> - ( @@{command Associationclass} - | @@{command Abstract_associationclass}) @{syntax type_object} \<newline> - @{syntax association} @{syntax class} (() | 'aggregation' | 'composition') - ; -\<close>} -\<close> - -text \<open> -\begin{matharray}{rcl} - @{command_def Context} & : & @{text "theory \<rightarrow> theory"} -\end{matharray} - -@{rail \<open> - @@{command Context} ('[' @'shallow' ']')? @{syntax type_object} @{syntax context} - ; -\<close>} -\<close> - - -text \<open> -\begin{matharray}{rcl} - @{command_def Instance} & : & @{text "theory \<rightarrow> theory"} -\end{matharray} - -@{rail \<open> - @@{command Instance} ((binding ('::' @{syntax type_object})? '=' \<newline> - (@{syntax term_object} | @{syntax object_cast})) * ('and'?)) - ; - @{syntax_def term_object}: - ('[' (binding @'with_only')? \<newline> - ((('(' binding ',' binding ')' '|=')? \<newline> - binding '=' @{syntax uml_term}) * ',') ']') - ; - @{syntax_def object_cast}: - '(' @{syntax term_object} '::' @{syntax type_object} ')' \<newline> - (('\<rightarrow>' 'oclAsType' '(' @{syntax type_object} ')') * ()) - ; -\<close>} -\<close> - -text \<open> -\begin{matharray}{rcl} - @{command_def State} & : & @{text "theory \<rightarrow> theory"} -\end{matharray} - -@{rail \<open> - @@{command State} ('[' @'shallow' ']')? binding ('=' @{syntax state})? - ; - @{syntax_def state}: - '[' ((binding | @{syntax object_cast}) * ',') ']' - ; -\<close>} -\<close> - -text \<open> -\begin{matharray}{rcl} - @{command_def Transition} & : & @{text "theory \<rightarrow> theory"} -\end{matharray} - -@{rail \<open> - @@{command Transition} ('[' @'shallow' ']')? (binding '=')? \<newline> - @{syntax transition} - @{syntax transition}? - ; - @{syntax_def transition}: - binding | @{syntax state} - ; -\<close>} -\<close> - -text \<open> -\begin{matharray}{rcl} - @{command_def Enum} & : & @{text "theory \<rightarrow> theory"} -\end{matharray} - -@{rail \<open> - @@{command Enum} binding '[' (binding * ',') ']' - ; -\<close>} -\<close> - -text \<open> -\begin{matharray}{rcl} - @{command_def Tree} & : & @{text "theory \<rightarrow> theory"} -\end{matharray} - -@{rail \<open> - @@{command Tree} nat nat - ; -\<close>} -\<close> - -subsection\<open>Miscellaneous\<close> - -text \<open> -\begin{matharray}{rcl} - @{command_def BaseType} & : & @{text "theory \<rightarrow> theory"} -\end{matharray} - -@{rail \<open> - @@{command BaseType} '[' (@{syntax term_base} * ',') ']' - ; -\<close>} -\<close> - -section\<open>UML/OCL: Type System\<close> -text \<open> -@{rail \<open> - @{syntax_def unlimited_natural}: - ('*'| '\<infinity>') | number - ; - @{syntax_def term_base}: - ('true' | 'false') - | @{syntax unlimited_natural} - | number - | float_number - | string - ; - @{syntax_def multiplicity}: - '[' ((@{syntax unlimited_natural} ('\<bullet>\<bullet>' @{syntax unlimited_natural})?) * ',') ']' - ; - @{syntax_def uml_term}: - @{syntax term_base} - | @{syntax multiplicity} - - | binding - - | @'self' nat? - | '[' (@{syntax uml_term} * ',') ']' - | '(' (@{syntax uml_term} * ',') ')' - - | '\<langle>' term '\<rangle>' - ; - @{syntax_def name_object}: - ((binding + ',') ':')? binding - ; - @{syntax_def type_base}: - 'Void' - | 'Boolean' - | 'UnlimitedNatural' - | 'Integer' - | 'Real' - | 'String' - ; - @{syntax_def type_object}: - @{syntax name_object} (('<' (@{syntax name_object} + ',')) * ()) - ; - @{syntax_def category}: - @{syntax multiplicity} \<newline> - (@'Role' binding)? - (( @'Derived' '=' term - | @'Nonunique' - | @'Ordered' - | @'Qualifier' @{syntax uml_type} - | @'Redefines' binding - | @'Sequence_' - | @'Subsets' binding - | @'Union') * ()) - ; - @{syntax_def uml_type}: - @{syntax type_base} - | @{syntax type_object} - - | ('Sequence' | 'Set' | @{syntax category}) @{syntax uml_type} - | 'Pair' ( @{syntax uml_type} @{syntax uml_type} - | '(' @{syntax uml_type} ',' @{syntax uml_type} ')') - | '(' ((binding ':' ('(' @{syntax uml_type} ')' | uml_type_weak)) * ',') ')' \<newline> - (':' @{syntax uml_type})? - | '(' @{syntax uml_type} ')' - - | '\<langle>' type '\<rangle>' - ; - @{syntax_def use_prop}: - ( @{syntax type_object} - | @{syntax association} - | (binding? ':')? prop) (';'?) - ; -\<close>} -\<close> -text\<open>uml\_type\_weak is like uml\_type except that type\_object can not contain quantified names.\<close> - -section\<open>UML/OCL: Lazy Identity Combinator\<close> -text \<open> -\begin{matharray}{rcl} - @{command_def End} & : & @{text "theory \<rightarrow> theory"} -\end{matharray} - -@{rail \<open> - @@{command End} ('[' 'forced' ']' | '!')? -\<close>} -\<close> - -section\<open>Featherweight OCL: Library\<close> -text \<open> -\begin{matharray}{rcl} - @{command_def Assert} & : & @{text "theory \<rightarrow> theory"} \\ - @{command_def Assert_local} & : & @{text "local_theory \<rightarrow> local_theory"} -\end{matharray} - -@{rail \<open> - @@{command Assert} term - ; - @@{command Assert_local} term - ; -\<close>} -\<close> - -section\<open>Featherweight OCL: Auxiliary\<close> -text \<open> -\begin{matharray}{rcl} - @{command_def lazy_text} & : & @{text "local_theory \<rightarrow> local_theory"} \\ - @{command_def apply_text} & : & @{text "local_theory \<rightarrow> local_theory"} \\ - @{command_def reset_text} & : & @{text "local_theory \<rightarrow> local_theory"} -\end{matharray} - -@{rail \<open> - @@{command lazy_text} target? text - ; - @@{command apply_text} '(' ')' - ; - @@{command reset_text} '(' ')' - ; -\<close>} -\<close> - -section\<open>Extensions of Isabelle Commands\<close> - -(* WARNING syntax errors during the extraction to LaTeX for the symbol "acute": - fun\<acute>, definition\<acute> or code_reflect\<acute> *) -text \<open> -\begin{matharray}{rcl} - @{command_def "code_reflect'"} & : & @{text "theory \<rightarrow> theory"} -\end{matharray} - -@{rail \<open> - @@{command "code_reflect'"} @'open'? string \<newline> - ( @'datatypes' ( string '=' ( '_' | ( string + '|' ) + @'and' ) ) ) ? \<newline> - ( @'functions' ( string + ) ) ? ( @'file' string ) ? - ; -\<close>} -\<close> - -text\<open> -@{command code_reflect'} has the same semantics as @{command code_reflect} -except that it additionally contains the option @{keyword "open"} inspired -from the command @{command export_code} (with the same semantics). -\<close> - -text \<open> -\begin{matharray}{rcl} - @{command_def lazy_code_printing} & : & @{text "theory \<rightarrow> theory"} \\ - @{command_def apply_code_printing} & : & @{text "theory \<rightarrow> theory"} \\ - @{command_def apply_code_printing_reflect} & : & @{text "local_theory \<rightarrow> local_theory"} -\end{matharray} - -@{rail \<open> - @@{command lazy_code_printing} - ( ( printing_const | printing_typeconstructor - | printing_class | printing_class_relation | printing_class_instance - | printing_module ) + '|' ) - ; - @@{command apply_code_printing} '(' ')' - ; - @@{command apply_code_printing_reflect} text - ; -\<close>} -\<close> - -text\<open> -@{command lazy_code_printing} has the same semantics as @{command code_printing} -or @{command ML}, -except that no side effects occur until we give more details about its intended future semantics: -this will be precised by calling -@{command apply_code_printing} or @{command apply_code_printing_reflect}. -\<close> - -text\<open> -@{command apply_code_printing} repeatedly calls @{command code_printing} -to all previously registered elements with @{command lazy_code_printing} (the order is preserved). -\<close> - -text\<open> -@{command apply_code_printing_reflect} repeatedly calls @{command ML} -to all previously registered elements with @{command lazy_code_printing} (the order is preserved). -As a consequence, code for other targets (Haskell, OCaml, Scala) are ignored. -Moreover before the execution of the overall, -it is possible to give an additional piece of SML code as argument to priorly execute. -\<close> - -(*<*) -end -(*>*) diff --git a/Citadelle/src/compiler/Static.thy b/Citadelle/src/compiler/Static.thy deleted file mode 100644 index 748f44e19510f8516ea067ef02e9f904e76082c2..0000000000000000000000000000000000000000 --- a/Citadelle/src/compiler/Static.thy +++ /dev/null @@ -1,62 +0,0 @@ -(****************************************************************************** - * Citadelle - * - * 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\<open>Toy Libraries Static\<close> -section\<open>Main Common Static Libraries\<close> - -theory Static -imports Main -begin - -text\<open>In case there are functions planned to be at the same time used by the compiler -(by the translating step) and -also used by generated files, then these functions can be defined in this file.\<close> - -definition "map_of_list = (foldl ((\<lambda>map. (\<lambda>(x , l1). (case (map (x)) of None \<Rightarrow> (map (x \<mapsto> l1)) - | Some l0 \<Rightarrow> (map (x \<mapsto> (concat ([l0 , l1])))))))) (Map.empty))" - -definition "choose_0 = fst" -definition "choose_1 = snd" - -definition "deref_assocs_list to_from oid S = - concat (map (choose_1 o to_from) (filter (\<lambda>p. List.member (choose_0 (to_from p)) oid) S))" - -end diff --git a/Citadelle/src/compiler/core/Core_init.thy b/Citadelle/src/compiler/core/Core_init.thy deleted file mode 100644 index 73b5bdb9744a97bdcdd0a993f00feac8335849c0..0000000000000000000000000000000000000000 --- a/Citadelle/src/compiler/core/Core_init.thy +++ /dev/null @@ -1,550 +0,0 @@ -(****************************************************************************** - * Citadelle - * - * 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\<open>Translating Meta-Models\<close> -section\<open>General Environment for the Translation: Introduction\<close> - -theory Core_init -imports "../Static" - "../meta/Meta_META" -begin - -text\<open>This file regroups common utilities used by the embedding functions of OCL in Isabelle.\<close> - -datatype opt_attr_type = OptInh | OptOwn -datatype opt_ident = OptIdent nat - -instantiation internal_oid :: linorder -begin - definition "n_of_internal_oid = (\<lambda> Oid n \<Rightarrow> n)" - definition "n \<le> m \<longleftrightarrow> n_of_internal_oid n \<le> n_of_internal_oid m" - definition "n < m \<longleftrightarrow> n_of_internal_oid n < n_of_internal_oid m" - instance - apply standard - apply (metis less_eq_internal_oid_def less_imp_le less_internal_oid_def not_less) - apply (metis less_eq_internal_oid_def order_refl) - apply (metis less_eq_internal_oid_def order.trans) - apply (simp add: less_eq_internal_oid_def n_of_internal_oid_def, case_tac x, case_tac y, simp) - by (metis le_cases less_eq_internal_oid_def) -end - -instantiation opt_ident :: linorder -begin - definition "n_of_opt_ident = (\<lambda> OptIdent n \<Rightarrow> n)" - definition "n \<le> m \<longleftrightarrow> n_of_opt_ident n \<le> n_of_opt_ident m" - definition "n < m \<longleftrightarrow> n_of_opt_ident n < n_of_opt_ident m" - instance - apply standard - apply (metis less_eq_opt_ident_def less_imp_le less_opt_ident_def not_less) - apply (metis less_eq_opt_ident_def order_refl) - apply (metis less_eq_opt_ident_def order.trans) - apply (simp add: less_eq_opt_ident_def n_of_opt_ident_def, case_tac x, case_tac y, simp) - by (metis le_cases less_eq_opt_ident_def) -end - - -definition "const_oclastype = \<open>OclAsType\<close>" -definition "const_oclistypeof = \<open>OclIsTypeOf\<close>" -definition "const_ocliskindof = \<open>OclIsKindOf\<close>" -definition "const_mixfix dot_ocl name = S.flatten [dot_ocl, \<open>'(\<close>, name, \<open>')\<close>]" -definition "const_oid_of s = \<open>oid_of_\<close> @@ s" -definition "dot_oclastype = \<open>.oclAsType\<close>" -definition "dot_oclistypeof = \<open>.oclIsTypeOf\<close>" -definition "dot_ocliskindof = \<open>.oclIsKindOf\<close>" -definition "dot_astype = mk_dot_par dot_oclastype" -definition "dot_istypeof = mk_dot_par dot_oclistypeof" -definition "dot_iskindof = mk_dot_par dot_ocliskindof" - -definition "var_reconst_basetype = \<open>reconst_basetype\<close>" -definition "var_reconst_basetype_void = \<open>reconst_basetype\<^sub>V\<^sub>o\<^sub>i\<^sub>d\<close>" -definition "var_Abs_Void = \<open>Abs_Void\<^sub>b\<^sub>a\<^sub>s\<^sub>e\<close>" -definition "var_oid_uniq = \<open>oid\<close>" -definition "var_eval_extract = \<open>eval_extract\<close>" -definition "var_deref = \<open>deref\<close>" -definition "var_deref_oid = \<open>deref_oid\<close>" -definition "var_deref_assocs = \<open>deref_assocs\<close>" -definition "var_deref_assocs_list = \<open>deref_assocs_list\<close>" -definition "var_inst_assoc = \<open>inst_assoc\<close>" -definition "var_select = \<open>select\<close>" -definition "var_select_object = \<open>select_object\<close>" -definition "var_select_object_set = \<open>select_object\<^sub>S\<^sub>e\<^sub>t\<close>" -definition "var_select_object_set_any = \<open>select_object_any\<^sub>S\<^sub>e\<^sub>t\<close>" -definition "var_select_object_set_any_exec = \<open>select_object_any_exec\<^sub>S\<^sub>e\<^sub>t\<close>" -definition "var_select_object_sequence = \<open>select_object\<^sub>S\<^sub>e\<^sub>q\<close>" -definition "var_select_object_sequence_any = \<open>select_object_any\<^sub>S\<^sub>e\<^sub>q\<close>" -definition "var_select_object_sequence_any_exec = \<open>select_object_any_exec\<^sub>S\<^sub>e\<^sub>q\<close>" -definition "var_select_object_pair = \<open>select_object\<^sub>P\<^sub>a\<^sub>i\<^sub>r\<close>" -definition "var_select_object_pair_any = \<open>select_object_any\<^sub>P\<^sub>a\<^sub>i\<^sub>r\<close>" -definition "var_select_object_pair_any_exec = \<open>select_object_any_exec\<^sub>P\<^sub>a\<^sub>i\<^sub>r\<close>" -definition "var_choose = \<open>choose\<close>" -definition "var_switch = \<open>switch\<close>" -definition "var_assocs = \<open>assocs\<close>" -definition "var_map_of_list = \<open>map_of_list\<close>" -definition "var_OclInteger = \<open>OclInt\<close>" -definition "var_OclReal = \<open>OclReal\<close>" -definition "var_OclString = \<open>OclString\<close>" -definition "var_Abs_Set = \<open>Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e\<close>" -definition "var_Abs_Set_inverse = var_Abs_Set @@ \<open>_inverse\<close>" -definition "var_Set_base = \<open>Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e\<close>" -definition "var_Sequence_base = \<open>Sequence\<^sub>b\<^sub>a\<^sub>s\<^sub>e\<close>" -definition "var_Pair_base = \<open>Pair\<^sub>b\<^sub>a\<^sub>s\<^sub>e\<close>" -definition "var_mt_set = \<open>mtSet\<close>" -definition "var_ANY_set = \<open>UML_Set.OclANY\<close>" -definition "var_OclIncluding_set = \<open>UML_Set.OclIncluding\<close>" -definition "var_OclForall_set = \<open>UML_Set.OclForall\<close>" -definition "var_mt_sequence = \<open>mtSequence\<close>" -definition "var_ANY_sequence = \<open>UML_Sequence.OclANY\<close>" -definition "var_OclIncluding_sequence = \<open>UML_Sequence.OclIncluding\<close>" -definition "var_OclForall_sequence = \<open>UML_Sequence.OclForall\<close>" -definition "var_self = \<open>self\<close>" -definition "var_result = \<open>result\<close>" -definition "var_val' = \<open>val'\<close>" -definition "update_D_ocl_accessor_pre f = (\<lambda>(l_pre, l_post). (f l_pre, l_post))" -definition "update_D_ocl_accessor_post f = (\<lambda>(l_pre, l_post). (l_pre, f l_post))" - -definition "Term_basety = (let var_x = \<open>x\<close> in - Term_lambdas [var_x, wildcard] (Term_some (Term_some (Term_basic [var_x]))))" - -datatype 'a tree = Tree 'a "'a tree list" - -fun make_tree -and make_tree' where - "make_tree l_pos nb_child deep = - Tree l_pos (case deep of 0 \<Rightarrow> [] - | Suc deep \<Rightarrow> make_tree' l_pos nb_child nb_child deep [])" - - | "make_tree' l_pos nb_child i deep l = - (case i of 0 \<Rightarrow> l - | Suc i \<Rightarrow> make_tree' l_pos nb_child i deep (make_tree (i # l_pos) nb_child deep # l))" - -definition "ident_fresh = (\<lambda>l (map, ident). - case RBT.lookup map l of None \<Rightarrow> (ident, (RBT.insert l ident map, Suc ident)) - | Some i \<Rightarrow> (i, (map, ident)))" - -definition "ident_empty = (RBT.empty, 0)" - -definition "ident_current = snd" - -fun fold_tree where - "fold_tree f t accu = - (case t of Tree _ [] \<Rightarrow> accu - | Tree x l \<Rightarrow> - List.fold - (fold_tree f) - l - (List.fold - (\<lambda>t accu. case t of Tree x' _ \<Rightarrow> f x x' accu) - l - accu))" - -datatype 'a class_output = C_out_OclAny | C_out_simple 'a - -definition "mk_tree nb_child deep n_init = - (let (l, map) = - fold_tree - (\<lambda> l1 l2 (l, map). - let (n1, map) = ident_fresh l1 map - ; (n2, map) = ident_fresh l2 map in - ((if n1 = 0 then - C_out_OclAny - else - C_out_simple (String.nat_to_digit26 (n1 + n_init)), String.nat_to_digit26 (n2 + n_init)) # l, map)) - (make_tree [] nb_child deep) - ([], ident_empty) in - (rev l, n_init + ident_current map - 1))" - -definition "find_class_ass env = - (let (l_tree, l_all_meta) = - partition (\<lambda> META_class_tree _ \<Rightarrow> True - | _ \<Rightarrow> False) (rev (D_input_meta env)) - ; (l_class, l_all_meta) = - partition (let f = \<lambda>class. ClassRaw_clause class = [] in - \<lambda> META_class_raw Floor1 class \<Rightarrow> f class - | META_association _ \<Rightarrow> True - | META_ass_class Floor1 (OclAssClass _ class) \<Rightarrow> f class - | META_class_synonym _ \<Rightarrow> True - | _ \<Rightarrow> False) (l_all_meta) in - ( L.flatten [ \<comment> \<open>generate a set of \<open>Class\<close> from \<open>Tree _ _\<close>\<close> - L.map (let mk = \<lambda>n1 n2. - META_class_raw Floor1 (ocl_class_raw.make - (OclTyObj (OclTyCore_pre n1) - (case n2 of None \<Rightarrow> [] - | Some n2 \<Rightarrow> [[OclTyCore_pre n2]])) - [] - [] - False) in - \<lambda> (C_out_OclAny, s) \<Rightarrow> mk s None - | (C_out_simple s1, s2) \<Rightarrow> mk s2 (Some s1)) - (concat (fst (L.mapM (\<lambda> META_class_tree (OclClassTree n1 n2) \<Rightarrow> - mk_tree (nat_of_natural n1) (nat_of_natural n2)) - l_tree - 0))) - , l_class - , List.map_filter (let f = \<lambda>class. class \<lparr> ClassRaw_clause := [] \<rparr> in - \<lambda> META_class_raw Floor1 c \<Rightarrow> Some (META_class_raw Floor1 (f c)) - | META_ass_class Floor1 (OclAssClass ass class) \<Rightarrow> Some (META_ass_class Floor1 (OclAssClass ass (f class))) - | _ \<Rightarrow> None) l_all_meta ] - , L.flatten (L.map - (let f = \<lambda>class. [ META_ctxt Floor1 (ocl_ctxt_ext [] (ClassRaw_name class) (ClassRaw_clause class) ()) ] in - \<lambda> META_class_raw Floor1 class \<Rightarrow> f class - | META_ass_class Floor1 (OclAssClass _ class) \<Rightarrow> f class - | x \<Rightarrow> [x]) l_all_meta)))" - -definition "map_enum_syn l_enum l_syn = - (\<lambda> OclTy_object (OclTyObj (OclTyCore_pre s) []) \<Rightarrow> - if list_ex (\<lambda>syn. s \<triangleq> (case syn of OclClassSynonym n _ \<Rightarrow> n)) l_syn then - OclTy_class_syn s - else if list_ex (\<lambda>enum. s \<triangleq> (case enum of OclEnum n _ \<Rightarrow> n)) l_enum then - OclTy_enum s - else - OclTy_object (OclTyObj (OclTyCore_pre s) []) - | x \<Rightarrow> x)" - -definition "arrange_ass with_aggreg with_optim_ass l_c l_enum = - (let l_syn = List.map_filter (\<lambda> META_class_synonym e \<Rightarrow> Some e - | _ \<Rightarrow> None) l_c - ; l_class = List.map_filter (\<lambda> META_class_raw Floor1 cflat \<Rightarrow> Some cflat - | META_ass_class Floor1 (OclAssClass _ cflat) \<Rightarrow> Some cflat - | _ \<Rightarrow> None) l_c - ; l_class = \<comment> \<open>map classes: change the (enumeration) type of every attributes to \<open>raw\<close>\<close> - \<comment> \<open>instead of the default \<open>object\<close> type\<close> - L.map - (\<lambda> cflat \<Rightarrow> - cflat \<lparr> ClassRaw_own := - L.map (map_prod id (map_enum_syn l_enum l_syn)) - (ClassRaw_own cflat) \<rparr>) l_class - ; l_ass = List.map_filter (\<lambda> META_association ass \<Rightarrow> Some ass - | META_ass_class Floor1 (OclAssClass ass _) \<Rightarrow> Some ass - | _ \<Rightarrow> None) l_c - ; OclMult = \<lambda>l set. ocl_multiplicity_ext l None set () - ; (l_class, l_ass0) = - if with_optim_ass then - \<comment> \<open>move from classes to associations:\<close> - \<comment> \<open>attributes of object types\<close> - \<comment> \<open>+ those constructed with at most 1 recursive call to \<open>OclTy_collection\<close>\<close> - map_prod rev rev (List.fold - (\<lambda>c (l_class, l_ass). - let default = [Set] - ; f = \<lambda>role t mult_out. \<lparr> OclAss_type = OclAssTy_native_attribute - , OclAss_relation = OclAssRel [(ClassRaw_name c, OclMult [(Mult_star, None)] default) - ,(t, mult_out \<lparr> TyRole := Some role \<rparr>)] \<rparr> - ; (l_own, l_ass) = - List.fold (\<lambda> (role, OclTy_object t) \<Rightarrow> - \<lambda> (l_own, l). (l_own, f role t (OclMult [(Mult_nat 0, Some (Mult_nat 1))] default) # l) - | (role, OclTy_collection mult (OclTy_object t)) \<Rightarrow> - \<lambda> (l_own, l). (l_own, f role t mult # l) - | x \<Rightarrow> \<lambda> (l_own, l). (x # l_own, l)) - (ClassRaw_own c) - ([], l_ass) in - (c \<lparr> ClassRaw_own := rev l_own \<rparr> # l_class, l_ass)) - l_class - ([], [])) - else - (l_class, []) - ; (l_class, l_ass) = - if with_aggreg then - \<comment> \<open>move from associations to classes:\<close> - \<comment> \<open>attributes of aggregation form\<close> - map_prod rev rev (List.fold - (\<lambda>ass (l_class, l_ass). - if OclAss_type ass = OclAssTy_aggregation then - ( fold_max - (\<lambda> (cpt_to, (name_to, category_to)). - case TyRole category_to of - Some role_to \<Rightarrow> - List.fold (\<lambda> (cpt_from, (name_from, multip_from)). - L.map_find (\<lambda>cflat. - if cl_name_to_string cflat \<triangleq> ty_obj_to_string name_from then - Some (cflat \<lparr> ClassRaw_own := - L.flatten [ ClassRaw_own cflat - , [(role_to, let ty = OclTy_object name_to in - if single_multip category_to then - ty - else - OclTy_collection category_to ty)]] \<rparr>) - else None)) - | _ \<Rightarrow> \<lambda>_. id) - (OclAss_relation' ass) - l_class - , l_ass) - else - (l_class, ass # l_ass)) l_ass (l_class, [])) - else - (l_class, l_ass) in - ( l_class - , L.flatten [l_ass, l_ass0]))" - -definition "datatype_name = \<open>ty\<close>" -definition "datatype_ext_name = datatype_name @@ \<open>\<E>\<X>\<T>\<close>" -definition "datatype_constr_name = \<open>mk\<close>" -definition "datatype_ext_constr_name = datatype_constr_name @@ \<open>\<E>\<X>\<T>\<close>" -definition "datatype'_ext_name = \<open>ty2\<close>" -definition "datatype'_ext'_name = datatype'_ext_name @@ \<open>\<E>\<X>\<T>\<close>" -definition "datatype'_name = datatype'_ext_name @@ const_oid" -definition "datatype'_ext_constr_name = \<open>mk2\<close>" -definition "datatype'_constr_name = datatype'_ext_constr_name @@ const_oid" -definition "datatype_in = \<open>in\<close>" - -subsection\<open>Main Combinators for the Translation\<close> - -text\<open> -As general remark, all the future translating steps -(e.g., that will occur in @{file "Floor1_access.thy"}) -will extensively use Isabelle expressions, -represented by its Meta-Model, for example lots of functions will use @{term "Term_app"}... -So the overall can be simplified by the use of polymorphic cartouches. -It looks feasible to add a new front-end for cartouches in @{theory "FOCL.Init"} -supporting the use of Isabelle syntax in cartouches, -then we could obtain at the end a parsed Isabelle Meta-Model in Isabelle.\<close> - -definition "map_class_arg_only_var = map_class_arg_only_var_gen (\<lambda>s e. Term_postunary s (Term_basic e))" -definition "map_class_arg_only_var' = map_class_arg_only_var'_gen (\<lambda>s e. Term_postunary s (Term_basic e))" -definition "map_class_arg_only_var'' = map_class_arg_only_var''_gen (\<lambda>s e. Term_postunary s (Term_basic e))" - -definition "split_ty name = L.map (\<lambda>s. hol_split (s @@ String.isub name)) [datatype_ext_name, datatype_name]" - -definition "start_map f = L.mapM (\<lambda>x acc. (f x, acc))" -definition "start_map' f x accu = (f x, accu)" -definition "start_map''' f fl = (\<lambda> env. - let design_analysis = D_ocl_semantics env - ; base_attr = (if design_analysis = Gen_only_design then id else L.filter (\<lambda> (_, OclTy_object (OclTyObj (OclTyCore _) _)) \<Rightarrow> False | _ \<Rightarrow> True)) - ; base_attr' = (\<lambda> (l_attr, l_inh). (base_attr l_attr, L.map base_attr l_inh)) - ; base_attr'' = (\<lambda> (l_attr, l_inh). (base_attr l_attr, base_attr l_inh)) in - start_map f (fl design_analysis base_attr base_attr' base_attr'') env)" -definition "start_map'' f fl e = start_map''' f (\<lambda>_. fl) e" -definition "start_map'''' f fl = (\<lambda> env. start_map f (fl (D_ocl_semantics env)) env)" -definition "start_map''''' f fl = (\<lambda> env. start_map f (fl (D_output_sorry_dirty env) (D_ocl_semantics env)) env)" -definition "start_map'''''' f fl = (\<lambda> env. start_map f (fl (\<lambda>s. (case D_output_header_thy env of - Some (n_thy, _, _) \<Rightarrow> - String.replace_integers - (\<lambda> n. if n = 0x5F then \<open>-\<close> - else \<degree>n\<degree>) - n_thy - | None \<Rightarrow> \<open>\<close>) @@ s) - (D_ocl_semantics env)) env)" - -definition "start_m_gen final f print = start_map'' final o (\<lambda>expr base_attr _ _. - m_class_gen2 base_attr f print expr)" -definition "start_m final f print = start_map'' final o (\<lambda>expr base_attr _ _. - m_class base_attr f print expr)" -definition "start_m' final print = start_map'' final o (\<lambda>expr base_attr _ _. - m_class' base_attr print expr)" -definition "start_m'3_gen final print = start_map'' final o (\<lambda>expr base_attr _ _. - m_class_gen3 base_attr id print expr)" - - -definition "activate_simp_optimization = True" - -definition "prev_was_stop = (\<lambda> [] \<Rightarrow> True | x # _ \<Rightarrow> ignore_meta_header x)" - -fun collect_meta_embed where - "collect_meta_embed accu e = - (\<lambda> (True, _) \<Rightarrow> rev accu - | (_, []) \<Rightarrow> rev accu - | (_, x # l_meta) \<Rightarrow> collect_meta_embed (x # accu) (prev_was_stop l_meta, l_meta)) e" - -definition "bootstrap_floor l env = - (let l_setup = \<lambda>f. META_boot_setup_env (Boot_setup_env (f env \<lparr> D_output_disable_thy := True - , D_output_header_thy := None \<rparr>)) - # l in - ( if D_output_auto_bootstrap env then - if prev_was_stop (D_input_meta env) then - l - else - l_setup (\<lambda>env. compiler_env_config_reset_no_env env - \<lparr> D_input_meta := collect_meta_embed [] (False, D_input_meta env) \<rparr>) - else - META_boot_generation_syntax (Boot_generation_syntax (D_ocl_semantics env)) - # l_setup id - , env \<lparr> D_output_auto_bootstrap := True \<rparr> ))" - -definition "wrap_oclty x = \<open>\<cdot>\<close> @@ x" -definition "Term_annot_ocl e s = Term_annot' e (wrap_oclty s)" -definition "Term_oclset l = (case l of [] \<Rightarrow> Term_basic [\<open>Set{}\<close>] | _ \<Rightarrow> Term_paren \<open>Set{\<close> \<open>}\<close> (term_binop \<open>,\<close> l))" - -context SML -begin -definition "oid s = (\<lambda>Oid n \<Rightarrow> basic [s @@ String.natural_to_digit10 n])" -end - -lemmas [code] = - \<comment> \<open>def\<close> - SML.oid_def - -definition "Term_oid s = (\<lambda>Oid n \<Rightarrow> Term_basic [s @@ String.natural_to_digit10 n])" - -subsection\<open>Preliminaries on: Enumeration\<close> - -subsection\<open>Preliminaries on: Infrastructure\<close> - -fun print_infra_type_synonym_class_rec_aux0 where - "print_infra_type_synonym_class_rec_aux0 e = - (let option = \<lambda>x. Typ_apply (Typ_base \<open>option\<close>) [x] in - (\<lambda> OclTy_collection c t \<Rightarrow> - let (name, ty) = print_infra_type_synonym_class_rec_aux0 t in - ( (if is_sequence c then \<open>Sequence\<close> else \<open>Set\<close>) @@ \<open>_\<close> @@ name - , Typ_apply (Typ_base (if is_sequence c then var_Sequence_base else var_Set_base)) [ty]) - | OclTy_pair t1 t2 \<Rightarrow> - let (name1, ty1) = print_infra_type_synonym_class_rec_aux0 t1 - ; (name2, ty2) = print_infra_type_synonym_class_rec_aux0 t2 in - ( \<open>Pair\<close> @@ \<open>_\<close> @@ name1 @@ \<open>_\<close> @@ name2 - , Typ_apply (Typ_base var_Pair_base) [ty1, ty2]) - | OclTy_object (OclTyObj (OclTyCore_pre s) _) \<Rightarrow> (s, option (option (Typ_base (datatype_name @@ String.isub s)))) - | t \<Rightarrow> (str_of_ty t, Typ_base (str_of_ty t @@ String.isub \<open>base\<close>))) e)" - -definition "print_infra_type_synonym_class_rec_aux t = - (let (tit, body) = print_infra_type_synonym_class_rec_aux0 t in - (tit, Typ_apply (Typ_base \<open>val\<close>) [Typ_base \<open>\<AA>\<close>, body]))" - -definition "pref_generic_enum name_ty = name_ty @@ String.isub \<open>generic\<close>" - -subsection\<open>Preliminaries on: AsType\<close> - -definition "print_astype_from_universe_name name = S.flatten [const_oclastype, String.isub name, \<open>_\<AA>\<close>]" - -subsection\<open>Preliminaries on: IsTypeOf\<close> - -definition "print_istypeof_defined_name isub_name h_name = S.flatten [isub_name const_oclistypeof, \<open>_\<close>, h_name, \<open>_defined\<close>]" -definition "print_istypeof_defined'_name isub_name h_name = S.flatten [isub_name const_oclistypeof, \<open>_\<close>, h_name, \<open>_defined'\<close>]" -definition "print_istypeof_up_d_cast_name name_mid name_any name_pers = S.flatten [\<open>down_cast_type\<close>, String.isub name_mid, \<open>_from_\<close>, name_any, \<open>_to_\<close>, name_pers]" - -subsection\<open>Preliminaries on: IsKindOf\<close> - -definition "print_iskindof_up_eq_asty_name name = (S.flatten [\<open>actual_eq_static\<close>, String.isub name])" -definition "print_iskindof_up_larger_name name_pers name_any = S.flatten [\<open>actualKind\<close>, String.isub name_pers, \<open>_larger_staticKind\<close>, String.isub name_any]" - -subsection\<open>Preliminaries on: AllInstances\<close> - -definition "gen_pre_post0 f_tit f_assum spec f_lemma meth_last = - (let b = \<lambda>s. Term_basic [s] - ; d = hol_definition - ; f_allinst = \<lambda>s. \<open>OclAllInstances_\<close> @@ s - ; f_tit = f_tit o f_allinst - ; var_pre_post = \<open>pre_post\<close> - ; var_mk = \<open>mk\<close> - ; var_st = \<open>st\<close> - ; s_generic = \<open>generic\<close> - ; lem_gen = f_tit s_generic - ; mk_pre_post = \<lambda>pre_post at_when f_cpl. - let s_allinst = f_allinst at_when in - Lemma_assumes - (f_tit at_when) - f_assum - (spec (Term_app s_allinst) f_cpl pre_post) - [C.unfolding [T.thm (d s_allinst)]] - (C.by (M.rule (T.thm lem_gen) # meth_last)) in - [ f_lemma lem_gen f_assum (spec (\<lambda>l. Term_app (f_allinst s_generic) (b var_pre_post # l)) (\<lambda>e. Term_app var_mk [e]) var_pre_post) var_pre_post var_mk var_st - , mk_pre_post \<open>snd\<close> \<open>at_post\<close> (Term_pair (b var_st)) - , mk_pre_post \<open>fst\<close> \<open>at_pre\<close> (\<lambda>e. Term_pair e (b var_st)) ])" - -definition "gen_pre_post f_tit spec f_lemma = gen_pre_post0 f_tit [] spec (\<lambda>lem_gen _. f_lemma lem_gen)" - -subsection\<open>Preliminaries on: Accessor\<close> - -definition "print_access_oid_uniq_name' name_from_nat isub_name attr = S.flatten [ isub_name var_oid_uniq, \<open>_\<close>, String.natural_to_digit10 name_from_nat, \<open>_\<close>, attr ]" -definition "print_access_oid_uniq_name name_from_nat isub_name attr = print_access_oid_uniq_name' name_from_nat isub_name (String.isup attr)" -definition "print_access_oid_uniq_mlname name_from_nat name attr = S.flatten [ var_oid_uniq, name, \<open>_\<close>, String.natural_to_digit10 name_from_nat, \<open>_\<close>, attr ]" - -definition "print_access_choose_name n i j = - S.flatten [var_switch, String.isub (String.natural_to_digit10 n), \<open>_\<close>, String.natural_to_digit10 i, String.natural_to_digit10 j]" -definition "print_access_choose_mlname n i j = - S.flatten [var_switch, String.natural_to_digit10 n, \<open>_\<close>, String.natural_to_digit10 i, String.natural_to_digit10 j]" - -definition "print_access_dot_consts_ty attr_ty = - (let ty_base = \<lambda>attr_ty. - Typ_apply (Typ_base \<open>val\<close>) [Typ_base \<open>\<AA>\<close>, - let option = \<lambda>x. Typ_apply (Typ_base \<open>option\<close>) [x] in - option (option (Typ_base attr_ty))] in - case attr_ty of - OclTy_raw attr_ty \<Rightarrow> ty_base attr_ty - | OclTy_object (OclTyObj (OclTyCore ty_obj) _) \<Rightarrow> - let ty_obj = TyObj_to ty_obj - ; name = TyObjN_role_ty ty_obj - ; obj_mult = TyObjN_role_multip ty_obj in - Typ_base (if single_multip obj_mult then - wrap_oclty name - else if is_sequence obj_mult then - print_infra_type_synonym_class_sequence_name name - else - print_infra_type_synonym_class_set_name name) - | OclTy_object (OclTyObj (OclTyCore_pre s) _) \<Rightarrow> Raw (wrap_oclty s) - | OclTy_base_unlimitednatural \<Rightarrow> str_hol_of_ty_all Typ_apply ty_base attr_ty - (* REMARK Dependencies to UnlimitedNatural.thy can be detected and added - so that this pattern clause would be merged with the default case *) - | OclTy_collection _ _ \<Rightarrow> Raw (fst (print_infra_type_synonym_class_rec_aux attr_ty)) - | OclTy_pair _ _ \<Rightarrow> Raw (fst (print_infra_type_synonym_class_rec_aux attr_ty)) - | _ \<Rightarrow> Raw (str_of_ty attr_ty))" - -subsection\<open>Preliminaries on: Example (Floor 1)\<close> - -datatype reporting = Warning - | Error - | Writeln - -definition "raise_ml l_out s = SML (SML.app0 \<open>Ty'.check\<close> - [ SML.list' - (\<lambda>(rep, s). - SML.pair (SML.basic [S.flatten [ \<open>META.\<close> - , case rep of Warning \<Rightarrow> \<open>Warning\<close> - | Error \<Rightarrow> \<open>Error\<close> - | Writeln \<Rightarrow> \<open>Writeln\<close> ]]) - (SML.string s)) - l_out - , SML.string s ])" - -definition "print_examp_def_st_inst_var_name ocli name = S.flatten [case Inst_name ocli of Some n \<Rightarrow> n, name]" - -subsection\<open>Preliminaries on: Example (Floor 2)\<close> - -subsection\<open>Preliminaries on: Context (Floor 1)\<close> - -definition "print_ctxt_const_name attr_n var_at_when_hol name = - S.flatten [ \<open>dot\<close>, String.isup attr_n, var_at_when_hol] @@ (case name of None \<Rightarrow> \<open>\<close> | Some name \<Rightarrow> \<open>_\<close> @@ name)" -definition "print_ctxt_pre_post_name attr_n var_at_when_hol name = hol_definition (print_ctxt_const_name attr_n var_at_when_hol name)" -definition "print_ctxt_inv_name n tit var_at_when = S.flatten [n, \<open>_\<close>, tit, var_at_when]" - -definition "make_ctxt_free_var pref ctxt = - (var_self # L.flatten [ L.map fst (Ctxt_fun_ty_arg ctxt) - , if pref = OclCtxtPre then [] else [var_result] ])" - -subsection\<open>Preliminaries on: Context (Floor 2)\<close> - -end diff --git a/Citadelle/src/compiler/core/Floor1_access.thy b/Citadelle/src/compiler/core/Floor1_access.thy deleted file mode 100644 index 9d30c3c1b13445612bcd417bf5fa940a9d5eae84..0000000000000000000000000000000000000000 --- a/Citadelle/src/compiler/core/Floor1_access.thy +++ /dev/null @@ -1,736 +0,0 @@ -(****************************************************************************** - * 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. - ******************************************************************************) - -section\<open>Main Translation for: Accessor\<close> - -theory Floor1_access -imports Core_init -begin - -definition "print_access_oid_uniq_gen Thy_def D_ocl_oid_start_upd def_rewrite = - (\<lambda>expr env. - (\<lambda>(l, oid_start). (L.map Thy_def l, D_ocl_oid_start_upd env oid_start)) - (let (l, (acc, _)) = fold_class (\<lambda>isub_name name l_attr l_inh _ _ cpt. - let l_inh = L.map (\<lambda> OclClass _ l _ \<Rightarrow> l) (of_inh l_inh) in - let (l, cpt) = L.mapM (L.mapM - (\<lambda> (attr, OclTy_object (OclTyObj (OclTyCore ty_obj) _)) \<Rightarrow> - (let obj_oid = TyObj_ass_id ty_obj - ; obj_name_from_nat = TyObjN_ass_switch (TyObj_from ty_obj) in \<lambda>(cpt, rbt) \<Rightarrow> - let (cpt_obj, cpt_rbt) = - case RBT.lookup rbt obj_oid of - None \<Rightarrow> (cpt, oidSucAssoc cpt, RBT.insert obj_oid cpt rbt) - | Some cpt_obj \<Rightarrow> (cpt_obj, cpt, rbt) in - ( [def_rewrite obj_name_from_nat name isub_name attr (oidGetAssoc cpt_obj)] - , cpt_rbt)) - | _ \<Rightarrow> \<lambda>cpt. ([], cpt))) - (l_attr # l_inh) cpt in - (L.flatten (L.flatten l), cpt)) (D_ocl_oid_start env, RBT.empty) expr in - (L.flatten l, acc)))" -definition "print_access_oid_uniq_ml = - print_access_oid_uniq_gen - O.ML - (\<lambda>x _. x) - (\<lambda>obj_name_from_nat name _ attr cpt_obj. - SML (SML.rewrite_val - (SML.basic [print_access_oid_uniq_mlname obj_name_from_nat name attr]) - \<open>=\<close> - (SML.oid \<open>\<close> cpt_obj)))" -definition "print_access_oid_uniq = - print_access_oid_uniq_gen - O.definition - (\<lambda>env oid_start. env \<lparr> D_ocl_oid_start := oid_start \<rparr>) - (\<lambda>obj_name_from_nat _ isub_name attr cpt_obj. - Definition (Term_rewrite - (Term_basic [print_access_oid_uniq_name obj_name_from_nat isub_name attr]) - \<open>=\<close> - (Term_oid \<open>\<close> cpt_obj)))" - -definition "print_access_eval_extract _ = start_map O.definition - (let lets = \<lambda>var def. Definition (Term_rewrite (Term_basic [var]) \<open>=\<close> def) - ; a = \<lambda>f x. Term_app f [x] - ; b = \<lambda>s. Term_basic [s] in - [ let var_x = \<open>x\<close> - ; var_f = \<open>f\<close> - ; some_some = (\<lambda>x. Term_some (Term_some x)) - ; var_obj = \<open>obj\<close> in - Definition (Term_rewrite - (Term_basic [var_eval_extract, var_x, var_f]) - \<open>=\<close> - (Term_lam \<open>\<tau>\<close> - (\<lambda>var_tau. Term_case (Term_basic [var_x, var_tau]) - [ (some_some (Term_basic [var_obj]), Term_app var_f [Term_app \<open>oid_of\<close> [Term_basic [var_obj]], Term_basic [var_tau]]) - , (Term_basic [wildcard], Term_basic [\<open>invalid\<close>, var_tau])]))) - , lets var_in_pre_state (b \<open>fst\<close>) - , lets var_in_post_state (b \<open>snd\<close>) - , lets var_reconst_basetype Term_basety - , let var_x = \<open>x\<close> in - Definition (Term_rewrite (Term_basic [var_reconst_basetype_void, var_x]) - \<open>=\<close> - (Term_binop (Term_basic [var_Abs_Void]) \<open>o\<close> (a var_reconst_basetype (b var_x)))) ])" - - -definition "print_access_choose_switch - lets mk_var expr - print_access_choose_n - sexpr_list sexpr_function sexpr_pair = - L.flatten - (L.map - (\<lambda>n. - let l = L.upto 0 (n - 1) in - L.map (let l = sexpr_list (L.map mk_var l) in (\<lambda>(i,j). - (lets - (print_access_choose_n n i j) - (sexpr_function [(l, (sexpr_pair (mk_var i) (mk_var j)))])))) - ((L.flatten o L.flatten) (L.map (\<lambda>i. L.map (\<lambda>j. if i = j then [] else [(i, j)]) l) l))) - (class_arity expr))" -definition "print_access_choose_ml = start_map'''' O.ML o (\<lambda>expr _. - (let b = \<lambda>s. SML.basic [s] - ; lets = \<lambda>var exp. SML (SML.rewrite_val (SML.basic [var]) \<open>=\<close> exp) - ; mk_var = \<lambda>i. b (S.flatten [\<open>x\<close>, String.natural_to_digit10 i]) in - L.flatten - [ print_access_choose_switch - lets mk_var expr - print_access_choose_mlname - SML.list SML.function SML.pair ]))" -definition "print_access_choose = start_map'''' O.definition o (\<lambda>expr _. - (let a = \<lambda>f x. Term_app f [x] - ; b = \<lambda>s. Term_basic [s] - ; lets = \<lambda>var exp. Definition (Term_rewrite (Term_basic [var]) \<open>=\<close> exp) - ; lets' = \<lambda>var exp. Definition (Term_rewrite (Term_basic [var]) \<open>=\<close> (b exp)) - ; lets'' = \<lambda>var exp. Definition (Term_rewrite (Term_basic [var]) \<open>=\<close> (Term_lam \<open>l\<close> (\<lambda>var_l. Term_binop (b var_l) \<open>!\<close> (b exp)))) - ; _\<comment> \<open>(ignored)\<close> = - let l_flatten = \<open>L.flatten\<close> in - [ lets l_flatten (let fun_foldl = \<lambda>f base. - Term_lam \<open>l\<close> (\<lambda>var_l. Term_app \<open>foldl\<close> [Term_lam \<open>acc\<close> f, base, a \<open>rev\<close> (b var_l)]) in - fun_foldl (\<lambda>var_acc. - fun_foldl (\<lambda>var_acc. - Term_lam \<open>l\<close> (\<lambda>var_l. Term_app \<open>Cons\<close> (L.map b [var_l, var_acc]))) (b var_acc)) (b \<open>Nil\<close>)) - , lets var_map_of_list (Term_app \<open>foldl\<close> - [ Term_lam \<open>map\<close> (\<lambda>var_map. - let var_x = \<open>x\<close> - ; var_l0 = \<open>l0\<close> - ; var_l1 = \<open>l1\<close> - ; f_map = a var_map in - Term_lambdas0 (Term_pair (b var_x) (b var_l1)) - (Term_case (f_map (b var_x)) - (L.map (\<lambda>(pat, e). (pat, f_map (Term_binop (b var_x) \<open>\<mapsto>\<close> e))) - [ (b \<open>None\<close>, b var_l1) - , (Term_some (b var_l0), a l_flatten (Term_list (L.map b [var_l0, var_l1])))]))) - , b \<open>Map.empty\<close>])] in - L.flatten - [ let a = \<lambda>f x. Term_app f [x] - ; b = \<lambda>s. Term_basic [s] - ; lets = \<lambda>var exp. Definition (Term_rewrite (Term_basic [var]) \<open>=\<close> exp) - ; mk_var = \<lambda>i. b (S.flatten [\<open>x\<close>, String.natural_to_digit10 i]) in - print_access_choose_switch - lets mk_var expr - print_access_choose_name - Term_list Term_function Term_pair - , [ let var_pre_post = \<open>pre_post\<close> - ; var_to_from = \<open>to_from\<close> - ; var_assoc_oid = \<open>assoc_oid\<close> - ; var_f = \<open>f\<close> - ; var_oid = \<open>oid\<close> in - Definition (Term_rewrite - (Term_basic [var_deref_assocs, var_pre_post, var_to_from, var_assoc_oid, var_f, var_oid ]) - \<open>=\<close> - (Term_lam - \<open>\<tau>\<close> - (\<lambda>var_tau. - Term_case (Term_app var_assocs [Term_app var_pre_post [Term_basic [var_tau]] - ,Term_basic [var_assoc_oid]]) - [ let var_S = \<open>S\<close> in - ( Term_some (Term_basic [var_S]) - , Term_app var_f - [ Term_app var_deref_assocs_list (L.map b [var_to_from, var_oid, var_S]) - , Term_basic [var_tau]]) - , (Term_basic[wildcard], Term_app \<open>invalid\<close> [Term_basic [var_tau]]) ]))) ]] ))" - -definition "print_access_deref_oid_name isub_name = isub_name var_deref_oid" -definition "print_access_deref_oid = start_map O.definition o - map_class (\<lambda>isub_name _ _ _ _ _. - let var_fs = \<open>fst_snd\<close> - ; var_f = \<open>f\<close> - ; var_oid = \<open>oid\<close> - ; var_obj = \<open>obj\<close> in - Definition (Term_rewrite - (Term_basic [print_access_deref_oid_name isub_name, var_fs, var_f, var_oid]) - \<open>=\<close> - (Term_lam \<open>\<tau>\<close> - (\<lambda>var_tau. Term_case (Term_app \<open>heap\<close> [Term_basic [var_fs, var_tau], Term_basic [var_oid]]) - [ (Term_some (Term_basic [isub_name datatype_in, var_obj]), Term_basic [var_f, var_obj, var_tau]) - , (Term_basic [wildcard], Term_basic [\<open>invalid\<close>, var_tau]) ]))))" - -definition "print_access_deref_assocs_name' name_from isub_name isup_attr = - S.flatten [var_deref, \<open>_\<close>, isub_name var_assocs, \<open>_\<close>, String.natural_to_digit10 name_from, isup_attr \<open>_\<close>]" -definition "print_access_deref_assocs_name name_from isub_name attr = - print_access_deref_assocs_name' name_from isub_name (\<lambda>s. s @@ String.isup attr)" -definition "print_access_deref_assocs = start_map'''' O.definition o (\<lambda>expr design_analysis. - (if design_analysis = Gen_only_design then \<lambda>_. [] else (\<lambda>expr. L.flatten (L.flatten (map_class (\<lambda>isub_name name l_attr l_inherited _ _. - let l_inherited = map_class_inh l_inherited in - let var_fst_snd = \<open>fst_snd\<close> - ; var_f = \<open>f\<close> - ; b = \<lambda>s. Term_basic [s] in - L.flatten (L.map (L.map - (\<lambda> (attr, OclTy_object (OclTyObj (OclTyCore ty_obj) _)) \<Rightarrow> - let name_from = TyObjN_ass_switch (TyObj_from ty_obj) in - [Definition (Term_rewrite - (Term_basic [print_access_deref_assocs_name name_from isub_name attr, var_fst_snd, var_f]) - \<open>=\<close> - (Term_binop - (Term_app - var_deref_assocs - (L.map b [ var_fst_snd - , print_access_choose_name (TyObj_ass_arity ty_obj) name_from (TyObjN_ass_switch (TyObj_to ty_obj)) - , print_access_oid_uniq_name name_from isub_name attr - , var_f ])) - \<open>\<circ>\<close> - (b \<open>oid_of\<close>)))] - | _ \<Rightarrow> [])) - (l_attr # l_inherited))) expr)))) expr)" - -definition "print_access_select_name isup_attr isub_name = isup_attr (isub_name var_select)" -definition "print_access_select = start_map'' O.definition o (\<lambda>expr base_attr _ base_attr''. - let b = \<lambda>s. Term_basic [s] in - map_class_arg_only0 (\<lambda>isub_name name l_attr. - let l_attr = base_attr l_attr in - let var_f = \<open>f\<close> - ; wildc = Term_basic [wildcard] in - let (_, _, l) = (foldl - (\<lambda>(l_wildl, l_wildr, l_acc) (attr, _). - let isup_attr = (\<lambda>s. s @@ String.isup attr) in - ( wildc # l_wildl - , tl l_wildr - , Definition (Term_rewrite - (Term_basic [print_access_select_name isup_attr isub_name, var_f]) - \<open>=\<close> - (let var_attr = b (\<open>x_\<close> @@ String.isup attr) in - Term_function - (L.map (\<lambda>(lhs,rhs). ( Term_app - (isub_name datatype_constr_name) - ( wildc - # L.flatten [l_wildl, [lhs], l_wildr]) - , rhs)) - [ ( Term_basic [\<open>\<bottom>\<close>], Term_basic [\<open>null\<close>] ) - , ( Term_some var_attr - , Term_app var_f [var_attr]) ]))) # l_acc)) - ([], L.map (\<lambda>_. wildc) (tl l_attr), []) - l_attr) in - rev l) - (\<lambda>isub_name name (l_attr, l_inherited, l_cons). - let l_inherited = L.flatten (L.map (\<lambda> OclClass _ l _ \<Rightarrow> l) (of_inh l_inherited)) in - let (l_attr, l_inherited) = base_attr'' (l_attr, l_inherited) in - let var_f = \<open>f\<close> - ; wildc = Term_basic [wildcard] in - let (_, _, l) = (foldl - (\<lambda>(l_wildl, l_wildr, l_acc) (attr, _). - let isup_attr = (\<lambda>s. s @@ String.isup attr) in - ( wildc # l_wildl - , tl l_wildr - , Definition (Term_rewrite - (Term_basic [isup_attr (isub_name var_select), var_f]) - \<open>=\<close> - (let var_attr = b (\<open>x_\<close> @@ String.isup attr) in - Term_function - (L.flatten (L.map (\<lambda>(lhs,rhs). ( Term_app - (isub_name datatype_constr_name) - ( Term_app (isub_name datatype_ext_constr_name) - (wildc # L.flatten [l_wildl, [lhs], l_wildr]) - # L.map (\<lambda>_. wildc) l_attr) - , rhs)) - [ ( Term_basic [\<open>\<bottom>\<close>], Term_basic [\<open>null\<close>] ) - , ( Term_some var_attr - , Term_app var_f [var_attr]) ] - # (L.map (\<lambda> OclClass x _ _ \<Rightarrow> let var_x = String.lowercase x in - (Term_app - (isub_name datatype_constr_name) - ( Term_app (datatype_ext_constr_name @@ mk_constr_name name x) - [Term_basic [var_x]] - # L.map (\<lambda>_. wildc) l_attr), (Term_app (isup_attr (var_select @@ String.isub x)) - (L.map (\<lambda>x. Term_basic [x]) [var_f, var_x]) ))) (of_sub l_cons)) - # [])))) # l_acc)) - ([], L.map (\<lambda>_. wildc) (tl l_inherited), []) - l_inherited) in - rev l) expr)" - -definition "print_access_select_obj_name' isub_name attr = isub_name var_select @@ attr" -definition "print_access_select_obj_name isub_name attr = print_access_select_obj_name' isub_name (String.isup attr)" -definition "print_access_select_obj = start_map'''' O.definition o (\<lambda>expr design_analysis. - (if design_analysis = Gen_only_design then \<lambda>_. [] else (\<lambda>expr. L.flatten (L.flatten (map_class (\<lambda>isub_name name l_attr l_inh _ _. - let l_inh = map_class_inh l_inh in - L.flatten (fst (L.mapM (L.mapM - (\<lambda> (attr, OclTy_object (OclTyObj (OclTyCore ty_obj) _)) \<Rightarrow> \<lambda>rbt. - if lookup2 rbt (name, attr) = None then - ( [ Definition - (let b = \<lambda>s. Term_basic [s] in - Term_rewrite - (b (isub_name var_select @@ String.isup attr)) - \<open>=\<close> - (b (let obj_mult = TyObjN_role_multip (TyObj_to ty_obj) in - case (is_sequence obj_mult, single_multip obj_mult) of - (True, True) \<Rightarrow> var_select_object_sequence_any - | (True, False) \<Rightarrow> var_select_object_sequence - | (False, True) \<Rightarrow> var_select_object_set_any - | (False, False) \<Rightarrow> var_select_object_set)))] - , insert2 (name, attr) () rbt) - else ([], rbt) - | _ \<Rightarrow> Pair [])) - (l_attr # l_inh) RBT.empty))) expr)))) expr)" - -definition "print_access_dot_consts = - (L.mapM (\<lambda>(f_update, x) env. (O.consts x, env \<lparr> D_ocl_accessor := f_update (D_ocl_accessor env) \<rparr> ))) o - (L.flatten o L.flatten o map_class (\<lambda>isub_name name l_attr _ _ _. - L.map (\<lambda>(attr_n, attr_ty). - L.map - (\<lambda>(var_at_when_hol, var_at_when_ocl, f_update_ocl). - let name = - S.flatten [ \<open>dot\<close> - , case attr_ty of - OclTy_object (OclTyObj (OclTyCore ty_obj) _) \<Rightarrow> S.flatten [\<open>_\<close>, String.natural_to_digit10 (TyObjN_ass_switch (TyObj_from ty_obj)), \<open>_\<close>] - | _ \<Rightarrow> \<open>\<close> - , String.isup attr_n, var_at_when_hol] in - ( f_update_ocl (\<lambda> l. String.to_String\<^sub>b\<^sub>a\<^sub>s\<^sub>e name # l) - , Consts_raw0 - name - (Ty_arrow - (Typ_apply (Typ_base \<open>val\<close>) [Typ_base \<open>\<AA>\<close>, Typ_base \<open>'\<alpha>\<close>]) - (print_access_dot_consts_ty attr_ty)) - (let dot_name = mk_dot attr_n var_at_when_ocl - ; mk_par = \<lambda>s1 s2. S.flatten [s1, \<open> '/* \<close>, s2, \<open> *'/\<close>] in - case attr_ty of OclTy_object (OclTyObj (OclTyCore ty_obj) _) \<Rightarrow> - (case apply_optim_ass_arity - ty_obj - (mk_par - dot_name - (let ty_obj = TyObj_from ty_obj in - case TyObjN_role_name ty_obj of - None => String.natural_to_digit10 (TyObjN_ass_switch ty_obj) - | Some s => s)) of - None \<Rightarrow> dot_name - | Some dot_name \<Rightarrow> dot_name) - | _ \<Rightarrow> dot_name) - None)) - [ (var_at_when_hol_post, var_at_when_ocl_post, update_D_ocl_accessor_post) - , (var_at_when_hol_pre, var_at_when_ocl_pre, update_D_ocl_accessor_pre)]) l_attr))" - -definition "print_access_dot_name isub_name dot_at_when attr_ty isup_attr = - S.flatten [ isup_attr (let dot_name = isub_name \<open>dot\<close> in - case attr_ty of - OclTy_object (OclTyObj (OclTyCore ty_obj) _) \<Rightarrow> S.flatten [dot_name, \<open>_\<close>, String.natural_to_digit10 (TyObjN_ass_switch (TyObj_from ty_obj)), \<open>_\<close>] - | _ \<Rightarrow> dot_name) - , dot_at_when]" - -fun print_access_dot_aux where - "print_access_dot_aux deref_oid x = - (\<lambda> OclTy_collection c ty \<Rightarrow> - Term_app (if is_sequence c then var_select_object_sequence else var_select_object_set) - [print_access_dot_aux deref_oid ty] - | OclTy_pair ty1 ty2 \<Rightarrow> Term_app var_select_object_pair [print_access_dot_aux deref_oid ty1, print_access_dot_aux deref_oid ty2] - | OclTy_object (OclTyObj (OclTyCore_pre s) _) \<Rightarrow> deref_oid (Some s) [Term_basic [var_reconst_basetype]] - | OclTy_base_void \<Rightarrow> Term_basic [var_reconst_basetype_void] - | _ \<Rightarrow> Term_basic [var_reconst_basetype]) x" - -definition "print_access_dot = start_map'''' O.overloading o (\<lambda>expr design_analysis. - map_class_arg_only_var' - (\<lambda>isub_name name (var_in_when_state, dot_at_when) attr_ty isup_attr dot_attr. - let overloading_name = print_access_dot_name id dot_at_when attr_ty isup_attr in - [ Overloading - overloading_name - (Term_annot (Term_basic [overloading_name]) (Ty_arrow' (Ty_paren (Typ_base (wrap_oclty name))))) - (print_access_dot_name isub_name dot_at_when attr_ty isup_attr) - (let var_x = \<open>x\<close> in - Term_rewrite - (dot_attr (Term_annot_ocl (Term_basic [var_x]) name)) - \<open>\<equiv>\<close> - (Term_app var_eval_extract [Term_basic [var_x], - let deref_oid = \<lambda>attr_orig l. Term_app (case attr_orig of None \<Rightarrow> isub_name var_deref_oid - | Some orig_n \<Rightarrow> var_deref_oid @@ String.isub orig_n) (Term_basic [var_in_when_state] # l) in - deref_oid None - [ ( case attr_ty of - OclTy_object (OclTyObj (OclTyCore ty_obj) _) \<Rightarrow> - if design_analysis = Gen_only_design then id else - (\<lambda>l. Term_app (print_access_deref_assocs_name' (TyObjN_ass_switch (TyObj_from ty_obj)) isub_name isup_attr) (Term_basic [var_in_when_state] # [l])) - | _ \<Rightarrow> id) - (Term_app (isup_attr (isub_name var_select)) - [case attr_ty of - OclTy_raw _ \<Rightarrow> Term_basic [var_reconst_basetype] - | OclTy_object (OclTyObj (OclTyCore ty_obj) _) \<Rightarrow> - let ty_obj = TyObj_to ty_obj - ; der_name = deref_oid (Some (TyObjN_role_ty ty_obj)) [Term_basic [var_reconst_basetype]] in - if design_analysis = Gen_only_design then - let obj_mult = TyObjN_role_multip ty_obj - ; (var_select_object_name_any, var_select_object_name) = - if is_sequence obj_mult then - (var_select_object_sequence_any, var_select_object_sequence) - else - (var_select_object_set_any, var_select_object_set) in - Term_app (if single_multip obj_mult then - var_select_object_name_any - else - var_select_object_name) [der_name] - else - der_name - | x \<Rightarrow> print_access_dot_aux deref_oid x ]) ] ])) ]) expr)" - -definition "print_access_dot_lemmas_id_set = - (if activate_simp_optimization then - map_class_arg_only_var' - (\<lambda>isub_name _ (_, dot_at_when) attr_ty isup_attr _. [print_access_dot_name isub_name dot_at_when attr_ty isup_attr]) - else (\<lambda>_. []))" - -definition "print_access_dot_lemmas_id_name = \<open>dot_accessor\<close>" -definition "print_access_dot_lemmas_id = start_map' (\<lambda>expr. - (let name_set = print_access_dot_lemmas_id_set expr in - case name_set of [] \<Rightarrow> [] | _ \<Rightarrow> L.map O.lemmas - [ Lemmas_nosimp print_access_dot_lemmas_id_name (L.map T.thm name_set) ]))" - -definition "print_access_dot_cp_lemmas_set = - (if activate_simp_optimization then [hol_definition var_eval_extract] else [])" - -definition "print_access_dot_cp_lemmas = start_map' (\<lambda>_. - L.map (\<lambda>x. O.lemmas (Lemmas_simp \<open>\<close> [T.thm x])) print_access_dot_cp_lemmas_set)" - -definition "print_access_dot_lemma_cp_name isub_name dot_at_when attr_ty isup_attr = S.flatten [\<open>cp_\<close>, print_access_dot_name isub_name dot_at_when attr_ty isup_attr]" -definition "print_access_dot_lemma_cp = start_map O.lemma o - (let auto = \<lambda>l. M.auto_simp_add2 [T.thms print_access_dot_lemmas_id_name] (L.map hol_definition (\<open>cp\<close> # l)) in - map_class_arg_only_var - (\<lambda>isub_name name (_, dot_at_when) attr_ty isup_attr dot_attr. - [ Lemma - (print_access_dot_lemma_cp_name isub_name dot_at_when attr_ty isup_attr) - [Term_app \<open>cp\<close> [Term_lam \<open>X\<close> (\<lambda>var_x. dot_attr (Term_annot_ocl (Term_basic [var_x]) name)) ]] - [] - (C.by [auto (if print_access_dot_cp_lemmas_set = [] then - [var_eval_extract, S.flatten [isup_attr (isub_name \<open>dot\<close>), dot_at_when]] - else - [])]) ]) - (\<lambda>isub_name name (_, dot_at_when) attr_ty isup_attr dot_attr. - [ Lemma - (print_access_dot_lemma_cp_name isub_name dot_at_when attr_ty isup_attr) - [Term_app \<open>cp\<close> [Term_lam \<open>X\<close> (\<lambda>var_x. dot_attr (Term_annot_ocl (Term_basic [var_x]) name)) ]] - [] - (if print_access_dot_cp_lemmas_set = [] then C.sorry \<comment> \<open>fold \<open>l_hierarchy\<close>, take only subclass, unfold the corresponding definition\<close> - else C.by [auto []]) ]))" - -definition "print_access_dot_lemmas_cp = start_map O.lemmas o (\<lambda>expr. - case map_class_arg_only_var' - (\<lambda>isub_name _ (_, dot_at_when) attr_ty isup_attr _. - [T.thm (print_access_dot_lemma_cp_name isub_name dot_at_when attr_ty isup_attr) ]) - expr - of [] \<Rightarrow> [] - | l \<Rightarrow> [Lemmas_simp \<open>\<close> l])" - -definition "print_access_lemma_strict_name isub_name dot_at_when attr_ty isup_attr name_invalid = S.flatten [print_access_dot_name isub_name dot_at_when attr_ty isup_attr, \<open>_\<close>, name_invalid]" -definition "print_access_lemma_strict expr = (start_map O.lemma o - map_class_arg_only_var' (\<lambda>isub_name name (_, dot_at_when) attr_ty isup_attr dot_attr. - L.map (\<lambda>(name_invalid, meth_invalid). Lemma - (print_access_lemma_strict_name isub_name dot_at_when attr_ty isup_attr name_invalid) - [Term_rewrite - (dot_attr (Term_annot_ocl (Term_basic [name_invalid]) name)) - \<open>=\<close> - (Term_basic [\<open>invalid\<close>])] - [] - (if print_access_dot_lemmas_id_set expr = [] | print_access_dot_cp_lemmas_set = [] then - C.sorry else - C.by [ M.rule (T.thm \<open>ext\<close>), - M.simp_add2 [T.thms print_access_dot_lemmas_id_name] - (L.map hol_definition - (let l = (let l = (\<open>bot_option\<close> # meth_invalid) in - if print_access_dot_lemmas_id_set expr = [] then - S.flatten [isup_attr (isub_name \<open>dot\<close>), dot_at_when] # l - else l) in - if print_access_dot_cp_lemmas_set = [] - then - \<open>eval_extract\<close> # l - else l))]) ) - [(\<open>invalid\<close>, [\<open>invalid\<close>]), (\<open>null\<close>, [\<open>null_fun\<close>, \<open>null_option\<close>])])) expr" - -definition "print_access_def_mono_name isub_name dot_at_when attr_ty isup_attr = - S.flatten [ \<open>defined_mono_\<close>, print_access_dot_name isub_name dot_at_when attr_ty isup_attr ]" -definition "print_access_def_mono = start_map'''' O.lemma o (\<lambda>expr _. - map_class_arg_only_var' - (\<lambda>isub_name name (_, dot_at_when) attr_ty isup_attr dot_attr. - let var_X = \<open>X\<close> - ; var_tau = \<open>\<tau>\<close> - ; a = \<lambda>f x. Term_app f [x] - ; b = \<lambda>s. Term_basic [s] - ; f0 = \<lambda>e. Term_binop (Term_basic [var_tau]) \<open>\<Turnstile>\<close> e - ; f = \<lambda>e. f0 (Term_app \<open>\<delta>\<close> [e]) in - [ Lemma - (print_access_def_mono_name isub_name dot_at_when attr_ty isup_attr) - (L.map f [ dot_attr (Term_annot_ocl (b var_X) name) - , b var_X ]) - (let f_tac = \<lambda>s. - [ M.case_tac (f0 (Term_warning_parenthesis (Term_rewrite (b var_X) \<open>\<triangleq>\<close> (b s)))) - , M.insert [T.where (T.thm \<open>StrongEq_L_subst2\<close>) - [ (\<open>P\<close>, Term_lam \<open>x\<close> (\<lambda>var_X. a \<open>\<delta>\<close> (dot_attr (b var_X)))) - , (\<open>\<tau>\<close>, b \<open>\<tau>\<close>) - , (\<open>x\<close>, b var_X) - , (\<open>y\<close>, b s)]] - , M.simp_add [ \<open>foundation16'\<close> - , print_access_lemma_strict_name isub_name dot_at_when attr_ty isup_attr s] ] in - [ f_tac \<open>invalid\<close> - , f_tac \<open>null\<close> ]) - (C.by [M.simp_add [\<open>defined_split\<close>]]) ]) expr)" - -definition "print_access_is_repr_name isub_name dot_at_when attr_ty isup_attr = - S.flatten [ \<open>is_repr_\<close>, print_access_dot_name isub_name dot_at_when attr_ty isup_attr ]" -definition "print_access_is_repr = start_map'''' O.lemma o (\<lambda>expr design_analysis. - (let is_design = design_analysis = Gen_only_design - ; App_a = \<lambda>l. C.apply (if is_design then [] else l) - ; App_d = \<lambda>l. C.apply (if is_design then l else []) in - (if is_design then - (* TODO extend the support to object inherited attributes *) - map_class_arg_only_var'' - else - map_class_arg_only_var') - (\<lambda>isub_name name (var_in_when_state, dot_at_when) attr_ty isup_attr dot_attr. - case attr_ty of OclTy_object (OclTyObj (OclTyCore ty_obj) _) \<Rightarrow> - (let ty_mult = TyObjN_role_multip (TyObj_to ty_obj) in - if single_multip ty_mult then - let var_X = \<open>X\<close> - ; var_tau = \<open>\<tau>\<close> - ; var_def_dot = \<open>def_dot\<close> - ; a = \<lambda>f x. Term_app f [x] - ; ap = \<lambda>f x. Term_applys (Term_pat f) [x] - ; ap' = \<lambda>f x. Term_applys (Term_pat f) x - ; b = \<lambda>s. Term_basic [s] - ; f0 = \<lambda>e. Term_binop (Term_basic [var_tau]) \<open>\<Turnstile>\<close> e - ; f = \<lambda>e. f0 (Term_app \<open>\<delta>\<close> [e]) - ; attr_ty' = is_sequence ty_mult - ; name_from = TyObjN_ass_switch (TyObj_from ty_obj) - ; name_to = TyObjN_role_ty (TyObj_to ty_obj) - ; isub_name_to = \<lambda>s. s @@ String.isub name_to in - [ Lemma_assumes - (print_access_is_repr_name isub_name dot_at_when attr_ty isup_attr) - [ (var_def_dot, False, f (dot_attr (Term_annot_ocl (b var_X) name))) ] - (Term_app \<open>is_represented_in_state\<close> [b var_in_when_state, dot_attr (Term_basic [var_X]), b name_to, b var_tau]) -(let \<comment> \<open>existential variables\<close> - v_a0 = \<open>a0\<close> - ; v_a = \<open>a\<close> - ; v_b = \<open>b\<close> - ; v_r = \<open>r\<close> - ; v_typeoid = \<open>typeoid\<close> - ; v_opt = \<open>opt\<close> - ; v_aa = \<open>aa\<close> - ; v_e = \<open>e\<close> - ; v_aaa = \<open>aaa\<close> - - \<comment> \<open>schematic variables\<close> - ; vs_t = \<open>t\<close> - ; vs_sel_any = \<open>sel_any\<close> - - (* *) - ; l_thes = \<lambda>l l_when. Some (l @@@@ [Term_pat \<open>thesis\<close>], l_when) - ; l_thes0 = \<lambda>l l_when. Some (l @@@@ [Term_pat \<open>t\<close>], l_when) - ; hol_d = L.map hol_definition - ; thol_d = L.map (T.thm o hol_definition) - ; App_f = \<lambda>l e. C.fix_let l [] e [] - ; App_d_f = \<lambda>l e. if is_design then App_f l e else C.apply [] - ; App_f' = \<lambda>l. C.fix_let l [] - ; f_ss = \<lambda>v. a \<open>Some\<close> (a \<open>Some\<close> (b v)) - ; insert_that = M.insert [T.thms \<open>that\<close>] in - [ C.apply [M.insert [T.simplified (T.OF (T.thm (print_access_def_mono_name isub_name dot_at_when attr_ty isup_attr)) - (T.thm var_def_dot)) - (T.thm \<open>foundation16\<close>)]] - , C.apply [M.case_tac (a var_X (b var_tau)), M.simp_add [hol_definition \<open>bot_option\<close>]] - (* *) - , App_f' [v_a0] - (l_thes [Term_binop (a var_X (b var_tau)) \<open>=\<close> (a \<open>Some\<close> (b v_a0))] - [Term_binop (a var_X (b var_tau)) \<open>\<noteq>\<close> (b \<open>null\<close>)]) - [C.apply_end [M.simp_all]] - , C.apply [insert_that, M.case_tac (b v_a0), M.simp_add (L.map hol_definition [\<open>null_option\<close>, \<open>bot_option\<close>]), M.clarify] - (* *) - , App_f [v_a] (l_thes [ Term_binop (a var_X (b var_tau)) \<open>=\<close> (f_ss v_a) ] []) - , C.apply [M.case_tac (Term_app \<open>heap\<close> [ a var_in_when_state (b var_tau) - , a \<open>oid_of\<close> (b v_a)]), M.simp_add (hol_d [\<open>invalid\<close>, \<open>bot_option\<close>])] - , C.apply [ M.insert [T.thm \<open>def_dot\<close>] - , M.simp_add_split ( T.thm (print_access_dot_name isub_name dot_at_when attr_ty isup_attr) - # thol_d [ \<open>is_represented_in_state\<close> - , print_access_select_name isup_attr isub_name - , print_access_deref_oid_name isub_name - , var_in_when_state - , \<open>defined\<close>, \<open>OclValid\<close>, \<open>false\<close>, \<open>true\<close>, \<open>invalid\<close>, \<open>bot_fun\<close>]) - [T.thm \<open>if_split_asm\<close>]] - (* *) - , App_f [v_b] (l_thes [ Term_binop (a var_X (b var_tau)) \<open>=\<close> (f_ss v_a) - , Term_rewrite (Term_app \<open>heap\<close> [ a var_in_when_state (b var_tau) - , a \<open>oid_of\<close> (b v_a)]) - \<open>=\<close> - (a \<open>Some\<close> (b v_b)) ] - []) - , C.apply [ M.insert [T.simplified (T.thm \<open>def_dot\<close>) (T.thm \<open>foundation16\<close>)] - , M.auto_simp_add ( print_access_dot_name isub_name dot_at_when attr_ty isup_attr - # hol_d [ \<open>is_represented_in_state\<close> - , print_access_deref_oid_name isub_name - , \<open>bot_option\<close>, \<open>null_option\<close>])] - , C.apply [ M.case_tac (b v_b), M.simp_all_add (hol_d [\<open>invalid\<close>, \<open>bot_option\<close>]) ] - , App_a [ M.simp_add (hol_d [print_access_deref_assocs_name' name_from isub_name isup_attr, var_deref_assocs]) ] - , App_a [ M.case_tac (Term_app (\<open>assocs\<close>) [ a var_in_when_state (b var_tau) - , b (print_access_oid_uniq_name' name_from isub_name (isup_attr \<open>\<close>)) ]) - , M.simp_add (hol_d [\<open>invalid\<close>, \<open>bot_option\<close>]) - , M.simp_add (hol_d [print_access_select_obj_name' isub_name (isup_attr \<open>\<close>)]) ] - (* *) - , C.fix_let - [v_r, v_typeoid] - [ ( Term_pat vs_t - , Term_rewrite (f_ss v_r) \<open>\<in>\<close> (Term_binop - (Term_parenthesis - (Term_binop (b \<open>Some\<close>) \<open>o\<close> (b (print_astype_from_universe_name name_to)))) - \<open>`\<close> - (a \<open>ran\<close> (a \<open>heap\<close> (a var_in_when_state (b var_tau)))))) - , ( Term_pat vs_sel_any - , Term_app (if attr_ty' then var_select_object_sequence_any else var_select_object_set_any) - [ Term_app (print_access_deref_oid_name isub_name_to) [b var_in_when_state, b var_reconst_basetype] ])] - (Some ( [ Term_rewrite (if is_design then - Term_app (print_access_select_name isup_attr isub_name) - [ Term_pat vs_sel_any - , b v_typeoid - , b var_tau ] - else - Term_applys (Term_pat vs_sel_any) - [ b v_typeoid - , b var_tau ]) \<open>=\<close> (f_ss v_r) - , Term_pat vs_t ] - , [])) - [] - , App_d [ M.case_tac (b v_typeoid), M.simp_add (hol_d [print_access_select_name isup_attr isub_name]) ] - (* *) - , App_d_f [v_opt] - (l_thes0 - [ Term_rewrite (Term_applys (Term_case (b v_opt) - [ (b \<open>None\<close>, b \<open>null\<close>) - , let var_x = \<open>x\<close> in - (a \<open>Some\<close> (b var_x), ap vs_sel_any (b var_x)) ]) - [ b var_tau ]) - \<open>=\<close> - (f_ss v_r) ] - []) - , App_d [ M.case_tac (b v_opt), M.auto_simp_add (hol_d [\<open>null_fun\<close>, \<open>null_option\<close>, \<open>bot_option\<close>]) ] - (* *) - , App_f' [v_aa] - (l_thes0 - [Term_rewrite (ap' vs_sel_any [ b v_aa, b var_tau ]) \<open>=\<close> (f_ss v_r)] - [Term_binop (b var_tau) \<open>\<Turnstile>\<close> (a \<open>\<delta>\<close> (ap vs_sel_any (b v_aa)))]) - [ C.apply_end [ M.simp_add (\<open>foundation16\<close> # hol_d [\<open>bot_option\<close>, \<open>null_option\<close>]) ] ] - , C.apply [ insert_that - , M.drule (T.simplified (T.thm (if attr_ty' then - var_select_object_sequence_any_exec - else - var_select_object_set_any_exec)) - (T.thm \<open>foundation22\<close>)), M.erule (T.thm \<open>exE\<close>) ] - (* *) - , App_f' [v_e] - (l_thes0 - [] - [ Term_rewrite (ap' vs_sel_any [ b v_aa, b var_tau ]) \<open>=\<close> (f_ss v_r) - , Term_rewrite (ap' vs_sel_any [ b v_aa, b var_tau ]) - \<open>=\<close> - (Term_app (print_access_deref_oid_name isub_name_to) - (L.map b [ var_in_when_state - , var_reconst_basetype - , v_e - , var_tau ])) ]) - [ C.apply_end [ M.plus [M.blast None] ] ] - , C.apply [ insert_that, M.simp_add (hol_d [print_access_deref_oid_name isub_name_to]) ] - , C.apply [ M.case_tac (Term_app \<open>heap\<close> [ a var_in_when_state (b var_tau), b v_e ]) - , M.simp_add (hol_d [\<open>invalid\<close>, \<open>bot_option\<close>]), M.simp ] - (* *) - , App_f [v_aaa] - (l_thes0 - [ Term_rewrite (Term_case (b v_aaa) - [ let var_obj = \<open>obj\<close> in - (a (isub_name_to datatype_in) (b var_obj), Term_app var_reconst_basetype [b var_obj, b var_tau]) - , (b wildcard, a \<open>invalid\<close> (b var_tau)) ]) - \<open>=\<close> - (f_ss v_r) - , Term_rewrite (Term_app \<open>heap\<close> [ a var_in_when_state (b var_tau), b v_e ]) - \<open>=\<close> - (a \<open>Some\<close> (b v_aaa)) ] - []) - , C.apply [ M.case_tac (b v_aaa), M.auto_simp_add (hol_d [\<open>invalid\<close>, \<open>bot_option\<close>, \<open>image\<close>, \<open>ran\<close>]) ] - , C.apply [ M.rule (T.where (T.thm \<open>exI\<close>) [(\<open>x\<close>, a (isub_name_to datatype_in) (b v_r))]) - , M.simp_add_split (thol_d [print_astype_from_universe_name name_to, \<open>Let\<close>, var_reconst_basetype]) - [T.thm \<open>if_split_asm\<close>] ] ]) - (C.by [ M.rule' ]) ] else [] (* TODO *)) - | _ \<Rightarrow> [] (* TODO *))) expr)" - -definition "print_access_repr_allinst = start_map''''' O.lemma o (\<lambda>expr (sorry, dirty) design_analysis. - if sorry = Some Gen_sorry | sorry = None & dirty then - map_class_arg_only_var' - (\<lambda>isub_name name (var_in_when_state, dot_at_when) attr_ty isup_attr dot_attr. - case attr_ty of OclTy_object (OclTyObj (OclTyCore ty_obj) _) \<Rightarrow> - let var_tau = \<open>\<tau>\<close> - ; f = \<lambda>e. Term_binop (Term_basic [var_tau]) \<open>\<Turnstile>\<close> e - ; a = \<lambda>f x. Term_app f [x] - ; b = \<lambda>s. Term_basic [s] - ; var_x = \<open>x\<close> in - [ Lemma - (S.flatten [ isup_attr (S.flatten [isub_name \<open>dot_repr\<close>, \<open>_\<close>, String.natural_to_digit10 (TyObjN_ass_switch (TyObj_from ty_obj)), \<open>_\<close>]) - , dot_at_when]) - ([ f (a \<open>\<delta>\<close> (dot_attr (Term_annot_ocl (Term_basic [var_x]) name))) - , let all_inst = if var_in_when_state \<triangleq> var_in_pre_state then - \<open>OclAllInstances_at_pre\<close> - else - \<open>OclAllInstances_at_post\<close> in - Term_binop - (let ty_obj = TyObj_to ty_obj - ; name' = TyObjN_role_ty ty_obj - ; obj_mult = TyObjN_role_multip ty_obj in - f (Term_app - (if single_multip obj_mult then - \<open>UML_Set.OclIncludes\<close> - else - \<open>UML_Set.OclIncludesAll\<close>) - [ a all_inst (b name') - , let x = dot_attr (b var_x) in - if is_sequence obj_mult then - a \<open>OclAsSet\<^sub>S\<^sub>e\<^sub>q\<close> x - else - x ])) - \<open>\<and>\<close> - (f (Term_app \<open>UML_Set.OclIncludes\<close> [ a all_inst (b name) - , b var_x ]))]) - [] - C.sorry ] - | _ \<Rightarrow> []) expr - else [])" - -end diff --git a/Citadelle/src/compiler/core/Floor1_allinst.thy b/Citadelle/src/compiler/core/Floor1_allinst.thy deleted file mode 100644 index c3784f1aecebf760acc4ba222b46647212918aca..0000000000000000000000000000000000000000 --- a/Citadelle/src/compiler/core/Floor1_allinst.thy +++ /dev/null @@ -1,230 +0,0 @@ -(****************************************************************************** - * 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. - ******************************************************************************) - -section\<open>Main Translation for: AllInstances\<close> - -theory Floor1_allinst -imports Core_init -begin - -definition "print_allinst_def_id = start_map O.definition o - map_class (\<lambda>isub_name name _ _ _ _. - let const_astype = S.flatten [const_oclastype, String.isub name, \<open>_\<AA>\<close>] in - Definition (Term_rewrite (Term_basic [name]) \<open>=\<close> (Term_basic [const_astype])))" - -definition "print_allinst_lemmas_id = start_map' - (if activate_simp_optimization then - \<lambda>expr. - let name_set = map_class (\<lambda>_ name _ _ _ _. name) expr in - case name_set of [] \<Rightarrow> [] | _ \<Rightarrow> L.map O.lemmas - [ Lemmas_simp \<open>\<close> (L.map (T.thm o hol_definition) name_set) ] - else (\<lambda>_. []))" - -definition "print_allinst_astype_name isub_name = S.flatten [isub_name const_oclastype, \<open>_\<AA>\<close>, \<open>_some\<close>]" -definition "print_allinst_astype = start_map O.lemma o map_class_top (\<lambda>isub_name name _ _ _ _. - let b = \<lambda>s. Term_basic [s] - ; var_x = \<open>x\<close> - ; d = hol_definition in - [Lemma - (print_allinst_astype_name isub_name) - [ Term_rewrite - (Term_app (S.flatten [isub_name const_oclastype, \<open>_\<AA>\<close>]) [b var_x]) - \<open>\<noteq>\<close> - (b \<open>None\<close>)] - [] - (C.by [M.simp_add [d (S.flatten [isub_name const_oclastype, \<open>_\<AA>\<close>])]])])" - -definition "print_allinst_exec = start_map O.lemma o map_class_top (\<lambda>isub_name name _ _ _ _. - let b = \<lambda>s. Term_basic [s] - ; a = \<lambda>f x. Term_app f [x] - ; d = hol_definition - ; f = Term_paren \<open>\<lfloor>\<close> \<open>\<rfloor>\<close> - ; f_img = \<lambda>e1. Term_binop (b e1) \<open>`\<close> - ; ran_heap = \<lambda>var_pre_post var_tau. f_img name (a \<open>ran\<close> (a \<open>heap\<close> (Term_app var_pre_post [b var_tau]))) - ; f_incl = \<lambda>v1 v2. - let var_tau = \<open>\<tau>\<close> in - Term_bind \<open>\<And>\<close> (b var_tau) (Term_binop (Term_applys (Term_pat v1) [b var_tau]) \<open>\<subseteq>\<close> (Term_applys (Term_pat v2) [b var_tau])) - ; var_B = \<open>B\<close> - ; var_C = \<open>C\<close> in - gen_pre_post - (\<lambda>s. S.flatten [isub_name s, \<open>_exec\<close>]) - (\<lambda>f_expr _ var_pre_post. - Term_rewrite - (f_expr [b name]) - \<open>=\<close> - (Term_lam \<open>\<tau>\<close> (\<lambda>var_tau. Term_app var_Abs_Set [f (f (f_img \<open>Some\<close> (ran_heap var_pre_post var_tau))) ]))) - (\<lambda>lem_tit lem_spec var_pre_post _ _. - Lemma_assumes - lem_tit - [] - lem_spec - (let var_S1 = \<open>S1\<close> - ; var_S2 = \<open>S2\<close> in - [ C.let' (Term_pat var_S1) (Term_lam \<open>\<tau>\<close> (ran_heap var_pre_post)) - , C.let' (Term_pat var_S2) (Term_lam \<open>\<tau>\<close> (\<lambda>var_tau. Term_binop (Term_applys (Term_pat var_S1) [b var_tau]) \<open>-\<close> (Term_paren \<open>{\<close> \<open>}\<close> (b \<open>None\<close>)))) - , C.have var_B (f_incl var_S2 var_S1) (C.by [M.auto]) - , C.have var_C (f_incl var_S1 var_S2) (C.by [M.auto_simp_add [print_allinst_astype_name isub_name]]) - , C.apply [M.simp_add_del [d \<open>OclValid\<close>] [d \<open>OclAllInstances_generic\<close>, S.flatten [isub_name const_ocliskindof, \<open>_\<close>, name]]] ]) - (C.by [M.insert [T.OF_l (T.thm \<open>equalityI\<close>) (L.map T.thm [var_B, var_C])], M.simp])) - [])" - -definition "print_allinst_istypeof_pre_name1 = \<open>ex_ssubst\<close>" -definition "print_allinst_istypeof_pre_name2 = \<open>ex_def\<close>" -definition "print_allinst_istypeof_pre = start_map O.lemma o (\<lambda>_. - [ Lemma - print_allinst_istypeof_pre_name1 - (let var_x = \<open>x\<close> - ; var_B = \<open>B\<close> - ; var_s = \<open>s\<close> - ; var_t = \<open>t\<close> - ; var_P = \<open>P\<close> - ; b = \<lambda>s. Term_basic [s] - ; a = \<lambda>f x. Term_app f [x] - ; bind = \<lambda>symb. Term_bind symb (Term_binop (b var_x) \<open>\<in>\<close> (b var_B)) - ; f = \<lambda>v. bind \<open>\<exists>\<close> (a var_P (a v (b var_x))) in - [ Term_bind \<open>\<forall>\<close> (Term_binop (b var_x) \<open>\<in>\<close> (b var_B)) (Term_rewrite (a var_s (b var_x)) \<open>=\<close> (a var_t (b var_x))) - , Term_rewrite (f var_s) \<open>=\<close> (f var_t) ]) - [] - (C.by [M.simp]) - , Lemma - print_allinst_istypeof_pre_name2 - (let var_x = \<open>x\<close> - ; var_X = \<open>X\<close> - ; var_y = \<open>y\<close> - ; b = \<lambda>s. Term_basic [s] - ; c = Term_paren \<open>\<lceil>\<close> \<open>\<rceil>\<close> - ; f = Term_paren \<open>\<lfloor>\<close> \<open>\<rfloor>\<close> - ; p = Term_paren \<open>{\<close> \<open>}\<close> in - [ Term_binop (b var_x) \<open>\<in>\<close> (c (c (f (f (Term_binop (b \<open>Some\<close>) \<open>`\<close> (Term_parenthesis (Term_binop (b var_X) \<open>-\<close> (p (b \<open>None\<close>))))))))) - , Term_bind \<open>\<exists>\<close> (b var_y) (Term_rewrite (b var_x) \<open>=\<close> (f (f (b var_y)))) ]) - [] - (C.by [M.auto_simp_add []]) ])" - -definition "print_allinst_istypeof_single isub_name name isub_name2 name2 const_oclisof dot_isof f_simp1 f_simp2 = - (let b = \<lambda>s. Term_basic [s] - ; d = hol_definition - ; s = M.subst_l [\<open>1\<close>,\<open>2\<close>,\<open>3\<close>] - ; var_tau = \<open>\<tau>\<close> in - gen_pre_post - (\<lambda>s. S.flatten [name, \<open>_\<close>, s, \<open>_\<close>, isub_name2 const_oclisof]) - (\<lambda>f_expr _ _. Term_binop (b var_tau) \<open>\<Turnstile>\<close> (Term_app var_OclForall_set [f_expr [b name], b (isub_name2 const_oclisof) ])) - (\<lambda>lem_tit lem_spec _ _ _. Lemma - lem_tit - [lem_spec] - [ [M.simp_add_del [d \<open>OclValid\<close>] (d \<open>OclAllInstances_generic\<close> # f_simp1 [S.flatten [isub_name2 const_oclisof, \<open>_\<close>, name]])] - , [M.simp_only (L.flatten [L.map T.thm [ d var_OclForall_set, \<open>refl\<close>, \<open>if_True\<close> ], [T.simplified (T.thm \<open>OclAllInstances_generic_defined\<close>) (T.thm (d \<open>OclValid\<close>))]])] - , [M.simp_only [T.thm (d \<open>OclAllInstances_generic\<close>)]] - , [s (T.thm var_Abs_Set_inverse), M.simp_add [d \<open>bot_option\<close>]] - , [s (T.where - (T.thm print_allinst_istypeof_pre_name1) - [ (\<open>s\<close>, Term_lam \<open>x\<close> (\<lambda>var_x. Term_applys (Term_postunary (Term_lambda wildcard (b var_x)) (b (dot_isof name2))) [b var_tau])) - , (\<open>t\<close>, Term_lambda wildcard (Term_app \<open>true\<close> [b var_tau]))])] - , [M.intro [ T.thm \<open>ballI\<close> - , T.simplified_l - (T.thm (if name = name2 then - print_iskindof_up_eq_asty_name name - else - print_iskindof_up_larger_name name name2)) - (L.map T.thm (d \<open>OclValid\<close> # f_simp2 [S.flatten [isub_name const_ocliskindof, \<open>_\<close>, name]]))]] - , [M.drule (T.thm print_allinst_istypeof_pre_name2), M.erule (T.thm (\<open>exE\<close>)), M.simp]] - (C.by [M.simp])) - [])" - -definition "print_allinst_istypeof = start_map'' O.lemma o (\<lambda>expr base_attr _ _. map_class_gen (\<lambda>isub_name name l_attr _ _ next_dataty. - let l_attr = base_attr l_attr in - let b = \<lambda>s. Term_basic [s] - ; d = hol_definition - ; s = M.subst_l [\<open>1\<close>,\<open>2\<close>,\<open>3\<close>] - ; var_tau = \<open>\<tau>\<close> in - case next_dataty of [] \<Rightarrow> - print_allinst_istypeof_single isub_name name isub_name name const_oclistypeof dot_istypeof (\<lambda>_. []) id - | OclClass name_next _ _ # _ \<Rightarrow> - L.flatten - [ gen_pre_post - (\<lambda>s. S.flatten [name, \<open>_\<close>, s, \<open>_\<close>, isub_name const_oclistypeof, \<open>1\<close>]) - (\<lambda>f_expr _ _. - Term_exists - \<open>\<tau>\<close> - (\<lambda>var_tau. Term_binop (b var_tau) \<open>\<Turnstile>\<close> (Term_app var_OclForall_set [f_expr [b name], b (isub_name const_oclistypeof) ]))) - (\<lambda>lem_tit lem_spec var_pre_post _ _. Lemma_assumes - lem_tit - [(\<open>\<close>, True, Term_And \<open>x\<close> (\<lambda>var_x. Term_rewrite (Term_app var_pre_post [Term_parenthesis (Term_binop (b var_x) \<open>,\<close> (b var_x))]) \<open>=\<close> (b var_x)) )] - lem_spec - (L.map C.apply - [ let var_tau0 = var_tau @@ String.isub \<open>0\<close> in - [M.rule (T.where (T.thm \<open>exI\<close>) [(\<open>x\<close>, b var_tau0)]), M.simp_add_del (L.map d [var_tau0, \<open>OclValid\<close>]) [d \<open>OclAllInstances_generic\<close>]] - , [M.simp_only (L.flatten [L.map T.thm [ d var_OclForall_set, \<open>refl\<close>, \<open>if_True\<close> ], [T.simplified (T.thm \<open>OclAllInstances_generic_defined\<close>) (T.thm (d \<open>OclValid\<close>))]])] - , [M.simp_only [T.thm (d \<open>OclAllInstances_generic\<close>)]] - , [s (T.thm var_Abs_Set_inverse), M.simp_add [d \<open>bot_option\<close>]] ] ) - (C.by [M.simp (*M.simp_add [S.flatten [isub_name const_oclistypeof, \<open>_\<close>, name]]*)])) - [M.simp] - , gen_pre_post - (\<lambda>s. S.flatten [name, \<open>_\<close>, s, \<open>_\<close>, isub_name const_oclistypeof, \<open>2\<close>]) - (\<lambda>f_expr _ _. - Term_exists - \<open>\<tau>\<close> - (\<lambda>var_tau. Term_binop (b var_tau) \<open>\<Turnstile>\<close> (Term_app \<open>not\<close> [Term_app var_OclForall_set [f_expr [b name], b (isub_name const_oclistypeof) ]]))) - (\<lambda>lem_tit lem_spec var_pre_post _ _. Lemma_assumes - lem_tit - [(\<open>\<close>, True, Term_And \<open>x\<close> (\<lambda>var_x. Term_rewrite (Term_app var_pre_post [Term_parenthesis (Term_binop (b var_x) \<open>,\<close> (b var_x))]) \<open>=\<close> (b var_x)) )] - lem_spec - (let var_oid = \<open>oid\<close> - ; var_a = \<open>a\<close> - ; var_t0 = \<open>t0\<close> - ; s_empty = \<open>Map.empty\<close> in - [ C.fix [var_oid, var_a] - , C.let' (Term_pat var_t0) (Term_app \<open>state.make\<close> - [ Term_app s_empty [Term_binop (b var_oid) \<open>\<mapsto>\<close> (Term_app (isub_name datatype_in) [Term_app (isub_name datatype_constr_name) (Term_app (datatype_ext_constr_name @@ mk_constr_name name name_next) [b var_a] # L.map (\<lambda>_. b \<open>None\<close>) l_attr)])] - , b s_empty]) - , C.apply [M.rule (T.where (T.thm \<open>exI\<close>) [(\<open>x\<close>, Term_parenthesis (Term_binop (Term_pat var_t0) \<open>,\<close> (Term_pat var_t0)))]), M.simp_add_del [d \<open>OclValid\<close>] [d \<open>OclAllInstances_generic\<close>]] - , C.apply [M.simp_only (L.flatten [L.map T.thm [ d var_OclForall_set, \<open>refl\<close>, \<open>if_True\<close> ], [T.simplified (T.thm \<open>OclAllInstances_generic_defined\<close>) (T.thm (d \<open>OclValid\<close>))]])] - , C.apply [M.simp_only (L.map (\<lambda>x. T.thm (d x)) [\<open>OclAllInstances_generic\<close>, S.flatten [isub_name const_oclastype, \<open>_\<AA>\<close>]])] - , C.apply [s (T.thm var_Abs_Set_inverse), M.simp_add [d \<open>bot_option\<close>]] ] ) - (C.by [M.simp_add [d \<open>state.make\<close>, d \<open>OclNot\<close>]])) - [M.simp]]) expr)" - -definition "print_allinst_iskindof_eq = start_map O.lemma o map_class_gen (\<lambda>isub_name name _ _ _ _. - print_allinst_istypeof_single isub_name name isub_name name const_ocliskindof dot_iskindof id (\<lambda>_. []))" - -definition "print_allinst_iskindof_larger = start_map O.lemma o L.flatten o map_class_nupl2'_inh (\<lambda>name name2. - print_allinst_istypeof_single (\<lambda>s. s @@ String.isub name) name (\<lambda>s. s @@ String.isub name2) name2 const_ocliskindof dot_iskindof id (\<lambda>_. []))" - -end diff --git a/Citadelle/src/compiler/core/Floor1_astype.thy b/Citadelle/src/compiler/core/Floor1_astype.thy deleted file mode 100644 index 12239099d238f527375417e12e4519012118034c..0000000000000000000000000000000000000000 --- a/Citadelle/src/compiler/core/Floor1_astype.thy +++ /dev/null @@ -1,329 +0,0 @@ -(****************************************************************************** - * 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. - ******************************************************************************) - -section\<open>Main Translation for: AsType\<close> - -theory Floor1_astype -imports Core_init -begin - -definition "print_astype_consts = start_map O.consts o - map_class (\<lambda>isub_name name _ _ _ _. - Consts' (isub_name const_oclastype) (Typ_base (wrap_oclty name)) (const_mixfix dot_oclastype name))" - -definition "print_astype_class = start_m' O.overloading - (\<lambda> compare (isub_name, name, nl_attr). \<lambda> OclClass h_name hl_attr _ \<Rightarrow> - Overloading' - (isub_name const_oclastype) - (Ty_arrow' (Ty_paren (Typ_base (wrap_oclty h_name)))) - (S.flatten [isub_name const_oclastype, \<open>_\<close>, h_name]) - (let var_x = \<open>x\<close> in - Term_rewrite - (Term_postunary (Term_annot_ocl (Term_basic [var_x]) h_name) (Term_basic [dot_astype name])) - \<open>\<equiv>\<close> - (case compare - of EQ \<Rightarrow> - Term_basic [var_x] - | x \<Rightarrow> - Term_lam \<open>\<tau>\<close> - (\<lambda>var_tau. let val_invalid = Term_app \<open>invalid\<close> [Term_basic [var_tau]] in - Term_case - (Term_app var_x [Term_basic [var_tau]]) - ( (Term_basic [\<open>\<bottom>\<close>], val_invalid) - # (Term_some (Term_basic [\<open>\<bottom>\<close>]), Term_app \<open>null\<close> [Term_basic [var_tau]]) - # (let pattern_complex = (\<lambda>h_name name l_extra. - let isub_h = (\<lambda> s. s @@ String.isub h_name) - ; isub_name = (\<lambda>s. s @@ String.isub name) - ; isub_n = (\<lambda>s. isub_name (s @@ \<open>_\<close>)) - ; var_name = name in - Term_app (isub_h datatype_constr_name) - ( Term_app (isub_n (isub_h datatype_ext_constr_name)) [Term_basic [var_name]] - # l_extra) ) - ; pattern_simple = (\<lambda> name. - let isub_name = (\<lambda>s. s @@ String.isub name) - ; var_name = name in - Term_basic [var_name]) - ; some_some = (\<lambda>x. Term_some (Term_some x)) in - if x = LT then - [ (some_some (pattern_simple h_name), some_some (pattern_complex name h_name (L.map (\<lambda>_. Term_basic [\<open>None\<close>]) nl_attr))) ] - else - let l = [(Term_basic [wildcard], val_invalid)] in - if x = GT then - (some_some (pattern_complex h_name name (L.map (\<lambda>_. Term_basic [wildcard]) hl_attr)), some_some (pattern_simple name)) - # l - else l) ) ))))" - -definition "print_astype_from_universe = - (let f_finish = (\<lambda> [] \<Rightarrow> ((id, Term_binop (Term_basic [\<open>Some\<close>]) \<open>o\<close>), []) - | _ \<Rightarrow> ((Term_some, id), [(Term_basic [wildcard], Term_basic [\<open>None\<close>])])) in - start_m_gen O.definition - (\<lambda> name l_inh _ l. - let const_astype = print_astype_from_universe_name name in - [ Definition (Term_rewrite (Term_basic [const_astype]) \<open>=\<close> - (case f_finish l_inh of ((_, finish_with_some2), last_case_none) \<Rightarrow> - finish_with_some2 (Term_function (L.flatten [l, last_case_none]))))]) - (\<lambda> l_inh _ _ compare (_, name, nl_attr). \<lambda> OclClass h_name hl_attr _ \<Rightarrow> - if compare = UN' then [] else - let ((finish_with_some1, _), _) = f_finish l_inh - ; isub_h = (\<lambda> s. s @@ String.isub h_name) - ; pattern_complex = (\<lambda>h_name name l_extra. - let isub_h = (\<lambda> s. s @@ String.isub h_name) - ; isub_name = (\<lambda>s. s @@ String.isub name) - ; isub_n = (\<lambda>s. isub_name (s @@ \<open>_\<close>)) - ; var_name = name in - Term_app (isub_h datatype_constr_name) - ( Term_app (isub_n (isub_h datatype_ext_constr_name)) [Term_basic [var_name]] - # l_extra )) - ; pattern_simple = (\<lambda> name. - let isub_name = (\<lambda>s. s @@ String.isub name) - ; var_name = name in - Term_basic [var_name]) - ; case_branch = (\<lambda>pat res. [(Term_app (isub_h datatype_in) [pat], finish_with_some1 res)]) in - case compare - of GT \<Rightarrow> case_branch (pattern_complex h_name name (L.map (\<lambda>_. Term_basic [wildcard]) hl_attr)) (pattern_simple name) - | EQ \<Rightarrow> let n = Term_basic [name] in case_branch n n - | LT \<Rightarrow> case_branch (pattern_simple h_name) (pattern_complex name h_name (L.map (\<lambda>_. Term_basic [\<open>None\<close>]) nl_attr))))" - -definition "print_astype_lemma_cp_set = - (if activate_simp_optimization then - map_class (\<lambda>isub_name name _ _ _ _. ((isub_name, name), name)) - else (\<lambda>_. []))" - -definition "print_astype_lemmas_id = start_map' (\<lambda>expr. - (let name_set = print_astype_lemma_cp_set expr in - case name_set of [] \<Rightarrow> [] | _ \<Rightarrow> L.map O.lemmas - [ Lemmas_simp \<open>\<close> (L.map (\<lambda>((isub_name, _), name). - T.thm (S.flatten [isub_name const_oclastype, \<open>_\<close>, name])) name_set) ]))" - -definition "print_astype_lemma_cp_set2 = - (if activate_simp_optimization then - \<lambda>expr base_attr. - L.flatten (m_class' base_attr (\<lambda> compare (isub_name, name, _). \<lambda> OclClass name2 _ _ \<Rightarrow> - if compare = EQ then - [] - else - [((isub_name, name), ((\<lambda>s. s @@ String.isub name2), name2))]) expr) - else (\<lambda>_ _. []))" - -definition "print_astype_lemmas_id2 = start_map'' id o (\<lambda>expr base_attr _ _. - (let name_set = print_astype_lemma_cp_set2 expr base_attr in - case name_set of [] \<Rightarrow> [] | _ \<Rightarrow> L.map O.lemmas - [ Lemmas_simp \<open>\<close> (L.map (\<lambda>((isub_name_h, _), (_, name)). - T.thm (S.flatten [isub_name_h const_oclastype, \<open>_\<close>, name])) name_set) ]))" - -definition "print_astype_lemma_cp expr = (start_map O.lemma o get_hierarchy_map ( - let check_opt = - let set = print_astype_lemma_cp_set expr in - (\<lambda>n1 n2. list_ex (\<lambda>((_, name1), name2). name1 = n1 & name2 = n2) set) in - (\<lambda>name1 name2 name3. - Lemma - (S.flatten [\<open>cp_\<close>, const_oclastype, String.isub name1, \<open>_\<close>, name3, \<open>_\<close>, name2]) - (let var_p = \<open>p\<close> in - L.map - (\<lambda>x. Term_app \<open>cp\<close> [x]) - [ Term_basic [var_p] - , Term_lam \<open>x\<close> - (\<lambda>var_x. Term_warning_parenthesis (Term_postunary - (Term_annot_ocl (Term_app var_p [Term_annot_ocl (Term_basic [var_x]) name3]) name2) - (Term_basic [dot_astype name1])))]) - [] - (C.by [M.rule (T.thm \<open>cpI1\<close>), if check_opt name1 name2 then M.simp - else M.simp_add [S.flatten [const_oclastype, String.isub name1, \<open>_\<close>, name2]]]) - )) (\<lambda>x. (x, x, x))) expr" - -definition "print_astype_lemmas_cp = start_map' - (if activate_simp_optimization then L.map O.lemmas o - (\<lambda>expr. [Lemmas_simp \<open>\<close> (get_hierarchy_map - (\<lambda>name1 name2 name3. - T.thm (S.flatten [\<open>cp_\<close>, const_oclastype, String.isub name1, \<open>_\<close>, name3, \<open>_\<close>, name2])) - (\<lambda>x. (x, x, x)) expr)]) - else (\<lambda>_. []))" - -definition "print_astype_lemma_strict expr = (start_map O.lemma o - get_hierarchy_map ( - let check_opt = - let set = print_astype_lemma_cp_set expr in - (\<lambda>n1 n2. list_ex (\<lambda>((_, name1), name2). name1 = n1 & name2 = n2) set) in - (\<lambda>name1 name2 name3. - Lemma - (S.flatten [const_oclastype, String.isub name1, \<open>_\<close>, name3, \<open>_\<close>, name2]) - [ Term_rewrite - (Term_warning_parenthesis (Term_postunary - (Term_annot_ocl (Term_basic [name2]) name3) - (Term_basic [dot_astype name1]))) - \<open>=\<close> - (Term_basic [name2])] - [] - (C.by (if check_opt name1 name3 then [M.simp] - else [M.rule (T.thm \<open>ext\<close>) - , M.simp_add (S.flatten [const_oclastype, String.isub name1, \<open>_\<close>, name3] - # hol_definition \<open>bot_option\<close> - # L.map hol_definition (if name2 = \<open>invalid\<close> then [\<open>invalid\<close>] - else [\<open>null_fun\<close>,\<open>null_option\<close>]))])) - )) (\<lambda>x. (x, [\<open>invalid\<close>,\<open>null\<close>], x))) expr" - -definition "print_astype_lemmas_strict = start_map' - (if activate_simp_optimization then L.map O.lemmas o - (\<lambda>expr. [ Lemmas_simp \<open>\<close> (get_hierarchy_map (\<lambda>name1 name2 name3. - T.thm (S.flatten [const_oclastype, String.isub name1, \<open>_\<close>, name3, \<open>_\<close>, name2]) - ) (\<lambda>x. (x, [\<open>invalid\<close>,\<open>null\<close>], x)) expr)]) - else (\<lambda>_. []))" - -definition "print_astype_defined = start_m O.lemma m_class_default - (\<lambda> compare (isub_name, name, _). \<lambda> OclClass h_name _ _ \<Rightarrow> - let var_X = \<open>X\<close> - ; var_isdef = \<open>isdef\<close> - ; f = \<lambda>e. Term_binop (Term_basic [\<open>\<tau>\<close>]) \<open>\<Turnstile>\<close> (Term_app \<open>\<delta>\<close> [e]) in - case compare of LT \<Rightarrow> - [ Lemma_assumes - (S.flatten [isub_name const_oclastype, \<open>_\<close>, h_name, \<open>_defined\<close>]) - [(var_isdef, False, f (Term_basic [var_X]))] - (f (Term_postunary (Term_annot_ocl (Term_basic [var_X]) h_name) (Term_basic [dot_astype name]))) - [C.using [T.thm var_isdef]] - (C.by [M.auto_simp_add (S.flatten [isub_name const_oclastype, \<open>_\<close>, h_name] - # \<open>foundation16\<close> - # L.map hol_definition [\<open>null_option\<close>, \<open>bot_option\<close> ])]) ] - | _ \<Rightarrow> [])" - -definition "print_astype_up_d_cast0_name name_any name_pers = S.flatten [\<open>up\<close>, String.isub name_any, \<open>_down\<close>, String.isub name_pers, \<open>_cast0\<close>]" -definition "print_astype_up_d_cast0 = start_map O.lemma o - map_class_nupl2'_inh (\<lambda>name_pers name_any. - let var_X = \<open>X\<close> - ; var_isdef = \<open>isdef\<close> - ; f = Term_binop (Term_basic [\<open>\<tau>\<close>]) \<open>\<Turnstile>\<close> in - Lemma_assumes - (print_astype_up_d_cast0_name name_any name_pers) - [(var_isdef, False, f (Term_app \<open>\<delta>\<close> [Term_basic [var_X]]))] - (f (Term_binop - (let asty = \<lambda>x ty. Term_warning_parenthesis (Term_postunary x (Term_basic [dot_astype ty])) in - asty (asty (Term_annot_ocl (Term_basic [var_X]) name_pers) name_any) name_pers) - \<open>\<triangleq>\<close> (Term_basic [var_X]))) - [C.using [T.thm var_isdef]] - (C.by [M.auto_simp_add_split - (L.map T.thm - ( S.flatten [const_oclastype, String.isub name_any, \<open>_\<close>, name_pers] - # S.flatten [const_oclastype, String.isub name_pers, \<open>_\<close>, name_any] - # \<open>foundation22\<close> - # \<open>foundation16\<close> - # L.map hol_definition [\<open>null_option\<close>, \<open>bot_option\<close> ])) - (split_ty name_pers) ]))" - -definition "print_astype_up_d_cast_name name_any name_pers = S.flatten [\<open>up\<close>, String.isub name_any, \<open>_down\<close>, String.isub name_pers, \<open>_cast\<close>]" -definition "print_astype_up_d_cast = start_map O.lemma o - map_class_nupl2'_inh (\<lambda>name_pers name_any. - let var_X = \<open>X\<close> - ; var_tau = \<open>\<tau>\<close> in - Lemma_assumes - (S.flatten [\<open>up\<close>, String.isub name_any, \<open>_down\<close>, String.isub name_pers, \<open>_cast\<close>]) - [] - (Term_binop - (let asty = \<lambda>x ty. Term_warning_parenthesis (Term_postunary x (Term_basic [dot_astype ty])) in - asty (asty (Term_annot_ocl (Term_basic [var_X]) name_pers) name_any) name_pers) - \<open>=\<close> (Term_basic [var_X])) - (L.map C.apply - [[M.rule (T.thm \<open>ext\<close>), M.rename_tac [var_tau]] - ,[M.rule (T.THEN (T.thm \<open>foundation22\<close>) (T.thm \<open>iffD1\<close>))] - ,[M.case_tac (Term_binop (Term_basic [var_tau]) \<open>\<Turnstile>\<close> - (Term_app \<open>\<delta>\<close> [Term_basic [var_X]])), M.simp_add [print_astype_up_d_cast0_name name_any name_pers]] - ,[M.simp_add [\<open>defined_split\<close>], M.elim (T.thm \<open>disjE\<close>)] - ,[M.plus [M.erule (T.thm \<open>StrongEq_L_subst2_rev\<close>), M.simp, M.simp]]]) - C.done)" - -definition "print_astype_d_up_cast = start_map O.lemma o - map_class_nupl2'_inh (\<lambda>name_pers name_any. - let var_X = \<open>X\<close> - ; var_Y = \<open>Y\<close> - ; a = \<lambda>f x. Term_app f [x] - ; b = \<lambda>s. Term_basic [s] - ; var_tau = \<open>\<tau>\<close> - ; f_tau = \<lambda>s. Term_warning_parenthesis (Term_binop (b var_tau) \<open>\<Turnstile>\<close> (Term_warning_parenthesis s)) - ; var_def_X = \<open>def_X\<close> - ; asty = \<lambda>x ty. Term_warning_parenthesis (Term_postunary x (Term_basic [dot_astype ty])) - ; not_val = a \<open>not\<close> (a \<open>\<upsilon>\<close> (b var_X)) in - Lemma_assumes - (S.flatten [\<open>down\<close>, String.isub name_pers, \<open>_up\<close>, String.isub name_any, \<open>_cast\<close>]) - [(var_def_X, False, Term_binop - (Term_basic [var_X]) - \<open>=\<close> - (asty (Term_annot_ocl (Term_basic [var_Y]) name_pers) name_any))] - (f_tau (Term_binop not_val \<open>or\<close> - (Term_binop - (asty (asty (Term_basic [var_X]) name_pers) name_any) - \<open>\<doteq>\<close> - (b var_X)))) - (L.map C.apply - [[M.case_tac (f_tau not_val), M.rule (T.thm \<open>foundation25\<close>), M.simp]]) - (C.by [ M.rule (T.thm \<open>foundation25'\<close>) - , M.simp_add [ var_def_X - , print_astype_up_d_cast_name name_any name_pers - , \<open>StrictRefEq\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_sym\<close>]]) )" - -definition "print_astype_lemma_const expr = (start_map O.lemma o - get_hierarchy_map - (let a = \<lambda>f x. Term_app f [x] - ; b = \<lambda>s. Term_basic [s] - ; d = hol_definition - ; check_opt = - let set = print_astype_lemma_cp_set expr in - (\<lambda>n1 n2. list_ex (\<lambda>((_, name1), name2). name1 = n1 & name2 = n2) set) - ; var_X = \<open>X\<close> in - (\<lambda>name1 name2 name3. - let n = S.flatten [const_oclastype, String.isub name1, \<open>_\<close>, name3] in - Lemma - (S.flatten [n, \<open>_\<close>, name2]) - (L.map (a \<open>const\<close>) - [ Term_annot' (b var_X) (wrap_oclty name3) - , Term_postunary - (b var_X) - (Term_basic [dot_astype name1]) ]) - [] - (C.by [ M.simp_add [d \<open>const\<close>] - , M.option [M.metis0 [\<open>no_types\<close>] (L.map T.thm (n # \<open>prod.collapse\<close> # L.map d [\<open>bot_option\<close>, \<open>invalid\<close>, \<open>null_fun\<close>, \<open>null_option\<close>]))]]))) - (\<lambda>x. (x, [\<open>const\<close>], x))) expr" - -definition "print_astype_lemmas_const = start_map' - (if activate_simp_optimization then L.map O.lemmas o - (\<lambda>expr. [ Lemmas_simp \<open>\<close> (get_hierarchy_map (\<lambda>name1 name2 name3. - T.thm (S.flatten [const_oclastype, String.isub name1, \<open>_\<close>, name3, \<open>_\<close>, name2]) - ) (\<lambda>x. (x, [\<open>const\<close>], x)) expr)]) - else (\<lambda>_. []))" - -end diff --git a/Citadelle/src/compiler/core/Floor1_ctxt.thy b/Citadelle/src/compiler/core/Floor1_ctxt.thy deleted file mode 100644 index 4be36e358f33ed18874cc86f44f04c54520b4c1e..0000000000000000000000000000000000000000 --- a/Citadelle/src/compiler/core/Floor1_ctxt.thy +++ /dev/null @@ -1,99 +0,0 @@ -(****************************************************************************** - * 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. - ******************************************************************************) - -section\<open>Main Translation for: Context (Floor 1)\<close> - -theory Floor1_ctxt -imports Core_init -begin - -definition "print_ctxt_const ctxt env = - (let Ty_par = Typ_apply_paren \<open>(\<close> \<open>)\<close> (* because of potential ambiguities *) - ; l_enum = List.map_filter (\<lambda> META_enum e \<Rightarrow> Some e | _ \<Rightarrow> None) (D_input_meta env) - ; l_syn = List.map_filter (\<lambda> META_class_synonym c \<Rightarrow> Some c | _ \<Rightarrow> None) (D_input_meta env) in - map_prod (map_prod id (rev o L.map O.type_synonym)) (rev o L.map O.consts) - (List.fold - (\<lambda> Ctxt_inv _ \<Rightarrow> id - | Ctxt_pp ctxt \<Rightarrow> - let attr_n = Ctxt_fun_name ctxt in - List.fold - (\<lambda>(var_at_when_hol, var_at_when_ocl, f_update_ocl) ((env, l_isab_ty), l_isab_const). - let name = print_ctxt_const_name attr_n var_at_when_hol None - ; (l_name, l) = - List.fold - (\<lambda> ty (l_name, l, l_isab_ty). - let ty = map_enum_syn l_enum l_syn ty - ; (n, isab_ty) = print_infra_type_synonym_class_rec_aux ty in - ( Ty_par (print_access_dot_consts_ty ty) # l_name - , if is_higher_order ty & \<not> String.member l n then - (String.to_String\<^sub>b\<^sub>a\<^sub>s\<^sub>e n # l, Type_synonym' n isab_ty # l_isab_ty) - else - (l, l_isab_ty))) - (L.flatten - [ L.map snd (Ctxt_fun_ty_arg ctxt) - , [ case Ctxt_fun_ty_out ctxt of None \<Rightarrow> OclTy_base_void | Some s \<Rightarrow> s ] ]) - ([], D_ocl_HO_type env, l_isab_ty) in - ( map_prod - (let env = env \<lparr> D_ocl_accessor := f_update_ocl (\<lambda> l. String.to_String\<^sub>b\<^sub>a\<^sub>s\<^sub>e name # l) (D_ocl_accessor env) \<rparr> in - (\<lambda> D_ocl_HO_type. env \<lparr> D_ocl_HO_type := D_ocl_HO_type \<rparr>)) - id - l - , Consts_raw0 - name - (ty_arrow (Typ_apply (Typ_base \<open>val\<close>) [Typ_base \<open>\<AA>\<close>, Typ_base \<open>'\<alpha>\<close>] # rev l_name)) - (mk_dot attr_n var_at_when_ocl) - (Some (natural_of_nat (length (Ctxt_fun_ty_arg ctxt)))) # l_isab_const)) - [ (var_at_when_hol_post, var_at_when_ocl_post, update_D_ocl_accessor_post) - , (var_at_when_hol_pre, var_at_when_ocl_pre, update_D_ocl_accessor_pre)]) - (Ctxt_clause ctxt) - ((env, []), [])))" - -definition "print_ctxt = (\<lambda>ctxt. (\<lambda>f x e. let (l, e) = f x e in bootstrap_floor l e) - (\<lambda>l env. - let ((env, l_isab_ty), l_isab) = print_ctxt_const ctxt env in - (L.flatten [l_isab_ty, l_isab, l], env)) - [ META_all_meta_embedding (META_ctxt Floor2 - (map_invariant (\<lambda>T_inv b (OclProp_ctxt n p) \<Rightarrow> - T_inv b (OclProp_ctxt n (T_lambdas (Ctxt_param ctxt @@@@ [var_self]) p))) - (map_pre_post (\<lambda>pref ctxt. T_lambdas (make_ctxt_free_var pref ctxt)) - ctxt))) ])" - -end diff --git a/Citadelle/src/compiler/core/Floor1_enum.thy b/Citadelle/src/compiler/core/Floor1_enum.thy deleted file mode 100644 index 11c82c7a89448e41ba9659465959c7faf67753c6..0000000000000000000000000000000000000000 --- a/Citadelle/src/compiler/core/Floor1_enum.thy +++ /dev/null @@ -1,83 +0,0 @@ -(****************************************************************************** - * 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. - ******************************************************************************) - -section\<open>Main Translation for: Enumeration\<close> - -theory Floor1_enum -imports Core_init -begin - -definition "print_enum = (\<lambda> OclEnum name_ty l \<Rightarrow> Pair - (let a = \<lambda>f x. Term_app f [x] - ; b = \<lambda>s. Term_basic [s] - ; option = Typ_apply_paren \<open>\<langle>\<close> \<open>\<rangle>\<^sub>\<bottom>\<close> - ; name_ty_base = name_ty @@ String.isub \<open>base\<close> - ; name_ty_base' = pref_generic_enum name_ty - ; uu = \<open>'\<AA>\<close> in - L.flatten - [ [ O.datatype (Datatype' (pref_ty_enum name_ty) (L.map (\<lambda>constr. (pref_constr_enum constr, [])) l)) - , O.type_synonym (Type_synonym' name_ty_base (option (option (Typ_base (pref_ty_enum name_ty))))) - , O.type_synonym (Type_synonym'' name_ty_base' [uu] (\<lambda> [u] \<Rightarrow> Typ_apply (Typ_base \<open>val\<close>) [Typ_base u, Typ_base name_ty_base])) - , O.overloading - (Overloading' - (\<open>StrictRefEq\<close>) - (Ty_arrow' (Typ_apply (Typ_base name_ty_base') [Typ_base uu])) - (\<open>StrictRefEq\<close> @@ String.isub name_ty) - (let var_x = \<open>x\<close> - ; var_y = \<open>y\<close> in - Term_rewrite - (Term_rewrite (Term_annot (b var_x) (Typ_apply (Typ_base name_ty_base') [Typ_base uu])) \<open>\<doteq>\<close> (b var_y)) - \<open>\<equiv>\<close> - (Term_lam \<open>\<tau>\<close> - (\<lambda>var_tau. - Term_if_then_else - (let f = \<lambda>v. Term_rewrite (Term_applys (a \<open>\<upsilon>\<close> (b v)) [b var_tau]) \<open>=\<close> (a \<open>true\<close> (b var_tau)) in - Term_binop (f var_x) \<open>\<and>\<close> (f var_y)) - (Term_applys (Term_rewrite (b var_x) \<open>\<triangleq>\<close> (b var_y)) [b var_tau]) - (a \<open>invalid\<close> (b var_tau)))))) ] - , L.map - (\<lambda>constr. - O.definition - (Definition (Term_rewrite (b constr) - \<open>=\<close> - (Term_lam \<open>_\<close> (\<lambda>_. Term_some (Term_some (Term_annot' (b (pref_constr_enum constr)) (pref_ty_enum name_ty)))))))) l ]))" - -end diff --git a/Citadelle/src/compiler/core/Floor1_examp.thy b/Citadelle/src/compiler/core/Floor1_examp.thy deleted file mode 100644 index 7c0790118c5fc0dac2233eef1250094e5beec8f4..0000000000000000000000000000000000000000 --- a/Citadelle/src/compiler/core/Floor1_examp.thy +++ /dev/null @@ -1,904 +0,0 @@ -(****************************************************************************** - * 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. - ******************************************************************************) - -section\<open>Main Translation for: Example (Floor 1)\<close> - -theory Floor1_examp -imports Core_init -begin - -definition "print_examp_oclbase_gen = - (\<lambda> OclDefInteger nb \<Rightarrow> - let name = var_OclInteger @@ nb - ; b = \<lambda>s. Term_basic [s] - ; ab_name = b nb in - (ab_name, Definition_where2 - name - (b (String.to_bold_number nb)) - (Term_rewrite (b name) \<open>=\<close> (Term_lambda wildcard (Term_some (Term_some ab_name))))) - | OclDefReal (nb0, nb1) \<Rightarrow> - let name = S.flatten [ var_OclReal, nb0, \<open>_\<close>, nb1 ] - ; b = \<lambda>s. Term_basic [s] - ; ab_name = b (S.flatten [nb0(*(* WARNING - uncomment this as soon as OCL_basic_type_Real.thy - is not implemented as 'nat' *), \<open>.\<close>, nb1*)]) in - (ab_name, Definition_where2 - name - (b (S.flatten [String.to_bold_number nb0, \<open>.\<close>, String.to_bold_number nb1])) - (Term_rewrite (b name) \<open>=\<close> (Term_lambda wildcard (Term_some (Term_some ab_name))))) - | OclDefString nb \<Rightarrow> - let name = var_OclString @@ String.base255 nb - ; b = \<lambda>s. Term_basic [s] in - if \<not> String.is_empty nb & String.all is_letter nb then - let ab_name = b (S.flatten [\<open>''\<close>, nb, \<open>''\<close>]) in - (ab_name, - Definition_where2 name (b (text2_of_str nb)) - (Term_rewrite (b name) \<open>=\<close> (Term_lambda wildcard (Term_some (Term_some ab_name))))) - else - let ab_name = b (text_of_str nb) in - (ab_name, - Definition - (Term_rewrite (b name) \<open>=\<close> (Term_lambda wildcard (Term_some (Term_some ab_name))))))" - -definition "print_examp_oclbase = (\<lambda> OclDefBase l \<Rightarrow> (start_map O.definition o L.map (snd o print_examp_oclbase_gen)) l)" - -datatype print_examp_instance_draw_list_attr = Return_obj ocl_ty_class - | Return_exp semi__term -datatype print_examp_instance_draw_list_attr_err = Return_err_ty "ocl_ty \<times> ocl_data_shallow" - | Return_err_ty_auto (* automated type reconstruction failed *) - | Return_ocl_null - | Return_ocl_invalid - | Return_object_variable string - | Return_err_l "print_examp_instance_draw_list_attr_err list" -datatype 'a print_examp_instance_draw_list_attr' = Return_val 'a - | Return_err print_examp_instance_draw_list_attr_err - -definition "bind\<^sub>e\<^sub>r\<^sub>r v f = (case v of Return_val x \<Rightarrow> f x - | Return_err x \<Rightarrow> Return_err x)" - -definition "map\<^sub>e\<^sub>r\<^sub>r f v = bind\<^sub>e\<^sub>r\<^sub>r v (Return_val o f)" - -fun fold\<^sub>e\<^sub>r\<^sub>r where - "fold\<^sub>e\<^sub>r\<^sub>r f e accu = (\<lambda> Return_err_ty _ \<Rightarrow> f e accu - | Return_err_ty_auto \<Rightarrow> f e accu - | Return_ocl_invalid \<Rightarrow> f e accu - | Return_err_l l \<Rightarrow> List.fold (fold\<^sub>e\<^sub>r\<^sub>r f) l accu - | _ \<Rightarrow> accu) e" - -fun has_err_ty where - "has_err_ty e = (\<lambda> Return_err_ty _ \<Rightarrow> True - | Return_err_ty_auto \<Rightarrow> True - | Return_err_l l \<Rightarrow> list_ex has_err_ty l - | _ \<Rightarrow> False) e" - -fun has_invalid where - "has_invalid e = (\<lambda> Return_ocl_invalid \<Rightarrow> True - | Return_err_l l \<Rightarrow> list_ex has_invalid l - | _ \<Rightarrow> False) e" - -definition "list_bind\<^sub>e\<^sub>r\<^sub>r f0 f l = - (case List.partition (\<lambda> Return_err _ \<Rightarrow> True | _ \<Rightarrow> False) (L.map f0 l) of - ([], l) \<Rightarrow> Return_val (f (L.map (\<lambda> Return_val e \<Rightarrow> e) l)) - | (l, _) \<Rightarrow> Return_err (Return_err_l (L.map (\<lambda> Return_err e \<Rightarrow> e) l)))" - -definition "filter_ocl_exn s v = - (if s \<triangleq> \<open>null\<close> then - Return_err Return_ocl_null - else if s \<triangleq> \<open>invalid\<close> then - Return_err Return_ocl_invalid - else - v)" - -definition "print_examp_instance_draw_list_attr_aux_base = - (\<lambda> (_, ShallB_term t) \<Rightarrow> - Return_val (fst (print_examp_oclbase_gen t)) (* some typing errors are not returned here but some could be raised later, since further checks will occur when evaluating meta embedded commands *) - | (ty, ShallB_str s) \<Rightarrow> filter_ocl_exn s (Return_err (Return_err_ty (ty, ShallB_str s))) - | e \<Rightarrow> Return_err (Return_err_ty e))" - -fun print_examp_instance_draw_list_attr_aux where - "print_examp_instance_draw_list_attr_aux f_oid_rec e = - (\<lambda> - (* object case 2 *) - (OclTy_collection _ ty, ShallB_list l) \<Rightarrow> - list_bind\<^sub>e\<^sub>r\<^sub>r (\<lambda>e. print_examp_instance_draw_list_attr_aux f_oid_rec (ty, e)) Term_list l - | (OclTy_pair ty1 ty2, ShallB_list [e1, e2]) \<Rightarrow> - list_bind\<^sub>e\<^sub>r\<^sub>r id - (\<lambda> [e1, e2] \<Rightarrow> Term_pair e1 e2) - [ print_examp_instance_draw_list_attr_aux f_oid_rec (ty1, e1) - , print_examp_instance_draw_list_attr_aux f_oid_rec (ty2, e2) ] - | (OclTy_object (OclTyObj (OclTyCore_pre _) _), shall) \<Rightarrow> f_oid_rec e - (* base cases *) - | (OclTy_base_integer, _) \<Rightarrow> print_examp_instance_draw_list_attr_aux_base e - | (OclTy_base_real, _) \<Rightarrow> print_examp_instance_draw_list_attr_aux_base e - | (OclTy_base_string, _) \<Rightarrow> print_examp_instance_draw_list_attr_aux_base e - | (OclTy_class_syn _, _) \<Rightarrow> print_examp_instance_draw_list_attr_aux_base e - (* enum case *) - | (OclTy_enum _, ShallB_str s) \<Rightarrow> filter_ocl_exn s (Return_val (Term_basic [pref_constr_enum s])) - (* type error *) - | e \<Rightarrow> Return_err (Return_err_ty e)) e" - -definition "print_examp_instance_draw_list_attr = (\<lambda>(f_oid, f_oid_rec). - let a = \<lambda>f x. Term_app f [x] - ; b = \<lambda>s. Term_basic [s] - ; filter_ty_err = \<lambda>pre_post f. - \<lambda> Return_val v \<Rightarrow> Return_val (f v) - | Return_err err \<Rightarrow> if has_err_ty err | has_invalid err then - Return_err err - else - case (pre_post, err) of (Some (pre, post), Return_object_variable s) \<Rightarrow> - Return_val (a \<open>Some\<close> (a \<open>oid_of\<close> (Term_app s [Term_pair (b pre) (b post)]))) - | _ \<Rightarrow> Return_val (b \<open>None\<close>) in - list_bind\<^sub>e\<^sub>r\<^sub>r - (\<lambda> obj. - bind\<^sub>e\<^sub>r\<^sub>r - ( case obj of - (t_obj, None) \<Rightarrow> Return_val (case t_obj of Some ty_obj \<Rightarrow> Return_obj ty_obj - | _ \<Rightarrow> Return_exp (b \<open>None\<close>)) - (* object case 1 *) - | (_, Some (OclTy_object (OclTyObj (OclTyCore ty_obj) _), _)) \<Rightarrow> Return_val (Return_obj ty_obj) - (* *) - | (_, Some (ty, pre_post, shallow)) \<Rightarrow> - map\<^sub>e\<^sub>r\<^sub>r Return_exp (filter_ty_err pre_post Term_some (print_examp_instance_draw_list_attr_aux f_oid_rec (ty, shallow)))) - (\<lambda> Return_obj ty_obj \<Rightarrow> filter_ty_err None id (f_oid ty_obj) - | Return_exp exp \<Rightarrow> Return_val exp)) - id)" - -definition "print_examp_instance_app_constr_notmp f_oid = (\<lambda>isub_name app_x l_attr. - map\<^sub>e\<^sub>r\<^sub>r - (\<lambda>l. Term_app (isub_name datatype_constr_name) (app_x # l)) - (print_examp_instance_draw_list_attr f_oid l_attr))" - -definition "rbt_of_class env = - (let rbt = (snd o fold_class_gen (\<lambda>_ name l_attr l_inh _ _ rbt. - ( [()] - , modify_def (RBT.empty, []) name - (let f_fold = \<lambda>tag l rbt. - let (rbt, _, n) = List.fold - (\<lambda> (name_attr, ty) \<Rightarrow> \<lambda>(rbt, cpt, l_obj). - (insert name_attr (ty, tag, OptIdent cpt) rbt, Succ cpt, (case ty of OclTy_object (OclTyObj (OclTyCore ty_obj) _) \<Rightarrow> Some ty_obj | _ \<Rightarrow> None) # l_obj)) - l - (rbt, 0, []) in - (rbt, (tag, n)) in - (\<lambda>(rbt, _). - let (rbt, info_own) = f_fold OptOwn l_attr rbt in - let (rbt, info_inh) = f_fold OptInh (L.flatten (map_class_inh l_inh)) rbt in - (rbt, [info_own, info_inh]))) - rbt)) RBT.empty) (case D_input_class env of Some c \<Rightarrow> c) in - (\<lambda>name. - let rbt = lookup rbt name in - ( rbt = None - , \<lambda> name_attr. - Option.bind rbt (\<lambda>(rbt, _). lookup rbt name_attr) - , \<lambda> v. Option.bind rbt (\<lambda>(_, l). - map_option (\<lambda>l f accu. - let (_, accu) = - List.fold - (let f_fold = \<lambda>b (n, accu). (Succ n, f b n accu) in - if D_ocl_semantics env = Gen_only_design then - f_fold - else - \<lambda> Some _ \<Rightarrow> (\<lambda>(n, accu). (Succ n, accu)) - | None \<Rightarrow> f_fold None) (rev l) (0, accu) in - accu) (L.assoc v l)))))" - -definition "fill_blank f_blank = - L.map (\<lambda> (attr_ty, l). - case f_blank attr_ty of Some f_fold \<Rightarrow> - let rbt = List.fold (\<lambda> ((ty, _, ident), shallow) \<Rightarrow> RBT.insert ident (ty, shallow)) l RBT.empty in - (attr_ty, rev (f_fold (\<lambda>b n l. (b, RBT.lookup rbt (OptIdent n)) # l) [])))" - -fun split_inh_own where - "split_inh_own f_class s_cast l_attr = - (let (f_attr, f_blank) = f_class s_cast - ; split = \<lambda>l. List.partition (\<lambda>((_, OptOwn, _), _) \<Rightarrow> True | _ \<Rightarrow> False) - (List.map_filter (\<lambda>(pre_post, name_attr, data). map_option (\<lambda>x. (x, (pre_post, data))) (f_attr name_attr)) l) in - case l_attr of - OclAttrNoCast l \<Rightarrow> - let (l_own, l_inh) = split l in - OclAttrNoCast (fill_blank f_blank [(OptOwn, l_own), (OptInh, l_inh)]) - | OclAttrCast s_cast l_attr l \<Rightarrow> - case split l of (l_own, []) \<Rightarrow> - OclAttrCast s_cast (split_inh_own f_class s_cast l_attr) (fill_blank f_blank [(OptOwn, l_own)]))" - -fun print_examp_instance_app_constr2_notmp where - "print_examp_instance_app_constr2_notmp l_attr isub_name cpt f_oid = - (case l_attr of - OclAttrNoCast [(OptOwn, l_own), (OptInh, l_inh)] \<Rightarrow> - bind\<^sub>e\<^sub>r\<^sub>r - (map\<^sub>e\<^sub>r\<^sub>r - (let var_oid = Term_oid var_oid_uniq (oidGetInh cpt) in - (\<lambda>l. (Term_app (isub_name datatype_ext_constr_name) (var_oid # l), l_own))) - (print_examp_instance_draw_list_attr (f_oid isub_name cpt) l_inh)) - (\<lambda>(l_inh, l_own). - print_examp_instance_app_constr_notmp (f_oid isub_name cpt) isub_name l_inh l_own) - | OclAttrCast x l_attr _ \<Rightarrow> - print_examp_instance_app_constr2_notmp l_attr (\<lambda>s. s @@ String.isub x) cpt f_oid)" - -fun print_examp_instance_app_constr2_notmp' where - "print_examp_instance_app_constr2_notmp' l_attr e = - (case l_attr of - OclAttrNoCast _ \<Rightarrow> e (* NOTE: to be enclosed in a potentially not mandatory parenthesis *) - | OclAttrCast ty (OclAttrNoCast _) _ \<Rightarrow> Term_annot' e (wrap_oclty ty) (* NOTE: to be enclosed in a mandatory parenthesis *) - | OclAttrCast ty l_attr _ \<Rightarrow> - Term_postunary (Term_parenthesis (print_examp_instance_app_constr2_notmp' l_attr e)) (Term_basic [dot_astype ty]))" - -definition "inst_name ocli = (case Inst_name ocli of Some n \<Rightarrow> n)" - -definition "init_map_class env l = - (let (rbt_nat, rbt_str, _, _) = - List.fold - (\<lambda> ocli (rbt_nat, rbt_str, oid_start, accu). - let f = \<lambda>_. - ( RBT.insert (Oid accu) oid_start rbt_nat - , insert (inst_name ocli) oid_start rbt_str - , oidSucInh oid_start - , Succ accu) in - case Inst_attr_with ocli of - None \<Rightarrow> f () - | Some s \<Rightarrow> - (case lookup rbt_str s of None \<Rightarrow> f () - | Some oid_start' \<Rightarrow> - ( RBT.insert (Oid accu) oid_start' rbt_nat - , insert (inst_name ocli) oid_start' rbt_str - , oid_start - , Succ accu))) - l - ( RBT.empty - , RBT.bulkload (L.map (\<lambda>(k, _, v). (String\<^sub>b\<^sub>a\<^sub>s\<^sub>e.to_list k, v)) (D_input_instance env)) - , D_ocl_oid_start env - , 0) in - (rbt_of_class env, RBT.lookup rbt_nat, lookup rbt_str))" - -definition "print_examp_def_st_assoc_build_rbt_gen f rbt map_self map_username l_assoc = - List.fold - (\<lambda> (ocli, cpt). fold_instance_single - (\<lambda> ty l_attr. - let (f_attr_ty, _) = rbt ty in - f ty - (List.fold (\<lambda>(_, name_attr, shall). - case f_attr_ty name_attr of - Some (OclTy_object (OclTyObj (OclTyCore ty_obj) _), _, _) \<Rightarrow> - modify_def ([], ty_obj) name_attr - (\<lambda>(l, accu). case let find_map = \<lambda> ShallB_str s \<Rightarrow> map_username s | ShallB_self s \<Rightarrow> map_self s | _ \<Rightarrow> None in - case shall of - ShallB_list l \<Rightarrow> if list_ex (\<lambda>x. find_map x = None) l then - None - else - Some (List.map_filter find_map l) - | _ \<Rightarrow> map_option (\<lambda>x. [x]) (find_map shall) of - None \<Rightarrow> (l, accu) - | Some oid \<Rightarrow> (L.map (L.map oidGetInh) [[cpt], oid] # l, accu)) - | _ \<Rightarrow> id) l_attr)) ocli) l_assoc RBT.empty" - -fun fold_data_shallow where "fold_data_shallow f_str f_self f x accu = - (\<lambda> ShallB_str s \<Rightarrow> f (f_str s) accu - | ShallB_self s \<Rightarrow> f (f_self s) accu - | ShallB_list l \<Rightarrow> List.fold (fold_data_shallow f_str f_self f) l accu - | _ \<Rightarrow> accu) x" - -definition \<open>print_examp_def_st_assoc_build_rbt_gen_typecheck check_ty f_attr_none f_attr map_self map_username l_enum l accu = - (let v_null = \<open>null\<close> - ; v_invalid = \<open>invalid\<close> in - fst ( - List.fold - (\<lambda> (ocli, cpt) (l, rbt). - let Inst_name_ocli = inst_name ocli - ; l = fold_instance_single - (\<lambda> ty l accu. - let f_attr = f_attr ty in - fst (List.fold - (\<lambda>(pre_post, name_attr, shall) (accu, rbt). - let f = \<lambda>msg. \<lambda> None \<Rightarrow> Some msg | _ \<Rightarrow> None - ; find_map = \<lambda>x. fold_data_shallow - (\<lambda>s. if s \<triangleq> v_null - | s \<triangleq> v_invalid - | list_ex (\<lambda>OclEnum _ l \<Rightarrow> list_ex ((\<triangleq>) s) l) l_enum then None - else f s (map_username s)) - (\<lambda>s. f (\<open>self \<close> @@ String.natural_to_digit10 (case s of Oid n \<Rightarrow> n)) (map_self s)) - (\<lambda> None \<Rightarrow> id | Some x \<Rightarrow> Cons x) - x - [] - ; (accu, rbt) = - case case shall of ShallB_list l \<Rightarrow> L.flatten (L.map find_map l) - | _ \<Rightarrow> find_map shall of - [] \<Rightarrow> (accu, rbt) - | l \<Rightarrow> (* some rhs variables are authorized because some could have been introduced in HOL side (between 2 meta embedded commands) *) - ( if pre_post = None then - (Error, S.flatten [ \<open>Extra variables on rhs: \<close>, String_concatWith \<open>, \<close> (L.map (\<lambda>s. \<open>"\<close> @@ s @@ \<open>"\<close>) l) - , \<open> in the definition of "\<close>, Inst_name_ocli, \<open>"\<close> ]) # accu - else accu - , rbt) - ; (accu, rbt) = - if lookup rbt name_attr = None then - (accu, insert name_attr () rbt) - else - ((Warning, S.flatten [ \<open>At least one unused variable "\<close>, name_attr, \<open>"\<close> - , \<open> in the definition of "\<close>, Inst_name_ocli, \<open>"\<close> ]) # accu, rbt) in - ( if f_attr name_attr = None then - (Error, S.flatten [ \<open>Error in record input: "\<close>, name_attr, \<open>" is no proper field\<close> - , \<open> in the definition of "\<close>, Inst_name_ocli, \<open>"\<close> ]) # accu - else accu - , rbt)) - l - (accu, RBT.empty))) - ocli - (if Inst_name_ocli \<triangleq> v_null - | Inst_name_ocli \<triangleq> v_invalid - | \<not> f_attr_none Inst_name_ocli (* e.g.: this constant should be (already) defined so that oclAllInstances can receive it as argument *) then - (Error, S.flatten [ \<open>Bad head of lhs: existing constant "\<close>, Inst_name_ocli, \<open>"\<close> ]) # l - else - l) - ; (l, rbt) = - ( case check_ty ocli cpt of - Return_err err \<Rightarrow> - fold\<^sub>e\<^sub>r\<^sub>r - (\<lambda> Return_err_ty (ty, obj) \<Rightarrow> Cons (Error, S.flatten [ \<open>Type unification failed: Clash of types "\<close> - , str_of_ty ty - , \<open>" and "\<close> - , str_of_data_shallow obj - , \<open>"\<close> - , \<open> in the definition of "\<close>, Inst_name_ocli, \<open>"\<close> ]) - | Return_ocl_invalid \<Rightarrow> Cons (Writeln, S.flatten [ \<open>"invalid" returned\<close> - , \<open> in the definition of "\<close>, Inst_name_ocli, \<open>"\<close> ]) - | _ \<Rightarrow> id) - err - l - | _ \<Rightarrow> l - , rbt) in - (if lookup rbt Inst_name_ocli = None then - (l, insert Inst_name_ocli () rbt) - else - ((Error, S.flatten [ \<open>Duplicate fixed variable(s): "\<close>, Inst_name_ocli, \<open>"\<close> ]) # l, rbt))) l - (accu, RBT.empty)))\<close> - -definition "print_examp_def_st_assoc_build_rbt = print_examp_def_st_assoc_build_rbt_gen (modify_def RBT.empty)" -definition "print_examp_def_st_assoc_build_rbt2 = print_examp_def_st_assoc_build_rbt_gen (\<lambda>_. id)" - -definition "print_examp_def_st_assoc rbt map_self map_username l_assoc = - (let b = \<lambda>s. Term_basic [s] - ; rbt = print_examp_def_st_assoc_build_rbt rbt map_self map_username l_assoc in - Term_app var_map_of_list [Term_list (fold (\<lambda>name. fold (\<lambda>name_attr (l_attr, ty_obj) l_cons. - let cpt_from = TyObjN_ass_switch (TyObj_from ty_obj) in - Term_pair - (Term_basic [print_access_oid_uniq_name cpt_from (\<lambda>s. s @@ String.isub name) name_attr]) - (Term_app \<open>List.map\<close> - [ Term_binop (let var_x = \<open>x\<close> - ; var_y = \<open>y\<close> in - Term_lambdas0 - (Term_pair (b var_x) (b var_y)) - (Term_list [b var_x, b var_y])) - \<open>o\<close> - (b (print_access_choose_name - (TyObj_ass_arity ty_obj) - cpt_from - (TyObjN_ass_switch (TyObj_to ty_obj)))) - , Term_list' (Term_list' (Term_list' (Term_oid var_oid_uniq))) l_attr ]) - # l_cons)) rbt [])])" - -definition "print_examp_instance_oid thy_definition_hol l env = (L.map thy_definition_hol o L.flatten) - (let (f1, f2) = (\<lambda> var_oid _ _. var_oid, \<lambda> _ _ cpt. Term_oid \<open>\<close> (oidGetInh cpt)) in - L.map (\<lambda> (ocli, cpt). - if List.fold (\<lambda>(_, _, cpt0) b. b | oidGetInh cpt0 = oidGetInh cpt) (D_input_instance env) False then - [] - else - let var_oid = Term_oid var_oid_uniq (oidGetInh cpt) - ; isub_name = \<lambda>s. s @@ String.isub (inst_ty ocli) in - [Definition (Term_rewrite (f1 var_oid isub_name ocli) \<open>=\<close> (f2 ocli isub_name cpt))]) l)" - -definition "check_single = (\<lambda> (name_attr, oid, l_oid) l_mult l. - let l = (RBT.keys o RBT.bulkload o L.map (\<lambda>x. (x, ()))) l - ; assoc = \<lambda>x. case map_of l_oid x of Some s \<Rightarrow> s | None \<Rightarrow> case x of Oid n \<Rightarrow> S.flatten [\<open>/*\<close>, String.natural_to_digit10 n, \<open>*/\<close>] - ; attr_len = natural_of_nat (length l) - ; l_typed = - L.map (\<lambda> (mult_min, mult_max0) \<Rightarrow> - let mult_max = case mult_max0 of None \<Rightarrow> mult_min | Some mult_max \<Rightarrow> mult_max - ; s_mult = \<lambda> Mult_nat n \<Rightarrow> String.natural_to_digit10 n | Mult_star \<Rightarrow> \<open>*\<close> | Mult_infinity \<Rightarrow> \<open>\<infinity>\<close> - ; f = \<lambda>s. S.flatten [ \<open> // \<close> - , s - , \<open> constraint [\<close> - , s_mult mult_min - , if mult_max0 = None then \<open>\<close> else S.flatten [\<open> .. \<close>, s_mult mult_max] - , \<open>] not satisfied\<close> ] in - L.map (\<lambda> (b, msg) \<Rightarrow> (b, S.flatten [ assoc oid - , \<open> \<close> - , case name_attr of None \<Rightarrow> \<open>/* unnamed attribute */\<close> | Some s \<Rightarrow> \<open>.\<close> @@ s - , \<open> \<cong> Set{\<close> (* '\<cong>' instead of '=' because the lhs can be 'invalid' or 'null'! *) - , let l = L.map assoc l in - if l = [] then \<open>\<close> else \<open> \<close> @@ String_concatWith \<open> , \<close> l @@ \<open> \<close> - , \<open>}\<close> - , if b then \<open>\<close> else f msg ])) - [(case mult_min of Mult_nat mult_min \<Rightarrow> mult_min \<le> attr_len | _ \<Rightarrow> True, \<open>minimum\<close>) - ,(case mult_max of Mult_nat mult_max \<Rightarrow> mult_max \<ge> attr_len | _ \<Rightarrow> True, \<open>maximum\<close>)]) l_mult - ; (stop, l_typed) = - if list_ex (list_all fst) l_typed then - ( Warning - , if list_ex (list_ex (Not o fst)) l_typed then - (* at least 1 warning *) - L.map (filter (Not o fst)) l_typed - else - (* 0 warning *) - [[hd (hd l_typed)]]) - else - (Error, L.map (filter (Not o fst)) l_typed) in - L.flatten (L.map (L.map (\<lambda> (b, s) \<Rightarrow> (if b then Writeln else stop, s))) l_typed))" - -definition "check_export_code f_writeln f_warning f_error f_raise l_report msg_last = - (let l_err = - List.fold - (\<lambda> (Writeln, s) \<Rightarrow> \<lambda>acc. case f_writeln s of () \<Rightarrow> acc - | (Warning, s) \<Rightarrow> \<lambda>acc. case f_warning s of () \<Rightarrow> acc - | (Error, s) \<Rightarrow> \<lambda>acc. case f_error s of () \<Rightarrow> s # acc) - l_report - [] in - if l_err = [] then - () - else - f_raise (String.nat_to_digit10 (length l_err) @@ msg_last))" - -definition "print_examp_instance_defassoc_gen name l_ocli env = - (case D_ocl_semantics env of Gen_only_analysis \<Rightarrow> \<lambda>_. [] | Gen_default \<Rightarrow> \<lambda>_. [] | Gen_only_design \<Rightarrow> - \<lambda>(rbt, (map_self, map_username)). - let a = \<lambda>f x. Term_app f [x] - ; b = \<lambda>s. Term_basic [s] - ; l_ocli = if list_ex (\<lambda>(ocli, _). inst_ty0 ocli = None) l_ocli then [] else l_ocli in - [Definition - (Term_rewrite name - \<open>=\<close> - (let var_oid_class = \<open>oid_class\<close> - ; var_to_from = \<open>to_from\<close> - ; var_oid = \<open>oid\<close> - ; a_l = \<lambda>s. Typ_apply (Typ_base var_ty_list) [s] in - Term_lambdas - [var_oid_class, var_to_from, var_oid] - (Term_annot (Term_case - (Term_app var_deref_assocs_list - [ Term_annot (b var_to_from) (Ty_arrow - (a_l (a_l (Typ_base const_oid))) - (let t = a_l (Typ_base const_oid) in - Ty_times t t)) - , Term_annot' (b var_oid) const_oid - , a \<open>the\<close> - (Term_applys (print_examp_def_st_assoc (snd o rbt) map_self map_username l_ocli) - [Term_annot' (b var_oid_class) const_oid])]) - [ (b \<open>Nil\<close>, b \<open>None\<close>) - , let b_l = b \<open>l\<close> in - (b_l, a \<open>Some\<close> b_l)] ) (Typ_apply (Typ_base \<open>option\<close>) [a_l (Typ_base const_oid)]))))])" - -definition "check_single_ty rbt_init rbt' l_attr_gen l_oid x = - (\<lambda> (ty1, mult1) (ty2, mult2). - let role1 = TyRole mult1 - ; role2 = TyRole mult2 - ; s = (*01*) \<lambda> [x0, x1] \<Rightarrow> (x0, x1) - ; s' = (*01*) \<lambda> [x0, x1] \<Rightarrow> (x0, x1) - ; s'' = (*01*) \<lambda> [x0, x1] \<Rightarrow> (x0, x1) - ; (name, (mult_from, mult_to), l) = - case - let f = \<lambda>g. - \<lambda> None \<Rightarrow> None - | Some role1 \<Rightarrow> - map_option - (\<lambda>_. let (ty1, role1, f_swap) = g role1 in - ( case fst (rbt_init ty1) role1 of Some (OclTy_object (OclTyObj (OclTyCore ty_obj) _), _, _) \<Rightarrow> ty_obj - , f_swap (TyObj_from, TyObj_to))) - (lookup rbt' role1) in - case role2 of - None \<Rightarrow> f (\<lambda>role1. (ty2, role1, \<lambda>(a, b). (b, a))) role1 - | Some role2 \<Rightarrow> - (case lookup rbt' role2 of - Some (_, ty_obj) \<Rightarrow> Some (ty_obj, (TyObj_from, TyObj_to)) - | None \<Rightarrow> f (\<lambda>_. (ty1, role2, id)) role1) - of - Some (ty_obj, (f_from, f_to)) \<Rightarrow> - let (o_from, o_to) = (f_from ty_obj, f_to ty_obj) in - ( case (TyObjN_role_name o_from, TyObjN_role_name o_to) of - (name_from, name_to) \<Rightarrow> [name_from, name_to] - , (TyObjN_role_multip o_from, TyObjN_role_multip o_to) - , deref_assocs_list s x (L.map (if ( TyObjN_ass_switch o_from - , TyObjN_ass_switch o_to) = (0, 1) then(*01*) id else(*10*) rev) - (case l_attr_gen (TyObj_ass_id ty_obj) of Some l_attr \<Rightarrow> l_attr))) - | None \<Rightarrow> ([role1, role2], (mult1, mult2), []) in - (\<lambda>acc. - L.flatten [ acc - , check_single - ((snd o s'') name, x, l_oid) - ((snd o s') ([TyMult mult_from, TyMult mult_to])) - l]))" - -definition "mk_instance_single_cpt0 map_username l env = - (let (l, cpt) = - L.mapM (\<lambda>ocli cpt. case Inst_attr_with ocli of - None \<Rightarrow> ([(ocli, cpt)], oidSucInh cpt) - | Some n \<Rightarrow> - (case map_username n of None \<Rightarrow> ([(ocli, cpt)], oidSucInh cpt) - | Some cpt' \<Rightarrow> ([(ocli, cpt')], cpt))) - l - (D_ocl_oid_start env) in - (L.flatten l, cpt))" - -definition "mk_instance_single_cpt map_username l = - fst o mk_instance_single_cpt0 map_username l" - -definition "print_examp_instance_defassoc = (\<lambda> OclInstance l \<Rightarrow> \<lambda> env. - let (rbt :: _ \<Rightarrow> _ \<times> _ \<times> (_ \<Rightarrow> ((_ \<Rightarrow> natural \<Rightarrow> _ \<Rightarrow> (ocl_ty \<times> ocl_data_shallow) option list) \<Rightarrow> _ \<Rightarrow> _) option) - , (map_self, map_username)) = init_map_class env l - ; l = mk_instance_single_cpt map_username l env in - (\<lambda>l_res. - ( print_examp_instance_oid O.definition l env - @@@@ L.map O.definition l_res - , env)) - (print_examp_instance_defassoc_gen - (Term_oid var_inst_assoc (oidGetInh (D_ocl_oid_start env))) - l - env - (rbt, (map_self, map_username))))" - -definition "fold_instance_single_name ocli = - (let b = \<lambda>s. Term_basic [s] in - (case Inst_attr_with ocli of None \<Rightarrow> id - | Some s \<Rightarrow> Cons (b s)) - o - fold_instance_single' (\<lambda>_. List.fold (\<lambda> (_, _, d). fold_data_shallow Some - (\<lambda>_. None) - (\<lambda> Some s \<Rightarrow> Cons (b s) | None \<Rightarrow> id) - d)) - ocli)" - -definition "print_examp_instance_defassoc_typecheck_var = (\<lambda> OclInstance l \<Rightarrow> - (let b = \<lambda>s. Term_basic [s] - ; l_var = List.fold (\<lambda>ocli. case Inst_name ocli of None \<Rightarrow> id | Some n \<Rightarrow> Cons n) l [] - ; n = \<open>_\<close> @@ String_concatWith \<open>_\<close> l_var in - Pair - [ O.definition - (Definition - (Term_rewrite - (Term_app (\<open>typecheck_instance_bad_head_on_lhs\<close> @@ n) (L.map b l_var)) - \<open>=\<close> - (Term_pair' []))) - , O.definition - (Definition - (Term_rewrite - (b (\<open>typecheck_instance_extra_variables_on_rhs\<close> @@ n)) - \<open>=\<close> - (Term_lambdas l_var (Term_pair' (List.fold fold_instance_single_name l [])))))]))" - -definition "print_examp_instance_app_constr2_notmp_norec = (\<lambda>(rbt, (map_self, map_username)) cpt_start ocli isub_name cpt. - let l_attr = split_inh_own rbt (inst_ty ocli) (Inst_attr ocli) in - ( print_examp_instance_app_constr2_notmp - l_attr - isub_name - cpt - (\<lambda>isub_name oid. - ( \<lambda> ty_obj. - let b = \<lambda>s. Term_basic [s] in - Return_val - (Term_applys - cpt_start - (let ty_objfrom = TyObj_from ty_obj - ; ty_objto = TyObj_to ty_obj in - [ b (print_access_oid_uniq_name (TyObjN_ass_switch ty_objfrom) isub_name (case TyObjN_role_name ty_objto of Some s \<Rightarrow> s)) - , b (print_access_choose_name (TyObj_ass_arity ty_obj) (TyObjN_ass_switch ty_objfrom) (TyObjN_ass_switch ty_objto)) - , Term_oid var_oid_uniq (oidGetInh oid) ])) - , \<lambda> base. - let f = \<lambda>v. \<lambda> None \<Rightarrow> Return_err v - | Some s \<Rightarrow> Return_val ((Term_oid var_oid_uniq o oidGetInh) s) in - case base of (_, ShallB_str s) \<Rightarrow> f (Return_object_variable s) (map_username s) - | (_, ShallB_self cpt1) \<Rightarrow> f (Return_err_ty base) (map_self cpt1) - | _ \<Rightarrow> Return_err (Return_err_ty base))) - , Term_warning_parenthesis o print_examp_instance_app_constr2_notmp' l_attr))" - -definition \<open>print_examp_instance_defassoc_typecheck_gen l_ocli env = - (let l_enum = List.map_filter (\<lambda>META_enum e \<Rightarrow> Some e | _ \<Rightarrow> None) (D_input_meta env) - ; (l_spec1, l_spec2) = arrange_ass False True (fst (find_class_ass env)) l_enum in - - case class_unflat (l_spec1, l_spec2) of None \<Rightarrow> [ raise_ml [(Error, \<open>The universe of classes contains a cycle\<close>)] - \<open> error(s)\<close> ] - | Some spec \<Rightarrow> (* cycles could still occur, but not in "spec" *) - let raise_ml_warn = \<lambda>s raise_ml l. raise_ml ((Warning, s) # l) - ; raise_ml = - (if length l_spec1 + (if list_ex (\<lambda> c. cl_name_to_string c \<triangleq> const_oclany) l_spec1 then 0 else 1) - > nb_class spec then - raise_ml_warn (\<open>Some classes have been ignored because of duplications of classes, the absence of classes inheriting from OclAny or the presence of cycles.\n\<close> @@ - \<open>The classes considered for the generation are only:\n \<close> @@ - String_concatWith \<open>, \<close> - (rev (fst (fold_class (\<lambda> _ name _ _ _. - \<lambda> [] \<Rightarrow> Pair name - | l \<Rightarrow> Pair (name @@ \<open>[\<close> @@ String_concatWith \<open>, \<close> (L.map (\<lambda> OclClass n _ _ \<Rightarrow> n) l) @@ \<open>]\<close>)) - () - spec)))) - else id) - raise_ml - ; raise_ml = - (case - RBT.entries (List.fold (\<lambda> c l. - snd (List.fold (\<lambda> (s, _) (rbt, l). - case lookup rbt s of - None \<Rightarrow> (insert s () rbt, l) - | Some _ \<Rightarrow> (rbt, insert s (cl_name_to_string c) l)) - (ClassRaw_own c) - (RBT.empty, l))) - l_spec1 - RBT.empty) of - [] \<Rightarrow> id - | l \<Rightarrow> raise_ml_warn (\<open>Duplicate constant declaration:\n\<close> @@ - String_concatWith \<open>\n\<close> (L.map (\<lambda>(s, name). \<open> \<close> @@ name @@ \<open>: \<close> @@ \<lless>s\<ggreater>) l))) - raise_ml - ; raise_ml = - (case - L.map fst - (RBT.entries - (List.fold - (\<lambda>ass accu. case OclAss_relation ass of OclAssRel l \<Rightarrow> - snd (List.fold (\<lambda>(_, m). - case TyRole m of None \<Rightarrow> id - | Some name \<Rightarrow> \<lambda>(rbt, accu). - (case lookup rbt name of None \<Rightarrow> (insert name () rbt, accu) - | Some _ \<Rightarrow> (rbt, insert name () accu))) - l - (RBT.empty, accu))) - l_spec2 - RBT.empty)) of - [] \<Rightarrow> id - | l \<Rightarrow> raise_ml_warn (\<open>Duplicate constant declaration in association:\n\<close> @@ - String_concatWith \<open>\n\<close> (L.map (\<lambda>s. \<open> \<close> @@ \<lless>s\<ggreater>) l))) - raise_ml - ; env = env \<lparr> D_input_class := Some spec \<rparr> - ; l_assoc = List.map_filter id l_ocli in - if list_ex (\<lambda>ocli. inst_ty0 ocli = None) l_assoc then - [ raise_ml - (List.map_filter (\<lambda>ocli. if inst_ty0 ocli = None then Some (Error, \<open>Missing type annotation in the definition of "\<close> @@ inst_name ocli @@ \<open>"\<close>) else None) l_assoc) - \<open> error(s)\<close>] - else - let (rbt_init0, (map_self, map_username)) = init_map_class env (L.map (\<lambda> Some ocli \<Rightarrow> ocli | None \<Rightarrow> ocl_instance_single_empty) l_ocli) - ; rbt_init = snd o rbt_init0 - ; l_assoc = mk_instance_single_cpt map_username l_assoc env - ; rbt = print_examp_def_st_assoc_build_rbt2 rbt_init map_self map_username l_assoc - ; l_attr_gen = map_of_list (fold (\<lambda>_ (l_attr, ty_obj). - Cons ( TyObj_ass_id ty_obj - , L.map ( (\<lambda>(x , y). [x , y]) - o (if TyObjN_ass_switch (TyObj_from ty_obj) < TyObjN_ass_switch (TyObj_to ty_obj) then - (*01*) \<lambda> [x0, x1] \<Rightarrow> (x0, x1) - else - (*10*) \<lambda> [x0, x1] \<Rightarrow> (x1, x0))) - l_attr)) rbt []) - ; l_oid_gen = L.map - (\<lambda> (ocli, oids). - ( fst (hd (fold_instance_single (\<lambda>a b. Cons (a, b)) ocli [])) - , case oidGetInh oids of oid \<Rightarrow> oid - , inst_name ocli )) - l_assoc in - case L.split l_oid_gen of (_, l_oid) \<Rightarrow> - let l_out = - List.fold - (\<lambda> (name, (x, _)). - let l = find_inh name spec - ; f = \<lambda>(ty1, mult1) ty2 accu. - fst (List.fold - (\<lambda> ty1' (l, b). - if b then - (l, b) - else - ( check_single_ty rbt_init rbt l_attr_gen l_oid x (ty1', mult1) ty2 l - , ty1' \<triangleq> ty1)) - (if name \<triangleq> ty1 then - ty1 # l - else if list_ex ((\<triangleq>) ty1) l then - l - else - []) - (accu, False)) in - List.fold (\<lambda>ass. - case L.map (map_prod ty_obj_to_string id) (OclAss_relation' ass) of - [t1, t2] \<Rightarrow> f t2 t1 o f t1 t2 - | _ \<Rightarrow> id) - l_spec2) - l_oid_gen - [] in - - [ raise_ml - (L.flatten [ rev (print_examp_def_st_assoc_build_rbt_gen_typecheck - (\<lambda>ocli. fst o print_examp_instance_app_constr2_notmp_norec (snd o rbt_init0, (map_self, map_username)) (Term_basic []) ocli id) - (fst o rbt_init0) - (fst o rbt_init) - map_self - map_username - l_enum - l_assoc - []) - , l_out]) - \<open> error(s)\<close> ])\<close> - -definition "print_examp_instance_defassoc_typecheck = (\<lambda> OclInstance l \<Rightarrow> \<lambda> env. - (\<lambda>l_res. (L.map O.ML l_res, env \<lparr> D_output_header_force := True \<rparr>)) - (print_examp_instance_defassoc_typecheck_gen - (L.map Some l) - env))" - -definition "print_examp_instance_name = id" -definition "print_examp_instance = (\<lambda> OclInstance l \<Rightarrow> \<lambda> env. - (\<lambda> ((l_res, oid_start), instance_rbt). - ((L.map O.definition o L.flatten) l_res, env \<lparr> D_ocl_oid_start := oid_start, D_input_instance := instance_rbt \<rparr>)) - (let (rbt, (map_self, map_username)) = init_map_class env l - ; a = \<lambda>f x. Term_app f [x] - ; b = \<lambda>s. Term_basic [s] in - ( let var_inst_ass = \<open>inst_assoc\<close> in - map_prod - (L.map - (\<lambda> (ocli, cpt). - let var_oid = Term_oid var_oid_uniq (oidGetInh cpt) - ; (isub_name, body2, body2') = - case inst_ty0 ocli of - Some ty \<Rightarrow> - let isub_name = \<lambda>s. s @@ String.isub (inst_ty ocli) in - (isub_name, print_examp_instance_app_constr2_notmp_norec (snd o rbt, (map_self, map_username)) (b var_inst_ass) ocli isub_name cpt) - | None \<Rightarrow> (id, (Return_err Return_err_ty_auto, id)) - ; l = - [ Definition - (Term_rewrite (let e = b (inst_name ocli) in - case Inst_ty ocli of - None \<Rightarrow> e - | Some ty \<Rightarrow> Term_annot_ocl e ty) - \<open>=\<close> - (case body2 of Return_err _ \<Rightarrow> b \<open>invalid\<close> - | _ \<Rightarrow> body2' (Term_lambda - wildcard - (Term_some (Term_some (let name_pers = print_examp_instance_name isub_name (inst_name ocli) in - if D_ocl_semantics env = Gen_only_design then - a name_pers (Term_oid var_inst_assoc (oidGetInh (D_ocl_oid_start env))) - else - b name_pers))))))] in - case body2 of Return_err _ \<Rightarrow> l - | Return_val body2 \<Rightarrow> Definition (Term_rewrite (Term_basic (print_examp_instance_name isub_name (inst_name ocli) - # (if D_ocl_semantics env = Gen_only_design then [ var_inst_ass ] else []))) - \<open>=\<close> - body2) - # l)) - id - (mk_instance_single_cpt0 map_username l env) - , let l_id = L.mapi (\<lambda>i ocli. (i, inst_name ocli)) l in - List.fold - (\<lambda>ocli instance_rbt. - let n = inst_name ocli in - ( String.to_String\<^sub>b\<^sub>a\<^sub>s\<^sub>e n - , map_inst_single_self (\<lambda>Oid self \<Rightarrow> - case L.assoc self l_id of - Some name \<Rightarrow> ShallB_str name - | _ \<Rightarrow> ShallB_list []) - ocli - , case map_username n of Some oid \<Rightarrow> oid) - # instance_rbt) - l - (D_input_instance env))))" - -definition "print_examp_def_st_typecheck_var = (\<lambda> OclDefSt name l \<Rightarrow> - (let b = \<lambda>s. Term_basic [s] - ; l_var0 = [name] - ; n = \<open>_\<close> @@ String_concatWith \<open>_\<close> l_var0 in - Pair - [ O.definition - (Definition - (Term_rewrite - (Term_app (\<open>typecheck_state_bad_head_on_lhs\<close> @@ n) (L.map b l_var0)) - \<open>=\<close> - (Term_pair' []))) - , O.definition - (Definition - (Term_rewrite - (b (\<open>typecheck_state_extra_variables_on_rhs\<close> @@ n)) - \<open>=\<close> - (Term_pair' (List.fold (\<lambda> OclDefCoreAdd i \<Rightarrow> fold_instance_single_name i - | OclDefCoreBinding s \<Rightarrow> Cons (b s)) - l - []))))]))" - -definition "print_examp_def_st0 name l = - (let (l, _) = List.fold (\<lambda> (pos, core) (l, n). - ((pos, pos - n, core) # l, - case core of OclDefCoreAdd _ \<Rightarrow> n - | OclDefCoreBinding _ \<Rightarrow> Succ n)) - (L.mapi Pair l) - ([], 0) in - List.fold (\<lambda> (pos, _, OclDefCoreAdd ocli) \<Rightarrow> \<lambda>(l_inst, l_defst). - let i_name = case Inst_name ocli of Some x \<Rightarrow> x | None \<Rightarrow> S.flatten [name, \<open>_object\<close>, String.natural_to_digit10 pos] in - ( map_inst_single_self (\<lambda>Oid self \<Rightarrow> - (case L.assoc self l of - Some (_, OclDefCoreBinding name) \<Rightarrow> ShallB_str name - | Some (p, _) \<Rightarrow> ShallB_self (Oid p) - | _ \<Rightarrow> ShallB_list [])) ocli - \<lparr> Inst_name := Some i_name \<rparr> - # l_inst - , OclDefCoreBinding i_name # l_defst) - | (_, _, OclDefCoreBinding name) \<Rightarrow> \<lambda>(l_inst, l_defst). - ( l_inst - , OclDefCoreBinding name # l_defst)) - l - ([], []))" - -definition "print_examp_increase_oid l_inst = - snd o print_examp_instance (OclInstance l_inst)" - -definition "bootstrap_floor' f_x l env = - (let (l, accu :: compiler_env_config \<Rightarrow> _) = f_x l env in - (bootstrap_floor l env, accu))" - -definition "print_examp_def_st1_gen = (\<lambda> OclDefSt name l \<Rightarrow> bootstrap_floor' - (\<lambda>(l, accu) _. (L.flatten [L.map META_all_meta_embedding l], accu)) - (let (l_inst, l_defst) = print_examp_def_st0 name l - ; l = [ META_def_state Floor2 (OclDefSt name l_defst) ] in - if l_inst = [] then - (l, id) - else - (META_instance (OclInstance l_inst) # l, print_examp_increase_oid l_inst)))" - -definition "print_examp_def_st1 s = fst o print_examp_def_st1_gen s" -definition "print_meta_setup_def_state s env = snd (print_examp_def_st1_gen s env) env" - -definition "print_examp_def_st_defs = (\<lambda> _ \<Rightarrow> start_map O.lemmas - [ Lemmas_simp_thms \<open>\<close> [ \<open>state.defs\<close>, \<open>const_ss\<close> ] ])" - -definition "print_transition_gen = (\<lambda> OclDefPP name s_pre s_post \<Rightarrow> bootstrap_floor' - (\<lambda>f env. - let (l, accu) = f env in - (L.flatten [ L.map META_all_meta_embedding l ], accu)) - (\<lambda>env. - let pref_name = case name of Some n \<Rightarrow> n - | None \<Rightarrow> \<open>WFF_\<close> @@ String.nat_to_digit10 (length (D_input_meta env)) - ; f_comp = \<lambda>None \<Rightarrow> id | Some (_, f, _) \<Rightarrow> f - ; f_comp_env = \<lambda>None \<Rightarrow> id | Some (_, _, f) \<Rightarrow> f - ; f_conv = \<lambda>msg. - \<lambda> OclDefPPCoreAdd ocl_def_state \<Rightarrow> - let n = pref_name @@ msg in - ( OclDefPPCoreBinding n - , Cons (META_def_state Floor1 (OclDefSt n ocl_def_state)) - , let l_inst = fst (print_examp_def_st0 n ocl_def_state) in - if l_inst = [] then id else print_examp_increase_oid l_inst ) - | s \<Rightarrow> (s, id, id) - ; o_pre = Some (f_conv \<open>_pre\<close> s_pre) - ; o_post = map_option (f_conv \<open>_post\<close>) s_post in - ( (f_comp o_pre o f_comp o_post) - [ META_def_transition Floor2 (OclDefPP name - (case o_pre of Some (n, _) \<Rightarrow> n) - (map_option fst o_post)) ] - , f_comp_env o_pre o f_comp_env o_post )))" - -definition "print_transition s = fst o print_transition_gen s" -definition "print_meta_setup_def_transition s env = snd (print_transition_gen s env) env" - -end diff --git a/Citadelle/src/compiler/core/Floor1_haskabelle.thy b/Citadelle/src/compiler/core/Floor1_haskabelle.thy deleted file mode 100644 index 880c4b1c4021630cc29e404bd129eb49058a7d6f..0000000000000000000000000000000000000000 --- a/Citadelle/src/compiler/core/Floor1_haskabelle.thy +++ /dev/null @@ -1,161 +0,0 @@ -(****************************************************************************** - * HOL-HKB - * - * Copyright (c) 2017-2018 Virginia Tech, USA - * 2018-2019 Université Paris-Saclay, Univ. Paris-Sud, France - * - * 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. - ******************************************************************************) - -section\<open>Main Translation for: Haskabelle\<close> - -theory Floor1_haskabelle -imports Core_init -begin - -definition "gen_zero s = s @@ \<open>0\<close>" - -definition "hsk_name0 flatten = (\<lambda> l_name. - \<lambda> Name n \<Rightarrow> n - | QName (ThyName n0) n1 \<Rightarrow> - (case List.find (\<lambda>(n1, _). n0 \<triangleq> n1) l_name of - None \<Rightarrow> flatten n0 n1 - | Some (_, Some n0) \<Rightarrow> flatten n0 n1 - | Some (_, None) \<Rightarrow> n1))" - -definition "hsk_name = hsk_name0 (\<lambda> n0 n1. S.flatten [n0, \<open>.\<close>, n1])" -definition "hsk_name' names = mk_quote o hsk_name names" -definition "hsk_name'' = hsk_name0 (\<lambda> _. id)" - -fun hsk_type where - "hsk_type names e = - (\<lambda> Type n [] \<Rightarrow> Typ_base (hsk_name names n) - | Type n l \<Rightarrow> Typ_apply (Typ_base (hsk_name names n)) (map (hsk_type names) l) - | Func t1 t2 \<Rightarrow> Typ_apply (hsk_type names t1) [hsk_type names t2] - | TVar n \<Rightarrow> Typ_base (hsk_name' names n)) e" - -definition "hsk_typespec names = (\<lambda> TypeSpec l n \<Rightarrow> (hsk_name names n, L.map (hsk_name' names) l))" - -definition "hsk_typesign names = (\<lambda>TypeSign n _ _ \<Rightarrow> hsk_name names n)" - -definition "hsk_literal str = (\<lambda> String s \<Rightarrow> str s - | Meta_HKB.Int n \<Rightarrow> Term_basic [String.natural_to_digit10 n])" - -record lexical = lex_list_cons :: string - lex_bool_false :: string - lex_string :: "string \<Rightarrow> semi__term" - -fun hsk_term and - hsk_term_app where - "hsk_term lexi names t = - (\<lambda> Literal l \<Rightarrow> hsk_literal (lex_string lexi) l - | Const n \<Rightarrow> - let f = \<lambda> (). Term_basic [hsk_name names n] in - (case n of QName (ThyName s1) s2 \<Rightarrow> - if s1 \<triangleq> \<open>List\<close> & s2 \<triangleq> \<open>Nil\<close> then Term_list [] - else if s1 \<triangleq> \<open>HOL\<close> & s2 \<triangleq> \<open>False\<close> then Term_basic [lex_bool_false lexi] - else f () - | _ \<Rightarrow> f ()) - | App t1 t2 \<Rightarrow> - let t2 = hsk_term lexi names t2 - ; f = \<lambda> (). hsk_term_app lexi names [t2] t1 in - (case t1 of - App (Const (QName (ThyName s1) s2)) t12 \<Rightarrow> - let t12 = \<lambda> (). hsk_term lexi names t12 in - if s1 \<triangleq> \<open>Product_Type\<close> & s2 \<triangleq> \<open>Pair\<close> then Term_pair (t12 ()) t2 - else if s1 \<triangleq> \<open>Prelude\<close> & s2 \<triangleq> \<open>#\<close> then Term_parenthesis (Term_binop (t12 ()) (lex_list_cons lexi) t2) - else f () - | _ \<Rightarrow> f ()) - | Parenthesized t \<Rightarrow> hsk_term lexi names t) t" - | "hsk_term_app lexi names l t = (\<lambda> App t1 t2 \<Rightarrow> hsk_term_app lexi names (hsk_term lexi names t2 # l) t1 - | e \<Rightarrow> Term_parenthesis (Term_apply (hsk_term lexi names e) l)) t" - -definition "hsk_stmt version names app_end = - (let b = \<lambda>s. Term_basic [s] in - map_prod concat concat o L.split o map - (\<lambda> Meta_HKB.Datatype l \<Rightarrow> - let l_data = L.map (map_prod (hsk_typespec names) (L.map (map_prod (hsk_name names) (L.map (hsk_type names))))) l - ; l_data' = concat (L.map (L.map (\<lambda>(s, _). (s, gen_zero s)) o snd) l_data) in - ( O.datatype (Datatype version (L.map (map_prod id (L.map (map_prod gen_zero id))) l_data)) - # (* For each constructor, we additionally generate an alias definition, for it to be used - in the SML code generated part as an alternative of the SML generated constructor: - its type will be not curried (whereas the SML type of the constructor will be). *) - L.map (\<lambda>(s, s'). O.definition (Definition (Term_rewrite (b s) \<open>=\<close> (b s')))) l_data' - , L.map fst l_data') - | TypeSynonym [(t0, t1)] \<Rightarrow> ([O.type_synonym (Type_synonym (hsk_typespec names t0) (hsk_type names t1))], []) - | Function (Function_Stmt Meta_HKB.Definition [t] [((lhs_n, lhs_arg), rhs)]) \<Rightarrow> - let s_empty = b \<open>v\<close> - ; T_string = Term_string' - ; hsk_term = hsk_term \<lparr> lex_list_cons = \<open>#\<close>, lex_bool_false = \<open>False\<close>, lex_string = (\<lambda>s. if s \<triangleq> \<open>\<close> then s_empty else T_string s) \<rparr> names in - ( [(O.definition o Definition) - (Term_rewrite (Term_app (hsk_name'' names lhs_n) (map hsk_term lhs_arg)) - \<open>=\<close> - (let t = Term_parenthesis (Term_let [(s_empty, T_string \<open>\<close>)] (hsk_term rhs)) in - case app_end of Gen_apply_hol f \<Rightarrow> Term_app f [t] - | _ \<Rightarrow> t))] - , []) - | Meta_HKB.SML (Function_Stmt Meta_HKB.Definition [t] [((lhs_n, lhs_arg), rhs)]) \<Rightarrow> - let s_empty = b \<open>v\<close> - ; f_content = b \<open>content\<close> - ; T_string = Term_string'' f_content - ; hsk_term = hsk_term \<lparr> lex_list_cons = \<open>::\<close>, lex_bool_false = \<open>false\<close>, lex_string = (\<lambda>s. if s \<triangleq> \<open>\<close> then s_empty else T_string s) \<rparr> names in - ( (O.ML o SML o SML_top) - [SML_val_fun - (Some Sval) - (hol_to_sml (Term_rewrite (Term_app (hsk_name'' names lhs_n) (map hsk_term lhs_arg)) - \<open>=\<close> - (let t = Term_parenthesis (Term_let [ (f_content, term_binop \<open>o\<close> (map b [\<open>SS_base\<close>, \<open>ST\<close>, \<open>Input.source_content\<close>])) - , (s_empty, T_string \<open>\<close>)] - (hsk_term rhs)) in - case app_end of Gen_apply_sml f \<Rightarrow> Term_app f [t] - | Gen_apply_sml_cmd f _ \<Rightarrow> Term_app f [t] - | _ \<Rightarrow> t)))] - # (case app_end of Gen_apply_sml_cmd _ s \<Rightarrow> - [(META_all_meta_embedding o META_generic o OclGeneric) s] - | _ \<Rightarrow> []) - , []) - | _ \<Rightarrow> ([], [])))" - -definition "print_haskell = (\<lambda> IsaUnit version l_name app_end name_new (l_mod, b_concat) \<Rightarrow> \<lambda>env. - (map_prod concat ((\<lambda>l1. D_hsk_constr_update (\<lambda>l0. l0 @ l1) env) o L.map String.to_String\<^sub>b\<^sub>a\<^sub>s\<^sub>e o concat) - o L.split - o map - (\<lambda> Module (ThyName name_old) _ m _ \<Rightarrow> - hsk_stmt (case map_prod id nat_of_natural version of (False, _) \<Rightarrow> Datatype_new - | (True, 0) \<Rightarrow> Datatype_old - | (True, Suc 0) \<Rightarrow> Datatype_old_atomic - | (True, Suc (Suc 0)) \<Rightarrow> Datatype_old_atomic_sub) - ((name_old, Some name_new) # l_name) - app_end - m)) - (if b_concat then l_mod else [last l_mod]))" - -end diff --git a/Citadelle/src/compiler/core/Floor1_infra.thy b/Citadelle/src/compiler/core/Floor1_infra.thy deleted file mode 100644 index d9ba3ab4fca28bd99722cc535a4fd84a2a8dcfc1..0000000000000000000000000000000000000000 --- a/Citadelle/src/compiler/core/Floor1_infra.thy +++ /dev/null @@ -1,449 +0,0 @@ -(****************************************************************************** - * 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. - ******************************************************************************) - -section\<open>Main Translation for: Infrastructure\<close> - -theory Floor1_infra -imports Core_init -begin - -definition "print_infra_enum_synonym _ env = (\<lambda>f. (f (fst (find_class_ass env)), env)) - (L.flatten o L.map - (\<lambda> META_class_synonym (OclClassSynonym n1 n2) \<Rightarrow> - [ O.type_synonym (Type_synonym' (pref_ty_syn n1) (Typ_base (str_hol_of_ty_all (\<lambda>a _. a) id n2))) ] - | _ \<Rightarrow> []))" - -definition "print_infra_datatype_class_1 = start_map'' O.datatype o (\<lambda>expr _ base_attr' _. map_class_gen_h'''' - (\<lambda>isub_name name _ l_attr l_inherited l_cons. - let (l_attr, l_inherited) = base_attr' (l_attr, of_inh l_inherited) - ; map_ty = L.map ((\<lambda>x. Typ_apply (Typ_base \<open>option\<close>) [str_hol_of_ty_all Typ_apply Typ_base x]) o snd) in - [ Datatype' - (isub_name datatype_ext_name) - ( (L.rev_map (\<lambda>x. ( datatype_ext_constr_name @@ mk_constr_name name x - , [Raw (datatype_name @@ String.isub x)])) (of_sub l_cons)) - @@@@ [(isub_name datatype_ext_constr_name, Raw const_oid # L.maps map_ty l_inherited)]) - , Datatype' - (isub_name datatype_name) - [ (isub_name datatype_constr_name, Raw (isub_name datatype_ext_name) # map_ty l_attr ) ] ]) expr)" - -definition \<open>print_latex_infra_datatype_class = start_map'' O.datatype o (\<lambda>expr _ base_attr' _. map_class_gen_h'''' - (\<lambda>isub_name name _ l_attr l_inherited l_cons. - let (l_attr, l_inherited) = base_attr' (l_attr, of_inh l_inherited) - ; map_ty = L.map ((\<lambda>x. Typ_apply (Typ_base \<open>option\<close>) [str_hol_of_ty_all Typ_apply Typ_base x]) o snd) - ; n1 = \<open>{ext}\<close> - ; n2 = \<open>{ty}\<close> in - [ Datatype' - (\<open>\operatorname{\<close> @@ name @@ \<open>}_\<close> @@ n1 @@ \<open>\<close>) - ( (L.rev_map (\<lambda>x. ( \<open>\operatorname{mk}_\text{\<close> @@ name @@ \<open>\_\<close> @@ x @@ \<open>}\<close> - , [Raw (\<open>\operatorname{\<close> @@ x @@ \<open>}_\<close> @@ n2 @@ \<open>\<close>)])) (of_sub l_cons)) - @@@@ [(\<open>\operatorname{mk}_\text{\<close> @@ name @@ \<open>}\<close>, Raw const_oid # L.maps map_ty l_inherited)]) - , Datatype' - (\<open>\operatorname{\<close> @@ name @@ \<open>}_\<close> @@ n2 @@ \<open>\<close>) - [ (\<open>\operatorname{mkoid}_\text{\<close> @@ name @@ \<open>}\<close>, Raw (\<open>\operatorname{\<close> @@ name @@ \<open>}_\<close> @@ n1 @@ \<open>\<close>) # map_ty l_attr ) ] ]) expr)\<close> - -definition "print_infra_datatype_class_2 = start_map'' O.datatype o (\<lambda>expr _ base_attr' _. map_class_gen_h''' - (\<lambda>isub_name name _ l_attr l_inherited l_cons. - let (l_attr, l_inherited) = base_attr' (l_attr, of_inh l_inherited) - ; map_ty = L.map ((\<lambda>x. Typ_apply (Typ_base \<open>option\<close>) [str_hol_of_ty_all Typ_apply Typ_base x]) o snd) - ; l = - [ Datatype' - (isub_name datatype'_ext'_name) - ([(isub_name datatype'_ext_constr_name, L.flatten [ map_ty l_attr - , if l_cons = [] then [] else [ Opt (isub_name datatype'_ext_name) ]])]) - , Datatype' - (isub_name datatype'_name) - [(isub_name datatype'_constr_name, L.flatten [ Raw const_oid # L.maps map_ty l_inherited - , [ Raw (isub_name datatype'_ext'_name) ]])]] in - if l_cons = [] then l - else - Datatype' - (isub_name datatype'_ext_name) - (L.rev_map (\<lambda> OclClass x _ _ \<Rightarrow> - ( datatype'_ext_constr_name @@ mk_constr_name name x - , [Raw (datatype'_ext'_name @@ String.isub x)])) l_cons) # l) expr)" - -definition "print_infra_datatype_equiv_2of1_name = \<open>class_ty_ext_equiv_2of1\<close>" -definition "print_infra_datatype_equiv_2of1_name_aux = print_infra_datatype_equiv_2of1_name @@ \<open>_aux\<close>" -definition "print_infra_datatype_equiv_2of1 = start_map'' O.definition o (\<lambda>expr _ base_attr' _. map_class_gen_h''' - (\<lambda>isub_name name _ l_attr l_inherited next_dataty. - let (l_attr, l_inherited) = base_attr' (l_attr, of_inh l_inherited) - ; f_attr_own = (\<lambda>s. \<open>own\<close> @@ String.isub s \<comment> \<open>fresh variable names\<close>) o fst - ; f_attr_inh = (\<lambda>s. \<open>inh\<close> @@ String.isub s \<comment> \<open>fresh variable names\<close>) o fst - ; (l_attr, l_inherited) = (L.map f_attr_own l_attr, L.map f_attr_inh (L.flatten l_inherited)) - ; a = \<lambda>f x. Term_app f [x] - ; b = \<lambda>s. Term_basic [s] - ; a' = \<lambda>f l. Term_app f (L.map b l) - ; print_name = isub_name print_infra_datatype_equiv_2of1_name_aux - ; var_oid = \<open>oid\<close> - ; f_pat = \<lambda>l. L.flatten [var_oid # l_inherited, l] in - L.map (\<lambda> (n,d). Definition (Term_rewrite (b n) \<open>=\<close> d)) - [( print_name - , let var_t = \<open>t\<close> in - Term_lambdas - (f_pat []) - (Term_function - [( a' (isub_name datatype'_ext_constr_name) (L.flatten [ l_attr, if next_dataty = [] then [] else [var_t]]) - , Term_app - (isub_name datatype_constr_name) - ( (let pat_none = a' (isub_name datatype_ext_constr_name) (f_pat []) in - if next_dataty = [] then pat_none - else - Term_case - (b var_t) - ( (b \<open>None\<close>, pat_none) - # (L.map - (\<lambda> OclClass name_pers l_attr_pers name_pers0 \<Rightarrow> - let l_attr_pers = L.map f_attr_own (fst (base_attr' (l_attr_pers, []))) - ; isub_name_pers = \<lambda>x. x @@ String.isub name_pers in - ( Term_some (a (datatype'_ext_constr_name @@ mk_constr_name name name_pers) (b var_t)) - , let f_pat = \<lambda>l. L.flatten [ l_attr, l_inherited, l] in - Term_case - (a' (isub_name_pers print_infra_datatype_equiv_2of1_name_aux) (var_oid # f_pat [var_t])) - (let a_pers = \<lambda>x. Term_app (isub_name_pers datatype_constr_name) - (x # L.map b l_attr_pers) - ; v = a_pers (a' (isub_name_pers datatype_ext_constr_name) - (var_oid # f_pat [])) in - (v, a (datatype_ext_constr_name @@ mk_constr_name name name_pers) v) - # - L.map - (\<lambda> OclClass name_bot _ _ \<Rightarrow> - ( a_pers (a (datatype_ext_constr_name @@ mk_constr_name name_pers name_bot) - (b var_t)) - , a (datatype_ext_constr_name @@ mk_constr_name name name_bot) (b var_t))) - (get_class_hierarchy_strict name_pers0)))) - next_dataty))) - # L.map b l_attr))])) - , ( isub_name print_infra_datatype_equiv_2of1_name - , Term_function [ let l = L.map b (f_pat [\<open>t\<close>]) in - (Term_app (isub_name datatype'_constr_name) l, Term_app print_name l)])]) expr)" - -definition "print_infra_datatype_equiv_1of2_name = \<open>class_ty_ext_equiv_1of2\<close>" -definition "print_infra_datatype_equiv_1of2_name_aux0 = print_infra_datatype_equiv_1of2_name @@ \<open>_aux0\<close>" -definition "print_infra_datatype_equiv_1of2_name_aux = print_infra_datatype_equiv_1of2_name @@ \<open>_aux\<close>" -definition "print_infra_datatype_equiv_1of2_name_get_oid_inh = print_infra_datatype_equiv_1of2_name @@ \<open>_get_oid_inh\<close>" -definition "print_infra_datatype_equiv_1of2 = start_map'' O.definition o (\<lambda>expr _ base_attr' _. map_class_gen_h''' - (\<lambda>isub_name name _ l_attr l_inherited next_dataty. - let (l_attr, l_inherited) = base_attr' (l_attr, of_inh l_inherited) - ; f_attr_own = (\<lambda>s. \<open>own\<close> @@ String.isub s \<comment> \<open>fresh variable names\<close>) o fst - ; f_attr_inh = (\<lambda>s. \<open>inh\<close> @@ String.isub s \<comment> \<open>fresh variable names\<close>) o fst - ; f_attr_var = (\<lambda>s. \<open>var\<close> @@ String.isub s \<comment> \<open>fresh variable names\<close>) o fst - ; (l_attr', l_attr, l_inherited', l_inherited) = - ( L.map f_attr_var l_attr - , L.map f_attr_own l_attr - , L.map f_attr_var (L.flatten l_inherited) - , L.map f_attr_inh (L.flatten l_inherited)) - ; a = \<lambda>f x. Term_app f [x] - ; b = \<lambda>s. Term_basic [s] - ; a' = \<lambda>f l. Term_app f (L.map b l) - ; print_name = isub_name print_infra_datatype_equiv_1of2_name_aux - ; var_t = \<open>t\<close> - ; var_tt = \<open>tt\<close> - ; var_oid = \<open>oid\<close> in - L.map (\<lambda> (n,d). Definition (Term_rewrite (b n) \<open>=\<close> d)) - [ ( isub_name print_infra_datatype_equiv_1of2_name_get_oid_inh - , Term_function - ((a' (isub_name datatype_ext_constr_name) (L.flatten [[var_oid], l_inherited]) - ,Term_pairs' b (L.flatten [[var_oid], l_inherited])) - # - (L.flatten - (L.map - (fst o fold_class (\<lambda>isub_name_pers name_pers l_attr_pers l_inh _ _. - let l_attr_pers = L.map f_attr_var (fst (base_attr' (l_attr_pers, []))) in - Pair ( a (datatype_ext_constr_name @@ mk_constr_name name name_pers) - (a' (isub_name_pers datatype_constr_name) (var_t # l_attr_pers)) - , Term_case (a (isub_name_pers print_infra_datatype_equiv_1of2_name_get_oid_inh) (b var_t)) - [ let l_inh = L.flatten [ L.flatten (L.map (\<lambda>OclClass _ l_attr _ \<Rightarrow> - L.map f_attr_var (fst (base_attr' (l_attr, [])))) (of_inh l_inh)) - , l_attr' - , l_inherited' ] in - (Term_pairs' b (var_oid # l_inh), Term_pairs' b (var_oid # l_inherited'))])) ()) - next_dataty)))) - , ( print_name - , Term_function - [( a' (isub_name datatype_constr_name) (var_t # l_attr) - , Term_app - (isub_name datatype'_ext_constr_name) - (L.flatten - [ L.map b l_attr - , if next_dataty = [] then [] else - [Term_case (b var_t) - ( (a' (isub_name datatype_ext_constr_name) (var_oid # l_inherited), b \<open>None\<close>) - # - L.flatten (L.map (fst o fold_class (\<lambda>isub_name_pers name_pers l_attr_pers l_inh _ _. - let l_attr_pers = L.map f_attr_var (fst (base_attr' (l_attr_pers, []))) in - Pair - ( a (datatype_ext_constr_name @@ mk_constr_name name name_pers) (b var_tt) - , Term_case - (Term_case (b var_tt) - [ let var_t = \<open>t\<close> in - ( a' (isub_name_pers datatype_constr_name) (var_t # l_attr_pers) - , a (isub_name_pers print_infra_datatype_equiv_1of2_name_get_oid_inh) (b var_t))]) - [(Term_pairs' - b - ( var_oid # (L.flatten [ L.flatten (L.map (\<lambda>OclClass _ l_attr _ \<Rightarrow> - L.map f_attr_var (fst (base_attr' (l_attr, [])))) (of_inh l_inh)) - , l_attr' - , l_inherited'])) - , let f_cons = \<lambda> expr name0 name1. Term_some (a (datatype'_ext_constr_name @@ mk_constr_name name1 name0) expr) - ; (expr, name0) = - foldl - (\<lambda> (expr, name0) (name1, l_attr1). - ( Term_app (datatype'_ext_constr_name @@ String.isub name1) - (L.flatten [L.map b (L.map f_attr_var (fst (base_attr' (l_attr1, [])))), [f_cons expr name0 name1]]) - , name1)) - (a (isub_name_pers print_infra_datatype_equiv_1of2_name_aux) (b var_tt), name_pers) - (L.map (\<lambda>OclClass n l_attr _ \<Rightarrow> (n, l_attr)) (of_inh l_inh)) in - f_cons expr name0 name)])) ()) next_dataty)) ]]))]) - , ( isub_name print_infra_datatype_equiv_1of2_name - , Term_function - [( a' (isub_name datatype_constr_name) (var_t # l_attr) - , Term_case - (a (isub_name print_infra_datatype_equiv_1of2_name_get_oid_inh) (b var_t)) - [( Term_pairs' b (var_oid # l_inherited) - , Term_app (isub_name datatype'_constr_name) - (L.flatten [ L.map b (var_oid # l_inherited) - , [a print_name (a' (isub_name datatype_constr_name) (var_t # l_attr))]]))])])]) expr)" - -definition "print_infra_datatype_equiv_1_idempo_name = \<open>class_ty_ext_equiv_1_idempo\<close>" -definition "print_infra_datatype_equiv_1_idempo = start_map'' O.lemma o (\<lambda>expr _ base_attr' _. map_class_gen_h''' - (\<lambda>isub_name name _ l_attr l_inherited next_dataty. - let (l_attr, l_inherited) = base_attr' (l_attr, of_inh l_inherited) - ; f_attr_own = (\<lambda>s. \<open>own\<close> @@ String.isub s \<comment> \<open>fresh variable names\<close>) o fst - ; f_attr_inh = (\<lambda>s. \<open>inh\<close> @@ String.isub s \<comment> \<open>fresh variable names\<close>) o fst - ; f_attr_var = (\<lambda>s. \<open>var\<close> @@ String.isub s \<comment> \<open>fresh variable names\<close>) o fst - ; (l_attr', l_attr, l_inherited', l_inherited) = - ( L.map f_attr_var l_attr - , L.map f_attr_own l_attr - , L.map f_attr_var (L.flatten l_inherited) - , L.map f_attr_inh (L.flatten l_inherited)) - ; a = \<lambda>f x. Term_app f [x] - ; b = \<lambda>s. Term_basic [s] - ; f_1of2 = isub_name print_infra_datatype_equiv_1of2_name - ; f_2of1 = isub_name print_infra_datatype_equiv_2of1_name - ; var_X = \<open>X\<close> - ; var_t = \<open>t\<close> - ; var_oid = \<open>oid\<close> in - [ Lemma_assumes (isub_name print_infra_datatype_equiv_1_idempo_name) - [] - (Term_rewrite (a f_1of2 (a f_2of1 (b var_X))) \<open>=\<close> (b var_X)) - [ C.apply [M.case_tac (b var_X), M.simp] - (*, C.fix (var_oid # l_inherited')*) - (* TODO below *) ] - C.sorry ]) expr)" -(* -(* -Class Person < Planet Attributes salary : Integer -Class Planet < Galaxy Attributes wormhole : UnlimitedNatural - weight : Integer -Class Galaxy Attributes sound : Void - moving : Boolean -Class Ooo < Ppp -Class Ppp < Planet -Class Yyy < Zzz -Class Zzz -*) -lemma class_ty_ext_equiv_1_idempo\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t : -shows "(class_ty_ext_equiv_1of2\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t ((class_ty_ext_equiv_2of1\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t (X)))) = X" - apply(case_tac "X", simp) - subgoal for oid (*var\<^sub>w\<^sub>o\<^sub>r\<^sub>m\<^sub>h\<^sub>o\<^sub>l\<^sub>e var\<^sub>w\<^sub>e\<^sub>i\<^sub>g\<^sub>h\<^sub>t*) var\<^sub>s\<^sub>o\<^sub>u\<^sub>n\<^sub>d var\<^sub>m\<^sub>o\<^sub>v\<^sub>i\<^sub>n\<^sub>g t - apply(case_tac t, simp) - subgoal for var\<^sub>w\<^sub>o\<^sub>r\<^sub>m\<^sub>h\<^sub>o\<^sub>l\<^sub>e var\<^sub>w\<^sub>e\<^sub>i\<^sub>g\<^sub>h\<^sub>t opt - apply(case_tac opt, simp) - apply(subst class_ty_ext_equiv_1of2\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_def, - subst class_ty_ext_equiv_1of2_aux\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_def, - subst class_ty_ext_equiv_1of2_get_oid_inh\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_def, - subst class_ty_ext_equiv_2of1\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_def, - subst class_ty_ext_equiv_2of1_aux\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_def, - auto) - subgoal for obj - apply(case_tac "obj", simp) defer apply(simp) - subgoal for ty2\<E>\<X>\<T>\<^sub>P\<^sub>p\<^sub>p - apply(insert class_ty_ext_equiv_1_idempo\<^sub>P\<^sub>p\<^sub>p[of "mk2oid\<^sub>P\<^sub>p\<^sub>p oid var\<^sub>w\<^sub>o\<^sub>r\<^sub>m\<^sub>h\<^sub>o\<^sub>l\<^sub>e var\<^sub>w\<^sub>e\<^sub>i\<^sub>g\<^sub>h\<^sub>t var\<^sub>s\<^sub>o\<^sub>u\<^sub>n\<^sub>d - var\<^sub>m\<^sub>o\<^sub>v\<^sub>i\<^sub>n\<^sub>g ty2\<E>\<X>\<T>\<^sub>P\<^sub>p\<^sub>p"]) - apply(subst class_ty_ext_equiv_1of2\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_def, - subst class_ty_ext_equiv_1of2_aux\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_def, - subst class_ty_ext_equiv_1of2_get_oid_inh\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_def, - subst class_ty_ext_equiv_2of1\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_def, - subst class_ty_ext_equiv_2of1_aux\<^sub>P\<^sub>l\<^sub>a\<^sub>n\<^sub>e\<^sub>t_def, - simp) - - apply(case_tac "class_ty_ext_equiv_2of1_aux\<^sub>P\<^sub>p\<^sub>p oid var\<^sub>w\<^sub>o\<^sub>r\<^sub>m\<^sub>h\<^sub>o\<^sub>l\<^sub>e var\<^sub>w\<^sub>e\<^sub>i\<^sub>g\<^sub>h\<^sub>t - var\<^sub>s\<^sub>o\<^sub>u\<^sub>n\<^sub>d var\<^sub>m\<^sub>o\<^sub>v\<^sub>i\<^sub>n\<^sub>g ty2\<E>\<X>\<T>\<^sub>P\<^sub>p\<^sub>p", simp) - subgoal for ty\<E>\<X>\<T>\<^sub>P\<^sub>p\<^sub>p - apply(case_tac ty\<E>\<X>\<T>\<^sub>P\<^sub>p\<^sub>p, simp) - subgoal for ty\<^sub>O\<^sub>o\<^sub>o - apply(case_tac ty\<^sub>O\<^sub>o\<^sub>o, simp) - subgoal for ty\<E>\<X>\<T>\<^sub>O\<^sub>o\<^sub>o - apply(case_tac "class_ty_ext_equiv_1of2_get_oid_inh\<^sub>O\<^sub>o\<^sub>o ty\<E>\<X>\<T>\<^sub>O\<^sub>o\<^sub>o", simp) - by(simp add: class_ty_ext_equiv_1of2\<^sub>P\<^sub>p\<^sub>p_def class_ty_ext_equiv_2of1\<^sub>P\<^sub>p\<^sub>p_def - class_ty_ext_equiv_1of2_get_oid_inh\<^sub>P\<^sub>p\<^sub>p_def - class_ty_ext_equiv_1of2_aux\<^sub>P\<^sub>p\<^sub>p_def) - done - by(simp add: class_ty_ext_equiv_1of2\<^sub>P\<^sub>p\<^sub>p_def class_ty_ext_equiv_2of1\<^sub>P\<^sub>p\<^sub>p_def - class_ty_ext_equiv_1of2_get_oid_inh\<^sub>P\<^sub>p\<^sub>p_def - class_ty_ext_equiv_1of2_aux\<^sub>P\<^sub>p\<^sub>p_def) - done -sorry sorry sorry sorry -*) - -definition "print_infra_datatype_universe expr = start_map O.datatype - [ Datatype' \<open>\<AA>\<close> - (map_class (\<lambda>isub_name _ _ _ _ _. (isub_name datatype_in, [Raw (isub_name datatype_name)])) expr) ]" - -definition "print_infra_enum_syn _ env = (\<lambda>f1 f2. (L.flatten [f1 (D_input_meta env), f2 (fst (find_class_ass env))], env)) - (L.flatten o L.map - (\<lambda> META_enum (OclEnum name_ty _) \<Rightarrow> - [O.type_synonym (Type_synonym' name_ty (Typ_apply (Typ_base (pref_generic_enum name_ty)) [Typ_base \<open>\<AA>\<close>]))] - | _ \<Rightarrow> [])) - (L.flatten o L.map - (\<lambda> META_class_synonym (OclClassSynonym name_ty ty) \<Rightarrow> - [O.type_synonym (Type_synonym' name_ty (Typ_base (str_of_ty ty)))] - | _ \<Rightarrow> []))" - -definition "print_infra_type_synonym_class _ = start_map id - (L.map O.type_synonym - (let ty = \<lambda> t s. Type_synonym' (str_of_ty t) (Typ_apply (Typ_base s) [Typ_base \<open>\<AA>\<close>]) in - \<comment> \<open>base type\<close> - ty OclTy_base_void ty_void # - ty OclTy_base_boolean ty_boolean # - ty OclTy_base_integer ty_integer # - (*ty OclTy_base_unlimitednatural ty_unlimitednatural #*) - ty OclTy_base_real ty_real # - ty OclTy_base_string ty_string # - (* *) - Type_synonym'' var_val' [\<open>'\<alpha>\<close>] (\<lambda> [alpha] \<Rightarrow> Typ_apply (Typ_base \<open>val\<close>) [Typ_base \<open>\<AA>\<close>, Typ_base alpha ]) # - []) - @@@@ - L.map O.type_notation - [ Type_notation var_val' \<open>\<cdot>(_)\<close> ])" - -definition "print_infra_type_synonym_class_higher expr = start_map O.type_synonym - (let option = Typ_apply_paren \<open>\<langle>\<close> \<open>\<rangle>\<^sub>\<bottom>\<close> in - L.flatten - (map_class - (\<lambda>isub_name name _ _ _ _. - [ Type_synonym' name - (option (option (Typ_base (isub_name datatype_name)))) - \<^cancel>\<open>, Type_synonym' name (Typ_apply_paren \<open>\<cdot>\<close> \<open>\<close> (Typ_base (name @@ \<open>'\<close>)))\<close>]) - expr))" - -definition "print_infra_type_synonym_class_rec = (\<lambda>expr env. - map_prod id (\<lambda> D_ocl_HO_type. env \<lparr> D_ocl_HO_type := D_ocl_HO_type \<rparr>) - (L.split (L.map (\<lambda>(tit, body). (O.type_synonym (Type_synonym' (String\<^sub>b\<^sub>a\<^sub>s\<^sub>e.to_String tit) body), tit)) - (snd (fold_class (\<lambda>_ _ l_attr _ _ _. - Pair () o List.fold - (\<lambda>(_, t) l. - let f = (* WARNING we may test with RBT instead of List *) - \<lambda>t l. - let (tit, body) = print_infra_type_synonym_class_rec_aux t in - if String.assoc tit l = None then (String.to_String\<^sub>b\<^sub>a\<^sub>s\<^sub>e tit, body) # l else l in - case t of - OclTy_object (OclTyObj (OclTyCore obj) _) \<Rightarrow> - let t = \<lambda>ty. OclTy_collection (ocl_multiplicity_ext [] None [ty] ()) (OclTy_class_pre (TyObjN_role_ty (TyObj_to obj))) in - f (t Sequence) (f (t Set) l) - | OclTy_collection _ _ \<Rightarrow> f t l - | OclTy_pair _ _ \<Rightarrow> f t l - | _ \<Rightarrow> l) - l_attr) - [] - expr)))))" - -definition "print_infra_instantiation_class = start_map'' O.instantiation o (\<lambda>expr _ base_attr' _. map_class_gen_h'''' - (\<lambda>isub_name name _ l_attr l_inherited l_cons. - let (l_attr, l_inherited) = base_attr' (l_attr, of_inh l_inherited) in - let oid_of = \<open>oid_of\<close> in - [Instantiation - (isub_name datatype_name) - oid_of - (Term_rewrite - (Term_basic [oid_of]) - \<open>=\<close> - (Term_function - [ let var_oid = \<open>t\<close> in - ( Term_basic (isub_name datatype_constr_name # var_oid # L.map (\<lambda>_. wildcard) l_attr) - , Term_case - (Term_basic [var_oid]) - ( ( Term_app - (isub_name datatype_ext_constr_name) - (Term_basic [var_oid] # L.flatten (L.map (L.map (\<lambda>_. Term_basic [wildcard])) l_inherited)) - , Term_basic [var_oid]) - # L.map (\<lambda>x. ( Term_app (datatype_ext_constr_name @@ mk_constr_name name x) [Term_basic [var_oid]] - , Term_app oid_of [Term_basic [var_oid]])) (of_sub l_cons)))])) - ]) expr)" - -definition "print_infra_instantiation_universe expr = start_map O.instantiation - [ let oid_of = \<open>oid_of\<close> in - Instantiation \<open>\<AA>\<close> oid_of - (Term_rewrite - (Term_basic [oid_of]) - \<open>=\<close> - (Term_function (map_class (\<lambda>isub_name name _ _ _ _. - let esc = (\<lambda>h. Term_basic (h # [name])) in - (esc (isub_name datatype_in), esc oid_of)) expr))) ]" - - -definition "print_instantia_def_strictrefeq_name mk_strict name = mk_strict [\<open>_\<close>, String.isub name]" -definition "print_instantia_def_strictrefeq = start_map O.overloading o - map_class (\<lambda>isub_name name _ _ _ _. - let mk_strict = (\<lambda>l. S.flatten (\<open>StrictRefEq\<close> # String.isub \<open>Object\<close> # l)) - ; s_strict = mk_strict [\<open>_\<close>, String.isub name] - ; var_x = \<open>x\<close> - ; var_y = \<open>y\<close> in - Overloading' - \<open>StrictRefEq\<close> - (Ty_arrow' (Ty_arrow' (Ty_paren (Typ_base (wrap_oclty name))))) - (print_instantia_def_strictrefeq_name mk_strict name) - (Term_rewrite (Term_binop (Term_annot_ocl (Term_basic [var_x]) name) - \<open>\<doteq>\<close> - (Term_basic [var_y])) - \<open>\<equiv>\<close> - (Term_basic [mk_strict [], var_x, var_y])) )" - -definition "print_instantia_lemmas_strictrefeq = start_map' - (if activate_simp_optimization then - \<lambda>expr. - let mk_strict = (\<lambda>l. S.flatten (\<open>StrictRefEq\<close> # String.isub \<open>Object\<close> # l)) - ; name_set = map_class (\<lambda>_ name _ _ _ _. print_instantia_def_strictrefeq_name mk_strict name) expr in - case name_set of [] \<Rightarrow> [] | _ \<Rightarrow> L.map O.lemmas - [ Lemmas_simp \<open>\<close> (L.map (T.thm) name_set) ] - else (\<lambda>_. []))" - -end diff --git a/Citadelle/src/compiler/core/Floor1_iskindof.thy b/Citadelle/src/compiler/core/Floor1_iskindof.thy deleted file mode 100644 index 16da3b7b669431c9df1f081d3e7d5018fd2a043e..0000000000000000000000000000000000000000 --- a/Citadelle/src/compiler/core/Floor1_iskindof.thy +++ /dev/null @@ -1,421 +0,0 @@ -(****************************************************************************** - * 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. - ******************************************************************************) - -section\<open>Main Translation for: IsKindOf\<close> - -theory Floor1_iskindof -imports Core_init -begin - -definition "print_iskindof_consts = start_map O.consts o - map_class (\<lambda>isub_name name _ _ _ _. - Consts' (isub_name const_ocliskindof) (Typ_base ty_boolean) (const_mixfix dot_ocliskindof name))" - -definition "print_iskindof_class_name isub_name h_name = S.flatten [isub_name const_ocliskindof, \<open>_\<close>, h_name]" -definition "print_iskindof_class = start_m_gen O.overloading m_class_default - (\<lambda> _ _ next_dataty _ (isub_name, name, _). \<lambda> OclClass h_name _ _ \<Rightarrow> - [ Overloading' - (isub_name const_ocliskindof) - (Ty_arrow' (Ty_paren (Typ_base (wrap_oclty h_name)))) - (print_iskindof_class_name isub_name h_name) - (let var_x = \<open>x\<close> in - Term_rewrite - (Term_postunary (Term_annot_ocl (Term_basic [var_x]) h_name) (Term_basic [dot_iskindof name])) - \<open>\<equiv>\<close> - (let isof = (\<lambda>f name. Term_warning_parenthesis (Term_postunary (Term_basic [var_x]) (Term_basic [f name]))) in - term_binop \<open>or\<close> (isof dot_istypeof name # L.map (\<lambda> OclClass name_past _ _ \<Rightarrow> isof dot_iskindof name_past) next_dataty)))])" - -definition "print_iskindof_from_universe = start_m O.definition - (\<lambda>name _ _ l. - let const_iskindof = S.flatten [const_ocliskindof, String.isub name, \<open>_\<AA>\<close>] in - [ Definition (Term_rewrite (Term_basic [const_iskindof]) \<open>=\<close> (Term_function l)) ]) - (\<lambda> _ (_, name, _). \<lambda> OclClass h_name _ _ \<Rightarrow> - let isub_h = (\<lambda> s. s @@ String.isub h_name) in - [ ( Term_app (isub_h datatype_in) [Term_basic [h_name]] - , Term_warning_parenthesis - (Term_postunary (Term_annot_ocl (Term_applys Term_basety [Term_basic [h_name]]) - h_name) - (Term_basic [dot_iskindof name])))])" - -definition "print_iskindof_lemma_cp_set = - (if activate_simp_optimization then - map_class (\<lambda>isub_name name _ _ _ _. ((isub_name, name), name)) - else (\<lambda>_. []))" - -definition "print_iskindof_lemmas_id = start_map' (\<lambda>expr. - (let name_set = print_iskindof_lemma_cp_set expr in - case name_set of [] \<Rightarrow> [] | _ \<Rightarrow> L.map O.lemmas - [ Lemmas_simp \<open>\<close> (L.map (\<lambda>((isub_name, _), name). - T.thm (S.flatten [isub_name const_ocliskindof, \<open>_\<close>, name] )) name_set) ]))" - -definition "print_iskindof_lemma_cp = start_m'3_gen O.lemma - (\<lambda> _ _ next_dataty name1 name2 name3. - let lemma_name = S.flatten [\<open>cp_\<close>, const_ocliskindof, String.isub name1, \<open>_\<close>, name3, \<open>_\<close>, name2] - ; lemma_spec = let var_p = \<open>p\<close> in - L.map - (\<lambda>x. Term_app \<open>cp\<close> [x]) - [ Term_basic [var_p] - , Term_lam \<open>x\<close> - (\<lambda>var_x. Term_warning_parenthesis (Term_postunary - (Term_annot_ocl (Term_app var_p [Term_annot_ocl (Term_basic [var_x]) name3]) name2) - (Term_basic [dot_iskindof name1])))] - ; lem_simp1 = M.simp_only [T.thm (S.flatten [const_ocliskindof, String.isub name1, \<open>_\<close>, name2])] - ; lem_simp2 = M.simp_only [T.thm (S.flatten [\<open>cp_\<close>, const_oclistypeof, String.isub name1, \<open>_\<close>, name3, \<open>_\<close>, name2])] in - let (tac1, tac2) = - if next_dataty = [] then ([], C.by [ lem_simp1 , lem_simp2 ]) - else - ( [ [ lem_simp1 ] - , [ M.plus - [ M.rule (T.where (T.thm \<open>cpI2\<close>) [(\<open>f\<close>, Term_parenthesis (Term_basic [\<open>or\<close>]))]) - , M.plus [M.rule (T.thm \<open>allI\<close>)] - , M.rule (T.thm \<open>cp_OclOr\<close>) ]] - , [ lem_simp2 ] ] - , C.by (L.map - (\<lambda> OclClass n _ _ \<Rightarrow> M.simp_only [T.thm (S.flatten [\<open>cp_\<close>, const_ocliskindof, String.isub n, \<open>_\<close>, name3, \<open>_\<close>, name2])] ) - next_dataty)) - in Lemma lemma_name lemma_spec tac1 tac2)" - -definition "print_iskindof_lemmas_cp = start_map' - (if activate_simp_optimization then L.map O.lemmas o - (\<lambda>expr. [Lemmas_simp \<open>\<close> - (get_hierarchy_map (\<lambda>name1 name2 name3. - T.thm (S.flatten [\<open>cp_\<close>, const_ocliskindof, String.isub name1, \<open>_\<close>, name3, \<open>_\<close>, name2]) - ) (\<lambda>x. (x, x, x)) expr)]) - else (\<lambda>_. []))" - -definition "print_iskindof_lemma_strict = start_m_gen O.lemma m_class_default - (\<lambda> _ _ next_dataty _ (_, name1, _). \<lambda> OclClass name3 _ _ \<Rightarrow> - L.map (\<lambda>(name2, name2'). - Lemma - (S.flatten [const_ocliskindof, String.isub name1, \<open>_\<close>, name3, \<open>_\<close>, name2]) - [ Term_rewrite - (Term_warning_parenthesis (Term_postunary - (Term_annot_ocl (Term_basic [name2]) name3) - (Term_basic [dot_iskindof name1]))) - \<open>=\<close> - (Term_basic [name2'])] - [] - (C.by - (M.simp_only - (L.map T.thm (L.flatten - [ [S.flatten [const_ocliskindof, String.isub name1, \<open>_\<close>, name3]] - , [S.flatten [const_oclistypeof, String.isub name1, \<open>_\<close>, name3, \<open>_\<close>, name2]] - , L.map - (\<lambda> OclClass n _ _ \<Rightarrow> - S.flatten [const_ocliskindof, String.isub n, \<open>_\<close>, name3, \<open>_\<close>, name2]) - next_dataty ])) - # (if next_dataty = [] then [] else [M.simp])) )) - [(\<open>invalid\<close>,\<open>invalid\<close>),(\<open>null\<close>,\<open>true\<close>)])" - -definition "print_iskindof_lemmas_strict = start_map' - (if activate_simp_optimization then L.map O.lemmas o - (\<lambda>expr. [ Lemmas_simp \<open>\<close> (get_hierarchy_map (\<lambda>name1 name2 name3. - T.thm (S.flatten [const_ocliskindof, String.isub name1, \<open>_\<close>, name3, \<open>_\<close>, name2]) - ) (\<lambda>x. (x, [\<open>invalid\<close>,\<open>null\<close>], x)) expr)]) - else (\<lambda>_. []))" - -definition "print_iskindof_defined_name isub_name h_name = S.flatten [isub_name const_ocliskindof, \<open>_\<close>, h_name, \<open>_defined\<close>]" -definition "print_iskindof_defined = start_m_gen O.lemma m_class_default - (\<lambda> _ _ next_dataty _ (isub_name, name, _). \<lambda> OclClass h_name _ _ \<Rightarrow> - let var_X = \<open>X\<close> - ; var_isdef = \<open>isdef\<close> - ; f = \<lambda>symb e. Term_binop (Term_basic [\<open>\<tau>\<close>]) \<open>\<Turnstile>\<close> (Term_app symb [e]) in - [ Lemma_assumes - (print_iskindof_defined_name isub_name h_name) - [(var_isdef, False, f \<open>\<upsilon>\<close> (Term_basic [var_X]))] - (f \<open>\<delta>\<close> (Term_postunary (Term_annot_ocl (Term_basic [var_X]) h_name) (Term_basic [dot_iskindof name]))) - [] - (C.by [ M.simp_only [T.thm (S.flatten [isub_name const_ocliskindof, \<open>_\<close>, h_name])] - , M.rule - (let mk_OF = \<lambda>f. T.OF (T.thm (f h_name)) (T.thm var_isdef) in - List.fold - (\<lambda> OclClass n _ _ \<Rightarrow> \<lambda> prf. - T.OF_l - (T.thm \<open>defined_or_I\<close>) - [ prf - , mk_OF (print_iskindof_defined_name (\<lambda>name. name @@ String.isub n))]) - next_dataty - (mk_OF (print_istypeof_defined_name isub_name))) ])])" - -definition "print_iskindof_defined'_name isub_name h_name = S.flatten [isub_name const_ocliskindof, \<open>_\<close>, h_name, \<open>_defined'\<close>]" -definition "print_iskindof_defined' = start_m O.lemma m_class_default - (\<lambda> _ (isub_name, name, _). \<lambda> OclClass h_name _ _ \<Rightarrow> - let var_X = \<open>X\<close> - ; var_isdef = \<open>isdef\<close> - ; f = \<lambda>e. Term_binop (Term_basic [\<open>\<tau>\<close>]) \<open>\<Turnstile>\<close> (Term_app \<open>\<delta>\<close> [e]) in - [ Lemma_assumes - (print_iskindof_defined'_name isub_name h_name) - [(var_isdef, False, f (Term_basic [var_X]))] - (f (Term_postunary (Term_annot_ocl (Term_basic [var_X]) h_name) (Term_basic [dot_iskindof name]))) - [] - (C.by [M.rule (T.OF (T.thm (print_iskindof_defined_name isub_name h_name)) - (T.THEN (T.thm var_isdef) (T.thm \<open>foundation20\<close>)))]) ])" - -definition "print_iskindof_up_eq_asty = start_map O.lemma o map_class_gen_h''''' - (\<lambda> _ name l_attr _ l_subtree next_dataty. - let var_X = \<open>X\<close> - ; var_isdef = \<open>isdef\<close> - ; f = Term_binop (Term_basic [\<open>\<tau>\<close>]) \<open>\<Turnstile>\<close> in - [Lemma_assumes - (print_iskindof_up_eq_asty_name name) - [(var_isdef, False, f (Term_app \<open>\<delta>\<close> [Term_basic [var_X]]))] - (f (Term_warning_parenthesis (Term_postunary - (Term_annot_ocl (Term_basic [var_X]) name) - (Term_basic [dot_iskindof name])))) - (L.map C.apply - [ [ M.simp_only [T.thm (hol_definition \<open>OclValid\<close>)] - , M.insert [T.thm var_isdef]] - , L.flatten (fst (L.mapM - (\<lambda> OclClass n _ next \<Rightarrow> \<lambda>accu. - let (l_subst, accu) = L.mapM (\<lambda> _ (cpt, l_sub). - let l_sub = String.natural_to_digit10 cpt # l_sub in - ( M.subst_l - l_sub (* subst could fail without the list of integers *) - (T.thm \<open>cp_OclOr\<close>) - , Succ cpt - , l_sub)) next accu in - ( M.simp_only [T.thm (S.flatten [const_ocliskindof, String.isub n, \<open>_\<close>, name])] - # l_subst - , accu)) - (OclClass name l_attr next_dataty # rev l_subtree) (1, []))) - , [ M.auto_simp_add_split - (let l = L.map T.thm (L.flatten ( [\<open>foundation16\<close>, hol_definition \<open>bot_option\<close>] - # L.map - (\<lambda> OclClass n _ _ \<Rightarrow> [S.flatten [const_oclistypeof, String.isub n, \<open>_\<close>, name]]) - l_subtree)) in - if l_subtree = [] then l else T.symmetric (T.thm \<open>cp_OclOr\<close>) # l) - (\<open>option.split\<close> # L.flatten (split_ty name # L.map (\<lambda> OclClass n _ _ \<Rightarrow> split_ty n) l_subtree))]]) - (C.by [M.option [M.simp_all_add (L.map hol_definition [\<open>false\<close>, \<open>true\<close>, \<open>OclOr\<close>, \<open>OclAnd\<close>, \<open>OclNot\<close>])]])])" - -definition "print_iskindof_up_larger = start_map O.lemma o - map_class_nupl2''_inh (\<lambda>name_pers name_any name_pred. - let var_X = \<open>X\<close> - ; var_isdef = \<open>isdef\<close> - ; f = Term_binop (Term_basic [\<open>\<tau>\<close>]) \<open>\<Turnstile>\<close> - ; disjI1 = \<open>foundation25\<close> - ; disjI2 = \<open>foundation25'\<close> in - Lemma_assumes - (print_iskindof_up_larger_name name_pers name_any) - [(var_isdef, False, f (Term_app \<open>\<delta>\<close> [Term_basic [var_X]]))] - (f (Term_warning_parenthesis (Term_postunary - (Term_annot_ocl (Term_basic [var_X]) name_pers) - (Term_basic [dot_iskindof name_any])))) - [C.apply [M.simp_only [T.thm (S.flatten [const_ocliskindof, String.isub name_any, \<open>_\<close>, name_pers])]] ] - (C.by - (case - fst (List.fold (\<lambda> cl. \<lambda> (l, True) \<Rightarrow> (l, True) - | (l, False) \<Rightarrow> - let v = - case cl of (OclClass n _ _, inh) \<Rightarrow> - if n = name_pers then - Some (print_iskindof_up_eq_asty_name name_pers) - else if inh then - Some (print_iskindof_up_larger_name name_pers n) - else None in - (v # l, v \<noteq> None)) - (rev (* priority of '_ or _' is right to left so we reverse *) name_pred) - ([], False)) - of Some meth_last # l \<Rightarrow> - L.map M.rule - (L.flatten [ L.map (\<lambda>_. T.thm disjI1) l - , [ T.thm disjI2] - , [ T.OF (T.thm meth_last) (T.thm var_isdef)] ]))))" - -datatype ('a, 'b) print_iskindof_up_istypeof_output - = M_simp_only 'a - | M_erule 'b - | M_simp\<^sub>d\<^sub>e\<^sub>p\<^sub>t\<^sub>h\<^sub>_\<^sub>1 (* simp add: iskin *) - | M_simp\<^sub>d\<^sub>e\<^sub>p\<^sub>t\<^sub>h\<^sub>_\<^sub>2 - | M_simp\<^sub>b\<^sub>r\<^sub>e\<^sub>a\<^sub>d\<^sub>t\<^sub>h - -fun aux\<^sub>d\<^sub>e\<^sub>p\<^sub>t\<^sub>h -and aux\<^sub>b\<^sub>r\<^sub>e\<^sub>a\<^sub>d\<^sub>t\<^sub>h where - "aux\<^sub>d\<^sub>e\<^sub>p\<^sub>t\<^sub>h l\<^sub>d\<^sub>e\<^sub>p\<^sub>t\<^sub>h = - (\<lambda> [] \<Rightarrow> [] - | (class, l\<^sub>b\<^sub>r\<^sub>e\<^sub>a\<^sub>d\<^sub>t\<^sub>h) # l\<^sub>d\<^sub>e\<^sub>p\<^sub>t\<^sub>h \<Rightarrow> - M_simp_only class - # aux\<^sub>b\<^sub>r\<^sub>e\<^sub>a\<^sub>d\<^sub>t\<^sub>h class [] l\<^sub>d\<^sub>e\<^sub>p\<^sub>t\<^sub>h (rev l\<^sub>b\<^sub>r\<^sub>e\<^sub>a\<^sub>d\<^sub>t\<^sub>h)) - l\<^sub>d\<^sub>e\<^sub>p\<^sub>t\<^sub>h" - | "aux\<^sub>b\<^sub>r\<^sub>e\<^sub>a\<^sub>d\<^sub>t\<^sub>h class tactic l\<^sub>d\<^sub>e\<^sub>p\<^sub>t\<^sub>h l\<^sub>b\<^sub>r\<^sub>e\<^sub>a\<^sub>d\<^sub>t\<^sub>h = - (\<lambda> [] \<Rightarrow> tactic - | (class0, class0_path_inh) # l\<^sub>b\<^sub>r\<^sub>e\<^sub>a\<^sub>d\<^sub>t\<^sub>h \<Rightarrow> - M_erule (class, class0 # map fst l\<^sub>b\<^sub>r\<^sub>e\<^sub>a\<^sub>d\<^sub>t\<^sub>h) - # (if l\<^sub>b\<^sub>r\<^sub>e\<^sub>a\<^sub>d\<^sub>t\<^sub>h = [] then (#) M_simp\<^sub>b\<^sub>r\<^sub>e\<^sub>a\<^sub>d\<^sub>t\<^sub>h else id) - (aux\<^sub>b\<^sub>r\<^sub>e\<^sub>a\<^sub>d\<^sub>t\<^sub>h - class - ( (if class0_path_inh then - (if l\<^sub>d\<^sub>e\<^sub>p\<^sub>t\<^sub>h = [] then (#) M_simp\<^sub>d\<^sub>e\<^sub>p\<^sub>t\<^sub>h\<^sub>_\<^sub>1 else id) - (aux\<^sub>d\<^sub>e\<^sub>p\<^sub>t\<^sub>h l\<^sub>d\<^sub>e\<^sub>p\<^sub>t\<^sub>h) - else [M_simp\<^sub>d\<^sub>e\<^sub>p\<^sub>t\<^sub>h\<^sub>_\<^sub>2]) - @ tactic) - l\<^sub>d\<^sub>e\<^sub>p\<^sub>t\<^sub>h - l\<^sub>b\<^sub>r\<^sub>e\<^sub>a\<^sub>d\<^sub>t\<^sub>h)) - l\<^sub>b\<^sub>r\<^sub>e\<^sub>a\<^sub>d\<^sub>t\<^sub>h" - -definition "print_iskindof_up_istypeof_erule var_isdef next_dataty name_pers name_any = - (let mk_OF = \<lambda>f. T.OF (T.thm (f name_any)) (T.thm var_isdef) - ; next_dataty = case next_dataty of x # xs \<Rightarrow> - rev ((\<open>foundation26\<close>, x) # L.map (Pair \<open>defined_or_I\<close>) xs) in - M.erule (List.fold - (\<lambda> (rule_name, OclClass n _ _) \<Rightarrow> \<lambda> prf. - T.OF_l - (T.thm rule_name) - [ prf - , mk_OF (print_iskindof_defined'_name (\<lambda>name. name @@ String.isub n))]) - next_dataty - (mk_OF (print_istypeof_defined'_name (\<lambda>name. name @@ String.isub name_pers)))))" - -definition "print_iskindof_up_istypeof_unfold_name name_pers name_any = S.flatten [\<open>not_\<close>, const_ocliskindof, String.isub name_pers, \<open>_then_\<close>, name_any, \<open>_\<close>, const_oclistypeof, \<open>_others_unfold\<close>]" -definition "print_iskindof_up_istypeof_unfold = start_m_gen O.lemma m_class_default - (\<lambda> _ name_pred0 next_dataty compare (isub_name, name_pers, _). \<lambda> OclClass name_any _ _ \<Rightarrow> - if compare = GT then - let var_X = \<open>X\<close> - ; var_iskin = \<open>iskin\<close> - ; var_isdef = \<open>isdef\<close> - ; f = \<lambda>f. f o Term_parenthesis o Term_binop (Term_basic [\<open>\<tau>\<close>]) \<open>\<Turnstile>\<close> in - [ Lemma_assumes - (print_iskindof_up_istypeof_unfold_name name_pers name_any) - [(var_isdef, False, f id (Term_app \<open>\<delta>\<close> [Term_basic [var_X]])) - ,(var_iskin, False, f id (Term_warning_parenthesis (Term_postunary - (Term_annot_ocl (Term_basic [var_X]) name_any) - (Term_basic [dot_iskindof name_pers]))))] - (term_binop' \<open>\<or>\<close> - (L.flatten - (L.map (\<lambda>(f_dot, l). L.map - (\<lambda>name_pred. f id (Term_warning_parenthesis (Term_postunary - (Term_annot_ocl (Term_basic [var_X]) name_any) - (Term_basic [f_dot name_pred])))) l) - [ (dot_istypeof, name_pers # L.map (\<lambda> OclClass n _ _ \<Rightarrow> n) name_pred0) ]))) - (C.using [T.thm var_iskin] - # C.apply [M.simp_only [T.thm (S.flatten [isub_name const_ocliskindof, \<open>_\<close>, name_any])]] - # (if next_dataty = [] then [] else L.flatten - [ fst (L.mapM - (\<lambda>_ next_dataty. - ( C.apply [print_iskindof_up_istypeof_erule var_isdef next_dataty name_pers name_any] - , tl next_dataty)) - next_dataty - (rev next_dataty)) - , [ C.apply [M.simp] ] - , L.map (\<lambda> OclClass n _ _ \<Rightarrow> - C.apply [M.drule (T.OF (T.thm (print_iskindof_up_istypeof_unfold_name n name_any)) (T.thm var_isdef)), M.blast None]) next_dataty ])) - C.done ] - else [])" - -definition "print_iskindof_up_istypeof_name name_pers name_any = S.flatten [\<open>not_\<close>, const_ocliskindof, String.isub name_pers, \<open>_then_\<close>, name_any, \<open>_\<close>, const_oclistypeof, \<open>_others\<close>]" -definition "print_iskindof_up_istypeof = start_map O.lemma o - map_class_nupl2l'_inh (\<lambda>name_pers name_pred0. - case name_pred0 of (name_any, _) # name_pred \<Rightarrow> - let name_any = case Inh name_any of OclClass name_any _ _ \<Rightarrow> name_any - ; var_X = \<open>X\<close> - ; var_iskin = \<open>iskin\<close> - ; var_isdef = \<open>isdef\<close> - ; f = \<lambda>f. f o Term_binop (Term_basic [\<open>\<tau>\<close>]) \<open>\<Turnstile>\<close> in - Lemma_assumes - (print_iskindof_up_istypeof_name name_pers name_any) - [(var_iskin, False, f (Term_preunary (Term_basic [\<open>\<not>\<close>])) (Term_warning_parenthesis (Term_postunary - (Term_annot_ocl (Term_basic [var_X]) name_any) - (Term_basic [dot_iskindof name_pers])))) - ,(var_isdef, False, f id (Term_app \<open>\<delta>\<close> [Term_basic [var_X]]))] - (term_binop' \<open>\<or>\<close> - (L.flatten - (L.map (\<lambda>(f_dot, l). L.map - (\<lambda>name_pred. f id (Term_warning_parenthesis (Term_postunary - (Term_annot_ocl (Term_basic [var_X]) name_any) - (Term_basic [f_dot name_pred])))) l) - [ (dot_istypeof, L.map (\<lambda> (name_pred, _). case Inh name_pred of OclClass n _ _ \<Rightarrow> n) name_pred0) - , (dot_iskindof, L.flatten (L.map (\<lambda> (name_pred, _). case Inh_sib_unflat name_pred of l \<Rightarrow> L.map (\<lambda> OclClass n _ _ \<Rightarrow> n) l) name_pred0)) ]))) - (C.using [T.OF (T.thm (print_iskindof_up_eq_asty_name name_any)) (T.thm var_isdef)] - # L.map (\<lambda>x. C.apply [x]) - (L.map - (\<lambda> M_simp_only name_pred \<Rightarrow> M.simp_only [T.thm (print_iskindof_class_name (\<lambda>s. s @@ String.isub name_pred) name_any)] - | M_erule (name_pred, next_dataty) \<Rightarrow> - print_iskindof_up_istypeof_erule var_isdef next_dataty name_pred name_any - | M_simp\<^sub>d\<^sub>e\<^sub>p\<^sub>t\<^sub>h\<^sub>_\<^sub>1 \<Rightarrow> M.simp_add [var_iskin] - | _ \<Rightarrow> M.simp) - (aux\<^sub>d\<^sub>e\<^sub>p\<^sub>t\<^sub>h (L.map (map_prod (\<lambda>class. case Inh class of OclClass class _ _ \<Rightarrow> class) id) - name_pred0)))) - C.done)" - -definition "print_iskindof_up_d_cast = start_map O.lemma o - map_class_nupl3'_LE'_inh (\<lambda>name_pers name_mid name_pred0. - case name_pred0 of (name_any, _) # name_pred \<Rightarrow> - let name_any = case Inh name_any of OclClass name_any _ _ \<Rightarrow> name_any - ; var_X = \<open>X\<close> - ; var_iskin = \<open>iskin\<close> - ; var_isdef = \<open>isdef\<close> - ; f = \<lambda>f. f o Term_binop (Term_basic [\<open>\<tau>\<close>]) \<open>\<Turnstile>\<close> in - Lemma_assumes - (S.flatten [\<open>down_cast_kind\<close>, String.isub name_mid, \<open>_from_\<close>, name_any, \<open>_to_\<close>, name_pers]) - [(var_iskin, False, f (Term_preunary (Term_basic [\<open>\<not>\<close>])) (Term_warning_parenthesis (Term_postunary - (Term_annot_ocl (Term_basic [var_X]) name_any) - (Term_basic [dot_iskindof name_mid])))) - ,(var_isdef, False, f id (Term_app \<open>\<delta>\<close> [Term_basic [var_X]]))] - (f id (Term_binop (Term_warning_parenthesis (Term_postunary - (Term_basic [var_X]) - (Term_basic [dot_astype name_pers])) - ) \<open>\<triangleq>\<close> (Term_basic [\<open>invalid\<close>]))) - (L.flatten - (let name_pred_inh = L.map (\<lambda> (name_pred, _). Inh name_pred) name_pred0 - ; name_pred_inh_sib_gen = L.flatten (L.map (\<lambda> (name_pred, _). case Inh_sib name_pred of l \<Rightarrow> l) name_pred0) - ; name_pred_inh_sib = L.map fst name_pred_inh_sib_gen - ; f0 = \<lambda>name_pred. let name_pred = case name_pred of OclClass n _ _ \<Rightarrow> n in - [ M.rule (T.thm (print_istypeof_up_d_cast_name name_pred name_any name_pers)) - , M.simp_only [] (* FIXME use wildcard *) - , M.simp_only [T.thm var_isdef]] in - [ C.apply ( M.insert [T.OF_l (T.thm (print_iskindof_up_istypeof_name name_mid name_any)) (L.map T.thm [var_iskin, var_isdef])] - # (case L.flatten [ name_pred_inh, name_pred_inh_sib ] - of [] \<Rightarrow> [] | [_] \<Rightarrow> [] | _ \<Rightarrow> [ M.elim (T.thm \<open>disjE\<close>) ]))] - # L.map (C.apply o f0) name_pred_inh - # L.map (\<lambda> (OclClass name_pred l_attr next_d, l_subtree) \<Rightarrow> - L.map C.apply - [ [ M.drule (T.OF (T.thm (print_iskindof_up_istypeof_unfold_name name_pred name_any)) (T.thm var_isdef))] - , if next_d = [] then - f0 (OclClass name_pred l_attr next_d) - else - [ M.auto_simp_add - (var_isdef # L.map - (\<lambda> OclClass name_pred _ _ \<Rightarrow> - print_istypeof_up_d_cast_name name_pred name_any name_pers) - l_subtree)] ]) - name_pred_inh_sib_gen)) - C.done)" - -end diff --git a/Citadelle/src/compiler/core/Floor1_istypeof.thy b/Citadelle/src/compiler/core/Floor1_istypeof.thy deleted file mode 100644 index b1fefe9672aa7c2f3a699c8cad7143bca8a9990a..0000000000000000000000000000000000000000 --- a/Citadelle/src/compiler/core/Floor1_istypeof.thy +++ /dev/null @@ -1,246 +0,0 @@ -(****************************************************************************** - * 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. - ******************************************************************************) - -section\<open>Main Translation for: IsTypeOf\<close> - -theory Floor1_istypeof -imports Core_init -begin - -definition "print_istypeof_consts = start_map O.consts o - map_class (\<lambda>isub_name name _ _ _ _. - Consts' (isub_name const_oclistypeof) (Typ_base ty_boolean) (const_mixfix dot_oclistypeof name))" - -definition "print_istypeof_class = start_m_gen O.overloading m_class_default - (\<lambda> l_inh _ _ compare (isub_name, name, _). \<lambda> OclClass h_name hl_attr h_last \<Rightarrow> - [Overloading' - (isub_name const_oclistypeof) - (Ty_arrow' (Ty_paren (Typ_base (wrap_oclty h_name)))) - (S.flatten [isub_name const_oclistypeof, \<open>_\<close>, h_name]) - (let var_x = \<open>x\<close> in - Term_rewrite - (Term_postunary (Term_annot_ocl (Term_basic [var_x]) h_name) (Term_basic [dot_istypeof name])) - \<open>\<equiv>\<close> - (Term_lam \<open>\<tau>\<close> - (\<lambda>var_tau. let app_tau = (\<lambda>v. Term_app v [Term_basic [var_tau]]) in - Term_case - (app_tau var_x) - ( (Term_basic [\<open>\<bottom>\<close>], app_tau \<open>invalid\<close>) - # (Term_some (Term_basic [\<open>\<bottom>\<close>]), app_tau \<open>true\<close>) - # (let l_false = [(Term_basic [wildcard], app_tau \<open>false\<close>)] - ; pattern_complex_gen = (\<lambda>f1 f2. - let isub_h = (\<lambda> s. s @@ String.isub h_name) in - (Term_some (Term_some - (Term_app (isub_h datatype_constr_name) - ( Term_app (f2 (\<lambda>s. isub_name (s @@ \<open>_\<close>)) (isub_h datatype_ext_constr_name)) - (Term_basic [wildcard] # f1) - # L.map (\<lambda>_. Term_basic [wildcard]) hl_attr))), app_tau \<open>true\<close>) - # (if h_last = [] then [] else l_false)) in - case compare - of EQ \<Rightarrow> pattern_complex_gen (L.flatten (L.map (L.map (\<lambda>_. Term_basic [wildcard]) o (\<lambda> OclClass _ l _ \<Rightarrow> l)) (of_linh l_inh))) (\<lambda>_. id) - | GT \<Rightarrow> pattern_complex_gen [] id - | _ \<Rightarrow> l_false) ) )))] )" - -definition "print_istypeof_from_universe = start_m O.definition - (\<lambda> name _ _ l. - let const_istypeof = S.flatten [const_oclistypeof, String.isub name, \<open>_\<AA>\<close>] in - [ Definition (Term_rewrite (Term_basic [const_istypeof]) \<open>=\<close> (Term_function l))]) - (\<lambda>_ (_, name, _). \<lambda> OclClass h_name _ _ \<Rightarrow> - let isub_h = (\<lambda> s. s @@ String.isub h_name) in - [( Term_app (isub_h datatype_in) [Term_basic [h_name]] - , Term_warning_parenthesis - (Term_postunary (Term_annot_ocl (Term_applys Term_basety [Term_basic [h_name]]) - h_name) - (Term_basic [dot_istypeof name])))])" - -definition "print_istypeof_lemma_cp_set = - (if activate_simp_optimization then - map_class (\<lambda>isub_name name _ _ _ _. ((isub_name, name), name)) - else (\<lambda>_. []))" - -definition "print_istypeof_lemmas_id = start_map' (\<lambda>expr. - (let name_set = print_istypeof_lemma_cp_set expr in - case name_set of [] \<Rightarrow> [] | _ \<Rightarrow> L.map O.lemmas - [ Lemmas_simp \<open>\<close> (L.map (\<lambda>((isub_name, _), name). - T.thm (S.flatten [isub_name const_oclistypeof, \<open>_\<close>, name] )) name_set) ]))" - -definition "print_istypeof_lemma_cp expr = (start_map O.lemma o - (get_hierarchy_map ( - let check_opt = - let set = print_istypeof_lemma_cp_set expr in - (\<lambda>n1 n2. list_ex (\<lambda>((_, name1), name2). name1 = n1 & name2 = n2) set) in - (\<lambda>name1 name2 name3. - Lemma - (S.flatten [\<open>cp_\<close>, const_oclistypeof, String.isub name1, \<open>_\<close>, name3, \<open>_\<close>, name2]) - (let var_p = \<open>p\<close> in - L.map - (\<lambda>x. Term_app \<open>cp\<close> [x]) - [ Term_basic [var_p] - , Term_lam \<open>x\<close> - (\<lambda>var_x. Term_warning_parenthesis (Term_postunary - (Term_annot_ocl (Term_app var_p [Term_annot_ocl (Term_basic [var_x]) name3]) name2) - (Term_basic [dot_istypeof name1])))]) - [] - (C.by [M.rule (T.thm \<open>cpI1\<close>), if check_opt name1 name2 then M.simp - else M.simp_add [S.flatten [const_oclistypeof, String.isub name1, \<open>_\<close>, name2]]]) - )) (\<lambda>x. (x, x, x))) ) expr" - -definition "print_istypeof_lemmas_cp = start_map' - (if activate_simp_optimization then L.map O.lemmas o - (\<lambda>expr. [Lemmas_simp \<open>\<close> - (get_hierarchy_map (\<lambda>name1 name2 name3. - T.thm (S.flatten [\<open>cp_\<close>, const_oclistypeof, String.isub name1, \<open>_\<close>, name3, \<open>_\<close>, name2])) - (\<lambda>x. (x, x, x)) expr)]) - else (\<lambda>_. []))" - -definition "print_istypeof_lemma_strict expr = (start_map O.lemma o - get_hierarchy_map ( - let check_opt = - let set = print_istypeof_lemma_cp_set expr in - (\<lambda>n1 n2. list_ex (\<lambda>((_, name1), name2). name1 = n1 & name2 = n2) set) in - (\<lambda>name1 (name2,name2') name3. - Lemma - (S.flatten [const_oclistypeof, String.isub name1, \<open>_\<close>, name3, \<open>_\<close>, name2]) - [ Term_rewrite - (Term_warning_parenthesis (Term_postunary - (Term_annot_ocl (Term_basic [name2]) name3) - (Term_basic [dot_istypeof name1]))) - \<open>=\<close> - (Term_basic [name2'])] - [] - (C.by (let l = L.map hol_definition (\<open>bot_option\<close> # (if name2 = \<open>invalid\<close> then [\<open>invalid\<close>] - else [\<open>null_fun\<close>,\<open>null_option\<close>])) in - [M.rule (T.thm \<open>ext\<close>), M.simp_add (if check_opt name1 name3 then l - else S.flatten [const_oclistypeof, String.isub name1, \<open>_\<close>, name3] # l)])) - )) (\<lambda>x. (x, [(\<open>invalid\<close>,\<open>invalid\<close>),(\<open>null\<close>,\<open>true\<close>)], x))) expr" - -definition "print_istypeof_lemmas_strict_set = - (if activate_simp_optimization then - get_hierarchy_map (\<lambda>name1 name2 name3. (name1, name3, name2)) (\<lambda>x. (x, [\<open>invalid\<close>,\<open>null\<close>], x)) - else (\<lambda>_. []))" - -definition "print_istypeof_lemmas_strict expr = start_map O.lemmas - (case print_istypeof_lemmas_strict_set expr - of [] \<Rightarrow> [] - | l \<Rightarrow> [ Lemmas_simp \<open>\<close> (L.map - (\<lambda>(name1, name3, name2). - T.thm (S.flatten [const_oclistypeof, String.isub name1, \<open>_\<close>, name3, \<open>_\<close>, name2])) - l) ])" - -definition "print_istypeof_defined = start_m O.lemma m_class_default - (\<lambda> _ (isub_name, name, _). \<lambda> OclClass h_name _ _ \<Rightarrow> - let var_X = \<open>X\<close> - ; var_isdef = \<open>isdef\<close> - ; f = \<lambda>symb e. Term_binop (Term_basic [\<open>\<tau>\<close>]) \<open>\<Turnstile>\<close> (Term_app symb [e]) in - [ Lemma_assumes - (print_istypeof_defined_name isub_name h_name) - [(var_isdef, False, f \<open>\<upsilon>\<close> (Term_basic [var_X]))] - (f \<open>\<delta>\<close> (Term_postunary (Term_annot_ocl (Term_basic [var_X]) h_name) (Term_basic [dot_istypeof name]))) - [C.apply [M.insert [T.simplified (T.thm var_isdef) (T.thm \<open>foundation18'\<close>) ] - ,M.simp_only [T.thm (hol_definition \<open>OclValid\<close>)] - ,M.subst (T.thm \<open>cp_defined\<close>)]] - (C.by [M.auto_simp_add_split ( T.symmetric (T.thm \<open>cp_defined\<close>) - # L.map T.thm ( hol_definition \<open>bot_option\<close> - # [ S.flatten [isub_name const_oclistypeof, \<open>_\<close>, h_name] ])) - (\<open>option.split\<close> # split_ty h_name) ]) ])" - -definition "print_istypeof_defined' = start_m O.lemma m_class_default - (\<lambda> _ (isub_name, name, _). \<lambda> OclClass h_name _ _ \<Rightarrow> - let var_X = \<open>X\<close> - ; var_isdef = \<open>isdef\<close> - ; f = \<lambda>e. Term_binop (Term_basic [\<open>\<tau>\<close>]) \<open>\<Turnstile>\<close> (Term_app \<open>\<delta>\<close> [e]) in - [ Lemma_assumes - (print_istypeof_defined'_name isub_name h_name) - [(var_isdef, False, f (Term_basic [var_X]))] - (f (Term_postunary (Term_annot_ocl (Term_basic [var_X]) h_name) (Term_basic [dot_istypeof name]))) - [] - (C.by [M.rule (T.OF (T.thm (print_istypeof_defined_name isub_name h_name)) - (T.THEN (T.thm var_isdef) (T.thm \<open>foundation20\<close>)))]) ])" - -definition "print_istypeof_up_larger_name name_pers name_any = S.flatten [\<open>actualType\<close>, String.isub name_pers, \<open>_larger_staticType\<close>, String.isub name_any]" -definition "print_istypeof_up_larger = start_map O.lemma o - map_class_nupl2'_inh_large (\<lambda>name_pers name_any. - let var_X = \<open>X\<close> - ; var_isdef = \<open>isdef\<close> - ; f = Term_binop (Term_basic [\<open>\<tau>\<close>]) \<open>\<Turnstile>\<close> in - Lemma_assumes - (print_istypeof_up_larger_name name_pers name_any) - [(var_isdef, False, f (Term_app \<open>\<delta>\<close> [Term_basic [var_X]]))] - (f (Term_binop (Term_warning_parenthesis (Term_postunary - (Term_annot_ocl (Term_basic [var_X]) name_pers) - (Term_basic [dot_istypeof name_any])) - ) \<open>\<triangleq>\<close> (Term_basic [\<open>false\<close>]))) - [C.using [T.thm var_isdef]] - (C.by [M.auto_simp_add ( S.flatten [const_oclistypeof, String.isub name_any, \<open>_\<close>, name_pers] - # \<open>foundation22\<close> - # \<open>foundation16\<close> - # L.map hol_definition [\<open>null_option\<close>, \<open>bot_option\<close> ])]))" - -definition "print_istypeof_up_d_cast expr = (start_map O.lemma o - map_class_nupl3'_GE_inh (\<lambda>name_pers name_mid name_any. - let var_X = \<open>X\<close> - ; var_istyp = \<open>istyp\<close> - ; var_isdef = \<open>isdef\<close> - ; f = Term_binop (Term_basic [\<open>\<tau>\<close>]) \<open>\<Turnstile>\<close> in - Lemma_assumes - (print_istypeof_up_d_cast_name name_mid name_any name_pers) - [(var_istyp, False, f (Term_warning_parenthesis (Term_postunary - (Term_annot_ocl (Term_basic [var_X]) name_any) - (Term_basic [dot_istypeof name_mid])))) - ,(var_isdef, False, f (Term_app \<open>\<delta>\<close> [Term_basic [var_X]]))] - (f (Term_binop (Term_warning_parenthesis (Term_postunary - (Term_basic [var_X]) - (Term_basic [dot_astype name_pers])) - ) \<open>\<triangleq>\<close> (Term_basic [\<open>invalid\<close>]))) - [C.using (L.map T.thm [var_istyp, var_isdef]) - ,C.apply [M.auto_simp_add_split (L.map T.thm - ( S.flatten [const_oclastype, String.isub name_pers, \<open>_\<close>, name_any] - # \<open>foundation22\<close> - # \<open>foundation16\<close> - # L.map hol_definition [\<open>null_option\<close>, \<open>bot_option\<close> ])) - (split_ty name_any) ]] - (C.by [M.simp_add (let l = L.map hol_definition [\<open>OclValid\<close>, \<open>false\<close>, \<open>true\<close>] in - if name_mid = name_any & ~(print_istypeof_lemma_cp_set expr = []) then - l - else - S.flatten [const_oclistypeof, String.isub name_mid, \<open>_\<close>, name_any] # l)]))) expr" - -end diff --git a/Citadelle/src/compiler/core/Floor2_ctxt.thy b/Citadelle/src/compiler/core/Floor2_ctxt.thy deleted file mode 100644 index b2b2d554800e4faefda9e6a5c13b3143340f401c..0000000000000000000000000000000000000000 --- a/Citadelle/src/compiler/core/Floor2_ctxt.thy +++ /dev/null @@ -1,265 +0,0 @@ -(****************************************************************************** - * 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. - ******************************************************************************) - -section\<open>Main Translation for: Context (Floor 2)\<close> - -theory Floor2_ctxt -imports Core_init -begin - -(* (* ERROR this lambda term type-checks expensively *) -definition "print_ctxt_is_accessor = - (\<lambda> Type \<lless>''fun''\<ggreater> - [Type \<lless>''fun''\<ggreater> - [Type \<lless>''Product_Type.prod''\<ggreater> - [Type \<lless>''OCL_core.state.state_ext''\<ggreater> - [Type _ (* AA *) [], Type \<lless>''Product_Type.unit''\<ggreater> []], - Type \<lless>''OCL_core.state.state_ext''\<ggreater> - [Type _ (* AA *) [], Type \<lless>''Product_Type.unit''\<ggreater> []]], - TFree _ (* 'a *) [\<lless>''HOL.type''\<ggreater>]], - Type \<lless>''fun''\<ggreater> - [Type \<lless>''Product_Type.prod''\<ggreater> - [Type \<lless>''OCL_core.state.state_ext''\<ggreater> - [Type _ (* AA *) [], Type \<lless>''Product_Type.unit''\<ggreater> []], - Type \<lless>''OCL_core.state.state_ext''\<ggreater> - [Type _ (* AA *) [], Type \<lless>''Product_Type.unit''\<ggreater> []]], - Type \<lless>''Option.option''\<ggreater> - [Type \<lless>''Option.option''\<ggreater> - [Type _ (* class name *) []]]]] - \<Rightarrow> True - | _ \<Rightarrow> False)" -*) -definition "print_ctxt_is_name_at_gen var s = - (let var = String.to_list var - ; s = String.to_list s in - case var of _ # _ \<Rightarrow> - let lg_var = length var in - if (* TODO use \<triangleq> *) L.take_last lg_var s = var then - Some \<lless>L.take_first (length s - lg_var) s\<ggreater> - else - None)" - -definition "print_ctxt_is_name_at_pre = print_ctxt_is_name_at_gen var_at_when_hol_pre" -definition "print_ctxt_is_name_at_post = (case String.to_list var_at_when_hol_post of [] \<Rightarrow> - \<lambda>s. case print_ctxt_is_name_at_pre s of None \<Rightarrow> Some s - | _ \<Rightarrow> None)" - -definition "print_ctxt_to_ocl_gen_split s = - (case L.split_at (\<lambda> s. s = 0x2E) (String.to_list s) of - (_, Some _, s) \<Rightarrow> Some s - | _ \<Rightarrow> None)" -definition "print_ctxt_to_ocl_gen l_access f var = - (let l_ex = \<lambda>s. (*print_ctxt2_is_accessor ty*) - list_ex (case print_ctxt_to_ocl_gen_split s of - Some s \<Rightarrow> \<lambda>n. String\<^sub>b\<^sub>a\<^sub>s\<^sub>e.to_list n = s - | _ \<Rightarrow> \<lambda>_. False) l_access in - \<lambda> T_pure t o_s \<Rightarrow> - T_pure (Meta_Pure.map_Const (\<lambda> s _. - if l_ex s then - case f s of - Some s \<Rightarrow> s @@ var - | _ \<Rightarrow> s - else - s) t) - (if Meta_Pure.fold_Const (\<lambda> b s. b | l_ex s & f s \<noteq> None) False t then - None - else - o_s))" - -definition "print_ctxt_to_ocl_pre env = print_ctxt_to_ocl_gen (snd (D_ocl_accessor env)) print_ctxt_is_name_at_post var_at_when_hol_pre" -definition "print_ctxt_to_ocl_post env = print_ctxt_to_ocl_gen (fst (D_ocl_accessor env)) print_ctxt_is_name_at_pre var_at_when_hol_post" - -definition "raise_ml_unbound f_msg ctxt = - [ (\<lambda>_. [O.ML (raise_ml (let l = L.flatten (L.mapi (\<lambda> n. \<lambda>(msg, T_pure t _) \<Rightarrow> - let l = - rev (Meta_Pure.fold_Free (\<lambda>l s. - (Error, S.flatten [f_msg n msg, \<open>: unbound value \<close>, s]) # l) [] t) in - if l = [] then [(Writeln, f_msg n msg)] else l) ctxt) in - if list_ex (\<lambda>(Error, _) \<Rightarrow> True | _ \<Rightarrow> False) l then l else []) - \<open> error(s)\<close>)]) ]" - -definition "print_ctxt_pre_post_interp = (\<lambda>(sorry, dirty) name ctxt e_name e_pre e_post. - let a = \<lambda>f x. Term_app f [x] - ; b = \<lambda>s. Term_basic [s] - ; f = \<lambda>(pref, e). List.foldr Term_lambda (make_ctxt_free_var pref ctxt) e - ; lg = length (Ctxt_fun_ty_arg ctxt) in - if (sorry = Some Gen_sorry | sorry = None & dirty) & lg \<le> 3 then - Some (O.interpretation - (Interpretation - name - (\<open>contract\<close> @@ String.nat_to_digit10 lg) - [ e_name - , f e_pre - , f e_post ] - (*apply(unfold_locales, simp only: dot__aaa_Person Let_def, auto)*) - C.sorry)) - else - None (* not yet implemented *))" - -definition "print_ctxt_pre_post = (\<lambda>f. map_prod L.flatten id o f) o L.mapM (\<lambda>x env. (x env, env)) o (\<lambda> ctxt. - let ty_name = ty_obj_to_string (Ctxt_ty ctxt) in - L.flatten (L.map (\<lambda> (l_ctxt, ctxt). - let (l_pre, l_post) = List.partition (\<lambda> (OclCtxtPre, _) \<Rightarrow> True | _ \<Rightarrow> False) l_ctxt - ; attr_n = Ctxt_fun_name ctxt - ; a = \<lambda>f x. Term_app f [x] - ; b = \<lambda>s. Term_basic [s] - ; var_tau = \<open>\<tau>\<close> - ; f_tau = \<lambda>s. Term_warning_parenthesis (Term_binop (b var_tau) \<open>\<Turnstile>\<close> (Term_warning_parenthesis s)) - ; term_binop0 = \<lambda>base u_and. \<lambda> [] \<Rightarrow> b base | l \<Rightarrow> Term_parenthesis (term_binop u_and l) - ; to_s = \<lambda>pref f_to l_pre. - Term_parenthesis (term_binop0 \<open>true\<close> \<open>and\<close> - (L.map - (let nb_var = length (make_ctxt_free_var pref ctxt) in - (\<lambda>(_, expr) \<Rightarrow> - cross_abs (\<lambda>_. id) nb_var (case f_to expr of T_pure expr _ \<Rightarrow> expr))) l_pre)) - ; f = \<lambda> (var_at_when_hol, var_at_when_ocl). - let dot_expr = \<lambda>e f_escape. Term_postunary e (b (mk_dot_par_gen (S.flatten [\<open>.\<close>, attr_n, var_at_when_ocl]) (L.map (f_escape o fst) (Ctxt_fun_ty_arg ctxt)))) in - (\<lambda>env. - let (l_pre, l_post) = ( to_s OclCtxtPre (print_ctxt_to_ocl_pre env) l_pre - , to_s OclCtxtPost id l_post) - ; var_r = var_result - ; expr = - Term_rewrite - (dot_expr (Term_annot_ocl (b var_self) ty_name) id) - \<open>\<equiv>\<close> - (Term_lambda var_tau - (a \<open>Eps\<close> (Term_lambda var_r - (Term_app \<open>HOL.Let\<close> - [ Term_lambda \<open>_\<close> (b var_r) - , Term_lambda var_result - (Term_parenthesis (Term_if_then_else (term_binop0 \<open>True\<close> \<open>\<and>\<close> (f_tau (a \<open>\<delta>\<close> (b var_self)) # L.map (\<lambda>s. f_tau (a \<open>\<upsilon>\<close> (b (fst s)))) (Ctxt_fun_ty_arg ctxt))) - (Term_binop - (f_tau l_pre) - \<open>\<and>\<close> - (f_tau l_post)) - (f_tau (Term_rewrite (b var_result) \<open>\<triangleq>\<close> (b \<open>invalid\<close>)))))])))) - ; (name0, def) = - (if - List.fold (\<lambda> (_, T_pure t _) \<Rightarrow> \<lambda> b \<Rightarrow> - b | Meta_Pure.fold_Const (\<lambda> b s. b | (case print_ctxt_to_ocl_gen_split s of - None \<Rightarrow> False - | Some s \<Rightarrow> - let f_eq = \<lambda>a. String.to_list (print_ctxt_const_name attr_n a None) = s in - f_eq var_at_when_hol_post | f_eq var_at_when_hol_pre)) - False - t) - l_ctxt - False - then - ( print_ctxt_pre_post_name attr_n var_at_when_hol - , O.axiomatization (Axiomatization (print_ctxt_pre_post_name attr_n var_at_when_hol (Some ty_name)) expr)) - else - ( print_ctxt_const_name attr_n var_at_when_hol - , O.overloading (Overloading' (print_ctxt_const_name attr_n var_at_when_hol None) - (Ty_arrow' (Ty_paren (Typ_base (wrap_oclty ty_name)))) - (print_ctxt_const_name attr_n var_at_when_hol (Some ty_name)) - expr))) - ; name = name0 (Some ty_name) in - def - # O.thm (Thm [T.thm name]) - # (case let name = name0 None in - print_ctxt_pre_post_interp - (D_output_sorry_dirty env) - name - ctxt - (let v = b var_self in - Term_lambdas0 (Term_annot_ocl v ty_name) (a name v)) - (OclCtxtPre, l_pre) - (OclCtxtPost, l_post) of - None \<Rightarrow> [] - | Some x \<Rightarrow> [x])) - # (\<lambda>env. - L.flatten (fst (fold_class (\<lambda>_ name _ _ _ _. - Pair (if ty_name \<triangleq> name then - [] - else - let var_x = \<open>x\<close> - ; f_escape = \<lambda>s. var_x @@ String.isub s in - [ O.overloading - (Overloading' (S.flatten [ \<open>dot\<close>, String.isup attr_n, var_at_when_hol]) - (Ty_arrow' (Ty_paren (Typ_base (wrap_oclty name)))) - (S.flatten [ \<open>dot\<close>, String.isup attr_n, var_at_when_hol, \<open>_\<close>, name]) - (Term_rewrite - (dot_expr (Term_annot_ocl (b var_x) name) f_escape) - \<open>\<equiv>\<close> - (dot_expr (Term_postunary (b var_x) (b (dot_astype ty_name))) f_escape))) ])) - () - (case D_input_class env of Some class_spec \<Rightarrow> class_spec)))) - # raise_ml_unbound - (\<lambda>n pref. S.flatten [\<open>(\<close>, String.natural_to_digit10 (n + 1), \<open>) \<close>, if pref = OclCtxtPre then \<open>pre\<close> else \<open>post\<close>]) - l_ctxt in - f (var_at_when_hol_post, var_at_when_ocl_post)) - (rev (fold_pre_post (\<lambda> l c. Cons (L.map (map_prod id snd) l, c)) ctxt []))))" - -definition "print_ctxt_inv = (\<lambda>f. map_prod L.flatten id o f) o L.mapM (\<lambda>x env. (x env, env)) o L.flatten o L.flatten o (\<lambda> ctxt. - let a = \<lambda>f x. Term_app f [x] - ; b = \<lambda>s. Term_basic [s] - ; f_tau = \<lambda>s. Term_lam \<open>\<tau>\<close> (\<lambda>var_tau. Term_warning_parenthesis (Term_binop (b var_tau) \<open>\<Turnstile>\<close> s)) - ; nb_var = length (Ctxt_param ctxt) - ; Ctxt_ty_n = ty_obj_to_string (Ctxt_ty ctxt) - ; l = fold_invariant' ctxt in - - L.map (\<lambda> (tit, term) \<Rightarrow> - (L.map - (\<lambda> (allinst_at_when, var_at_when, e) \<Rightarrow> - [ (\<lambda>env. [ O.definition - (Definition (Term_rewrite - (b (print_ctxt_inv_name Ctxt_ty_n tit var_at_when)) - \<open>=\<close> - (f_tau (cross_abs (\<lambda>s x. Term_app var_OclForall_set - [ a allinst_at_when (b Ctxt_ty_n) - , Term_lambda s x]) - (Suc nb_var (* nb_var + \<open>self\<close> *)) - (case e env of T_pure e _ \<Rightarrow> e)) )))]) ]) - [(\<open>OclAllInstances_at_pre\<close>, var_at_when_hol_pre, \<lambda>env. print_ctxt_to_ocl_pre env term) - ,(\<open>OclAllInstances_at_post\<close>, var_at_when_hol_post, \<lambda>env. print_ctxt_to_ocl_post env term)]) - @@@@ [raise_ml_unbound (\<lambda>_ pref. S.flatten [\<open>inv \<close>, pref]) l]) - l)" - -definition "print_ctxt_thm ctxt = Pair - (case L.flatten (L.map (\<lambda>(tit, _). L.map (hol_definition o print_ctxt_inv_name (ty_obj_to_string (Ctxt_ty ctxt)) tit) - [ var_at_when_hol_pre - , var_at_when_hol_post ]) - (fold_invariant' ctxt)) of - [] \<Rightarrow> [] - | l \<Rightarrow> [ O.thm (Thm (L.map T.thm l)) ])" - -end diff --git a/Citadelle/src/compiler/core/Floor2_examp.thy b/Citadelle/src/compiler/core/Floor2_examp.thy deleted file mode 100644 index 0ea0343cb3f6ee135de9d28e63334f3d138437a2..0000000000000000000000000000000000000000 --- a/Citadelle/src/compiler/core/Floor2_examp.thy +++ /dev/null @@ -1,494 +0,0 @@ -(****************************************************************************** - * 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. - ******************************************************************************) - -section\<open>Main Translation for: Example (Floor 2)\<close> - -theory Floor2_examp -imports Floor1_examp -begin - -definition "init_map_class2 env l = - (let rbt_str = RBT.bulkload (L.map (\<lambda>(k, _, v). (String\<^sub>b\<^sub>a\<^sub>s\<^sub>e.to_list k, v)) (D_input_instance env)) in - ( rbt_of_class env - , RBT.lookup (fst (List.fold - (\<lambda> ocli (rbt_nat, accu). - ( case lookup rbt_str (case Inst_attr_with ocli of - None \<Rightarrow> inst_name ocli - | Some s \<Rightarrow> s) of - None \<Rightarrow> rbt_nat - | Some oid_start' \<Rightarrow> RBT.insert (Oid accu) oid_start' rbt_nat - , Succ accu)) - l - ( RBT.empty - , 0))) - , lookup rbt_str))" - -definition "merge_unique_gen f l = List.fold (List.fold (\<lambda>x. case f x of Some (x, v) \<Rightarrow> RBT.insert x v | None \<Rightarrow> id)) l RBT.empty" -definition "merge_unique f l = RBT.entries (merge_unique_gen f l)" -definition "merge_unique' f = - L.map snd - o RBT.entries - o (\<lambda>l. - List.fold - (\<lambda>((k, _), e) rbt. - RBT.insert k - (case RBT.lookup rbt k of - None \<Rightarrow> [e] - | Some l \<Rightarrow> e # l) - rbt) - l - RBT.empty) - o merge_unique (\<lambda> ((a, n), b). Some ((oidGetInh a, n), (a, b))) - o L.map (L.map (\<lambda>(oid, e) \<Rightarrow> ((oid, f e), e)))" -definition "merge_unique'' l = - L.map (L.map (map_prod id (\<lambda> OclDefCoreBinding (_, ocli) \<Rightarrow> ocli))) - (merge_unique' (\<lambda> OclDefCoreBinding (s, _) \<Rightarrow> String.to_list s) l)" - -definition "map_tail f = - (let f = map_prod (Term_oid var_oid_uniq o oidGetInh) f in - L.map (\<lambda> x # xs \<Rightarrow> - map_prod id - (\<lambda>x. L.flatten (x # L.map (snd o f) xs)) - (f x)))" - -definition "print_examp_def_st_locale_distinct = \<open>distinct_oid\<close>" -definition "print_examp_def_st_locale_metis = M.metis (L.map T.thm [print_examp_def_st_locale_distinct, \<open>distinct_length_2_or_more\<close>])" -definition "print_examp_def_st_locale_aux l = - (let b = \<lambda>s. Term_basic [s] in - map_prod - id - L.flatten - (L.split - (map_tail - (\<lambda> ocli. - let n = inst_name ocli - ; ty = inst_ty ocli - ; f = \<lambda>s. s @@ String.isub ty - ; name_pers = print_examp_instance_name f n in - [ ( [(b name_pers, Typ_base (f datatype_name))], None) - , ( [(b n, Typ_base (wrap_oclty ty))] - , Some (hol_definition n, Term_rewrite (b n) \<open>=\<close> (Term_lambda wildcard (Term_some (Term_some (b name_pers)))))) ]) - l)))" - -definition "print_examp_def_st_locale_make f_name f_spec l = - (let (oid, l_fix_assum) = print_examp_def_st_locale_aux l - ; ty_n = \<open>nat\<close> in - \<lparr> HolThyLocale_name = f_name - , HolThyLocale_header = L.flatten - [ [ ( L.map (\<lambda>x. (x, Typ_base ty_n)) oid - , Some ( print_examp_def_st_locale_distinct - , Term_app \<open>distinct\<close> [let e = Term_list oid in - if oid = [] then Term_annot' e (ty_n @@ \<open> list\<close>) else e])) ] - , l_fix_assum - , f_spec ] \<rparr>)" - -definition "print_examp_def_st_locale_sort env l = - merge_unique' (String.to_list o inst_name) - (L.map (\<lambda> OclDefCoreBinding name \<Rightarrow> case String.assoc name (D_input_instance env) of - Some n \<Rightarrow> [flip n]) l)" - -definition "filter_locale_interp = - L.split - o map_tail - (let a = \<lambda>f x. Term_app f [x] - ; b = \<lambda>s. Term_basic [s] - ; c = Term_paren \<open>\<lceil>\<close> \<open>\<rceil>\<close> - ; var_tau = \<open>\<tau>\<close> in - \<lambda> ocli \<Rightarrow> - let n = inst_name ocli in - [ c (c (a n (b var_tau))) - , b n])" - -definition "print_examp_def_st_locale_name n = \<open>state_\<close> @@ n" -definition "print_examp_def_st_locale = (\<lambda> OclDefSt n l \<Rightarrow> \<lambda>env. - (\<lambda>d. (d, env)) - (print_examp_def_st_locale_make - (print_examp_def_st_locale_name n) - [] - (print_examp_def_st_locale_sort env l)))" - -definition "print_examp_def_st_defassoc_typecheck_gen l env = - ([ raise_ml - (case - List.fold - (\<lambda> OclDefCoreBinding name \<Rightarrow> - \<lambda>(l, rbt). - ( ( (if String.assoc name (D_input_instance env) = None then - Cons (Error, name) - else - id) - o (if lookup rbt name = None then - id - else - Cons (Warning, name))) l - , insert name () rbt)) - l - ([], RBT.empty) - of - ([], _) \<Rightarrow> [] - | (l, _) \<Rightarrow> L.rev_map (\<lambda> (Error, n) \<Rightarrow> (Error, \<open>Extra variables on rhs: \<close> @@ n) - | (Warning, n) \<Rightarrow> (Warning, \<open>Duplicate variables on rhs: \<close> @@ n)) l) - \<open> error(s)\<close> ])" - -definition "print_examp_def_st_defassoc_typecheck = (\<lambda> OclDefSt _ l \<Rightarrow> \<lambda> env. - (\<lambda>l_res. (L.map O'.ML l_res, env \<lparr> D_output_header_force := True \<rparr>)) - (print_examp_def_st_defassoc_typecheck_gen - l - env))" - -definition "print_examp_def_st_mapsto_gen f = - L.map - (\<lambda>(cpt, ocore). - let b = \<lambda>s. Term_basic [s] - ; (ocli, exp) = case ocore of - OclDefCoreBinding (name, ocli) \<Rightarrow> - (ocli, Some (b (print_examp_instance_name (\<lambda>s. s @@ String.isub (inst_ty ocli)) name))) in - f (cpt, ocore) ocli exp)" - -definition "print_examp_def_st_mapsto l = L.bind id id - (print_examp_def_st_mapsto_gen - (\<lambda>(cpt, _) ocli. map_option (\<lambda>exp. - Term_binop (Term_oid var_oid_uniq (oidGetInh cpt)) \<open>\<mapsto>\<close> (Term_app (datatype_in @@ String.isub (inst_ty ocli)) [exp]))) - l)" - -definition "print_examp_def_st2 = (\<lambda> OclDefSt name l \<Rightarrow> \<lambda>env. - (\<lambda>(l, l_st). (L.map O'.definition l, env \<lparr> D_input_state := (String.to_String\<^sub>b\<^sub>a\<^sub>s\<^sub>e name, l_st) # D_input_state env \<rparr>)) - (let b = \<lambda>s. Term_basic [s] - ; l = L.map (\<lambda> OclDefCoreBinding name \<Rightarrow> map_option (Pair name) (String.assoc name (D_input_instance env))) l - ; (rbt, (map_self, map_username)) = - (init_map_class2 - env - (L.map (\<lambda> Some (_, ocli, _) \<Rightarrow> ocli | None \<Rightarrow> ocl_instance_single_empty) l) - :: (_ \<Rightarrow> _ \<times> _ \<times> (_ \<Rightarrow> ((_ \<Rightarrow> nat \<Rightarrow> _ \<Rightarrow> _) \<Rightarrow> _ - \<Rightarrow> (ocl_ty_class option \<times> (ocl_ty \<times> ocl_data_shallow) option) list) option)) \<times> _ \<times> _) - ; (l_st, l_assoc) = L.mapM (\<lambda> o_n l_assoc. - case o_n of - Some (name, ocli, cpt) \<Rightarrow> ([(cpt, OclDefCoreBinding (name, ocli))], (ocli, cpt) # l_assoc) - | None \<Rightarrow> ([], l_assoc)) l [] - ; l_st = L.unique oidGetInh (L.flatten l_st) in - - ( [ Definition (Term_rewrite (b name) \<open>=\<close> (Term_app \<open>state.make\<close> - ( Term_app \<open>Map.empty\<close> (case print_examp_def_st_mapsto l_st of None \<Rightarrow> [] | Some l \<Rightarrow> l) - # [ print_examp_def_st_assoc (snd o rbt) map_self map_username l_assoc ]))) ] - , l_st)))" - -definition "print_examp_def_st_dom_name name = S.flatten [\<open>dom_\<close>, name]" -definition "print_examp_def_st_dom = (\<lambda> _ env. - (\<lambda> l. (L.map O'.lemma l, env)) - (let (name, l_st) = map_prod String\<^sub>b\<^sub>a\<^sub>s\<^sub>e.to_String id (hd (D_input_state env)) - ; a = \<lambda>f x. Term_app f [x] - ; b = \<lambda>s. Term_basic [s] - ; d = hol_definition in - [ Lemma - (print_examp_def_st_dom_name name) - [Term_rewrite (a \<open>dom\<close> (a \<open>heap\<close> (b name))) \<open>=\<close> (Term_set (L.map (\<lambda>(cpt, _). Term_oid var_oid_uniq (oidGetInh cpt)) l_st))] - [] - (C.by [M.auto_simp_add [d name]])]))" - -definition "print_examp_def_st_dom_lemmas = (\<lambda> _ env. - (\<lambda> l. (L.map O'.lemmas l, env)) - (let (name, _) = hd (D_input_state env) in - [ Lemmas_simp \<open>\<close> - [T.thm (print_examp_def_st_dom_name (String\<^sub>b\<^sub>a\<^sub>s\<^sub>e.to_String name))] ]))" - -definition "print_examp_def_st_perm_name name = S.flatten [\<open>perm_\<close>, name]" -definition "print_examp_def_st_perm = (\<lambda> _ env. - (\<lambda> l. (L.map O'.lemma l, env)) - (let (name, l_st) = map_prod String\<^sub>b\<^sub>a\<^sub>s\<^sub>e.to_String id (hd (D_input_state env)) - ; expr_app = print_examp_def_st_mapsto (rev l_st) - ; b = \<lambda>s. Term_basic [s] - ; d = hol_definition - ; (l_app, l_last) = - case l_st of [] \<Rightarrow> ([], C.by [M.simp_add [d name]]) - | [_] \<Rightarrow> ([], C.by [M.simp_add [d name]]) - | _ \<Rightarrow> - ( [ M.simp_add [d name]] - # L.flatten (L.map (\<lambda>i_max. L.map (\<lambda>i. [M.subst_l (L.map String.nat_to_digit10 [i_max - i]) (T.thm \<open>fun_upd_twist\<close>), print_examp_def_st_locale_metis]) (List.upt 0 i_max)) (List.upt 1 (List.length l_st))) - , C.by [M.simp]) in - case expr_app of None \<Rightarrow> [] | Some expr_app \<Rightarrow> - [ Lemma - (print_examp_def_st_perm_name name) - [Term_rewrite (b name) \<open>=\<close> (Term_app \<open>state.make\<close> - (Term_app \<open>Map.empty\<close> expr_app # [Term_app var_assocs [b name]]))] - l_app - l_last ]))" - -definition "print_examp_def_st_allinst = (\<lambda> _ env. - (\<lambda> l. (L.map O'.lemma l, env)) - (let a = \<lambda>f x. Term_app f [x] - ; b = \<lambda>s. Term_basic [s] - ; d = hol_definition - ; (name_st, expr_app) = - map_prod - String\<^sub>b\<^sub>a\<^sub>s\<^sub>e.to_String - (print_examp_def_st_mapsto_gen - (\<lambda>(_, ocore) ocli _. - ( ocore - , ocli - , case ocore of OclDefCoreBinding (name, _) \<Rightarrow> b name))) - (hd (D_input_state env)) in - map_class_gen_h'_inh (\<lambda> isub_name name compare. - let in_name = \<lambda>ocli. b (print_examp_instance_name (\<lambda>s. s @@ String.isub (inst_ty ocli)) (inst_name ocli)) - ; in_pers = \<lambda>ocli. a name (a (datatype_in @@ String.isub (inst_ty ocli)) (in_name ocli)) - ; expr_app = L.map (\<lambda>(ocore, ocli, exp). - ( (ocore, ocli) - , let asty = \<lambda>e. Term_postunary e (b (dot_astype name)) - ; exp_annot = [( [S.flatten [const_oclastype, String.isub name, \<open>_\<close>, inst_ty ocli]] - , ( asty (case ocore of OclDefCoreBinding _ \<Rightarrow> exp) - , Some (let und = \<lambda>e. Term_lam \<open>_\<close> (\<lambda>_. Term_some e) in - Term_rewrite (und (in_pers ocli)) - \<open>=\<close> - (Term_warning_parenthesis (asty (Term_parenthesis - (Term_annot' (und (Term_some (in_name ocli))) (wrap_oclty (inst_ty ocli)))))))) - , True - , ocore)] in - case compare (inst_ty ocli) of - EQ \<Rightarrow> [([], (exp, None), False, ocore)] - | LT \<Rightarrow> exp_annot - | GT \<Rightarrow> (case fold_list_attr None (\<lambda>ty _. Cons ty) (Inst_attr ocli) [] of Some name2 # _ \<Rightarrow> - if name \<triangleq> name2 then exp_annot - else [] | _ \<Rightarrow> []) - | UN' \<Rightarrow> [])) expr_app - ; (l_asty, ((l_spec, l_spec'), l_body)) = map_prod (M.simp_add_del [] o L.flatten) - (map_prod L.split id o L.split) - (L.split (L.flatten (L.map snd expr_app))) - ; only_assms = Cons (M.simp_all_only' [ T.thms \<open>assms\<close> ]) - ; l_assum = L.flatten [ L.map (\<lambda> ((_, ocli), l). - (\<open>\<close>, True, Term_rewrite (in_pers ocli) (if l = [] then \<open>=\<close> else \<open>\<noteq>\<close>) (b \<open>None\<close>))) - expr_app - , List.map_filter (map_option (\<lambda> e \<Rightarrow> (\<open>\<close>, True, e))) l_spec'] in - gen_pre_post0 - (\<lambda>s. S.flatten [ name_st, \<open>_\<close>, s, \<open>_exec_\<close>, name ]) - l_assum - (\<lambda>f_expr f_mk _. Term_binop - (f_mk (b name_st)) - \<open>\<Turnstile>\<close> - (Term_binop (f_expr [b name]) \<open>\<doteq>\<close> (Term_oclset l_spec))) - (\<lambda>lem_tit lem_assum lem_spec var_pre_post var_mk _. Lemma_assumes - lem_tit - (L.flatten [ lem_assum - , [(\<open>\<close>, True, Term_And \<open>a\<close> (\<lambda>var_a. Term_rewrite (a var_pre_post (a var_mk (b var_a))) \<open>=\<close> (b var_a)))]]) - lem_spec - (L.map C.apply - (L.flatten - [ [[M.subst (T.thm (print_examp_def_st_perm_name name_st))]] - , [[M.simp_only (L.map (T.thm o d) - (\<open>state.make\<close> # L.map (\<lambda>(_, OclDefCoreBinding (n, _)) \<Rightarrow> n) l_body))]] - , fst (L.mapM (\<lambda> expr l_spec. - let mk_StrictRefEq_including = \<lambda>l. M.rule (T.thm \<open>const_StrictRefEq\<^sub>S\<^sub>e\<^sub>t_including\<close>) - # l_asty - # l_asty - # M.simp - # l - ; (state_update_vs_allInstances_generic, l_spec, l_OclIncluding_cong) = - let f = Cons M.simp in - case expr of ((ocore, _), []) \<Rightarrow> - ( \<open>state_update_vs_allInstances_generic_ntc\<close> - , l_spec - , f (if l_spec = [] then - [M.rule (T.thm \<open>const_StrictRefEq\<^sub>S\<^sub>e\<^sub>t_empty\<close>), M.simp] - else - mk_StrictRefEq_including [])) - | _ \<Rightarrow> - ( \<open>state_update_vs_allInstances_generic_tc\<close> - , tl l_spec - , ( M.blast None - # f (let f = \<lambda>l. M.option [M.simp_only [T.symmetric (T.thms \<open>assms\<close>)]] - # M.simp_add (L.map d [\<open>valid\<close>, \<open>OclValid\<close>, \<open>bot_fun\<close>, \<open>bot_option\<close>]) - # l in - mk_StrictRefEq_including (M.rule (T.thm \<open>OclIncluding_cong\<close>) # f (f []))))) in - ( M.subst (T.thm state_update_vs_allInstances_generic) - # M.simp - # M.simp - # M.option [print_examp_def_st_locale_metis] - # M.simp_only' [ T.thms \<open>assms\<close> ] - # l_OclIncluding_cong - , l_spec) ) expr_app l_spec) - , [[M.rule (T.thm \<open>state_update_vs_allInstances_generic_empty\<close>)]] ])) - (C.by (if l_spec = [] then [ M.simp ] - else only_assms [ M.option [M.simp_all_add [d (S.flatten [isub_name const_oclastype, \<open>_\<AA>\<close>])]]])) ) - (let l = [ M.simp_all ] in if l_assum = [] then l else only_assms l)) - (case D_input_class env of Some class_spec \<Rightarrow> class_spec)))" - -definition "print_examp_def_st_def_interp = (\<lambda> OclDefSt n l \<Rightarrow> \<lambda> env. - (\<lambda> l. (L.map O.definition l, env)) - (let a = \<lambda>f x. Term_app f [x] - ; b = \<lambda>s. Term_basic [s] - ; var_tau = \<open>\<tau>\<close> - ; (oid, l_fix_assum) = filter_locale_interp (print_examp_def_st_locale_sort env l) in - [Definition (Term_rewrite (a (\<open>state_interpretation_\<close> @@ n) (b var_tau)) - \<open>=\<close> - (Term_app (print_examp_def_st_locale_name n) - (L.flatten [oid, L.flatten l_fix_assum])))]))" - -definition "get_state f = (\<lambda> OclDefPP _ s_pre s_post \<Rightarrow> \<lambda> env. - let get_state = let l_st = D_input_state env in \<lambda>OclDefPPCoreBinding s \<Rightarrow> (s, case String.assoc s l_st of None \<Rightarrow> [] | Some l \<Rightarrow> l) - ; (s_pre, l_pre) = get_state s_pre - ; (s_post, l_post) = case s_post of None \<Rightarrow> (s_pre, l_pre) | Some s_post \<Rightarrow> get_state s_post in - f (s_pre, l_pre) - (s_post, l_post) - ((s_pre, l_pre) # (if s_pre \<triangleq> s_post then - [] - else - [ (s_post, l_post) ])) - env)" - -definition "print_transition_locale_aux l = - (let (oid, l_fix_assum) = print_examp_def_st_locale_aux (merge_unique'' [l]) in - L.flatten [oid, L.flatten (L.map (L.map fst o fst) l_fix_assum) ])" - -definition "print_transition_locale_name s_pre s_post = \<open>transition_\<close> @@ s_pre @@ \<open>_\<close> @@ s_post" -definition "print_transition_locale = get_state (\<lambda> (s_pre, l_pre) (s_post, l_post) l_pre_post. Pair - (print_examp_def_st_locale_make - (print_transition_locale_name s_pre s_post) - (L.map (\<lambda>(s, l). ([], Some (s, Term_app - (print_examp_def_st_locale_name s) - (print_transition_locale_aux l)))) - l_pre_post) - (merge_unique'' [l_pre, l_post])))" - -definition "print_transition_interp = get_state (\<lambda> _ _. - Pair o L.map O'.interpretation o L.map - (\<lambda>(s, l). - let n = print_examp_def_st_locale_name s in - Interpretation n n (print_transition_locale_aux l) - (C.by [M.rule (T.thm s)])))" - -definition "print_transition_def_state = get_state (\<lambda> pre post _. - (Pair o L.map O'.definition) - (L.map - (let a = \<lambda>f x. Term_app f [x] - ; b = \<lambda>s. Term_basic [s] in - (\<lambda>(s, _). - Definition (Term_rewrite (b s) \<open>=\<close> (b (print_examp_def_st_locale_name s @@ \<open>.\<close> @@ s))))) - [ pre, post ]))" - -definition "print_transition_wff = get_state (\<lambda> (s_pre, l_pre) (s_post, l_post) l_pre_post env. - (\<lambda> l. (L.map O'.lemma l, env)) - (let a = \<lambda>f x. Term_app f [x] - ; b = \<lambda>s. Term_basic [s] - ; d = hol_definition - ; mk_n = \<lambda>s. print_examp_def_st_locale_name s @@ \<open>.\<close> @@ s in - [ Lemma_assumes - (S.flatten [\<open>basic_\<close>, s_pre, \<open>_\<close>, s_post, \<open>_wff\<close>]) - (L.flatten - (L.map (L.map (\<lambda> (cpt, ocli) \<Rightarrow> - let ty = \<lambda>s. s @@ String.isub (inst_ty ocli) - ; n = inst_name ocli in - (\<open>\<close>, True, Term_rewrite - (a \<open>oid_of\<close> (a (ty datatype_in) (b (print_examp_instance_name ty n)))) - \<open>=\<close> - (Term_oid var_oid_uniq (oidGetInh cpt))))) - (merge_unique'' [l_pre, l_post]))) - (a \<open>WFF\<close> (let mk_n = b o mk_n in Term_pair (mk_n s_pre) (mk_n s_post))) - (L.map snd - (merge_unique (\<lambda> [oid_b, oid_a] \<Rightarrow> - if oid_a = oid_b then - None - else - Some ( [oid_a, oid_b] - , C.have0 \<open>\<close> - True - (Term_rewrite (Term_oid var_oid_uniq oid_a) \<open>\<noteq>\<close> (Term_oid var_oid_uniq oid_b)) - (C.by [print_examp_def_st_locale_metis]))) - [List.n_lists 2 (L.map (oidGetInh o fst) - (L.flatten (L.map snd l_pre_post)))])) - (C.by [M.auto_simp_add (L.map d (\<open>WFF\<close> # L.map (mk_n o fst) l_pre_post))])] ))" - -definition "print_transition_where = get_state (\<lambda> (s_pre, l_pre) (s_post, l_post) l_pre_post env. - (\<lambda> l. ((L.map O'.lemma o L.flatten) l, env)) - (let a = \<lambda>f x. Term_app f [x] - ; b = \<lambda>s. Term_basic [s] - ; d = hol_definition - ; mk_n = \<lambda>s. print_examp_def_st_locale_name s @@ \<open>.\<close> @@ s - ; f_name = \<lambda>(cpt, ocore). Some (oidGetInh cpt, ocore) - ; rbt_pre = merge_unique_gen f_name [l_pre] - ; rbt_post = merge_unique_gen f_name [l_post] in - L.map - (\<lambda>x_pers_oid. - let (x_where, l_ocore) = - case (RBT.lookup rbt_pre x_pers_oid, RBT.lookup rbt_post x_pers_oid) of - (Some ocore1, Some ocore2) \<Rightarrow> (\<open>OclIsMaintained\<close>, let l = [(ocore1, s_pre), (ocore2, s_post)] in - if String.to_list s_pre = String.to_list s_post then [hd l] else l) - | (Some ocore, None) \<Rightarrow> (\<open>OclIsDeleted\<close>, [(ocore, s_pre)]) - | (None, Some ocore) \<Rightarrow> (\<open>OclIsNew\<close>, [(ocore, s_post)]) in - L.map - (\<lambda> (OclDefCoreBinding (name, ocli), name_st) \<Rightarrow> - Lemma_assumes - (S.flatten [var_oid_uniq, String.natural_to_digit10 (case x_pers_oid of Oid i \<Rightarrow> i), s_pre, s_post, \<open>_\<close>, name_st, \<open>_\<close>, x_where]) - [(\<open>\<close>, True, Term_rewrite (a \<open>oid_of\<close> (b (print_examp_instance_name (\<lambda>s. s @@ String.isub (inst_ty ocli)) (inst_name ocli)))) - \<open>=\<close> - (Term_oid var_oid_uniq x_pers_oid))] - (Term_binop (let mk_n = b o mk_n in Term_pair (mk_n s_pre) (mk_n s_post)) - \<open>\<Turnstile>\<close> - (a x_where (b name))) - [C.apply [M.simp_add (L.map d (let l = [ mk_n s_post, name, x_where, \<open>OclValid\<close>, const_oid_of \<open>option\<close> ] in - case l_pre_post of [_] \<Rightarrow> l | _ \<Rightarrow> mk_n s_pre # l))]] - (C.by [M.option [print_examp_def_st_locale_metis]])) - l_ocore) - (RBT.keys (RBT.union rbt_pre rbt_post)) ))" - -definition "print_transition_def_interp = get_state (\<lambda> (s_pre, l_pre) (s_post, l_post) _. - (Pair o L.map O.definition) - (let a = \<lambda>f x. Term_app f [x] - ; b = \<lambda>s. Term_basic [s] - ; var_tau = \<open>\<tau>\<close> - ; (oid, l_fix_assum) = filter_locale_interp (merge_unique'' [l_pre, l_post]) in - [Definition (Term_rewrite (a (\<open>pp_\<close> @@ s_pre @@ \<open>_\<close> @@ s_post) (b var_tau)) - \<open>=\<close> - (Term_app (print_transition_locale_name s_pre s_post) - (L.flatten [oid, L.flatten l_fix_assum])))]))" - -definition "print_transition_lemmas_oid = get_state (\<lambda> (s_pre, l_pre) (s_post, l_post) _. - (Pair o L.map O.lemmas) - (let b = \<lambda>s. Term_basic [s] in - L.map (let l_pp = merge_unique'' [l_pre, l_post] in - (\<lambda>(tit, f). Lemmas_nosimp (tit @@ s_pre @@ \<open>_\<close> @@ s_post) - (L.flatten (L.map (L.map (T.thm o hol_definition) o f) l_pp)))) - [ (\<open>pp_oid_\<close>, (\<lambda>(cpt, _) # _ \<Rightarrow> - [ S.flatten [ var_oid_uniq - , String.natural_to_digit10 (case oidGetInh cpt of Oid i \<Rightarrow> i) ]])) - , (\<open>pp_object_\<close>, L.map (\<lambda>(_, ocli) \<Rightarrow> inst_name ocli)) - , (\<open>pp_object_ty_\<close>, L.map (\<lambda>(_, ocli) \<Rightarrow> - print_examp_instance_name - (\<lambda>s. s @@ String.isub (inst_ty ocli)) (inst_name ocli))) ]))" - -end diff --git a/Citadelle/src/compiler/meta/Meta_HKB.thy b/Citadelle/src/compiler/meta/Meta_HKB.thy deleted file mode 100644 index 5b6a44e3fff3ae38185501e06fdc5d313506c8a3..0000000000000000000000000000000000000000 --- a/Citadelle/src/compiler/meta/Meta_HKB.thy +++ /dev/null @@ -1,131 +0,0 @@ -(****************************************************************************** - * A Meta-Model for the Haskabelle API - * - * Copyright (c) 2007-2015 Technische Universität München, Germany - * 2017-2018 Virginia Tech, USA - * 2018-2019 Université Paris-Saclay, Univ. Paris-Sud, France - * - * 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. - ******************************************************************************) - -section\<open>Isabelle Meta-Model aka. AST definition of Isabelle\<close> - -theory Meta_HKB -imports "../../compiler_generic/Init" -begin - -section \<open>Miscellaneous\<close> - -datatype gen_meta = Gen_apply_hol string (* HOL term to apply *) - | Gen_apply_sml string (* SML term to apply *) - | Gen_apply_sml_cmd string (* SML term to apply *) - string (* SML term given to meta_command *) - | Gen_no_apply - -section \<open>Isa.hs\<close> - -(* Author: Tobias C. Rittweiler, TU Muenchen - -Abstract representation of Isar/HOL theory. -*) - -datatype ThyName = ThyName string - -datatype Name = QName ThyName string - | Name string - -type_synonym Sort = "Name list" - -datatype Type = Type Name "Type list" - | Func Type Type - | TVar Name - | NoType - -datatype Literal = Int nat (*FIXME 'int' to be supported instead of 'nat'*) - (*(*To be supported*)| Char char*) - | String string - -datatype Term = Literal Literal - | Const Name - | Abs Name Term - | App Term Term - | If Term Term Term - | Let "(Term * Term) list" Term - | Case Term "(Term * Term) list" - | ListCompr Term "ListComprFragment list" - | RecConstr Name "(Name * Term) list" - | RecUpdate Term "(Name * Term) list" - | DoBlock string "DoBlockFragment list" string - | Parenthesized Term -and ListComprFragment = Generator "Term * Term" - | Guard Term -and DoBlockFragment = DoGenerator Term Term - | DoQualifier Term - | DoLetStmt "(Term * Term) list" - -type_synonym Pat = Term - -datatype TypeSpec = TypeSpec "Name list" Name - -datatype TypeSign = TypeSign Name "(Name * Sort) list" Type - -datatype Function_Kind = Definition - | Primrec - | Fun - | Function_Sorry - -datatype Function_Stmt = Function_Stmt Function_Kind "TypeSign list" "((Name * (Pat list)) * Term) list" - -datatype Stmt = Datatype "(TypeSpec * ((Name * (Type list)) list)) list" - | Record TypeSpec "(Name * Type) list" - | TypeSynonym "(TypeSpec * Type) list" - | Function Function_Stmt - | Class Name "Name list" "TypeSign list" - | Instance Name Name "(Name * Sort) list" "Function_Stmt list" - | Comment string - | SML Function_Stmt - -datatype Module = Module ThyName "ThyName list" "Stmt list" bool - -section \<open>Convert.hs\<close> - -(* Author: Tobias C. Rittweiler, TU Muenchen - -Conversion from abstract Haskell code to abstract Isar/HOL theory. -*) - -datatype IsaUnit = IsaUnit "bool (* true: generate with 'old_datatype' instead of 'datatype' *) \<times> nat (* 0: full datatype, \<ge> 1: more atomic *)" (* FIXME add a generic meta-command 'generation_syntax_params' to parameterize at any interleaving place the generating mode (i.e. datatype or old_datatype) *) - "(string (* old prefix name to replace *) \<times> string option (* new substitute (or none to remove the prefix) *)) list" - gen_meta (* converting function to apply once the parsed value is created *) - string (* name of the current theory *) (* FIXME move that 'static value' to the global environment. In principle, each meta-command is evaluated within one "own" theory name, following the hierarchy of children theories... *) - "Module list \<times> bool (* true: treat as most the list as a single module *)" - -end diff --git a/Citadelle/src/compiler/meta/Meta_META.thy b/Citadelle/src/compiler/meta/Meta_META.thy deleted file mode 100644 index 6a9a5ba4ce804bd5cb11e7308c9dfb68f3b626c8..0000000000000000000000000000000000000000 --- a/Citadelle/src/compiler/meta/Meta_META.thy +++ /dev/null @@ -1,325 +0,0 @@ -(****************************************************************************** - * Citadelle - * - * 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. - ******************************************************************************) - -section\<open>Regrouping Together All Existing Meta-Models\<close> - -theory Meta_META -imports Meta_UML - Meta_UML_extended - Meta_HKB - "../../compiler_generic/meta_isabelle/Meta_Isabelle" -begin - -subsection\<open>A Basic Meta-Model\<close> - -text\<open>The following basic Meta-Model is an empty Meta-Model.\<close> - -text\<open>Most of the Meta-Model we have defined (in particular those defined in UML) - can be used in exceptional situations - for requiring an eager or lazy interactive evaluation of already encountered Meta-Models. - This is also the case for this basic Meta-Model.\<close> - -datatype ocl_flush_all = OclFlushAll - -subsection\<open>The Generic Meta-Model\<close> - -text\<open>The generic Meta-Model can simulate any other Meta-Models \<open>M\<close> by taking a string representing - some ML code, which is supposed to express a parsed value inhabiting \<open>M\<close>.\<close> - -datatype ocl_generic = OclGeneric string - -subsection\<open>The META Meta-Model (I)\<close> - -datatype floor = Floor1 | Floor2 | Floor3 (* NOTE nat can be used *) - -text\<open> -Meta-Models can be seen as arranged in a semantic tower with several floors. -By default, @{term Floor1} corresponds to the first level we are situating by default, -then a subsequent meta-evaluation would jump to a deeper floor, -to @{term Floor2}, then @{term Floor3}...\<close> - -text\<open> -It is not mandatory to jump to a floor superior than the one we currently are. -The important point is to be sure that all jumps will ultimately terminate.\<close> - -(* *) - -text\<open> -Most of the following constructors are preceded by an additional -@{typ floor} field, which explicitly indicates the intended associated semantic to consider -during the meta-embedding to Isabelle. -In case no @{typ floor} is precised, we fix it to be @{term Floor1} by default.\<close> - -(* le meta-model de "tout le monde" - frederic. *) -datatype all_meta_embedding = - (* TODO: we can merge Enum and ClassRaw into a common record *) - - \<comment> \<open>USE\<close> - META_enum ocl_enum - | META_class_raw floor ocl_class_raw - | META_association ocl_association - | META_ass_class floor ocl_ass_class - | META_ctxt floor ocl_ctxt - - \<comment> \<open>Haskell\<close> - | META_haskell IsaUnit - - \<comment> \<open>invented\<close> - | META_class_synonym ocl_class_synonym - | META_instance ocl_instance - | META_def_base_l ocl_def_base_l - | META_def_state floor ocl_def_state - | META_def_transition floor ocl_def_transition - | META_class_tree ocl_class_tree - | META_flush_all ocl_flush_all - | META_generic ocl_generic - -subsection\<open>Main Compiling Environment\<close> - -text\<open>The environment constitutes the main data-structure carried by all monadic translations.\<close> - -datatype generation_semantics_ocl = Gen_only_design | Gen_only_analysis | Gen_default -datatype generation_lemma_mode = Gen_sorry | Gen_no_dirty - -record compiler_env_config = D_output_disable_thy :: bool - D_output_header_thy :: "(string \<comment> \<open>theory\<close> - \<times> string list \<comment> \<open>imports\<close> - \<times> string \<comment> \<open>import optional (compiler bootstrap)\<close>) option" - D_ocl_oid_start :: internal_oids - D_output_position :: "nat \<times> nat" - D_ocl_semantics :: generation_semantics_ocl - D_input_class :: "ocl_class option" - \<comment> \<open>last class considered for the generation\<close> - D_input_meta :: "all_meta_embedding list" - D_input_instance :: "(string\<^sub>b\<^sub>a\<^sub>s\<^sub>e \<comment> \<open>name (as key for rbt)\<close> - \<times> ocl_instance_single - \<times> internal_oids) list" - \<comment> \<open>instance namespace environment\<close> - D_input_state :: "(string\<^sub>b\<^sub>a\<^sub>s\<^sub>e \<comment> \<open>name (as key for rbt)\<close> - \<times> (internal_oids - \<times> (string \<comment> \<open>name\<close> - \<times> ocl_instance_single \<comment> \<open>alias\<close>) - ocl_def_state_core) list) list" - \<comment> \<open>state namespace environment\<close> - D_output_header_force :: bool \<comment> \<open>true : the header should import the compiler for bootstrapping\<close> - D_output_auto_bootstrap :: bool \<comment> \<open>true : add the \<open>generation_syntax\<close> command\<close> - D_ocl_accessor :: " string\<^sub>b\<^sub>a\<^sub>s\<^sub>e \<comment> \<open>name of the constant added\<close> list \<comment> \<open>pre\<close> - \<times> string\<^sub>b\<^sub>a\<^sub>s\<^sub>e \<comment> \<open>name of the constant added\<close> list \<comment> \<open>post\<close>" - D_ocl_HO_type :: "(string\<^sub>b\<^sub>a\<^sub>s\<^sub>e \<comment> \<open>raw HOL name (as key for rbt)\<close>) list" - D_hsk_constr :: "(string\<^sub>b\<^sub>a\<^sub>s\<^sub>e \<comment> \<open>name of the constant added\<close>) list" - D_output_sorry_dirty :: "generation_lemma_mode option \<times> bool \<comment> \<open>dirty\<close>" \<comment> \<open>\<open>Some Gen_sorry\<close> or \<open>None\<close> and \<open>{dirty}\<close>: activate sorry mode for skipping proofs\<close> - -subsection\<open>Operations of Fold, Map, ..., on the Meta-Model\<close> - -definition "ignore_meta_header = (\<lambda> META_ctxt Floor1 _ \<Rightarrow> True - | META_def_state Floor1 _ \<Rightarrow> True - | META_def_transition Floor1 _ \<Rightarrow> True - | _ \<Rightarrow> False)" - -text\<open> -As remark in @{term ignore_meta_header}, @{term META_class_raw} and @{term META_ass_class} do not occur, -even if the associated meta-commands will be put at the beginning when generating files during the reordering step. -This is because some values for which @{term ignore_meta_header} returns @{term False} can exist just before -meta-commands associated to @{term META_class_raw} or @{term META_ass_class}. -\<close> - -definition "map2_ctxt_term f = - (let f_prop = \<lambda> OclProp_ctxt n prop \<Rightarrow> OclProp_ctxt n (f prop) - ; f_inva = \<lambda> T_inv b prop \<Rightarrow> T_inv b (f_prop prop) in - \<lambda> META_ctxt Floor2 c \<Rightarrow> - META_ctxt Floor2 - (Ctxt_clause_update - (L.map (\<lambda> Ctxt_pp pp \<Rightarrow> Ctxt_pp (Ctxt_expr_update (L.map (\<lambda> T_pp pref prop \<Rightarrow> T_pp pref (f_prop prop) - | T_invariant inva \<Rightarrow> T_invariant (f_inva inva))) pp) - | Ctxt_inv l_inv \<Rightarrow> Ctxt_inv (f_inva l_inv))) c) - | x \<Rightarrow> x)" - -definition "compiler_env_config_more_map f ocl = - compiler_env_config.extend (compiler_env_config.truncate ocl) (f (compiler_env_config.more ocl))" - -definition "compiler_env_config_empty output_disable_thy output_header_thy oid_start design_analysis sorry_dirty = - compiler_env_config.make - output_disable_thy - output_header_thy - oid_start - (0, 0) - design_analysis - None [] [] [] False False ([], []) [] [] - sorry_dirty" - -definition "compiler_env_config_reset_no_env env = - compiler_env_config_empty - (D_output_disable_thy env) - (D_output_header_thy env) - (oidReinitAll (D_ocl_oid_start env)) - (D_ocl_semantics env) - (D_output_sorry_dirty env) - \<lparr> D_input_meta := D_input_meta env \<rparr>" - -subsection\<open>The META Meta-Model (II)\<close> -subsubsection\<open>Type Definition\<close> - -text\<open> -For bootstrapping the environment through the jumps to another semantic floor, we additionally -consider the environment as a Meta-Model.\<close> - -datatype boot_generation_syntax = Boot_generation_syntax generation_semantics_ocl -datatype boot_setup_env = Boot_setup_env compiler_env_config - -datatype all_meta = \<comment> \<open>pure Isabelle\<close> - META_semi__theories semi__theories - - \<comment> \<open>bootstrapping embedded languages\<close> - | META_boot_generation_syntax boot_generation_syntax - | META_boot_setup_env boot_setup_env - | META_all_meta_embedding all_meta_embedding - -text\<open>As remark, the Isabelle Meta-Model represented by @{typ semi__theories} can be merged -with the previous META Meta-Model @{typ all_meta_embedding}. -However a corresponding parser and printer would then be required, instead we can just regroup them -in a temporary type:\<close> - -datatype fold_all_input = Fold_meta all_meta_embedding - | Fold_custom "all_meta list" - -subsubsection\<open>Extending the Meta-Model\<close> - -locale O \<comment> \<open>outer syntax\<close> -begin -definition "i x = META_semi__theories o Theories_one o x" -definition "datatype = i Theory_datatype" -definition "type_synonym = i Theory_type_synonym" -definition "type_notation = i Theory_type_notation" -definition "instantiation = i Theory_instantiation" -definition "overloading = i Theory_overloading" -definition "consts = i Theory_consts" -definition "definition = i Theory_definition" -definition "lemmas = i Theory_lemmas" -definition "lemma = i Theory_lemma" -definition "axiomatization = i Theory_axiomatization" -definition "section = i Theory_section" -definition "text = i Theory_text" -definition "text_raw = i Theory_text_raw" -definition "ML = i Theory_ML" -definition "setup = i Theory_setup" -definition "thm = i Theory_thm" -definition "interpretation = i Theory_interpretation" -definition "hide_const = i Theory_hide_const" -definition "abbreviation = i Theory_abbreviation" -definition "code_reflect' = i Theory_code_reflect'" -end - -lemmas [code] = - \<comment> \<open>def\<close> - O.i_def - O.datatype_def - O.type_synonym_def - O.type_notation_def - O.instantiation_def - O.overloading_def - O.consts_def - O.definition_def - O.lemmas_def - O.lemma_def - O.axiomatization_def - O.section_def - O.text_def - O.text_raw_def - O.ML_def - O.setup_def - O.thm_def - O.interpretation_def - O.hide_const_def - O.abbreviation_def - O.code_reflect'_def - -locale O' -begin -definition "datatype = Theory_datatype" -definition "type_synonym = Theory_type_synonym" -definition "type_notation = Theory_type_notation" -definition "instantiation = Theory_instantiation" -definition "overloading = Theory_overloading" -definition "consts = Theory_consts" -definition "definition = Theory_definition" -definition "lemmas = Theory_lemmas" -definition "lemma = Theory_lemma" -definition "axiomatization = Theory_axiomatization" -definition "section = Theory_section" -definition "text = Theory_text" -definition "ML = Theory_ML" -definition "setup = Theory_setup" -definition "thm = Theory_thm" -definition "interpretation = Theory_interpretation" -definition "hide_const = Theory_hide_const" -definition "abbreviation = Theory_abbreviation" -definition "code_reflect' = Theory_code_reflect'" -end - -lemmas [code] = - \<comment> \<open>def\<close> - O'.datatype_def - O'.type_synonym_def - O'.type_notation_def - O'.instantiation_def - O'.overloading_def - O'.consts_def - O'.definition_def - O'.lemmas_def - O'.lemma_def - O'.axiomatization_def - O'.section_def - O'.text_def - O'.ML_def - O'.setup_def - O'.thm_def - O'.interpretation_def - O'.hide_const_def - O'.abbreviation_def - O'.code_reflect'_def - -subsubsection\<open>Operations of Fold, Map, ..., on the Meta-Model\<close> - -definition "map_semi__theory f = (\<lambda> META_semi__theories (Theories_one x) \<Rightarrow> META_semi__theories (Theories_one (f x)) - | META_semi__theories (Theories_locale data l) \<Rightarrow> META_semi__theories (Theories_locale data (L.map (L.map f) l)) - | x \<Rightarrow> x)" - -end diff --git a/Citadelle/src/compiler/meta/Meta_UML.thy b/Citadelle/src/compiler/meta/Meta_UML.thy deleted file mode 100644 index da1e2d9c3642959fc07e06499cabb42c4701aa45..0000000000000000000000000000000000000000 --- a/Citadelle/src/compiler/meta/Meta_UML.thy +++ /dev/null @@ -1,850 +0,0 @@ -(****************************************************************************** - * 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. - ******************************************************************************) - -section\<open>OCL Meta-Model aka. AST definition of OCL (I)\<close> - -theory Meta_UML -imports "../../compiler_generic/meta_isabelle/Meta_Pure" - "../Init_rbt" -begin - -subsection\<open>Type Definition\<close> - -datatype ocl_collection = Set - | Sequence - | Ordered0 \<comment> \<open>ordered set\<close> - | Subsets0 \<^cancel>\<open>binding\<close> - | Union0 - | Redefines0 \<^cancel>\<open>binding\<close> - | Derived0 \<^cancel>\<open>string\<close> - | Qualifier0 \<^cancel>\<open>binding \<times> use_oclty\<close> - | Nonunique0 \<^cancel>\<open>bag\<close> - -datatype ocl_multiplicity_single = Mult_nat nat - | Mult_star - | Mult_infinity - -record ocl_multiplicity = TyMult :: "(ocl_multiplicity_single \<times> ocl_multiplicity_single option) list" - TyRole :: "string option" - TyCollect :: "ocl_collection list" \<comment> \<open>return type of the accessor (constrained by the above multiplicity)\<close> - -record ocl_ty_class_node = TyObjN_ass_switch :: nat - TyObjN_role_multip :: ocl_multiplicity - TyObjN_role_ty :: string -record ocl_ty_class = TyObj_name :: string - TyObj_ass_id :: nat - TyObj_ass_arity :: nat - TyObj_from :: ocl_ty_class_node - TyObj_to :: ocl_ty_class_node -datatype ocl_ty_obj_core = OclTyCore_pre string \<comment> \<open>class name, untyped\<close> (* FIXME perform the typing separately *) - | OclTyCore ocl_ty_class \<comment> \<open>class name, typed\<close> -datatype ocl_ty_obj = OclTyObj ocl_ty_obj_core - "ocl_ty_obj_core list \<comment> \<open>the \<^theory_text>\<open>and\<close> semantics\<close> - list \<comment> \<open>\<open>x # \<dots>\<close> means \<open>x < \<dots>\<close>\<close>" \<comment> \<open>superclass\<close> -datatype ocl_ty = OclTy_base_void (* NOTE can be merged in a generic tuple *) - | OclTy_base_boolean - | OclTy_base_integer - | OclTy_base_unlimitednatural - | OclTy_base_real - | OclTy_base_string - | OclTy_object ocl_ty_obj - | OclTy_collection ocl_multiplicity ocl_ty - | OclTy_pair ocl_ty ocl_ty (* NOTE can be merged in a generic tuple *) - | OclTy_binding "string option \<comment> \<open>name\<close> \<times> ocl_ty" (* NOTE can be merged in a generic tuple *) - | OclTy_arrow ocl_ty ocl_ty - | OclTy_class_syn string - | OclTy_enum string - | OclTy_raw string \<comment> \<open>denoting raw HOL-type\<close> (* FIXME to be removed *) - - -datatype ocl_association_type = OclAssTy_native_attribute - | OclAssTy_association - | OclAssTy_composition - | OclAssTy_aggregation -datatype ocl_association_relation = OclAssRel "(ocl_ty_obj \<times> ocl_multiplicity) list" -record ocl_association = OclAss_type :: ocl_association_type - OclAss_relation :: ocl_association_relation - -datatype ocl_ctxt_prefix = OclCtxtPre | OclCtxtPost - -datatype ocl_ctxt_term = T_pure "term" - "string option" \<comment> \<open>represents the unparsed version of the term\<close> - | T_to_be_parsed string \<comment> \<open>raw, it includes extra quoting characters like DEL (char 127)\<close> - string \<comment> \<open>same string but escaped without those quoting characters\<close> - | T_lambda string ocl_ctxt_term -datatype ocl_prop = OclProp_ctxt "string option" \<comment> \<open>name\<close> ocl_ctxt_term - \<^cancel>\<open>| OclProp_rel ocl_ty_obj \<comment> \<open>states that the constraint should be true\<close> - | OclProp_ass ocl_association_relation \<comment> \<open>states the relation as true\<close>\<close> -datatype ocl_ctxt_term_inv = T_inv bool \<comment> \<open>True: existential\<close> ocl_prop -datatype ocl_ctxt_term_pp = T_pp ocl_ctxt_prefix ocl_prop - | T_invariant ocl_ctxt_term_inv - -record ocl_ctxt_pre_post = Ctxt_fun_name :: string \<comment> \<open>function name\<close> - Ctxt_fun_ty :: ocl_ty - Ctxt_expr :: "ocl_ctxt_term_pp list" - -datatype ocl_ctxt_clause = Ctxt_pp ocl_ctxt_pre_post - | Ctxt_inv ocl_ctxt_term_inv -record ocl_ctxt = Ctxt_param :: "string list" \<comment> \<open>param\<close> - Ctxt_ty :: ocl_ty_obj - Ctxt_clause :: "ocl_ctxt_clause list" - -datatype ocl_class = OclClass - string \<comment> \<open>name of the class\<close> - "(string \<comment> \<open>name\<close> \<times> ocl_ty) list" \<comment> \<open>attribute\<close> - "ocl_class list" \<comment> \<open>link to subclasses\<close> - -record ocl_class_raw = ClassRaw_name :: ocl_ty_obj - ClassRaw_own :: "(string \<comment> \<open>name\<close> \<times> ocl_ty) list" \<comment> \<open>attribute\<close> - ClassRaw_clause :: "ocl_ctxt_clause list" - ClassRaw_abstract :: bool \<comment> \<open>True: abstract\<close> - -datatype ocl_ass_class = OclAssClass ocl_association - ocl_class_raw - -datatype ocl_class_synonym = OclClassSynonym string \<comment> \<open>name alias\<close> ocl_ty - -datatype ocl_enum = OclEnum string \<comment> \<open>name\<close> "string \<comment> \<open>constructor name\<close> list" - -subsection\<open>Extending the Meta-Model\<close> - -definition "T_lambdas = List.fold T_lambda" -definition "TyObjN_role_name = TyRole o TyObjN_role_multip" -definition "OclTy_class c = OclTy_object (OclTyObj (OclTyCore c) [])" -definition "OclTy_class_pre c = OclTy_object (OclTyObj (OclTyCore_pre c) [])" -definition "OclAss_relation' l = (case OclAss_relation l of OclAssRel l \<Rightarrow> l)" - -fun fold_pair_var where - "fold_pair_var f t accu = (case t of - OclTy_pair t1 t2 \<Rightarrow> Option.bind (fold_pair_var f t1 accu) (fold_pair_var f t2) - | OclTy_binding (Some v, t) \<Rightarrow> fold_pair_var f t (f (v, t) accu) - | OclTy_binding (None, t) \<Rightarrow> fold_pair_var f t accu - | OclTy_collection _ t \<Rightarrow> fold_pair_var f t accu - | OclTy_arrow _ _ \<Rightarrow> None - | _ \<Rightarrow> Some accu)" - -definition "Ctxt_fun_ty_arg ctxt = - (case - fold_pair_var - Cons - (case Ctxt_fun_ty ctxt of OclTy_arrow t _ \<Rightarrow> t - | t \<Rightarrow> t) - [] - of Some l \<Rightarrow> rev l)" - -definition "Ctxt_fun_ty_out ctxt = - (case Ctxt_fun_ty ctxt of OclTy_arrow _ t \<Rightarrow> Some t - | _ \<Rightarrow> None)" - -definition "map_pre_post f = - Ctxt_clause_update - (L.map - (\<lambda> Ctxt_pp ctxt \<Rightarrow> - Ctxt_pp (Ctxt_expr_update - (L.map - (\<lambda> T_pp pref (OclProp_ctxt n e) \<Rightarrow> - T_pp pref (OclProp_ctxt n (f pref ctxt e)) - | x \<Rightarrow> x)) - ctxt) - | x \<Rightarrow> x))" - -definition "fold_pre_post f ctxt = - List.fold - (\<lambda> Ctxt_pp ctxt \<Rightarrow> - f (rev (List.fold - (\<lambda> T_pp pref (OclProp_ctxt n e) \<Rightarrow> Cons (pref, n, e) - | _ \<Rightarrow> id) - (Ctxt_expr ctxt) [])) ctxt - | _ \<Rightarrow> id) - (Ctxt_clause ctxt)" - -definition "map_invariant f_inv = - Ctxt_clause_update - (L.map - (\<lambda> Ctxt_pp ctxt \<Rightarrow> - Ctxt_pp (Ctxt_expr_update - (L.map - (\<lambda> T_invariant ctxt \<Rightarrow> T_invariant (f_inv ctxt) - | x \<Rightarrow> x)) - ctxt) - | Ctxt_inv ctxt \<Rightarrow> Ctxt_inv (f_inv ctxt)))" - -definition "fold_invariant f_inv ctxt = - List.fold - (\<lambda> Ctxt_pp ctxt \<Rightarrow> - List.fold - (\<lambda> T_invariant ctxt \<Rightarrow> f_inv ctxt - | _ \<Rightarrow> id) - (Ctxt_expr ctxt) - | Ctxt_inv ctxt \<Rightarrow> f_inv ctxt) - (Ctxt_clause ctxt)" - -definition "fold_invariant' inva = - rev (fst (fold_invariant (\<lambda>(T_inv _ (OclProp_ctxt tit inva)) \<Rightarrow> \<lambda> (accu, n). - ( (let tit = case tit of None \<Rightarrow> String.nat_to_digit10 n - | Some tit \<Rightarrow> tit in - (tit, inva)) - # accu - , Suc n)) - inva - ([], 0)))" - -fun remove_binding where - "remove_binding e = (\<lambda> OclTy_collection m ty \<Rightarrow> OclTy_collection m (remove_binding ty) - | OclTy_pair ty1 ty2 \<Rightarrow> OclTy_pair (remove_binding ty1) (remove_binding ty2) - | OclTy_binding (_, ty) \<Rightarrow> remove_binding ty - | OclTy_arrow ty1 ty2 \<Rightarrow> OclTy_arrow (remove_binding ty1) (remove_binding ty2) - | x \<Rightarrow> x) e" - -subsection\<open>Class Translation Preliminaries\<close> - -definition "const_oid = \<open>oid\<close>" -definition "var_ty_list = \<open>list\<close>" -definition "var_ty_prod = \<open>prod\<close>" -definition "const_oclany = \<open>OclAny\<close>" - -definition "single_multip = - List.list_all (\<lambda> (_, Some (Mult_nat n)) \<Rightarrow> n \<le> 1 - | (Mult_nat n, None) \<Rightarrow> n \<le> 1 - | _ \<Rightarrow> False) o TyMult" - -fun fold_max_aux where - "fold_max_aux f l l_acc accu = (case l of - [] \<Rightarrow> accu - | x # xs \<Rightarrow> fold_max_aux f xs (x # l_acc) (f x (L.flatten [rev l_acc, xs]) accu))" - -definition "fold_max f l = fold_max_aux f (L.mapi Pair l) []" - -locale RBTS -begin -definition "lookup m k = RBT.lookup m (String.to_list k)" -definition insert where "insert k = RBT.insert (String.to_list k)" -definition "map_entry k = RBT.map_entry (String.to_list k)" -definition "modify_def v k = RBT.modify_def v (String.to_list k)" -definition "keys m = L.map (\<lambda>s. \<lless>s\<ggreater>) (RBT.keys m)" -definition "lookup2 m = (\<lambda>(k1, k2). RBT.lookup2 m (String.to_list k1, String.to_list k2))" -definition "insert2 = (\<lambda>(k1, k2). RBT.insert2 (String.to_list k1, String.to_list k2))" -definition fold where "fold f = RBT.fold (\<lambda>c. f \<lless>c\<ggreater>)" -definition "entries m = L.map (map_prod (\<lambda>c. \<lless>c\<ggreater>) id) (RBT.entries m)" -end -lemmas [code] = - \<comment> \<open>def\<close> - RBTS.lookup_def - RBTS.insert_def - RBTS.map_entry_def - RBTS.modify_def_def - RBTS.keys_def - RBTS.lookup2_def - RBTS.insert2_def - RBTS.fold_def - RBTS.entries_def - -syntax "_rbt_lookup" :: "_ \<Rightarrow> _" ("lookup") translations "lookup" \<rightleftharpoons> "CONST RBTS.lookup" -syntax "_rbt_insert" :: "_ \<Rightarrow> _" ("insert") translations "insert" \<rightleftharpoons> "CONST RBTS.insert" -syntax "_rbt_map_entry" :: "_ \<Rightarrow> _" ("map'_entry") translations "map_entry" \<rightleftharpoons> "CONST RBTS.map_entry" -syntax "_rbt_modify_def" :: "_ \<Rightarrow> _" ("modify'_def") translations "modify_def" \<rightleftharpoons> "CONST RBTS.modify_def" -syntax "_rbt_keys" :: "_ \<Rightarrow> _" ("keys") translations "keys" \<rightleftharpoons> "CONST RBTS.keys" -syntax "_rbt_lookup2" :: "_ \<Rightarrow> _" ("lookup2") translations "lookup2" \<rightleftharpoons> "CONST RBTS.lookup2" -syntax "_rbt_insert2" :: "_ \<Rightarrow> _" ("insert2") translations "insert2" \<rightleftharpoons> "CONST RBTS.insert2" -syntax "_rbt_fold" :: "_ \<Rightarrow> _" ("fold") translations "fold" \<rightleftharpoons> "CONST RBTS.fold" -syntax "_rbt_entries" :: "_ \<Rightarrow> _" ("entries") translations "entries" \<rightleftharpoons> "CONST RBTS.entries" - -function (sequential) class_unflat_aux where -(* FIXME replace with this simplified form *) \<^cancel>\<open> - "class_unflat_aux rbt rbt_inv rbt_cycle r = - (case lookup rbt_cycle r of None \<comment> \<open>cycle detection\<close> \<Rightarrow> - map_option - (OclClass - r - (case lookup rbt r of Some l \<Rightarrow> l)) - (L.bind (class_unflat_aux rbt rbt_inv (insert r () rbt_cycle)) - id - (case lookup rbt_inv r of None \<Rightarrow> [] | Some l \<Rightarrow> l)) - | _ \<Rightarrow> None)" -\<close> - "class_unflat_aux rbt rbt_inv rbt_cycle r = - (case lookup rbt_inv r of None \<Rightarrow> - (case lookup rbt_cycle r of None \<comment> \<open>cycle detection\<close> \<Rightarrow> - map_option - (OclClass - r - (case lookup rbt r of Some l \<Rightarrow> l)) - ((\<lambda>f0 f l. - let l = List.map f0 l in - if list_ex (\<lambda> None \<Rightarrow> True | _ \<Rightarrow> False) l then - None - else - Some (f (List.map_filter id l))) (class_unflat_aux rbt rbt_inv (insert r () rbt_cycle)) - id - ([])) - | _ \<Rightarrow> None) - | Some l \<Rightarrow> - (case lookup rbt_cycle r of None \<comment> \<open>cycle detection\<close> \<Rightarrow> - map_option - (OclClass - r - (case lookup rbt r of Some l \<Rightarrow> l)) - ((\<lambda>f0 f l. - let l = List.map f0 l in - if list_ex (\<lambda> None \<Rightarrow> True | _ \<Rightarrow> False) l then - None - else - Some (f (List.map_filter id l))) (class_unflat_aux rbt rbt_inv (insert r () rbt_cycle)) - id - (l)) - | _ \<Rightarrow> None))" -by pat_completeness auto - -termination -proof - - have arith_diff: "\<And>a1 a2 (b :: Nat.nat). a1 = a2 \<Longrightarrow> a1 > b \<Longrightarrow> a1 - (b + 1) < a2 - b" - by arith - - have arith_less: "\<And>(a:: Nat.nat) b c. b \<ge> max (a + 1) c \<Longrightarrow> a < b" - by arith - - have rbt_length: "\<And>rbt_cycle r v. RBT.lookup rbt_cycle r = None \<Longrightarrow> - length (RBT.keys (RBT.insert r v rbt_cycle)) = length (RBT.keys rbt_cycle) + 1" - apply(subst (1 2) distinct_card[symmetric], (rule distinct_keys)+) - apply(simp only: lookup_keys[symmetric], simp) - by (metis card_insert_if domIff finite_dom_lookup) - - have rbt_fold_union'': "\<And>ab a x k. dom (\<lambda>b. if b = ab then Some a else k b) = {ab} \<union> dom k" - by(auto) - - have rbt_fold_union': "\<And>l rbt_inv a. - dom (RBT.lookup (List.fold (\<lambda>(k, _). RBT.insert k a) l rbt_inv)) = - dom (map_of l) \<union> dom (RBT.lookup rbt_inv)" - apply(rule_tac P = "\<lambda>rbt_inv . dom (RBT.lookup (List.fold (\<lambda>(k, _). RBT.insert k a) l rbt_inv)) = - dom (map_of l) \<union> dom (RBT.lookup rbt_inv)" in allE, simp_all) - apply(induct_tac l, simp, rule allI) - apply(case_tac aa, simp) - apply(simp add: rbt_fold_union'') - done - - have rbt_fold_union: "\<And>rbt_cycle rbt_inv a. - dom (RBT.lookup (RBT.fold (\<lambda>k _. RBT.insert k a) rbt_cycle rbt_inv)) = - dom (RBT.lookup rbt_cycle) \<union> dom (RBT.lookup rbt_inv)" - apply(simp add: fold_fold) - apply(subst (2) map_of_entries[symmetric]) - apply(rule rbt_fold_union') - done - - have rbt_fold_eq: "\<And>rbt_cycle rbt_inv a b. - dom (RBT.lookup (RBT.fold (\<lambda>k _. RBT.insert k a) rbt_cycle rbt_inv)) = - dom (RBT.lookup (RBT.fold (\<lambda>k _. RBT.insert k b) rbt_inv rbt_cycle))" - by(simp add: rbt_fold_union Un_commute) - - let ?len = "\<lambda>x. length (RBT.keys x)" - let ?len_merge = "\<lambda>rbt_cycle rbt_inv. ?len (RBT.fold (\<lambda>k _. RBT.insert k []) rbt_cycle rbt_inv)" - - have rbt_fold_large: "\<And>rbt_cycle rbt_inv. ?len_merge rbt_cycle rbt_inv \<ge> max (?len rbt_cycle) (?len rbt_inv)" - apply(subst (1 2 3) distinct_card[symmetric], (rule distinct_keys)+) - apply(simp only: lookup_keys[symmetric], simp) - apply(subst (1 2) card_mono, simp_all) - apply(simp add: rbt_fold_union)+ - done - - have rbt_fold_eq: "\<And>rbt_cycle rbt_inv r a. - RBT.lookup rbt_inv r = Some a \<Longrightarrow> - ?len_merge (RBT.insert r () rbt_cycle) rbt_inv = ?len_merge rbt_cycle rbt_inv" - apply(subst (1 2) distinct_card[symmetric], (rule distinct_keys)+) - apply(simp only: lookup_keys[symmetric]) - apply(simp add: rbt_fold_union) - by (metis Un_insert_right insert_dom) - - show ?thesis - apply(relation "measure (\<lambda>(_, rbt_inv, rbt_cycle, _). - ?len_merge rbt_cycle rbt_inv - ?len rbt_cycle)" - , simp+) - unfolding RBTS.lookup_def RBTS.insert_def - apply(subst rbt_length, simp) - apply(rule arith_diff) - apply(rule rbt_fold_eq, simp) - apply(rule arith_less) - apply(subst rbt_length[symmetric], simp) - apply(rule rbt_fold_large) - done -qed -definition "ty_obj_to_string = (\<lambda>OclTyObj (OclTyCore_pre s) _ \<Rightarrow> s)" -definition "cl_name_to_string = ty_obj_to_string o ClassRaw_name" - -definition "normalize0 f l = - rev (snd (List.fold (\<lambda>x (rbt, l). - let x0 = f x in - case RBT.lookup rbt x0 of - None \<Rightarrow> (RBT.insert x0 () rbt, x # l) - | Some _ \<Rightarrow> (rbt, l)) - l - (RBT.empty, [])))" - -definition "class_unflat = (\<lambda> (l_class, l_ass). - let l = - let const_oclany' = OclTyCore_pre const_oclany - ; rbt = \<comment> \<open>fold classes:\<close> - \<comment> \<open>set \<open>OclAny\<close> as default inherited class (for all classes linking to zero inherited classes)\<close> - insert - const_oclany - (ocl_class_raw.make (OclTyObj const_oclany' []) [] [] False) - (List.fold - (\<lambda> cflat \<Rightarrow> - insert (cl_name_to_string cflat) (cflat \<lparr> ClassRaw_name := case ClassRaw_name cflat of OclTyObj n [] \<Rightarrow> OclTyObj n [[const_oclany']] | x \<Rightarrow> x \<rparr>)) - l_class - RBT.empty) in - \<comment> \<open>fold associations:\<close> - \<comment> \<open>add remaining 'object' attributes\<close> - L.map snd (entries (List.fold (\<lambda> (ass_oid, ass) \<Rightarrow> - case let (l_none, l_some) = List.partition (\<lambda>(_, m). TyRole m = None) (OclAss_relation' ass ) in - L.flatten [l_none, normalize0 (\<lambda>(_, m). case TyRole m of Some s \<Rightarrow> String.to_list s) l_some] of - [] \<Rightarrow> id - | [_] \<Rightarrow> id - | l_rel \<Rightarrow> - fold_max - (let n_rel = natural_of_nat (List.length l_rel) in - (\<lambda> (cpt_to, (name_to, category_to)). - case TyRole category_to of - Some role_to \<Rightarrow> - List.fold (\<lambda> (cpt_from, (name_from, mult_from)). - let name_from = ty_obj_to_string name_from in - map_entry name_from (\<lambda>cflat. cflat \<lparr> ClassRaw_own := (role_to, - OclTy_class (ocl_ty_class_ext const_oid ass_oid n_rel - (ocl_ty_class_node_ext cpt_from mult_from name_from ()) - (ocl_ty_class_node_ext cpt_to category_to (ty_obj_to_string name_to) ()) - ())) # ClassRaw_own cflat \<rparr>)) - | _ \<Rightarrow> \<lambda>_. id)) - l_rel) (L.mapi Pair l_ass) rbt)) in - class_unflat_aux - (List.fold (\<lambda> cflat. insert (cl_name_to_string cflat) - (normalize0 (String.to_list o fst) (L.map (map_prod id remove_binding) (ClassRaw_own cflat)))) - l - RBT.empty) - (List.fold - (\<lambda> cflat. - case ClassRaw_name cflat of - OclTyObj n [] \<Rightarrow> id - | OclTyObj n l \<Rightarrow> case rev ([n] # l) of x0 # xs \<Rightarrow> \<lambda>rbt. - snd (List.fold - (\<lambda> x (x0, rbt). - (x, List.fold (\<lambda> OclTyCore_pre k \<Rightarrow> modify_def [] k (\<lambda>l. L.flatten [L.map (\<lambda>OclTyCore_pre s \<Rightarrow> s) x, l])) - x0 - rbt)) - xs - (x0, rbt))) - l - RBT.empty) - RBT.empty - const_oclany)" - -definition "class_unflat' x = - (case class_unflat x of None \<Rightarrow> OclClass const_oclany [] [] - | Some tree \<Rightarrow> tree)" - -fun nb_class where - "nb_class e = (\<lambda> OclClass _ _ l \<Rightarrow> Suc (List.fold ((+) o nb_class) l 0)) e" - -definition "apply_optim_ass_arity ty_obj v = - (if TyObj_ass_arity ty_obj \<le> 2 then None - else Some v)" - -definition "is_higher_order = (\<lambda> OclTy_collection _ _ \<Rightarrow> True | OclTy_pair _ _ \<Rightarrow> True | _ \<Rightarrow> False)" - -definition "parse_ty_raw = (\<lambda> OclTy_raw s \<Rightarrow> if s = \<open>int\<close> then OclTy_base_integer else OclTy_raw s - | x \<Rightarrow> x)" - -definition "is_sequence = list_ex (\<lambda> Sequence \<Rightarrow> True | _ \<Rightarrow> False) o TyCollect" - -fun str_of_ty where "str_of_ty e = - (\<lambda> OclTy_base_void \<Rightarrow> \<open>Void\<close> - | OclTy_base_boolean \<Rightarrow> \<open>Boolean\<close> - | OclTy_base_integer \<Rightarrow> \<open>Integer\<close> - | OclTy_base_unlimitednatural \<Rightarrow> \<open>UnlimitedNatural\<close> - | OclTy_base_real \<Rightarrow> \<open>Real\<close> - | OclTy_base_string \<Rightarrow> \<open>String\<close> - | OclTy_object (OclTyObj (OclTyCore_pre s) _) \<Rightarrow> s - \<^cancel>\<open>| OclTy_object (OclTyObj (OclTyCore ty_obj) _)\<close> - | OclTy_collection t ocl_ty \<Rightarrow> (if is_sequence t then - S.flatten [\<open>Sequence(\<close>, str_of_ty ocl_ty,\<open>)\<close>] - else - S.flatten [\<open>Set(\<close>, str_of_ty ocl_ty,\<open>)\<close>]) - | OclTy_pair ocl_ty1 ocl_ty2 \<Rightarrow> S.flatten [\<open>Pair(\<close>, str_of_ty ocl_ty1, \<open>,\<close>, str_of_ty ocl_ty2,\<open>)\<close>] - | OclTy_binding (_, ocl_ty) \<Rightarrow> str_of_ty ocl_ty - | OclTy_class_syn s \<Rightarrow> s - | OclTy_enum s \<Rightarrow> s - | OclTy_raw s \<Rightarrow> S.flatten [\<open>\<acute>\<close>, s, \<open>\<acute>\<close>]) e" - -definition "ty_void = str_of_ty OclTy_base_void" -definition "ty_boolean = str_of_ty OclTy_base_boolean" -definition "ty_integer = str_of_ty OclTy_base_integer" -definition "ty_unlimitednatural = str_of_ty OclTy_base_unlimitednatural" -definition "ty_real = str_of_ty OclTy_base_real" -definition "ty_string = str_of_ty OclTy_base_string" - -definition "pref_ty_enum s = \<open>ty_enum\<close> @@ String.isub s" -definition "pref_ty_syn s = \<open>ty_syn\<close> @@ String.isub s" -definition "pref_constr_enum s = \<open>constr\<close> @@ String.isub s" - -fun str_hol_of_ty_all where "str_hol_of_ty_all f b e = - (\<lambda> OclTy_base_void \<Rightarrow> b \<open>unit\<close> - | OclTy_base_boolean \<Rightarrow> b \<open>bool\<close> - | OclTy_base_integer \<Rightarrow> b \<open>int\<close> - | OclTy_base_unlimitednatural \<Rightarrow> b \<open>nat\<close> - | OclTy_base_real \<Rightarrow> b \<open>real\<close> - | OclTy_base_string \<Rightarrow> b \<open>string\<close> - | OclTy_object (OclTyObj (OclTyCore_pre s) _) \<Rightarrow> b const_oid - | OclTy_object (OclTyObj (OclTyCore ty_obj) _) \<Rightarrow> f (b var_ty_list) [b (TyObj_name ty_obj)] - | OclTy_collection _ ty \<Rightarrow> f (b var_ty_list) [str_hol_of_ty_all f b ty] - | OclTy_pair ty1 ty2 \<Rightarrow> f (b var_ty_prod) [str_hol_of_ty_all f b ty1, str_hol_of_ty_all f b ty2] - | OclTy_binding (_, t) \<Rightarrow> str_hol_of_ty_all f b t - | OclTy_class_syn s \<Rightarrow> b (pref_ty_syn s) - | OclTy_enum s \<Rightarrow> b (pref_ty_enum s) - | OclTy_raw s \<Rightarrow> b s) e" - -definition "print_infra_type_synonym_class_set_name name = \<open>Set_\<close> @@ name" -definition "print_infra_type_synonym_class_sequence_name name = \<open>Sequence_\<close> @@ name" - -fun get_class_hierarchy_strict_aux where - "get_class_hierarchy_strict_aux dataty l_res = - (List.fold - (\<lambda> OclClass name l_attr dataty \<Rightarrow> \<lambda> l_res. - get_class_hierarchy_strict_aux dataty (OclClass name l_attr dataty # l_res)) - dataty - l_res)" -definition "get_class_hierarchy_strict d = get_class_hierarchy_strict_aux d []" - -fun get_class_hierarchy'_aux where - "get_class_hierarchy'_aux l_res (OclClass name l_attr dataty) = - (let l_res = OclClass name l_attr dataty # l_res in - case dataty of [] \<Rightarrow> rev l_res - | dataty \<Rightarrow> List.fold (\<lambda>x acc. get_class_hierarchy'_aux acc x) dataty l_res)" -definition "get_class_hierarchy' = get_class_hierarchy'_aux []" - -definition "get_class_hierarchy e = L.map (\<lambda> OclClass n l _ \<Rightarrow> (n, l)) (get_class_hierarchy' e)" -definition "get_class_hierarchy_sub = (\<lambda> None \<Rightarrow> [] - | Some next_dataty \<Rightarrow> get_class_hierarchy next_dataty)" -definition "get_class_hierarchy_sub' = (\<lambda> None \<Rightarrow> [] - | Some next_dataty \<Rightarrow> get_class_hierarchy' next_dataty)" - -datatype position = EQ \<comment> \<open>equal\<close> | LT \<comment> \<open>less\<close> | GT \<comment> \<open>greater\<close> | UN' \<comment> \<open>uncomparable\<close> - -fun fold_less_gen where "fold_less_gen f_gen f_jump f l = (case l of - x # xs \<Rightarrow> \<lambda>acc. fold_less_gen f_gen f_jump f xs (f_gen (f x) xs (f_jump acc)) - | [] \<Rightarrow> id)" - -definition "fold_less2 = fold_less_gen List.fold" - -section\<open>Translation of AST\<close> - -definition "var_in_pre_state = \<open>in_pre_state\<close>" -definition "var_in_post_state = \<open>in_post_state\<close>" -definition "var_at_when_hol_post = \<open>\<close>" -definition "var_at_when_hol_pre = \<open>at_pre\<close>" -definition "var_at_when_ocl_post = \<open>\<close>" -definition "var_at_when_ocl_pre = \<open>@pre\<close>" - -datatype 'a tmp_sub = Tsub 'a -record 'a inheritance = - Inh :: 'a - Inh_sib :: "('a \<times> 'a list \<comment> \<open>flat version of the 1st component\<close>) list" \<comment> \<open>sibling\<close> - Inh_sib_unflat :: "'a list" \<comment> \<open>sibling\<close> -datatype 'a tmp_inh = Tinh 'a -datatype 'a tmp_univ = Tuniv 'a -definition "of_inh = (\<lambda>Tinh l \<Rightarrow> l)" -definition "of_linh = L.map Inh" -definition "of_linh_sib l = L.flatten (L.map snd (L.flatten (L.map Inh_sib l)))" -definition "of_sub = (\<lambda>Tsub l \<Rightarrow> l)" -definition "of_univ = (\<lambda>Tuniv l \<Rightarrow> l)" -definition "map_inh f = (\<lambda>Tinh l \<Rightarrow> Tinh (f l))" -definition "map_linh f cl = \<lparr> Inh = f (Inh cl) - , Inh_sib = L.map (map_prod f (L.map f)) (Inh_sib cl) - , Inh_sib_unflat = L.map f (Inh_sib_unflat cl) \<rparr>" - -fun fold_class_gen_aux where - "fold_class_gen_aux l_inh f accu (OclClass name l_attr dataty) = - (let accu = f (\<lambda>s. s @@ String.isub name) - name - l_attr - (Tinh l_inh) - (Tsub (get_class_hierarchy_strict dataty)) \<comment> \<open>order: bfs or dfs (modulo reversing)\<close> - dataty - accu in - case dataty of [] \<Rightarrow> accu - | _ \<Rightarrow> - fst (List.fold - (\<lambda> node (accu, l_inh_l, l_inh_r). - ( fold_class_gen_aux - ( \<lparr> Inh = OclClass name l_attr dataty - , Inh_sib = L.flatten (L.map (L.map (\<lambda>l. (l, get_class_hierarchy' l))) [l_inh_l, tl l_inh_r]) - , Inh_sib_unflat = L.flatten [l_inh_l, tl l_inh_r] \<rparr> - # l_inh) - f accu node - , hd l_inh_r # l_inh_l - , tl l_inh_r)) - dataty - (accu, [], dataty)))" - -definition "fold_class_gen f accu expr = - (let (l_res, accu) = - fold_class_gen_aux - [] - (\<lambda> isub_name name l_attr l_inh l_subtree next_dataty (l_res, accu). - let (r, accu) = f isub_name name l_attr l_inh l_subtree next_dataty accu in - (r # l_res, accu)) - ([], accu) - expr in - (L.flatten l_res, accu))" - -definition "map_class_gen f = fst o fold_class_gen - (\<lambda> isub_name name l_attr l_inh l_subtree last_d. \<lambda> () \<Rightarrow> - (f isub_name name l_attr l_inh l_subtree last_d, ())) ()" - -definition "add_hierarchy f x = (\<lambda>isub_name name _ _ _ _. f isub_name name (Tuniv (L.map fst (get_class_hierarchy x))))" -definition "add_hierarchy' f x = (\<lambda>isub_name name _ _ _ _. f isub_name name (Tuniv (get_class_hierarchy x)))" -definition "add_hierarchy'' f x = (\<lambda>isub_name name l_attr _ _ _. f isub_name name (Tuniv (get_class_hierarchy x)) l_attr)" -definition "add_hierarchy''' f x = (\<lambda>isub_name name l_attr l_inh _ next_dataty. f isub_name name (Tuniv (get_class_hierarchy x)) l_attr (map_inh (L.map (\<lambda> OclClass _ l _ \<Rightarrow> l) o of_linh) l_inh) next_dataty)" -definition "add_hierarchy'''' f x = (\<lambda>isub_name name l_attr l_inh l_subtree _. f isub_name name (Tuniv (get_class_hierarchy x)) l_attr (map_inh (L.map (\<lambda> OclClass _ l _ \<Rightarrow> l) o of_linh) l_inh) l_subtree)" -definition "add_hierarchy''''' f = (\<lambda>isub_name name l_attr l_inh l_subtree. f isub_name name l_attr (of_inh l_inh) (of_sub l_subtree))" -definition "map_class f = map_class_gen (\<lambda>isub_name name l_attr l_inh l_subtree next_dataty. [f isub_name name l_attr l_inh (Tsub (L.map (\<lambda> OclClass n _ _ \<Rightarrow> n) (of_sub l_subtree))) next_dataty])" -definition "map_class' f = map_class_gen (\<lambda>isub_name name l_attr l_inh l_subtree next_dataty. [f isub_name name l_attr l_inh l_subtree next_dataty])" -definition "fold_class f = fold_class_gen (\<lambda>isub_name name l_attr l_inh l_subtree next_dataty accu. let (x, accu) = f isub_name name l_attr (map_inh of_linh l_inh) (Tsub (L.map (\<lambda> OclClass n _ _ \<Rightarrow> n) (of_sub l_subtree))) next_dataty accu in ([x], accu))" -definition "map_class_gen_h f x = map_class_gen (add_hierarchy f x) x" -definition "map_class_gen_h' f x = map_class_gen (add_hierarchy' f x) x" -definition "map_class_gen_h'' f x = map_class_gen (add_hierarchy'' f x) x" -definition "map_class_gen_h''' f x = map_class_gen (add_hierarchy''' f x) x" -definition "map_class_gen_h'''' f x = map_class_gen (add_hierarchy'''' (\<lambda>isub_name name l_inherited l_attr l_inh l_subtree. f isub_name name l_inherited l_attr l_inh (Tsub (L.map (\<lambda> OclClass n _ _ \<Rightarrow> n) (of_sub l_subtree)))) x) x" -definition "map_class_gen_h''''' f x = map_class_gen (add_hierarchy''''' f) x" -definition "map_class_h f x = map_class (add_hierarchy f x) x" -definition "map_class_h' f x = map_class (add_hierarchy' f x) x" -definition "map_class_h'' f x = map_class (add_hierarchy'' f x) x" -definition "map_class_h''' f x = map_class (add_hierarchy''' f x) x" -definition "map_class_h'''' f x = map_class (add_hierarchy'''' f x) x" -definition "map_class_h''''' f x = map_class' (add_hierarchy''''' f) x" -definition "map_class_arg_only f = map_class_gen (\<lambda> isub_name name l_attr _ _ _. case l_attr of [] \<Rightarrow> [] | l \<Rightarrow> f isub_name name l)" -definition "map_class_arg_only' f = map_class_gen (\<lambda> isub_name name l_attr l_inh l_subtree _. - case filter (\<lambda> OclClass _ [] _ \<Rightarrow> False | _ \<Rightarrow> True) (of_linh (of_inh l_inh)) of - [] \<Rightarrow> [] - | l \<Rightarrow> f isub_name name (l_attr, Tinh l, l_subtree))" -definition "map_class_arg_only0 f1 f2 u = map_class_arg_only f1 u @@@@ map_class_arg_only' f2 u" -definition "map_class_arg_only_var0 = (\<lambda>f_expr f_app f_lattr isub_name name l_attr. - L.flatten (L.flatten ( - L.map (\<lambda>(var_in_when_state, dot_at_when, attr_when). - L.flatten (L.map (\<lambda> l_attr. L.map (\<lambda>(attr_name, attr_ty). - f_app - isub_name - name - (var_in_when_state, dot_at_when) - attr_ty - (\<lambda>s. s @@ String.isup attr_name) - (\<lambda>s. f_expr s - [ case case attr_ty of - OclTy_object (OclTyObj (OclTyCore ty_obj) _) \<Rightarrow> - apply_optim_ass_arity ty_obj - (let ty_obj = TyObj_from ty_obj in - case TyObjN_role_name ty_obj of - None => String.natural_to_digit10 (TyObjN_ass_switch ty_obj) - | Some s => s) - | _ \<Rightarrow> None of - None \<Rightarrow> mk_dot attr_name attr_when - | Some s2 \<Rightarrow> mk_dot_comment attr_name attr_when s2 ])) l_attr) - (f_lattr l_attr))) - [ (var_in_post_state, var_at_when_hol_post, var_at_when_ocl_post) - , (var_in_pre_state, var_at_when_hol_pre, var_at_when_ocl_pre)])))" -definition "map_class_arg_only_var_gen f_expr f1 f2 = map_class_arg_only0 (map_class_arg_only_var0 f_expr f1 (\<lambda>l. [l])) (map_class_arg_only_var0 f_expr f2 (\<lambda> (_, Tinh l, _) \<Rightarrow> L.map (\<lambda> OclClass _ l _ \<Rightarrow> l) l))" -definition "map_class_arg_only_var'_gen f_expr f = map_class_arg_only0 (map_class_arg_only_var0 f_expr f (\<lambda>l. [l])) (map_class_arg_only_var0 f_expr f (\<lambda> (_, Tinh l, _) \<Rightarrow> L.map (\<lambda> OclClass _ l _ \<Rightarrow> l) l))" -definition "map_class_arg_only_var''_gen f_expr f = map_class_arg_only (map_class_arg_only_var0 f_expr f (\<lambda>l. [l]))" -definition "map_class_one f_l f expr = - (case f_l (fst (fold_class (\<lambda>isub_name name l_attr l_inh l_inh_sib next_dataty _. ((isub_name, name, l_attr, l_inh, l_inh_sib, next_dataty), ())) () expr)) of - (isub_name, name, l_attr, l_inh, l_inh_sib, next_dataty) # _ \<Rightarrow> - f isub_name name l_attr l_inh l_inh_sib next_dataty)" -definition "map_class_top = map_class_one rev" -definition "get_hierarchy_map f f_l x = L.flatten (L.flatten ( - let (l1, l2, l3) = f_l (L.map fst (get_class_hierarchy x)) in - L.map (\<lambda>name1. L.map (\<lambda>name2. L.map (f name1 name2) l3) l2) l1))" - -definition "class_arity = RBT.keys o (\<lambda>l. List.fold (\<lambda>x. RBT.insert x ()) l RBT.empty) o - L.flatten o L.flatten o map_class (\<lambda> _ _ l_attr _ _ _. - L.map (\<lambda> (_, OclTy_object (OclTyObj (OclTyCore ty_obj) _)) \<Rightarrow> [TyObj_ass_arity ty_obj] - | _ \<Rightarrow> []) l_attr)" - -definition "map_class_gen_h'_inh f = - map_class_gen_h''''' (\<lambda>isub_name name _ l_inh l_subtree _. - let l_mem = \<lambda>l. List.member (L.map (\<lambda> OclClass n _ _ \<Rightarrow> String.to_list n) l) in - f isub_name - name - (\<lambda>n. let n = String.to_list n in - if (* TODO use \<triangleq> *) n = String.to_list name then EQ else - if l_mem (of_linh l_inh) n then GT else - if l_mem l_subtree n then LT else - UN'))" - -definition "m_class_gen2 base_attr f print = - (let m_base_attr = \<lambda> OclClass n l b \<Rightarrow> OclClass n (base_attr l) b - ; f_base_attr = L.map m_base_attr in - map_class_gen_h''''' (\<lambda>isub_name name nl_attr l_inh l_subtree next_dataty. - f name - l_inh - l_subtree - (L.flatten (L.flatten (L.map ( - let print_astype = - print - (L.map (map_linh m_base_attr) l_inh) - (f_base_attr l_subtree) - next_dataty - ; nl_attr = base_attr nl_attr in - (\<lambda>(l_hierarchy, l). - L.map - (print_astype l_hierarchy (isub_name, name, nl_attr) o m_base_attr) - l)) - [ (EQ, [OclClass name nl_attr next_dataty]) - , (GT, of_linh l_inh) - , (LT, l_subtree) - , (UN', of_linh_sib l_inh) ])))))" - -definition "f_less2 = - (\<lambda>f l. rev (fst (fold_less2 (\<lambda>(l, _). (l, None)) (\<lambda>x y (l, acc). (f x y acc # l, Some y)) l ([], None)))) - (\<lambda>a b _. (a,b))" - -definition "m_class_gen3_GE base_attr f print = - (let m_base_attr = \<lambda> OclClass n l b \<Rightarrow> OclClass n (base_attr l) b - ; f_base_attr = L.map m_base_attr in - map_class_gen_h''''' (\<lambda>isub_name name nl_attr l_inh l_subtree next_dataty. - let print_astype = - print - (L.map (map_linh m_base_attr) l_inh) - (f_base_attr l_subtree) - next_dataty in - L.flatten - [ f (L.flatten (L.map (\<lambda> (l_hierarchy, l). - L.map (\<lambda> OclClass h_name _ _ \<Rightarrow> print_astype name h_name h_name) l) - [ (GT, of_linh l_inh) ])) - , f (L.flatten (L.map (\<lambda> (l_hierarchy, l). - L.map (\<lambda> (h_name, hh_name). print_astype name h_name hh_name) (f_less2 (L.map (\<lambda> OclClass n _ _ \<Rightarrow> n) l))) - [ (GT, of_linh l_inh) ])) - , f (L.flatten (L.map (\<lambda> (l_hierarchy, l). - L.flatten (L.map (\<lambda> OclClass h_name _ _ \<Rightarrow> - L.map (\<lambda> OclClass sib_name _ _ \<Rightarrow> print_astype name sib_name h_name) (of_linh_sib l_inh)) l)) - [ (GT, of_linh l_inh) ])) ]))" - -definition "m_class_gen3 base_attr f print = - (let m_base_attr = \<lambda> OclClass n l b \<Rightarrow> OclClass n (base_attr l) b - ; f_base_attr = L.map m_base_attr in - map_class_gen_h''''' (\<lambda>isub_name name nl_attr l_inh l_subtree next_dataty. - let print_astype = - print - (L.map (map_linh m_base_attr) l_inh) - (f_base_attr l_subtree) - next_dataty in - f (L.flatten ( - let l_tree = L.map (\<lambda>(cmp,l). (cmp, f_base_attr l)) - [ (EQ, [OclClass name nl_attr next_dataty]) - , (GT, of_linh l_inh) - , (LT, l_subtree) - , (UN', of_linh_sib l_inh) ] in - (\<lambda>f. L.flatten (L.map (\<lambda> (l_hierarchy, l). L.map (f l_hierarchy) l) l_tree)) - (\<lambda> l_hierarchy1. \<lambda> OclClass h_name hl_attr hb \<Rightarrow> - (\<lambda>f. L.flatten (L.map (\<lambda> (l_hierarchy, l). L.map (f l_hierarchy) l) l_tree)) - (\<lambda> l_hierarchy2. \<lambda> OclClass hh_name hhl_attr hhb \<Rightarrow> - print_astype - name - h_name - hh_name))))))" - -definition "m_class_default = (\<lambda>_ _ _. id)" -definition "m_class base_attr f print = m_class_gen2 base_attr f (\<lambda>_ _ _. print)" -definition "m_class3_GE base_attr f print = m_class_gen3_GE base_attr f (\<lambda>_ _ _. print)" -definition "m_class' base_attr print = - m_class base_attr m_class_default (\<lambda> l_hierarchy x0 x1. [ print l_hierarchy x0 x1 ])" - -definition "map_class_nupl2'_inh f = List.map_filter id o - (m_class' id (\<lambda>compare (_, name, _). \<lambda> OclClass h_name _ _ \<Rightarrow> - if compare = GT then Some (f name h_name) else None))" - -definition "map_class_nupl2'_inh_large f = List.map_filter id o - (m_class' id (\<lambda>compare (_, name, _). \<lambda> OclClass h_name _ _ \<Rightarrow> - if compare = GT - | compare = UN' then Some (f name h_name) else None))" - -definition "map_class_nupl2''_inh f = List.map_filter id o - (m_class_gen2 id m_class_default (\<lambda> l_inh _ _ compare (_, name, _). \<lambda> OclClass h_name _ h_subtree \<Rightarrow> - [ if compare = GT then - Some (f name h_name (L.map (\<lambda>x. (x, List.member (of_linh l_inh) x)) h_subtree)) - else - None]))" - -definition "map_class_nupl2l'_inh_gen f = List.map_filter id o - (m_class_gen2 id m_class_default (\<lambda> l_inh l_subtree _ compare (_, name, _). \<lambda> OclClass h_name _ _ \<Rightarrow> - [ if compare = GT then - Some (f l_subtree name (fst (List.fold (\<lambda>x. \<lambda> (l, True, prev_x) \<Rightarrow> (l, True, prev_x) - | (l, False, prev_x) \<Rightarrow> - case Inh x of OclClass n _ next_d \<Rightarrow> - ( (x, L.map (\<lambda> OclClass n l next_d \<Rightarrow> - (OclClass n l next_d, n = prev_x)) - next_d) - # l - , n = h_name - , n)) - l_inh - ([], False, name)))) - else - None]))" - -definition "map_class_nupl2l'_inh f = map_class_nupl2l'_inh_gen (\<lambda>_ x l. f x l)" - -definition "map_class_nupl3'_LE'_inh f = L.flatten o map_class_nupl2l'_inh_gen (\<lambda>l_subtree x l. - L.map - (\<lambda>name_bot. f name_bot x l) - (x # L.map (\<lambda> OclClass n _ _ \<Rightarrow> n) l_subtree))" - -definition "map_class_nupl3'_GE_inh = m_class3_GE id id" - -definition "map_class_inh l_inherited = L.map (\<lambda> OclClass _ l _ \<Rightarrow> l) (of_inh (map_inh of_linh l_inherited))" - -definition "find_inh name class = - (case fold_class - (\<lambda>_ name0 _ l_inh _ _ accu. - Pair () (if accu = None & name \<triangleq> name0 then - Some (L.map (\<lambda>OclClass n _ _ \<Rightarrow> n) (of_inh l_inh)) - else - accu)) - None - class - of (_, Some l) \<Rightarrow> l)" - -end diff --git a/Citadelle/src/compiler/meta/Meta_UML_extended.thy b/Citadelle/src/compiler/meta/Meta_UML_extended.thy deleted file mode 100644 index 2bd589496b9afe99e526cbaf5bcb5685dc7ab1bf..0000000000000000000000000000000000000000 --- a/Citadelle/src/compiler/meta/Meta_UML_extended.thy +++ /dev/null @@ -1,158 +0,0 @@ -(****************************************************************************** - * 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. - ******************************************************************************) - -section\<open>OCL Meta-Model aka. AST definition of OCL (II)\<close> - -theory Meta_UML_extended -imports "../../compiler_generic/Init" -begin - -subsection\<open>Type Definition\<close> - -datatype internal_oid = Oid nat -datatype internal_oids = Oids nat \<comment> \<open>start\<close> - nat \<comment> \<open>oid for assoc (incremented from start)\<close> - nat \<comment> \<open>oid for inh (incremented from start)\<close> - -datatype ocl_def_base = OclDefInteger "string" \<comment> \<open>integer digit\<close> - | OclDefReal "string \<comment> \<open>integer digit (left)\<close> \<times> string \<comment> \<open>integer digit (right)\<close>" - | OclDefString "string" - -datatype ocl_data_shallow = ShallB_term ocl_def_base - | ShallB_str string \<comment> \<open>binding\<close> - | ShallB_self internal_oid - | ShallB_list "ocl_data_shallow list" - -datatype 'a ocl_list_attr = OclAttrNoCast 'a \<comment> \<open>inh, own\<close> - | OclAttrCast - string \<comment> \<open>cast from\<close> - "'a ocl_list_attr" \<comment> \<open>cast entity\<close> - 'a \<comment> \<open>inh, own\<close> - -record ocl_instance_single = Inst_name :: "string option" \<comment> \<open>None: fresh name to be generated\<close> - Inst_ty :: "string option" \<comment> \<open>type\<close> - Inst_attr_with :: "string \<comment> \<open>name\<close> option" - Inst_attr :: "(( (string \<comment> \<open>pre state\<close> \<times> string \<comment> \<open>post state\<close>) option - \<comment> \<open>state used when \<open>ocl_data_shallow\<close> is an object variable (for retrieving its oid)\<close> - \<times> string \<comment> \<open>name\<close> - \<times> ocl_data_shallow) list) \<comment> \<open>inh and own\<close> - ocl_list_attr" - -datatype ocl_instance = OclInstance "ocl_instance_single list" \<comment> \<open>mutual recursive\<close> - -datatype ocl_def_base_l = OclDefBase "ocl_def_base list" - -datatype 'a ocl_def_state_core = OclDefCoreAdd ocl_instance_single - | OclDefCoreBinding 'a - -datatype ocl_def_state = OclDefSt string \<comment> \<open>name\<close> - "string \<comment> \<open>name\<close> ocl_def_state_core list" - -datatype ocl_def_pp_core = OclDefPPCoreAdd "string \<comment> \<open>name\<close> ocl_def_state_core list" - | OclDefPPCoreBinding string \<comment> \<open>name\<close> - -datatype ocl_def_transition = OclDefPP - "string option" \<comment> \<open>None: fresh name to be generated\<close> - ocl_def_pp_core \<comment> \<open>pre\<close> - "ocl_def_pp_core option" \<comment> \<open>post\<close> \<comment> \<open>None: same as pre\<close> - -datatype ocl_class_tree = OclClassTree nat \<comment> \<open>nb child\<close> - nat \<comment> \<open>depth\<close> - -subsection\<open>Object ID Management\<close> - -definition "oidInit = (\<lambda> Oid n \<Rightarrow> Oids n n n)" - -definition "oidSucAssoc = (\<lambda> Oids n1 n2 n3 \<Rightarrow> Oids n1 (Succ n2) (Succ n3))" -definition "oidSucInh = (\<lambda> Oids n1 n2 n3 \<Rightarrow> Oids n1 n2 (Succ n3))" -definition "oidGetAssoc = (\<lambda> Oids _ n _ \<Rightarrow> Oid n)" -definition "oidGetInh = (\<lambda> Oids _ _ n \<Rightarrow> Oid n)" - -definition "oidReinitAll = (\<lambda>Oids n1 _ _ \<Rightarrow> Oids n1 n1 n1)" -definition "oidReinitInh = (\<lambda>Oids n1 n2 _ \<Rightarrow> Oids n1 n2 n2)" - -subsection\<open>Operations of Fold, Map, ..., on the Meta-Model\<close> - -definition "ocl_instance_single_empty = - \<lparr> Inst_name = None, Inst_ty = None, Inst_attr_with = None, Inst_attr = OclAttrNoCast [] \<rparr>" - -fun map_data_shallow_self where - "map_data_shallow_self f e = (\<lambda> ShallB_self s \<Rightarrow> f s - | ShallB_list l \<Rightarrow> ShallB_list (List.map (map_data_shallow_self f) l) - | x \<Rightarrow> x) e" - -fun map_list_attr where - "map_list_attr f e = - (\<lambda> OclAttrNoCast x \<Rightarrow> OclAttrNoCast (f x) - | OclAttrCast c_from l_attr x \<Rightarrow> OclAttrCast c_from (map_list_attr f l_attr) (f x)) e" - -definition "map_instance_single f ocli = ocli \<lparr> Inst_attr := map_list_attr (L.map f) (Inst_attr ocli) \<rparr>" - -fun fold_list_attr where - "fold_list_attr cast_from f l_attr accu = (case l_attr of - OclAttrNoCast x \<Rightarrow> f cast_from x accu - | OclAttrCast c_from l_attr x \<Rightarrow> fold_list_attr (Some c_from) f l_attr (f cast_from x accu))" - -definition "inst_ty0 ocli = (case Inst_ty ocli of Some ty \<Rightarrow> Some ty - | None \<Rightarrow> (case Inst_attr ocli of OclAttrCast ty _ _ \<Rightarrow> Some ty - | _ \<Rightarrow> None))" -definition "inst_ty ocli = (case inst_ty0 ocli of Some ty \<Rightarrow> ty)" - -definition "fold_instance_single f ocli = fold_list_attr (inst_ty0 ocli) (\<lambda> Some x \<Rightarrow> f x) (Inst_attr ocli)" -definition "fold_instance_single' f ocli = fold_list_attr (Inst_ty ocli) f (Inst_attr ocli)" - -definition "str_of_def_base = (\<lambda> OclDefInteger _ \<Rightarrow> \<open>Integer\<close> - | OclDefReal _ \<Rightarrow> \<open>Real\<close> - | OclDefString _ \<Rightarrow> \<open>String\<close>)" - -fun str_of_data_shallow where - \<open>str_of_data_shallow e = (\<lambda> ShallB_term b \<Rightarrow> str_of_def_base b - | ShallB_str s \<Rightarrow> \<open>"\<close> @@ s @@ \<open>"\<close> - | ShallB_self _ \<Rightarrow> \<open>(*object_oid*)\<close> - | ShallB_list l \<Rightarrow> \<open>[ \<close> @@ String_concatWith \<open>, \<close> (List.map str_of_data_shallow l) @@ \<open> ]\<close>) e\<close> - -definition "map_inst_single_self f = - map_instance_single - (map_prod id - (map_prod id - (map_data_shallow_self f)))" - -end diff --git a/Citadelle/src/compiler/meta/Parser_HKB.thy b/Citadelle/src/compiler/meta/Parser_HKB.thy deleted file mode 100644 index 7e64c261b9d31131301ee3cda26b5314a3dfd1e7..0000000000000000000000000000000000000000 --- a/Citadelle/src/compiler/meta/Parser_HKB.thy +++ /dev/null @@ -1,155 +0,0 @@ -(****************************************************************************** - * HOL-HKB - * - * Copyright (c) 2017-2018 Virginia Tech, USA - * 2018-2019 Université Paris-Saclay, Univ. Paris-Sud, France - * - * 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. - ******************************************************************************) - -section\<open>Instantiating the Parser of Haskabelle\<close> - -theory Parser_HKB -imports Meta_HKB - "../../compiler_generic/meta_isabelle/Parser_init" -begin - -subsection\<open>Main\<close> - -context Parse -begin - -definition "of_gen_meta a b = rec_gen_meta - (ap1 a (b \<open>Gen_apply_hol\<close>) (of_string a b)) - (ap1 a (b \<open>Gen_apply_sml\<close>) (of_string a b)) - (ap2 a (b \<open>Gen_apply_sml_cmd\<close>) (of_string a b) (of_string a b)) - (b \<open>Gen_no_apply\<close>)" - -definition "of_ThyName a b = rec_ThyName - (ap1 a (b \<open>ThyName\<close>) (of_string a b))" - -definition "of_Name a b = rec_Name - (ap2 a (b \<open>QName\<close>) (of_ThyName a b) (of_string a b)) - (ap1 a (b \<open>Name\<close>) (of_string a b))" - -definition "of_Sort a b = of_list a b (of_Name a b)" - -definition "of_Type a b = (\<lambda>f1 f2 f3. rec_Type f1 (\<lambda>_ _. f2) f3) - (ap2 a (b \<open>Type\<close>) (of_Name a b) (of_list a b snd)) - (ar2 a (b \<open>Func\<close>) id) - (ap1 a (b \<open>TVar\<close>) (of_Name a b)) - (b \<open>NoType\<close>)" - -definition "of_Literal a b = rec_Literal - (ap1 a (b \<open>Int\<close>) (of_nat a b)) - (ap1 a (b \<open>String\<close>) (of_string a b))" - -definition "of_TLD_aux f_rec a b = (\<lambda>f1 f2 f3 f4 f5 f6 f7 f8 f9 f10 f11 f12 f13 f14 f15 f16 f17. f_rec f1 f2 (co1 K f3) (\<lambda>_ _. f4) (\<lambda>_ _ _. f5) (\<lambda>l _. f6 (map (map_prod snd snd) l)) (\<lambda>_ l. f7 (map (map_prod snd snd) l)) (\<lambda>_ l. f8 (map snd l)) (\<lambda>a l. f9 a (map (map_prod id snd) l)) (K (f10 o map (map_prod id snd))) (\<lambda>a l. f11 a (map snd l)) (K f12) (f13 o map_prod snd snd) (K f14) (\<lambda>_ _. f15) (K f16) (f17 o map (map_prod snd snd))) - (ap1 a (b \<open>Literal\<close>) (of_Literal a b)) - (ap1 a (b \<open>Const\<close>) (of_Name a b)) - (ar2 a (b \<open>Abs\<close>) (of_Name a b)) - (ar2 a (b \<open>App\<close>) id) - (ar3 a (b \<open>If\<close>) id id) - (ap2 a (b \<open>Let\<close>) (of_list a b (of_pair a b id id)) id) - (ap2 a (b \<open>Case\<close>) (of_list a b (of_pair a b id id)) id) - (ap2 a (b \<open>ListCompr\<close>) (of_list a b id) id) - (ap2 a (b \<open>RecConstr\<close>) (of_Name a b) (of_list a b (of_pair a b (of_Name a b) id))) - (ap2 a (b \<open>RecUpdate\<close>) (of_list a b (of_pair a b (of_Name a b) id)) id) - (ap3 a (b \<open>DoBlock\<close>) (of_string a b) (of_list a b id) (of_string a b)) - (ar1 a (b \<open>Parenthesized\<close>)) - (* *) - (ap1 a (b \<open>Generator\<close>) (of_pair a b id id)) - (ar1 a (b \<open>Guard\<close>)) - (* *) - (ar2 a (b \<open>DoGenerator\<close>) id) - (ar1 a (b \<open>DoQualifier\<close>)) - (ap1 a (b \<open>DoLetStmt\<close>) (of_list a b (of_pair a b id id)))" - -definition "of_Term = of_TLD_aux rec_Term" -definition "of_ListComprFragment = of_TLD_aux rec_ListComprFragment" -definition "of_DoBlockFragment = of_TLD_aux rec_DoBlockFragment" - -definition "of_Pat = of_Term" - -definition "of_TypeSpec a b = rec_TypeSpec - (ap2 a (b \<open>TypeSpec\<close>) (of_list a b (of_Name a b)) (of_Name a b))" - -definition "of_TypeSign a b = rec_TypeSign - (ap3 a (b \<open>TypeSign\<close>) (of_Name a b) (of_list a b (of_pair a b (of_Name a b) (of_Sort a b))) (of_Type a b))" - -definition "of_Function_Kind b = rec_Function_Kind - (b \<open>Definition\<close>) - (b \<open>Primrec\<close>) - (b \<open>Fun\<close>) - (b \<open>Function_Sorry\<close>)" - -definition "of_Function_Stmt a b = rec_Function_Stmt - (ap3 a (b \<open>Function_Stmt\<close>) (of_Function_Kind b) (of_list a b (of_TypeSign a b)) (of_list a b (of_pair a b (of_pair a b (of_Name a b) (of_list a b (of_Pat a b))) (of_Term a b))))" - -definition "of_Stmt a b = rec_Stmt - (ap1 a (b \<open>Datatype\<close>) (of_list a b (of_pair a b (of_TypeSpec a b) (of_list a b (of_pair a b (of_Name a b) (of_list a b (of_Type a b))))))) - (ap2 a (b \<open>Record\<close>) (of_TypeSpec a b) (of_list a b (of_pair a b (of_Name a b) (of_Type a b)))) - (ap1 a (b \<open>TypeSynonym\<close>) (of_list a b (of_pair a b (of_TypeSpec a b) (of_Type a b)))) - (ap1 a (b \<open>Function\<close>) (of_Function_Stmt a b)) - (ap3 a (b \<open>Class\<close>) (of_Name a b) (of_list a b (of_Name a b)) (of_list a b (of_TypeSign a b))) - (ap4 a (b \<open>Instance\<close>) (of_Name a b) (of_Name a b) (of_list a b (of_pair a b (of_Name a b) (of_Sort a b))) (of_list a b (of_Function_Stmt a b))) - (ap1 a (b \<open>Comment\<close>) (of_string a b)) - (ap1 a (b \<open>SML\<close>) (of_Function_Stmt a b))" - -definition "of_Module a b = rec_Module - (ap4 a (b \<open>Module\<close>) (of_ThyName a b) (of_list a b (of_ThyName a b)) (of_list a b (of_Stmt a b)) (of_bool b))" - -definition "of_IsaUnit a b = rec_IsaUnit - (ap5 a (b \<open>IsaUnit\<close>) (of_pair a b (of_bool b) (of_nat a b)) (of_list a b (of_pair a b (of_string a b) (of_option a b (of_string a b)))) (of_gen_meta a b) (of_string a b) (of_pair a b (of_list a b (of_Module a b)) (of_bool b)))" - -end - -lemmas [code] = - Parse.of_gen_meta_def - Parse.of_ThyName_def - Parse.of_Name_def - Parse.of_Sort_def - Parse.of_Type_def - Parse.of_Literal_def - Parse.of_TLD_aux_def - Parse.of_Term_def - Parse.of_ListComprFragment_def - Parse.of_DoBlockFragment_def - Parse.of_Pat_def - Parse.of_TypeSpec_def - Parse.of_TypeSign_def - Parse.of_Function_Kind_def - Parse.of_Function_Stmt_def - Parse.of_Stmt_def - Parse.of_Module_def - Parse.of_IsaUnit_def - -end diff --git a/Citadelle/src/compiler/meta/Parser_META.thy b/Citadelle/src/compiler/meta/Parser_META.thy deleted file mode 100644 index 5b1e9fc5edda16629b162bef203fc8c16d17fcc8..0000000000000000000000000000000000000000 --- a/Citadelle/src/compiler/meta/Parser_META.thy +++ /dev/null @@ -1,368 +0,0 @@ -(****************************************************************************** - * Citadelle - * - * 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. - ******************************************************************************) - -section\<open>Instantiating the Parser of META\<close> - -theory Parser_META -imports Meta_META - Parser_UML - Parser_UML_extended - Parser_HKB -begin - -subsection\<open>Building Recursors for Records\<close> (* NOTE part to be automated *) - -definition "compiler_env_config_rec0 f env = f - (D_output_disable_thy env) - (D_output_header_thy env) - (D_ocl_oid_start env) - (D_output_position env) - (D_ocl_semantics env) - (D_input_class env) - (D_input_meta env) - (D_input_instance env) - (D_input_state env) - (D_output_header_force env) - (D_output_auto_bootstrap env) - (D_ocl_accessor env) - (D_ocl_HO_type env) - (D_hsk_constr env) - (D_output_sorry_dirty env)" - -definition "compiler_env_config_rec f env = compiler_env_config_rec0 f env - (compiler_env_config.more env)" - -(* *) - -lemma [code]: "compiler_env_config.extend = (\<lambda>env v. compiler_env_config_rec0 (co15 (\<lambda>f. f v) compiler_env_config_ext) env)" -by(intro ext, simp add: compiler_env_config_rec0_def - compiler_env_config.extend_def - co15_def K_def) -lemma [code]: "compiler_env_config.make = co15 (\<lambda>f. f ()) compiler_env_config_ext" -by(intro ext, simp add: compiler_env_config.make_def - co15_def) -lemma [code]: "compiler_env_config.truncate = compiler_env_config_rec (co15 K compiler_env_config.make)" -by(intro ext, simp add: compiler_env_config_rec0_def - compiler_env_config_rec_def - compiler_env_config.truncate_def - compiler_env_config.make_def - co15_def K_def) - -subsection\<open>Main\<close> - -context Parse -begin - -definition "of_ocl_flush_all a b = rec_ocl_flush_all - (b \<open>OclFlushAll\<close>)" - -definition "of_ocl_generic a b = rec_ocl_generic - (ap1 a (b \<open>OclGeneric\<close>) (of_string a b))" - -definition "of_floor a b = rec_floor - (b \<open>Floor1\<close>) - (b \<open>Floor2\<close>) - (b \<open>Floor3\<close>)" - -definition "of_all_meta_embedding a b = rec_all_meta_embedding - (ap1 a (b \<open>META_enum\<close>) (of_ocl_enum a b)) - (ap2 a (b \<open>META_class_raw\<close>) (of_floor a b) (of_ocl_class_raw a b (K of_unit))) - (ap1 a (b \<open>META_association\<close>) (of_ocl_association a b (K of_unit))) - (ap2 a (b \<open>META_ass_class\<close>) (of_floor a b) (of_ocl_ass_class a b)) - (ap2 a (b \<open>META_ctxt\<close>) (of_floor a b) (of_ocl_ctxt a b (K of_unit))) - - (ap1 a (b \<open>META_haskell\<close>) (of_IsaUnit a b)) - - (ap1 a (b \<open>META_class_synonym\<close>) (of_ocl_class_synonym a b)) - (ap1 a (b \<open>META_instance\<close>) (of_ocl_instance a b)) - (ap1 a (b \<open>META_def_base_l\<close>) (of_ocl_def_base_l a b)) - (ap2 a (b \<open>META_def_state\<close>) (of_floor a b) (of_ocl_def_state a b)) - (ap2 a (b \<open>META_def_transition\<close>) (of_floor a b) (of_ocl_def_transition a b)) - (ap1 a (b \<open>META_class_tree\<close>) (of_ocl_class_tree a b)) - (ap1 a (b \<open>META_flush_all\<close>) (of_ocl_flush_all a b)) - (ap1 a (b \<open>META_generic\<close>) (of_ocl_generic a b))" - -definition "of_generation_semantics_ocl a b = rec_generation_semantics_ocl - (b \<open>Gen_only_design\<close>) - (b \<open>Gen_only_analysis\<close>) - (b \<open>Gen_default\<close>)" - -definition "of_generation_lemma_mode a b = rec_generation_lemma_mode - (b \<open>Gen_sorry\<close>) - (b \<open>Gen_no_dirty\<close>)" - -definition "of_compiler_env_config a b f = compiler_env_config_rec - (ap16 a (b (ext \<open>compiler_env_config_ext\<close>)) - (of_bool b) - (of_option a b (of_pair a b (of_string a b) (of_pair a b (of_list a b (of_string a b)) (of_string a b)))) - (of_internal_oids a b) - (of_pair a b (of_nat a b) (of_nat a b)) - (of_generation_semantics_ocl a b) - (of_option a b (of_ocl_class a b)) - (of_list a b (of_all_meta_embedding a b)) - (of_list a b (of_pair a b (of_string\<^sub>b\<^sub>a\<^sub>s\<^sub>e a b) (of_pair a b (of_ocl_instance_single a b (K of_unit)) (of_internal_oids a b)))) - (of_list a b (of_pair a b (of_string\<^sub>b\<^sub>a\<^sub>s\<^sub>e a b) (of_list a b (of_pair a b (of_internal_oids a b) (of_ocl_def_state_core a b (of_pair a b (of_string a b) (of_ocl_instance_single a b (K of_unit)))))))) - (of_bool b) - (of_bool b) - (of_pair a b (of_list a b (of_string\<^sub>b\<^sub>a\<^sub>s\<^sub>e a b)) (of_list a b (of_string\<^sub>b\<^sub>a\<^sub>s\<^sub>e a b))) - (of_list a b (of_string\<^sub>b\<^sub>a\<^sub>s\<^sub>e a b)) - (of_list a b (of_string\<^sub>b\<^sub>a\<^sub>s\<^sub>e a b)) - (of_pair a b (of_option a b (of_generation_lemma_mode a b)) (of_bool b)) - (f a b))" - -end - -lemmas [code] = - Parse.of_ocl_flush_all_def - Parse.of_ocl_generic_def - Parse.of_floor_def - Parse.of_all_meta_embedding_def - Parse.of_generation_semantics_ocl_def - Parse.of_generation_lemma_mode_def - Parse.of_compiler_env_config_def - -section\<open>Finalizing the Parser\<close> - -text\<open>It should be feasible to invent a meta-command (e.g., @{text "datatype'"}) -to automatically generate the previous recursors in @{text Parse}. - -Otherwise as an extra check, one can also overload polymorphic cartouches in @{theory FOCL.Init} -to really check that all the given constructor exists at the time of editing -(similarly as writing @{verbatim "@{term ...}"}, -when it is embedded in a @{verbatim "text"} command).\<close> - -subsection\<open>Isabelle Syntax\<close> - -locale Parse_Isabelle -begin - -definition "Of_Pair = \<open>Pair\<close>" -definition "Of_Nil = \<open>Nil\<close>" -definition "Of_Cons = \<open>Cons\<close>" -definition "Of_None = \<open>None\<close>" -definition "Of_Some = \<open>Some\<close>" - -\<comment> \<open>recursor types\<close> - -definition "of_pair a b f1 f2 = (\<lambda>f. \<lambda>(c, d) \<Rightarrow> f c d) - (ap2 a (b Of_Pair) f1 f2)" - -definition "of_list a b f = (\<lambda>f0. rec_list f0 o co1 K) - (b Of_Nil) - (ar2 a (b Of_Cons) f)" - -definition "of_option a b f = rec_option - (b Of_None) - (ap1 a (b Of_Some) f)" - -\<comment> \<open>ground types\<close> - -definition "of_unit b = case_unit - (b \<open>()\<close>)" - -definition of_bool where "of_bool b = case_bool - (b \<open>True\<close>) - (b \<open>False\<close>)" - -definition "of_string_gen s_flatten s_st0 s_st a b s = - b (let s = textstr_of_str (\<lambda>c. \<open>(\<close> @@ s_flatten @@ \<open> \<close> @@ c @@ \<open>)\<close>) - (\<lambda>c \<Rightarrow> s_st0 (S.flatten [\<open> 0x\<close>, String.integer_to_digit16 c])) - (\<lambda>c. s_st (S.flatten [\<open> (\<close>, c, \<open>)\<close>])) - s in - S.flatten [ \<open>(\<close>, s, \<open>)\<close> ])" - -definition "of_string = of_string_gen \<open>Init.S.flatten\<close> - (\<lambda>s. S.flatten [\<open>(Init.ST0\<close>, s, \<open>)\<close>]) - (\<lambda>s. S.flatten [\<open>(Init.abr_string.SS_base (Init.string\<^sub>b\<^sub>a\<^sub>s\<^sub>e.ST\<close>, s, \<open>))\<close>])" -definition "of_string\<^sub>b\<^sub>a\<^sub>s\<^sub>e a b s = of_string_gen \<open>Init.String\<^sub>b\<^sub>a\<^sub>s\<^sub>e.flatten\<close> - (\<lambda>s. S.flatten [\<open>(Init.ST0_base\<close>, s, \<open>)\<close>]) - (\<lambda>s. S.flatten [\<open>(Init.string\<^sub>b\<^sub>a\<^sub>s\<^sub>e.ST\<close>, s, \<open>)\<close>]) - a - b - (String\<^sub>b\<^sub>a\<^sub>s\<^sub>e.to_String s)" - -definition of_nat where "of_nat a b = b o String.natural_to_digit10" - -end - -sublocale Parse_Isabelle < Parse "id" - Parse_Isabelle.of_string - Parse_Isabelle.of_string\<^sub>b\<^sub>a\<^sub>s\<^sub>e - Parse_Isabelle.of_nat - Parse_Isabelle.of_unit - Parse_Isabelle.of_bool - Parse_Isabelle.Of_Pair - Parse_Isabelle.Of_Nil - Parse_Isabelle.Of_Cons - Parse_Isabelle.Of_None - Parse_Isabelle.Of_Some -done - -context Parse_Isabelle begin - definition "compiler_env_config a b = - of_compiler_env_config a b (\<lambda> a b. - of_pair a b - (of_list a b (of_all_meta_embedding a b)) - (of_option a b (of_string a b)))" -end - -definition "isabelle_of_compiler_env_config = Parse_Isabelle.compiler_env_config" - -lemmas [code] = - Parse_Isabelle.Of_Pair_def - Parse_Isabelle.Of_Nil_def - Parse_Isabelle.Of_Cons_def - Parse_Isabelle.Of_None_def - Parse_Isabelle.Of_Some_def - - Parse_Isabelle.of_pair_def - Parse_Isabelle.of_list_def - Parse_Isabelle.of_option_def - Parse_Isabelle.of_unit_def - Parse_Isabelle.of_bool_def - Parse_Isabelle.of_string_gen_def - Parse_Isabelle.of_string_def - Parse_Isabelle.of_string\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def - Parse_Isabelle.of_nat_def - - Parse_Isabelle.compiler_env_config_def - -(* *) - -definition "isabelle_apply s l = S.flatten [s, S.flatten (L.map (\<lambda> s. S.flatten [\<open> (\<close>, s, \<open>)\<close>]) l)]" - -subsection\<open>SML Syntax\<close> - -locale Parse_SML -begin - -definition "Of_Pair = \<open>I\<close>" -definition "Of_Nil = \<open>nil\<close>" -definition "Of_Cons = \<open>uncurry cons\<close>" (* val cons2 = uncurry cons *) -definition "Of_None = \<open>NONE\<close>" -definition "Of_Some = \<open>SOME\<close>" - -(* *) - -definition "of_pair a b f1 f2 = (\<lambda>f. \<lambda>(c, d) \<Rightarrow> f c d) - (ap2 a (b Of_Pair) f1 f2)" - -definition "of_list a b f = (\<lambda>f0. rec_list f0 o co1 K) - (b Of_Nil) - (ar2 a (b Of_Cons) f)" - -definition "of_option a b f = rec_option - (b Of_None) - (ap1 a (b Of_Some) f)" - -(* *) - -definition "of_unit b = case_unit - (b \<open>()\<close>)" - -definition of_bool where "of_bool b = case_bool - (b \<open>true\<close>) - (b \<open>false\<close>)" - -definition \<open>sml_escape = - String.replace_integers (\<lambda>x. if x = 0x0A then \<open>\n\<close> - else if x = 0x05 then \<open>\005\<close> - else if x = 0x06 then \<open>\006\<close> - else if x = 0x7F then \<open>\127\<close> - else \<degree>x\<degree>)\<close> - -definition \<open>of_string a b = - (\<lambda>x. b (S.flatten [ \<open>(META.SS_base (META.ST "\<close> - , sml_escape x - , \<open>"))\<close>]))\<close> - -definition \<open>of_string\<^sub>b\<^sub>a\<^sub>s\<^sub>e a b = - (\<lambda>x. b (S.flatten [ \<open>(META.ST "\<close> - , sml_escape (String\<^sub>b\<^sub>a\<^sub>s\<^sub>e.to_String x) - , \<open>")\<close>]))\<close> - -definition of_nat where "of_nat a b = (\<lambda>x. b (S.flatten [\<open>(Code_Numeral.natural_of_integer \<close>, String.natural_to_digit10 x, \<open>)\<close>]))" - -end - -sublocale Parse_SML < Parse "\<lambda>c. case String.to_list c of x # xs \<Rightarrow> S.flatten [String.uppercase \<lless>[x]\<ggreater>, \<lless>xs\<ggreater>]" - Parse_SML.of_string - Parse_SML.of_string\<^sub>b\<^sub>a\<^sub>s\<^sub>e - Parse_SML.of_nat - Parse_SML.of_unit - Parse_SML.of_bool - Parse_SML.Of_Pair - Parse_SML.Of_Nil - Parse_SML.Of_Cons - Parse_SML.Of_None - Parse_SML.Of_Some -done - -context Parse_SML begin - definition "compiler_env_config a b = of_compiler_env_config a b (\<lambda> _. of_unit)" -end - -definition "sml_of_compiler_env_config = Parse_SML.compiler_env_config" - -lemmas [code] = - Parse_SML.Of_Pair_def - Parse_SML.Of_Nil_def - Parse_SML.Of_Cons_def - Parse_SML.Of_None_def - Parse_SML.Of_Some_def - - Parse_SML.of_pair_def - Parse_SML.of_list_def - Parse_SML.of_option_def - Parse_SML.of_unit_def - Parse_SML.of_bool_def - Parse_SML.of_string_def - Parse_SML.of_string\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def - Parse_SML.of_nat_def - - Parse_SML.sml_escape_def - Parse_SML.compiler_env_config_def - -(* *) - -definition "sml_apply s l = S.flatten [s, \<open> (\<close>, case l of x # xs \<Rightarrow> S.flatten [x, S.flatten (L.map (\<lambda>s. S.flatten [\<open>, \<close>, s]) xs)], \<open>)\<close> ]" - -end diff --git a/Citadelle/src/compiler/meta/Parser_UML.thy b/Citadelle/src/compiler/meta/Parser_UML.thy deleted file mode 100644 index 0621e0f480d9742a1e06f19e4532a2174dfb3713..0000000000000000000000000000000000000000 --- a/Citadelle/src/compiler/meta/Parser_UML.thy +++ /dev/null @@ -1,318 +0,0 @@ -(****************************************************************************** - * 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. - ******************************************************************************) - -section\<open>Instantiating the Parser of OCL (I)\<close> - -theory Parser_UML -imports Meta_UML - "../../compiler_generic/meta_isabelle/Parser_Pure" -begin - -subsection\<open>Building Recursors for Records\<close> (* NOTE part to be automated *) - -definition "ocl_multiplicity_rec0 f ocl = f - (TyMult ocl) - (TyRole ocl) - (TyCollect ocl)" - -definition "ocl_multiplicity_rec f ocl = ocl_multiplicity_rec0 f ocl - (ocl_multiplicity.more ocl)" - -definition "ocl_ty_class_node_rec0 f ocl = f - (TyObjN_ass_switch ocl) - (TyObjN_role_multip ocl) - (TyObjN_role_ty ocl)" - -definition "ocl_ty_class_node_rec f ocl = ocl_ty_class_node_rec0 f ocl - (ocl_ty_class_node.more ocl)" - -definition "ocl_ty_class_rec0 f ocl = f - (TyObj_name ocl) - (TyObj_ass_id ocl) - (TyObj_ass_arity ocl) - (TyObj_from ocl) - (TyObj_to ocl)" - -definition "ocl_ty_class_rec f ocl = ocl_ty_class_rec0 f ocl - (ocl_ty_class.more ocl)" - -definition "ocl_class_raw_rec0 f ocl = f - (ClassRaw_name ocl) - (ClassRaw_own ocl) - (ClassRaw_clause ocl) - (ClassRaw_abstract ocl)" - -definition "ocl_class_raw_rec f ocl = ocl_class_raw_rec0 f ocl - (ocl_class_raw.more ocl)" - -definition "ocl_association_rec0 f ocl = f - (OclAss_type ocl) - (OclAss_relation ocl)" - -definition "ocl_association_rec f ocl = ocl_association_rec0 f ocl - (ocl_association.more ocl)" - -definition "ocl_ctxt_pre_post_rec0 f ocl = f - (Ctxt_fun_name ocl) - (Ctxt_fun_ty ocl) - (Ctxt_expr ocl)" - -definition "ocl_ctxt_pre_post_rec f ocl = ocl_ctxt_pre_post_rec0 f ocl - (ocl_ctxt_pre_post.more ocl)" - -definition "ocl_ctxt_rec0 f ocl = f - (Ctxt_param ocl) - (Ctxt_ty ocl) - (Ctxt_clause ocl)" - -definition "ocl_ctxt_rec f ocl = ocl_ctxt_rec0 f ocl - (ocl_ctxt.more ocl)" - -(* *) - -lemma [code]: "ocl_class_raw.extend = (\<lambda>ocl v. ocl_class_raw_rec0 (co4 (\<lambda>f. f v) ocl_class_raw_ext) ocl)" -by(intro ext, simp add: ocl_class_raw_rec0_def - ocl_class_raw.extend_def - co4_def K_def) -lemma [code]: "ocl_class_raw.make = co4 (\<lambda>f. f ()) ocl_class_raw_ext" -by(intro ext, simp add: ocl_class_raw.make_def - co4_def) -lemma [code]: "ocl_class_raw.truncate = ocl_class_raw_rec (co4 K ocl_class_raw.make)" -by(intro ext, simp add: ocl_class_raw_rec0_def - ocl_class_raw_rec_def - ocl_class_raw.truncate_def - ocl_class_raw.make_def - co4_def K_def) - -lemma [code]: "ocl_association.extend = (\<lambda>ocl v. ocl_association_rec0 (co2 (\<lambda>f. f v) ocl_association_ext) ocl)" -by(intro ext, simp add: ocl_association_rec0_def - ocl_association.extend_def - co2_def K_def) -lemma [code]: "ocl_association.make = co2 (\<lambda>f. f ()) ocl_association_ext" -by(intro ext, simp add: ocl_association.make_def - co2_def) -lemma [code]: "ocl_association.truncate = ocl_association_rec (co2 K ocl_association.make)" -by(intro ext, simp add: ocl_association_rec0_def - ocl_association_rec_def - ocl_association.truncate_def - ocl_association.make_def - co2_def K_def) - -subsection\<open>Main\<close> - -context Parse -begin - -definition "of_ocl_collection b = rec_ocl_collection - (b \<open>Set\<close>) - (b \<open>Sequence\<close>) - (b \<open>Ordered0\<close>) - (b \<open>Subsets0\<close>) - (b \<open>Union0\<close>) - (b \<open>Redefines0\<close>) - (b \<open>Derived0\<close>) - (b \<open>Qualifier0\<close>) - (b \<open>Nonunique0\<close>)" - -definition "of_ocl_multiplicity_single a b = rec_ocl_multiplicity_single - (ap1 a (b \<open>Mult_nat\<close>) (of_nat a b)) - (b \<open>Mult_star\<close>) - (b \<open>Mult_infinity\<close>)" - -definition "of_ocl_multiplicity a b f = ocl_multiplicity_rec - (ap4 a (b (ext \<open>ocl_multiplicity_ext\<close>)) - (of_list a b (of_pair a b (of_ocl_multiplicity_single a b) (of_option a b (of_ocl_multiplicity_single a b)))) - (of_option a b (of_string a b)) - (of_list a b (of_ocl_collection b)) - (f a b))" - -definition "of_ocl_ty_class_node a b f = ocl_ty_class_node_rec - (ap4 a (b (ext \<open>ocl_ty_class_node_ext\<close>)) - (of_nat a b) - (of_ocl_multiplicity a b (K of_unit)) - (of_string a b) - (f a b))" - -definition "of_ocl_ty_class a b f = ocl_ty_class_rec - (ap6 a (b (ext \<open>ocl_ty_class_ext\<close>)) - (of_string a b) - (of_nat a b) - (of_nat a b) - (of_ocl_ty_class_node a b (K of_unit)) - (of_ocl_ty_class_node a b (K of_unit)) - (f a b))" - -definition "of_ocl_ty_obj_core a b = rec_ocl_ty_obj_core - (ap1 a (b \<open>OclTyCore_pre\<close>) (of_string a b)) - (ap1 a (b \<open>OclTyCore\<close>) (of_ocl_ty_class a b (K of_unit)))" - -definition "of_ocl_ty_obj a b = rec_ocl_ty_obj - (ap2 a (b \<open>OclTyObj\<close>) (of_ocl_ty_obj_core a b) (of_list a b (of_list a b (of_ocl_ty_obj_core a b))))" - -definition "of_ocl_ty a b = (\<lambda>f1 f2 f3 f4 f5 f6 f7 f8 f9 f10 f11 f12 f13 f14 f15. - rec_ocl_ty f1 f2 f3 f4 f5 f6 - f7 (K o f8) (\<lambda>_ _. f9) (f10 o map_prod id snd) (\<lambda>_ _. f11) f12 f13 f14 f15) - (b \<open>OclTy_base_void\<close>) - (b \<open>OclTy_base_boolean\<close>) - (b \<open>OclTy_base_integer\<close>) - (b \<open>OclTy_base_unlimitednatural\<close>) - (b \<open>OclTy_base_real\<close>) - (b \<open>OclTy_base_string\<close>) - (ap1 a (b \<open>OclTy_object\<close>) (of_ocl_ty_obj a b)) - (ar2 a (b \<open>OclTy_collection\<close>) (of_ocl_multiplicity a b (K of_unit))) - (ar2 a (b \<open>OclTy_pair\<close>) id) - (ap1 a (b \<open>OclTy_binding\<close>) (of_pair a b (of_option a b (of_string a b)) id)) - (ar2 a (b \<open>OclTy_arrow\<close>) id) - (ap1 a (b \<open>OclTy_class_syn\<close>) (of_string a b)) - (ap1 a (b \<open>OclTy_enum\<close>) (of_string a b)) - (ap1 a (b \<open>OclTy_raw\<close>) (of_string a b))" - -definition "of_ocl_association_type a b = rec_ocl_association_type - (b \<open>OclAssTy_native_attribute\<close>) - (b \<open>OclAssTy_association\<close>) - (b \<open>OclAssTy_composition\<close>) - (b \<open>OclAssTy_aggregation\<close>)" - -definition "of_ocl_association_relation a b = rec_ocl_association_relation - (ap1 a (b \<open>OclAssRel\<close>) - (of_list a b (of_pair a b (of_ocl_ty_obj a b) (of_ocl_multiplicity a b (K of_unit)))))" - -definition "of_ocl_association a b f = ocl_association_rec - (ap3 a (b (ext \<open>ocl_association_ext\<close>)) - (of_ocl_association_type a b) - (of_ocl_association_relation a b) - (f a b))" - -definition "of_ocl_ctxt_prefix a b = rec_ocl_ctxt_prefix - (b \<open>OclCtxtPre\<close>) - (b \<open>OclCtxtPost\<close>)" - -definition "of_ocl_ctxt_term a b = (\<lambda>f0 f1 f2. rec_ocl_ctxt_term f0 f1 (co1 K f2)) - (ap2 a (b \<open>T_pure\<close>) (of_pure_term a b) (of_option a b (of_string a b))) - (ap2 a (b \<open>T_to_be_parsed\<close>) (of_string a b) (of_string a b)) - (ar2 a (b \<open>T_lambda\<close>) (of_string a b))" - -definition "of_ocl_prop a b = rec_ocl_prop - (ap2 a (b \<open>OclProp_ctxt\<close>) (of_option a b (of_string a b)) (of_ocl_ctxt_term a b))" - -definition "of_ocl_ctxt_term_inv a b = rec_ocl_ctxt_term_inv - (ap2 a (b \<open>T_inv\<close>) (of_bool b) (of_ocl_prop a b))" - -definition "of_ocl_ctxt_term_pp a b = rec_ocl_ctxt_term_pp - (ap2 a (b \<open>T_pp\<close>) (of_ocl_ctxt_prefix a b) (of_ocl_prop a b)) - (ap1 a (b \<open>T_invariant\<close>) (of_ocl_ctxt_term_inv a b))" - -definition "of_ocl_ctxt_pre_post a b f = ocl_ctxt_pre_post_rec - (ap4 a (b (ext \<open>ocl_ctxt_pre_post_ext\<close>)) - (of_string a b) - (of_ocl_ty a b) - (of_list a b (of_ocl_ctxt_term_pp a b)) - (f a b))" - -definition "of_ocl_ctxt_clause a b = rec_ocl_ctxt_clause - (ap1 a (b \<open>Ctxt_pp\<close>) (of_ocl_ctxt_pre_post a b (K of_unit))) - (ap1 a (b \<open>Ctxt_inv\<close>) (of_ocl_ctxt_term_inv a b))" - -definition "of_ocl_ctxt a b f = ocl_ctxt_rec - (ap4 a (b (ext \<open>ocl_ctxt_ext\<close>)) - (of_list a b (of_string a b)) - (of_ocl_ty_obj a b) - (of_list a b (of_ocl_ctxt_clause a b)) - (f a b))" - -definition "of_ocl_class a b = (\<lambda>f0 f1 f2 f3. rec_ocl_class (ap3 a f0 f1 f2 f3)) - (b \<open>OclClass\<close>) - (of_string a b) - (of_list a b (of_pair a b (of_string a b) (of_ocl_ty a b))) - (of_list a b snd)" - -definition "of_ocl_class_raw a b f = ocl_class_raw_rec - (ap5 a (b (ext \<open>ocl_class_raw_ext\<close>)) - (of_ocl_ty_obj a b) - (of_list a b (of_pair a b (of_string a b) (of_ocl_ty a b))) - (of_list a b (of_ocl_ctxt_clause a b)) - (of_bool b) - (f a b))" - -definition "of_ocl_ass_class a b = rec_ocl_ass_class - (ap2 a (b \<open>OclAssClass\<close>) - (of_ocl_association a b (K of_unit)) - (of_ocl_class_raw a b (K of_unit)))" - -definition "of_ocl_class_synonym a b = rec_ocl_class_synonym - (ap2 a (b \<open>OclClassSynonym\<close>) - (of_string a b) - (of_ocl_ty a b))" - -definition "of_ocl_enum a b = rec_ocl_enum - (ap2 a (b \<open>OclEnum\<close>) - (of_string a b) - (of_list a b (of_string a b)))" - -end - -lemmas [code] = - Parse.of_ocl_collection_def - Parse.of_ocl_multiplicity_single_def - Parse.of_ocl_multiplicity_def - Parse.of_ocl_ty_class_node_def - Parse.of_ocl_ty_class_def - Parse.of_ocl_ty_obj_core_def - Parse.of_ocl_ty_obj_def - Parse.of_ocl_ty_def - Parse.of_ocl_association_type_def - Parse.of_ocl_association_relation_def - Parse.of_ocl_association_def - Parse.of_ocl_ctxt_prefix_def - Parse.of_ocl_ctxt_term_def - Parse.of_ocl_prop_def - Parse.of_ocl_ctxt_term_inv_def - Parse.of_ocl_ctxt_term_pp_def - Parse.of_ocl_ctxt_pre_post_def - Parse.of_ocl_ctxt_clause_def - Parse.of_ocl_ctxt_def - Parse.of_ocl_class_def - Parse.of_ocl_class_raw_def - Parse.of_ocl_ass_class_def - Parse.of_ocl_class_synonym_def - Parse.of_ocl_enum_def - -end diff --git a/Citadelle/src/compiler/meta/Parser_UML_extended.thy b/Citadelle/src/compiler/meta/Parser_UML_extended.thy deleted file mode 100644 index 0b5fe8b9aaaaa90eac6c0c0b0b86239ac0fc6583..0000000000000000000000000000000000000000 --- a/Citadelle/src/compiler/meta/Parser_UML_extended.thy +++ /dev/null @@ -1,162 +0,0 @@ -(****************************************************************************** - * 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. - ******************************************************************************) - -section\<open>Instantiating the Parser of OCL (II)\<close> - -theory Parser_UML_extended -imports Meta_UML_extended - "../../compiler_generic/meta_isabelle/Parser_init" -begin - -subsection\<open>Building Recursors for Records\<close> (* NOTE part to be automated *) - -definition "ocl_instance_single_rec0 f ocl = f - (Inst_name ocl) - (Inst_ty ocl) - (Inst_attr_with ocl) - (Inst_attr ocl)" - -definition "ocl_instance_single_rec f ocl = ocl_instance_single_rec0 f ocl - (ocl_instance_single.more ocl)" - -(* *) - -lemma [code]: "ocl_instance_single.extend = (\<lambda>ocl v. ocl_instance_single_rec0 (co4 (\<lambda>f. f v) ocl_instance_single_ext) ocl)" -by(intro ext, simp add: ocl_instance_single_rec0_def - ocl_instance_single.extend_def - co4_def K_def) -lemma [code]: "ocl_instance_single.make = co4 (\<lambda>f. f ()) ocl_instance_single_ext" -by(intro ext, simp add: ocl_instance_single.make_def - co4_def) -lemma [code]: "ocl_instance_single.truncate = ocl_instance_single_rec (co4 K ocl_instance_single.make)" -by(intro ext, simp add: ocl_instance_single_rec0_def - ocl_instance_single_rec_def - ocl_instance_single.truncate_def - ocl_instance_single.make_def - co4_def K_def) - -subsection\<open>Main\<close> - -context Parse -begin - -definition "of_internal_oid a b = rec_internal_oid - (ap1 a (b \<open>Oid\<close>) (of_nat a b))" - -definition "of_internal_oids a b = rec_internal_oids - (ap3 a (b \<open>Oids\<close>) - (of_nat a b) - (of_nat a b) - (of_nat a b))" - -definition "of_ocl_def_base a b = rec_ocl_def_base - (ap1 a (b \<open>OclDefInteger\<close>) (of_string a b)) - (ap1 a (b \<open>OclDefReal\<close>) (of_pair a b (of_string a b) (of_string a b))) - (ap1 a (b \<open>OclDefString\<close>) (of_string a b))" - -definition "of_ocl_data_shallow a b = rec_ocl_data_shallow - (ap1 a (b \<open>ShallB_term\<close>) (of_ocl_def_base a b)) - (ap1 a (b \<open>ShallB_str\<close>) (of_string a b)) - (ap1 a (b \<open>ShallB_self\<close>) (of_internal_oid a b)) - (ap1 a (b \<open>ShallB_list\<close>) (of_list a b snd))" - -definition "of_ocl_list_attr a b f = (\<lambda>f0. co4 (\<lambda>f1. rec_ocl_list_attr f0 (\<lambda>s _ a rec. f1 s rec a)) (ap3 a)) - (ap1 a (b \<open>OclAttrNoCast\<close>) f) - (b \<open>OclAttrCast\<close>) - (of_string a b) - id - f" - -definition "of_ocl_instance_single a b f = ocl_instance_single_rec - (ap5 a (b (ext \<open>ocl_instance_single_ext\<close>)) - (of_option a b (of_string a b)) - (of_option a b (of_string a b)) - (of_option a b (of_string a b)) - (of_ocl_list_attr a b (of_list a b (of_pair a b (of_option a b (of_pair a b (of_string a b) (of_string a b))) (of_pair a b (of_string a b) (of_ocl_data_shallow a b))))) - (f a b))" - -definition "of_ocl_instance a b = rec_ocl_instance - (ap1 a (b \<open>OclInstance\<close>) - (of_list a b (of_ocl_instance_single a b (K of_unit))))" - -definition "of_ocl_def_base_l a b = rec_ocl_def_base_l - (ap1 a (b \<open>OclDefBase\<close>) (of_list a b (of_ocl_def_base a b)))" - -definition "of_ocl_def_state_core a b f = rec_ocl_def_state_core - (ap1 a (b \<open>OclDefCoreAdd\<close>) (of_ocl_instance_single a b (K of_unit))) - (ap1 a (b \<open>OclDefCoreBinding\<close>) f)" - -definition "of_ocl_def_state a b = rec_ocl_def_state - (ap2 a (b \<open>OclDefSt\<close>) (of_string a b) (of_list a b (of_ocl_def_state_core a b (of_string a b))))" - -definition "of_ocl_def_pp_core a b = rec_ocl_def_pp_core - (ap1 a (b \<open>OclDefPPCoreAdd\<close>) (of_list a b (of_ocl_def_state_core a b (of_string a b)))) - (ap1 a (b \<open>OclDefPPCoreBinding\<close>) (of_string a b))" - -definition "of_ocl_def_transition a b = rec_ocl_def_transition - (ap3 a (b \<open>OclDefPP\<close>) - (of_option a b (of_string a b)) - (of_ocl_def_pp_core a b) - (of_option a b (of_ocl_def_pp_core a b)))" - -definition "of_ocl_class_tree a b = rec_ocl_class_tree - (ap2 a (b \<open>OclClassTree\<close>) - (of_nat a b) - (of_nat a b))" - -end - -lemmas [code] = - Parse.of_internal_oid_def - Parse.of_internal_oids_def - Parse.of_ocl_def_base_def - Parse.of_ocl_data_shallow_def - Parse.of_ocl_list_attr_def - Parse.of_ocl_instance_single_def - Parse.of_ocl_instance_def - Parse.of_ocl_def_base_l_def - Parse.of_ocl_def_state_core_def - Parse.of_ocl_def_state_def - Parse.of_ocl_def_pp_core_def - Parse.of_ocl_def_transition_def - Parse.of_ocl_class_tree_def - -end diff --git a/Citadelle/src/compiler/meta/Printer_META.thy b/Citadelle/src/compiler/meta/Printer_META.thy deleted file mode 100644 index 43f3afd6958a0f3bdb82442701a4578da0d2d45c..0000000000000000000000000000000000000000 --- a/Citadelle/src/compiler/meta/Printer_META.thy +++ /dev/null @@ -1,175 +0,0 @@ -(****************************************************************************** - * Citadelle - * - * 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. - ******************************************************************************) - -section\<open>Instantiating the Printer for META\<close> - -theory Printer_META -imports Parser_META - "../../compiler_generic/meta_isabelle/Printer_Isabelle" - Printer_UML_extended -begin - -context Print -begin - -definition "of\<^sub>e\<^sub>n\<^sub>v_section env = - (if D_output_disable_thy env then - \<lambda>_. \<open>\<close> - else - of_section env)" - -definition "of\<^sub>e\<^sub>n\<^sub>v_semi__theory env = - (\<lambda> Theory_section section_title \<Rightarrow> of\<^sub>e\<^sub>n\<^sub>v_section env section_title - | x \<Rightarrow> of_semi__theory env x)" - -definition \<open>of\<^sub>e\<^sub>n\<^sub>v_semi__theories env = - (\<lambda> Theories_one t \<Rightarrow> of\<^sub>e\<^sub>n\<^sub>v_semi__theory env t - | Theories_locale data l \<Rightarrow> - \<open>locale %s = -%s -begin -%s -end\<close> (To_string (HolThyLocale_name data)) - (String_concat_map - \<open> -\<close> - (\<lambda> (l_fix, o_assum). - \<open>%s%s\<close> (String_concat_map \<open> -\<close> (\<lambda>(e, ty). \<open>fixes "%s" :: "%s"\<close> (of_semi__term e) (of_semi__typ ty)) l_fix) - (case o_assum of None \<Rightarrow> \<open>\<close> - | Some (name, e) \<Rightarrow> \<open> -assumes %s: "%s"\<close> (To_string name) (of_semi__term e))) - (HolThyLocale_header data)) - (String_concat_map \<open> - -\<close> (String_concat_map \<open> - -\<close> (of\<^sub>e\<^sub>n\<^sub>v_semi__theory env)) l))\<close> - -(* *) - -definition "of_ocl_generic _ = (\<lambda> OclGeneric s \<Rightarrow> \<open>meta_command \<open>%s\<close>\<close> (To_string s))" - -definition "of_floor = (\<lambda> Floor1 \<Rightarrow> \<open>\<close> | Floor2 \<Rightarrow> \<open>[shallow]\<close> | Floor3 \<Rightarrow> \<open>[shallow_shallow]\<close>)" - -definition "of_all_meta_embedding env = - (\<lambda> META_ctxt floor ctxt \<Rightarrow> of_ocl_ctxt env (of_floor floor) ctxt - | META_instance i \<Rightarrow> of_ocl_instance env i - | META_def_state floor s \<Rightarrow> of_ocl_def_state env (of_floor floor) s - | META_def_transition floor p \<Rightarrow> of_ocl_def_transition env (of_floor floor) p - | META_generic s \<Rightarrow> of_ocl_generic env s)" - -definition "of_boot_generation_syntax _ = (\<lambda> Boot_generation_syntax mode \<Rightarrow> - \<open>generation_syntax [ shallow%s ]\<close> - (let f = \<open> (generation_semantics [ %s ])\<close> in - case mode of Gen_only_design \<Rightarrow> f \<open>design\<close> - | Gen_only_analysis \<Rightarrow> f \<open>analysis\<close> - | Gen_default \<Rightarrow> \<open>\<close>))" - -declare[[cartouche_type' = "abr_string"]] - -definition "of_boot_setup_env env = (\<lambda> Boot_setup_env e \<Rightarrow> - of_setup - env - (Setup - (SML.app0 - \<open>Generation_mode.update_compiler_config\<close> - [ SML.app - \<open>K\<close> - [ SML.let_open - \<open>META\<close> - (\<comment> \<open>Instead of using\<close> - \<comment> \<open>\<open>sml_of_compiler_env_config SML_apply (\<lambda>x. SML_basic [x]) e\<close>\<close> - \<comment> \<open>the following allows to 'automatically' return an uncurried expression:\<close> - SML_basic [sml_of_compiler_env_config sml_apply id e])]])))" - -declare[[cartouche_type' = "fun\<^sub>p\<^sub>r\<^sub>i\<^sub>n\<^sub>t\<^sub>f"]] - -definition "of_all_meta env = (\<lambda> - META_semi__theories thy \<Rightarrow> of\<^sub>e\<^sub>n\<^sub>v_semi__theories env thy - | META_boot_generation_syntax generation_syntax \<Rightarrow> of_boot_generation_syntax env generation_syntax - | META_boot_setup_env setup_env \<Rightarrow> of_boot_setup_env env setup_env - | META_all_meta_embedding all_meta_embedding \<Rightarrow> of_all_meta_embedding env all_meta_embedding)" - -definition "of_all_meta_lists env l_thy = - (let (th_beg, th_end) = case D_output_header_thy env of None \<Rightarrow> ([], []) - | Some (name, fic_import, fic_import_boot) \<Rightarrow> - ( [ \<open>theory %s imports %s begin\<close> - (To_string name) - (of_semi__term (term_binop \<langle>STR '' ''\<rangle> - (L.map Term_string - (fic_import @@@@ (if D_output_header_force env - | D_output_auto_bootstrap env then - [fic_import_boot] - else - []))))) ] - , [ \<open>\<close>, \<open>end\<close> ]) in - L.flatten - [ th_beg - , L.flatten (fst (L.mapM (\<lambda>(msg, l) (i, cpt). - let (l_thy, lg) = L.mapM (\<lambda>l n. (of_all_meta env l, Succ n)) l 0 in - (( \<open>\<close> - # \<open>%s(* %d ************************************ %d + %d *)%s\<close> - (To_string (if compiler_env_config.more env then \<langle>STR ''''\<rangle> else \<degree>integer_escape\<degree>)) - (To_nat (Succ i)) - (To_nat cpt) - (To_nat lg) - (case msg of None \<Rightarrow> \<open>\<close> | Some msg \<Rightarrow> \<open> (* term %s *)\<close> (To_string msg)) - # l_thy), Succ i, cpt + lg)) l_thy (D_output_position env))) - , th_end ])" -end - -lemmas [code] = - \<comment> \<open>def\<close> - Print.of\<^sub>e\<^sub>n\<^sub>v_section_def - Print.of\<^sub>e\<^sub>n\<^sub>v_semi__theory_def - Print.of\<^sub>e\<^sub>n\<^sub>v_semi__theories_def - Print.of_ocl_generic_def - Print.of_floor_def - Print.of_all_meta_embedding_def - Print.of_boot_generation_syntax_def - Print.of_boot_setup_env_def - Print.of_all_meta_def - Print.of_all_meta_lists_def - - \<comment> \<open>fun\<close> - -end diff --git a/Citadelle/src/compiler/meta/Printer_UML.thy b/Citadelle/src/compiler/meta/Printer_UML.thy deleted file mode 100644 index 39e9fffb29e18690e164d86479c58606220c596e..0000000000000000000000000000000000000000 --- a/Citadelle/src/compiler/meta/Printer_UML.thy +++ /dev/null @@ -1,115 +0,0 @@ -(****************************************************************************** - * 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. - ******************************************************************************) - -section\<open>Instantiating the Printer for OCL (I)\<close> - -theory Printer_UML -imports Meta_UML - "../../compiler_generic/meta_isabelle/Printer_Pure" -begin - -context Print -begin - -declare[[cartouche_type' = "abr_string"]] - -definition "concatWith l = - (if l = [] then - id - else - sprint2 STR ''(%s. (%s))''\<acute> (To_string (String_concatWith \<open> \<close> (\<open>\<lambda>\<close> # rev l))))" - -declare[[cartouche_type' = "fun\<^sub>p\<^sub>r\<^sub>i\<^sub>n\<^sub>t\<^sub>f"]] - -fun of_ctxt2_term_aux where "of_ctxt2_term_aux l e = - (\<lambda> T_pure pure o_s \<Rightarrow> (case o_s of None \<Rightarrow> concatWith l (of_pure_term True [] pure) - | Some s \<Rightarrow> To_string s) - | T_to_be_parsed _ s \<Rightarrow> concatWith l (To_string s) - | T_lambda s c \<Rightarrow> of_ctxt2_term_aux (s # l) c) e" -definition "of_ctxt2_term = of_ctxt2_term_aux []" - -definition \<open>of_ocl_ctxt _ (floor :: \<comment> \<open>polymorphism weakening needed by \<^theory_text>\<open>code_reflect\<close>\<close> - String.literal) ctxt = - (let f_inv = \<lambda> T_inv b (OclProp_ctxt n s) \<Rightarrow> \<open> %sInv %s : "%s"\<close> - (if b then \<open>Existential\<close> else \<open>\<close>) - (case n of None \<Rightarrow> \<open>\<close> | Some s \<Rightarrow> To_string s) - (of_ctxt2_term s) in - \<open>Context%s %s%s %s\<close> - floor - (case Ctxt_param ctxt of - [] \<Rightarrow> \<open>\<close> - | l \<Rightarrow> \<open>%s : \<close> (String_concat \<open>, \<close> (L.map To_string l))) - (To_string (ty_obj_to_string (Ctxt_ty ctxt))) - (String_concat \<open> -\<close> (L.map (\<lambda> Ctxt_pp ctxt \<Rightarrow> - \<open>:: %s (%s) %s -%s\<close> - (To_string (Ctxt_fun_name ctxt)) - (String_concat \<open>, \<close> - (L.map - (\<lambda> (s, ty). \<open>%s : %s\<close> (To_string s) (To_string (str_of_ty ty))) - (Ctxt_fun_ty_arg ctxt))) - (case Ctxt_fun_ty_out ctxt of None \<Rightarrow> \<open>\<close> - | Some ty \<Rightarrow> \<open>: %s\<close> (To_string (str_of_ty ty))) - (String_concat \<open> -\<close> - (L.map - (\<lambda> T_pp pref (OclProp_ctxt n s) \<Rightarrow> \<open> %s %s: "%s"\<close> - (case pref of OclCtxtPre \<Rightarrow> \<open>Pre\<close> - | OclCtxtPost \<Rightarrow> \<open>Post\<close>) - (case n of None \<Rightarrow> \<open>\<close> | Some s \<Rightarrow> To_string s) - (of_ctxt2_term s) - | T_invariant inva \<Rightarrow> f_inv inva) - (Ctxt_expr ctxt))) - | Ctxt_inv inva \<Rightarrow> f_inv inva) - (Ctxt_clause ctxt))))\<close> - -end - -lemmas [code] = - \<comment> \<open>def\<close> - Print.concatWith_def - Print.of_ctxt2_term_def - Print.of_ocl_ctxt_def - \<comment> \<open>fun\<close> - Print.of_ctxt2_term_aux.simps - -end diff --git a/Citadelle/src/compiler/meta/Printer_UML_extended.thy b/Citadelle/src/compiler/meta/Printer_UML_extended.thy deleted file mode 100644 index 9958133ba0727a7cc1fc3978d1fb27839670f955..0000000000000000000000000000000000000000 --- a/Citadelle/src/compiler/meta/Printer_UML_extended.thy +++ /dev/null @@ -1,136 +0,0 @@ -(****************************************************************************** - * 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. - ******************************************************************************) - -section\<open>Instantiating the Printer for OCL (II)\<close> - -theory Printer_UML_extended -imports Meta_UML_extended - Printer_UML -begin - -context Print -begin - -definition "To_oid = (\<lambda>Oid n \<Rightarrow> To_nat n)" - -definition \<open>of_ocl_def_base = (\<lambda> OclDefInteger i \<Rightarrow> To_string i - | OclDefReal (i1, i2) \<Rightarrow> \<open>%s.%s\<close> (To_string i1) (To_string i2) - | OclDefString s \<Rightarrow> \<open>"%s"\<close> (To_string s))\<close> - -fun of_ocl_data_shallow where - "of_ocl_data_shallow e = (\<lambda> ShallB_term b \<Rightarrow> of_ocl_def_base b - | ShallB_str s \<Rightarrow> To_string s - | ShallB_self s \<Rightarrow> \<open>self %d\<close> (To_oid s) - | ShallB_list l \<Rightarrow> \<open>[ %s ]\<close> (String_concat \<open>, \<close> (List.map of_ocl_data_shallow l))) e" - -fun of_ocl_list_attr where - "of_ocl_list_attr f e = (\<lambda> OclAttrNoCast x \<Rightarrow> f x - | OclAttrCast ty (OclAttrNoCast x) _ \<Rightarrow> \<open>(%s :: %s)\<close> (f x) (To_string ty) - | OclAttrCast ty l _ \<Rightarrow> \<open>%s \<rightarrow> oclAsType( %s )\<close> (of_ocl_list_attr f l) (To_string ty)) e" - -definition \<open>of_ocl_instance_single ocli = - (let (s_left, s_right) = - case Inst_name ocli of - None \<Rightarrow> (case Inst_ty ocli of Some ty \<Rightarrow> (\<open>(\<close>, \<open> :: %s)\<close> (To_string ty))) - | Some s \<Rightarrow> - ( \<open>%s%s = \<close> - (To_string s) - (case Inst_ty ocli of None \<Rightarrow> \<open>\<close> | Some ty \<Rightarrow> \<open> :: %s\<close> (To_string ty)) - , \<open>\<close>) in - \<open>%s%s%s\<close> - s_left - (of_ocl_list_attr - (\<lambda>l. \<open>[ %s%s ]\<close> - (case Inst_attr_with ocli of None \<Rightarrow> \<open>\<close> | Some s \<Rightarrow> \<open>%s with_only \<close> (To_string s)) - (String_concat \<open>, \<close> - (L.map (\<lambda>(pre_post, attr, v). - \<open>%s"%s" = %s\<close> (case pre_post of None \<Rightarrow> \<open>\<close> - | Some (s1, s2) \<Rightarrow> \<open>("%s", "%s") |= \<close> (To_string s1) (To_string s2)) - (To_string attr) - (of_ocl_data_shallow v)) - l))) - (Inst_attr ocli)) - s_right)\<close> - -definition "of_ocl_instance _ = (\<lambda> OclInstance l \<Rightarrow> - \<open>Instance %s\<close> (String_concat \<open> - and \<close> (L.map of_ocl_instance_single l)))" - -definition "of_ocl_def_state_core l = - String_concat \<open>, \<close> (L.map (\<lambda> OclDefCoreBinding s \<Rightarrow> To_string s - | OclDefCoreAdd ocli \<Rightarrow> of_ocl_instance_single ocli) l)" - -definition "of_ocl_def_state _ (floor :: \<comment> \<open>polymorphism weakening needed by \<^theory_text>\<open>code_reflect\<close>\<close> - String.literal) = (\<lambda> OclDefSt n l \<Rightarrow> - \<open>State%s %s = [ %s ]\<close> - floor - (To_string n) - (of_ocl_def_state_core l))" - -definition "of_ocl_def_pp_core = (\<lambda> OclDefPPCoreBinding s \<Rightarrow> To_string s - | OclDefPPCoreAdd l \<Rightarrow> \<open>[ %s ]\<close> (of_ocl_def_state_core l))" - -definition "of_ocl_def_transition _ (floor :: \<comment> \<open>polymorphism weakening needed by \<^theory_text>\<open>code_reflect\<close>\<close> - String.literal) = (\<lambda> OclDefPP n s_pre s_post \<Rightarrow> - \<open>Transition%s %s%s%s\<close> - floor - (case n of None \<Rightarrow> \<open>\<close> | Some n \<Rightarrow> \<open>%s = \<close> (To_string n)) - (of_ocl_def_pp_core s_pre) - (case s_post of None \<Rightarrow> \<open>\<close> | Some s_post \<Rightarrow> \<open> %s\<close> (of_ocl_def_pp_core s_post)))" - -end - -lemmas [code] = - \<comment> \<open>def\<close> - Print.To_oid_def - Print.of_ocl_def_base_def - Print.of_ocl_instance_single_def - Print.of_ocl_instance_def - Print.of_ocl_def_state_core_def - Print.of_ocl_def_state_def - Print.of_ocl_def_pp_core_def - Print.of_ocl_def_transition_def - - \<comment> \<open>fun\<close> - Print.of_ocl_list_attr.simps - Print.of_ocl_data_shallow.simps - -end diff --git a/Citadelle/src/compiler_generic/Init.thy b/Citadelle/src/compiler_generic/Init.thy deleted file mode 100644 index 3da772262546affe9a3a15720d9cb063f659725f..0000000000000000000000000000000000000000 --- a/Citadelle/src/compiler_generic/Init.thy +++ /dev/null @@ -1,429 +0,0 @@ -(****************************************************************************** - * Citadelle - * - * 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 Init - imports "isabelle_home/src/HOL/Isabelle_Main0" -begin - -section\<open>Optimization on the String Datatype\<close> - -text\<open>The following types will allow to delay all concatenations on @{typ "integer list"}, - until we reach the end. As optimization, we also consider the use of @{typ String.literal} - besides @{typ "integer list"}.\<close> - -type_notation natural ("nat") -definition "Succ x = x + 1" - -datatype string\<^sub>b\<^sub>a\<^sub>s\<^sub>e = ST String.literal - | ST' "integer list" - (* NOTE one can further optimize here - by adding another constructor for representing "nat" - (oid management) *) - -datatype abr_string = (* NOTE operations in this datatype must not decrease the size of the string *) - SS_base string\<^sub>b\<^sub>a\<^sub>s\<^sub>e - | String_concatWith abr_string "abr_string list" - -syntax "_string1" :: "_ \<Rightarrow> abr_string" ("\<langle>(_)\<rangle>") -translations "\<langle>x\<rangle>" \<rightleftharpoons> "CONST SS_base (CONST ST x)" - -syntax "_string3" :: "_ \<Rightarrow> abr_string" ("\<lless>(_)\<ggreater>") -translations "\<lless>x\<ggreater>" \<rightleftharpoons> "CONST SS_base (CONST ST' x)" - -syntax "_integer1" :: "_ \<Rightarrow> abr_string" ("\<degree>(_)\<degree>") -translations "\<degree>x\<degree>" \<rightleftharpoons> "CONST SS_base (CONST ST' ((CONST Cons) x (CONST Nil)))" - -type_notation abr_string ("string") - -section\<open>Basic Extension of the Standard Library\<close> - -subsection\<open>Polymorphic Cartouches\<close> - -text\<open>We generalize the construction of cartouches for them to be used ``polymorphically'', - however the type inference is not automatic: - types of all cartouche expressions will need to be specified - earlier before their use (we will however provide a default type).\<close> - -ML\<open> -structure Cartouche_Grammar = struct - fun list_comb_mk cst n c = list_comb (Syntax.const cst, String_Syntax.mk_bits_syntax n c) - val nil1 = Syntax.const @{const_syntax String.empty_literal} - fun cons1 c l = list_comb_mk @{const_syntax String.Literal} 7 c $ l - - val default = - [ ( "char list" - , ( Const (@{const_syntax Nil}, @{typ "char list"}) - , fn c => fn l => Syntax.const @{const_syntax Cons} $ list_comb_mk @{const_syntax Char} 8 c $ l - , snd)) - , ( "String.literal", (nil1, cons1, snd)) - , ( "abr_string" - , ( nil1 - , cons1 - , fn (_, x) => Syntax.const @{const_syntax SS_base} - $ (Syntax.const @{const_syntax ST} - $ x)))] -end -\<close> - -ML\<open> -fun parse_translation_cartouche binding l f_integer accu = - let val cartouche_type = Attrib.setup_config_string binding (K (fst (hd l))) - (* if there is no type specified, by default we set the first element - to be the default type of cartouches *) in - fn ctxt => - let val cart_type = Config.get ctxt cartouche_type in - case List.find (fn (s, _) => s = cart_type) l of - NONE => error ("Unregistered return type for the cartouche: \"" ^ cart_type ^ "\"") - | SOME (_, (nil0, cons, f)) => - string_tr f (f_integer, cons, nil0) accu (Symbol_Pos.cartouche_content o Symbol_Pos.explode) - end - end -\<close> - -parse_translation \<open> - [( @{syntax_const "_cartouche_string"} - , parse_translation_cartouche @{binding cartouche_type} Cartouche_Grammar.default (K I) ())] -\<close> - -text\<open>This is the special command which sets the type of subsequent cartouches. - Note: here the given type is currently parsed as a string, - one should extend it to be a truly ``typed'' type...\<close> -declare[[cartouche_type = "abr_string"]] - -subsection\<open>Operations on Pair\<close> - -definition "flip = (\<lambda>(a, b). (b, a))" - -subsection\<open>Operations on List\<close> - -datatype ('a, 'b) nsplit = Nsplit_text 'a - | Nsplit_sep 'b -locale L -begin -definition map where "map f l = rev (foldl (\<lambda>l x. f x # l) [] l)" -definition "flatten l = foldl (\<lambda>acc l. foldl (\<lambda>acc x. x # acc) acc (rev l)) [] (rev l)" -definition "mapi f l = rev (fst (foldl (\<lambda>(l,cpt) x. (f cpt x # l, Succ cpt)) ([], 0::nat) l))" -definition "iter f = foldl (\<lambda>_. f) ()" -definition "maps f x = L.flatten (L.map f x)" -definition append where "append a b = L.flatten [a, b]" -definition filter where "filter f l = rev (foldl (\<lambda>l x. if f x then x # l else l) [] l)" -definition "rev_map f = foldl (\<lambda>l x. f x # l) []" -definition "mapM f l accu = - (let (l, accu) = List.fold (\<lambda>x (l, accu). let (x, accu) = f x accu in (x # l, accu)) l ([], accu) in - (rev l, accu))" -definition "assoc x1 l = List.fold (\<lambda>(x2, v). \<lambda>None \<Rightarrow> if x1 = x2 then Some v else None | x \<Rightarrow> x) l None" -definition split where "split l = (L.map fst l, L.map snd l)" -definition upto where "upto i j = - (let to_i = \<lambda>n. int_of_integer (integer_of_natural n) in - L.map (natural_of_integer o integer_of_int) (List.upto (to_i i) (to_i j)))" -definition "split_at f l = - (let f = \<lambda>x. \<not> f x in - (takeWhile f l, case dropWhile f l of [] \<Rightarrow> (None, []) | x # xs \<Rightarrow> (Some x, xs)))" -definition take where "take reverse lg l = reverse (snd (L.split (takeWhile (\<lambda>(n, _). n < lg) (enumerate 0 (reverse l)))))" -definition "take_last = take rev" -definition "take_first = take id" -definition "replace_gen f_res l c0 lby = - (let Nsplit_text = \<lambda>l lgen. if l = [] then lgen else Nsplit_text l # lgen in - case List.fold - (\<lambda> c1 (l, lgen). - if c0 c1 then - (lby, Nsplit_sep c1 # Nsplit_text l lgen) - else - (c1 # l, lgen)) - (rev l) - ([], []) - of (l, lgen) \<Rightarrow> f_res (Nsplit_text l lgen))" -definition "nsplit_f l c0 = replace_gen id l c0 []" -definition "replace = replace_gen (L.flatten o L.map (\<lambda> Nsplit_text l \<Rightarrow> l | _ \<Rightarrow> []))" - -fun map_find_aux where - "map_find_aux accu f l = (\<lambda> [] \<Rightarrow> List.rev accu - | x # xs \<Rightarrow> (case f x of Some x \<Rightarrow> List.fold Cons accu (x # xs) - | None \<Rightarrow> map_find_aux (x # accu) f xs)) l" -definition "map_find = map_find_aux []" - -definition "bind f0 f l = - (let l = L.map f0 l in - if list_ex (\<lambda> None \<Rightarrow> True | _ \<Rightarrow> False) l then - None - else - Some (f (List.map_filter id l)))" - -end -notation L.append (infixr "@@@@" 65) - -lemmas [code] = - \<comment> \<open>def\<close> - L.map_def - L.flatten_def - L.mapi_def - L.iter_def - L.maps_def - L.append_def - L.filter_def - L.rev_map_def - L.mapM_def - L.assoc_def - L.split_def - L.upto_def - L.split_at_def - L.take_def - L.take_last_def - L.take_first_def - L.replace_gen_def - L.nsplit_f_def - L.replace_def - L.map_find_def - L.bind_def - - \<comment> \<open>fun\<close> - L.map_find_aux.simps - -subsection\<open>Operations on Char\<close> - -definition ascii_of_literal ("INT") where - "ascii_of_literal = hd o String.asciis_of_literal" - -definition "(integer_escape :: integer) = 0x09" -definition "ST0 c = \<lless>[c]\<ggreater>" -definition "ST0_base c = ST' [c]" - -subsection\<open>Operations on String (I)\<close> - -notation "String.asciis_of_literal" ("INTS") - -locale S -locale String -locale String\<^sub>b\<^sub>a\<^sub>s\<^sub>e - -definition (in S) "flatten = String_concatWith \<open>\<close>" -definition (in String) "flatten a b = S.flatten [a, b]" -notation String.flatten (infixr "@@" 65) -definition (in String) "make n c = \<lless>L.map (\<lambda>_. c) (L.upto 1 n)\<ggreater>" -definition (in String\<^sub>b\<^sub>a\<^sub>s\<^sub>e) "map_gen replace g = (\<lambda> ST s \<Rightarrow> replace \<open>\<close> (Some s) \<open>\<close> - | ST' s \<Rightarrow> S.flatten (L.map g s))" -fun (in String) map_gen where - "map_gen replace g e = - (\<lambda> SS_base s \<Rightarrow> String\<^sub>b\<^sub>a\<^sub>s\<^sub>e.map_gen replace g s - | String_concatWith abr l \<Rightarrow> String_concatWith (map_gen replace g abr) (List.map (map_gen replace g) l)) e" -definition (in String) "foldl_one f accu = foldl f accu o INTS" -definition (in String\<^sub>b\<^sub>a\<^sub>s\<^sub>e) foldl where "foldl f accu = (\<lambda> ST s \<Rightarrow> String.foldl_one f accu s - | ST' s \<Rightarrow> List.foldl f accu s)" -fun (in String) foldl where - "foldl f accu e = - (\<lambda> SS_base s \<Rightarrow> String\<^sub>b\<^sub>a\<^sub>s\<^sub>e.foldl f accu s - | String_concatWith abr l \<Rightarrow> - (case l of [] \<Rightarrow> accu - | x # xs \<Rightarrow> List.foldl (\<lambda>accu. foldl f (foldl f accu abr)) (foldl f accu x) xs)) e" -definition (in S) "replace_integers f s1 s s2 = - s1 @@ (case s of None \<Rightarrow> \<open>\<close> | Some s \<Rightarrow> flatten (L.map f (INTS s))) @@ s2" -definition (in String) map where "map f = map_gen (S.replace_integers (\<lambda>c. \<degree>f c\<degree>)) (\<lambda>x. \<degree>f x\<degree>)" -definition (in String) "replace_integers f = map_gen (S.replace_integers (\<lambda>c. f c)) f" -definition (in String) "all f = foldl (\<lambda>b s. b & f s) True" -definition (in String) length where "length = foldl (\<lambda>n _. Suc n) 0" -definition (in String) "to_list s = rev (foldl (\<lambda>l c. c # l) [] s)" -definition (in String\<^sub>b\<^sub>a\<^sub>s\<^sub>e) "to_list = (\<lambda> ST s \<Rightarrow> INTS s | ST' l \<Rightarrow> l)" -definition (in String) "meta_of_logic = String.literal_of_asciis o to_list" -definition (in String) "to_String\<^sub>b\<^sub>a\<^sub>s\<^sub>e = (\<lambda> SS_base s \<Rightarrow> s | s \<Rightarrow> ST' (to_list s))" -definition (in String\<^sub>b\<^sub>a\<^sub>s\<^sub>e) "to_String = SS_base" -definition (in String\<^sub>b\<^sub>a\<^sub>s\<^sub>e) "is_empty = (\<lambda> ST s \<Rightarrow> s = STR '''' - | ST' s \<Rightarrow> s = [])" -fun (in String) is_empty where - "is_empty e = (\<lambda> SS_base s \<Rightarrow> String\<^sub>b\<^sub>a\<^sub>s\<^sub>e.is_empty s | String_concatWith _ l \<Rightarrow> list_all is_empty l) e" -definition (in String) "equal s1 s2 = (to_list s1 = to_list s2)" -notation String.equal (infixl "\<triangleq>" 50) -definition (in String) "assoc x l = L.assoc (to_list x) (L.map (map_prod String\<^sub>b\<^sub>a\<^sub>s\<^sub>e.to_list id) l)" -definition (in String) "member l x = List.member (L.map String\<^sub>b\<^sub>a\<^sub>s\<^sub>e.to_list l) (to_list x)" -definition (in String\<^sub>b\<^sub>a\<^sub>s\<^sub>e) "flatten l = String.to_String\<^sub>b\<^sub>a\<^sub>s\<^sub>e (S.flatten (L.map to_String l))" - -lemmas [code] = - \<comment> \<open>def\<close> - S.flatten_def - String.flatten_def - String.make_def - String\<^sub>b\<^sub>a\<^sub>s\<^sub>e.map_gen_def - String.foldl_one_def - String\<^sub>b\<^sub>a\<^sub>s\<^sub>e.foldl_def - S.replace_integers_def - String.map_def - String.replace_integers_def - String.all_def - String.length_def - String.to_list_def - String\<^sub>b\<^sub>a\<^sub>s\<^sub>e.to_list_def - String.meta_of_logic_def - String.to_String\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def - String\<^sub>b\<^sub>a\<^sub>s\<^sub>e.to_String_def - String\<^sub>b\<^sub>a\<^sub>s\<^sub>e.is_empty_def - String.equal_def - String.assoc_def - String.member_def - String\<^sub>b\<^sub>a\<^sub>s\<^sub>e.flatten_def - - \<comment> \<open>fun\<close> - String.map_gen.simps - String.foldl.simps - String.is_empty.simps - -subsection\<open>Operations on String (II)\<close> - -definition "wildcard = \<open>_\<close>" - -context String -begin -definition "lowercase = map (\<lambda>n. if n < 97 then n + 32 else n)" -definition "uppercase = map (\<lambda>n. if n < 97 then n else n - 32)" -definition "to_bold_number = replace_integers (\<lambda>n. [\<open>\<zero>\<close>, \<open>\<one>\<close>, \<open>\<two>\<close>, \<open>\<three>\<close>, \<open>\<four>\<close>, \<open>\<five>\<close>, \<open>\<six>\<close>, \<open>\<seven>\<close>, \<open>\<eight>\<close>, \<open>\<nine>\<close>] ! nat_of_integer (n - 48))" -fun nat_to_digit10_aux where - "nat_to_digit10_aux l (n :: Nat.nat) = (if n < 10 then n # l else nat_to_digit10_aux (n mod 10 # l) (n div 10))" -fun nat_to_digit26_aux where - "nat_to_digit26_aux l (n :: Nat.nat) = (if n < 26 then n # l else nat_to_digit26_aux (n mod 26 # l) (n div 26))" -definition "nat_to_digit10 n = - (let nat_raw_to_str = L.map (integer_of_nat o (+) 0x30) in - \<lless>nat_raw_to_str (nat_to_digit10_aux [] n)\<ggreater>)" -definition "natural_to_digit10 = nat_to_digit10 o nat_of_natural" -definition "nat_to_digit26 = - (let str26_of_nat = - let nat_raw_of_str26 = L.map (integer_of_nat o (+) 0x61) in - (\<lambda> n. \<lless>nat_raw_of_str26 (nat_to_digit26_aux [] n)\<ggreater>) in - (\<lambda>n. - let n = n - 1 - ; s1 = str26_of_nat n in - case String.to_list - (if n < 26 then - let s2 = str26_of_nat (26 - n - 1) in - S.flatten [s1, s1, s2, s2] - else - S.flatten [s1, s1]) - of - x # xs \<Rightarrow> S.flatten [String.uppercase \<lless>[x]\<ggreater>, \<lless>xs\<ggreater>]))" - -declare[[cartouche_type = "String.literal"]] - -definition "integer_to_digit16 = - (let f = nth (INTS \<open>0123456789ABCDEF\<close>) o nat_of_integer in - \<lambda>n \<Rightarrow> \<lless>[f (n div 16), f (n mod 16)]\<ggreater>)" -end -lemmas [code] = - \<comment> \<open>def\<close> - String.lowercase_def - String.uppercase_def - String.to_bold_number_def - String.nat_to_digit10_def - String.natural_to_digit10_def - String.nat_to_digit26_def - String.integer_to_digit16_def - - \<comment> \<open>fun\<close> - String.nat_to_digit10_aux.simps - String.nat_to_digit26_aux.simps - -definition "add_0 n = - (let n = nat_of_integer n in - S.flatten (L.map (\<lambda>_. \<open>0\<close>) (upt 0 (if n < 10 then 2 else if n < 100 then 1 else 0))) - @@ String.nat_to_digit10 n)" - -declare[[cartouche_type = "String.literal"]] - -definition "is_letter = - (let int_A = INT \<open>A\<close>; int_Z = INT \<open>Z\<close>; int_a = INT \<open>a\<close>; int_z = INT \<open>z\<close> in - (\<lambda>n. n \<ge> int_A & n \<le> int_Z | n \<ge> int_a & n \<le> int_z))" -definition "is_digit = - (let int_0 = INT \<open>0\<close>; int_9 = INT \<open>9\<close> in - (\<lambda>n. n \<ge> int_0 & n \<le> int_9))" -definition "is_special = List.member (INTS \<open> <>^_=-./(){}\<close>)" -context String -begin -definition "base255 = replace_integers (\<lambda>c. if is_letter c then \<degree>c\<degree> else add_0 c)" -declare[[cartouche_type = "abr_string"]] -definition "isub = - replace_integers (let is_und = List.member (INTS (STR ''_'')) in - (\<lambda>c. if is_letter c | is_digit c | is_und c then \<open>\<^sub>\<close> @@ \<degree>c\<degree> else add_0 c))" -definition "isup s = \<open>__\<close> @@ s" -end -lemmas [code] = - \<comment> \<open>def\<close> - String.base255_def - String.isub_def - String.isup_def - -declare[[cartouche_type = "abr_string"]] - -definition "text_of_str str = - (let s = \<open>c\<close> - ; ap = \<open> # \<close> in - S.flatten [ \<open>(let \<close>, s, \<open> = char_of :: nat \<Rightarrow> char in \<close> - , String.replace_integers (\<lambda>c. - if is_letter c then - S.flatten [\<open>CHR ''\<close>,\<degree>c\<degree>,\<open>''\<close>,ap] - else - S.flatten [s, \<open> \<close>, add_0 c, ap]) - str - , \<open>[])\<close>])" -definition \<open>text2_of_str = String.replace_integers (\<lambda>c. S.flatten [\<open>\\<close>, \<open><\<close>, \<degree>c\<degree>, \<open>>\<close>])\<close> - -definition "textstr_of_str f_flatten f_integer f_str str = - (let str0 = String.to_list str - ; f_letter = \<lambda>c. is_letter c | is_digit c | is_special c - ; s = \<open>c\<close> - ; f_text = \<lambda> Nsplit_text l \<Rightarrow> S.flatten [f_str (S.flatten [\<open>STR ''\<close>,\<lless>l\<ggreater>,\<open>''\<close>])] - | Nsplit_sep c \<Rightarrow> S.flatten [f_integer c] - ; str = case L.nsplit_f str0 (Not o f_letter) of - [] \<Rightarrow> S.flatten [f_str \<open>STR ''''\<close>] - | [x] \<Rightarrow> f_text x - | l \<Rightarrow> S.flatten (L.map (\<lambda>x. \<open>(\<close> @@ f_text x @@ \<open>) # \<close>) l) @@ \<open>[]\<close> in - if list_all f_letter str0 then - str - else - f_flatten (S.flatten [ \<open>(\<close>, str, \<open>)\<close> ]))" - -definition \<open>escape_sml = String.replace_integers (\<lambda>n. if n = 0x22 then \<open>\"\<close> else \<degree>n\<degree>)\<close> -definition "mk_constr_name name = (\<lambda> x. S.flatten [String.isub name, \<open>_\<close>, String.isub x])" -definition "mk_dot s1 s2 = S.flatten [\<open>.\<close>, s1, s2]" -definition "mk_dot_par_gen dot l_s = S.flatten [dot, \<open>(\<close>, case l_s of [] \<Rightarrow> \<open>\<close> | x # xs \<Rightarrow> S.flatten [x, S.flatten (L.map (\<lambda>s. \<open>, \<close> @@ s) xs) ], \<open>)\<close>]" -definition "mk_dot_par dot s = mk_dot_par_gen dot [s]" -definition "mk_dot_comment s1 s2 s3 = mk_dot s1 (S.flatten [s2, \<open> /*\<close>, s3, \<open>*/\<close>])" -definition "mk_quote s = S.flatten [\<open>'\<close>, s]" - -definition "hol_definition s = S.flatten [s, \<open>_def\<close>]" -definition "hol_split s = S.flatten [s, \<open>.split\<close>]" - -end diff --git a/Citadelle/src/compiler_generic/ROOT b/Citadelle/src/compiler_generic/ROOT deleted file mode 100644 index cec17e27f202c414bd430c890b19483a2363e3bf..0000000000000000000000000000000000000000 --- a/Citadelle/src/compiler_generic/ROOT +++ /dev/null @@ -1,105 +0,0 @@ -(****************************************************************************** - * Citadelle - * - * 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 AFP - -session Meta_Isabelle (AFP) = HOL + - description {* Meta_Isabelle *} - options [timeout = 600, document = pdf, document_output = document_generated] - theories [document = false] - "isabelle_home/src/HOL/Isabelle_Main0" - "isabelle_home/src/HOL/Isabelle_Main1" - theories - "meta_isabelle/Parser_Pure" - "meta_isabelle/Meta_Isabelle" - "meta_isabelle/Printer_Isabelle" - document_files - "root.bib" - "root.tex" - -session Isabelle_Meta_Model (AFP) = "HOL-Library" + - description {* Isabelle_Meta_Model containing a Toy Example *} - options [timeout = 600, document = pdf, document_output = document_generated] - theories [document = false] - "isabelle_home/src/HOL/Isabelle_Main0" - "isabelle_home/src/HOL/Isabelle_Main1" - "isabelle_home/src/HOL/Isabelle_Main2" - theories - "meta_isabelle/Parser_Pure" - "meta_isabelle/Meta_Isabelle" - "meta_isabelle/Printer_Isabelle" - theories [document = false] - "toy_example/embedding/Printer" - theories - "toy_example/embedding/Generator_static" - "toy_example/embedding/Generator_dynamic_sequential" - "toy_example/generator/Design_deep" - "toy_example/generator/Design_shallow" - "document/Rail" - theories - (* This part ensures that generated theories are accepted: - in general, if X..._generated_generated.thy is wellformed - then we also have X..._generated.thy wellformed *) - "toy_example/document_generated/Design_generated" - "toy_example/document_generated/Design_generated_generated" - document_files - "root.bib" - "root.tex" - -(* -session Toy_All = "HOL-Library" + - description {* Toy_All *} - options [timeout = 600, document = pdf, document_output = document_generated] - theories [document = false] - "isabelle_home/src/HOL/Isabelle_Main0" - "isabelle_home/src/HOL/Isabelle_Main1" - "isabelle_home/src/HOL/Isabelle_Main2" - theories - "toy_example/embedding/Generator_static" - (* "toy_example/embedding/Generator_dynamic_sequential" (* is imported by the following examples *) *) - "toy_example/generator/Design_deep" - "toy_example/generator/Design_shallow" - "toy_example/document_generated/Design_generated_generated" - "document/Rail" - document_files - "root.bib" - "root.tex" -*) diff --git a/Citadelle/src/compiler_generic/document/Rail.thy b/Citadelle/src/compiler_generic/document/Rail.thy deleted file mode 100644 index 48c9d6a2e37d4b429ec83a370ad2e8c4cf4b7914..0000000000000000000000000000000000000000 --- a/Citadelle/src/compiler_generic/document/Rail.thy +++ /dev/null @@ -1,413 +0,0 @@ -(****************************************************************************** - * Citadelle - * - * 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 Rail -imports "../toy_example/embedding/Generator_dynamic_sequential" -begin -ML_file "~~/src/Doc/antiquote_setup.ML" -(*>*) - -section\<open>Main Setup of Meta Commands\<close> - -text \<open> -\begin{matharray}{rcl} - @{command_def generation_syntax} & : & @{text "theory \<rightarrow> theory"} -\end{matharray} - -@{rail \<open> - @@{command generation_syntax} - ( '[' (@{syntax syntax} * ',') ']' - | @{syntax syntax} - | @'deep' @'flush_all') - ; - @{syntax_def syntax}: - @'deep' @{syntax semantics} @{syntax deep_embedding} - | @'shallow' @{syntax semantics} @{syntax long_or_dirty} - | @'syntax_print' number? - ; - @{syntax_def semantics}: - ('(' @'generation_semantics' \<newline> - ('[' (@'design' | @'analysis') (',' @'oid_start' nat)? ']') ')')? - ; - @{syntax_def deep_embedding}: - (@'skip_export')? \<newline> - ('(' @'THEORY' name ')' \<newline> - '(' @'IMPORTS' '[' (name * ',') ']' name ')')? \<newline> - (@'SECTION')? \<newline> - @{syntax long_or_dirty} \<newline> - ('[' (@{syntax export_code} + ',') ']') \<newline> - ('(' @'output_directory' name ')')? - ; - @{syntax_def export_code}: - @'in' ( @'self' - | 'Haskell' - | (( 'OCaml' - | 'Scala' - | 'SML') @'module_name' name)) ( '(' args ')' ) ? - ; - @{syntax_def long_or_dirty}: - (@'SORRY' | @'no_dirty')? - ; -\<close>} -\<close> - -text\<open> -@{command generation_syntax} sets the behavior of all incoming meta-commands. -By default, without firstly writing @{command generation_syntax}, -meta-commands will only print in output what they have parsed, -this is similar as giving to @{command generation_syntax} -a non-empty list having only @{keyword "syntax_print"} as elements -(on the other hand, nothing is printed when an empty list is received). -Additionally @{keyword "syntax_print"} can be followed by an integer -indicating the printing depth in output, similar as declaring -@{attribute "ML_print_depth"} with an integer, -but the global option @{keyword "syntax_print"} is restricted to meta-commands. -Besides the printing of syntaxes, several options are provided to further analyze -the semantics of languages being embedded, -and tell if their evaluation should occur immediately using the @{keyword "shallow"} mode, -or to only display what would have been evaluated using the @{keyword "deep"} mode -(i.e., to only show the generated Isabelle content in the output window). - -Since several occurrences of - @{keyword "deep"}, @{keyword "shallow"} or @{keyword "syntax_print"} -can appear in the parameterizing list, -for each meta-command the overall evaluation respects the order of events -given in the list (from head to tail). -At the time of writing, it is only possible to evaluate this list sequentially: -the execution stops as soon as one first error is raised, thus ignoring remaining events. - -@{command generation_syntax} @{keyword "deep"} @{keyword "flush_all"} -performs as side effect the writing of all the generated Isabelle contents -to the hard disk (all at the calling time), -by iterating the saving for each @{keyword "deep"} mode in the list. -In particular, this is only effective -if there is at least one @{keyword "deep"} mode earlier declared. - -As a side note, target languages for the @{keyword "deep"} mode currently supported are: - Haskell, OCaml, Scala and SML. -So in principle, all these targets generate the same Isabelle content and exit correctly. -However, depending on the intended use, exporting with some targets may be more appropriate -than other targets: -\begin{itemize} -\item For efficiency reasons, the meta-compiler has implemented a particular optimization -for accelerating the process of evaluating incoming meta-commands. -By default in Haskell and OCaml, the meta-compiler (at HOL side) is exported only once, -during the @{command generation_syntax} step. -Then all incoming meta-commands are considered as arguments sent to the exported meta-compiler. -As a compositionality aspect, these arguments are compiled then linked together -with the (already compiled) meta-compiler, but -this implies the use of one call of -@{text "unsafeCoerce"} in Haskell and one @{text "Obj.magic"} statement in OCaml -(otherwise another solution would be to extract the meta-compiler as a functor). -Similar optimizations are not yet implemented for Scala and are only half-implemented for the SML target -(which basically performs a step of marshalling to string in Isabelle/ML). -\item For safety reasons, it simply suffices to extract all the meta-compiler together with the respective -arguments in front of each incoming meta-commands everytime, then the overall needs to be newly -compiled everytime. -This is the current implemented behavior for Scala. -For Haskell, OCaml and SML, it was also the default behavior in a prototyping version of the compiler, -as a consequence one can restore that functionality for future versions. -\end{itemize} -The keyword @{keyword "self"} is another option to call the own reflected meta-compiler, -and execute the full generation without leaving the own Isabelle process being executed. - -Concerning the semantics of generated contents, if lemmas and proofs are generated, -@{keyword "SORRY"} allows to explicitly skip the evaluation of all proofs, -irrespective of the presence of @{command sorry} or not in generated proofs. -In any cases, the semantics of @{command sorry} has not been overloaded, e.g., -red background may appear as usual. - -Finally @{keyword "generation_semantics"} is a container for specifying various options -for varying the semantics of languages being embedded. -For example, @{keyword "design"} and @{keyword "analysis"} are two options for specifying how -the modelling of objects will be represented in the Toy Language. -Similarly, this would be a typical place for options like -@{text eager} or @{text lazy} for choosing how the evaluation should happen... -\<close> - -section\<open>All Meta Commands of the Toy Language\<close> - -text \<open> -\begin{matharray}{rcl} - @{command_def Class} & : & @{text "theory \<rightarrow> theory"} \\ - @{command_def Abstract_class} & : & @{text "theory \<rightarrow> theory"} \\ -\end{matharray} - -@{rail \<open> - ( @@{command Class} - | @@{command Abstract_class}) - ( binding '=' @{syntax type_base} - | @{syntax type_object} - @{syntax class}) - ; - @{syntax_def class}: - @'Attributes'? ((binding ':' @{syntax toy_type}) * (';'?)) \<newline> - @{syntax context} - ; - @{syntax_def context}: - (( ((() | @'Operations' | '::') - binding @{syntax toy_type} \<newline> - ('=' term | term)? (((@'Pre' | @'Post') @{syntax use_prop} - | @{syntax invariant}) * ()) - ) - | @{syntax invariant}) * ()) - ; - @{syntax_def invariant}: - @'Constraints'? @'Existential'? @'Inv' @{syntax use_prop} - ; -\<close>} -\<close> - -text \<open> -\begin{matharray}{rcl} - @{command_def Aggregation} & : & @{text "theory \<rightarrow> theory"} \\ - @{command_def Association} & : & @{text "theory \<rightarrow> theory"} \\ - @{command_def Composition} & : & @{text "theory \<rightarrow> theory"} -\end{matharray} - -@{rail \<open> - ( @@{command Aggregation} - | @@{command Association} - | @@{command Composition}) binding? @{syntax association} - ; - @{syntax_def association}: - @'Between'? (@{syntax association_end} (@{syntax association_end}+))? - ; - @{syntax_def association_end}: - @{syntax type_object} - @{syntax category} - ';'? - ; -\<close>} -\<close> - -text \<open> -\begin{matharray}{rcl} - @{command_def Associationclass} & : & @{text "theory \<rightarrow> theory"} \\ - @{command_def Abstract_associationclass} & : & @{text "theory \<rightarrow> theory"} -\end{matharray} - -@{rail \<open> - ( @@{command Associationclass} - | @@{command Abstract_associationclass}) @{syntax type_object} \<newline> - @{syntax association} @{syntax class} (() | 'aggregation' | 'composition') - ; -\<close>} -\<close> - -text \<open> -\begin{matharray}{rcl} - @{command_def Context} & : & @{text "theory \<rightarrow> theory"} -\end{matharray} - -@{rail \<open> - @@{command Context} ('[' @'shallow' ']')? @{syntax type_object} @{syntax context} - ; -\<close>} -\<close> - - -text \<open> -\begin{matharray}{rcl} - @{command_def Instance} & : & @{text "theory \<rightarrow> theory"} -\end{matharray} - -@{rail \<open> - @@{command Instance} ((binding ('::' @{syntax type_object})? '=' \<newline> - (@{syntax term_object} | @{syntax object_cast})) * ('and'?)) - ; - @{syntax_def term_object}: - ('[' (binding @'with_only')? \<newline> - ((('(' binding ',' binding ')' '|=')? \<newline> - binding '=' @{syntax toy_term}) * ',') ']') - ; - @{syntax_def object_cast}: - '(' @{syntax term_object} '::' @{syntax type_object} ')' \<newline> - (('\<rightarrow>' 'toyAsType' '(' @{syntax type_object} ')') * ()) - ; -\<close>} -\<close> - -text \<open> -\begin{matharray}{rcl} - @{command_def State} & : & @{text "theory \<rightarrow> theory"} -\end{matharray} - -@{rail \<open> - @@{command State} ('[' @'shallow' ']')? binding ('=' @{syntax state})? - ; - @{syntax_def state}: - '[' ((binding | @{syntax object_cast}) * ',') ']' - ; -\<close>} -\<close> - -text \<open> -\begin{matharray}{rcl} - @{command_def Transition} & : & @{text "theory \<rightarrow> theory"} -\end{matharray} - -@{rail \<open> - @@{command Transition} ('[' @'shallow' ']')? (binding '=')? \<newline> - @{syntax transition} - @{syntax transition}? - ; - @{syntax_def transition}: - binding | @{syntax state} - ; -\<close>} -\<close> - -text \<open> -\begin{matharray}{rcl} - @{command_def Enum} & : & @{text "theory \<rightarrow> theory"} -\end{matharray} - -@{rail \<open> - @@{command Enum} binding '[' (binding * ',') ']' - ; -\<close>} -\<close> - -text \<open> -\begin{matharray}{rcl} - @{command_def Tree} & : & @{text "theory \<rightarrow> theory"} -\end{matharray} - -@{rail \<open> - @@{command Tree} nat nat - ; -\<close>} -\<close> - -subsection\<open>Miscellaneous\<close> - -text \<open> -\begin{matharray}{rcl} - @{command_def BaseType} & : & @{text "theory \<rightarrow> theory"} -\end{matharray} - -@{rail \<open> - @@{command BaseType} '[' (@{syntax term_base} * ',') ']' - ; -\<close>} -\<close> - -section\<open>Toy: Lazy Identity Combinator\<close> -text \<open> -\begin{matharray}{rcl} - @{command_def End} & : & @{text "theory \<rightarrow> theory"} -\end{matharray} - -@{rail \<open> - @@{command End} ('[' 'forced' ']' | '!')? -\<close>} -\<close> - - -section\<open>Extensions of Isabelle Commands\<close> - -(* WARNING syntax errors during the extraction to LaTeX for the symbol "acute": - fun\<acute>, definition\<acute> or code_reflect\<acute> *) -text \<open> -\begin{matharray}{rcl} - @{command_def "code_reflect'"} & : & @{text "theory \<rightarrow> theory"} -\end{matharray} - -@{rail \<open> - @@{command "code_reflect'"} @'open'? string \<newline> - ( @'datatypes' ( string '=' ( '_' | ( string + '|' ) + @'and' ) ) ) ? \<newline> - ( @'functions' ( string + ) ) ? ( @'file' string ) ? - ; -\<close>} -\<close> - -text\<open> -@{command code_reflect'} has the same semantics as @{command code_reflect} -except that it additionally contains the option @{keyword "open"} inspired -from the command @{command export_code} (with the same semantics). -\<close> - -text \<open> -\begin{matharray}{rcl} - @{command_def lazy_code_printing} & : & @{text "theory \<rightarrow> theory"} \\ - @{command_def apply_code_printing} & : & @{text "theory \<rightarrow> theory"} \\ - @{command_def apply_code_printing_reflect} & : & @{text "local_theory \<rightarrow> local_theory"} -\end{matharray} - -@{rail \<open> - @@{command lazy_code_printing} - ( ( printing_const | printing_typeconstructor - | printing_class | printing_class_relation | printing_class_instance - | printing_module ) + '|' ) - ; - @@{command apply_code_printing} '(' ')' - ; - @@{command apply_code_printing_reflect} text - ; -\<close>} -\<close> - -text\<open> -@{command lazy_code_printing} has the same semantics as @{command code_printing} -or @{command ML}, -except that no side effects occur until we give more details about its intended future semantics: -this will be precised by calling -@{command apply_code_printing} or @{command apply_code_printing_reflect}. -\<close> - -text\<open> -@{command apply_code_printing} repeatedly calls @{command code_printing} -to all previously registered elements with @{command lazy_code_printing} (the order is preserved). -\<close> - -text\<open> -@{command apply_code_printing_reflect} repeatedly calls @{command ML} -to all previously registered elements with @{command lazy_code_printing} (the order is preserved). -As a consequence, code for other targets (Haskell, OCaml, Scala) are ignored. -Moreover before the execution of the overall, -it is possible to give an additional piece of SML code as argument to priorly execute. -\<close> - -(*<*) -end -(*>*) diff --git a/Citadelle/src/compiler_generic/document/root.bib b/Citadelle/src/compiler_generic/document/root.bib deleted file mode 100644 index 7cfb008ce8d8a0edb0cf44273a664e099d5e4a5a..0000000000000000000000000000000000000000 --- a/Citadelle/src/compiler_generic/document/root.bib +++ /dev/null @@ -1,39 +0,0 @@ -% $Id: adb-long.bib 8488 2013-01-06 12:10:24Z brucker $ -@Article{ brucker.ea:featherweight:2014, - author = {Achim D. Brucker and Fr{\'e}d{\'e}ric Tuong and Burkhart - Wolff}, - title = {Featherweight OCL: A Proposal for a Machine-Checked Formal - Semantics for OCL 2.5}, - journal = {Archive of Formal Proofs}, - month = jan, - year = 2014, - note = {\url{http://isa-afp.org/entries/Featherweight_OCL.shtml}, - Formal proof development}, - issn = {2150-914x}, - abstract = {The Unified Modeling Language (UML) is one of the few - modeling languages that is widely used in industry. While - UML is mostly known as diagrammatic modeling language - (e.g., visualizing class models), it is complemented by a - textual language, called Object Constraint Language (OCL). - OCL is based on a three-valued logic that turns UML into a - formal language. Unfortunately the semantics of this - specification language, captured in the "Annex A" of the - OCL standard, leads to different interpretations of corner - cases. We formalize the core of OCL: denotational - definitions, a logical calculus and operational rules that - allow for the execution of OCL expressions by a mixture of - term rewriting and code compilation. Our formalization - reveals several inconsistencies and contradictions in the - current version of the OCL standard. Overall, this document - is intended to provide the basis for a machine-checked text - "Annex A" of the OCL standard targeting at tool - implementors.}, - public = {yes}, - classification= {formal}, - categories = {holocl}, - pdf = {http://www.brucker.ch/bibliography/download/2014/brucker.ea-featherweight-2014.pdf}, - filelabel = {Outline}, - file = {http://www.brucker.ch/bibliography/download/2014/brucker.ea-featherweight-outline-2014.pdf}, - areas = {formal methods, software}, - url = {http://www.brucker.ch/bibliography/abstract/brucker.ea-featherweight-2014} -} diff --git a/Citadelle/src/compiler_generic/document/root.tex b/Citadelle/src/compiler_generic/document/root.tex deleted file mode 100644 index 938ecce7953cd609357652a4d6955c22466d9333..0000000000000000000000000000000000000000 --- a/Citadelle/src/compiler_generic/document/root.tex +++ /dev/null @@ -1,220 +0,0 @@ -\documentclass[fontsize=11pt,paper=a4,open=right,twoside,abstract=true]{scrreprt} -\usepackage[T1]{fontenc} -\usepackage[utf8]{inputenc} -\usepackage{lmodern} -\usepackage{textcomp} -\usepackage[english]{babel} -%\usepackage[draft]{fixme} -\usepackage{graphicx} -\usepackage[numbers, sort&compress, sectionbib]{natbib} -\usepackage{amssymb} -\usepackage{versions} -\usepackage{isabelle,isabellesym} -\usepackage{units} -%\usepackage{eurosym} -\IfFileExists{railsetup.sty}{\usepackage{railsetup}}{} -\usepackage{titletoc} - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -% short vs. long version - -%%%% Short Version: -\includeversion{short} -\excludeversion{extended} - -%%%% Extended Version: -%\excludeversion{short} -%\includeversion{extended} - -%%%% Misc.: -\newenvironment{shortspace}[1]{}{} %\processifversion{short}{\vspace{#1}} - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -% command - -\graphicspath{{data/},{figures/}} - -%% - -\newenvironment{matharray}[1]{\[\begin{array}{#1}}{\end{array}\]} % from 'iman.sty' -\newcommand{\indexdef}[3]% -{\ifthenelse{\equal{}{#1}}{\index{#3 (#2)|bold}}{\index{#3 (#1\ #2)|bold}}} % from 'isar.sty' - -%% - -\newcommand\inputif[1]{\IfFileExists{./#1}{\input{#1}}{}} -\newcommand\chapterif[2]{\IfFileExists{./#1}{\chapter{#2}}{}} - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -% fix for package declaration to be at the end -\usepackage[pdfpagelabels, pageanchor=false, plainpages=false]{hyperref} - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -% document - -\urlstyle{rm} -\isabellestyle{it} - -\begin{document} - -\title{A Meta-Model for the Isabelle API} -\author{% - \href{https://www.lri.fr/~tuong/}{Fr\'ed\'eric Tuong} - \and - \href{https://www.lri.fr/~wolff/}{Burkhart Wolff}} -\publishers{% - \mbox{LRI, Univ. Paris-Sud, CNRS, CentraleSup\'elec, Universit\'e Paris-Saclay} \\ - b\^at. 650 Ada Lovelace, 91405 Orsay, France \texorpdfstring{\\}{} - \href{mailto:"Frederic Tuong" - <frederic.tuong@lri.fr>}{frederic.tuong@lri.fr} \hspace{4.5em} - \href{mailto:"Burkhart Wolff" - <burkhart.wolff@lri.fr>}{burkhart.wolff@lri.fr} \\[2em] - % - IRT SystemX\\ - 8 av.~de la Vauve, 91120 Palaiseau, France \texorpdfstring{\\}{} - \href{mailto:"Frederic Tuong" - <frederic.tuong@irt-systemx.fr>}{frederic.tuong@irt-systemx.fr} \quad - \href{mailto:"Burkhart Wolff" - <burkhart.wolff@irt-systemx.fr>}{burkhart.wolff@irt-systemx.fr} -} - -\maketitle - -\begin{abstract} -We represent a theory \emph{of} (a fragment of) Isabelle/HOL \emph{in} -Isabelle/HOL. The purpose of this exercise is to write packages for -domain-specific specifications such as class models, B-machines, -\dots, and generally speaking, any domain-specific languages whose -abstract syntax can be defined by a HOL ``datatype''. On this basis, the -Isabelle code-generator can then be used to generate code for global -context transformations as well as tactic code. - -Consequently the package is geared towards -parsing, printing and code-generation to the Isabelle API. -It is at the moment not sufficiently rich for doing meta theory on -Isabelle itself. Extensions in this direction are possible though. - -Moreover, the chosen fragment is fairly rudimentary. However it should be -easily adapted to one's needs if a package is written on top of it. -The supported API contains types, terms, transformation of -global context like definitions and data-type declarations as well -as infrastructure for Isar-setups. - -This theory is drawn from the Featherweight OCL\cite{brucker.ea:featherweight:2014} project where -it is used to construct a package for object-oriented data-type theories -generated from UML class diagrams. The Featherweight OCL, for example, allows for -both the direct execution of compiled tactic code by the Isabelle API -as well as the generation of \verb|.thy|-files for debugging purposes. - -Gained experience from this project shows that the compiled code is sufficiently -efficient for practical purposes while being based on a formal \emph{model} -on which properties of the package can be proven such as termination of certain -transformations, correctness, etc. -\end{abstract} -\tableofcontents - -\parindent 0pt\parskip 0.5ex - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%\input{session} - -\part{A Meta-Model for the Isabelle API} -\chapter{Initialization} -\inputif{Init.tex} -\inputif{Init_rbt.tex} - -\chapter{Defining Meta-Models} -\inputif{Meta_Pure.tex} -\inputif{Meta_SML.tex} -\inputif{Meta_Isabelle.tex} -\inputif{Meta_Toy.tex} % toy -\inputif{Meta_Toy_extended.tex} % toy -\inputif{Meta_META.tex} - -%\chapter{Toy Libraries Static} % chapter already declared in this following first file: - \inputif{Toy_Library_Static.tex} % toy - -%\chapter{Translating Meta-Models} % chapter already declared in this following first file: -\inputif{Core_init.tex} -\inputif{Floor1_enum.tex} -\inputif{Floor1_infra.tex} -\inputif{Floor1_astype.tex} -\inputif{Floor1_istypeof.tex} -\inputif{Floor1_iskindof.tex} -\inputif{Floor1_allinst.tex} -\inputif{Floor1_access.tex} -\inputif{Floor1_examp.tex} -\inputif{Floor2_examp.tex} -\inputif{Floor1_ctxt.tex} -\inputif{Floor2_ctxt.tex} -\inputif{Core.tex} - -\chapter{Parsing Meta-Models} -\inputif{Parser_init.tex} -\inputif{Parser_Pure.tex} -\inputif{Parser_Toy.tex} % toy -\inputif{Parser_Toy_extended.tex} % toy -\inputif{Parser_META.tex} - -\chapter{Printing Meta-Models} -\inputif{Printer_init.tex} -\inputif{Printer_Pure.tex} -\inputif{Printer_SML.tex} -\inputif{Printer_Isabelle.tex} -\inputif{Printer_Toy.tex} % toy -\inputif{Printer_Toy_extended.tex} % toy -\inputif{Printer_META.tex} -\inputif{Printer.tex} - -\chapter{Main} -\inputif{Generator_static.tex} -\inputif{Generator_dynamic_sequential.tex} - -\part{A Toy Example} -\inputif{Toy_Library.tex} % toy -\inputif{Design_deep.tex} % toy -\inputif{Design_shallow.tex} % toy - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - -\bibliographystyle{abbrvnat} -\bibliography{root} - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - -\appendix -\part{Appendix} -\chapter{Grammars of Commands} -\inputif{Rail.tex} - -\chapter{Content of the Directory isabelle\_home} - -\section{Extensions for Cartouches} - -\begin{itemize} -\item \verb|./src/HOL/ex/Isabelle_Cartouche_Examples.thy| \hfill \emph{Main0}: \hspace{3em} \\ -Some functions have been generalized for supporting cartouches. -\end{itemize} - -\section{Other Changes} - -\begin{itemize} -\item \verb|./src/Tools/Code/Isabelle_code_runtime.thy| \hfill \emph{Main1}: \hspace{3em} \\ -The option $open$ was introduced in this file for the definition of $code\_reflect'$. -\item \verb|./src/Tools/Code/Isabelle_code_target.thy| \hfill \emph{Main1}: \hspace{3em} \\ -Some signatures was removed for exposing the main structure, -we have also defined at the end the implementation of $lazy\_code\_printing$, -$apply\_code\_printing$ and $apply\_code\_printing\_reflect$. -\item \verb|./src/Pure/Isar/Isabelle_typedecl.thy| \hfill \emph{Main2}: \hspace{3em} \\ -Short modification of the argument lifting a $binding$ to a $binding$~$option$ with some signatures removed. -\end{itemize} - -\chapter{Content of One Generated File (as example)} -\inputif{Design_generated_generated.tex} - -\end{document} - -%%% Local Variables: -%%% mode: latex -%%% TeX-master: t -%%% End: diff --git a/Citadelle/src/compiler_generic/isabelle_d_atomic/src/HOL/Library/Old_Datatype.thy b/Citadelle/src/compiler_generic/isabelle_d_atomic/src/HOL/Library/Old_Datatype.thy deleted file mode 100644 index bc601ccca28bef4224c10e7044a5801718c73c0b..0000000000000000000000000000000000000000 --- a/Citadelle/src/compiler_generic/isabelle_d_atomic/src/HOL/Library/Old_Datatype.thy +++ /dev/null @@ -1,517 +0,0 @@ -(* Title: HOL/Library/Old_Datatype.thy - Author: Lawrence C Paulson, Cambridge University Computer Laboratory - Author: Stefan Berghofer and Markus Wenzel, TU Muenchen -*) - -section \<open>Old Datatype package: constructing datatypes from Cartesian Products and Disjoint Sums\<close> - -theory Old_Datatype -imports Main -keywords "sub_atomic_old_datatype" "atomic_old_datatype" "old_datatype" :: thy_decl -begin - -ML_file "~~/src/HOL/Tools/datatype_realizer.ML" - - -subsection \<open>The datatype universe\<close> - -definition "Node = {p. \<exists>f x k. p = (f :: nat => 'b + nat, x ::'a + nat) \<and> f k = Inr 0}" - -typedef ('a, 'b) node = "Node :: ((nat => 'b + nat) * ('a + nat)) set" - morphisms Rep_Node Abs_Node - unfolding Node_def by auto - -text\<open>Datatypes will be represented by sets of type \<open>node\<close>\<close> - -type_synonym 'a item = "('a, unit) node set" -type_synonym ('a, 'b) dtree = "('a, 'b) node set" - -definition Push :: "[('b + nat), nat => ('b + nat)] => (nat => ('b + nat))" - (*crude "lists" of nats -- needed for the constructions*) - where "Push == (%b h. case_nat b h)" - -definition Push_Node :: "[('b + nat), ('a, 'b) node] => ('a, 'b) node" - where "Push_Node == (%n x. Abs_Node (apfst (Push n) (Rep_Node x)))" - - -(** operations on S-expressions -- sets of nodes **) - -(*S-expression constructors*) -definition Atom :: "('a + nat) => ('a, 'b) dtree" - where "Atom == (%x. {Abs_Node((%k. Inr 0, x))})" -definition Scons :: "[('a, 'b) dtree, ('a, 'b) dtree] => ('a, 'b) dtree" - where "Scons M N == (Push_Node (Inr 1) ` M) Un (Push_Node (Inr (Suc 1)) ` N)" - -(*Leaf nodes, with arbitrary or nat labels*) -definition Leaf :: "'a => ('a, 'b) dtree" - where "Leaf == Atom \<circ> Inl" -definition Numb :: "nat => ('a, 'b) dtree" - where "Numb == Atom \<circ> Inr" - -(*Injections of the "disjoint sum"*) -definition In0 :: "('a, 'b) dtree => ('a, 'b) dtree" - where "In0(M) == Scons (Numb 0) M" -definition In1 :: "('a, 'b) dtree => ('a, 'b) dtree" - where "In1(M) == Scons (Numb 1) M" - -(*Function spaces*) -definition Lim :: "('b => ('a, 'b) dtree) => ('a, 'b) dtree" - where "Lim f == \<Union>{z. \<exists>x. z = Push_Node (Inl x) ` (f x)}" - -(*the set of nodes with depth less than k*) -definition ndepth :: "('a, 'b) node => nat" - where "ndepth(n) == (%(f,x). LEAST k. f k = Inr 0) (Rep_Node n)" -definition ntrunc :: "[nat, ('a, 'b) dtree] => ('a, 'b) dtree" - where "ntrunc k N == {n. n\<in>N \<and> ndepth(n)<k}" - -(*products and sums for the "universe"*) -definition uprod :: "[('a, 'b) dtree set, ('a, 'b) dtree set]=> ('a, 'b) dtree set" - where "uprod A B == UN x:A. UN y:B. { Scons x y }" -definition usum :: "[('a, 'b) dtree set, ('a, 'b) dtree set]=> ('a, 'b) dtree set" - where "usum A B == In0`A Un In1`B" - -(*the corresponding eliminators*) -definition Split :: "[[('a, 'b) dtree, ('a, 'b) dtree]=>'c, ('a, 'b) dtree] => 'c" - where "Split c M == THE u. \<exists>x y. M = Scons x y \<and> u = c x y" - -definition Case :: "[[('a, 'b) dtree]=>'c, [('a, 'b) dtree]=>'c, ('a, 'b) dtree] => 'c" - where "Case c d M == THE u. (\<exists>x . M = In0(x) \<and> u = c(x)) \<or> (\<exists>y . M = In1(y) \<and> u = d(y))" - - -(** equality for the "universe" **) - -definition dprod :: "[(('a, 'b) dtree * ('a, 'b) dtree)set, (('a, 'b) dtree * ('a, 'b) dtree)set] - => (('a, 'b) dtree * ('a, 'b) dtree)set" - where "dprod r s == UN (x,x'):r. UN (y,y'):s. {(Scons x y, Scons x' y')}" - -definition dsum :: "[(('a, 'b) dtree * ('a, 'b) dtree)set, (('a, 'b) dtree * ('a, 'b) dtree)set] - => (('a, 'b) dtree * ('a, 'b) dtree)set" - where "dsum r s == (UN (x,x'):r. {(In0(x),In0(x'))}) Un (UN (y,y'):s. {(In1(y),In1(y'))})" - - -lemma apfst_convE: - "[| q = apfst f p; !!x y. [| p = (x,y); q = (f(x),y) |] ==> R - |] ==> R" -by (force simp add: apfst_def) - -(** Push -- an injection, analogous to Cons on lists **) - -lemma Push_inject1: "Push i f = Push j g ==> i=j" -apply (simp add: Push_def fun_eq_iff) -apply (drule_tac x=0 in spec, simp) -done - -lemma Push_inject2: "Push i f = Push j g ==> f=g" -apply (auto simp add: Push_def fun_eq_iff) -apply (drule_tac x="Suc x" in spec, simp) -done - -lemma Push_inject: - "[| Push i f =Push j g; [| i=j; f=g |] ==> P |] ==> P" -by (blast dest: Push_inject1 Push_inject2) - -lemma Push_neq_K0: "Push (Inr (Suc k)) f = (%z. Inr 0) ==> P" -by (auto simp add: Push_def fun_eq_iff split: nat.split_asm) - -lemmas Abs_Node_inj = Abs_Node_inject [THEN [2] rev_iffD1] - - -(*** Introduction rules for Node ***) - -lemma Node_K0_I: "(\<lambda>k. Inr 0, a) \<in> Node" -by (simp add: Node_def) - -lemma Node_Push_I: "p \<in> Node \<Longrightarrow> apfst (Push i) p \<in> Node" -apply (simp add: Node_def Push_def) -apply (fast intro!: apfst_conv nat.case(2)[THEN trans]) -done - - -subsection\<open>Freeness: Distinctness of Constructors\<close> - -(** Scons vs Atom **) - -lemma Scons_not_Atom [iff]: "Scons M N \<noteq> Atom(a)" -unfolding Atom_def Scons_def Push_Node_def One_nat_def -by (blast intro: Node_K0_I Rep_Node [THEN Node_Push_I] - dest!: Abs_Node_inj - elim!: apfst_convE sym [THEN Push_neq_K0]) - -lemmas Atom_not_Scons [iff] = Scons_not_Atom [THEN not_sym] - - -(*** Injectiveness ***) - -(** Atomic nodes **) - -lemma inj_Atom: "inj(Atom)" -apply (simp add: Atom_def) -apply (blast intro!: inj_onI Node_K0_I dest!: Abs_Node_inj) -done -lemmas Atom_inject = inj_Atom [THEN injD] - -lemma Atom_Atom_eq [iff]: "(Atom(a)=Atom(b)) = (a=b)" -by (blast dest!: Atom_inject) - -lemma inj_Leaf: "inj(Leaf)" -apply (simp add: Leaf_def o_def) -apply (rule inj_onI) -apply (erule Atom_inject [THEN Inl_inject]) -done - -lemmas Leaf_inject [dest!] = inj_Leaf [THEN injD] - -lemma inj_Numb: "inj(Numb)" -apply (simp add: Numb_def o_def) -apply (rule inj_onI) -apply (erule Atom_inject [THEN Inr_inject]) -done - -lemmas Numb_inject [dest!] = inj_Numb [THEN injD] - - -(** Injectiveness of Push_Node **) - -lemma Push_Node_inject: - "[| Push_Node i m =Push_Node j n; [| i=j; m=n |] ==> P - |] ==> P" -apply (simp add: Push_Node_def) -apply (erule Abs_Node_inj [THEN apfst_convE]) -apply (rule Rep_Node [THEN Node_Push_I])+ -apply (erule sym [THEN apfst_convE]) -apply (blast intro: Rep_Node_inject [THEN iffD1] trans sym elim!: Push_inject) -done - - -(** Injectiveness of Scons **) - -lemma Scons_inject_lemma1: "Scons M N <= Scons M' N' ==> M<=M'" -unfolding Scons_def One_nat_def -by (blast dest!: Push_Node_inject) - -lemma Scons_inject_lemma2: "Scons M N <= Scons M' N' ==> N<=N'" -unfolding Scons_def One_nat_def -by (blast dest!: Push_Node_inject) - -lemma Scons_inject1: "Scons M N = Scons M' N' ==> M=M'" -apply (erule equalityE) -apply (iprover intro: equalityI Scons_inject_lemma1) -done - -lemma Scons_inject2: "Scons M N = Scons M' N' ==> N=N'" -apply (erule equalityE) -apply (iprover intro: equalityI Scons_inject_lemma2) -done - -lemma Scons_inject: - "[| Scons M N = Scons M' N'; [| M=M'; N=N' |] ==> P |] ==> P" -by (iprover dest: Scons_inject1 Scons_inject2) - -lemma Scons_Scons_eq [iff]: "(Scons M N = Scons M' N') = (M=M' \<and> N=N')" -by (blast elim!: Scons_inject) - -(*** Distinctness involving Leaf and Numb ***) - -(** Scons vs Leaf **) - -lemma Scons_not_Leaf [iff]: "Scons M N \<noteq> Leaf(a)" -unfolding Leaf_def o_def by (rule Scons_not_Atom) - -lemmas Leaf_not_Scons [iff] = Scons_not_Leaf [THEN not_sym] - -(** Scons vs Numb **) - -lemma Scons_not_Numb [iff]: "Scons M N \<noteq> Numb(k)" -unfolding Numb_def o_def by (rule Scons_not_Atom) - -lemmas Numb_not_Scons [iff] = Scons_not_Numb [THEN not_sym] - - -(** Leaf vs Numb **) - -lemma Leaf_not_Numb [iff]: "Leaf(a) \<noteq> Numb(k)" -by (simp add: Leaf_def Numb_def) - -lemmas Numb_not_Leaf [iff] = Leaf_not_Numb [THEN not_sym] - - -(*** ndepth -- the depth of a node ***) - -lemma ndepth_K0: "ndepth (Abs_Node(%k. Inr 0, x)) = 0" -by (simp add: ndepth_def Node_K0_I [THEN Abs_Node_inverse] Least_equality) - -lemma ndepth_Push_Node_aux: - "case_nat (Inr (Suc i)) f k = Inr 0 \<longrightarrow> Suc(LEAST x. f x = Inr 0) \<le> k" -apply (induct_tac "k", auto) -apply (erule Least_le) -done - -lemma ndepth_Push_Node: - "ndepth (Push_Node (Inr (Suc i)) n) = Suc(ndepth(n))" -apply (insert Rep_Node [of n, unfolded Node_def]) -apply (auto simp add: ndepth_def Push_Node_def - Rep_Node [THEN Node_Push_I, THEN Abs_Node_inverse]) -apply (rule Least_equality) -apply (auto simp add: Push_def ndepth_Push_Node_aux) -apply (erule LeastI) -done - - -(*** ntrunc applied to the various node sets ***) - -lemma ntrunc_0 [simp]: "ntrunc 0 M = {}" -by (simp add: ntrunc_def) - -lemma ntrunc_Atom [simp]: "ntrunc (Suc k) (Atom a) = Atom(a)" -by (auto simp add: Atom_def ntrunc_def ndepth_K0) - -lemma ntrunc_Leaf [simp]: "ntrunc (Suc k) (Leaf a) = Leaf(a)" -unfolding Leaf_def o_def by (rule ntrunc_Atom) - -lemma ntrunc_Numb [simp]: "ntrunc (Suc k) (Numb i) = Numb(i)" -unfolding Numb_def o_def by (rule ntrunc_Atom) - -lemma ntrunc_Scons [simp]: - "ntrunc (Suc k) (Scons M N) = Scons (ntrunc k M) (ntrunc k N)" -unfolding Scons_def ntrunc_def One_nat_def -by (auto simp add: ndepth_Push_Node) - - - -(** Injection nodes **) - -lemma ntrunc_one_In0 [simp]: "ntrunc (Suc 0) (In0 M) = {}" -apply (simp add: In0_def) -apply (simp add: Scons_def) -done - -lemma ntrunc_In0 [simp]: "ntrunc (Suc(Suc k)) (In0 M) = In0 (ntrunc (Suc k) M)" -by (simp add: In0_def) - -lemma ntrunc_one_In1 [simp]: "ntrunc (Suc 0) (In1 M) = {}" -apply (simp add: In1_def) -apply (simp add: Scons_def) -done - -lemma ntrunc_In1 [simp]: "ntrunc (Suc(Suc k)) (In1 M) = In1 (ntrunc (Suc k) M)" -by (simp add: In1_def) - - -subsection\<open>Set Constructions\<close> - - -(*** Cartesian Product ***) - -lemma uprodI [intro!]: "\<lbrakk>M\<in>A; N\<in>B\<rbrakk> \<Longrightarrow> Scons M N \<in> uprod A B" -by (simp add: uprod_def) - -(*The general elimination rule*) -lemma uprodE [elim!]: - "\<lbrakk>c \<in> uprod A B; - \<And>x y. \<lbrakk>x \<in> A; y \<in> B; c = Scons x y\<rbrakk> \<Longrightarrow> P - \<rbrakk> \<Longrightarrow> P" -by (auto simp add: uprod_def) - - -(*Elimination of a pair -- introduces no eigenvariables*) -lemma uprodE2: "\<lbrakk>Scons M N \<in> uprod A B; \<lbrakk>M \<in> A; N \<in> B\<rbrakk> \<Longrightarrow> P\<rbrakk> \<Longrightarrow> P" -by (auto simp add: uprod_def) - - -(*** Disjoint Sum ***) - -lemma usum_In0I [intro]: "M \<in> A \<Longrightarrow> In0(M) \<in> usum A B" -by (simp add: usum_def) - -lemma usum_In1I [intro]: "N \<in> B \<Longrightarrow> In1(N) \<in> usum A B" -by (simp add: usum_def) - -lemma usumE [elim!]: - "\<lbrakk>u \<in> usum A B; - \<And>x. \<lbrakk>x \<in> A; u=In0(x)\<rbrakk> \<Longrightarrow> P; - \<And>y. \<lbrakk>y \<in> B; u=In1(y)\<rbrakk> \<Longrightarrow> P - \<rbrakk> \<Longrightarrow> P" -by (auto simp add: usum_def) - - -(** Injection **) - -lemma In0_not_In1 [iff]: "In0(M) \<noteq> In1(N)" -unfolding In0_def In1_def One_nat_def by auto - -lemmas In1_not_In0 [iff] = In0_not_In1 [THEN not_sym] - -lemma In0_inject: "In0(M) = In0(N) ==> M=N" -by (simp add: In0_def) - -lemma In1_inject: "In1(M) = In1(N) ==> M=N" -by (simp add: In1_def) - -lemma In0_eq [iff]: "(In0 M = In0 N) = (M=N)" -by (blast dest!: In0_inject) - -lemma In1_eq [iff]: "(In1 M = In1 N) = (M=N)" -by (blast dest!: In1_inject) - -lemma inj_In0: "inj In0" -by (blast intro!: inj_onI) - -lemma inj_In1: "inj In1" -by (blast intro!: inj_onI) - - -(*** Function spaces ***) - -lemma Lim_inject: "Lim f = Lim g ==> f = g" -apply (simp add: Lim_def) -apply (rule ext) -apply (blast elim!: Push_Node_inject) -done - - -(*** proving equality of sets and functions using ntrunc ***) - -lemma ntrunc_subsetI: "ntrunc k M <= M" -by (auto simp add: ntrunc_def) - -lemma ntrunc_subsetD: "(!!k. ntrunc k M <= N) ==> M<=N" -by (auto simp add: ntrunc_def) - -(*A generalized form of the take-lemma*) -lemma ntrunc_equality: "(!!k. ntrunc k M = ntrunc k N) ==> M=N" -apply (rule equalityI) -apply (rule_tac [!] ntrunc_subsetD) -apply (rule_tac [!] ntrunc_subsetI [THEN [2] subset_trans], auto) -done - -lemma ntrunc_o_equality: - "[| !!k. (ntrunc(k) \<circ> h1) = (ntrunc(k) \<circ> h2) |] ==> h1=h2" -apply (rule ntrunc_equality [THEN ext]) -apply (simp add: fun_eq_iff) -done - - -(*** Monotonicity ***) - -lemma uprod_mono: "[| A<=A'; B<=B' |] ==> uprod A B <= uprod A' B'" -by (simp add: uprod_def, blast) - -lemma usum_mono: "[| A<=A'; B<=B' |] ==> usum A B <= usum A' B'" -by (simp add: usum_def, blast) - -lemma Scons_mono: "[| M<=M'; N<=N' |] ==> Scons M N <= Scons M' N'" -by (simp add: Scons_def, blast) - -lemma In0_mono: "M<=N ==> In0(M) <= In0(N)" -by (simp add: In0_def Scons_mono) - -lemma In1_mono: "M<=N ==> In1(M) <= In1(N)" -by (simp add: In1_def Scons_mono) - - -(*** Split and Case ***) - -lemma Split [simp]: "Split c (Scons M N) = c M N" -by (simp add: Split_def) - -lemma Case_In0 [simp]: "Case c d (In0 M) = c(M)" -by (simp add: Case_def) - -lemma Case_In1 [simp]: "Case c d (In1 N) = d(N)" -by (simp add: Case_def) - - - -(**** UN x. B(x) rules ****) - -lemma ntrunc_UN1: "ntrunc k (UN x. f(x)) = (UN x. ntrunc k (f x))" -by (simp add: ntrunc_def, blast) - -lemma Scons_UN1_x: "Scons (UN x. f x) M = (UN x. Scons (f x) M)" -by (simp add: Scons_def, blast) - -lemma Scons_UN1_y: "Scons M (UN x. f x) = (UN x. Scons M (f x))" -by (simp add: Scons_def, blast) - -lemma In0_UN1: "In0(UN x. f(x)) = (UN x. In0(f(x)))" -by (simp add: In0_def Scons_UN1_y) - -lemma In1_UN1: "In1(UN x. f(x)) = (UN x. In1(f(x)))" -by (simp add: In1_def Scons_UN1_y) - - -(*** Equality for Cartesian Product ***) - -lemma dprodI [intro!]: - "\<lbrakk>(M,M') \<in> r; (N,N') \<in> s\<rbrakk> \<Longrightarrow> (Scons M N, Scons M' N') \<in> dprod r s" -by (auto simp add: dprod_def) - -(*The general elimination rule*) -lemma dprodE [elim!]: - "\<lbrakk>c \<in> dprod r s; - \<And>x y x' y'. \<lbrakk>(x,x') \<in> r; (y,y') \<in> s; - c = (Scons x y, Scons x' y')\<rbrakk> \<Longrightarrow> P - \<rbrakk> \<Longrightarrow> P" -by (auto simp add: dprod_def) - - -(*** Equality for Disjoint Sum ***) - -lemma dsum_In0I [intro]: "(M,M') \<in> r \<Longrightarrow> (In0(M), In0(M')) \<in> dsum r s" -by (auto simp add: dsum_def) - -lemma dsum_In1I [intro]: "(N,N') \<in> s \<Longrightarrow> (In1(N), In1(N')) \<in> dsum r s" -by (auto simp add: dsum_def) - -lemma dsumE [elim!]: - "\<lbrakk>w \<in> dsum r s; - \<And>x x'. \<lbrakk> (x,x') \<in> r; w = (In0(x), In0(x')) \<rbrakk> \<Longrightarrow> P; - \<And>y y'. \<lbrakk> (y,y') \<in> s; w = (In1(y), In1(y')) \<rbrakk> \<Longrightarrow> P - \<rbrakk> \<Longrightarrow> P" -by (auto simp add: dsum_def) - - -(*** Monotonicity ***) - -lemma dprod_mono: "[| r<=r'; s<=s' |] ==> dprod r s <= dprod r' s'" -by blast - -lemma dsum_mono: "[| r<=r'; s<=s' |] ==> dsum r s <= dsum r' s'" -by blast - - -(*** Bounding theorems ***) - -lemma dprod_Sigma: "(dprod (A \<times> B) (C \<times> D)) <= (uprod A C) \<times> (uprod B D)" -by blast - -lemmas dprod_subset_Sigma = subset_trans [OF dprod_mono dprod_Sigma] - -(*Dependent version*) -lemma dprod_subset_Sigma2: - "(dprod (Sigma A B) (Sigma C D)) <= Sigma (uprod A C) (Split (%x y. uprod (B x) (D y)))" -by auto - -lemma dsum_Sigma: "(dsum (A \<times> B) (C \<times> D)) <= (usum A C) \<times> (usum B D)" -by blast - -lemmas dsum_subset_Sigma = subset_trans [OF dsum_mono dsum_Sigma] - - -(*** Domain theorems ***) - -lemma Domain_dprod [simp]: "Domain (dprod r s) = uprod (Domain r) (Domain s)" - by auto - -lemma Domain_dsum [simp]: "Domain (dsum r s) = usum (Domain r) (Domain s)" - by auto - - -text \<open>hides popular names\<close> -hide_type (open) node item -hide_const (open) Push Node Atom Leaf Numb Lim Split Case - -ML_file "~~/src/HOL/Tools/Old_Datatype/old_datatype.ML" -ML_file "~~/src/HOL/Tools/inductive_realizer.ML" - -end diff --git a/Citadelle/src/compiler_generic/isabelle_d_atomic/src/HOL/Tools/Ctr_Sugar/ctr_sugar_code.ML b/Citadelle/src/compiler_generic/isabelle_d_atomic/src/HOL/Tools/Ctr_Sugar/ctr_sugar_code.ML deleted file mode 100644 index 3b7b39b17aa35ca4c54f876716bae259d22fc764..0000000000000000000000000000000000000000 --- a/Citadelle/src/compiler_generic/isabelle_d_atomic/src/HOL/Tools/Ctr_Sugar/ctr_sugar_code.ML +++ /dev/null @@ -1,143 +0,0 @@ -(* Title: HOL/Tools/Ctr_Sugar/ctr_sugar_code.ML - Author: Jasmin Blanchette, TU Muenchen - Author: Dmitriy Traytel, TU Muenchen - Author: Stefan Berghofer, TU Muenchen - Author: Florian Haftmann, TU Muenchen - Copyright 2001-2013 - -Code generation for freely generated types. -*) - -signature CTR_SUGAR_CODE = -sig - val add_ctr_code: string -> typ list -> (string * typ) list -> thm list -> thm list -> thm list -> - theory -> theory -end; - -structure Ctr_Sugar_Code : CTR_SUGAR_CODE = -struct - -open Ctr_Sugar_Util - -val eqN = "eq" -val reflN = "refl" -val simpsN = "simps" - -fun mk_case_certificate ctxt raw_thms = - let - val thms = raw_thms - |> Conjunction.intr_balanced - |> Thm.unvarify_global (Proof_Context.theory_of ctxt) - |> Conjunction.elim_balanced (length raw_thms) - |> map Simpdata.mk_meta_eq - |> map Drule.zero_var_indexes; - in - case thms of [] => NONE | thm1 :: _ => SOME - let - val params = Term.add_free_names (Thm.prop_of thm1) []; - val rhs = thm1 - |> Thm.prop_of |> Logic.dest_equals |> fst |> Term.strip_comb - ||> fst o split_last |> list_comb; - val lhs = Free (singleton (Name.variant_list params) "case", Term.fastype_of rhs); - val assum = Thm.cterm_of ctxt (Logic.mk_equals (lhs, rhs)); - in - thms - |> Conjunction.intr_balanced - |> rewrite_rule ctxt [Thm.symmetric (Thm.assume assum)] - |> Thm.implies_intr assum - |> Thm.generalize ([], params) 0 - |> Axclass.unoverload ctxt - |> Thm.varifyT_global - end - end; - -fun mk_free_ctr_equations fcT ctrs inject_thms distinct_thms thy = - let - fun mk_fcT_eq (t, u) = Const (@{const_name HOL.equal}, fcT --> fcT --> HOLogic.boolT) $ t $ u; - fun true_eq tu = HOLogic.mk_eq (mk_fcT_eq tu, @{term True}); - fun false_eq tu = HOLogic.mk_eq (mk_fcT_eq tu, @{term False}); - - val monomorphic_prop_of = Thm.prop_of o Thm.unvarify_global thy o Drule.zero_var_indexes; - - fun massage_inject (tp $ (eqv $ (_ $ t $ u) $ rhs)) = tp $ (eqv $ mk_fcT_eq (t, u) $ rhs); - fun massage_distinct (tp $ (_ $ (_ $ t $ u))) = [tp $ false_eq (t, u), tp $ false_eq (u, t)]; - - val triv_inject_goals = - map_filter (fn c as (_, T) => - if T = fcT then SOME (HOLogic.mk_Trueprop (true_eq (Const c, Const c))) else NONE) - ctrs; - val inject_goals = map (massage_inject o monomorphic_prop_of) inject_thms; - val distinct_goals = maps (massage_distinct o monomorphic_prop_of) distinct_thms; - val refl_goal = HOLogic.mk_Trueprop (true_eq (Free ("x", fcT), Free ("x", fcT))); - - fun prove goal = - Goal.prove_sorry_global thy [] [] goal (fn {context = ctxt, ...} => - HEADGOAL Goal.conjunction_tac THEN - ALLGOALS (simp_tac - (put_simpset HOL_basic_ss ctxt - addsimps (map Simpdata.mk_eq (@{thms equal eq_True} @ inject_thms @ distinct_thms))))); - - fun proves goals = goals - |> Logic.mk_conjunction_balanced - |> prove - |> Thm.close_derivation - |> Conjunction.elim_balanced (length goals) - |> map Simpdata.mk_eq; - in - (proves (triv_inject_goals @ inject_goals @ distinct_goals), Simpdata.mk_eq (prove refl_goal)) - end; - -fun add_equality fcT fcT_name As ctrs inject_thms distinct_thms = - let - fun add_def lthy = - let - fun mk_side const_name = - Const (const_name, fcT --> fcT --> HOLogic.boolT) $ Free ("x", fcT) $ Free ("y", fcT); - val spec = - mk_Trueprop_eq (mk_side @{const_name HOL.equal}, mk_side @{const_name HOL.eq}) - |> Syntax.check_term lthy; - val ((_, (_, raw_def)), lthy') = - Specification.definition NONE [] [] (Binding.empty_atts, spec) lthy; - val thy_ctxt = Proof_Context.init_global (Proof_Context.theory_of lthy'); - val def = singleton (Proof_Context.export lthy' thy_ctxt) raw_def; - in - (def, lthy') - end; - - fun tac ctxt thms = - Class.intro_classes_tac ctxt [] THEN ALLGOALS (Proof_Context.fact_tac ctxt thms); - - val qualify = - Binding.qualify true (Long_Name.base_name fcT_name) o Binding.qualify true eqN o Binding.name; - in - Class.instantiation ([fcT_name], map dest_TFree As, [HOLogic.class_equal]) - #> add_def - #-> Class.prove_instantiation_exit_result (map o Morphism.thm) tac o single - #> snd - #> `(mk_free_ctr_equations fcT ctrs inject_thms distinct_thms) - #-> (fn (thms, thm) => Global_Theory.note_thmss Thm.theoremK - [((qualify reflN, []), [([thm], [])]), - ((qualify simpsN, []), [(rev thms, [])])]) - #-> (fn [(_, [thm]), (_, thms)] => - Code.declare_default_eqns_global ((thm, false) :: map (rpair true) thms)) - end; - -fun add_ctr_code fcT_name raw_As raw_ctrs inject_thms distinct_thms case_thms thy = - let - val As = map (perhaps (try Logic.unvarifyT_global)) raw_As; - val ctrs = map (apsnd (perhaps (try Logic.unvarifyT_global))) raw_ctrs; - val fcT = Type (fcT_name, As); - val unover_ctrs = map (fn ctr as (_, fcT) => (Axclass.unoverload_const thy ctr, fcT)) ctrs; - in - if can (Code.constrset_of_consts thy) unover_ctrs then - thy - |> Code.declare_datatype_global ctrs - |> Code.declare_default_eqns_global (map (rpair true) (rev case_thms)) - |> (case mk_case_certificate (Proof_Context.init_global thy) case_thms of SOME thm => Code.declare_case_global thm | NONE => I) - |> not (Sorts.has_instance (Sign.classes_of thy) fcT_name [HOLogic.class_equal]) - ? add_equality fcT fcT_name As ctrs inject_thms distinct_thms - else - thy - end; - -end; diff --git a/Citadelle/src/compiler_generic/isabelle_d_atomic/src/HOL/Tools/Old_Datatype/old_datatype.ML b/Citadelle/src/compiler_generic/isabelle_d_atomic/src/HOL/Tools/Old_Datatype/old_datatype.ML deleted file mode 100644 index 1c649050ab23846d8f8a0bc071dba161e6b90ba7..0000000000000000000000000000000000000000 --- a/Citadelle/src/compiler_generic/isabelle_d_atomic/src/HOL/Tools/Old_Datatype/old_datatype.ML +++ /dev/null @@ -1,827 +0,0 @@ -(* Title: HOL/Tools/Old_Datatype/old_datatype.ML - Author: Stefan Berghofer, TU Muenchen - -Datatype package: definitional introduction of datatypes -with proof of characteristic theorems: injectivity / distinctness -of constructors and induction. Main interface to datatypes -after full bootstrap of datatype package. -*) - -signature OLD_DATATYPE = -sig - include OLD_DATATYPE_COMMON - - val distinct_lemma: thm - type spec_cmd = - (binding * (string * string option) list * mixfix) * (binding * string list * mixfix) list - val read_specs: spec_cmd list -> theory -> spec list * Proof.context - val check_specs: spec list -> theory -> spec list * Proof.context - val add_datatype: config -> spec list -> theory -> string list * theory - val add_datatype_cmd: config -> spec_cmd list -> theory -> string list * theory - val spec_cmd: spec_cmd parser -end; - -structure Old_Datatype : OLD_DATATYPE = -struct - -(** auxiliary **) - -val distinct_lemma = @{lemma "f x \<noteq> f y ==> x \<noteq> y" by iprover}; -val (_ $ (_ $ (_ $ (distinct_f $ _) $ _))) = hd (Thm.prems_of distinct_lemma); - -fun exh_thm_of (dt_info : Old_Datatype_Aux.info Symtab.table) tname = - #exhaust (the (Symtab.lookup dt_info tname)); - -val In0_inject = @{thm In0_inject}; -val In1_inject = @{thm In1_inject}; -val Scons_inject = @{thm Scons_inject}; -val Leaf_inject = @{thm Leaf_inject}; -val In0_eq = @{thm In0_eq}; -val In1_eq = @{thm In1_eq}; -val In0_not_In1 = @{thm In0_not_In1}; -val In1_not_In0 = @{thm In1_not_In0}; -val Lim_inject = @{thm Lim_inject}; -val Inl_inject = @{thm Inl_inject}; -val Inr_inject = @{thm Inr_inject}; -val Suml_inject = @{thm Suml_inject}; -val Sumr_inject = @{thm Sumr_inject}; - -val datatype_injI = - @{lemma "(!!x. ALL y. f x = f y --> x = y) ==> inj f" by (simp add: inj_on_def)}; - - -(** proof of characteristic theorems **) - -fun representation_proofs (config : Old_Datatype_Aux.config) - (dt_info : Old_Datatype_Aux.info Symtab.table) descr types_syntax constr_syntax case_names_induct - thy = - let - val descr' = flat descr; - val new_type_names = map (Binding.name_of o fst) types_syntax; - val big_name = space_implode "_" new_type_names; - val thy1 = Sign.add_path big_name thy; - val big_rec_name = "rep_set_" ^ big_name; - val rep_set_names' = - if length descr' = 1 then [big_rec_name] - else map (prefix (big_rec_name ^ "_") o string_of_int) (1 upto length descr'); - val rep_set_names = map (Sign.full_bname thy1) rep_set_names'; - - val tyvars = map (fn (_, (_, Ts, _)) => map Old_Datatype_Aux.dest_DtTFree Ts) (hd descr); - val leafTs' = Old_Datatype_Aux.get_nonrec_types descr'; - val branchTs = Old_Datatype_Aux.get_branching_types descr'; - val branchT = - if null branchTs then HOLogic.unitT - else Balanced_Tree.make (fn (T, U) => Type (@{type_name Sum_Type.sum}, [T, U])) branchTs; - val arities = remove (op =) 0 (Old_Datatype_Aux.get_arities descr'); - val unneeded_vars = - subtract (op =) (fold Term.add_tfreesT (leafTs' @ branchTs) []) (hd tyvars); - val leafTs = leafTs' @ map TFree unneeded_vars; - val recTs = Old_Datatype_Aux.get_rec_types descr'; - val (newTs, oldTs) = chop (length (hd descr)) recTs; - val sumT = - if null leafTs then HOLogic.unitT - else Balanced_Tree.make (fn (T, U) => Type (@{type_name Sum_Type.sum}, [T, U])) leafTs; - val Univ_elT = HOLogic.mk_setT (Type (@{type_name Old_Datatype.node}, [sumT, branchT])); - val UnivT = HOLogic.mk_setT Univ_elT; - val UnivT' = Univ_elT --> HOLogic.boolT; - val Collect = Const (@{const_name Collect}, UnivT' --> UnivT); - - val In0 = Const (@{const_name Old_Datatype.In0}, Univ_elT --> Univ_elT); - val In1 = Const (@{const_name Old_Datatype.In1}, Univ_elT --> Univ_elT); - val Leaf = Const (@{const_name Old_Datatype.Leaf}, sumT --> Univ_elT); - val Lim = Const (@{const_name Old_Datatype.Lim}, (branchT --> Univ_elT) --> Univ_elT); - - (* make injections needed for embedding types in leaves *) - - fun mk_inj T' x = - let - fun mk_inj' T n i = - if n = 1 then x - else - let - val n2 = n div 2; - val Type (_, [T1, T2]) = T; - in - if i <= n2 - then Const (@{const_name Inl}, T1 --> T) $ mk_inj' T1 n2 i - else Const (@{const_name Inr}, T2 --> T) $ mk_inj' T2 (n - n2) (i - n2) - end; - in mk_inj' sumT (length leafTs) (1 + find_index (fn T'' => T'' = T') leafTs) end; - - (* make injections for constructors *) - - fun mk_univ_inj ts = Balanced_Tree.access - {left = fn t => In0 $ t, - right = fn t => In1 $ t, - init = - if ts = [] then Const (@{const_name undefined}, Univ_elT) - else foldr1 (HOLogic.mk_binop @{const_name Old_Datatype.Scons}) ts}; - - (* function spaces *) - - fun mk_fun_inj T' x = - let - fun mk_inj T n i = - if n = 1 then x - else - let - val n2 = n div 2; - val Type (_, [T1, T2]) = T; - fun mkT U = (U --> Univ_elT) --> T --> Univ_elT; - in - if i <= n2 then Const (@{const_name Sum_Type.Suml}, mkT T1) $ mk_inj T1 n2 i - else Const (@{const_name Sum_Type.Sumr}, mkT T2) $ mk_inj T2 (n - n2) (i - n2) - end; - in mk_inj branchT (length branchTs) (1 + find_index (fn T'' => T'' = T') branchTs) end; - - fun mk_lim t Ts = fold_rev (fn T => fn t => Lim $ mk_fun_inj T (Abs ("x", T, t))) Ts t; - - (************** generate introduction rules for representing set **********) - - val _ = Old_Datatype_Aux.message config "Constructing representing sets ..."; - - (* make introduction rule for a single constructor *) - - fun make_intr s n (i, (_, cargs)) = - let - fun mk_prem dt (j, prems, ts) = - (case Old_Datatype_Aux.strip_dtyp dt of - (dts, Old_Datatype_Aux.DtRec k) => - let - val Ts = map (Old_Datatype_Aux.typ_of_dtyp descr') dts; - val free_t = - Old_Datatype_Aux.app_bnds (Old_Datatype_Aux.mk_Free "x" (Ts ---> Univ_elT) j) - (length Ts) - in - (j + 1, Logic.list_all (map (pair "x") Ts, - HOLogic.mk_Trueprop - (Free (nth rep_set_names' k, UnivT') $ free_t)) :: prems, - mk_lim free_t Ts :: ts) - end - | _ => - let val T = Old_Datatype_Aux.typ_of_dtyp descr' dt - in (j + 1, prems, (Leaf $ mk_inj T (Old_Datatype_Aux.mk_Free "x" T j)) :: ts) end); - - val (_, prems, ts) = fold_rev mk_prem cargs (1, [], []); - val concl = HOLogic.mk_Trueprop (Free (s, UnivT') $ mk_univ_inj ts n i); - in Logic.list_implies (prems, concl) end; - - val intr_ts = maps (fn ((_, (_, _, constrs)), rep_set_name) => - map (make_intr rep_set_name (length constrs)) - ((1 upto length constrs) ~~ constrs)) (descr' ~~ rep_set_names'); - - val ({raw_induct = rep_induct, intrs = rep_intrs, ...}, thy2) = - thy1 - |> Sign.concealed - |> Inductive.add_inductive_global - {quiet_mode = #quiet config, verbose = false, alt_name = Binding.name big_rec_name, - coind = false, no_elim = true, no_elim' = true, no_ind0 = #skip_level config >= 2, no_eqs = true, no_ind = #skip_level config >= 2, skip_mono = true} - (map (fn s => ((Binding.name s, UnivT'), NoSyn)) rep_set_names') [] - (map (fn x => (Binding.empty_atts, x)) intr_ts) [] - ||> Sign.restore_naming thy1; - - (********************************* typedef ********************************) - - val (typedefs, thy3) = thy2 - |> Sign.parent_path - |> fold_map - (fn (((name, mx), tvs), c) => - Typedef.add_typedef_global {overloaded = false} (name, tvs, mx) - (Collect $ Const (c, UnivT')) NONE - (fn ctxt => - resolve_tac ctxt [exI] 1 THEN - resolve_tac ctxt [CollectI] 1 THEN - QUIET_BREADTH_FIRST (has_fewer_prems 1) - (resolve_tac ctxt rep_intrs 1))) - (types_syntax ~~ tyvars ~~ take (length newTs) rep_set_names) - ||> Sign.add_path big_name; - - (*********************** definition of constructors ***********************) - - val big_rep_name = big_name ^ "_Rep_"; - val rep_names' = map (fn i => big_rep_name ^ string_of_int i) (1 upto length (flat (tl descr))); - val all_rep_names = - map (#Rep_name o #1 o #2) typedefs @ - map (Sign.full_bname thy3) rep_names'; - - (* isomorphism declarations *) - - val iso_decls = map (fn (T, s) => (Binding.name s, T --> Univ_elT, NoSyn)) - (oldTs ~~ rep_names'); - - (* constructor definitions *) - - fun make_constr_def (typedef: Typedef.info) T n - ((cname, cargs), (cname', mx)) (thy, defs, eqns, i) = - let - fun constr_arg dt (j, l_args, r_args) = - let - val T = Old_Datatype_Aux.typ_of_dtyp descr' dt; - val free_t = Old_Datatype_Aux.mk_Free "x" T j; - in - (case (Old_Datatype_Aux.strip_dtyp dt, strip_type T) of - ((_, Old_Datatype_Aux.DtRec m), (Us, U)) => - (j + 1, free_t :: l_args, mk_lim - (Const (nth all_rep_names m, U --> Univ_elT) $ - Old_Datatype_Aux.app_bnds free_t (length Us)) Us :: r_args) - | _ => (j + 1, free_t :: l_args, (Leaf $ mk_inj T free_t) :: r_args)) - end; - - val (_, l_args, r_args) = fold_rev constr_arg cargs (1, [], []); - val constrT = map (Old_Datatype_Aux.typ_of_dtyp descr') cargs ---> T; - val ({Abs_name, Rep_name, ...}, _) = typedef; - val lhs = list_comb (Const (cname, constrT), l_args); - val rhs = mk_univ_inj r_args n i; - val def = Logic.mk_equals (lhs, Const (Abs_name, Univ_elT --> T) $ rhs); - val def_name = Thm.def_name (Long_Name.base_name cname); - val eqn = - HOLogic.mk_Trueprop (HOLogic.mk_eq (Const (Rep_name, T --> Univ_elT) $ lhs, rhs)); - val ([def_thm], thy') = - thy - |> Sign.add_consts [(cname', constrT, mx)] - |> (Global_Theory.add_defs false o map Thm.no_attributes) [(Binding.name def_name, def)]; - - in (thy', defs @ [def_thm], eqns @ [eqn], i + 1) end; - - (* constructor definitions for datatype *) - - fun dt_constr_defs (((((_, (_, _, constrs)), tname), typedef: Typedef.info), T), constr_syntax) - (thy, defs, eqns, rep_congs, dist_lemmas) = - let - val ctxt = Proof_Context.init_global thy; - val _ $ (_ $ (cong_f $ _) $ _) = Thm.concl_of arg_cong; - val rep_const = Thm.cterm_of ctxt (Const (#Rep_name (#1 typedef), T --> Univ_elT)); - val cong' = infer_instantiate ctxt [(#1 (dest_Var cong_f), rep_const)] arg_cong; - val dist = infer_instantiate ctxt [(#1 (dest_Var distinct_f), rep_const)] distinct_lemma; - val (thy', defs', eqns', _) = - fold (make_constr_def typedef T (length constrs)) - (constrs ~~ constr_syntax) (Sign.add_path tname thy, defs, [], 1); - in - (Sign.parent_path thy', defs', eqns @ [eqns'], - rep_congs @ [cong'], dist_lemmas @ [dist]) - end; - - val (thy4, constr_defs, constr_rep_eqns, rep_congs, dist_lemmas) = - fold dt_constr_defs - (hd descr ~~ new_type_names ~~ map #2 typedefs ~~ newTs ~~ constr_syntax) - (thy3 |> Sign.add_consts iso_decls |> Sign.parent_path, [], [], [], []); - - in - if #skip_level config >= 2 then - (([], [], @{thm True_def}), thy4) - else - let - (*********** isomorphisms for new types (introduced by typedef) ***********) - - val _ = Old_Datatype_Aux.message config "Proving isomorphism properties ..."; - - val collect_simp = rewrite_rule (Proof_Context.init_global thy4) [mk_meta_eq mem_Collect_eq]; - - val newT_iso_axms = typedefs |> map (fn (_, (_, {Abs_inverse, Rep_inverse, Rep, ...})) => - (collect_simp Abs_inverse, Rep_inverse, collect_simp Rep)); - - val newT_iso_inj_thms = typedefs |> map (fn (_, (_, {Abs_inject, Rep_inject, ...})) => - (collect_simp Abs_inject RS iffD1, Rep_inject RS iffD1)); - - (********* isomorphisms between existing types and "unfolded" types *******) - - (*---------------------------------------------------------------------*) - (* isomorphisms are defined using primrec-combinators: *) - (* generate appropriate functions for instantiating primrec-combinator *) - (* *) - (* e.g. Rep_dt_i = list_rec ... (%h t y. In1 (Scons (Leaf h) y)) *) - (* *) - (* also generate characteristic equations for isomorphisms *) - (* *) - (* e.g. Rep_dt_i (cons h t) = In1 (Scons (Rep_dt_j h) (Rep_dt_i t)) *) - (*---------------------------------------------------------------------*) - - fun make_iso_def k ks n (cname, cargs) (fs, eqns, i) = - let - val argTs = map (Old_Datatype_Aux.typ_of_dtyp descr') cargs; - val T = nth recTs k; - val rep_const = Const (nth all_rep_names k, T --> Univ_elT); - val constr = Const (cname, argTs ---> T); - - fun process_arg ks' dt (i2, i2', ts, Ts) = - let - val T' = Old_Datatype_Aux.typ_of_dtyp descr' dt; - val (Us, U) = strip_type T' - in - (case Old_Datatype_Aux.strip_dtyp dt of - (_, Old_Datatype_Aux.DtRec j) => - if member (op =) ks' j then - (i2 + 1, i2' + 1, ts @ [mk_lim (Old_Datatype_Aux.app_bnds - (Old_Datatype_Aux.mk_Free "y" (Us ---> Univ_elT) i2') (length Us)) Us], - Ts @ [Us ---> Univ_elT]) - else - (i2 + 1, i2', ts @ [mk_lim - (Const (nth all_rep_names j, U --> Univ_elT) $ - Old_Datatype_Aux.app_bnds - (Old_Datatype_Aux.mk_Free "x" T' i2) (length Us)) Us], Ts) - | _ => (i2 + 1, i2', ts @ [Leaf $ mk_inj T' (Old_Datatype_Aux.mk_Free "x" T' i2)], Ts)) - end; - - val (i2, i2', ts, Ts) = fold (process_arg ks) cargs (1, 1, [], []); - val xs = map (uncurry (Old_Datatype_Aux.mk_Free "x")) (argTs ~~ (1 upto (i2 - 1))); - val ys = map (uncurry (Old_Datatype_Aux.mk_Free "y")) (Ts ~~ (1 upto (i2' - 1))); - val f = fold_rev lambda (xs @ ys) (mk_univ_inj ts n i); - - val (_, _, ts', _) = fold (process_arg []) cargs (1, 1, [], []); - val eqn = HOLogic.mk_Trueprop (HOLogic.mk_eq - (rep_const $ list_comb (constr, xs), mk_univ_inj ts' n i)) - - in (fs @ [f], eqns @ [eqn], i + 1) end; - - (* define isomorphisms for all mutually recursive datatypes in list ds *) - - fun make_iso_defs ds (thy, char_thms) = - let - val ks = map fst ds; - val (_, (tname, _, _)) = hd ds; - val {rec_rewrites, rec_names, ...} = the (Symtab.lookup dt_info tname); - - fun process_dt (k, (_, _, constrs)) (fs, eqns, isos) = - let - val (fs', eqns', _) = fold (make_iso_def k ks (length constrs)) constrs (fs, eqns, 1); - val iso = (nth recTs k, nth all_rep_names k); - in (fs', eqns', isos @ [iso]) end; - - val (fs, eqns, isos) = fold process_dt ds ([], [], []); - val fTs = map fastype_of fs; - val defs = - map (fn (rec_name, (T, iso_name)) => - (Binding.name (Thm.def_name (Long_Name.base_name iso_name)), - Logic.mk_equals (Const (iso_name, T --> Univ_elT), - list_comb (Const (rec_name, fTs @ [T] ---> Univ_elT), fs)))) (rec_names ~~ isos); - val (def_thms, thy') = - (Global_Theory.add_defs false o map Thm.no_attributes) defs thy; - - (* prove characteristic equations *) - - val rewrites = def_thms @ map mk_meta_eq rec_rewrites; - val char_thms' = - map (fn eqn => Goal.prove_sorry_global thy' [] [] eqn - (fn {context = ctxt, ...} => - EVERY [rewrite_goals_tac ctxt rewrites, resolve_tac ctxt [refl] 1])) eqns; - - in (thy', char_thms' @ char_thms) end; - - val (thy5, iso_char_thms) = - fold_rev make_iso_defs (tl descr) (Sign.add_path big_name thy4, []); - - (* prove isomorphism properties *) - - fun mk_funs_inv thy thm = - let - val prop = Thm.prop_of thm; - val _ $ (_ $ ((S as Const (_, Type (_, [U, _]))) $ _ )) $ - (_ $ (_ $ (r $ (a $ _)) $ _)) = Type.legacy_freeze prop; - val used = Term.add_tfree_names a []; - - fun mk_thm i = - let - val Ts = map (TFree o rpair @{sort type}) (Name.variant_list used (replicate i "'t")); - val f = Free ("f", Ts ---> U); - in - Goal.prove_sorry_global thy [] [] - (Logic.mk_implies - (HOLogic.mk_Trueprop (HOLogic.list_all - (map (pair "x") Ts, S $ Old_Datatype_Aux.app_bnds f i)), - HOLogic.mk_Trueprop (HOLogic.mk_eq (fold_rev (Term.abs o pair "x") Ts - (r $ (a $ Old_Datatype_Aux.app_bnds f i)), f)))) - (fn {context = ctxt, ...} => - EVERY [REPEAT_DETERM_N i (resolve_tac ctxt @{thms ext} 1), - REPEAT (eresolve_tac ctxt [allE] 1), - resolve_tac ctxt [thm] 1, - assume_tac ctxt 1]) - end - in map (fn r => r RS subst) (thm :: map mk_thm arities) end; - - (* prove inj Rep_dt_i and Rep_dt_i x : rep_set_dt_i *) - - val fun_congs = - map (fn T => make_elim (Thm.instantiate' [SOME (Thm.global_ctyp_of thy5 T)] [] fun_cong)) branchTs; - - fun prove_iso_thms ds (inj_thms, elem_thms) = - let - val (_, (tname, _, _)) = hd ds; - val induct = #induct (the (Symtab.lookup dt_info tname)); - - fun mk_ind_concl (i, _) = - let - val T = nth recTs i; - val Rep_t = Const (nth all_rep_names i, T --> Univ_elT); - val rep_set_name = nth rep_set_names i; - val concl1 = - HOLogic.all_const T $ Abs ("y", T, HOLogic.imp $ - HOLogic.mk_eq (Rep_t $ Old_Datatype_Aux.mk_Free "x" T i, Rep_t $ Bound 0) $ - HOLogic.mk_eq (Old_Datatype_Aux.mk_Free "x" T i, Bound 0)); - val concl2 = Const (rep_set_name, UnivT') $ (Rep_t $ Old_Datatype_Aux.mk_Free "x" T i); - in (concl1, concl2) end; - - val (ind_concl1, ind_concl2) = split_list (map mk_ind_concl ds); - - val rewrites = map mk_meta_eq iso_char_thms; - val inj_thms' = map snd newT_iso_inj_thms @ map (fn r => r RS @{thm injD}) inj_thms; - - val inj_thm = - Goal.prove_sorry_global thy5 [] [] - (HOLogic.mk_Trueprop (Old_Datatype_Aux.mk_conj ind_concl1)) - (fn {context = ctxt, ...} => EVERY - [(Old_Datatype_Aux.ind_tac ctxt induct [] THEN_ALL_NEW - Object_Logic.atomize_prems_tac ctxt) 1, - REPEAT (EVERY - [resolve_tac ctxt [allI] 1, resolve_tac ctxt [impI] 1, - Old_Datatype_Aux.exh_tac ctxt (exh_thm_of dt_info) 1, - REPEAT (EVERY - [hyp_subst_tac ctxt 1, - rewrite_goals_tac ctxt rewrites, - REPEAT (dresolve_tac ctxt [In0_inject, In1_inject] 1), - (eresolve_tac ctxt [In0_not_In1 RS notE, In1_not_In0 RS notE] 1) - ORELSE (EVERY - [REPEAT (eresolve_tac ctxt (Scons_inject :: - map make_elim [Leaf_inject, Inl_inject, Inr_inject]) 1), - REPEAT (cong_tac ctxt 1), resolve_tac ctxt [refl] 1, - REPEAT (assume_tac ctxt 1 ORELSE (EVERY - [REPEAT (resolve_tac ctxt @{thms ext} 1), - REPEAT (eresolve_tac ctxt (mp :: allE :: - map make_elim (Suml_inject :: Sumr_inject :: - Lim_inject :: inj_thms') @ fun_congs) 1), - assume_tac ctxt 1]))])])])]); - - val inj_thms'' = map (fn r => r RS datatype_injI) (Old_Datatype_Aux.split_conj_thm inj_thm); - - val elem_thm = - Goal.prove_sorry_global thy5 [] [] - (HOLogic.mk_Trueprop (Old_Datatype_Aux.mk_conj ind_concl2)) - (fn {context = ctxt, ...} => - EVERY [ - (Old_Datatype_Aux.ind_tac ctxt induct [] THEN_ALL_NEW - Object_Logic.atomize_prems_tac ctxt) 1, - rewrite_goals_tac ctxt rewrites, - REPEAT ((resolve_tac ctxt rep_intrs THEN_ALL_NEW - ((REPEAT o eresolve_tac ctxt [allE]) THEN' ares_tac ctxt elem_thms)) 1)]); - - in (inj_thms'' @ inj_thms, elem_thms @ Old_Datatype_Aux.split_conj_thm elem_thm) end; - - val (iso_inj_thms_unfolded, iso_elem_thms) = - fold_rev prove_iso_thms (tl descr) ([], map #3 newT_iso_axms); - val iso_inj_thms = - map snd newT_iso_inj_thms @ map (fn r => r RS @{thm injD}) iso_inj_thms_unfolded; - - (* prove rep_set_dt_i x --> x : range Rep_dt_i *) - - fun mk_iso_t (((set_name, iso_name), i), T) = - let val isoT = T --> Univ_elT in - HOLogic.imp $ - (Const (set_name, UnivT') $ Old_Datatype_Aux.mk_Free "x" Univ_elT i) $ - (if i < length newTs then @{term True} - else HOLogic.mk_mem (Old_Datatype_Aux.mk_Free "x" Univ_elT i, - Const (@{const_name image}, isoT --> HOLogic.mk_setT T --> UnivT) $ - Const (iso_name, isoT) $ Const (@{const_abbrev UNIV}, HOLogic.mk_setT T))) - end; - - val iso_t = HOLogic.mk_Trueprop (Old_Datatype_Aux.mk_conj (map mk_iso_t - (rep_set_names ~~ all_rep_names ~~ (0 upto (length descr' - 1)) ~~ recTs))); - - (* all the theorems are proved by one single simultaneous induction *) - - val range_eqs = map (fn r => mk_meta_eq (r RS @{thm range_ex1_eq})) iso_inj_thms_unfolded; - - val iso_thms = - if length descr = 1 then [] - else - drop (length newTs) (Old_Datatype_Aux.split_conj_thm - (Goal.prove_sorry_global thy5 [] [] iso_t (fn {context = ctxt, ...} => EVERY - [(Old_Datatype_Aux.ind_tac ctxt rep_induct [] THEN_ALL_NEW - Object_Logic.atomize_prems_tac ctxt) 1, - REPEAT (resolve_tac ctxt [TrueI] 1), - rewrite_goals_tac ctxt (mk_meta_eq @{thm choice_eq} :: - Thm.symmetric (mk_meta_eq @{thm fun_eq_iff}) :: range_eqs), - rewrite_goals_tac ctxt (map Thm.symmetric range_eqs), - REPEAT (EVERY - [REPEAT (eresolve_tac ctxt ([rangeE, @{thm ex1_implies_ex} RS exE] @ - maps (mk_funs_inv thy5 o #1) newT_iso_axms) 1), - TRY (hyp_subst_tac ctxt 1), - resolve_tac ctxt [sym RS range_eqI] 1, - resolve_tac ctxt iso_char_thms 1])]))); - - val Abs_inverse_thms' = - map #1 newT_iso_axms @ - map2 (fn r_inj => fn r => @{thm f_the_inv_into_f} OF [r_inj, r RS mp]) - iso_inj_thms_unfolded iso_thms; - - val Abs_inverse_thms = maps (mk_funs_inv thy5) Abs_inverse_thms'; - - (******************* freeness theorems for constructors *******************) - - val _ = Old_Datatype_Aux.message config "Proving freeness of constructors ..."; - - (* prove theorem Rep_i (Constr_j ...) = Inj_j ... *) - - fun prove_constr_rep_thm eqn = - let - val inj_thms = map fst newT_iso_inj_thms; - val rewrites = @{thm o_def} :: constr_defs @ map (mk_meta_eq o #2) newT_iso_axms; - in - Goal.prove_sorry_global thy5 [] [] eqn - (fn {context = ctxt, ...} => EVERY - [resolve_tac ctxt inj_thms 1, - rewrite_goals_tac ctxt rewrites, - resolve_tac ctxt [refl] 3, - resolve_tac ctxt rep_intrs 2, - REPEAT (resolve_tac ctxt iso_elem_thms 1)]) - end; - - (*--------------------------------------------------------------*) - (* constr_rep_thms and rep_congs are used to prove distinctness *) - (* of constructors. *) - (*--------------------------------------------------------------*) - - val constr_rep_thms = map (map prove_constr_rep_thm) constr_rep_eqns; - - val dist_rewrites = - map (fn (rep_thms, dist_lemma) => - dist_lemma :: (rep_thms @ [In0_eq, In1_eq, In0_not_In1, In1_not_In0])) - (constr_rep_thms ~~ dist_lemmas); - - fun prove_distinct_thms dist_rewrites' = - let - fun prove [] = [] - | prove (t :: ts) = - let - val dist_thm = Goal.prove_sorry_global thy5 [] [] t (fn {context = ctxt, ...} => - EVERY [simp_tac (put_simpset HOL_ss ctxt addsimps dist_rewrites') 1]) - in dist_thm :: Drule.zero_var_indexes (dist_thm RS not_sym) :: prove ts end; - in prove end; - - val distinct_thms = - map2 (prove_distinct_thms) dist_rewrites (Old_Datatype_Prop.make_distincts descr); - - (* prove injectivity of constructors *) - - fun prove_constr_inj_thm rep_thms t = - let - val inj_thms = Scons_inject :: - map make_elim - (iso_inj_thms @ - [In0_inject, In1_inject, Leaf_inject, Inl_inject, Inr_inject, - Lim_inject, Suml_inject, Sumr_inject]) - in - Goal.prove_sorry_global thy5 [] [] t - (fn {context = ctxt, ...} => EVERY - [resolve_tac ctxt [iffI] 1, - REPEAT (eresolve_tac ctxt [conjE] 2), hyp_subst_tac ctxt 2, - resolve_tac ctxt [refl] 2, - dresolve_tac ctxt rep_congs 1, - dresolve_tac ctxt @{thms box_equals} 1, - REPEAT (resolve_tac ctxt rep_thms 1), - REPEAT (eresolve_tac ctxt inj_thms 1), - REPEAT (ares_tac ctxt [conjI] 1 ORELSE (EVERY [REPEAT (resolve_tac ctxt @{thms ext} 1), - REPEAT (eresolve_tac ctxt (make_elim fun_cong :: inj_thms) 1), - assume_tac ctxt 1]))]) - end; - - val constr_inject = - map (fn (ts, thms) => map (prove_constr_inj_thm thms) ts) - (Old_Datatype_Prop.make_injs descr ~~ constr_rep_thms); - - val ((constr_inject', distinct_thms'), thy6) = - thy5 - |> Sign.parent_path - |> Old_Datatype_Aux.store_thmss "inject" new_type_names constr_inject - ||>> Old_Datatype_Aux.store_thmss "distinct" new_type_names distinct_thms; - - (*************************** induction theorem ****************************) - - val _ = Old_Datatype_Aux.message config "Proving induction rule for datatypes ..."; - - val Rep_inverse_thms = - map (fn (_, iso, _) => iso RS subst) newT_iso_axms @ - map (fn r => r RS @{thm the_inv_f_f} RS subst) iso_inj_thms_unfolded; - val Rep_inverse_thms' = map (fn r => r RS @{thm the_inv_f_f}) iso_inj_thms_unfolded; - - fun mk_indrule_lemma (i, _) T = - let - val Rep_t = Const (nth all_rep_names i, T --> Univ_elT) $ Old_Datatype_Aux.mk_Free "x" T i; - val Abs_t = - if i < length newTs then - Const (#Abs_name (#1 (#2 (nth typedefs i))), Univ_elT --> T) - else - Const (@{const_name the_inv_into}, - [HOLogic.mk_setT T, T --> Univ_elT, Univ_elT] ---> T) $ - HOLogic.mk_UNIV T $ Const (nth all_rep_names i, T --> Univ_elT); - val prem = - HOLogic.imp $ - (Const (nth rep_set_names i, UnivT') $ Rep_t) $ - (Old_Datatype_Aux.mk_Free "P" (T --> HOLogic.boolT) (i + 1) $ (Abs_t $ Rep_t)); - val concl = - Old_Datatype_Aux.mk_Free "P" (T --> HOLogic.boolT) (i + 1) $ - Old_Datatype_Aux.mk_Free "x" T i; - in (prem, concl) end; - - val (indrule_lemma_prems, indrule_lemma_concls) = - split_list (map2 mk_indrule_lemma descr' recTs); - - val indrule_lemma = - Goal.prove_sorry_global thy6 [] [] - (Logic.mk_implies - (HOLogic.mk_Trueprop (Old_Datatype_Aux.mk_conj indrule_lemma_prems), - HOLogic.mk_Trueprop (Old_Datatype_Aux.mk_conj indrule_lemma_concls))) - (fn {context = ctxt, ...} => - EVERY - [REPEAT (eresolve_tac ctxt [conjE] 1), - REPEAT (EVERY - [TRY (resolve_tac ctxt [conjI] 1), resolve_tac ctxt Rep_inverse_thms 1, - eresolve_tac ctxt [mp] 1, resolve_tac ctxt iso_elem_thms 1])]); - - val Ps = map head_of (HOLogic.dest_conj (HOLogic.dest_Trueprop (Thm.concl_of indrule_lemma))); - val frees = - if length Ps = 1 then [Free ("P", snd (dest_Var (hd Ps)))] - else map (Free o apfst fst o dest_Var) Ps; - - val dt_induct_prop = Old_Datatype_Prop.make_ind descr; - val dt_induct = - Goal.prove_sorry_global thy6 [] - (Logic.strip_imp_prems dt_induct_prop) - (Logic.strip_imp_concl dt_induct_prop) - (fn {context = ctxt, prems, ...} => - let - val indrule_lemma' = - infer_instantiate ctxt - (map (#1 o dest_Var) Ps ~~ map (Thm.cterm_of ctxt) frees) indrule_lemma; - in - EVERY - [resolve_tac ctxt [indrule_lemma'] 1, - (Old_Datatype_Aux.ind_tac ctxt rep_induct [] THEN_ALL_NEW - Object_Logic.atomize_prems_tac ctxt) 1, - EVERY (map (fn (prem, r) => (EVERY - [REPEAT (eresolve_tac ctxt Abs_inverse_thms 1), - simp_tac (put_simpset HOL_basic_ss ctxt - addsimps (Thm.symmetric r :: Rep_inverse_thms')) 1, - DEPTH_SOLVE_1 (ares_tac ctxt [prem] 1 ORELSE eresolve_tac ctxt [allE] 1)])) - (prems ~~ (constr_defs @ map mk_meta_eq iso_char_thms)))] - end); - - val ([(_, [dt_induct'])], thy7) = - thy6 - |> Global_Theory.note_thmss "" - [((Binding.qualify true big_name (Binding.name "induct"), [case_names_induct]), - [([dt_induct], [])])]; - in - ((constr_inject', distinct_thms', dt_induct'), thy7) - end - end; - - - -(** datatype definition **) - -(* specifications *) - -type spec_cmd = - (binding * (string * string option) list * mixfix) * (binding * string list * mixfix) list; - -local - -fun parse_spec ctxt ((b, args, mx), constrs) = - ((b, map (apsnd (Typedecl.read_constraint ctxt)) args, mx), - constrs |> map (fn (c, Ts, mx') => (c, map (Syntax.parse_typ ctxt) Ts, mx'))); - -fun check_specs ctxt (specs: Old_Datatype_Aux.spec list) = - let - fun prep_spec ((tname, args, mx), constrs) tys = - let - val (args', tys1) = chop (length args) tys; - val (constrs', tys3) = (constrs, tys1) |-> fold_map (fn (cname, cargs, mx') => fn tys2 => - let val (cargs', tys3) = chop (length cargs) tys2; - in ((cname, cargs', mx'), tys3) end); - in (((tname, map dest_TFree args', mx), constrs'), tys3) end; - - val all_tys = - specs |> maps (fn ((_, args, _), cs) => map TFree args @ maps #2 cs) - |> Syntax.check_typs ctxt; - - in #1 (fold_map prep_spec specs all_tys) end; - -fun prep_specs parse raw_specs thy = - let - val ctxt = thy - |> Sign.add_types_global (map (fn ((b, args, mx), _) => (b, length args, mx)) raw_specs) - |> Proof_Context.init_global - |> fold (fn ((_, args, _), _) => fold (fn (a, _) => - Variable.declare_typ (TFree (a, dummyS))) args) raw_specs; - val specs = check_specs ctxt (map (parse ctxt) raw_specs); - in (specs, ctxt) end; - -in - -val read_specs = prep_specs parse_spec; -val check_specs = prep_specs (K I); - -end; - - -(* main commands *) - -fun gen_add_datatype prep_specs config raw_specs thy = - let - val (dts, spec_ctxt) = prep_specs raw_specs thy; - val ((_, tyvars, _), _) :: _ = dts; - val string_of_tyvar = Syntax.string_of_typ spec_ctxt o TFree; - - val (new_dts, types_syntax) = dts |> map (fn ((tname, tvs, mx), _) => - let val full_tname = Sign.full_name thy tname in - (case duplicates (op =) tvs of - [] => - if eq_set (op =) (tyvars, tvs) then ((full_tname, tvs), (tname, mx)) - else error "Mutually recursive datatypes must have same type parameters" - | dups => - error ("Duplicate parameter(s) for datatype " ^ Binding.print tname ^ - " : " ^ commas (map string_of_tyvar dups))) - end) |> split_list; - val dt_names = map fst new_dts; - - val _ = - (case duplicates (op =) (map fst new_dts) of - [] => () - | dups => error ("Duplicate datatypes: " ^ commas_quote dups)); - - fun prep_dt_spec ((tname, tvs, _), constrs) (dts', constr_syntax, i) = - let - fun prep_constr (cname, cargs, mx) (constrs, constr_syntax') = - let - val _ = - (case subtract (op =) tvs (fold Term.add_tfreesT cargs []) of - [] => () - | vs => error ("Extra type variables on rhs: " ^ commas (map string_of_tyvar vs))); - val c = Sign.full_name_path thy (Binding.name_of tname) cname; - in - (constrs @ [(c, map (Old_Datatype_Aux.dtyp_of_typ new_dts) cargs)], - constr_syntax' @ [(cname, mx)]) - end handle ERROR msg => - cat_error msg ("The error above occurred in constructor " ^ Binding.print cname ^ - " of datatype " ^ Binding.print tname); - - val (constrs', constr_syntax') = fold prep_constr constrs ([], []); - in - (case duplicates (op =) (map fst constrs') of - [] => - (dts' @ [(i, (Sign.full_name thy tname, map Old_Datatype_Aux.DtTFree tvs, constrs'))], - constr_syntax @ [constr_syntax'], i + 1) - | dups => - error ("Duplicate constructors " ^ commas_quote dups ^ - " in datatype " ^ Binding.print tname)) - end; - - val (dts', constr_syntax, i) = fold prep_dt_spec dts ([], [], 0); - - val dt_info = Old_Datatype_Data.get_all thy; - val (descr, _) = Old_Datatype_Aux.unfold_datatypes spec_ctxt dts' dt_info dts' i; - val _ = - Old_Datatype_Aux.check_nonempty descr - handle (exn as Old_Datatype_Aux.Datatype_Empty s) => - if #strict config then error ("Nonemptiness check failed for datatype " ^ quote s) - else Exn.reraise exn; - - val _ = - Old_Datatype_Aux.message config - ("Constructing datatype(s) " ^ commas_quote (map (Binding.name_of o #1 o #1) dts)); - in - thy - |> representation_proofs config dt_info descr types_syntax constr_syntax - (Old_Datatype_Data.mk_case_names_induct (flat descr)) - |-> (fn (inject, distinct, induct) => - Old_Rep_Datatype.derive_datatype_props config dt_names descr induct inject distinct) - end; - -val add_datatype = gen_add_datatype check_specs; -val add_datatype_cmd = gen_add_datatype read_specs; - - -(* outer syntax *) - -val spec_cmd = - Parse.type_args_constrained -- Parse.binding -- Parse.opt_mixfix -- - (@{keyword "="} |-- Parse.enum1 "|" (Parse.binding -- Scan.repeat Parse.typ -- Parse.opt_mixfix)) - >> (fn (((vs, t), mx), cons) => ((t, vs, mx), map Scan.triple1 cons)); - -val _ = - Outer_Syntax.command @{command_keyword old_datatype} "define old-style inductive datatypes" - (Parse.and_list1 spec_cmd - >> (Toplevel.theory o (snd oo add_datatype_cmd Old_Datatype_Aux.default_config))); - -val _ = - Outer_Syntax.command @{command_keyword atomic_old_datatype} "define old-style inductive datatypes" - (Parse.and_list1 spec_cmd - >> (Toplevel.theory o (snd oo add_datatype_cmd (Old_Datatype_Aux.default_config' 1)))); - -val _ = - Outer_Syntax.command @{command_keyword sub_atomic_old_datatype} "define old-style inductive datatypes" - (Parse.and_list1 spec_cmd - >> (Toplevel.theory o (snd oo add_datatype_cmd (Old_Datatype_Aux.default_config' 2)))); - -open Old_Datatype_Aux; - -end; diff --git a/Citadelle/src/compiler_generic/isabelle_d_atomic/src/HOL/Tools/Old_Datatype/old_datatype_aux.ML b/Citadelle/src/compiler_generic/isabelle_d_atomic/src/HOL/Tools/Old_Datatype/old_datatype_aux.ML deleted file mode 100644 index 8bf53c4b965a1eb2522613c5b5dff6914ed89e5f..0000000000000000000000000000000000000000 --- a/Citadelle/src/compiler_generic/isabelle_d_atomic/src/HOL/Tools/Old_Datatype/old_datatype_aux.ML +++ /dev/null @@ -1,408 +0,0 @@ -(* Title: HOL/Tools/Old_Datatype/old_datatype_aux.ML - Author: Stefan Berghofer, TU Muenchen - -Datatype package: auxiliary data structures and functions. -*) - -signature OLD_DATATYPE_COMMON = -sig - type config = {strict : bool, quiet : bool, skip_level : int} - val default_config : config - val default_config' : int -> config - datatype dtyp = - DtTFree of string * sort - | DtType of string * dtyp list - | DtRec of int - type descr = (int * (string * dtyp list * (string * dtyp list) list)) list - type info = - {index : int, - descr : descr, - inject : thm list, - distinct : thm list, - induct : thm, - inducts : thm list, - exhaust : thm, - nchotomy : thm, - rec_names : string list, - rec_rewrites : thm list, - case_name : string, - case_rewrites : thm list, - case_cong : thm, - case_cong_weak : thm, - split : thm, - split_asm: thm} - type spec = (binding * (string * sort) list * mixfix) * (binding * typ list * mixfix) list -end - -signature OLD_DATATYPE_AUX = -sig - include OLD_DATATYPE_COMMON - - val message : config -> string -> unit - - val store_thmss_atts : string -> string list -> attribute list list -> thm list list - -> theory -> thm list list * theory - val store_thmss : string -> string list -> thm list list -> theory -> thm list list * theory - val store_thms_atts : string -> string list -> attribute list list -> thm list - -> theory -> thm list * theory - val store_thms : string -> string list -> thm list -> theory -> thm list * theory - - val split_conj_thm : thm -> thm list - val mk_conj : term list -> term - val mk_disj : term list -> term - - val app_bnds : term -> int -> term - - val ind_tac : Proof.context -> thm -> string list -> int -> tactic - val exh_tac : Proof.context -> (string -> thm) -> int -> tactic - - exception Datatype - exception Datatype_Empty of string - val name_of_typ : typ -> string - val dtyp_of_typ : (string * (string * sort) list) list -> typ -> dtyp - val mk_Free : string -> typ -> int -> term - val is_rec_type : dtyp -> bool - val typ_of_dtyp : descr -> dtyp -> typ - val dest_DtTFree : dtyp -> string * sort - val dest_DtRec : dtyp -> int - val strip_dtyp : dtyp -> dtyp list * dtyp - val body_index : dtyp -> int - val mk_fun_dtyp : dtyp list -> dtyp -> dtyp - val get_nonrec_types : descr -> typ list - val get_branching_types : descr -> typ list - val get_arities : descr -> int list - val get_rec_types : descr -> typ list - val interpret_construction : descr -> (string * sort) list -> - {atyp: typ -> 'a, dtyp: typ list -> int * bool -> string * typ list -> 'a} -> - ((string * typ list) * (string * 'a list) list) list - val check_nonempty : descr list -> unit - val unfold_datatypes : Proof.context -> descr -> info Symtab.table -> - descr -> int -> descr list * int - val find_shortest_path : descr -> int -> (string * int) option -end; - -structure Old_Datatype_Aux : OLD_DATATYPE_AUX = -struct - -(* datatype option flags *) - -type config = {strict : bool, quiet : bool, skip_level : int}; -fun default_config' i : config = {strict = true, quiet = false, skip_level = i}; -val default_config : config = default_config' 0; - -fun message ({quiet = true, ...} : config) s = writeln s - | message _ _ = (); - - -(* store theorems in theory *) - -fun store_thmss_atts name tnames attss thmss = - fold_map (fn ((tname, atts), thms) => - Global_Theory.note_thms "" - ((Binding.qualify true tname (Binding.name name), atts), [(thms, [])]) - #-> (fn (_, res) => pair res)) (tnames ~~ attss ~~ thmss); - -fun store_thmss name tnames = store_thmss_atts name tnames (replicate (length tnames) []); - -fun store_thms_atts name tnames attss thms = - fold_map (fn ((tname, atts), thm) => - Global_Theory.note_thms "" - ((Binding.qualify true tname (Binding.name name), atts), [([thm], [])]) - #-> (fn (_, [res]) => pair res)) (tnames ~~ attss ~~ thms); - -fun store_thms name tnames = store_thms_atts name tnames (replicate (length tnames) []); - - -(* split theorem thm_1 & ... & thm_n into n theorems *) - -fun split_conj_thm th = - ((th RS conjunct1) :: split_conj_thm (th RS conjunct2)) handle THM _ => [th]; - -val mk_conj = foldr1 (HOLogic.mk_binop @{const_name HOL.conj}); -val mk_disj = foldr1 (HOLogic.mk_binop @{const_name HOL.disj}); - -fun app_bnds t i = list_comb (t, map Bound (i - 1 downto 0)); - - -(* instantiate induction rule *) - -fun ind_tac ctxt indrule indnames = CSUBGOAL (fn (cgoal, i) => - let - val goal = Thm.term_of cgoal; - val ts = HOLogic.dest_conj (HOLogic.dest_Trueprop (Thm.concl_of indrule)); - val ts' = HOLogic.dest_conj (HOLogic.dest_Trueprop (Logic.strip_imp_concl goal)); - val getP = - if can HOLogic.dest_imp (hd ts) - then apfst SOME o HOLogic.dest_imp - else pair NONE; - val flt = - if null indnames then I - else filter (member (op =) indnames o fst); - fun abstr (t1, t2) = - (case t1 of - NONE => - (case flt (Term.add_frees t2 []) of - [(s, T)] => SOME (absfree (s, T) t2) - | _ => NONE) - | SOME (_ $ t') => SOME (Abs ("x", fastype_of t', abstract_over (t', t2)))); - val insts = - (ts ~~ ts') |> map_filter (fn (t, u) => - (case abstr (getP u) of - NONE => NONE - | SOME u' => SOME (t |> getP |> snd |> head_of |> dest_Var |> #1, Thm.cterm_of ctxt u'))); - val indrule' = infer_instantiate ctxt insts indrule; - in resolve_tac ctxt [indrule'] i end); - - -(* perform exhaustive case analysis on last parameter of subgoal i *) - -fun exh_tac ctxt exh_thm_of = CSUBGOAL (fn (cgoal, i) => - let - val goal = Thm.term_of cgoal; - val params = Logic.strip_params goal; - val (_, Type (tname, _)) = hd (rev params); - val exhaustion = Thm.lift_rule cgoal (exh_thm_of tname); - val prem' = hd (Thm.prems_of exhaustion); - val _ $ (_ $ lhs $ _) = hd (rev (Logic.strip_assums_hyp prem')); - val exhaustion' = - infer_instantiate ctxt - [(#1 (dest_Var (head_of lhs)), - Thm.cterm_of ctxt (fold_rev (fn (_, T) => fn t => Abs ("z", T, t)) params (Bound 0)))] - exhaustion; - in compose_tac ctxt (false, exhaustion', Thm.nprems_of exhaustion) i end); - - -(********************** Internal description of datatypes *********************) - -datatype dtyp = - DtTFree of string * sort - | DtType of string * dtyp list - | DtRec of int; - -(* information about datatypes *) - -(* index, datatype name, type arguments, constructor name, types of constructor's arguments *) -type descr = (int * (string * dtyp list * (string * dtyp list) list)) list; - -type info = - {index : int, - descr : descr, - inject : thm list, - distinct : thm list, - induct : thm, - inducts : thm list, - exhaust : thm, - nchotomy : thm, - rec_names : string list, - rec_rewrites : thm list, - case_name : string, - case_rewrites : thm list, - case_cong : thm, - case_cong_weak : thm, - split : thm, - split_asm: thm}; - -type spec = (binding * (string * sort) list * mixfix) * (binding * typ list * mixfix) list; - -fun mk_Free s T i = Free (s ^ string_of_int i, T); - -fun subst_DtTFree _ substs (T as DtTFree a) = the_default T (AList.lookup (op =) substs a) - | subst_DtTFree i substs (DtType (name, ts)) = DtType (name, map (subst_DtTFree i substs) ts) - | subst_DtTFree i _ (DtRec j) = DtRec (i + j); - -exception Datatype; -exception Datatype_Empty of string; - -fun dest_DtTFree (DtTFree a) = a - | dest_DtTFree _ = raise Datatype; - -fun dest_DtRec (DtRec i) = i - | dest_DtRec _ = raise Datatype; - -fun is_rec_type (DtType (_, dts)) = exists is_rec_type dts - | is_rec_type (DtRec _) = true - | is_rec_type _ = false; - -fun strip_dtyp (DtType ("fun", [T, U])) = apfst (cons T) (strip_dtyp U) - | strip_dtyp T = ([], T); - -val body_index = dest_DtRec o snd o strip_dtyp; - -fun mk_fun_dtyp [] U = U - | mk_fun_dtyp (T :: Ts) U = DtType ("fun", [T, mk_fun_dtyp Ts U]); - -fun name_of_typ (Type (s, Ts)) = - let val s' = Long_Name.base_name s in - space_implode "_" - (filter_out (equal "") (map name_of_typ Ts) @ - [if Symbol_Pos.is_identifier s' then s' else "x"]) - end - | name_of_typ _ = ""; - -fun dtyp_of_typ _ (TFree a) = DtTFree a - | dtyp_of_typ _ (TVar _) = error "Illegal schematic type variable(s)" - | dtyp_of_typ new_dts (Type (tname, Ts)) = - (case AList.lookup (op =) new_dts tname of - NONE => DtType (tname, map (dtyp_of_typ new_dts) Ts) - | SOME vs => - if map (try dest_TFree) Ts = map SOME vs then - DtRec (find_index (curry op = tname o fst) new_dts) - else error ("Illegal occurrence of recursive type " ^ quote tname)); - -fun typ_of_dtyp descr (DtTFree a) = TFree a - | typ_of_dtyp descr (DtRec i) = - let val (s, ds, _) = the (AList.lookup (op =) descr i) - in Type (s, map (typ_of_dtyp descr) ds) end - | typ_of_dtyp descr (DtType (s, ds)) = Type (s, map (typ_of_dtyp descr) ds); - -(* find all non-recursive types in datatype description *) - -fun get_nonrec_types descr = - map (typ_of_dtyp descr) (fold (fn (_, (_, _, constrs)) => - fold (fn (_, cargs) => union (op =) (filter_out is_rec_type cargs)) constrs) descr []); - -(* get all recursive types in datatype description *) - -fun get_rec_types descr = map (fn (_ , (s, ds, _)) => - Type (s, map (typ_of_dtyp descr) ds)) descr; - -(* get all branching types *) - -fun get_branching_types descr = - map (typ_of_dtyp descr) - (fold - (fn (_, (_, _, constrs)) => - fold (fn (_, cargs) => fold (strip_dtyp #> fst #> fold (insert op =)) cargs) constrs) - descr []); - -fun get_arities descr = - fold - (fn (_, (_, _, constrs)) => - fold (fn (_, cargs) => - fold (insert op =) (map (length o fst o strip_dtyp) (filter is_rec_type cargs))) constrs) - descr []; - -(* interpret construction of datatype *) - -fun interpret_construction descr vs {atyp, dtyp} = - let - val typ_of = - typ_of_dtyp descr #> - map_atyps (fn TFree (a, _) => TFree (a, the (AList.lookup (op =) vs a)) | T => T); - fun interpT dT = - (case strip_dtyp dT of - (dTs, DtRec l) => - let - val (tyco, dTs', _) = the (AList.lookup (op =) descr l); - val Ts = map typ_of dTs; - val Ts' = map typ_of dTs'; - val is_proper = forall (can dest_TFree) Ts'; - in dtyp Ts (l, is_proper) (tyco, Ts') end - | _ => atyp (typ_of dT)); - fun interpC (c, dTs) = (c, map interpT dTs); - fun interpD (_, (tyco, dTs, cs)) = ((tyco, map typ_of dTs), map interpC cs); - in map interpD descr end; - -(* nonemptiness check for datatypes *) - -fun check_nonempty descr = - let - val descr' = flat descr; - fun is_nonempty_dt is i = - let - val (_, _, constrs) = the (AList.lookup (op =) descr' i); - fun arg_nonempty (_, DtRec i) = - if member (op =) is i then false - else is_nonempty_dt (i :: is) i - | arg_nonempty _ = true; - in exists (forall (arg_nonempty o strip_dtyp) o snd) constrs end - val _ = hd descr |> forall (fn (i, (s, _, _)) => - is_nonempty_dt [i] i orelse raise Datatype_Empty s) - in () end; - -(* unfold a list of mutually recursive datatype specifications *) -(* all types of the form DtType (dt_name, [..., DtRec _, ...]) *) -(* need to be unfolded *) - -fun unfold_datatypes ctxt orig_descr (dt_info : info Symtab.table) descr i = - let - fun typ_error T msg = - error ("Non-admissible type expression\n" ^ - Syntax.string_of_typ ctxt (typ_of_dtyp (orig_descr @ descr) T) ^ "\n" ^ msg); - - fun get_dt_descr T i tname dts = - (case Symtab.lookup dt_info tname of - NONE => - typ_error T (quote tname ^ " is not registered as an old-style datatype and hence cannot \ - \be used in nested recursion") - | SOME {index, descr, ...} => - let - val (_, vars, _) = the (AList.lookup (op =) descr index); - val subst = map dest_DtTFree vars ~~ dts - handle ListPair.UnequalLengths => - typ_error T ("Type constructor " ^ quote tname ^ - " used with wrong number of arguments"); - in - (i + index, - map (fn (j, (tn, args, cs)) => - (i + j, (tn, map (subst_DtTFree i subst) args, - map (apsnd (map (subst_DtTFree i subst))) cs))) descr) - end); - - (* unfold a single constructor argument *) - - fun unfold_arg T (i, Ts, descrs) = - if is_rec_type T then - let val (Us, U) = strip_dtyp T in - if exists is_rec_type Us then - typ_error T "Non-strictly positive recursive occurrence of type" - else - (case U of - DtType (tname, dts) => - let - val (index, descr) = get_dt_descr T i tname dts; - val (descr', i') = - unfold_datatypes ctxt orig_descr dt_info descr (i + length descr); - in (i', Ts @ [mk_fun_dtyp Us (DtRec index)], descrs @ descr') end - | _ => (i, Ts @ [T], descrs)) - end - else (i, Ts @ [T], descrs); - - (* unfold a constructor *) - - fun unfold_constr (cname, cargs) (i, constrs, descrs) = - let val (i', cargs', descrs') = fold unfold_arg cargs (i, [], descrs) - in (i', constrs @ [(cname, cargs')], descrs') end; - - (* unfold a single datatype *) - - fun unfold_datatype (j, (tname, tvars, constrs)) (i, dtypes, descrs) = - let val (i', constrs', descrs') = fold unfold_constr constrs (i, [], descrs) - in (i', dtypes @ [(j, (tname, tvars, constrs'))], descrs') end; - - val (i', descr', descrs) = fold unfold_datatype descr (i, [], []); - - in (descr' :: descrs, i') end; - -(* find shortest path to constructor with no recursive arguments *) - -fun find_nonempty descr is i = - let - fun arg_nonempty (_, DtRec i) = - if member (op =) is i - then NONE - else Option.map (Integer.add 1 o snd) (find_nonempty descr (i :: is) i) - | arg_nonempty _ = SOME 0; - fun max_inf (SOME i) (SOME j) = SOME (Integer.max i j) - | max_inf _ _ = NONE; - fun max xs = fold max_inf xs (SOME 0); - val (_, _, constrs) = the (AList.lookup (op =) descr i); - val xs = - sort (int_ord o apply2 snd) - (map_filter (fn (s, dts) => Option.map (pair s) - (max (map (arg_nonempty o strip_dtyp) dts))) constrs) - in if null xs then NONE else SOME (hd xs) end; - -fun find_shortest_path descr i = find_nonempty descr [i] i; - -end; diff --git a/Citadelle/src/compiler_generic/isabelle_d_atomic/src/HOL/Tools/Old_Datatype/old_datatype_codegen.ML b/Citadelle/src/compiler_generic/isabelle_d_atomic/src/HOL/Tools/Old_Datatype/old_datatype_codegen.ML deleted file mode 100644 index f56367b3665d5ed9c7e155379487d31eb041f3de..0000000000000000000000000000000000000000 --- a/Citadelle/src/compiler_generic/isabelle_d_atomic/src/HOL/Tools/Old_Datatype/old_datatype_codegen.ML +++ /dev/null @@ -1,28 +0,0 @@ -(* Title: HOL/Tools/Old_Datatype/old_datatype_codegen.ML - Author: Stefan Berghofer and Florian Haftmann, TU Muenchen - -Code generator facilities for inductive datatypes. -*) - -signature OLD_DATATYPE_CODEGEN = -sig -end; - -structure Old_Datatype_Codegen : OLD_DATATYPE_CODEGEN = -struct - -fun add_code_for_datatype config fcT_name = - if #skip_level config >= 2 then I else fn thy => - let - val ctxt = Proof_Context.init_global thy - in - case Ctr_Sugar.ctr_sugar_of ctxt fcT_name of - SOME {ctrs, injects, distincts, case_thms, ...} => - let val Type (_, As) = body_type (fastype_of (hd ctrs)) - in Ctr_Sugar_Code.add_ctr_code fcT_name As (map dest_Const ctrs) injects distincts case_thms thy end - | _ => thy - end; - -val _ = Theory.setup (Old_Datatype_Data.interpretation (fold o add_code_for_datatype)); - -end; diff --git a/Citadelle/src/compiler_generic/isabelle_d_atomic/src/HOL/Tools/Old_Datatype/old_datatype_data.ML b/Citadelle/src/compiler_generic/isabelle_d_atomic/src/HOL/Tools/Old_Datatype/old_datatype_data.ML deleted file mode 100644 index 4eebb5ad78885d97370251dcc237f0077b48a79e..0000000000000000000000000000000000000000 --- a/Citadelle/src/compiler_generic/isabelle_d_atomic/src/HOL/Tools/Old_Datatype/old_datatype_data.ML +++ /dev/null @@ -1,262 +0,0 @@ -(* Title: HOL/Tools/Old_Datatype/old_datatype_data.ML - Author: Stefan Berghofer, TU Muenchen - -Datatype package bookkeeping. -*) - -signature OLD_DATATYPE_DATA = -sig - include OLD_DATATYPE_COMMON - - val get_all : theory -> info Symtab.table - val get_info : theory -> string -> info option - val the_info : theory -> string -> info - val info_of_constr : theory -> string * typ -> info option - val info_of_constr_permissive : theory -> string * typ -> info option - val info_of_case : theory -> string -> info option - val register: (string * info) list -> theory -> theory - val the_spec : theory -> string -> (string * sort) list * (string * typ list) list - val the_descr : theory -> string list -> - descr * (string * sort) list * string list * string * - (string list * string list) * (typ list * typ list) - val all_distincts : theory -> typ list -> thm list list - val get_constrs : theory -> string -> (string * typ) list option - val mk_case_names_induct: descr -> attribute - val mk_case_names_exhausts: descr -> string list -> attribute list - val interpretation : (config -> string list -> theory -> theory) -> theory -> theory - val interpretation_data : config * string list -> theory -> theory -end; - -structure Old_Datatype_Data: OLD_DATATYPE_DATA = -struct - -(** theory data **) - -(* data management *) - -structure Data = Theory_Data -( - type T = - {types: Old_Datatype_Aux.info Symtab.table, - constrs: (string * Old_Datatype_Aux.info) list Symtab.table, - cases: Old_Datatype_Aux.info Symtab.table}; - - val empty = - {types = Symtab.empty, constrs = Symtab.empty, cases = Symtab.empty}; - val extend = I; - fun merge - ({types = types1, constrs = constrs1, cases = cases1}, - {types = types2, constrs = constrs2, cases = cases2}) : T = - {types = Symtab.merge (K true) (types1, types2), - constrs = Symtab.join (K (AList.merge (op =) (K true))) (constrs1, constrs2), - cases = Symtab.merge (K true) (cases1, cases2)}; -); - -val get_all = #types o Data.get; -val get_info = Symtab.lookup o get_all; - -fun the_info thy name = - (case get_info thy name of - SOME info => info - | NONE => error ("Unknown old-style datatype " ^ quote name)); - -fun info_of_constr thy (c, T) = - let - val tab = Symtab.lookup_list (#constrs (Data.get thy)) c; - in - (case body_type T of - Type (tyco, _) => AList.lookup (op =) tab tyco - | _ => NONE) - end; - -fun info_of_constr_permissive thy (c, T) = - let - val tab = Symtab.lookup_list (#constrs (Data.get thy)) c; - val hint = (case body_type T of Type (tyco, _) => SOME tyco | _ => NONE); - val default = if null tab then NONE else SOME (snd (List.last tab)); - (*conservative wrt. overloaded constructors*) - in - (case hint of - NONE => default - | SOME tyco => - (case AList.lookup (op =) tab tyco of - NONE => default (*permissive*) - | SOME info => SOME info)) - end; - -val info_of_case = Symtab.lookup o #cases o Data.get; - -fun ctrs_of_exhaust exhaust = - Logic.strip_imp_prems (Thm.prop_of exhaust) |> - map (head_of o snd o HOLogic.dest_eq o HOLogic.dest_Trueprop o the_single - o Logic.strip_assums_hyp); - -fun case_of_case_rewrite case_rewrite = - head_of (fst (HOLogic.dest_eq (HOLogic.dest_Trueprop (Thm.prop_of case_rewrite)))); - -fun ctr_sugar_of_info ({exhaust, nchotomy, inject, distinct, case_rewrites, case_cong, - case_cong_weak, split, split_asm, ...} : Old_Datatype_Aux.info) = - let val ctrs = ctrs_of_exhaust exhaust in - {kind = Ctr_Sugar.Datatype, - T = case ctrs of ctr1 :: _ => body_type (fastype_of ctr1) | _ => @{typ bool}, - ctrs = ctrs, - casex = case case_rewrites of [] => @{term True} | _ => case_of_case_rewrite (hd case_rewrites), - discs = [], - selss = [], - exhaust = exhaust, - nchotomy = nchotomy, - injects = inject, - distincts = distinct, - case_thms = case_rewrites, - case_cong = case_cong, - case_cong_weak = case_cong_weak, - case_distribs = [], - split = split, - split_asm = split_asm, - disc_defs = [], - disc_thmss = [], - discIs = [], - disc_eq_cases = [], - sel_defs = [], - sel_thmss = [], - distinct_discsss = [], - exhaust_discs = [], - exhaust_sels = [], - collapses = [], - expands = [], - split_sels = [], - split_sel_asms = [], - case_eq_ifs = []} - end; - -fun register dt_infos = - Data.map (fn {types, constrs, cases} => - {types = types |> fold Symtab.update dt_infos, - constrs = constrs |> fold (fn (constr, dtname_info) => - Symtab.map_default (constr, []) (cons dtname_info)) - (maps (fn (dtname, info as {descr, index, ...}) => - map (rpair (dtname, info) o fst) (#3 (the (AList.lookup op = descr index)))) dt_infos), - cases = cases |> fold Symtab.update - (map (fn (_, info as {case_name, ...}) => (case_name, info)) dt_infos)}) #> - fold (Ctr_Sugar.default_register_ctr_sugar_global (K true) o ctr_sugar_of_info o snd) dt_infos; - - -(* complex queries *) - -fun the_spec thy dtco = - let - val {descr, index, ...} = the_info thy dtco; - val (_, dtys, raw_cos) = the (AList.lookup (op =) descr index); - val args = map Old_Datatype_Aux.dest_DtTFree dtys; - val cos = map (fn (co, tys) => (co, map (Old_Datatype_Aux.typ_of_dtyp descr) tys)) raw_cos; - in (args, cos) end; - -fun the_descr thy (raw_tycos as raw_tyco :: _) = - let - val info = the_info thy raw_tyco; - val descr = #descr info; - - val (_, dtys, _) = the (AList.lookup (op =) descr (#index info)); - val vs = map Old_Datatype_Aux.dest_DtTFree dtys; - - fun is_DtTFree (Old_Datatype_Aux.DtTFree _) = true - | is_DtTFree _ = false; - val k = find_index (fn (_, (_, dTs, _)) => not (forall is_DtTFree dTs)) descr; - val protoTs as (dataTs, _) = - chop k descr - |> (apply2 o map) - (fn (_, (tyco, dTs, _)) => (tyco, map (Old_Datatype_Aux.typ_of_dtyp descr) dTs)); - - val tycos = map fst dataTs; - val _ = - if eq_set (op =) (tycos, raw_tycos) then () - else - error ("Type constructors " ^ commas_quote raw_tycos ^ - " do not belong exhaustively to one mutually recursive old-style datatype"); - - val (Ts, Us) = apply2 (map Type) protoTs; - - val names = map Long_Name.base_name tycos; - val (auxnames, _) = - Name.make_context names - |> fold_map (Name.variant o Old_Datatype_Aux.name_of_typ) Us; - val prefix = space_implode "_" names; - - in (descr, vs, tycos, prefix, (names, auxnames), (Ts, Us)) end; - -fun all_distincts thy Ts = - let - fun add_tycos (Type (tyco, Ts)) = insert (op =) tyco #> fold add_tycos Ts - | add_tycos _ = I; - val tycos = fold add_tycos Ts []; - in map_filter (Option.map #distinct o get_info thy) tycos end; - -fun get_constrs thy dtco = - (case try (the_spec thy) dtco of - SOME (args, cos) => - let - fun subst (v, sort) = TVar ((v, 0), sort); - fun subst_ty (TFree v) = subst v - | subst_ty ty = ty; - val dty = Type (dtco, map subst args); - fun mk_co (co, tys) = (co, map (Term.map_atyps subst_ty) tys ---> dty); - in SOME (map mk_co cos) end - | NONE => NONE); - - - -(** various auxiliary **) - -(* case names *) - -local - -fun dt_recs (Old_Datatype_Aux.DtTFree _) = [] - | dt_recs (Old_Datatype_Aux.DtType (_, dts)) = maps dt_recs dts - | dt_recs (Old_Datatype_Aux.DtRec i) = [i]; - -fun dt_cases (descr: Old_Datatype_Aux.descr) (_, args, constrs) = - let - fun the_bname i = Long_Name.base_name (#1 (the (AList.lookup (op =) descr i))); - val bnames = map the_bname (distinct (op =) (maps dt_recs args)); - in map (fn (c, _) => space_implode "_" (Long_Name.base_name c :: bnames)) constrs end; - -fun induct_cases descr = - Old_Datatype_Prop.indexify_names (maps (dt_cases descr) (map #2 descr)); - -fun exhaust_cases descr i = dt_cases descr (the (AList.lookup (op =) descr i)); - -in - -fun mk_case_names_induct descr = Rule_Cases.case_names (induct_cases descr); - -fun mk_case_names_exhausts descr new = - map (Rule_Cases.case_names o exhaust_cases descr o #1) - (filter (fn ((_, (name, _, _))) => member (op =) new name) descr); - -end; - - - -(** abstract theory extensions relative to a datatype characterisation **) - -structure Old_Datatype_Plugin = Plugin(type T = Old_Datatype_Aux.config * string list); - -val old_datatype_plugin = Plugin_Name.declare_setup @{binding old_datatype}; - -fun interpretation f = - Old_Datatype_Plugin.interpretation old_datatype_plugin - (fn (config, type_names as name :: _) => - Local_Theory.background_theory (fn thy => - thy - |> Sign.root_path - |> Sign.add_path (Long_Name.qualifier name) - |> f config type_names - |> Sign.restore_naming thy)); - -val interpretation_data = Named_Target.theory_map o Old_Datatype_Plugin.data_default; - - -open Old_Datatype_Aux; - -end; diff --git a/Citadelle/src/compiler_generic/isabelle_d_atomic/src/HOL/Tools/Old_Datatype/old_rep_datatype.ML b/Citadelle/src/compiler_generic/isabelle_d_atomic/src/HOL/Tools/Old_Datatype/old_rep_datatype.ML deleted file mode 100644 index b55a96f7c40e5b4c839c4459b2a3df51e3d81227..0000000000000000000000000000000000000000 --- a/Citadelle/src/compiler_generic/isabelle_d_atomic/src/HOL/Tools/Old_Datatype/old_rep_datatype.ML +++ /dev/null @@ -1,718 +0,0 @@ -(* Title: HOL/Tools/Old_Datatype/old_rep_datatype.ML - Author: Stefan Berghofer, TU Muenchen - -Representation of existing types as datatypes: proofs and definitions -independent of concrete representation of datatypes (i.e. requiring -only abstract properties: injectivity / distinctness of constructors -and induction). -*) - -signature OLD_REP_DATATYPE = -sig - val derive_datatype_props : Old_Datatype_Aux.config -> string list -> - Old_Datatype_Aux.descr list -> thm -> thm list list -> thm list list -> theory -> - string list * theory - val rep_datatype : Old_Datatype_Aux.config -> (string list -> Proof.context -> Proof.context) -> - term list -> theory -> Proof.state - val rep_datatype_cmd : Old_Datatype_Aux.config -> - (string list -> Proof.context -> Proof.context) -> string list -> theory -> Proof.state -end; - -structure Old_Rep_Datatype: OLD_REP_DATATYPE = -struct - -(** derived definitions and proofs **) - -(* case distinction theorems *) - -fun prove_casedist_thms (config : Old_Datatype_Aux.config) - new_type_names descr induct case_names_exhausts thy = - let - val _ = Old_Datatype_Aux.message config "Proving case distinction theorems ..."; - - val descr' = flat descr; - val recTs = Old_Datatype_Aux.get_rec_types descr'; - val newTs = take (length (hd descr)) recTs; - - val maxidx = Thm.maxidx_of induct; - val induct_Ps = - map head_of (HOLogic.dest_conj (HOLogic.dest_Trueprop (Thm.concl_of induct))); - - fun prove_casedist_thm (i, (T, t)) = - let - val dummyPs = map (fn (Var (_, Type (_, [T', T'']))) => - Abs ("z", T', Const (@{const_name True}, T''))) induct_Ps; - val P = - Abs ("z", T, HOLogic.imp $ HOLogic.mk_eq (Var (("a", maxidx + 1), T), Bound 0) $ - Var (("P", 0), HOLogic.boolT)); - val insts = take i dummyPs @ (P :: drop (i + 1) dummyPs); - in - Goal.prove_sorry_global thy [] - (Logic.strip_imp_prems t) - (Logic.strip_imp_concl t) - (fn {context = ctxt, prems, ...} => - let - val insts' = map (#1 o dest_Var) induct_Ps ~~ map (Thm.cterm_of ctxt) insts; - val induct' = - refl RS - (nth (Old_Datatype_Aux.split_conj_thm (infer_instantiate ctxt insts' induct)) i - RSN (2, rev_mp)); - in - EVERY - [resolve_tac ctxt [induct'] 1, - REPEAT (resolve_tac ctxt [TrueI] 1), - REPEAT ((resolve_tac ctxt [impI] 1) THEN (eresolve_tac ctxt prems 1)), - REPEAT (resolve_tac ctxt [TrueI] 1)] - end) - end; - - val casedist_thms = - map_index prove_casedist_thm (newTs ~~ Old_Datatype_Prop.make_casedists descr); - in - thy - |> Old_Datatype_Aux.store_thms_atts "exhaust" new_type_names - (map single case_names_exhausts) casedist_thms - end; - - -(* primrec combinators *) - -fun prove_primrec_thms (config : Old_Datatype_Aux.config) new_type_names descr - injects_of constr_inject (dist_rewrites, other_dist_rewrites) induct thy = - let - val _ = Old_Datatype_Aux.message config "Constructing primrec combinators ..."; - - val big_name = space_implode "_" new_type_names; - val thy0 = Sign.add_path big_name thy; - - val descr' = flat descr; - val recTs = Old_Datatype_Aux.get_rec_types descr'; - val used = fold Term.add_tfree_namesT recTs []; - val newTs = take (length (hd descr)) recTs; - - val induct_Ps = - map head_of (HOLogic.dest_conj (HOLogic.dest_Trueprop (Thm.concl_of induct))); - - val big_rec_name' = "rec_set_" ^ big_name; - val rec_set_names' = - if length descr' = 1 then [big_rec_name'] - else map (prefix (big_rec_name' ^ "_") o string_of_int) (1 upto length descr'); - val rec_set_names = map (Sign.full_bname thy0) rec_set_names'; - - val (rec_result_Ts, reccomb_fn_Ts) = Old_Datatype_Prop.make_primrec_Ts descr used; - - val rec_set_Ts = - map (fn (T1, T2) => (reccomb_fn_Ts @ [T1, T2]) ---> HOLogic.boolT) (recTs ~~ rec_result_Ts); - - val rec_fns = - map (uncurry (Old_Datatype_Aux.mk_Free "f")) (reccomb_fn_Ts ~~ (1 upto length reccomb_fn_Ts)); - val rec_sets' = - map (fn c => list_comb (Free c, rec_fns)) (rec_set_names' ~~ rec_set_Ts); - val rec_sets = - map (fn c => list_comb (Const c, rec_fns)) (rec_set_names ~~ rec_set_Ts); - - (* introduction rules for graph of primrec function *) - - fun make_rec_intr T rec_set (cname, cargs) (rec_intr_ts, l) = - let - fun mk_prem (dt, U) (j, k, prems, t1s, t2s) = - let val free1 = Old_Datatype_Aux.mk_Free "x" U j in - (case (Old_Datatype_Aux.strip_dtyp dt, strip_type U) of - ((_, Old_Datatype_Aux.DtRec m), (Us, _)) => - let - val free2 = Old_Datatype_Aux.mk_Free "y" (Us ---> nth rec_result_Ts m) k; - val i = length Us; - in - (j + 1, k + 1, - HOLogic.mk_Trueprop (HOLogic.list_all - (map (pair "x") Us, nth rec_sets' m $ - Old_Datatype_Aux.app_bnds free1 i $ - Old_Datatype_Aux.app_bnds free2 i)) :: prems, - free1 :: t1s, free2 :: t2s) - end - | _ => (j + 1, k, prems, free1 :: t1s, t2s)) - end; - - val Ts = map (Old_Datatype_Aux.typ_of_dtyp descr') cargs; - val (_, _, prems, t1s, t2s) = fold_rev mk_prem (cargs ~~ Ts) (1, 1, [], [], []); - - in - (rec_intr_ts @ - [Logic.list_implies (prems, HOLogic.mk_Trueprop - (rec_set $ list_comb (Const (cname, Ts ---> T), t1s) $ - list_comb (nth rec_fns l, t1s @ t2s)))], l + 1) - end; - - val (rec_intr_ts, _) = - fold (fn ((d, T), set_name) => - fold (make_rec_intr T set_name) (#3 (snd d))) (descr' ~~ recTs ~~ rec_sets') ([], 0); - - val ({intrs = rec_intrs, elims = rec_elims, ...}, thy1) = - thy0 - |> Sign.concealed - |> Inductive.add_inductive_global - {quiet_mode = #quiet config, verbose = false, alt_name = Binding.name big_rec_name', - coind = false, no_elim = false, no_elim' = false, no_ind0 = #skip_level config >= 1, - no_eqs = #skip_level config >= 1, no_ind = true, skip_mono = true} - (map (fn (s, T) => ((Binding.name s, T), NoSyn)) (rec_set_names' ~~ rec_set_Ts)) - (map dest_Free rec_fns) - (map (fn x => (Binding.empty_atts, x)) rec_intr_ts) [] - ||> Sign.restore_naming thy0; - - (* prove uniqueness and termination of primrec combinators *) - - val _ = Old_Datatype_Aux.message config - "Proving termination and uniqueness of primrec functions ..."; - - fun mk_unique_tac ctxt ((((i, (tname, _, constrs)), elim), T), T') (tac, intrs) = - let - val distinct_tac = - if i < length newTs then - full_simp_tac (put_simpset HOL_ss ctxt addsimps (nth dist_rewrites i)) 1 - else full_simp_tac (put_simpset HOL_ss ctxt addsimps (flat other_dist_rewrites)) 1; - - val inject = - map (fn r => r RS iffD1) - (if i < length newTs then nth constr_inject i else injects_of tname); - - fun mk_unique_constr_tac n (cname, cargs) (tac, intr :: intrs, j) = - let - val k = length (filter Old_Datatype_Aux.is_rec_type cargs); - in - (EVERY - [DETERM tac, - REPEAT (eresolve_tac ctxt @{thms ex1E} 1), resolve_tac ctxt @{thms ex1I} 1, - DEPTH_SOLVE_1 (ares_tac ctxt [intr] 1), - REPEAT_DETERM_N k (eresolve_tac ctxt [thin_rl] 1 THEN rotate_tac 1 1), - eresolve_tac ctxt [elim] 1, - REPEAT_DETERM_N j distinct_tac, - TRY (dresolve_tac ctxt inject 1), - REPEAT (eresolve_tac ctxt [conjE] 1), hyp_subst_tac ctxt 1, - REPEAT - (EVERY [eresolve_tac ctxt [allE] 1, dresolve_tac ctxt [mp] 1, assume_tac ctxt 1]), - TRY (hyp_subst_tac ctxt 1), - resolve_tac ctxt [refl] 1, - REPEAT_DETERM_N (n - j - 1) distinct_tac], - intrs, j + 1) - end; - - val (tac', intrs', _) = - fold (mk_unique_constr_tac (length constrs)) constrs (tac, intrs, 0); - in (tac', intrs') end; - - val rec_unique_thms = - let - val rec_unique_ts = - map (fn (((set_t, T1), T2), i) => - Const (@{const_name Ex1}, (T2 --> HOLogic.boolT) --> HOLogic.boolT) $ - absfree ("y", T2) (set_t $ Old_Datatype_Aux.mk_Free "x" T1 i $ Free ("y", T2))) - (rec_sets ~~ recTs ~~ rec_result_Ts ~~ (1 upto length recTs)); - val insts = - map (fn ((i, T), t) => absfree ("x" ^ string_of_int i, T) t) - ((1 upto length recTs) ~~ recTs ~~ rec_unique_ts); - in - Old_Datatype_Aux.split_conj_thm (Goal.prove_sorry_global thy1 [] [] - (HOLogic.mk_Trueprop (Old_Datatype_Aux.mk_conj rec_unique_ts)) - (fn {context = ctxt, ...} => - let - val induct' = - infer_instantiate ctxt - (map (#1 o dest_Var) induct_Ps ~~ map (Thm.cterm_of ctxt) insts) induct; - in - #1 (fold (mk_unique_tac ctxt) (descr' ~~ rec_elims ~~ recTs ~~ rec_result_Ts) - (((resolve_tac ctxt [induct'] THEN_ALL_NEW Object_Logic.atomize_prems_tac ctxt) 1 THEN - rewrite_goals_tac ctxt [mk_meta_eq @{thm choice_eq}], rec_intrs))) - end)) - end; - - val rec_total_thms = map (fn r => r RS @{thm theI'}) rec_unique_thms; - - (* define primrec combinators *) - - val big_reccomb_name = "rec_" ^ space_implode "_" new_type_names; - val reccomb_names = - map (Sign.full_bname thy1) - (if length descr' = 1 then [big_reccomb_name] - else map (prefix (big_reccomb_name ^ "_") o string_of_int) (1 upto length descr')); - val reccombs = - map (fn ((name, T), T') => Const (name, reccomb_fn_Ts @ [T] ---> T')) - (reccomb_names ~~ recTs ~~ rec_result_Ts); - - val (reccomb_defs, thy2) = - thy1 - |> Sign.add_consts (map (fn ((name, T), T') => - (Binding.name (Long_Name.base_name name), reccomb_fn_Ts @ [T] ---> T', NoSyn)) - (reccomb_names ~~ recTs ~~ rec_result_Ts)) - |> (Global_Theory.add_defs false o map Thm.no_attributes) - (map - (fn ((((name, comb), set), T), T') => - (Binding.name (Thm.def_name (Long_Name.base_name name)), - Logic.mk_equals (comb, fold_rev lambda rec_fns (absfree ("x", T) - (Const (@{const_name The}, (T' --> HOLogic.boolT) --> T') $ absfree ("y", T') - (set $ Free ("x", T) $ Free ("y", T'))))))) - (reccomb_names ~~ reccombs ~~ rec_sets ~~ recTs ~~ rec_result_Ts)) - ||> Sign.parent_path; - - - (* prove characteristic equations for primrec combinators *) - - val _ = Old_Datatype_Aux.message config - "Proving characteristic theorems for primrec combinators ..."; - - val rec_thms = - map (fn t => - Goal.prove_sorry_global thy2 [] [] t - (fn {context = ctxt, ...} => EVERY - [rewrite_goals_tac ctxt reccomb_defs, - resolve_tac ctxt @{thms the1_equality} 1, - resolve_tac ctxt rec_unique_thms 1, - resolve_tac ctxt rec_intrs 1, - REPEAT (resolve_tac ctxt [allI] 1 ORELSE resolve_tac ctxt rec_total_thms 1)])) - (Old_Datatype_Prop.make_primrecs reccomb_names descr thy2); - in - thy2 - |> Sign.add_path (space_implode "_" new_type_names) - |> Global_Theory.note_thms "" - ((Binding.name "rec", [Named_Theorems.add @{named_theorems nitpick_simp}]), [(rec_thms, [])]) - ||> Sign.parent_path - |-> (fn (_, thms) => pair (reccomb_names, thms)) - end; - - -(* case combinators *) - -fun prove_case_thms (config : Old_Datatype_Aux.config) - new_type_names descr reccomb_names primrec_thms thy = - let - val _ = Old_Datatype_Aux.message config - "Proving characteristic theorems for case combinators ..."; - - val ctxt = Proof_Context.init_global thy; - val thy1 = Sign.add_path (space_implode "_" new_type_names) thy; - - val descr' = flat descr; - val recTs = Old_Datatype_Aux.get_rec_types descr'; - val used = fold Term.add_tfree_namesT recTs []; - val newTs = take (length (hd descr)) recTs; - val T' = TFree (singleton (Name.variant_list used) "'t", @{sort type}); - - fun mk_dummyT dt = binder_types (Old_Datatype_Aux.typ_of_dtyp descr' dt) ---> T'; - - val case_dummy_fns = - map (fn (_, (_, _, constrs)) => map (fn (_, cargs) => - let - val Ts = map (Old_Datatype_Aux.typ_of_dtyp descr') cargs; - val Ts' = map mk_dummyT (filter Old_Datatype_Aux.is_rec_type cargs) - in Const (@{const_name undefined}, Ts @ Ts' ---> T') end) constrs) descr'; - - val case_names0 = map (fn s => Sign.full_bname thy1 ("case_" ^ s)) new_type_names; - - (* define case combinators via primrec combinators *) - - fun def_case ((((i, (_, _, constrs)), T as Type (Tcon, _)), name), recname) (defs, thy) = - if is_some (Ctr_Sugar.ctr_sugar_of ctxt Tcon) then - (defs, thy) - else - let - val (fns1, fns2) = split_list (map (fn ((_, cargs), j) => - let - val Ts = map (Old_Datatype_Aux.typ_of_dtyp descr') cargs; - val Ts' = Ts @ map mk_dummyT (filter Old_Datatype_Aux.is_rec_type cargs); - val frees' = map2 (Old_Datatype_Aux.mk_Free "x") Ts' (1 upto length Ts'); - val frees = take (length cargs) frees'; - val free = Old_Datatype_Aux.mk_Free "f" (Ts ---> T') j; - in - (free, fold_rev (absfree o dest_Free) frees' (list_comb (free, frees))) - end) (constrs ~~ (1 upto length constrs))); - - val caseT = map (snd o dest_Free) fns1 @ [T] ---> T'; - val fns = flat (take i case_dummy_fns) @ fns2 @ flat (drop (i + 1) case_dummy_fns); - val reccomb = Const (recname, (map fastype_of fns) @ [T] ---> T'); - val decl = ((Binding.name (Long_Name.base_name name), caseT), NoSyn); - val def = - (Binding.name (Thm.def_name (Long_Name.base_name name)), - Logic.mk_equals (Const (name, caseT), - fold_rev lambda fns1 - (list_comb (reccomb, - flat (take i case_dummy_fns) @ fns2 @ flat (drop (i + 1) case_dummy_fns))))); - val ([def_thm], thy') = - thy - |> Sign.declare_const_global decl |> snd - |> (Global_Theory.add_defs false o map Thm.no_attributes) [def]; - in (defs @ [def_thm], thy') end; - - val (case_defs, thy2) = - fold def_case (hd descr ~~ newTs ~~ case_names0 ~~ take (length newTs) reccomb_names) - ([], thy1); - - fun prove_case t = - Goal.prove_sorry_global thy2 [] [] t (fn {context = ctxt, ...} => - EVERY [rewrite_goals_tac ctxt (case_defs @ map mk_meta_eq primrec_thms), - resolve_tac ctxt [refl] 1]); - - fun prove_cases (Type (Tcon, _)) ts = - (case Ctr_Sugar.ctr_sugar_of ctxt Tcon of - SOME {case_thms, ...} => case_thms - | NONE => map prove_case ts); - - val case_thms = - map2 prove_cases newTs (Old_Datatype_Prop.make_cases case_names0 descr thy2); - - fun case_name_of (th :: _) = - fst (dest_Const (head_of (fst (HOLogic.dest_eq (HOLogic.dest_Trueprop (Thm.prop_of th)))))); - - val case_names = map case_name_of case_thms; - in - thy2 - |> Context.theory_map - ((fold o fold) (Named_Theorems.add_thm @{named_theorems nitpick_simp}) case_thms) - |> Sign.parent_path - |> Old_Datatype_Aux.store_thmss "case" new_type_names case_thms - |-> (fn thmss => pair (thmss, case_names)) - end; - - -(* case splitting *) - -fun prove_split_thms (config : Old_Datatype_Aux.config) - new_type_names case_names descr constr_inject dist_rewrites casedist_thms case_thms thy = - let - val _ = Old_Datatype_Aux.message config "Proving equations for case splitting ..."; - - val descr' = flat descr; - val recTs = Old_Datatype_Aux.get_rec_types descr'; - val newTs = take (length (hd descr)) recTs; - - fun prove_split_thms ((((((t1, t2), inject), dist_rewrites'), exhaustion), case_thms'), T) = - let - val _ $ (_ $ lhs $ _) = hd (Logic.strip_assums_hyp (hd (Thm.prems_of exhaustion))); - val ctxt = Proof_Context.init_global thy; - val exhaustion' = exhaustion - |> infer_instantiate ctxt [(#1 (dest_Var lhs), Thm.cterm_of ctxt (Free ("x", T)))]; - val tac = - EVERY [resolve_tac ctxt [exhaustion'] 1, - ALLGOALS (asm_simp_tac - (put_simpset HOL_ss ctxt addsimps (dist_rewrites' @ inject @ case_thms')))]; - in - (Goal.prove_sorry_global thy [] [] t1 (K tac), - Goal.prove_sorry_global thy [] [] t2 (K tac)) - end; - - val split_thm_pairs = - map prove_split_thms - (Old_Datatype_Prop.make_splits case_names descr thy ~~ constr_inject ~~ - dist_rewrites ~~ casedist_thms ~~ case_thms ~~ newTs); - - val (split_thms, split_asm_thms) = split_list split_thm_pairs - - in - thy - |> Old_Datatype_Aux.store_thms "split" new_type_names split_thms - ||>> Old_Datatype_Aux.store_thms "split_asm" new_type_names split_asm_thms - |-> (fn (thms1, thms2) => pair (thms1 ~~ thms2)) - end; - -fun prove_case_cong_weaks new_type_names case_names descr thy = - let - fun prove_case_cong_weak t = - Goal.prove_sorry_global thy [] (Logic.strip_imp_prems t) (Logic.strip_imp_concl t) - (fn {context = ctxt, prems, ...} => - EVERY [resolve_tac ctxt [hd prems RS arg_cong] 1]); - - val case_cong_weaks = - map prove_case_cong_weak (Old_Datatype_Prop.make_case_cong_weaks case_names descr thy); - - in thy |> Old_Datatype_Aux.store_thms "case_cong_weak" new_type_names case_cong_weaks end; - - -(* additional theorems for TFL *) - -fun prove_nchotomys (config : Old_Datatype_Aux.config) new_type_names descr casedist_thms thy = - let - val _ = Old_Datatype_Aux.message config "Proving additional theorems for TFL ..."; - - fun prove_nchotomy (t, exhaustion) = - let - (* For goal i, select the correct disjunct to attack, then prove it *) - fun tac ctxt i 0 = - EVERY [TRY (resolve_tac ctxt [disjI1] i), hyp_subst_tac ctxt i, - REPEAT (resolve_tac ctxt [exI] i), resolve_tac ctxt [refl] i] - | tac ctxt i n = resolve_tac ctxt [disjI2] i THEN tac ctxt i (n - 1); - in - Goal.prove_sorry_global thy [] [] t - (fn {context = ctxt, ...} => - EVERY [resolve_tac ctxt [allI] 1, - Old_Datatype_Aux.exh_tac ctxt (K exhaustion) 1, - ALLGOALS (fn i => tac ctxt i (i - 1))]) - end; - - val nchotomys = - map prove_nchotomy (Old_Datatype_Prop.make_nchotomys descr ~~ casedist_thms); - - in thy |> Old_Datatype_Aux.store_thms "nchotomy" new_type_names nchotomys end; - -fun prove_case_congs new_type_names case_names descr nchotomys case_thms thy = - let - fun prove_case_cong ((t, nchotomy), case_rewrites) = - let - val Const (@{const_name Pure.imp}, _) $ tm $ _ = t; - val Const (@{const_name Trueprop}, _) $ (Const (@{const_name HOL.eq}, _) $ _ $ Ma) = tm; - val nchotomy' = nchotomy RS spec; - val [v] = Term.add_var_names (Thm.concl_of nchotomy') []; - in - Goal.prove_sorry_global thy [] (Logic.strip_imp_prems t) (Logic.strip_imp_concl t) - (fn {context = ctxt, prems, ...} => - let - val nchotomy'' = - infer_instantiate ctxt [(v, Thm.cterm_of ctxt Ma)] nchotomy'; - val simplify = asm_simp_tac (put_simpset HOL_ss ctxt addsimps (prems @ case_rewrites)) - in - EVERY [ - simp_tac (put_simpset HOL_ss ctxt addsimps [hd prems]) 1, - cut_tac nchotomy'' 1, - REPEAT (eresolve_tac ctxt [disjE] 1 THEN - REPEAT (eresolve_tac ctxt [exE] 1) THEN simplify 1), - REPEAT (eresolve_tac ctxt [exE] 1) THEN simplify 1 (* Get last disjunct *)] - end) - end; - - val case_congs = - map prove_case_cong - (Old_Datatype_Prop.make_case_congs case_names descr thy ~~ nchotomys ~~ case_thms); - - in thy |> Old_Datatype_Aux.store_thms "case_cong" new_type_names case_congs end; - - - -(** derive datatype props **) - -local - -fun make_dt_info descr induct inducts rec_names rec_rewrites - (index, (((((((((((_, (tname, _, _))), inject), distinct), - exhaust), nchotomy), case_name), case_rewrites), case_cong), case_cong_weak), - (split, split_asm))) = - (tname, - {index = index, - descr = descr, - inject = inject, - distinct = distinct, - induct = induct, - inducts = inducts, - exhaust = exhaust, - nchotomy = nchotomy, - rec_names = rec_names, - rec_rewrites = rec_rewrites, - case_name = case_name, - case_rewrites = case_rewrites, - case_cong = case_cong, - case_cong_weak = case_cong_weak, - split = split, - split_asm = split_asm}); - -fun make_dt_info1 descr induct inducts rec_names rec_rewrites (index, v) = - let val t = @{thm True_def} - in make_dt_info descr induct inducts rec_names rec_rewrites - (index, (((v, t), t), (t, t))) - end; - -fun make_dt_info2 descr induct inducts rec_names rec_rewrites (index, v) = - let val t = @{thm True_def} - in make_dt_info1 descr induct inducts rec_names rec_rewrites - (index, ((((((v, []), []), t), t), ""), [])) - end; - -in - -fun derive_datatype_props config dt_names descr induct inject distinct thy2 = - let - val flat_descr = flat descr; - val new_type_names = map Long_Name.base_name dt_names; - fun f_skip n a b thy = if #skip_level config >= n then (a, thy) else b thy; - val _ = - Old_Datatype_Aux.message config - ("Deriving properties for datatype(s) " ^ commas_quote new_type_names); - - val (exhaust, thy3) = thy2 - |> f_skip 2 [] (prove_casedist_thms config new_type_names descr induct - (Old_Datatype_Data.mk_case_names_exhausts flat_descr dt_names)); - val (nchotomys, thy4) = thy3 - |> f_skip 1 (map (fn _ => @{thm True_def}) exhaust) (prove_nchotomys config new_type_names descr exhaust); - val ((rec_names, rec_rewrites), thy5) = thy4 - |> f_skip 2 ([], []) (prove_primrec_thms config new_type_names descr - (#inject o the o Symtab.lookup (Old_Datatype_Data.get_all thy4)) inject - (distinct, - Old_Datatype_Data.all_distincts thy2 (Old_Datatype_Aux.get_rec_types flat_descr)) induct); - val ((case_rewrites, case_names), thy6) = thy5 - |> f_skip 2 ([], []) (prove_case_thms config new_type_names descr rec_names rec_rewrites); - val (case_congs, thy7) = thy6 - |> f_skip 1 [] (prove_case_congs new_type_names case_names descr nchotomys case_rewrites); - val (case_cong_weaks, thy8) = thy7 - |> f_skip 1 [] (prove_case_cong_weaks new_type_names case_names descr); - val (splits, thy9) = thy8 - |> f_skip 1 [] (prove_split_thms config new_type_names case_names descr - inject distinct exhaust case_rewrites); - val (inducts, _) = thy2 |> f_skip 2 [] (fn thy2 => - (Project_Rule.projections (Proof_Context.init_global thy2) induct, thy2)); - val dt_infos = - if #skip_level config >= 2 then - map_index - (make_dt_info2 flat_descr induct inducts rec_names rec_rewrites) - (hd descr) - else if #skip_level config >= 1 then - map_index - (make_dt_info1 flat_descr induct inducts rec_names rec_rewrites) - (hd descr ~~ inject ~~ distinct ~~ exhaust ~~ nchotomys ~~ - case_names ~~ case_rewrites) - else - map_index - (make_dt_info flat_descr induct inducts rec_names rec_rewrites) - (hd descr ~~ inject ~~ distinct ~~ exhaust ~~ nchotomys ~~ - case_names ~~ case_rewrites ~~ case_congs ~~ case_cong_weaks ~~ splits); - val dt_names = map fst dt_infos; - val prfx = Binding.qualify true (space_implode "_" new_type_names); - val simps = flat (inject @ distinct @ case_rewrites) @ rec_rewrites; - val named_rules = flat (map_index (fn (i, tname) => - [((Binding.empty, [Induct.induct_type tname]), [(if #skip_level config >= 2 then [] else [nth inducts i], [])]), - ((Binding.empty, [Induct.cases_type tname]), [(if #skip_level config >= 2 then [] else [nth exhaust i], [])])]) dt_names); - val unnamed_rules = map (fn induct => - ((Binding.empty, [Rule_Cases.inner_rule, Induct.induct_type ""]), [([induct], [])])) - (drop (length dt_names) inducts); - - val ctxt = Proof_Context.init_global thy9; - val case_combs = - map (Proof_Context.read_const {proper = true, strict = true} ctxt) case_names; - val constrss = map (fn (dtname, {descr, index, ...}) => - map (Proof_Context.read_const {proper = true, strict = true} ctxt o fst) - (#3 (the (AList.lookup op = descr index)))) dt_infos; - in - thy9 - |> Global_Theory.note_thmss "" - ([((prfx (Binding.name "simps"), []), [(simps, [])]), - ((prfx (Binding.name "inducts"), []), [(inducts, [])]), - ((prfx (Binding.name "splits"), []), [(maps (fn (x, y) => [x, y]) splits, [])]), - ((Binding.empty, [Simplifier.simp_add]), - [(flat case_rewrites @ flat distinct @ rec_rewrites, [])]), - ((Binding.empty, [iff_add]), [(flat inject, [])]), - ((Binding.empty, [Classical.safe_elim NONE]), - [(map (fn th => th RS notE) (flat distinct), [])]), - ((Binding.empty, [Simplifier.cong_add]), [(case_cong_weaks, [])]), - ((Binding.empty, [Induct.induct_simp_add]), [(flat (distinct @ inject), [])])] @ - named_rules @ unnamed_rules) - |> snd - |> Code.declare_default_eqns_global (map (rpair true) rec_rewrites) - |> Old_Datatype_Data.register dt_infos - |> (if #skip_level config >= 2 then I else Context.theory_map (fold2 Case_Translation.register case_combs constrss)) - |> Old_Datatype_Data.interpretation_data (config, dt_names) - |> pair dt_names - end; - -end; - - - -(** declare existing type as datatype **) - -local - -fun prove_rep_datatype config dt_names descr raw_inject half_distinct raw_induct thy1 = - let - val raw_distinct = (map o maps) (fn thm => [thm, thm RS not_sym]) half_distinct; - val new_type_names = map Long_Name.base_name dt_names; - val prfx = Binding.qualify true (space_implode "_" new_type_names); - val (((inject, distinct), [(_, [induct])]), thy2) = - thy1 - |> Old_Datatype_Aux.store_thmss "inject" new_type_names raw_inject - ||>> Old_Datatype_Aux.store_thmss "distinct" new_type_names raw_distinct - ||>> Global_Theory.note_thmss "" - [((prfx (Binding.name "induct"), [Old_Datatype_Data.mk_case_names_induct descr]), - [([raw_induct], [])])]; - in - thy2 - |> derive_datatype_props config dt_names [descr] induct inject distinct - end; - -fun gen_rep_datatype prep_term config after_qed raw_ts thy = - let - val ctxt = Proof_Context.init_global thy; - - fun constr_of_term (Const (c, T)) = (c, T) - | constr_of_term t = error ("Not a constant: " ^ Syntax.string_of_term ctxt t); - fun no_constr (c, T) = - error ("Bad constructor: " ^ Proof_Context.markup_const ctxt c ^ "::" ^ - Syntax.string_of_typ ctxt T); - fun type_of_constr (cT as (_, T)) = - let - val frees = Term.add_tfreesT T []; - val (tyco, vs) = (apsnd o map) dest_TFree (dest_Type (body_type T)) - handle TYPE _ => no_constr cT - val _ = if has_duplicates (eq_fst (op =)) vs then no_constr cT else (); - val _ = if length frees <> length vs then no_constr cT else (); - in (tyco, (vs, cT)) end; - - val raw_cs = - AList.group (op =) (map (type_of_constr o constr_of_term o prep_term thy) raw_ts); - val _ = - (case map_filter (fn (tyco, _) => - if Symtab.defined (Old_Datatype_Data.get_all thy) tyco then SOME tyco else NONE) raw_cs of - [] => () - | tycos => error ("Type(s) " ^ commas_quote tycos ^ " already represented inductively")); - val raw_vss = maps (map (map snd o fst) o snd) raw_cs; - val ms = - (case distinct (op =) (map length raw_vss) of - [n] => 0 upto n - 1 - | _ => error "Different types in given constructors"); - fun inter_sort m = - map (fn xs => nth xs m) raw_vss - |> foldr1 (Sorts.inter_sort (Sign.classes_of thy)); - val sorts = map inter_sort ms; - val vs = Name.invent_names Name.context Name.aT sorts; - - fun norm_constr (raw_vs, (c, T)) = - (c, map_atyps - (TFree o (the o AList.lookup (op =) (map fst raw_vs ~~ vs)) o fst o dest_TFree) T); - - val cs = map (apsnd (map norm_constr)) raw_cs; - val dtyps_of_typ = map (Old_Datatype_Aux.dtyp_of_typ (map (rpair vs o fst) cs)) o binder_types; - val dt_names = map fst cs; - - fun mk_spec (i, (tyco, constr)) = - (i, (tyco, map Old_Datatype_Aux.DtTFree vs, (map o apsnd) dtyps_of_typ constr)); - val descr = map_index mk_spec cs; - val injs = Old_Datatype_Prop.make_injs [descr]; - val half_distincts = Old_Datatype_Prop.make_distincts [descr]; - val ind = Old_Datatype_Prop.make_ind [descr]; - val rules = (map o map o map) Logic.close_form [[[ind]], injs, half_distincts]; - - fun after_qed' raw_thms = - let - val [[[raw_induct]], raw_inject, half_distinct] = - unflat rules (map Drule.zero_var_indexes_list raw_thms); - (*FIXME somehow dubious*) - in - Proof_Context.background_theory_result (* FIXME !? *) - (prove_rep_datatype config dt_names descr raw_inject half_distinct raw_induct) - #-> after_qed - end; - in - ctxt - |> Proof.theorem NONE after_qed' ((map o map) (rpair []) (flat rules)) - end; - -in - -val rep_datatype = gen_rep_datatype Sign.cert_term; -val rep_datatype_cmd = gen_rep_datatype Syntax.read_term_global; - -end; - - -(* outer syntax *) - -val _ = - Outer_Syntax.command @{command_keyword old_rep_datatype} - "register existing types as old-style datatypes" - (Scan.repeat1 Parse.term >> (fn ts => - Toplevel.theory_to_proof (rep_datatype_cmd Old_Datatype_Aux.default_config (K I) ts))); - -end; diff --git a/Citadelle/src/compiler_generic/isabelle_d_atomic/src/HOL/Tools/Old_Datatype/old_size.ML b/Citadelle/src/compiler_generic/isabelle_d_atomic/src/HOL/Tools/Old_Datatype/old_size.ML deleted file mode 100644 index 3e4a1abef0856168488790291d8ebd3ebf8b701d..0000000000000000000000000000000000000000 --- a/Citadelle/src/compiler_generic/isabelle_d_atomic/src/HOL/Tools/Old_Datatype/old_size.ML +++ /dev/null @@ -1,229 +0,0 @@ -(* Title: HOL/Tools/Old_Datatype/old_size.ML - Author: Stefan Berghofer, Florian Haftmann, TU Muenchen - -Size functions for old-style datatypes. -*) - -structure Old_Size: sig end = -struct - -fun plus (t1, t2) = Const (@{const_name Groups.plus}, - HOLogic.natT --> HOLogic.natT --> HOLogic.natT) $ t1 $ t2; - -fun size_of_type f g h (T as Type (s, Ts)) = - (case f s of - SOME t => SOME t - | NONE => (case g s of - SOME size_name => - SOME (list_comb (Const (size_name, - map (fn U => U --> HOLogic.natT) Ts @ [T] ---> HOLogic.natT), - map (size_of_type' f g h) Ts)) - | NONE => NONE)) - | size_of_type _ _ h (TFree (s, _)) = h s -and size_of_type' f g h T = (case size_of_type f g h T of - NONE => Abs ("x", T, HOLogic.zero) - | SOME t => t); - -fun is_poly thy (Old_Datatype_Aux.DtType (name, dts)) = - is_some (BNF_LFP_Size.size_of_global thy name) andalso exists (is_poly thy) dts - | is_poly _ _ = true; - -fun constrs_of thy name = - let - val {descr, index, ...} = Old_Datatype_Data.the_info thy name - val SOME (_, _, constrs) = AList.lookup op = descr index - in constrs end; - -val app = curry (list_comb o swap); - -fun prove_size_thms (info : Old_Datatype_Aux.info) new_type_names thy = - let - val {descr, rec_names, rec_rewrites, induct, ...} = info; - val l = length new_type_names; - val descr' = List.take (descr, l); - val tycos = map (#1 o snd) descr'; - in - if forall (fn tyco => can (Sign.arity_sorts thy tyco) [HOLogic.class_size]) tycos then - (* nothing to do -- the "size" function is already defined *) - thy - else - let - val recTs = Old_Datatype_Aux.get_rec_types descr; - val (recTs1, recTs2) = chop l recTs; - val (_, (_, paramdts, _)) :: _ = descr; - val paramTs = map (Old_Datatype_Aux.typ_of_dtyp descr) paramdts; - val ((param_size_fs, param_size_fTs), f_names) = paramTs |> - map (fn T as TFree (s, _) => - let - val name = "f" ^ unprefix "'" s; - val U = T --> HOLogic.natT - in - (((s, Free (name, U)), U), name) - end) |> split_list |>> split_list; - val param_size = AList.lookup op = param_size_fs; - - val extra_rewrites = descr |> map (#1 o snd) |> distinct op = |> - map_filter (Option.map (#2 o snd) o BNF_LFP_Size.size_of_global thy) |> flat; - val extra_size = Option.map fst o BNF_LFP_Size.size_of_global thy; - - val (((size_names, size_fns), def_names), def_names') = - recTs1 |> map (fn T as Type (s, _) => - let - val s' = "size_" ^ Long_Name.base_name s; - val s'' = Sign.full_bname thy s'; - in - (s'', - (list_comb (Const (s'', param_size_fTs @ [T] ---> HOLogic.natT), - map snd param_size_fs), - (s' ^ "_def", s' ^ "_overloaded_def"))) - end) |> split_list ||>> split_list ||>> split_list; - val overloaded_size_fns = map HOLogic.size_const recTs1; - - (* instantiation for primrec combinator *) - fun size_of_constr b size_ofp ((_, cargs), (_, cargs')) = - let - val Ts = map (Old_Datatype_Aux.typ_of_dtyp descr) cargs; - val k = length (filter Old_Datatype_Aux.is_rec_type cargs); - val (ts, _, _) = fold_rev (fn ((dt, dt'), T) => fn (us, i, j) => - if Old_Datatype_Aux.is_rec_type dt then (Bound i :: us, i + 1, j + 1) - else - (if b andalso is_poly thy dt' then - case size_of_type (K NONE) extra_size size_ofp T of - NONE => us | SOME sz => sz $ Bound j :: us - else us, i, j + 1)) - (cargs ~~ cargs' ~~ Ts) ([], 0, k); - val t = - if null ts andalso (not b orelse not (exists (is_poly thy) cargs')) - then HOLogic.zero - else foldl1 plus (ts @ [HOLogic.Suc_zero]) - in - fold_rev (fn T => fn t' => Abs ("x", T, t')) (Ts @ replicate k HOLogic.natT) t - end; - - val fs = maps (fn (_, (name, _, constrs)) => - map (size_of_constr true param_size) (constrs ~~ constrs_of thy name)) descr; - val fs' = maps (fn (n, (name, _, constrs)) => - map (size_of_constr (l <= n) (K NONE)) (constrs ~~ constrs_of thy name)) descr; - val fTs = map fastype_of fs; - - val (rec_combs1, rec_combs2) = chop l (map (fn (T, rec_name) => - Const (rec_name, fTs @ [T] ---> HOLogic.natT)) - (recTs ~~ rec_names)); - - fun define_overloaded (def_name, eq) lthy = - let - val (Free (c, _), rhs) = (Logic.dest_equals o Syntax.check_term lthy) eq; - val (thm, lthy') = lthy - |> Local_Theory.define ((Binding.name c, NoSyn), ((Binding.name def_name, []), rhs)) - |-> (fn (t, (_, thm)) => Spec_Rules.add Spec_Rules.Equational ([t], [thm]) #> pair thm); - val ctxt_thy = Proof_Context.init_global (Proof_Context.theory_of lthy'); - val thm' = singleton (Proof_Context.export lthy' ctxt_thy) thm; - in (thm', lthy') end; - - val ((size_def_thms, size_def_thms'), thy') = - thy - |> Sign.add_consts (map (fn (s, T) => (Binding.name (Long_Name.base_name s), - param_size_fTs @ [T] ---> HOLogic.natT, NoSyn)) - (size_names ~~ recTs1)) - |> Global_Theory.add_defs false - (map (Thm.no_attributes o apsnd (Logic.mk_equals o apsnd (app fs))) - (map Binding.name def_names ~~ (size_fns ~~ rec_combs1))) - ||> Class.instantiation (tycos, map dest_TFree paramTs, [HOLogic.class_size]) - ||>> fold_map define_overloaded - (def_names' ~~ map Logic.mk_equals (overloaded_size_fns ~~ map (app fs') rec_combs1)) - ||> Class.prove_instantiation_instance (fn ctxt => Class.intro_classes_tac ctxt []) - ||> Local_Theory.exit_global; - - val ctxt = Proof_Context.init_global thy'; - - val simpset1 = - put_simpset HOL_basic_ss ctxt addsimps @{thm Nat.add_0} :: @{thm Nat.add_0_right} :: - size_def_thms @ size_def_thms' @ rec_rewrites @ extra_rewrites; - val xs = map (fn i => "x" ^ string_of_int i) (1 upto length recTs2); - - fun mk_unfolded_size_eq tab size_ofp fs (p as (_, T), r) = - HOLogic.mk_eq (app fs r $ Free p, - the (size_of_type tab extra_size size_ofp T) $ Free p); - - fun prove_unfolded_size_eqs size_ofp fs = - if null recTs2 then [] - else Old_Datatype_Aux.split_conj_thm (Goal.prove_sorry ctxt xs [] - (HOLogic.mk_Trueprop (Old_Datatype_Aux.mk_conj (replicate l @{term True} @ - map (mk_unfolded_size_eq (AList.lookup op = - (new_type_names ~~ map (app fs) rec_combs1)) size_ofp fs) - (xs ~~ recTs2 ~~ rec_combs2)))) - (fn _ => (Old_Datatype_Aux.ind_tac ctxt induct xs THEN_ALL_NEW asm_simp_tac simpset1) 1)); - - val unfolded_size_eqs1 = prove_unfolded_size_eqs param_size fs; - val unfolded_size_eqs2 = prove_unfolded_size_eqs (K NONE) fs'; - - (* characteristic equations for size functions *) - fun gen_mk_size_eq p size_of size_ofp size_const T (cname, cargs) = - let - val Ts = map (Old_Datatype_Aux.typ_of_dtyp descr) cargs; - val tnames = Name.variant_list f_names (Old_Datatype_Prop.make_tnames Ts); - val ts = map_filter (fn (sT as (_, T), dt) => - Option.map (fn sz => sz $ Free sT) - (if p dt then size_of_type size_of extra_size size_ofp T - else NONE)) (tnames ~~ Ts ~~ cargs) - in - HOLogic.mk_Trueprop (HOLogic.mk_eq - (size_const $ list_comb (Const (cname, Ts ---> T), - map2 (curry Free) tnames Ts), - if null ts then HOLogic.zero - else foldl1 plus (ts @ [HOLogic.Suc_zero]))) - end; - - val simpset2 = - put_simpset HOL_basic_ss ctxt - addsimps (rec_rewrites @ size_def_thms @ unfolded_size_eqs1); - val simpset3 = - put_simpset HOL_basic_ss ctxt - addsimps (rec_rewrites @ size_def_thms' @ unfolded_size_eqs2); - - fun prove_size_eqs p size_fns size_ofp simpset = - maps (fn (((_, (_, _, constrs)), size_const), T) => - map (fn constr => Drule.export_without_context (Goal.prove_sorry ctxt [] [] - (gen_mk_size_eq p (AList.lookup op = (new_type_names ~~ size_fns)) - size_ofp size_const T constr) - (fn _ => simp_tac simpset 1))) constrs) - (descr' ~~ size_fns ~~ recTs1); - - val size_eqns = prove_size_eqs (is_poly thy') size_fns param_size simpset2 @ - prove_size_eqs Old_Datatype_Aux.is_rec_type overloaded_size_fns (K NONE) simpset3; - - val ([(_, size_thms)], thy'') = thy' - |> Global_Theory.note_thmss "" - [((Binding.name "size", - [Simplifier.simp_add, Named_Theorems.add @{named_theorems nitpick_simp}]), - [(size_eqns, [])])]; - - in - thy'' - |> fold2 (fn new_type_name => fn size_name => - BNF_LFP_Size.register_size_global new_type_name size_name refl(*dummy*) size_thms []) - new_type_names size_names - |> Code.declare_default_eqns_global (map (rpair true) size_thms) - end - end; - -fun add_size_thms config (new_type_names as name :: _) = - if #skip_level config >= 1 then I else fn thy => - let - val info as {descr, ...} = Old_Datatype_Data.the_info thy name; - val prefix = space_implode "_" (map Long_Name.base_name new_type_names); - val no_size = exists (fn (_, (_, _, constrs)) => exists (fn (_, cargs) => exists (fn dt => - Old_Datatype_Aux.is_rec_type dt andalso - not (null (fst (Old_Datatype_Aux.strip_dtyp dt)))) cargs) constrs) descr - in - if no_size then thy - else - thy - |> Sign.add_path prefix - |> prove_size_thms info new_type_names - |> Sign.restore_naming thy - end; - -val _ = Theory.setup (Old_Datatype_Data.interpretation add_size_thms); - -end; diff --git a/Citadelle/src/compiler_generic/isabelle_d_atomic/src/HOL/Tools/inductive.ML b/Citadelle/src/compiler_generic/isabelle_d_atomic/src/HOL/Tools/inductive.ML deleted file mode 100644 index dee1af2d28d5004118fc464f143ca9a3d9d896fa..0000000000000000000000000000000000000000 --- a/Citadelle/src/compiler_generic/isabelle_d_atomic/src/HOL/Tools/inductive.ML +++ /dev/null @@ -1,1337 +0,0 @@ -(* Title: HOL/Tools/inductive.ML - Author: Lawrence C Paulson, Cambridge University Computer Laboratory - Author: Stefan Berghofer and Markus Wenzel, TU Muenchen - -(Co)Inductive Definition module for HOL. - -Features: - * least or greatest fixedpoints - * mutually recursive definitions - * definitions involving arbitrary monotone operators - * automatically proves introduction and elimination rules - - Introduction rules have the form - [| M Pj ti, ..., Q x, ... |] ==> Pk t - where M is some monotone operator (usually the identity) - Q x is any side condition on the free variables - ti, t are any terms - Pj, Pk are two of the predicates being defined in mutual recursion -*) - -signature BASIC_INDUCTIVE = -sig - type inductive_result = - {preds: term list, elims: thm list, raw_induct: thm, - induct: thm, inducts: thm list, intrs: thm list, eqs: thm list} - val transform_result: morphism -> inductive_result -> inductive_result - type inductive_info = {names: string list, coind: bool} * inductive_result - val the_inductive: Proof.context -> term -> inductive_info - val the_inductive_global: Proof.context -> string -> inductive_info - val print_inductives: bool -> Proof.context -> unit - val get_monos: Proof.context -> thm list - val mono_add: attribute - val mono_del: attribute - val mk_cases_tac: Proof.context -> tactic - val mk_cases: Proof.context -> term -> thm - val inductive_forall_def: thm - val rulify: Proof.context -> thm -> thm - val inductive_cases: (Attrib.binding * string list) list -> local_theory -> - (string * thm list) list * local_theory - val inductive_cases_i: (Attrib.binding * term list) list -> local_theory -> - (string * thm list) list * local_theory - val ind_cases_rules: Proof.context -> - string list -> (binding * string option * mixfix) list -> thm list - val inductive_simps: (Attrib.binding * string list) list -> local_theory -> - (string * thm list) list * local_theory - val inductive_simps_i: (Attrib.binding * term list) list -> local_theory -> - (string * thm list) list * local_theory - type inductive_flags = - {quiet_mode: bool, verbose: bool, alt_name: binding, coind: bool, - no_elim: bool, no_elim': bool, no_ind0: bool, no_eqs: bool, no_ind: bool, skip_mono: bool} - val add_inductive_i: - inductive_flags -> ((binding * typ) * mixfix) list -> - (string * typ) list -> (Attrib.binding * term) list -> thm list -> local_theory -> - inductive_result * local_theory - val add_inductive: bool -> bool -> - (binding * string option * mixfix) list -> - (binding * string option * mixfix) list -> - Specification.multi_specs_cmd -> - (Facts.ref * Token.src list) list -> - local_theory -> inductive_result * local_theory - val add_inductive_global: inductive_flags -> - ((binding * typ) * mixfix) list -> (string * typ) list -> (Attrib.binding * term) list -> - thm list -> theory -> inductive_result * theory - val arities_of: thm -> (string * int) list - val params_of: thm -> term list - val partition_rules: thm -> thm list -> (string * thm list) list - val partition_rules': thm -> (thm * 'a) list -> (string * (thm * 'a) list) list - val unpartition_rules: thm list -> (string * 'a list) list -> 'a list - val infer_intro_vars: theory -> thm -> int -> thm list -> term list list -end; - -signature INDUCTIVE = -sig - include BASIC_INDUCTIVE - val inductive_internals: bool Config.T - val select_disj_tac: Proof.context -> int -> int -> int -> tactic - type add_ind_def = - inductive_flags -> - term list -> (Attrib.binding * term) list -> thm list -> - term list -> (binding * mixfix) list -> - local_theory -> inductive_result * local_theory - val declare_rules: binding -> bool -> bool -> bool -> bool -> bool -> string list -> term list -> - thm list -> binding list -> Token.src list list -> (thm * string list * int) list -> - thm list -> thm -> local_theory -> thm list * thm list * thm list * thm * thm list * local_theory - val add_ind_def: add_ind_def - val gen_add_inductive_i: add_ind_def -> inductive_flags -> - ((binding * typ) * mixfix) list -> (string * typ) list -> (Attrib.binding * term) list -> - thm list -> local_theory -> inductive_result * local_theory - val gen_add_inductive: add_ind_def -> bool -> bool -> - (binding * string option * mixfix) list -> - (binding * string option * mixfix) list -> - Specification.multi_specs_cmd -> (Facts.ref * Token.src list) list -> - local_theory -> inductive_result * local_theory - val gen_ind_decl: add_ind_def -> bool -> (local_theory -> local_theory) parser -end; - -structure Inductive: INDUCTIVE = -struct - -(** theory context references **) - -val inductive_forall_def = @{thm HOL.induct_forall_def}; -val inductive_conj_def = @{thm HOL.induct_conj_def}; -val inductive_conj = @{thms induct_conj}; -val inductive_atomize = @{thms induct_atomize}; -val inductive_rulify = @{thms induct_rulify}; -val inductive_rulify_fallback = @{thms induct_rulify_fallback}; - -val simp_thms1 = - map mk_meta_eq - @{lemma "(\<not> True) = False" "(\<not> False) = True" - "(True \<longrightarrow> P) = P" "(False \<longrightarrow> P) = True" - "(P \<and> True) = P" "(True \<and> P) = P" - by (fact simp_thms)+}; - -val simp_thms2 = - map mk_meta_eq [@{thm inf_fun_def}, @{thm inf_bool_def}] @ simp_thms1; - -val simp_thms3 = - @{thms le_rel_bool_arg_iff if_False if_True conj_ac - le_fun_def le_bool_def sup_fun_def sup_bool_def simp_thms - if_bool_eq_disj all_simps ex_simps imp_conjL}; - - - -(** misc utilities **) - -val inductive_internals = Attrib.setup_config_bool \<^binding>\<open>inductive_internals\<close> (K false); - -fun message quiet_mode s = if quiet_mode then () else writeln s; - -fun clean_message ctxt quiet_mode s = - if Config.get ctxt quick_and_dirty then () else message quiet_mode s; - -fun coind_prefix true = "co" - | coind_prefix false = ""; - -fun log (b: int) m n = if m >= n then 0 else 1 + log b (b * m) n; - -fun make_bool_args f g [] i = [] - | make_bool_args f g (x :: xs) i = - (if i mod 2 = 0 then f x else g x) :: make_bool_args f g xs (i div 2); - -fun make_bool_args' xs = - make_bool_args (K \<^term>\<open>False\<close>) (K \<^term>\<open>True\<close>) xs; - -fun arg_types_of k c = drop k (binder_types (fastype_of c)); - -fun find_arg T x [] = raise Fail "find_arg" - | find_arg T x ((p as (_, (SOME _, _))) :: ps) = - apsnd (cons p) (find_arg T x ps) - | find_arg T x ((p as (U, (NONE, y))) :: ps) = - if (T: typ) = U then (y, (U, (SOME x, y)) :: ps) - else apsnd (cons p) (find_arg T x ps); - -fun make_args Ts xs = - map (fn (T, (NONE, ())) => Const (\<^const_name>\<open>undefined\<close>, T) | (_, (SOME t, ())) => t) - (fold (fn (t, T) => snd o find_arg T t) xs (map (rpair (NONE, ())) Ts)); - -fun make_args' Ts xs Us = - fst (fold_map (fn T => find_arg T ()) Us (Ts ~~ map (pair NONE) xs)); - -fun dest_predicate cs params t = - let - val k = length params; - val (c, ts) = strip_comb t; - val (xs, ys) = chop k ts; - val i = find_index (fn c' => c' = c) cs; - in - if xs = params andalso i >= 0 then - SOME (c, i, ys, chop (length ys) (arg_types_of k c)) - else NONE - end; - -fun mk_names a 0 = [] - | mk_names a 1 = [a] - | mk_names a n = map (fn i => a ^ string_of_int i) (1 upto n); - -fun select_disj_tac ctxt = - let - fun tacs 1 1 = [] - | tacs _ 1 = [resolve_tac ctxt @{thms disjI1}] - | tacs n i = resolve_tac ctxt @{thms disjI2} :: tacs (n - 1) (i - 1); - in fn n => fn i => EVERY' (tacs n i) end; - - - -(** context data **) - -type inductive_result = - {preds: term list, elims: thm list, raw_induct: thm, - induct: thm, inducts: thm list, intrs: thm list, eqs: thm list}; - -fun transform_result phi {preds, elims, raw_induct: thm, induct, inducts, intrs, eqs} = - let - val term = Morphism.term phi; - val thm = Morphism.thm phi; - val fact = Morphism.fact phi; - in - {preds = map term preds, elims = fact elims, raw_induct = thm raw_induct, - induct = thm induct, inducts = fact inducts, intrs = fact intrs, eqs = fact eqs} - end; - -type inductive_info = {names: string list, coind: bool} * inductive_result; - -val empty_infos = - Item_Net.init (op = o apply2 (#names o fst)) (#preds o snd) - -val empty_equations = - Item_Net.init Thm.eq_thm_prop - (single o fst o HOLogic.dest_eq o HOLogic.dest_Trueprop o Thm.prop_of); - -datatype data = Data of - {infos: inductive_info Item_Net.T, - monos: thm list, - equations: thm Item_Net.T}; - -fun make_data (infos, monos, equations) = - Data {infos = infos, monos = monos, equations = equations}; - -structure Data = Generic_Data -( - type T = data; - val empty = make_data (empty_infos, [], empty_equations); - val extend = I; - fun merge (Data {infos = infos1, monos = monos1, equations = equations1}, - Data {infos = infos2, monos = monos2, equations = equations2}) = - make_data (Item_Net.merge (infos1, infos2), - Thm.merge_thms (monos1, monos2), - Item_Net.merge (equations1, equations2)); -); - -fun map_data f = - Data.map (fn Data {infos, monos, equations} => make_data (f (infos, monos, equations))); - -fun rep_data ctxt = Data.get (Context.Proof ctxt) |> (fn Data rep => rep); - -fun print_inductives verbose ctxt = - let - val {infos, monos, ...} = rep_data ctxt; - val space = Consts.space_of (Proof_Context.consts_of ctxt); - val consts = - Item_Net.content infos - |> maps (fn ({names, ...}, result) => map (rpair result) names) - in - [Pretty.block - (Pretty.breaks - (Pretty.str "(co)inductives:" :: - map (Pretty.mark_str o #1) - (Name_Space.markup_entries verbose ctxt space consts))), - Pretty.big_list "monotonicity rules:" (map (Thm.pretty_thm_item ctxt) monos)] - end |> Pretty.writeln_chunks; - - -(* inductive info *) - -fun the_inductive ctxt term = - Item_Net.retrieve (#infos (rep_data ctxt)) term - |> the_single - |> apsnd (transform_result (Morphism.transfer_morphism' ctxt)) - -fun the_inductive_global ctxt name = - #infos (rep_data ctxt) - |> Item_Net.content - |> filter (fn ({names, ...}, _) => member op = names name) - |> the_single - |> apsnd (transform_result (Morphism.transfer_morphism' ctxt)) - -fun put_inductives info = - map_data (fn (infos, monos, equations) => - (Item_Net.update (apsnd (transform_result Morphism.trim_context_morphism) info) infos, - monos, equations)); - - -(* monotonicity rules *) - -fun get_monos ctxt = - #monos (rep_data ctxt) - |> map (Thm.transfer' ctxt); - -fun mk_mono ctxt thm = - let - fun eq_to_mono thm' = thm' RS (thm' RS @{thm eq_to_mono}); - fun dest_less_concl thm = dest_less_concl (thm RS @{thm le_funD}) - handle THM _ => thm RS @{thm le_boolD} - in - (case Thm.concl_of thm of - Const (\<^const_name>\<open>Pure.eq\<close>, _) $ _ $ _ => eq_to_mono (HOLogic.mk_obj_eq thm) - | _ $ (Const (\<^const_name>\<open>HOL.eq\<close>, _) $ _ $ _) => eq_to_mono thm - | _ $ (Const (\<^const_name>\<open>Orderings.less_eq\<close>, _) $ _ $ _) => - dest_less_concl (Seq.hd (REPEAT (FIRSTGOAL - (resolve_tac ctxt [@{thm le_funI}, @{thm le_boolI'}])) thm)) - | _ => thm) - end handle THM _ => error ("Bad monotonicity theorem:\n" ^ Thm.string_of_thm ctxt thm); - -val mono_add = - Thm.declaration_attribute (fn thm => fn context => - map_data (fn (infos, monos, equations) => - (infos, Thm.add_thm (Thm.trim_context (mk_mono (Context.proof_of context) thm)) monos, - equations)) context); - -val mono_del = - Thm.declaration_attribute (fn thm => fn context => - map_data (fn (infos, monos, equations) => - (infos, Thm.del_thm (mk_mono (Context.proof_of context) thm) monos, equations)) context); - -val _ = - Theory.setup - (Attrib.setup \<^binding>\<open>mono\<close> (Attrib.add_del mono_add mono_del) - "declaration of monotonicity rule"); - - -(* equations *) - -fun retrieve_equations ctxt = - Item_Net.retrieve (#equations (rep_data ctxt)) - #> map (Thm.transfer' ctxt); - -val equation_add_permissive = - Thm.declaration_attribute (fn thm => - map_data (fn (infos, monos, equations) => - (infos, monos, perhaps (try (Item_Net.update (Thm.trim_context thm))) equations))); - - - -(** process rules **) - -local - -fun err_in_rule ctxt name t msg = - error (cat_lines ["Ill-formed introduction rule " ^ Binding.print name, - Syntax.string_of_term ctxt t, msg]); - -fun err_in_prem ctxt name t p msg = - error (cat_lines ["Ill-formed premise", Syntax.string_of_term ctxt p, - "in introduction rule " ^ Binding.print name, Syntax.string_of_term ctxt t, msg]); - -val bad_concl = "Conclusion of introduction rule must be an inductive predicate"; - -val bad_ind_occ = "Inductive predicate occurs in argument of inductive predicate"; - -val bad_app = "Inductive predicate must be applied to parameter(s) "; - -fun atomize_term thy = Raw_Simplifier.rewrite_term thy inductive_atomize []; - -in - -fun check_rule ctxt cs params ((binding, att), rule) = - let - val params' = Term.variant_frees rule (Logic.strip_params rule); - val frees = rev (map Free params'); - val concl = subst_bounds (frees, Logic.strip_assums_concl rule); - val prems = map (curry subst_bounds frees) (Logic.strip_assums_hyp rule); - val rule' = Logic.list_implies (prems, concl); - val aprems = map (atomize_term (Proof_Context.theory_of ctxt)) prems; - val arule = fold_rev (Logic.all o Free) params' (Logic.list_implies (aprems, concl)); - - fun check_ind err t = - (case dest_predicate cs params t of - NONE => err (bad_app ^ - commas (map (Syntax.string_of_term ctxt) params)) - | SOME (_, _, ys, _) => - if exists (fn c => exists (fn t => Logic.occs (c, t)) ys) cs - then err bad_ind_occ else ()); - - fun check_prem' prem t = - if member (op =) cs (head_of t) then - check_ind (err_in_prem ctxt binding rule prem) t - else - (case t of - Abs (_, _, t) => check_prem' prem t - | t $ u => (check_prem' prem t; check_prem' prem u) - | _ => ()); - - fun check_prem (prem, aprem) = - if can HOLogic.dest_Trueprop aprem then check_prem' prem prem - else err_in_prem ctxt binding rule prem "Non-atomic premise"; - - val _ = - (case concl of - Const (\<^const_name>\<open>Trueprop\<close>, _) $ t => - if member (op =) cs (head_of t) then - (check_ind (err_in_rule ctxt binding rule') t; - List.app check_prem (prems ~~ aprems)) - else err_in_rule ctxt binding rule' bad_concl - | _ => err_in_rule ctxt binding rule' bad_concl); - in - ((binding, att), arule) - end; - -fun rulify ctxt = - hol_simplify ctxt inductive_conj - #> hol_simplify ctxt inductive_rulify - #> hol_simplify ctxt inductive_rulify_fallback - #> Simplifier.norm_hhf ctxt; - -end; - - - -(** proofs for (co)inductive predicates **) - -(* prove monotonicity *) - -fun prove_mono quiet_mode skip_mono predT fp_fun monos ctxt = - (message (quiet_mode orelse skip_mono andalso Config.get ctxt quick_and_dirty) - " Proving monotonicity ..."; - (if skip_mono then Goal.prove_sorry else Goal.prove_future) ctxt - [] [] - (HOLogic.mk_Trueprop - (Const (\<^const_name>\<open>Orderings.mono\<close>, (predT --> predT) --> HOLogic.boolT) $ fp_fun)) - (fn _ => EVERY [resolve_tac ctxt @{thms monoI} 1, - REPEAT (resolve_tac ctxt [@{thm le_funI}, @{thm le_boolI'}] 1), - REPEAT (FIRST - [assume_tac ctxt 1, - resolve_tac ctxt (map (mk_mono ctxt) monos @ get_monos ctxt) 1, - eresolve_tac ctxt @{thms le_funE} 1, - dresolve_tac ctxt @{thms le_boolD} 1])])); - - -(* prove introduction rules *) - -fun prove_intrs quiet_mode coind mono fp_def k intr_ts rec_preds_defs ctxt ctxt' = - let - val _ = clean_message ctxt quiet_mode " Proving the introduction rules ..."; - - val unfold = funpow k (fn th => th RS fun_cong) - (mono RS (fp_def RS - (if coind then @{thm def_gfp_unfold} else @{thm def_lfp_unfold}))); - - val rules = [refl, TrueI, @{lemma "\<not> False" by (rule notI)}, exI, conjI]; - - val intrs = map_index (fn (i, intr) => - Goal.prove_sorry ctxt [] [] intr (fn _ => EVERY - [rewrite_goals_tac ctxt rec_preds_defs, - resolve_tac ctxt [unfold RS iffD2] 1, - select_disj_tac ctxt (length intr_ts) (i + 1) 1, - (*Not ares_tac, since refl must be tried before any equality assumptions; - backtracking may occur if the premises have extra variables!*) - DEPTH_SOLVE_1 (resolve_tac ctxt rules 1 APPEND assume_tac ctxt 1)]) - |> singleton (Proof_Context.export ctxt ctxt')) intr_ts - - in (intrs, unfold) end; - - -(* prove elimination rules *) - -fun prove_elims quiet_mode cs params intr_ts intr_names unfold rec_preds_defs ctxt ctxt''' = - let - val _ = clean_message ctxt quiet_mode " Proving the elimination rules ..."; - - val ([pname], ctxt') = Variable.variant_fixes ["P"] ctxt; - val P = HOLogic.mk_Trueprop (Free (pname, HOLogic.boolT)); - - fun dest_intr r = - (the (dest_predicate cs params (HOLogic.dest_Trueprop (Logic.strip_assums_concl r))), - Logic.strip_assums_hyp r, Logic.strip_params r); - - val intrs = map dest_intr intr_ts ~~ intr_names; - - val rules1 = [disjE, exE, FalseE]; - val rules2 = [conjE, FalseE, @{lemma "\<not> True \<Longrightarrow> R" by (rule notE [OF _ TrueI])}]; - - fun prove_elim c = - let - val Ts = arg_types_of (length params) c; - val (anames, ctxt'') = Variable.variant_fixes (mk_names "a" (length Ts)) ctxt'; - val frees = map Free (anames ~~ Ts); - - fun mk_elim_prem ((_, _, us, _), ts, params') = - Logic.list_all (params', - Logic.list_implies (map (HOLogic.mk_Trueprop o HOLogic.mk_eq) - (frees ~~ us) @ ts, P)); - val c_intrs = filter (equal c o #1 o #1 o #1) intrs; - val prems = HOLogic.mk_Trueprop (list_comb (c, params @ frees)) :: - map mk_elim_prem (map #1 c_intrs) - in - (Goal.prove_sorry ctxt'' [] prems P - (fn {context = ctxt4, prems} => EVERY - [cut_tac (hd prems) 1, - rewrite_goals_tac ctxt4 rec_preds_defs, - dresolve_tac ctxt4 [unfold RS iffD1] 1, - REPEAT (FIRSTGOAL (eresolve_tac ctxt4 rules1)), - REPEAT (FIRSTGOAL (eresolve_tac ctxt4 rules2)), - EVERY (map (fn prem => - DEPTH_SOLVE_1 (assume_tac ctxt4 1 ORELSE - resolve_tac ctxt [rewrite_rule ctxt4 rec_preds_defs prem, conjI] 1)) - (tl prems))]) - |> singleton (Proof_Context.export ctxt'' ctxt'''), - map #2 c_intrs, length Ts) - end - - in map prove_elim cs end; - - -(* prove simplification equations *) - -fun prove_eqs quiet_mode cs params intr_ts intrs - (elims: (thm * bstring list * int) list) ctxt ctxt'' = (* FIXME ctxt'' ?? *) - let - val _ = clean_message ctxt quiet_mode " Proving the simplification rules ..."; - - fun dest_intr r = - (the (dest_predicate cs params (HOLogic.dest_Trueprop (Logic.strip_assums_concl r))), - Logic.strip_assums_hyp r, Logic.strip_params r); - val intr_ts' = map dest_intr intr_ts; - - fun prove_eq c (elim: thm * 'a * 'b) = - let - val Ts = arg_types_of (length params) c; - val (anames, ctxt') = Variable.variant_fixes (mk_names "a" (length Ts)) ctxt; - val frees = map Free (anames ~~ Ts); - val c_intrs = filter (equal c o #1 o #1 o #1) (intr_ts' ~~ intrs); - fun mk_intr_conj (((_, _, us, _), ts, params'), _) = - let - fun list_ex ([], t) = t - | list_ex ((a, T) :: vars, t) = - HOLogic.exists_const T $ Abs (a, T, list_ex (vars, t)); - val conjs = map2 (curry HOLogic.mk_eq) frees us @ map HOLogic.dest_Trueprop ts; - in - list_ex (params', if null conjs then \<^term>\<open>True\<close> else foldr1 HOLogic.mk_conj conjs) - end; - val lhs = list_comb (c, params @ frees); - val rhs = - if null c_intrs then \<^term>\<open>False\<close> - else foldr1 HOLogic.mk_disj (map mk_intr_conj c_intrs); - val eq = HOLogic.mk_Trueprop (HOLogic.mk_eq (lhs, rhs)); - fun prove_intr1 (i, _) = Subgoal.FOCUS_PREMS (fn {context = ctxt'', params, prems, ...} => - select_disj_tac ctxt'' (length c_intrs) (i + 1) 1 THEN - EVERY (replicate (length params) (resolve_tac ctxt'' @{thms exI} 1)) THEN - (if null prems then resolve_tac ctxt'' @{thms TrueI} 1 - else - let - val (prems', last_prem) = split_last prems; - in - EVERY (map (fn prem => - (resolve_tac ctxt'' @{thms conjI} 1 THEN resolve_tac ctxt'' [prem] 1)) prems') - THEN resolve_tac ctxt'' [last_prem] 1 - end)) ctxt' 1; - fun prove_intr2 (((_, _, us, _), ts, params'), intr) = - EVERY (replicate (length params') (eresolve_tac ctxt' @{thms exE} 1)) THEN - (if null ts andalso null us then resolve_tac ctxt' [intr] 1 - else - EVERY (replicate (length ts + length us - 1) (eresolve_tac ctxt' @{thms conjE} 1)) THEN - Subgoal.FOCUS_PREMS (fn {context = ctxt'', prems, ...} => - let - val (eqs, prems') = chop (length us) prems; - val rew_thms = map (fn th => th RS @{thm eq_reflection}) eqs; - in - rewrite_goal_tac ctxt'' rew_thms 1 THEN - resolve_tac ctxt'' [intr] 1 THEN - EVERY (map (fn p => resolve_tac ctxt'' [p] 1) prems') - end) ctxt' 1); - in - Goal.prove_sorry ctxt' [] [] eq (fn _ => - resolve_tac ctxt' @{thms iffI} 1 THEN - eresolve_tac ctxt' [#1 elim] 1 THEN - EVERY (map_index prove_intr1 c_intrs) THEN - (if null c_intrs then eresolve_tac ctxt' @{thms FalseE} 1 - else - let val (c_intrs', last_c_intr) = split_last c_intrs in - EVERY (map (fn ci => eresolve_tac ctxt' @{thms disjE} 1 THEN prove_intr2 ci) c_intrs') - THEN prove_intr2 last_c_intr - end)) - |> rulify ctxt' - |> singleton (Proof_Context.export ctxt' ctxt'') - end; - in - map2 prove_eq cs elims - end; - - -(* derivation of simplified elimination rules *) - -local - -(*delete needless equality assumptions*) -val refl_thin = Goal.prove_global @{theory HOL} [] [] \<^prop>\<open>\<And>P. a = a \<Longrightarrow> P \<Longrightarrow> P\<close> - (fn {context = ctxt, ...} => assume_tac ctxt 1); -val elim_rls = [asm_rl, FalseE, refl_thin, conjE, exE]; -fun elim_tac ctxt = REPEAT o eresolve_tac ctxt elim_rls; - -fun simp_case_tac ctxt i = - EVERY' [elim_tac ctxt, - asm_full_simp_tac ctxt, - elim_tac ctxt, - REPEAT o bound_hyp_subst_tac ctxt] i; - -in - -fun mk_cases_tac ctxt = ALLGOALS (simp_case_tac ctxt) THEN prune_params_tac ctxt; - -fun mk_cases ctxt prop = - let - fun err msg = - error (Pretty.string_of (Pretty.block - [Pretty.str msg, Pretty.fbrk, Syntax.pretty_term ctxt prop])); - - val elims = Induct.find_casesP ctxt prop; - - val cprop = Thm.cterm_of ctxt prop; - fun mk_elim rl = - Thm.implies_intr cprop - (Tactic.rule_by_tactic ctxt (mk_cases_tac ctxt) (Thm.assume cprop RS rl)) - |> singleton (Variable.export (Variable.auto_fixes prop ctxt) ctxt); - in - (case get_first (try mk_elim) elims of - SOME r => r - | NONE => err "Proposition not an inductive predicate:") - end; - -end; - - -(* inductive_cases *) - -fun gen_inductive_cases prep_att prep_prop args lthy = - let - val thmss = - map snd args - |> burrow (grouped 10 Par_List.map_independent (mk_cases lthy o prep_prop lthy)); - val facts = - map2 (fn ((a, atts), _) => fn thms => ((a, map (prep_att lthy) atts), [(thms, [])])) - args thmss; - in lthy |> Local_Theory.notes facts end; - -val inductive_cases = gen_inductive_cases Attrib.check_src Syntax.read_prop; -val inductive_cases_i = gen_inductive_cases (K I) Syntax.check_prop; - - -(* ind_cases *) - -fun ind_cases_rules ctxt raw_props raw_fixes = - let - val (props, ctxt') = Specification.read_props raw_props raw_fixes ctxt; - val rules = Proof_Context.export ctxt' ctxt (map (mk_cases ctxt') props); - in rules end; - -val _ = - Theory.setup - (Method.setup \<^binding>\<open>ind_cases\<close> - (Scan.lift (Scan.repeat1 Parse.prop -- Parse.for_fixes) >> - (fn (props, fixes) => fn ctxt => - Method.erule ctxt 0 (ind_cases_rules ctxt props fixes))) - "case analysis for inductive definitions, based on simplified elimination rule"); - - -(* derivation of simplified equation *) - -fun mk_simp_eq ctxt prop = - let - val thy = Proof_Context.theory_of ctxt; - val ctxt' = Variable.auto_fixes prop ctxt; - val lhs_of = fst o HOLogic.dest_eq o HOLogic.dest_Trueprop o Thm.prop_of; - val substs = - retrieve_equations ctxt (HOLogic.dest_Trueprop prop) - |> map_filter - (fn eq => SOME (Pattern.match thy (lhs_of eq, HOLogic.dest_Trueprop prop) - (Vartab.empty, Vartab.empty), eq) - handle Pattern.MATCH => NONE); - val (subst, eq) = - (case substs of - [s] => s - | _ => error - ("equations matching pattern " ^ Syntax.string_of_term ctxt prop ^ " is not unique")); - val inst = - map (fn v => (fst v, Thm.cterm_of ctxt' (Envir.subst_term subst (Var v)))) - (Term.add_vars (lhs_of eq) []); - in - infer_instantiate ctxt' inst eq - |> Conv.fconv_rule (Conv.arg_conv (Conv.arg_conv (Simplifier.full_rewrite ctxt'))) - |> singleton (Variable.export ctxt' ctxt) - end - - -(* inductive simps *) - -fun gen_inductive_simps prep_att prep_prop args lthy = - let - val facts = args |> map (fn ((a, atts), props) => - ((a, map (prep_att lthy) atts), - map (Thm.no_attributes o single o mk_simp_eq lthy o prep_prop lthy) props)); - in lthy |> Local_Theory.notes facts end; - -val inductive_simps = gen_inductive_simps Attrib.check_src Syntax.read_prop; -val inductive_simps_i = gen_inductive_simps (K I) Syntax.check_prop; - - -(* prove induction rule *) - -fun prove_indrule quiet_mode cs argTs bs xs rec_const params intr_ts mono - fp_def rec_preds_defs ctxt ctxt''' = (* FIXME ctxt''' ?? *) - let - val _ = clean_message ctxt quiet_mode " Proving the induction rule ..."; - - (* predicates for induction rule *) - - val (pnames, ctxt') = Variable.variant_fixes (mk_names "P" (length cs)) ctxt; - val preds = - map2 (curry Free) pnames - (map (fn c => arg_types_of (length params) c ---> HOLogic.boolT) cs); - - (* transform an introduction rule into a premise for induction rule *) - - fun mk_ind_prem r = - let - fun subst s = - (case dest_predicate cs params s of - SOME (_, i, ys, (_, Ts)) => - let - val k = length Ts; - val bs = map Bound (k - 1 downto 0); - val P = list_comb (nth preds i, map (incr_boundvars k) ys @ bs); - val Q = - fold_rev Term.abs (mk_names "x" k ~~ Ts) - (HOLogic.mk_binop \<^const_name>\<open>HOL.induct_conj\<close> - (list_comb (incr_boundvars k s, bs), P)); - in (Q, case Ts of [] => SOME (s, P) | _ => NONE) end - | NONE => - (case s of - t $ u => (fst (subst t) $ fst (subst u), NONE) - | Abs (a, T, t) => (Abs (a, T, fst (subst t)), NONE) - | _ => (s, NONE))); - - fun mk_prem s prems = - (case subst s of - (_, SOME (t, u)) => t :: u :: prems - | (t, _) => t :: prems); - - val SOME (_, i, ys, _) = - dest_predicate cs params (HOLogic.dest_Trueprop (Logic.strip_assums_concl r)); - in - fold_rev (Logic.all o Free) (Logic.strip_params r) - (Logic.list_implies (map HOLogic.mk_Trueprop (fold_rev mk_prem - (map HOLogic.dest_Trueprop (Logic.strip_assums_hyp r)) []), - HOLogic.mk_Trueprop (list_comb (nth preds i, ys)))) - end; - - val ind_prems = map mk_ind_prem intr_ts; - - - (* make conclusions for induction rules *) - - val Tss = map (binder_types o fastype_of) preds; - val (xnames, ctxt'') = Variable.variant_fixes (mk_names "x" (length (flat Tss))) ctxt'; - val mutual_ind_concl = - HOLogic.mk_Trueprop (foldr1 HOLogic.mk_conj - (map (fn (((xnames, Ts), c), P) => - let val frees = map Free (xnames ~~ Ts) - in HOLogic.mk_imp (list_comb (c, params @ frees), list_comb (P, frees)) end) - (unflat Tss xnames ~~ Tss ~~ cs ~~ preds))); - - - (* make predicate for instantiation of abstract induction rule *) - - val ind_pred = - fold_rev lambda (bs @ xs) (foldr1 HOLogic.mk_conj - (map_index (fn (i, P) => fold_rev (curry HOLogic.mk_imp) - (make_bool_args HOLogic.mk_not I bs i) - (list_comb (P, make_args' argTs xs (binder_types (fastype_of P))))) preds)); - - val ind_concl = - HOLogic.mk_Trueprop - (HOLogic.mk_binrel \<^const_name>\<open>Orderings.less_eq\<close> (rec_const, ind_pred)); - - val raw_fp_induct = mono RS (fp_def RS @{thm def_lfp_induct}); - - val induct = Goal.prove_sorry ctxt'' [] ind_prems ind_concl - (fn {context = ctxt3, prems} => EVERY - [rewrite_goals_tac ctxt3 [inductive_conj_def], - DETERM (resolve_tac ctxt3 [raw_fp_induct] 1), - REPEAT (resolve_tac ctxt3 [@{thm le_funI}, @{thm le_boolI}] 1), - rewrite_goals_tac ctxt3 simp_thms2, - (*This disjE separates out the introduction rules*) - REPEAT (FIRSTGOAL (eresolve_tac ctxt3 [disjE, exE, FalseE])), - (*Now break down the individual cases. No disjE here in case - some premise involves disjunction.*) - REPEAT (FIRSTGOAL (eresolve_tac ctxt3 [conjE] ORELSE' bound_hyp_subst_tac ctxt3)), - REPEAT (FIRSTGOAL - (resolve_tac ctxt3 [conjI, impI] ORELSE' - (eresolve_tac ctxt3 [notE] THEN' assume_tac ctxt3))), - EVERY (map (fn prem => - DEPTH_SOLVE_1 (assume_tac ctxt3 1 ORELSE - resolve_tac ctxt3 - [rewrite_rule ctxt3 (inductive_conj_def :: rec_preds_defs @ simp_thms2) prem, - conjI, refl] 1)) prems)]); - - val lemma = Goal.prove_sorry ctxt'' [] [] - (Logic.mk_implies (ind_concl, mutual_ind_concl)) (fn {context = ctxt3, ...} => EVERY - [rewrite_goals_tac ctxt3 rec_preds_defs, - REPEAT (EVERY - [REPEAT (resolve_tac ctxt3 [conjI, impI] 1), - REPEAT (eresolve_tac ctxt3 [@{thm le_funE}, @{thm le_boolE}] 1), - assume_tac ctxt3 1, - rewrite_goals_tac ctxt3 simp_thms1, - assume_tac ctxt3 1])]); - - in singleton (Proof_Context.export ctxt'' ctxt''') (induct RS lemma) end; - -(* prove coinduction rule *) - -fun If_const T = Const (\<^const_name>\<open>If\<close>, HOLogic.boolT --> T --> T --> T); -fun mk_If p t f = let val T = fastype_of t in If_const T $ p $ t $ f end; - -fun prove_coindrule quiet_mode preds cs argTs bs xs params intr_ts mono - fp_def rec_preds_defs ctxt ctxt''' = (* FIXME ctxt''' ?? *) - let - val _ = clean_message ctxt quiet_mode " Proving the coinduction rule ..."; - val n = length cs; - val (ns, xss) = map_split (fn pred => - make_args' argTs xs (arg_types_of (length params) pred) |> `length) preds; - val xTss = map (map fastype_of) xss; - val (Rs_names, names_ctxt) = Variable.variant_fixes (mk_names "X" n) ctxt; - val Rs = map2 (fn name => fn Ts => Free (name, Ts ---> \<^typ>\<open>bool\<close>)) Rs_names xTss; - val Rs_applied = map2 (curry list_comb) Rs xss; - val preds_applied = map2 (curry list_comb) (map (fn p => list_comb (p, params)) preds) xss; - val abstract_list = fold_rev (absfree o dest_Free); - val bss = map (make_bool_args - (fn b => HOLogic.mk_eq (b, \<^term>\<open>False\<close>)) - (fn b => HOLogic.mk_eq (b, \<^term>\<open>True\<close>)) bs) (0 upto n - 1); - val eq_undefinedss = map (fn ys => map (fn x => - HOLogic.mk_eq (x, Const (\<^const_name>\<open>undefined\<close>, fastype_of x))) - (subtract (op =) ys xs)) xss; - val R = - @{fold 3} (fn bs => fn eqs => fn R => fn t => if null bs andalso null eqs then R else - mk_If (Library.foldr1 HOLogic.mk_conj (bs @ eqs)) R t) - bss eq_undefinedss Rs_applied \<^term>\<open>False\<close> - |> abstract_list (bs @ xs); - - fun subst t = - (case dest_predicate cs params t of - SOME (_, i, ts, (_, Us)) => - let - val l = length Us; - val bs = map Bound (l - 1 downto 0); - val args = map (incr_boundvars l) ts @ bs - in - HOLogic.mk_disj (list_comb (nth Rs i, args), - list_comb (nth preds i, params @ args)) - |> fold_rev absdummy Us - end - | NONE => - (case t of - t1 $ t2 => subst t1 $ subst t2 - | Abs (x, T, u) => Abs (x, T, subst u) - | _ => t)); - - fun mk_coind_prem r = - let - val SOME (_, i, ts, (Ts, _)) = - dest_predicate cs params (HOLogic.dest_Trueprop (Logic.strip_assums_concl r)); - val ps = - map HOLogic.mk_eq (make_args' argTs xs Ts ~~ ts) @ - map (subst o HOLogic.dest_Trueprop) (Logic.strip_assums_hyp r); - in - (i, fold_rev (fn (x, T) => fn P => HOLogic.exists_const T $ Abs (x, T, P)) - (Logic.strip_params r) - (if null ps then \<^term>\<open>True\<close> else foldr1 HOLogic.mk_conj ps)) - end; - - fun mk_prem i Ps = Logic.mk_implies - ((nth Rs_applied i, Library.foldr1 HOLogic.mk_disj Ps) |> @{apply 2} HOLogic.mk_Trueprop) - |> fold_rev Logic.all (nth xss i); - - val prems = map mk_coind_prem intr_ts |> AList.group (op =) |> sort (int_ord o apply2 fst) - |> map (uncurry mk_prem); - - val concl = @{map 3} (fn xs => - Ctr_Sugar_Util.list_all_free xs oo curry HOLogic.mk_imp) xss Rs_applied preds_applied - |> Library.foldr1 HOLogic.mk_conj |> HOLogic.mk_Trueprop; - - - val pred_defs_sym = if null rec_preds_defs then [] else map2 (fn n => fn thm => - funpow n (fn thm => thm RS @{thm meta_fun_cong}) thm RS @{thm Pure.symmetric}) - ns rec_preds_defs; - val simps = simp_thms3 @ pred_defs_sym; - val simprocs = [Simplifier.the_simproc ctxt "HOL.defined_All"]; - val simplify = asm_full_simplify (Ctr_Sugar_Util.ss_only simps ctxt addsimprocs simprocs); - val coind = (mono RS (fp_def RS @{thm def_coinduct})) - |> infer_instantiate' ctxt [SOME (Thm.cterm_of ctxt R)] - |> simplify; - fun idx_of t = find_index (fn R => - R = the_single (subtract (op =) (preds @ params) (map Free (Term.add_frees t [])))) Rs; - val coind_concls = HOLogic.dest_Trueprop (Thm.concl_of coind) |> HOLogic.dest_conj - |> map (fn t => (idx_of t, t)) |> sort (int_ord o @{apply 2} fst) |> map snd; - val reorder_bound_goals = map_filter (fn (t, u) => if t aconv u then NONE else - SOME (HOLogic.mk_Trueprop (HOLogic.mk_eq (t, u)))) - ((HOLogic.dest_Trueprop concl |> HOLogic.dest_conj) ~~ coind_concls); - val reorder_bound_thms = map (fn goal => Goal.prove_sorry ctxt [] [] goal - (fn {context = ctxt, prems = _} => - HEADGOAL (EVERY' [resolve_tac ctxt [iffI], - REPEAT_DETERM o resolve_tac ctxt [allI, impI], - REPEAT_DETERM o dresolve_tac ctxt [spec], eresolve_tac ctxt [mp], assume_tac ctxt, - REPEAT_DETERM o resolve_tac ctxt [allI, impI], - REPEAT_DETERM o dresolve_tac ctxt [spec], eresolve_tac ctxt [mp], assume_tac ctxt]))) - reorder_bound_goals; - val coinduction = Goal.prove_sorry ctxt [] prems concl (fn {context = ctxt, prems = CIH} => - HEADGOAL (full_simp_tac - (Ctr_Sugar_Util.ss_only (simps @ reorder_bound_thms) ctxt addsimprocs simprocs) THEN' - resolve_tac ctxt [coind]) THEN - ALLGOALS (REPEAT_ALL_NEW (REPEAT_DETERM o resolve_tac ctxt [allI, impI, conjI] THEN' - REPEAT_DETERM o eresolve_tac ctxt [exE, conjE] THEN' - dresolve_tac ctxt (map simplify CIH) THEN' - REPEAT_DETERM o (assume_tac ctxt ORELSE' - eresolve_tac ctxt [conjE] ORELSE' dresolve_tac ctxt [spec, mp])))) - in - coinduction - |> length cs = 1 ? (Object_Logic.rulify ctxt #> rotate_prems ~1) - |> singleton (Proof_Context.export names_ctxt ctxt''') - end - - - - -(** specification of (co)inductive predicates **) - -fun mk_ind_def quiet_mode skip_mono alt_name coind cs intr_ts monos params cnames_syn lthy = - let - val fp_name = if coind then \<^const_name>\<open>Inductive.gfp\<close> else \<^const_name>\<open>Inductive.lfp\<close>; - - val argTs = fold (combine (op =) o arg_types_of (length params)) cs []; - val k = log 2 1 (length cs); - val predT = replicate k HOLogic.boolT ---> argTs ---> HOLogic.boolT; - val p :: xs = - map Free (Variable.variant_frees lthy intr_ts - (("p", predT) :: (mk_names "x" (length argTs) ~~ argTs))); - val bs = - map Free (Variable.variant_frees lthy (p :: xs @ intr_ts) - (map (rpair HOLogic.boolT) (mk_names "b" k))); - - fun subst t = - (case dest_predicate cs params t of - SOME (_, i, ts, (Ts, Us)) => - let - val l = length Us; - val zs = map Bound (l - 1 downto 0); - in - fold_rev (Term.abs o pair "z") Us - (list_comb (p, - make_bool_args' bs i @ make_args argTs - ((map (incr_boundvars l) ts ~~ Ts) @ (zs ~~ Us)))) - end - | NONE => - (case t of - t1 $ t2 => subst t1 $ subst t2 - | Abs (x, T, u) => Abs (x, T, subst u) - | _ => t)); - - (* transform an introduction rule into a conjunction *) - (* [| p_i t; ... |] ==> p_j u *) - (* is transformed into *) - (* b_j & x_j = u & p b_j t & ... *) - - fun transform_rule r = - let - val SOME (_, i, ts, (Ts, _)) = - dest_predicate cs params (HOLogic.dest_Trueprop (Logic.strip_assums_concl r)); - val ps = - make_bool_args HOLogic.mk_not I bs i @ - map HOLogic.mk_eq (make_args' argTs xs Ts ~~ ts) @ - map (subst o HOLogic.dest_Trueprop) (Logic.strip_assums_hyp r); - in - fold_rev (fn (x, T) => fn P => HOLogic.exists_const T $ Abs (x, T, P)) - (Logic.strip_params r) - (if null ps then \<^term>\<open>True\<close> else foldr1 HOLogic.mk_conj ps) - end; - - (* make a disjunction of all introduction rules *) - - val fp_fun = - fold_rev lambda (p :: bs @ xs) - (if null intr_ts then \<^term>\<open>False\<close> - else foldr1 HOLogic.mk_disj (map transform_rule intr_ts)); - - (* add definition of recursive predicates to theory *) - - val is_auxiliary = length cs > 1; - - val rec_binding = - if Binding.is_empty alt_name then Binding.conglomerate (map #1 cnames_syn) else alt_name; - val rec_name = Binding.name_of rec_binding; - - val internals = Config.get lthy inductive_internals; - - val ((rec_const, (_, fp_def)), lthy') = lthy - |> is_auxiliary ? Proof_Context.concealed - |> Local_Theory.define - ((rec_binding, case cnames_syn of [(_, mx)] => mx | _ => NoSyn), - ((Thm.make_def_binding internals rec_binding, @{attributes [nitpick_unfold]}), - fold_rev lambda params - (Const (fp_name, (predT --> predT) --> predT) $ fp_fun))) - ||> Proof_Context.restore_naming lthy; - val fp_def' = - Simplifier.rewrite (put_simpset HOL_basic_ss lthy' addsimps [fp_def]) - (Thm.cterm_of lthy' (list_comb (rec_const, params))); - val specs = - if is_auxiliary then - map_index (fn (i, ((b, mx), c)) => - let - val Ts = arg_types_of (length params) c; - val xs = - map Free (Variable.variant_frees lthy' intr_ts (mk_names "x" (length Ts) ~~ Ts)); - in - ((b, mx), - ((Thm.make_def_binding internals b, []), fold_rev lambda (params @ xs) - (list_comb (rec_const, params @ make_bool_args' bs i @ - make_args argTs (xs ~~ Ts))))) - end) (cnames_syn ~~ cs) - else []; - val (consts_defs, lthy'') = lthy' - |> fold_map Local_Theory.define specs; - val preds = (case cs of [_] => [rec_const] | _ => map #1 consts_defs); - - val (_, ctxt'') = Variable.add_fixes (map (fst o dest_Free) params) lthy''; - val mono = prove_mono quiet_mode skip_mono predT fp_fun monos ctxt''; - val (_, lthy''') = lthy'' - |> Local_Theory.note - ((if internals - then Binding.qualify true rec_name (Binding.name "mono") - else Binding.empty, []), - Proof_Context.export ctxt'' lthy'' [mono]); - in - (lthy''', Proof_Context.transfer (Proof_Context.theory_of lthy''') ctxt'', - rec_binding, mono, fp_def', map (#2 o #2) consts_defs, - list_comb (rec_const, params), preds, argTs, bs, xs) - end; - -fun declare_rules rec_binding coind no_elim' no_ind0 no_eqs no_ind cnames - preds intrs intr_bindings intr_atts elims eqs raw_induct lthy = - let - val rec_name = Binding.name_of rec_binding; - fun rec_qualified qualified = Binding.qualify qualified rec_name; - val intr_names = map Binding.name_of intr_bindings; - val ind_case_names = - if forall (equal "") intr_names then [] - else [Attrib.case_names intr_names]; - val induct = - if coind then - (raw_induct, - [Attrib.case_names [rec_name], - Attrib.case_conclusion (rec_name, intr_names), - Attrib.consumes (1 - Thm.nprems_of raw_induct), - Attrib.internal (K (Induct.coinduct_pred (hd cnames)))]) - else if no_ind orelse length cnames > 1 then - (raw_induct, ind_case_names @ [Attrib.consumes (~ (Thm.nprems_of raw_induct))]) - else - (raw_induct RSN (2, rev_mp), - ind_case_names @ [Attrib.consumes (~ (Thm.nprems_of raw_induct))]); - - val (intrs', lthy1) = - lthy |> - Spec_Rules.add - (if coind then Spec_Rules.Co_Inductive else Spec_Rules.Inductive) (preds, intrs) |> - Local_Theory.notes - (map (rec_qualified false) intr_bindings ~~ intr_atts ~~ - map (fn th => [([th], @{attributes [Pure.intro?]})]) intrs) |>> - map (hd o snd); - val (((_, elims'), (_, [induct'])), lthy2) = - (if no_elim' then ((("",[]),[]), lthy1) else lthy1 |> - Local_Theory.note ((rec_qualified true (Binding.name "intros"), []), intrs') ||>> - fold_map (fn (name, (elim, cases, k)) => - Local_Theory.note - ((Binding.qualify true (Long_Name.base_name name) (Binding.name "cases"), - ((if forall (equal "") cases then [] else [Attrib.case_names cases]) @ - [Attrib.consumes (1 - Thm.nprems_of elim), Attrib.constraints k, - Attrib.internal (K (Induct.cases_pred name))] @ @{attributes [Pure.elim?]})), - [elim]) #> - apfst (hd o snd)) (if null elims then [] else cnames ~~ elims)) ||>> - (fn lthy => if no_ind0 then (("", [@{thm True_def}]), lthy) else Local_Theory.note - ((rec_qualified true (Binding.name (coind_prefix coind ^ "induct")), #2 induct), - [rulify lthy1 (#1 induct)]) lthy); - - val (eqs', lthy3) = if no_eqs then ([], lthy2) else lthy2 |> - fold_map (fn (name, eq) => Local_Theory.note - ((Binding.qualify true (Long_Name.base_name name) (Binding.name "simps"), - [Attrib.internal (K equation_add_permissive)]), [eq]) - #> apfst (hd o snd)) - (if null eqs then [] else (cnames ~~ eqs)) - val (inducts, lthy4) = - if no_ind orelse coind then ([], lthy3) - else - let val inducts = cnames ~~ Project_Rule.projects lthy3 (1 upto length cnames) induct' in - lthy3 |> - Local_Theory.notes [((rec_qualified true (Binding.name "inducts"), []), - inducts |> map (fn (name, th) => ([th], - ind_case_names @ - [Attrib.consumes (1 - Thm.nprems_of th), - Attrib.internal (K (Induct.induct_pred name))])))] |>> snd o hd - end; - in (intrs', elims', eqs', induct', inducts, lthy4) end; - -type inductive_flags = - {quiet_mode: bool, verbose: bool, alt_name: binding, coind: bool, - no_elim: bool, no_elim': bool, no_ind0: bool, no_eqs: bool, no_ind: bool, skip_mono: bool}; - -type add_ind_def = - inductive_flags -> - term list -> (Attrib.binding * term) list -> thm list -> - term list -> (binding * mixfix) list -> - local_theory -> inductive_result * local_theory; - -fun add_ind_def - {quiet_mode, verbose, alt_name, coind, no_elim, no_elim', no_ind0, no_eqs, no_ind, skip_mono} - cs intros monos params cnames_syn lthy = - let - val _ = null cnames_syn andalso error "No inductive predicates given"; - val names = map (Binding.name_of o fst) cnames_syn; - val _ = message (quiet_mode andalso not verbose) - ("Proofs for " ^ coind_prefix coind ^ "inductive predicate(s) " ^ commas_quote names); - - val cnames = map (Local_Theory.full_name lthy o #1) cnames_syn; (* FIXME *) - val ((intr_names, intr_atts), intr_ts) = - apfst split_list (split_list (map (check_rule lthy cs params) intros)); - - val (lthy1, lthy2, rec_binding, mono, fp_def, rec_preds_defs, rec_const, preds, - argTs, bs, xs) = mk_ind_def quiet_mode skip_mono alt_name coind cs intr_ts - monos params cnames_syn lthy; - - val (intrs, unfold) = prove_intrs quiet_mode coind mono fp_def (length bs + length xs) - intr_ts rec_preds_defs lthy2 lthy1; - val elims = - if no_elim then [] - else - prove_elims quiet_mode cs params intr_ts (map Binding.name_of intr_names) - unfold rec_preds_defs lthy2 lthy1; - val raw_induct = zero_var_indexes - (if no_ind then Drule.asm_rl - else if coind then - prove_coindrule quiet_mode preds cs argTs bs xs params intr_ts mono fp_def - rec_preds_defs lthy2 lthy1 - else - prove_indrule quiet_mode cs argTs bs xs rec_const params intr_ts mono fp_def - rec_preds_defs lthy2 lthy1); - - val eqs = - if no_elim then [] else prove_eqs quiet_mode cs params intr_ts intrs elims lthy2 lthy1; - - val elims' = map (fn (th, ns, i) => (rulify lthy1 th, ns, i)) elims; - val intrs' = map (rulify lthy1) intrs; - - val (intrs'', elims'', eqs', induct, inducts, lthy3) = - declare_rules rec_binding coind no_elim' no_ind0 no_eqs no_ind - cnames preds intrs' intr_names intr_atts elims' eqs raw_induct lthy1; - - val result = - {preds = preds, - intrs = intrs'', - elims = elims'', - raw_induct = rulify lthy3 raw_induct, - induct = induct, - inducts = inducts, - eqs = eqs'}; - - val lthy4 = lthy3 - |> Local_Theory.declaration {syntax = false, pervasive = false} (fn phi => - let val result' = transform_result phi result; - in put_inductives ({names = cnames, coind = coind}, result') end); - in (result, lthy4) end; - - -(* external interfaces *) - -fun gen_add_inductive_i mk_def - flags cnames_syn pnames spec monos lthy = - let - - (* abbrevs *) - - val (_, ctxt1) = Variable.add_fixes (map (Binding.name_of o fst o fst) cnames_syn) lthy; - - fun get_abbrev ((name, atts), t) = - if can (Logic.strip_assums_concl #> Logic.dest_equals) t then - let - val _ = Binding.is_empty name andalso null atts orelse - error "Abbreviations may not have names or attributes"; - val ((x, T), rhs) = Local_Defs.abs_def (snd (Local_Defs.cert_def ctxt1 (K []) t)); - val var = - (case find_first (fn ((c, _), _) => Binding.name_of c = x) cnames_syn of - NONE => error ("Undeclared head of abbreviation " ^ quote x) - | SOME ((b, T'), mx) => - if T <> T' then error ("Bad type specification for abbreviation " ^ quote x) - else (b, mx)); - in SOME (var, rhs) end - else NONE; - - val abbrevs = map_filter get_abbrev spec; - val bs = map (Binding.name_of o fst o fst) abbrevs; - - - (* predicates *) - - val pre_intros = filter_out (is_some o get_abbrev) spec; - val cnames_syn' = filter_out (member (op =) bs o Binding.name_of o fst o fst) cnames_syn; - val cs = map (Free o apfst Binding.name_of o fst) cnames_syn'; - val ps = map Free pnames; - - val (_, ctxt2) = lthy |> Variable.add_fixes (map (Binding.name_of o fst o fst) cnames_syn'); - val ctxt3 = ctxt2 |> fold (snd oo Local_Defs.fixed_abbrev) abbrevs; - val expand = Assumption.export_term ctxt3 lthy #> Proof_Context.cert_term lthy; - - fun close_rule r = - fold (Logic.all o Free) (fold_aterms - (fn t as Free (v as (s, _)) => - if Variable.is_fixed ctxt1 s orelse - member (op =) ps t then I else insert (op =) v - | _ => I) r []) r; - - val intros = map (apsnd (Syntax.check_term lthy #> close_rule #> expand)) pre_intros; - val preds = map (fn ((c, _), mx) => (c, mx)) cnames_syn'; - in - lthy - |> mk_def flags cs intros monos ps preds - ||> fold (snd oo Local_Theory.abbrev Syntax.mode_default) abbrevs - end; - -fun gen_add_inductive mk_def verbose coind cnames_syn pnames_syn intro_srcs raw_monos lthy = - let - val ((vars, intrs), _) = lthy - |> Proof_Context.set_mode Proof_Context.mode_abbrev - |> Specification.read_multi_specs (cnames_syn @ pnames_syn) intro_srcs; - val (cs, ps) = chop (length cnames_syn) vars; - val monos = Attrib.eval_thms lthy raw_monos; - val flags = - {quiet_mode = false, verbose = verbose, alt_name = Binding.empty, - coind = coind, no_elim = false, no_elim' = false, no_ind0 = false, no_eqs = false, - no_ind = false, skip_mono = false}; - in - lthy - |> gen_add_inductive_i mk_def flags cs (map (apfst Binding.name_of o fst) ps) intrs monos - end; - -val add_inductive_i = gen_add_inductive_i add_ind_def; -val add_inductive = gen_add_inductive add_ind_def; - -fun add_inductive_global flags cnames_syn pnames pre_intros monos thy = - let - val name = Sign.full_name thy (fst (fst (hd cnames_syn))); - val ctxt' = thy - |> Named_Target.theory_init - |> add_inductive_i flags cnames_syn pnames pre_intros monos |> snd - |> Local_Theory.exit; - val info = #2 (the_inductive_global ctxt' name); - in (info, Proof_Context.theory_of ctxt') end; - - -(* read off arities of inductive predicates from raw induction rule *) -fun arities_of induct = - map (fn (_ $ t $ u) => - (fst (dest_Const (head_of t)), length (snd (strip_comb u)))) - (HOLogic.dest_conj (HOLogic.dest_Trueprop (Thm.concl_of induct))); - -(* read off parameters of inductive predicate from raw induction rule *) -fun params_of induct = - let - val (_ $ t $ u :: _) = HOLogic.dest_conj (HOLogic.dest_Trueprop (Thm.concl_of induct)); - val (_, ts) = strip_comb t; - val (_, us) = strip_comb u; - in - List.take (ts, length ts - length us) - end; - -val pname_of_intr = - Thm.concl_of #> HOLogic.dest_Trueprop #> head_of #> dest_Const #> fst; - -(* partition introduction rules according to predicate name *) -fun gen_partition_rules f induct intros = - fold_rev (fn r => AList.map_entry op = (pname_of_intr (f r)) (cons r)) intros - (map (rpair [] o fst) (arities_of induct)); - -val partition_rules = gen_partition_rules I; -fun partition_rules' induct = gen_partition_rules fst induct; - -fun unpartition_rules intros xs = - fold_map (fn r => AList.map_entry_yield op = (pname_of_intr r) - (fn x :: xs => (x, xs)) #>> the) intros xs |> fst; - -(* infer order of variables in intro rules from order of quantifiers in elim rule *) -fun infer_intro_vars thy elim arity intros = - let - val _ :: cases = Thm.prems_of elim; - val used = map (fst o fst) (Term.add_vars (Thm.prop_of elim) []); - fun mtch (t, u) = - let - val params = Logic.strip_params t; - val vars = - map (Var o apfst (rpair 0)) - (Name.variant_list used (map fst params) ~~ map snd params); - val ts = - map (curry subst_bounds (rev vars)) - (List.drop (Logic.strip_assums_hyp t, arity)); - val us = Logic.strip_imp_prems u; - val tab = - fold (Pattern.first_order_match thy) (ts ~~ us) (Vartab.empty, Vartab.empty); - in - map (Envir.subst_term tab) vars - end - in - map (mtch o apsnd Thm.prop_of) (cases ~~ intros) - end; - - - -(** outer syntax **) - -fun gen_ind_decl mk_def coind = - Parse.vars -- Parse.for_fixes -- - Scan.optional Parse_Spec.where_multi_specs [] -- - Scan.optional (\<^keyword>\<open>monos\<close> |-- Parse.!!! Parse.thms1) [] - >> (fn (((preds, params), specs), monos) => - (snd o gen_add_inductive mk_def true coind preds params specs monos)); - -val ind_decl = gen_ind_decl add_ind_def; - -val _ = - Outer_Syntax.local_theory \<^command_keyword>\<open>inductive\<close> "define inductive predicates" - (ind_decl false); - -val _ = - Outer_Syntax.local_theory \<^command_keyword>\<open>coinductive\<close> "define coinductive predicates" - (ind_decl true); - -val _ = - Outer_Syntax.local_theory \<^command_keyword>\<open>inductive_cases\<close> - "create simplified instances of elimination rules" - (Parse.and_list1 Parse_Spec.simple_specs >> (snd oo inductive_cases)); - -val _ = - Outer_Syntax.local_theory \<^command_keyword>\<open>inductive_simps\<close> - "create simplification rules for inductive predicates" - (Parse.and_list1 Parse_Spec.simple_specs >> (snd oo inductive_simps)); - -val _ = - Outer_Syntax.command \<^command_keyword>\<open>print_inductives\<close> - "print (co)inductive definitions and monotonicity rules" - (Parse.opt_bang >> (fn b => Toplevel.keep (print_inductives b o Toplevel.context_of))); - -end; diff --git a/Citadelle/src/compiler_generic/isabelle_d_atomic/src/HOL/Tools/inductive_realizer.ML b/Citadelle/src/compiler_generic/isabelle_d_atomic/src/HOL/Tools/inductive_realizer.ML deleted file mode 100644 index 3b6965f9b07580332d85c5dcd593c6e1e566e95b..0000000000000000000000000000000000000000 --- a/Citadelle/src/compiler_generic/isabelle_d_atomic/src/HOL/Tools/inductive_realizer.ML +++ /dev/null @@ -1,527 +0,0 @@ -(* Title: HOL/Tools/inductive_realizer.ML - Author: Stefan Berghofer, TU Muenchen - -Program extraction from proofs involving inductive predicates: -Realizers for induction and elimination rules. -*) - -signature INDUCTIVE_REALIZER = -sig - val add_ind_realizers: string -> string list -> theory -> theory -end; - -structure InductiveRealizer : INDUCTIVE_REALIZER = -struct - -fun name_of_thm thm = - (case Proofterm.fold_proof_atoms false (fn PThm (_, ((name, _, _), _)) => cons name | _ => I) - [Thm.proof_of thm] [] of - [name] => name - | _ => raise THM ("name_of_thm: bad proof of theorem", 0, [thm])); - -fun prf_of ctxt thm = - Reconstruct.proof_of ctxt thm - |> Reconstruct.expand_proof ctxt [("", NONE)]; (* FIXME *) - -fun subsets [] = [[]] - | subsets (x::xs) = - let val ys = subsets xs - in ys @ map (cons x) ys end; - -val pred_of = fst o dest_Const o head_of; - -fun strip_all' used names (Const (@{const_name Pure.all}, _) $ Abs (s, T, t)) = - let val (s', names') = (case names of - [] => (singleton (Name.variant_list used) s, []) - | name :: names' => (name, names')) - in strip_all' (s'::used) names' (subst_bound (Free (s', T), t)) end - | strip_all' used names ((t as Const (@{const_name Pure.imp}, _) $ P) $ Q) = - t $ strip_all' used names Q - | strip_all' _ _ t = t; - -fun strip_all t = strip_all' (Term.add_free_names t []) [] t; - -fun strip_one name - (Const (@{const_name Pure.all}, _) $ Abs (s, T, Const (@{const_name Pure.imp}, _) $ P $ Q)) = - (subst_bound (Free (name, T), P), subst_bound (Free (name, T), Q)) - | strip_one _ (Const (@{const_name Pure.imp}, _) $ P $ Q) = (P, Q); - -fun relevant_vars prop = fold (fn ((a, i), T) => fn vs => - (case strip_type T of - (_, Type (s, _)) => if s = @{type_name bool} then (a, T) :: vs else vs - | _ => vs)) (Term.add_vars prop []) []; - -val attach_typeS = map_types (map_atyps - (fn TFree (s, []) => TFree (s, @{sort type}) - | TVar (ixn, []) => TVar (ixn, @{sort type}) - | T => T)); - -fun dt_of_intrs thy vs nparms intrs = - let - val iTs = rev (Term.add_tvars (Thm.prop_of (hd intrs)) []); - val (Const (s, _), ts) = strip_comb (HOLogic.dest_Trueprop - (Logic.strip_imp_concl (Thm.prop_of (hd intrs)))); - val params = map dest_Var (take nparms ts); - val tname = Binding.name (space_implode "_" (Long_Name.base_name s ^ "T" :: vs)); - fun constr_of_intr intr = (Binding.name (Long_Name.base_name (name_of_thm intr)), - map (Logic.unvarifyT_global o snd) - (subtract (op =) params (rev (Term.add_vars (Thm.prop_of intr) []))) @ - filter_out (equal Extraction.nullT) - (map (Logic.unvarifyT_global o Extraction.etype_of thy vs []) (Thm.prems_of intr)), NoSyn); - in - ((tname, map (rpair dummyS) (map (fn a => "'" ^ a) vs @ map (fst o fst) iTs), NoSyn), - map constr_of_intr intrs) - end; - -fun mk_rlz T = Const ("realizes", [T, HOLogic.boolT] ---> HOLogic.boolT); - -(** turn "P" into "%r x. realizes r (P x)" **) - -fun gen_rvar vs (t as Var ((a, 0), T)) = - if body_type T <> HOLogic.boolT then t else - let - val U = TVar (("'" ^ a, 0), []) - val Ts = binder_types T; - val i = length Ts; - val xs = map (pair "x") Ts; - val u = list_comb (t, map Bound (i - 1 downto 0)) - in - if member (op =) vs a then - fold_rev Term.abs (("r", U) :: xs) (mk_rlz U $ Bound i $ u) - else - fold_rev Term.abs xs (mk_rlz Extraction.nullT $ Extraction.nullt $ u) - end - | gen_rvar _ t = t; - -fun mk_realizes_eqn n vs nparms intrs = - let - val intr = map_types Type.strip_sorts (Thm.prop_of (hd intrs)); - val concl = HOLogic.dest_Trueprop (Logic.strip_imp_concl intr); - val iTs = rev (Term.add_tvars intr []); - val Tvs = map TVar iTs; - val (h as Const (s, T), us) = strip_comb concl; - val params = List.take (us, nparms); - val elTs = List.drop (binder_types T, nparms); - val predT = elTs ---> HOLogic.boolT; - val used = map (fst o fst o dest_Var) params; - val xs = map (Var o apfst (rpair 0)) - (Name.variant_list used (replicate (length elTs) "x") ~~ elTs); - val rT = if n then Extraction.nullT - else Type (space_implode "_" (s ^ "T" :: vs), - map (fn a => TVar (("'" ^ a, 0), [])) vs @ Tvs); - val r = if n then Extraction.nullt else Var ((Long_Name.base_name s, 0), rT); - val S = list_comb (h, params @ xs); - val rvs = relevant_vars S; - val vs' = subtract (op =) vs (map fst rvs); - val rname = space_implode "_" (s ^ "R" :: vs); - - fun mk_Tprem n v = - let val T = (the o AList.lookup (op =) rvs) v - in (Const ("typeof", T --> Type ("Type", [])) $ Var ((v, 0), T), - Extraction.mk_typ (if n then Extraction.nullT - else TVar (("'" ^ v, 0), []))) - end; - - val prems = map (mk_Tprem true) vs' @ map (mk_Tprem false) vs; - val ts = map (gen_rvar vs) params; - val argTs = map fastype_of ts; - - in ((prems, (Const ("typeof", HOLogic.boolT --> Type ("Type", [])) $ S, - Extraction.mk_typ rT)), - (prems, (mk_rlz rT $ r $ S, - if n then list_comb (Const (rname, argTs ---> predT), ts @ xs) - else list_comb (Const (rname, argTs @ [rT] ---> predT), ts @ [r] @ xs)))) - end; - -fun fun_of_prem thy rsets vs params rule ivs intr = - let - val ctxt = Proof_Context.init_global thy - val args = map (Free o apfst fst o dest_Var) ivs; - val args' = map (Free o apfst fst) - (subtract (op =) params (Term.add_vars (Thm.prop_of intr) [])); - val rule' = strip_all rule; - val conclT = Extraction.etype_of thy vs [] (Logic.strip_imp_concl rule'); - val used = map (fst o dest_Free) args; - - val is_rec = exists_Const (fn (c, _) => member (op =) rsets c); - - fun is_meta (Const (@{const_name Pure.all}, _) $ Abs (s, _, P)) = is_meta P - | is_meta (Const (@{const_name Pure.imp}, _) $ _ $ Q) = is_meta Q - | is_meta (Const (@{const_name Trueprop}, _) $ t) = - (case head_of t of - Const (s, _) => can (Inductive.the_inductive_global ctxt) s - | _ => true) - | is_meta _ = false; - - fun fun_of ts rts args used (prem :: prems) = - let - val T = Extraction.etype_of thy vs [] prem; - val [x, r] = Name.variant_list used ["x", "r"] - in if T = Extraction.nullT - then fun_of ts rts args used prems - else if is_rec prem then - if is_meta prem then - let - val prem' :: prems' = prems; - val U = Extraction.etype_of thy vs [] prem'; - in - if U = Extraction.nullT - then fun_of (Free (x, T) :: ts) - (Free (r, binder_types T ---> HOLogic.unitT) :: rts) - (Free (x, T) :: args) (x :: r :: used) prems' - else fun_of (Free (x, T) :: ts) (Free (r, U) :: rts) - (Free (r, U) :: Free (x, T) :: args) (x :: r :: used) prems' - end - else - (case strip_type T of - (Ts, Type (@{type_name Product_Type.prod}, [T1, T2])) => - let - val fx = Free (x, Ts ---> T1); - val fr = Free (r, Ts ---> T2); - val bs = map Bound (length Ts - 1 downto 0); - val t = - fold_rev (Term.abs o pair "z") Ts - (HOLogic.mk_prod (list_comb (fx, bs), list_comb (fr, bs))); - in fun_of (fx :: ts) (fr :: rts) (t::args) (x :: r :: used) prems end - | (Ts, U) => fun_of (Free (x, T) :: ts) - (Free (r, binder_types T ---> HOLogic.unitT) :: rts) - (Free (x, T) :: args) (x :: r :: used) prems) - else fun_of (Free (x, T) :: ts) rts (Free (x, T) :: args) - (x :: used) prems - end - | fun_of ts rts args used [] = - let val xs = rev (rts @ ts) - in if conclT = Extraction.nullT - then fold_rev (absfree o dest_Free) xs HOLogic.unit - else fold_rev (absfree o dest_Free) xs - (list_comb - (Free ("r" ^ Long_Name.base_name (name_of_thm intr), - map fastype_of (rev args) ---> conclT), rev args)) - end - - in fun_of args' [] (rev args) used (Logic.strip_imp_prems rule') end; - -fun indrule_realizer thy induct raw_induct rsets params vs rec_names rss intrs dummies = - let - val concls = HOLogic.dest_conj (HOLogic.dest_Trueprop (Thm.concl_of raw_induct)); - val premss = map_filter (fn (s, rs) => if member (op =) rsets s then - SOME (rs, map (fn (_, r) => nth (Thm.prems_of raw_induct) - (find_index (fn prp => prp = Thm.prop_of r) (map Thm.prop_of intrs))) rs) else NONE) rss; - val fs = maps (fn ((intrs, prems), dummy) => - let - val fs = map (fn (rule, (ivs, intr)) => - fun_of_prem thy rsets vs params rule ivs intr) (prems ~~ intrs) - in - if dummy then Const (@{const_name default}, - HOLogic.unitT --> body_type (fastype_of (hd fs))) :: fs - else fs - end) (premss ~~ dummies); - val frees = fold Term.add_frees fs []; - val Ts = map fastype_of fs; - fun name_of_fn intr = "r" ^ Long_Name.base_name (name_of_thm intr) - in - fst (fold_map (fn concl => fn names => - let val T = Extraction.etype_of thy vs [] concl - in if T = Extraction.nullT then (Extraction.nullt, names) else - let - val Type ("fun", [U, _]) = T; - val a :: names' = names - in - (fold_rev absfree (("x", U) :: map_filter (fn intr => - Option.map (pair (name_of_fn intr)) - (AList.lookup (op =) frees (name_of_fn intr))) intrs) - (list_comb (Const (a, Ts ---> T), fs) $ Free ("x", U)), names') - end - end) concls rec_names) - end; - -fun add_dummy name dname (x as (_, ((s, vs, mx), cs))) = - if Binding.eq_name (name, s) - then (true, ((s, vs, mx), (dname, [HOLogic.unitT], NoSyn) :: cs)) - else x; - -fun add_dummies f [] _ thy = - (([], NONE), thy) - | add_dummies f dts used thy = - thy - |> f (map snd dts) - |-> (fn dtinfo => pair (map fst dts, SOME dtinfo)) - handle Old_Datatype_Aux.Datatype_Empty name' => - let - val name = Long_Name.base_name name'; - val dname = singleton (Name.variant_list used) "Dummy"; - in - thy - |> add_dummies f (map (add_dummy (Binding.name name) (Binding.name dname)) dts) (dname :: used) - end; - -fun mk_realizer thy vs (name, rule, rrule, rlz, rt) = - let - val ctxt = Proof_Context.init_global thy; - val rvs = map fst (relevant_vars (Thm.prop_of rule)); - val xs = rev (Term.add_vars (Thm.prop_of rule) []); - val vs1 = map Var (filter_out (fn ((a, _), _) => member (op =) rvs a) xs); - val rlzvs = rev (Term.add_vars (Thm.prop_of rrule) []); - val vs2 = map (fn (ixn, _) => Var (ixn, (the o AList.lookup (op =) rlzvs) ixn)) xs; - val rs = map Var (subtract (op = o apply2 fst) xs rlzvs); - val rlz' = fold_rev Logic.all rs (Thm.prop_of rrule) - in (name, (vs, - if rt = Extraction.nullt then rt else fold_rev lambda vs1 rt, - Extraction.abs_corr_shyps thy rule vs vs2 - (ProofRewriteRules.un_hhf_proof rlz' (attach_typeS rlz) - (fold_rev Proofterm.forall_intr_proof' rs (prf_of ctxt rrule))))) - end; - -fun rename tab = map (fn x => the_default x (AList.lookup op = tab x)); - -fun add_ind_realizer rsets intrs induct raw_induct elims vs thy = - let - val qualifier = Long_Name.qualifier (name_of_thm induct); - val inducts = Global_Theory.get_thms thy (Long_Name.qualify qualifier "inducts"); - val iTs = rev (Term.add_tvars (Thm.prop_of (hd intrs)) []); - val ar = length vs + length iTs; - val params = Inductive.params_of raw_induct; - val arities = Inductive.arities_of raw_induct; - val nparms = length params; - val params' = map dest_Var params; - val rss = Inductive.partition_rules raw_induct intrs; - val rss' = map (fn (((s, rs), (_, arity)), elim) => - (s, (Inductive.infer_intro_vars thy elim arity rs ~~ rs))) - (rss ~~ arities ~~ elims); - val (prfx, _) = split_last (Long_Name.explode (fst (hd rss))); - val tnames = map (fn s => space_implode "_" (s ^ "T" :: vs)) rsets; - - val thy1 = thy |> - Sign.root_path |> - Sign.add_path (Long_Name.implode prfx); - val (ty_eqs, rlz_eqs) = split_list - (map (fn (s, rs) => mk_realizes_eqn (not (member (op =) rsets s)) vs nparms rs) rss); - - val thy1' = thy1 |> - Sign.add_types_global - (map (fn s => (Binding.name (Long_Name.base_name s), ar, NoSyn)) tnames) |> - Extraction.add_typeof_eqns_i ty_eqs; - val dts = map_filter (fn (s, rs) => if member (op =) rsets s then - SOME (dt_of_intrs thy1' vs nparms rs) else NONE) rss; - - (** datatype representing computational content of inductive set **) - - val ((dummies, some_dt_names), thy2) = - thy1 - |> add_dummies (Old_Datatype.add_datatype - let val config = Old_Datatype_Aux.default_config in - {strict = false, quiet = #quiet config, skip_level = #skip_level config} end) - (map (pair false) dts) [] - ||> Extraction.add_typeof_eqns_i ty_eqs - ||> Extraction.add_realizes_eqns_i rlz_eqs; - val dt_names = these some_dt_names; - val case_thms = map (#case_rewrites o Old_Datatype_Data.the_info thy2) dt_names; - val rec_thms = - if null dt_names then [] - else #rec_rewrites (Old_Datatype_Data.the_info thy2 (hd dt_names)); - val rec_names = distinct (op =) (map (fst o dest_Const o head_of o fst o - HOLogic.dest_eq o HOLogic.dest_Trueprop o Thm.prop_of) rec_thms); - val (constrss, _) = fold_map (fn (s, rs) => fn (recs, dummies) => - if member (op =) rsets s then - let - val (d :: dummies') = dummies; - val (recs1, recs2) = chop (length rs) (if d then tl recs else recs) - in (map (head_of o hd o rev o snd o strip_comb o fst o - HOLogic.dest_eq o HOLogic.dest_Trueprop o Thm.prop_of) recs1, (recs2, dummies')) - end - else (replicate (length rs) Extraction.nullt, (recs, dummies))) - rss (rec_thms, dummies); - val rintrs = map (fn (intr, c) => attach_typeS (Envir.eta_contract - (Extraction.realizes_of thy2 vs - (if c = Extraction.nullt then c else list_comb (c, map Var (rev - (subtract (op =) params' (Term.add_vars (Thm.prop_of intr) []))))) (Thm.prop_of intr)))) - (maps snd rss ~~ flat constrss); - val (rlzpreds, rlzpreds') = - rintrs |> map (fn rintr => - let - val Const (s, T) = head_of (HOLogic.dest_Trueprop (Logic.strip_assums_concl rintr)); - val s' = Long_Name.base_name s; - val T' = Logic.unvarifyT_global T; - in (((s', T'), NoSyn), (Const (s, T'), Free (s', T'))) end) - |> distinct (op = o apply2 (#1 o #1)) - |> map (apfst (apfst (apfst Binding.name))) - |> split_list; - - val rlzparams = map (fn Var ((s, _), T) => (s, Logic.unvarifyT_global T)) - (List.take (snd (strip_comb - (HOLogic.dest_Trueprop (Logic.strip_assums_concl (hd rintrs)))), nparms)); - - (** realizability predicate **) - - val (ind_info, thy3') = thy2 |> - Inductive.add_inductive_global - {quiet_mode = false, verbose = false, alt_name = Binding.empty, coind = false, - no_elim = false, no_elim' = false, no_ind0 = false, no_eqs = false, no_ind = false, - skip_mono = false} - rlzpreds rlzparams (map (fn (rintr, intr) => - ((Binding.name (Long_Name.base_name (name_of_thm intr)), []), - subst_atomic rlzpreds' (Logic.unvarify_global rintr))) - (rintrs ~~ maps snd rss)) [] ||> - Sign.root_path; - val thy3 = fold (Global_Theory.hide_fact false o name_of_thm) (#intrs ind_info) thy3'; - - (** realizer for induction rule **) - - val Ps = map_filter (fn _ $ M $ P => if member (op =) rsets (pred_of M) then - SOME (fst (fst (dest_Var (head_of P)))) else NONE) - (HOLogic.dest_conj (HOLogic.dest_Trueprop (Thm.concl_of raw_induct))); - - fun add_ind_realizer Ps thy = - let - val vs' = rename (map (apply2 (fst o fst o dest_Var)) - (params ~~ List.take (snd (strip_comb (HOLogic.dest_Trueprop - (hd (Thm.prems_of (hd inducts))))), nparms))) vs; - val rs = indrule_realizer thy induct raw_induct rsets params' - (vs' @ Ps) rec_names rss' intrs dummies; - val rlzs = map (fn (r, ind) => Extraction.realizes_of thy (vs' @ Ps) r - (Thm.prop_of ind)) (rs ~~ inducts); - val used = fold Term.add_free_names rlzs []; - val rnames = Name.variant_list used (replicate (length inducts) "r"); - val rnames' = Name.variant_list - (used @ rnames) (replicate (length intrs) "s"); - val rlzs' as (prems, _, _) :: _ = map (fn (rlz, name) => - let - val (P, Q) = strip_one name (Logic.unvarify_global rlz); - val Q' = strip_all' [] rnames' Q - in - (Logic.strip_imp_prems Q', P, Logic.strip_imp_concl Q') - end) (rlzs ~~ rnames); - val concl = HOLogic.mk_Trueprop (foldr1 HOLogic.mk_conj (map - (fn (_, _ $ P, _ $ Q) => HOLogic.mk_imp (P, Q)) rlzs')); - val rews = map mk_meta_eq (@{thm fst_conv} :: @{thm snd_conv} :: rec_thms); - val thm = Goal.prove_global thy [] - (map attach_typeS prems) (attach_typeS concl) - (fn {context = ctxt, prems} => EVERY - [resolve_tac ctxt [#raw_induct ind_info] 1, - rewrite_goals_tac ctxt rews, - REPEAT ((resolve_tac ctxt prems THEN_ALL_NEW EVERY' - [K (rewrite_goals_tac ctxt rews), Object_Logic.atomize_prems_tac ctxt, - DEPTH_SOLVE_1 o - FIRST' [assume_tac ctxt, eresolve_tac ctxt [allE], eresolve_tac ctxt [impE]]]) 1)]); - val (thm', thy') = Global_Theory.store_thm (Binding.qualified_name (space_implode "_" - (Long_Name.qualify qualifier "induct" :: vs' @ Ps @ ["correctness"])), thm) thy; - val thms = map (fn th => zero_var_indexes (rotate_prems ~1 (th RS mp))) - (Old_Datatype_Aux.split_conj_thm thm'); - val ([thms'], thy'') = Global_Theory.add_thmss - [((Binding.qualified_name (space_implode "_" - (Long_Name.qualify qualifier "inducts" :: vs' @ Ps @ - ["correctness"])), thms), [])] thy'; - val realizers = inducts ~~ thms' ~~ rlzs ~~ rs; - in - Extraction.add_realizers_i - (map (fn (((ind, corr), rlz), r) => - mk_realizer thy'' (vs' @ Ps) (Thm.derivation_name ind, ind, corr, rlz, r)) - realizers @ (case realizers of - [(((ind, corr), rlz), r)] => - [mk_realizer thy'' (vs' @ Ps) (Long_Name.qualify qualifier "induct", - ind, corr, rlz, r)] - | _ => [])) thy'' - end; - - (** realizer for elimination rules **) - - val case_names = map (fst o dest_Const o head_of o fst o HOLogic.dest_eq o - HOLogic.dest_Trueprop o Thm.prop_of o hd) case_thms; - - fun add_elim_realizer Ps - (((((elim, elimR), intrs), case_thms), case_name), dummy) thy = - let - val (prem :: prems) = Thm.prems_of elim; - fun reorder1 (p, (_, intr)) = - fold (fn ((s, _), T) => Logic.all (Free (s, T))) - (subtract (op =) params' (Term.add_vars (Thm.prop_of intr) [])) - (strip_all p); - fun reorder2 ((ivs, intr), i) = - let val fs = subtract (op =) params' (Term.add_vars (Thm.prop_of intr) []) - in fold (lambda o Var) fs (list_comb (Bound (i + length ivs), ivs)) end; - val p = Logic.list_implies - (map reorder1 (prems ~~ intrs) @ [prem], Thm.concl_of elim); - val T' = Extraction.etype_of thy (vs @ Ps) [] p; - val T = if dummy then (HOLogic.unitT --> body_type T') --> T' else T'; - val Ts = map (Extraction.etype_of thy (vs @ Ps) []) (Thm.prems_of elim); - val r = - if null Ps then Extraction.nullt - else - fold_rev (Term.abs o pair "x") Ts - (list_comb (Const (case_name, T), - (if dummy then - [Abs ("x", HOLogic.unitT, Const (@{const_name default}, body_type T))] - else []) @ - map reorder2 (intrs ~~ (length prems - 1 downto 0)) @ - [Bound (length prems)])); - val rlz = Extraction.realizes_of thy (vs @ Ps) r (Thm.prop_of elim); - val rlz' = attach_typeS (strip_all (Logic.unvarify_global rlz)); - val rews = map mk_meta_eq case_thms; - val thm = Goal.prove_global thy [] - (Logic.strip_imp_prems rlz') (Logic.strip_imp_concl rlz') - (fn {context = ctxt, prems, ...} => EVERY - [cut_tac (hd prems) 1, - eresolve_tac ctxt [elimR] 1, - ALLGOALS (asm_simp_tac (put_simpset HOL_basic_ss ctxt)), - rewrite_goals_tac ctxt rews, - REPEAT ((resolve_tac ctxt prems THEN_ALL_NEW (Object_Logic.atomize_prems_tac ctxt THEN' - DEPTH_SOLVE_1 o - FIRST' [assume_tac ctxt, eresolve_tac ctxt [allE], eresolve_tac ctxt [impE]])) 1)]); - val (thm', thy') = Global_Theory.store_thm (Binding.qualified_name (space_implode "_" - (name_of_thm elim :: vs @ Ps @ ["correctness"])), thm) thy - in - Extraction.add_realizers_i - [mk_realizer thy' (vs @ Ps) (name_of_thm elim, elim, thm', rlz, r)] thy' - end; - - (** add realizers to theory **) - - val thy4 = fold add_ind_realizer (subsets Ps) thy3; - val thy5 = Extraction.add_realizers_i - (map (mk_realizer thy4 vs) (map (fn (((rule, rrule), rlz), c) => - (name_of_thm rule, rule, rrule, rlz, - list_comb (c, map Var (subtract (op =) params' (rev (Term.add_vars (Thm.prop_of rule) [])))))) - (maps snd rss ~~ #intrs ind_info ~~ rintrs ~~ flat constrss))) thy4; - val elimps = map_filter (fn ((s, intrs), p) => - if member (op =) rsets s then SOME (p, intrs) else NONE) - (rss' ~~ (elims ~~ #elims ind_info)); - val thy6 = - fold (fn p as (((((elim, _), _), _), _), _) => - add_elim_realizer [] p #> - add_elim_realizer [fst (fst (dest_Var (HOLogic.dest_Trueprop (Thm.concl_of elim))))] p) - (elimps ~~ case_thms ~~ case_names ~~ dummies) thy5; - - in Sign.restore_naming thy thy6 end; - -fun add_ind_realizers name rsets thy = - let - val (_, {intrs, induct, raw_induct, elims, ...}) = - Inductive.the_inductive_global (Proof_Context.init_global thy) name; - val vss = sort (int_ord o apply2 length) - (subsets (map fst (relevant_vars (Thm.concl_of (hd intrs))))) - in - fold_rev (add_ind_realizer rsets intrs induct raw_induct elims) vss thy - end - -fun rlz_attrib arg = Thm.declaration_attribute (fn thm => Context.mapping - let - fun err () = error "ind_realizer: bad rule"; - val sets = - (case HOLogic.dest_conj (HOLogic.dest_Trueprop (Thm.concl_of thm)) of - [_] => [pred_of (HOLogic.dest_Trueprop (hd (Thm.prems_of thm)))] - | xs => map (pred_of o fst o HOLogic.dest_imp) xs) - handle TERM _ => err () | List.Empty => err (); - in - add_ind_realizers (hd sets) - (case arg of - NONE => sets | SOME NONE => [] - | SOME (SOME sets') => subtract (op =) sets' sets) - end I); - -val _ = Theory.setup (Attrib.setup \<^binding>\<open>ind_realizer\<close> - ((Scan.option (Scan.lift (Args.$$$ "irrelevant") |-- - Scan.option (Scan.lift (Args.colon) |-- - Scan.repeat1 (Args.const {proper = true, strict = true})))) >> rlz_attrib) - "add realizers for inductive set"); - -end; diff --git a/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/.hgignore b/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/.hgignore deleted file mode 100644 index 03165c6afa3de3b23fb9000ce9d870a0483a92d6..0000000000000000000000000000000000000000 --- a/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/.hgignore +++ /dev/null @@ -1,16 +0,0 @@ -syntax: glob - -bin/haskabelle_bin - -doc/haskabelle.pdf - -ex/dst_hs -ex/dst_thy - -lib/texinputs - -.* -*~ -\#*\# -build/ -log/ diff --git a/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/.hgtags b/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/.hgtags deleted file mode 100644 index 1bfbfa614a4f4d08a839439ff7f3b7220fe1f9a7..0000000000000000000000000000000000000000 --- a/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/.hgtags +++ /dev/null @@ -1,13 +0,0 @@ -fb7402cb8c16658da5b55f73993df228d2d6adfb Haskabelle2009 -64d31ca6f0b02a0ca5f10498a9c5d05ede720541 Haskabelle2009-1 -adcf65dccae5c6c961ddf49161e7dba2941385e1 Haskabelle2009-2 -adcf65dccae5c6c961ddf49161e7dba2941385e1 Haskabelle2009-2 -845806e788bfa2c4f0905da8665cca6e82d27f77 Haskabelle2009-2 -67d7bfbfc94c023ec4ec89333360eabaee03b6f8 Haskabelle2011 -7e03a8957766277799bef29ddbee36125a587bd4 Haskabelle2011-1 -4342c3d4fa34716abf5f16a2acb290305f70461a Haskabelle2012 -7350a14ed7b4653a1cd1a3819f97f2e537103d41 Haskabelle2013 -97fe686b1586544d534e7f1849b460ba9cbe8e51 Haskabelle2014 -97fe686b1586544d534e7f1849b460ba9cbe8e51 Haskabelle2014 -002b13dbdc4a11fe104187011781d37cbc3af48a Haskabelle2014 -01a58283004c653e45a657c5bb094e00925eeb5d Haskabelle2015 diff --git a/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/COPYRIGHT b/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/COPYRIGHT deleted file mode 100644 index e09bf4df1d2bd2211aa546d61faaa0714d16f21a..0000000000000000000000000000000000000000 --- a/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/COPYRIGHT +++ /dev/null @@ -1,35 +0,0 @@ -HASKABELLE COPYRIGHT NOTICE, LICENCE AND DISCLAIMER. - -Copyright (c) 2007-2015 Technische Universität München, Germany - 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. diff --git a/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/Importer/AList.hs b/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/Importer/AList.hs deleted file mode 100644 index a56935b3f70d841fbdae86486e9fb37f67e7cc05..0000000000000000000000000000000000000000 --- a/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/Importer/AList.hs +++ /dev/null @@ -1,59 +0,0 @@ -{-| Author: Florian Haftmann, TU Muenchen - -Association lists -- lists of (key, value) pairs. --} - -module Importer.AList (lookup, defined, update, upd_default, delete, - map_entry, map_default, make, group) where - -import Prelude (Eq, Bool(..), Maybe(..), Integer, id, const, (==), (||), (+), (-), map) -import Importer.Library (fold_rev) - -find_index :: Eq a => [(a, b)] -> a -> Integer -find_index xs key = find xs 0 where - find [] _ = -1 - find ((key', value) : xs) i = - if key == key' then i else find xs (i + 1) - -map_index :: Eq a => a -> ([(a, b)] -> [(a, b)]) -> ((a, b) -> [(a, b)] -> [(a, b)]) - -> [(a, b)] -> [(a, b)] -map_index key f_none f_some xs = (if i == -1 then f_none else mapp i) xs where - i = find_index xs key; - mapp 0 (x : xs) = f_some x xs - mapp i (x : xs) = x : mapp (i - 1) xs - -lookup :: Eq a => [(a, b)] -> a -> Maybe b -lookup [] _ = Nothing -lookup ((key, value) : xs) key' = - if key' == key then Just value - else lookup xs key' - -defined :: Eq a => [(a, b)] -> a -> Bool -defined [] _ = False -defined ((key, value) : xs) key' = - key' == key || defined xs key' - -update :: Eq a => (a, b) -> [(a, b)] -> [(a, b)] -update (x @ (key, value)) = - map_index key ((:) x) (const ((:) x)); - -upd_default :: Eq a => (a, b) -> [(a, b)] -> [(a, b)] -upd_default (key, value) xs = - if defined xs key then xs else (key, value) : xs - -delete :: Eq a => a -> [(a, b)] -> [(a, b)] -delete key = map_index key id (const id) - -map_entry :: Eq a => a -> (b -> b) -> [(a, b)] -> [(a, b)] -map_entry key f = map_index key id (\ (key, value) -> (:) (key, f value)) - -map_default :: Eq a => (a, b) -> (b -> b) -> [(a, b)] -> [(a, b)] -map_default (key, value) f = - map_index key ((:) (key, f value)) (\ (key, value) -> (:) (key, f value)) - -make :: (a -> b) -> [a] -> [(a, b)] -make keyfun = map keypair where - keypair x = (x, keyfun x) - -group :: Eq a => [(a, b)] -> [(a, [b])] -group xs = fold_rev (\ (k, v) -> map_default (k, []) ((:) v)) xs [] diff --git a/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/Importer/Adapt.hs b/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/Importer/Adapt.hs deleted file mode 100644 index bbcd808745ff983d89126ac3ee035cf1ec65638d..0000000000000000000000000000000000000000 --- a/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/Importer/Adapt.hs +++ /dev/null @@ -1,700 +0,0 @@ -{-# LANGUAGE FlexibleContexts, RankNTypes #-} -{- Author: Tobias C. Rittweiler and Florian Haftmann, TU Muenchen - -Adaption tables and their application. --} - -module Importer.Adapt (Adaption(..), AdaptionTable(AdaptionTable), - readAdapt, makeAdaptionTable_FromHsModule, extractHskEntries, - adaptGlobalEnv, adaptModules -) where - -import Prelude hiding ((*>)) -import Importer.Library -import qualified Importer.AList as AList -import Data.Maybe (mapMaybe, fromMaybe, catMaybes, isJust) -import Data.List (partition, sort, group) -import Data.List.Split (splitOn) - -import Control.Monad.State (State, get, put, foldM, evalState, runState, liftM2) - -import System.FilePath (combine) - -import qualified Importer.Msg as Msg -import qualified Importer.Ident_Env as Ident_Env - -import qualified Language.Haskell.Exts as Hsx -import qualified Importer.Hsx as Hsx -import qualified Importer.Isa as Isa - - -{- Fundamental data structures -} - -data RawClassInfo = RawClassInfo - { superclasses :: [String], - methods :: [(String, String)], - classVar :: String - } - -data OpKind = Type - | Variable - | Function - | RawHskOp -- placeholder - | UnaryOp Int - | InfixOp Assoc (Maybe Int) - | Class RawClassInfo - -data Assoc = RightAssoc | LeftAssoc | NoneAssoc - -data AdaptionEntry = Haskell String OpKind - | Isabelle String OpKind - -data Adaption = Adaption { - rawAdaptionTable :: [(AdaptionEntry, AdaptionEntry)], - reservedKeywords :: [String], - usedConstNames :: [String], - usedThyNames :: [String], - preludeFile :: FilePath -} - -data AdaptionTable = AdaptionTable [(Ident_Env.Identifier, Ident_Env.Identifier)] - - -{- Haskell Prelude data -} - -hsk_infix_ops :: [(String, OpKind)] -hsk_infix_ops = [ - ("Prelude.(.)", InfixOp RightAssoc (Just 9)), - ("Prelude.(!!)", InfixOp LeftAssoc (Just 9)), - ("Prelude.(^)", InfixOp RightAssoc (Just 8)), - ("Prelude.(^^)", InfixOp RightAssoc (Just 8)), - ("Prelude.(**)", InfixOp RightAssoc (Just 8)), - ("Prelude.(*)", InfixOp LeftAssoc (Just 7)), - ("Prelude.(/)", InfixOp LeftAssoc (Just 7)), - ("Prelude.quot", InfixOp LeftAssoc (Just 7)), - ("Prelude.rem", InfixOp LeftAssoc (Just 7)), - ("Prelude.div", InfixOp LeftAssoc (Just 7)), - ("Prelude.mod", InfixOp LeftAssoc (Just 7)), - ("Prelude.(+)", InfixOp LeftAssoc (Just 6)), - ("Prelude.(-)", InfixOp LeftAssoc (Just 6)), - ("Prelude.(:)", InfixOp RightAssoc (Just 5)), - ("Prelude.(++)", InfixOp RightAssoc (Just 5)), - ("Prelude.(==)", InfixOp NoneAssoc (Just 4)), - ("Prelude.(/=)", InfixOp NoneAssoc (Just 4)), - ("Prelude.(<)", InfixOp NoneAssoc (Just 4)), - ("Prelude.(<=)", InfixOp NoneAssoc (Just 4)), - ("Prelude.(>=)", InfixOp NoneAssoc (Just 4)), - ("Prelude.(>)", InfixOp NoneAssoc (Just 4)), - ("Prelude.elem", InfixOp NoneAssoc (Just 4)), - ("Prelude.notElem", InfixOp NoneAssoc (Just 4)), - ("Prelude.(&&)", InfixOp LeftAssoc (Just 3)), - ("Prelude.(||)", InfixOp LeftAssoc (Just 2)), - ("Prelude.(>>)", InfixOp LeftAssoc (Just 1)), - ("Prelude.(>>=)", InfixOp LeftAssoc (Just 1)), - ("Prelude.(=<<)", InfixOp RightAssoc (Just 1)), - ("Prelude.($)", InfixOp RightAssoc (Just 0)), - ("Prelude.($!)", InfixOp RightAssoc (Just 0)), - ("Prelude.seq", InfixOp RightAssoc (Just 0))] - -{- Reading adaption file -} - -readError :: forall a. FilePath -> String -> a -readError file msg = - error ("An error occurred while reading adaption file \"" ++ file ++ "\": " ++ msg) - -parseAdapt :: FilePath -> IO [Hsx.Decl ()] -parseAdapt file = do - result <- Hsx.parseFile file - `catchIO` (\ioError-> readError file (show ioError)) - case result of - Hsx.ParseFailed loc msg -> - readError file (Msg.failed_parsing loc msg) - Hsx.ParseOk (Hsx.Module _ _ _ _ decls) -> - return $ map Hsx.fmapUnit decls - -indexify :: [Hsx.Decl ()] -> [(String, Hsx.Exp ())] -indexify decls = fold idxify decls [] where - idxify (Hsx.PatBind _ (Hsx.PVar _ (Hsx.Ident _ name)) (Hsx.UnGuardedRhs _ rhs) _) xs = - (name, rhs) : xs - idxify _ xs = xs - -evaluateString :: Hsx.Exp () -> String -evaluateString (Hsx.Lit _ (Hsx.String _ s _)) = s - -evaluateList :: (Hsx.Exp () -> a) -> Hsx.Exp () -> [a] -evaluateList eval (Hsx.List _ ts) = map eval ts - -evaluatePair :: (Hsx.Exp () -> a) -> (Hsx.Exp () -> b) -> Hsx.Exp () -> (a, b) -evaluatePair eval1 eval2 (Hsx.Tuple _ Hsx.Boxed [t1, t2]) = (eval1 t1, eval2 t2) - -evaluateEntryClass :: Hsx.Exp () -> RawClassInfo -evaluateEntryClass (Hsx.Paren _ (Hsx.RecConstr _ (Hsx.UnQual _ (Hsx.Ident _ "RawClassInfo")) - [Hsx.FieldUpdate _ (Hsx.UnQual _ (Hsx.Ident _ "superclasses")) superclasses, - Hsx.FieldUpdate _ (Hsx.UnQual _ (Hsx.Ident _ "classVar")) classVar, - Hsx.FieldUpdate _ (Hsx.UnQual _ (Hsx.Ident _ "methods")) methods])) = - RawClassInfo { - superclasses = evaluateList evaluateString superclasses, - classVar = evaluateString classVar, - methods = evaluateList (evaluatePair evaluateString evaluateString) methods } - -evaluateEntryKind :: Hsx.Exp () -> OpKind -evaluateEntryKind (Hsx.Paren _ (Hsx.App _ (Hsx.Con _ (Hsx.UnQual _ (Hsx.Ident _ "Class"))) cls)) = - Class (evaluateEntryClass cls) -evaluateEntryKind (Hsx.Con _ (Hsx.UnQual _ (Hsx.Ident _ "Type"))) = Type -evaluateEntryKind (Hsx.Con _ (Hsx.UnQual _ (Hsx.Ident _ "Function"))) = Function -evaluateEntryKind (Hsx.Paren _ (Hsx.App _ (Hsx.App _ (Hsx.Con _ (Hsx.UnQual _ (Hsx.Ident _ "InfixOp"))) - (Hsx.Con _ (Hsx.UnQual _ (Hsx.Ident _ assc)))) (Hsx.Lit _ (Hsx.Int _ pri _)))) = - InfixOp assoc (Just (fromInteger pri)) where - assoc = case assc of - "LeftAssoc" -> LeftAssoc - "RightAssoc" -> RightAssoc - "NoneAssoc" -> NoneAssoc - -evaluateEntry :: Hsx.Exp () -> AdaptionEntry -evaluateEntry (Hsx.App _ (Hsx.App _ (Hsx.Con _ (Hsx.UnQual _ (Hsx.Ident _ kind))) (Hsx.Lit _ (Hsx.String _ name _))) entry) - | (kind == "Haskell") = Haskell name (evaluateEntryKind entry) - | (kind == "Isabelle") = Isabelle name (evaluateEntryKind entry) - -evaluate dir decls = Adaption { - rawAdaptionTable = evaluateList (evaluatePair evaluateEntry evaluateEntry) - (lookupFunbind "raw_adaption_table"), - reservedKeywords = lookupStringList "reserved_keywords", - usedConstNames = lookupStringList "used_const_names", - usedThyNames = map (\s -> case splitOn "." s of [_, s] -> s ; _ -> s) $ lookupStringList "used_thy_names", - preludeFile = combine dir "Prelude.thy" } where - lookupFunbind name = case lookup name decls of - Nothing -> error ("No entry for " ++ name ++ " in adaption file") - Just rhs -> rhs - lookupStringList name = evaluateList evaluateString (lookupFunbind name) - -readAdapt :: FilePath -> IO Adaption -readAdapt dir = do - decls <- parseAdapt (combine dir "Generated_Adapt.hs") - return (evaluate dir (indexify decls)) - - -{- Building adaption table -} - -mkAdaptionTable :: Adaption -> AdaptionTable -mkAdaptionTable adapt = AdaptionTable - $ map (\(hEntry, iEntry) -> (parseEntry hEntry, parseEntry iEntry)) - (check_raw_adaption_table (rawAdaptionTable adapt)) - -extractHskEntries (AdaptionTable mapping) = map fst mapping -extractIsaEntries (AdaptionTable mapping) = map snd mapping - --- Our predefined `adaptionTable' contains entries for all things that --- may possibly get adapted; a haskell source file may, however, define --- their own variants of the Prelude stuff (e.g. define its own `map'.) --- --- Hence, we have to remove entries from `adaptionTable' which are --- defined in one of the source files. -makeAdaptionTable_FromHsModule :: Adaption -> Ident_Env.GlobalE -> [Hsx.Module ()] -> AdaptionTable -makeAdaptionTable_FromHsModule adapt env hsmodules = let - adaptionTable = mkAdaptionTable adapt - initial_class_env = makeGlobalEnv_FromAdaptionTable - (filterAdaptionTable (Ident_Env.isClass . fst) adaptionTable) - tmp_env = Ident_Env.unionGlobalEnvs initial_class_env env - defined_names = concatMap (extractDefNames tmp_env) (Hsx.zipMod hsmodules) - extractDefNames :: Ident_Env.GlobalE -> (Hsx.ModuleName (), Hsx.Module ()) -> [String] - extractDefNames globalEnv (m, Hsx.Module _ _ _ _ decls) = - mapMaybe (\n -> let m' = Ident_Env.fromHsk m - n' = Ident_Env.fromHsk n - ids = Ident_Env.lookupIdentifiers_OrLose m' n' globalEnv - name = Ident_Env.nameOf . Ident_Env.lexInfoOf - in case filter Ident_Env.isType ids of - [] -> Just $ name (head ids) - [id] | Ident_Env.isInstance id -> Just $ name id - | otherwise -> Nothing) - $ concatMap Hsx.extractBindingNs decls - in filterAdaptionTable (\(from, to) -> let - fromN = Ident_Env.nameOf (Ident_Env.lexInfoOf from) - toN = Ident_Env.nameOf (Ident_Env.lexInfoOf to) - in fromN `notElem` defined_names && toN `notElem` defined_names) adaptionTable - -makeGlobalEnv_FromAdaptionTable :: AdaptionTable -> Ident_Env.GlobalE -makeGlobalEnv_FromAdaptionTable adaptionTable - = Ident_Env.makeGlobalEnv importNothing exportAll (extractHskEntries adaptionTable) - where importNothing = const [] - exportAll = const True - -filterAdaptionTable :: ((Ident_Env.Identifier, Ident_Env.Identifier) -> Bool) -> AdaptionTable -> AdaptionTable -filterAdaptionTable predicate (AdaptionTable entries) - = AdaptionTable (filter predicate entries) - - --- Check the Raw Adaption Table for consistency; prohibit duplicate --- entries, and ensure that class methods have their own entry as --- function or op. --- -check_raw_adaption_table :: [(AdaptionEntry, AdaptionEntry)] -> [(AdaptionEntry, AdaptionEntry)] -check_raw_adaption_table tbl - = let (hsk_entries, _) = unzip tbl - names = [ n | Haskell n _ <- hsk_entries ] - methods = concatMap (\(Haskell _ (Class (RawClassInfo { methods = m }))) -> fst (unzip m)) - $ filter isClassEntry hsk_entries - functions = extract_functionoid_names hsk_entries - missing_fn_entries = filter (`notElem` functions) methods - in - if (has_duplicates names) - then error ("Duplicates in Raw Adaption Table found: " - ++ show (filter (flip (>) 1 . length) (group (sort names)))) - else if not (null missing_fn_entries) - then error ("Inconsistency in Raw Adaption Table: The following methods\n" - ++ "don't have a Function entry: " ++ show missing_fn_entries) - else tbl - - where - extract_functionoid_names [] = [] - extract_functionoid_names (e:rest_entries) - = case e of - Haskell n Function -> n : extract_functionoid_names rest_entries - Haskell n RawHskOp -> n : extract_functionoid_names rest_entries - Haskell n (UnaryOp _) -> n : extract_functionoid_names rest_entries - Haskell n (InfixOp _ _) -> n : extract_functionoid_names rest_entries - _ -> extract_functionoid_names rest_entries - - isClassEntry (Haskell _ (Class _)) = True - isClassEntry _ = False - -explode_identifier :: String -> [String] -explode_identifier = slice ((==) '.') - -parseEntry :: AdaptionEntry -> Ident_Env.Identifier - -parseEntry (Haskell raw_identifier op) - = let (moduleID, identifierID) = parseRawIdentifier raw_identifier - op' = (case op of Function -> fromMaybe Function (lookup raw_identifier hsk_infix_ops) - etc -> etc) - in makeIdentifier op' moduleID identifierID ([], Ident_Env.TyNone) -parseEntry (Isabelle raw_identifier op) - -- the raw identifier may look like "Datatype.option.None", where - -- "Datatype" is the ModuleID, and "None" is the real identifier, - -- and "option" basically noisy garbage. - = let (moduleID, identifierID) = parseRawIdentifier raw_identifier - moduleID' = (case explode_identifier moduleID of - [] -> moduleID - m:_ -> m) - in makeIdentifier op moduleID' identifierID ([], Ident_Env.TyNone) - -parseRawIdentifier :: String -> (String, String) -parseRawIdentifier string - = if '(' `elem` string - then let (modul, identifier) = break (== '(') string -- "Prelude.(:)" - in assert (last modul == '.' && - last identifier == ')') - $ (init modul, tail (init identifier)) - else let parts = explode_identifier string - identifier = last parts - modul = separate '.' (init parts) - in (modul, identifier) - -makeIdentifier :: OpKind -> Ident_Env.ModuleID -> Ident_Env.IdentifierID -> ([(Ident_Env.Name, [Ident_Env.Name])], Ident_Env.Type) -> Ident_Env.Identifier -makeIdentifier Variable m identifier t - = Ident_Env.Constant $ Ident_Env.Variable $ Ident_Env.makeLexInfo m identifier t -makeIdentifier Function m identifier t - = Ident_Env.Constant $ Ident_Env.Function $ Ident_Env.makeLexInfo m identifier t -makeIdentifier (UnaryOp prio) m identifier t - = Ident_Env.Constant $ Ident_Env.UnaryOp (Ident_Env.makeLexInfo m identifier t) prio -makeIdentifier (InfixOp assoc prio) m identifier t - = Ident_Env.Constant $ Ident_Env.InfixOp (Ident_Env.makeLexInfo m identifier t) (transformAssoc assoc) prio -makeIdentifier (Class classinfo) m identifier t - = let supers = map (Ident_Env.UnqualName . snd . parseRawIdentifier) (superclasses classinfo) - meths = map (\(n, tstr) -> let t = Ident_Env.typscheme_of_hsk_typ (parseType tstr) - in makeTypeAnnot (Ident_Env.makeLexInfo m n t)) - (methods classinfo) - classV = Ident_Env.UnqualName (classVar classinfo) - in - Ident_Env.TypeDecl $ Ident_Env.Class (Ident_Env.makeLexInfo m identifier t) - (Ident_Env.makeClassInfo supers meths classV) -makeIdentifier Type m identifier t - = Ident_Env.TypeDecl $ Ident_Env.Data (Ident_Env.makeLexInfo m identifier t) [] - -makeTypeAnnot :: Ident_Env.LexInfo -> Ident_Env.Identifier -makeTypeAnnot lexinfo = Ident_Env.Constant (Ident_Env.TypeAnnotation lexinfo) - -parseType :: String -> Hsx.Type () -parseType string = case Hsx.parseFileContents ("__foo__ :: " ++ string) of - (Hsx.ParseOk (Hsx.Module _ _ _ _ [Hsx.TypeSig _ _ t])) -> Hsx.fmapUnit t - -transformAssoc :: Assoc -> Ident_Env.Assoc -transformAssoc RightAssoc = Ident_Env.AssocRight -transformAssoc LeftAssoc = Ident_Env.AssocLeft -transformAssoc NoneAssoc = Ident_Env.AssocNone - - -{- Applying adaptions -} - -data AdptState = AdptState { oldGlobalEnv :: Ident_Env.GlobalE, - adaptedGlobalEnv :: Ident_Env.GlobalE, - adaptionTable :: AdaptionTable, - currentModuleID :: Maybe Ident_Env.ModuleID - } - -type AdaptM v = State AdptState v - -getAdptState :: AdaptM AdptState -getAdptState = do s <- get; return s - -query :: (AdptState -> x) -> AdaptM x -query slot = do s <- getAdptState; return (slot s) - -set :: (AdptState -> AdptState) -> AdaptM () -set update = do s <- getAdptState; put (update s); return () - -shadow :: [Ident_Env.Name] -> AdaptM () -shadow names - = set (\state - -> let (AdaptionTable mappings) = adaptionTable state - -- Functions (especially data constructors, like []) can't - -- be locally bound, so we must not shadow them. - (fun_mappings, rest_mappings) - = partition (\(id,_) -> Ident_Env.isInfixOp id || Ident_Env.isFunction id ) - mappings - in state { adaptionTable - = AdaptionTable $ - fun_mappings ++ - filter ((`notElem` names) . Ident_Env.identifier2name . fst) - rest_mappings - }) - --- shadowing [a, b, c] $ body --- with appropriate a, b, c. --- --- Inside `body', do not adapt names `a', `b', and `c'. --- -shadowing :: [Isa.Name] -> AdaptM v -> AdaptM v -shadowing names body - = do old_tbl <- query adaptionTable - shadow (map Ident_Env.fromIsa names) - r <- body - set (\state -> state { adaptionTable = old_tbl }) - return r - --- nested_binding [(a, computeA), (b, computeB), (c, computeC)] $ --- \([a', b', c']) -> body --- --- with appropriate a, b, c --- and with a', b', c' being the results of computeA, computeB, computeC. --- --- LET like binding construct: while computing `computeB', `a' is shadowed, --- while computing `computeC', `a' and `b' are shadowed, and so on. --- --- Inside `body', the identifiers `a', `b' and `c' won't be adapted.. --- -nested_binding :: [([Isa.Name], AdaptM b)] -> ([b] -> AdaptM v) -> AdaptM v -nested_binding [] continuation = continuation [] -nested_binding bindings continuation - = do old_tbl <- query adaptionTable - rs <- foldM (\result (ns,thunk) -> let ns' = map Ident_Env.fromIsa ns in - do shadow ns' ; t <- thunk - return (result ++ [t])) - [] bindings - r <- continuation rs - set (\state -> state { adaptionTable = old_tbl }) - return r - - -runAdaptionWith :: AdaptM v -> AdptState -> v -runAdaptionWith adaption state - = evalState adaption state - -runAdaption :: Ident_Env.GlobalE -> Ident_Env.GlobalE -> AdaptionTable -> AdaptM v -> v -runAdaption oldEnv newEnv tbl adaption - = runAdaptionWith adaption (AdptState { oldGlobalEnv = oldEnv, - adaptedGlobalEnv = newEnv, - adaptionTable = tbl, - currentModuleID = Nothing - }) - - -qualifyConstantName :: Ident_Env.GlobalE -> Ident_Env.ModuleID -> Ident_Env.Name -> Ident_Env.Name -qualifyConstantName globalEnv mID name - = fromMaybe (Ident_Env.qualifyName mID name) - $ Ident_Env.resolveConstantName globalEnv mID name - -qualifyTypeName :: Ident_Env.GlobalE -> Ident_Env.ModuleID -> Ident_Env.Name -> Ident_Env.Name -qualifyTypeName globalEnv mID name - = fromMaybe (Ident_Env.qualifyName mID name) - $ Ident_Env.resolveTypeName globalEnv mID name - - -adaptGlobalEnv :: AdaptionTable -> Ident_Env.GlobalE -> Ident_Env.GlobalE -adaptGlobalEnv adaptions env = Ident_Env.updateGlobalEnv (\n -> - case translateName adaptions n of - Just new_id -> [new_id] - Nothing -> adapt_type_in_identifier env adaptions n) env - -adapt_type_in_identifier :: Ident_Env.GlobalE -> AdaptionTable -> Ident_Env.Name -> [Ident_Env.Identifier] -adapt_type_in_identifier globalEnv adaptions n@(Ident_Env.QualName mID _) - = let old_ids = Ident_Env.lookupIdentifiers_OrLose mID n globalEnv - old_lexinfos = map Ident_Env.lexInfoOf old_ids - old_types = map Ident_Env.typschemeOf old_lexinfos - renamings = (case adaptions of AdaptionTable mappings -> mappings) - |> filter (Ident_Env.isClass . fst) - |> asserting (all (Ident_Env.isClass . snd)) - |> (map . map_both) Ident_Env.identifier2name - proto_qualify = qualifyTypeName globalEnv . Ident_Env.moduleOf - translate_name lexinfo n = case AList.lookup renamings (proto_qualify lexinfo n) of - Nothing -> n - Just n' -> n' - translate_typ lexinfo = translateEnvType adaptions (proto_qualify lexinfo) - translate (vs, typ) lexinfo = (map (\(v, sort) -> (translate_name lexinfo v, - map (translate_name lexinfo) sort)) vs, the_default typ (translate_typ lexinfo typ)) - new_types = zipWith translate old_types old_lexinfos - new_lexinfos = zipWith (\t lxinf -> lxinf {Ident_Env.typschemeOf = t}) new_types old_lexinfos - in - zipWith Ident_Env.updateIdentifier old_ids new_lexinfos - -translateName :: AdaptionTable -> Ident_Env.Name -> Maybe Ident_Env.Identifier -translateName (AdaptionTable mappings) name = - lookupBy (\n1 id2 -> n1 == Ident_Env.identifier2name id2) name mappings where - lookupBy :: (a -> b -> Bool) -> a -> [(b, c)] -> Maybe c - lookupBy eq key [] = Nothing - lookupBy eq key ((x,y):xys) - | key `eq` x = Just y - | otherwise = lookupBy eq key xys - - -translateIdentifier :: AdaptionTable -> Ident_Env.Identifier -> Ident_Env.Identifier -translateIdentifier tbl id - = case translateName tbl (Ident_Env.identifier2name id) of - Nothing -> id - Just new_id -> new_id - -translateEnvType :: AdaptionTable -> (Ident_Env.Name -> Ident_Env.Name) -> Ident_Env.Type -> Maybe Ident_Env.Type -translateEnvType (AdaptionTable mappings) qualify typ = let - type_renams = mappings - |> filter (Ident_Env.isData . fst) - |> asserting (all (Ident_Env.isData . snd)) - |> (map . map_both) Ident_Env.identifier2name - class_renams = mappings - |> filter (Ident_Env.isClass . fst) - |> asserting (all (Ident_Env.isClass . snd)) - |> (map . map_both) Ident_Env.identifier2name - renamings = type_renams ++ class_renams - transl n = case AList.lookup renamings (qualify n) of - Nothing -> return n - Just n' -> put True >> return n' - translate :: Ident_Env.Type -> State Bool Ident_Env.Type - translate typ = case typ of - Ident_Env.TyNone -> return Ident_Env.TyNone - Ident_Env.TyVar n -> liftM Ident_Env.TyVar (transl n) - Ident_Env.TyCon n ts -> do n' <- transl n - ts' <- mapM translate ts - return (Ident_Env.TyCon n' ts') - Ident_Env.TyFun t1 t2 -> do t1' <- translate t1 - t2' <- translate t2 - return (Ident_Env.TyFun t1' t2') - in case runState (translate typ) False of - (_, False) -> Nothing -- no match found in AdaptionTable. - (new_type, True) -> Just new_type - -adaptEnvName :: Ident_Env.Name -> AdaptM Ident_Env.Name -adaptEnvName n - = do Just mID <- query currentModuleID - tbl <- query adaptionTable - oldEnv <- query oldGlobalEnv - newEnv <- query adaptedGlobalEnv - case Ident_Env.lookupConstant mID n oldEnv of - Nothing -> return n - Just id -> let new_id = translateIdentifier tbl id - new_id_name = Ident_Env.identifier2name new_id - in assert (isJust (Ident_Env.lookupConstant mID new_id_name newEnv)) - $ return new_id_name - -adaptEnvType :: Ident_Env.Type -> AdaptM Ident_Env.Type -adaptEnvType t - = do Just mID <- query currentModuleID - adaptions <- query adaptionTable - oldEnv <- query oldGlobalEnv - let qualify = qualifyTypeName oldEnv mID - return (fromMaybe t (translateEnvType adaptions qualify t)) - -adaptName :: Isa.Name -> AdaptM Isa.Name -adaptName n = do - n' <- adaptEnvName (Ident_Env.fromIsa n) - return (Ident_Env.toIsa n') - -adaptType :: Isa.Type -> AdaptM Isa.Type -adaptType t = do t' <- adaptEnvType (Ident_Env.fromIsa t); return (Ident_Env.toIsa t') - -adaptClass :: Isa.Name -> AdaptM Isa.Name -adaptClass classN = do - Just mID <- query currentModuleID - AdaptionTable mappings <- query adaptionTable - let { renamings = mappings |> filter (Ident_Env.isClass . fst) - |> asserting (all (Ident_Env.isClass . snd)) |> (map . map_both) Ident_Env.identifier2name } - oldEnv <- query oldGlobalEnv - let classN' = AList.lookup renamings (qualifyTypeName oldEnv mID (Ident_Env.fromIsa classN)) - let classN'' = case classN' of { - Nothing -> classN; - Just classN' -> Ident_Env.toIsa classN' } - return classN'' - -adaptModules :: AdaptionTable -> Ident_Env.GlobalE -> Ident_Env.GlobalE -> [Isa.Module] -> [Isa.Module] -adaptModules adaptionTable adaptedGlobalEnv globalEnv modules = - runAdaption globalEnv adaptedGlobalEnv adaptionTable (mapM adapt modules) - - -not_implemented x = error ("Adaption not implemented yet for\n " ++ Msg.prettyShow' "thing" x) - -class Adapt a where - adapt :: a -> AdaptM a - -instance Adapt Isa.Module where - - adapt (Isa.Module thy imps cmds exportCode) - = do old_mID <- query currentModuleID - set (setModuleID $ Just (Ident_Env.fromIsa thy)) - cmds' <- mapM adapt cmds - set (setModuleID old_mID) - return (Isa.Module thy imps cmds' exportCode) - where setModuleID v state - = state { currentModuleID = v } - -instance Adapt Isa.Function_Stmt where - adapt (Isa.Function_Stmt kind sigs eqns) = - do sigs' <- mapM adapt sigs - let funNs = map Isa.name_of_type_sign (sigs ++ sigs') - shadowing (map Isa.name_of_type_sign sigs) $ - do eqns' <- mapM (\(funN, pats, body) -> - do funN' <- adaptName funN - assert (funN `elem` funNs) $ return () - pats' <- mapM adapt pats - shadowing (accumulate (fold add_const_names) pats') $ - do body' <- adapt body ; return (funN', pats', body')) eqns - return (Isa.Function_Stmt kind sigs' eqns') - -instance Adapt Isa.Stmt where - - adapt (Isa.TypeSynonym aliases) = liftM Isa.TypeSynonym (mapM adpt aliases) - where adpt (spec,typ) = liftM2 (,) (return spec) (adaptType typ) - adapt c@(Isa.Record _ _) = not_implemented c - adapt c@(Isa.Comment _) = return c - - adapt (Isa.Datatype decls) = liftM Isa.Datatype $ mapM adaptDecls decls where - adaptDecls ((sig @ (Isa.TypeSpec tyvarNs tycoN), constrs)) = shadowing (tycoN : tyvarNs) $ - do constrs' <- mapM adaptConstr constrs - return (sig, constrs') - adaptConstr (name, types) = - do types' <- mapM adaptType types - return (name, types') - - adapt (Isa.Function function_stmt) = liftM Isa.Function (adapt function_stmt) - - adapt (Isa.Class classN supclassNs typesigs) - = do classN' <- adaptClass classN - supclassNs' <- mapM adaptClass supclassNs - typesigs' <- mapM adapt typesigs - return (Isa.Class classN' supclassNs' typesigs') - - adapt (Isa.Instance classN tycoN arities stmt) - = do classN' <- adaptClass classN - type' <- adaptType (Isa.Type tycoN (map (Isa.TVar . fst) arities)) - let (tycoN', tvars') = ((map_snd . map) Isa.dest_TVar . Isa.dest_Type) type' - sorts' <- (mapM . mapM) adaptClass (map snd arities) - stmt' <- mapM adapt stmt - return (Isa.Instance classN' tycoN' (zip tvars' sorts') stmt') - -instance Adapt Isa.TypeSpec where - adapt (Isa.TypeSpec tyvarNs tycoN) - = do (Isa.Type tycoN' tyvars') <- adaptType (Isa.Type tycoN (map Isa.TVar tyvarNs)) - return $ Isa.TypeSpec (map (\(Isa.TVar n) -> n) tyvars') tycoN' - -instance Adapt Isa.TypeSign where - adapt (Isa.TypeSign n arities t) = do - n' <- adaptName n - tvars' <- mapM (adaptType . Isa.TVar . fst) arities - sorts' <- (mapM . mapM) adaptClass (map snd arities) - t' <- adaptType t - return (Isa.TypeSign n' (zip (map Isa.dest_TVar tvars') sorts') t') - -instance Adapt Isa.Term where - adapt (Isa.Literal lit) = return (Isa.Literal lit) - - adapt (Isa.Const n) = adaptConst n >>= (return . Isa.Const) - where - adaptConst n = do - n' <- adaptEnvName (Ident_Env.fromIsa n) - return (Ident_Env.toIsa n') - - adapt (Isa.Parenthesized t) = adapt t >>= (return . Isa.Parenthesized) - - adapt (Isa.App t1 t2) = do Just mID <- query currentModuleID - oldEnv <- query oldGlobalEnv - newEnv <- query adaptedGlobalEnv - t1' <- adapt t1 - t2' <- adapt t2 - -- t1 may have been an InfixOp and was adapted to - -- a function. In this case, we have to make sure that - -- all the arguments passed to this function are - -- parenthesized. - let n1 = find_applied_op t1 - let n1' = find_applied_op t1' - case (n1, n1') of - (Just n1, Just n1') - -> if isInfixOp mID n1 oldEnv && not (isInfixOp mID n1' newEnv) - then return $ Isa.App t1' (Isa.Parenthesized t2') - else return $ Isa.App t1' t2' - _ -> return (Isa.App t1' t2') - where isInfixOp mID n env - = case Ident_Env.lookupConstant mID (Ident_Env.fromIsa n) env of - Nothing -> False - Just c -> Ident_Env.isInfixOp c - find_applied_op :: Isa.Term -> Maybe Isa.Name - find_applied_op t - = case t of - Isa.Const n -> Just n - Isa.App t1 t2 -> find_applied_op t1 - Isa.Parenthesized t' -> find_applied_op t' - _ -> Nothing -- the remaining cases are - -- too complicated, so we give up. - - adapt (Isa.If c t e) = do c' <- adapt c ; t' <- adapt t ; e' <- adapt e - return (Isa.If c' t' e') - - adapt (Isa.Abs boundN body) - = shadowing [boundN] $ - adapt body >>= (return . Isa.Abs boundN) - - adapt (Isa.Let bindings body) - = do pats' <- mapM adapt (map fst bindings) - nested_binding (zipWith (\p' t -> (accumulate add_const_names p', adapt t)) - pats' (map snd bindings)) $ - \terms' -> do body' <- adapt body - return (Isa.Let (zip pats' terms') body') - - adapt (Isa.Case term patterns) - = do term' <- adapt term - patterns' <- mapM (\(pat, body) - -> do pat' <- adapt pat - shadowing (accumulate add_const_names pat') $ - do body' <- adapt body - return (pat', body')) - patterns - return (Isa.Case term' patterns') - - adapt (Isa.ListCompr body stmts) = adpt body stmts [] - where - adpt e [] stmts' = do e' <- adapt e; return (Isa.ListCompr e' (reverse stmts')) - adpt e (Isa.Guard b : rest) stmts' - = adapt b >>= (\b' -> adpt e rest (Isa.Guard b':stmts')) - adpt e (Isa.Generator (pat, exp) : rest) stmts' - = do pat' <- adapt pat - exp' <- adapt exp - shadowing (accumulate add_const_names pat') $ - adpt e rest (Isa.Generator (pat', exp') : stmts') - adapt (Isa.DoBlock pre stmts post) = - do stmts' <- mapM adapt stmts - return $ Isa.DoBlock pre stmts' post - -instance Adapt Isa.DoBlockFragment where - adapt (Isa.DoGenerator pat exp) = liftM2 Isa.DoGenerator (adapt pat) (adapt exp) - adapt (Isa.DoQualifier exp) = liftM Isa.DoQualifier $ adapt exp - - -add_const_names :: Isa.Term -> [Isa.Name] -> [Isa.Name] -add_const_names (Isa.Const n) = insert n -add_const_names (Isa.App t1 t2) = add_const_names t1 *> add_const_names t2 -add_const_names _ = id diff --git a/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/Importer/Configuration.hs b/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/Importer/Configuration.hs deleted file mode 100644 index b169474068593f07af040d04d16ee01776d45c5d..0000000000000000000000000000000000000000 --- a/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/Importer/Configuration.hs +++ /dev/null @@ -1,712 +0,0 @@ -{-# LANGUAGE DeriveDataTypeable #-} - -{-| Author: Patrick Bahr, NICTA - -This module provides functionality to read configurations from an XML -file into a data structure and to access this data structure. --} - -module Importer.Configuration - ( - -- * Types - Config (..), - Customisations, - CustomTheory, - Location (..), - CustomTranslations, - CustomTranslation, - MonadInstance (..), - DoSyntax (..), - -- * XML Parsing - readConfig, - -- * Default Configurations - defaultConfig, - defaultCustomisations, - -- * Accessor Functions - getCustomTheory, - getCustomTheoryName, - getCustomConstants, - getCustomTypes, - getCustomTheoryPath, - getMonadInstance, - getMonadConstant, - getMonadDoSyntax, - getMonadLift - ) where - -import Importer.Library -import Data.Maybe -import Data.List -import Data.Map (Map) -import qualified Data.Map as Map hiding (Map) - -import Control.Monad.Except (catchError) - -import Text.XML.Light hiding (findAttr) -import qualified Text.XML.Light as XML - -import Data.Generics - -import System.FilePath -import System.Directory - -import qualified Importer.Isa as Isa (ThyName(..)) -import qualified Language.Haskell.Exts as Hsx (ModuleName (..), Type(..), QName(..)) -import qualified Importer.Hsx as Hsx - - ---------------------- --- Data Structures -- ---------------------- - -{-| - This type represents sets of custom translations, i.e., mappings from Haskell - modules to custom theories. --} -type CustomTranslations = Map (Hsx.ModuleName ()) CustomTheory - -{-| - This type represents single custom translations. --} -type CustomTranslation = (Hsx.ModuleName (), CustomTheory) - -{-| - This type represents locations declared in a configuration. --} -newtype Location = FileLocation{ fileLocation :: FilePath} - deriving (Show, Eq, Data, Typeable) - -{-| - This type represents information that customise the actual translation. --} -data Customisations = Customisations{ customTheoryCust :: Map (Hsx.ModuleName ()) CustomTheory, monadInstanceCust :: Map String MonadInstance} - deriving (Show, Eq, Data, Typeable) - -{-| - An element of this type represents a single customisation option. --} -data Customisation = CustReplace Replace - | CustMonadInstance MonadInstance - deriving (Show, Eq, Data, Typeable) - -{-| - This type represents Isabelle theories that can be declared to be substitutes - to actual translations (which might be impossible) of necessary Haskell modules. --} -data CustomTheory = CustomTheory { - custThyName :: Isa.ThyName, -- ^The name of the theory. - custThyLocation :: Location, -- ^The location of the @*.thy@ file containing the theory. - custThyConstants :: [String], -- ^The constants that the theory is supposed to define. - custThyTypes :: [String], -- ^The types that the theory is supposed to define. - custThyMonads :: Either [String] [MonadInstance] -- ^The monads that the theory is supposed to define. - -- After the list of monad names was read from the XML - -- data the corresponding monad instances are inserted - -- instead in the post-processing phase. - } deriving (Show, Eq, Data, Typeable) - -{-| - An element of this type represents configuration information for this application. --} -data Config = Config{inputLocations :: [InputLocation], outputLocation :: OutputLocation, customisations :: Customisations, exportCode :: Bool, tryImport :: Bool, onlyTypes :: Bool, basePathAbs :: Maybe FilePath, ignoreNotInScope :: Bool, absMutParams :: Bool} - deriving (Show, Eq, Data, Typeable) - -{-| - This type represents a particular kind of a translation customisation. An element - of this type describes how a Haskell module can be replaced by an Isabelle theory. --} -data Replace = Replace{ moduleRepl :: Hsx.ModuleName (), customTheoryRepl :: CustomTheory} - deriving (Show, Eq, Data, Typeable) - -{-| - This type represents a particular kind of a translation customisation. An element - of this type describes how monadic code of one particular monad should be translated. --} -data MonadInstance = MonadInstance { - monadName :: String, -- ^The name of the considered monad. - doSyntax :: DoSyntax, -- ^Describes how @do@ expressions should be translated. - monadConstants :: MonadConstants, -- ^Describes how particular monad constants should be translated. - monadLifts :: MonadLifts -- ^Describes how particular lift functions should be treated. - } deriving (Show, Eq, Data, Typeable) -{-| - A mapping from lift functions to monads. When first reading the XML data the 'Left' - of the 'Either' type is produced. In the post-processing phase this is replaced by - the 'Right' resolving the dependencies. --} -type MonadLifts = Either [(String,String)] (Map String MonadInstance) - -{-| - Elements of this type describe how @do@ expressions should be translated into Isabelle - syntax. --} -data DoSyntax = DoParen String String -- ^Translate @do@ expressions as - -- @\<pre\> \<stmt1\>\; \<stmt2\>; ... \<stmtn\> \<post\>@ - -- were @\<pre\>@ and @\<post\>@ are the first and - -- the last constructor's argument respectively. - deriving (Show, Eq, Data, Typeable) - - -{-| - This type represents renamings of monad constants. E.g. this allow to declare - that @return@ should be renamed to @returnE@ in one particular monad. --} -data MonadConstants = ExplicitMonadConstants { - explMonConstants :: Map String String - } deriving (Show, Eq, Data, Typeable) - -{-| - This type represents input locations. --} -type InputLocation = Location - -{-| - This type represents output locations. --} -type OutputLocation = Maybe Location - -{-| - This type represents the monad where the processing of the XML - data takes place. --} -type XMLReader a = Either String a - --------------------- --- Default Values -- --------------------- - -{-| - This function constructs a default configuration depending on the input files, - output directory and customisation. --} -defaultConfig ::Customisations -> [FilePath] -> Maybe FilePath -> Bool -> Bool -> Bool -> Maybe FilePath -> Bool -> Bool -> Config -defaultConfig custs inFiles outDir exportCode tryImport onlyTypes basePathAbs ignoreNotInScope absMutParams = - Config { customisations = custs, - inputLocations = map FileLocation inFiles, - outputLocation = fmap FileLocation outDir, - exportCode = exportCode, - tryImport = tryImport, - onlyTypes = onlyTypes, - basePathAbs = basePathAbs, - ignoreNotInScope = ignoreNotInScope, - absMutParams = absMutParams} - -{-| - This constant represents a default customisations option. --} -defaultCustomisations :: Customisations -defaultCustomisations = Customisations Map.empty Map.empty - -{-| - This constant represents a monad constants option without any constants. --} -noMonadConstants = ExplicitMonadConstants (Map.empty) - - ---------------------------------------- --- Data Structure Accessor Functions -- ---------------------------------------- - -{-| - This function provides the custom theory the given module should be - replaced with according to the given customisations or @nothing@ if - no such translation was declared for the given module. --} -getCustomTheory :: Customisations -> Hsx.ModuleName () -> Maybe CustomTheory -getCustomTheory Customisations{ customTheoryCust = custs} mod = Map.lookup mod custs - - -{-| - This function provides the path of where given custom theories was declared - to be found. --} -getCustomTheoryPath :: CustomTheory -> String -getCustomTheoryPath CustomTheory{custThyLocation = FileLocation src} = src - -getCustomTheoryName :: CustomTheory -> Isa.ThyName -getCustomTheoryName CustomTheory{custThyName = name} = name - -{-| - This function provides the constants that are exported by the given custom - theory. This includes explicitly given one as well as indirectly given ones - (by including a monad instance). --} -getCustomConstants :: CustomTheory -> [String] -getCustomConstants cust = - let expl = custThyConstants cust - Right mons = custThyMonads cust - impl = concatMap (Map.keys . explMonConstants . monadConstants) mons - impl' = concatMap (names . monadLifts) mons - in expl `union` impl `union` impl' - where names (Right x) = Map.keys x - names (Left x) = map fst x - -{-| - This function provides the types that the given custom theory is declared to export. --} -getCustomTypes :: CustomTheory -> [String] -getCustomTypes = custThyConstants - -{-| - This function provides the monad instance declaration of the given monad name - or @Nothing@ if the given monad name was not declared in the given customisation - set. --} -getMonadInstance :: Customisations -> String -> Maybe MonadInstance -getMonadInstance Customisations{monadInstanceCust = insts} monadName = Map.lookup monadName insts - -{-| - This function provides the @do@ syntax information for the given monad - instance. --} -getMonadDoSyntax :: MonadInstance -> DoSyntax -getMonadDoSyntax = doSyntax - -{-| - This function provides the constants that were declared in the - given monad instance. --} -getMonadConstants :: MonadInstance -> [String] -getMonadConstants mon = - let ExplicitMonadConstants transl = monadConstants mon in - Map.keys transl - -{-| - This function provides the monad instance of the monad - that was declared to be lifted from by the given lift function - name inside the given monad or @Nothing@ if there is no such - declaration. --} -getMonadLift :: MonadInstance -- ^The context monad. - -> String -- ^The possible lift function. - -> Maybe MonadInstance -- ^The monad that is lifted (if any). -getMonadLift MonadInstance{monadLifts = Right consts} name = - Map.lookup name consts - -{-| - This function translates the given constant name using - the translation declaration given in the monad instance - argument. --} -getMonadConstant :: MonadInstance -> String -> String -getMonadConstant mon name = - case monadConstants mon of - ExplicitMonadConstants funMap -> - case Map.lookup name funMap of - Nothing -> name - Just name' -> name' - ------------------ --- XML Parsing -- ------------------ - - -{-| - This function reads the XML configuration file located at the given file path - and provides the parsed configuration data structure. --} - -readConfig :: FilePath -> Bool -> IO Config -readConfig path exportCode = - do content <- readFile path - let maybeRoot = parseXMLDoc content - when (isNothing maybeRoot) $ - error $ "Parsing error: The configuration file \"" ++ path ++ "\" is not a well-formed XML document!" - let Just root = maybeRoot - let res = parseConfigDoc root exportCode - config <- either (\msg -> error $ "Malformed configuration file: " ++ msg) return res - wd <- getCurrentDirectory - let path' = combine wd path - return $ makePathsAbsolute (takeDirectory path') config - ------------------------ --- General Structure -- ------------------------ - -{-| - This function takes the root element of a configuration document - and reads the configuration information in it. --} -parseConfigDoc :: Element -> Bool -> XMLReader Config -parseConfigDoc el exportCode - = do checkSName el "translation" - inputEl <- findSingleSElem "input" el - outputEl <- findSingleSElem "output" el - mbCustEl <- ((findSingleSElem "customisation" el >>= (return . Just)) - `catchError` (const $ return Nothing)) - input <- parseInputElem inputEl - output <- parseOutputElem outputEl - cust <- case mbCustEl of - Nothing -> return defaultCustomisations - Just custEl -> parseCustElem custEl - cust' <- processCustomisations cust - return $ Config {inputLocations=input, - outputLocation=output, - customisations=cust', - exportCode=exportCode, - tryImport=False, - onlyTypes=False, - basePathAbs=Nothing, - ignoreNotInScope=False, - absMutParams=False} - -{-| - This function processes the given customisations, i.e. it resolves all - dependencies. Currently, this means that names of monads are replaced by - the corresponding 'MonadInstance' data structures they point to. If a monad - name is not found an error in the XMLReader monad is raised. --} -processCustomisations :: Customisations -> XMLReader Customisations -processCustomisations custs = processCustThys custs >>= processLifts - -{-| - This function processes 'MonadLifts' data structures in the given - customisations by replacing the 'Left' of the 'Either' type into a 'Right'. --} -processLifts :: Customisations -> XMLReader Customisations -processLifts (Customisations thys mons) = - let mons' = Map.map lookup mons - lookup mon@MonadInstance{monadLifts = Left lifts} = - let lifts' = Map.fromList $ map lookupLift lifts in - mon{monadLifts = Right lifts'} - lookupLift (cons,monName) = (cons, fromJust $ Map.lookup monName mons') - in case (check,cycle) of - (monName:_,_) -> fail $ "Monad instance " ++ monName ++ " not found in configuration!" - (_,mon:_) -> fail $ "Monad instance " ++ monadName mon ++ " has a lifting function to itself!" - ([],[]) -> return (Customisations thys mons') - where check = filter (`Map.notMember` mons) $ concatMap monNames monList - cycle = filter (\mon -> monadName mon `elem` monNames mon) monList - monNames MonadInstance{monadLifts = Left lifts} = map snd lifts - monList = Map.elems mons -{-| - This function processes 'CustomTheory' data structures in the given - customisations by replacing monad names by the actual 'MonadInstance' - data structures. --} -processCustThys :: Customisations -> XMLReader Customisations -processCustThys (Customisations thys mons) = - let thys' = Map.map lookup thys in - case check of - [] -> return $ Customisations thys' mons - monName:_ -> fail $ "Monad instance " ++ monName ++ " not found in configuration!" - where monNames CustomTheory{custThyMonads = (Left ns)} = ns - lookup thy = thy{custThyMonads = Right $ map (fromJust . (flip Map.lookup mons)) (monNames thy)} - check = filter (`Map.notMember` mons) $ concatMap monNames (Map.elems thys) - - -{-| - This function turns all file paths in the given configuration into absolute - paths using the given path as the current directory. --} -makePathsAbsolute :: FilePath -> Config -> Config -makePathsAbsolute base = everywhere $ mkT alterPath - where alterPath (FileLocation path) = FileLocation $ combine base path - ------------ --- Input -- ------------ - -{-| - This function reads the input locations stored in the given - @input@ XML element. --} -parseInputElem :: Element -> XMLReader [InputLocation] -parseInputElem el = mapM parseInputLocElem $ onlyElems $ elContent el - -{-| - This function reads a single input location stored in the given - XML element being one of @file@, @dir@ and @path@. --} -parseInputLocElem :: Element -> XMLReader InputLocation -parseInputLocElem el - | elName el `elem` map simpName ["file", "dir", "path"] - = liftM FileLocation $ findSAttr "location" el - | otherwise = fail $ "Unexpected element \"" ++ (show.qName.elName $ el) ++ "\"" ++ (showLine.elLine $ el) ++ "!" - ------------- --- Output -- ------------- - -{-| - This function reads the output location stored in the given @output@ - XML element. --} - -parseOutputElem :: Element -> XMLReader OutputLocation -parseOutputElem el = liftM (Just . FileLocation) $ findSAttr "location" el - --------------------- --- Customisations -- --------------------- - -{-| - This function partitions a list of customisation into two lists of replace - and monad instance customisations respectively. --} -partitionCustomisations :: [Customisation] -> ([Replace],[MonadInstance]) -partitionCustomisations [] = ([],[]) -partitionCustomisations (cust: custs) = - let (repls,mons) = partitionCustomisations custs in - case cust of - CustReplace repl -> (repl:repls,mons) - CustMonadInstance mon -> (repls, mon:mons) - -{-| - This function constructs a customisation data structure given a list of - single customisation options. --} -makeCustomisations :: [Customisation] -> Customisations -makeCustomisations custs = Customisations replsMap monsMap - where (repls,mons) = partitionCustomisations custs - monsMap = Map.fromList $ map (\mon -> (monadName mon,mon)) mons - replsMap = Map.fromList $ map (\repl-> (moduleRepl repl, customTheoryRepl repl)) repls - -{-| - This function reads the customisations stored the given - @customisations@ XML element. --} -parseCustElem :: Element -> XMLReader Customisations -parseCustElem el =liftM makeCustomisations $ mapM parseCustOptElem $ onlyElems $ elContent el - - -{-| - This function reads a single customisation option stored in the given - XML element being either @replace@ or @monadInstance@. --} -parseCustOptElem :: Element -> XMLReader Customisation -parseCustOptElem el - | elName el == simpName "replace" = liftM CustReplace $ parseReplaceElem el - | elName el == simpName "monadInstance" = liftM CustMonadInstance $ parseMonadInstanceElem el - | otherwise = fail $ "Unexpected element \"" ++ (show.qName.elName $ el) ++ "\"" ++ (showLine.elLine $ el) ++ "!" - ---------------------- --- Custom Theories -- ---------------------- - -{-| - This function reads a replace customisation option stored in the given - @replace@ XML element --} -parseReplaceElem :: Element -> XMLReader Replace -parseReplaceElem el - = do moduleEl <- findSingleSElem "module" el - theoryEl <- findSingleSElem "theory" el - mod <- parseModuleNameElem moduleEl - custThy <- parseTheoryElem theoryEl - return $ Replace mod custThy - -{-| - This function reads a custom theory stored in the given @theory@ - XML element. --} -parseTheoryElem :: Element -> XMLReader CustomTheory -parseTheoryElem el = do thy <- findSAttr "name" el - path <- findSAttr "location" el - types <- getTypes - monads <- getMonads - constants <- getConstants - return $ CustomTheory (Isa.ThyName thy) (FileLocation path) constants types (Left monads) - where getTypes = (findSingleSElem "types" el >>= - parseThyTypesElem) - `defaultVal` [] - getMonads = (findSingleSElem "monads" el >>= - parseThyMonadsElem) - `defaultVal` [] - getConstants = (findSingleSElem "constants" el >>= - parseThyConstantsElem) - `defaultVal` [] - -{-| - This function reads a list of constant names stored in the given - @constants@ XML element. --} -parseThyConstantsElem :: Element -> XMLReader [String] -parseThyConstantsElem el = return . words . strContent $ el - -{-| - This function reads a list of type names stored in the given - @types@ XML element. --} -parseThyTypesElem :: Element -> XMLReader [String] -parseThyTypesElem el = return . words . strContent $ el - -{-| - This function reads a list of monad names stored in the given - @monads@ XML element. --} -parseThyMonadsElem :: Element -> XMLReader [String] -parseThyMonadsElem el = return .words . strContent $ el - -{-| - This function reads a module name stored in the given @module@ - XML element. --} -parseModuleNameElem :: Element -> XMLReader (Hsx.ModuleName ()) -parseModuleNameElem el = liftM (Hsx.ModuleName ()) $ findSAttr "name" el - ---------------------- --- Monad Instances -- ---------------------- - -{-| - This function reads a monad instance declaration stored in the given - @monadInstance@ XML element. --} -parseMonadInstanceElem :: Element -> XMLReader MonadInstance -parseMonadInstanceElem el - = do name <- findSAttr "name" el - doSyn <- getDoSyntax - constants <- getConstants - lifts <- getLifts - return $ MonadInstance name doSyn constants (Left lifts) - where getLifts = (findSingleSElem "lifts" el >>= - parseLiftsElem) - `defaultVal` [] - getConstants = (findSingleSElem "constants" el >>= - parseMonConstantsElem) - `defaultVal` noMonadConstants - getDoSyntax = findSingleSElem "doSyntax" el >>= - parseDoSyntaxElem - -{-| - This function reads a list of monad lift information stored in the - given @lifts@ XML element. --} -parseLiftsElem :: Element -> XMLReader [(String,String)] -parseLiftsElem el = findSElems "lift" el >>= mapM parseLiftElem - -{-| - This function read a single piece of monad lift information stored - in the given @lift@ XML element. --} -parseLiftElem :: Element -> XMLReader (String,String) -parseLiftElem el = - do from <- findSAttr "from" el - by <- findSAttr "by" el - return (by, from) - -{-| - This function reads @do@ syntax information stored in the given - @doSyntax@ XML element. --} -parseDoSyntaxElem :: Element -> XMLReader DoSyntax -parseDoSyntaxElem el = - let [begin, end] = words . strContent $ el - in return $ DoParen begin end - -{-| - This function reads monad constants information stored in the given - @constants@ XML element --} -parseMonConstantsElem :: Element -> XMLReader MonadConstants -parseMonConstantsElem = return . ExplicitMonadConstants . Map.fromList . pair . words . strContent - where pair [] = [] - pair [_] = fail "Monad constants have to be defined in pairs!" - pair (a:b:rest) = (a,b) : pair rest - - - -------------------- --- XML utilities -- -------------------- - -{-| - This combinator provides the given default value if the given - @XMLReader@ monad fails. --} -defaultVal :: XMLReader a -> a -> XMLReader a -defaultVal parse val = parse `catchError` const (return val) - -{-| - This function is similar to 'findSinlgeElem' but it takes a string as the basis for - a name provided by 'simpName'. --} -findSingleSElem :: String -> Element -> XMLReader Element -findSingleSElem name el = findSingleElem (simpName name) el - -{-| - This looks for a single element of the given name as the child of the - given element. If not /exactly one/ element is found an error is raised. --} -findSingleElem :: QName -> Element -> XMLReader Element -findSingleElem name el = case findChildren name el of - [] -> failAt el $ "Required element \""++ (showName name) ++"\" not found" - _:_:_ -> failAt el $ "Only one element \""++ (showName name) ++"\" is allowed" - [e] -> return e - -{-| - This function is similar to 'findElems' but it takes a string as the basis - for a name provided by 'simpName'. --} -findSElems :: String -> Element -> XMLReader [Element] -findSElems name el = findElems (simpName name) el - -{-| - This function provides all children elements of the given - element having the given name. --} -findElems :: QName -> Element -> XMLReader [Element] -findElems name el = return $ findChildren name el - -{-| - This function provides an unqualified name having the given string - as a name. --} -simpName :: String -> QName -simpName name = QName {qName = name, qURI = Nothing, qPrefix = Nothing} - -{-| - This function is similar to 'checkName' but it takes a string as the basis - of a name provided by 'simpName'. --} -checkSName :: Element -> String -> XMLReader () -checkSName el sname = checkName el (simpName sname) - -{-| - This function checks whether the given element has the given name. If it has - not an error is raised. --} -checkName :: Element -> QName -> XMLReader () -checkName el name - = let foundName = elName el in - if foundName /= name - then failAt el $ "Expected \""++ (showName name) ++"\" element but found \"" ++ (showName foundName) - else return () - -{-| - This function raises an error with the given message. The XML element is used - to provide information where the error occurred. --} -failAt :: Element -> String -> XMLReader a -failAt el msg = fail $ msg ++ (showLine $ elLine el) ++ "!" - -{-| - This function turns a line information of an XML element into a - human readable string that can be used in an error message. --} -showLine :: Maybe Line -> String -showLine Nothing = "" -showLine (Just line) = " at line " ++ (show line) - -{-| - This function provides a human readable string representation of the given - qualified name. --} -showName :: QName -> String -showName name = qName name - -{-| - This function is similar to 'findAttr' but instead of a qualified name it - takes a string to construct one using 'simpName' --} -findSAttr :: String -> Element -> XMLReader String -findSAttr name el = findAttr (simpName name) el - -{-| - This function provides the value of the attribute of the given name in the given - element. If there is no such attribute an error is raised. --} -findAttr :: QName -> Element -> XMLReader String -findAttr name el = maybe - (fail $ "Expected attribute \"" ++ (showName name) ++ "\" not found" ++ (showLine $ elLine el) ++ "!") - return - (XML.findAttr name el) - diff --git a/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/Importer/Conversion.hs b/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/Importer/Conversion.hs deleted file mode 100644 index aa36a1dad9d0eb32b0283ccc8e135074deec1298..0000000000000000000000000000000000000000 --- a/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/Importer/Conversion.hs +++ /dev/null @@ -1,96 +0,0 @@ -{-| Author: Tobias C. Rittweiler, TU Muenchen - -Internal importer main interfaces. --} - -module Importer.Conversion (importFiles, importProject) where - -import Importer.Library - -import qualified Data.Generics as G -import qualified Data.List as List -import qualified Language.Haskell.Interpreter as I -import Text.PrettyPrint (render) - -import System.FilePath -import System.Directory -import System.IO - -import Importer.Adapt (Adaption (..), AdaptionTable, readAdapt, preludeFile) -import Importer.Configuration -import Importer.Convert -import Importer.Printer (pprint) - -import qualified Importer.Ident_Env as Ident_Env (GlobalE) -import qualified Importer.Isa as Isa (Module (..), Stmt (..), ThyName (..)) -import qualified Importer.Hsx as Hsx -import qualified Importer.Conversion.SML as SML - - -importProject :: Config -> FilePath -> Bool -> Maybe ([String], [String], String, String) -> [String] -> IO () -importProject config adaptDir metaParseShallow metaParse hskContents = do - adapt <- readAdapt adaptDir - runConversion config (convertFiles adapt metaParseShallow metaParse hskContents) - -importFiles :: [FilePath] -> Maybe FilePath -> Bool -> Bool -> Bool -> Maybe FilePath -> Bool -> Bool -> FilePath -> Bool -> Maybe ([String], [String], String, String) -> [String] -> IO () -importFiles files out exportCode tryImport onlyTypes basePathAbs getIgnoreNotInScope absMutParams - = importProject (defaultConfig defaultCustomisations files out exportCode tryImport onlyTypes basePathAbs getIgnoreNotInScope absMutParams) - -convertFiles :: Adaption -> Bool -> Maybe ([String], [String], String, String) -> [String] -> Conversion () -convertFiles adapt metaParseShallow metaParse hskContents = do - - inFiles <- getInputFilesRecursively - outDir <- getOutputDir - exportCode <- getExportCode - tryImport <- getTryImport - onlyTypes <- getOnlyTypes - basePathAbs <- getBasePathAbs - ignoreNotInScope <- getIgnoreNotInScope - absMutParams <- getAbsMutParams - custs <- getCustomisations - - exists <- liftIO $ mapM doesDirectoryExist outDir - when (case exists of Just False -> True ; _ -> False) $ liftIO $ maybe (return ()) createDirectory outDir - hskContents' <- liftIO $ mapM (case metaParse of Nothing -> return . (\code -> (code, [])) - Just (load, imports, code, hskName) -> \hsk_ct -> do - let s = I.parens code ++ " " ++ show hsk_ct - res <- I.runInterpreter $ do - mapM (\basePathAbs -> I.set [I.searchPath I.:= [basePathAbs]]) basePathAbs - I.loadModules load - I.setImports ("Prelude" : imports) - I.interpret s (I.as :: IO (String, [(Int, Int, (String, [(String, String)]))])) >>= liftIO - return $ case res of Right (code, report) -> (hskName ++ " = " ++ code, report) ; Left l -> error (show l)) - hskContents - let (hskContents'0, report) = unzip hskContents' - units <- parseHskFiles tryImport onlyTypes basePathAbs (map Right hskContents'0 ++ map Left (filter Hsx.isHaskellSourceFile inFiles)) - let (adaptTable : _, convertedUnits) = map_split (convertHskUnit custs exportCode ignoreNotInScope absMutParams adapt) units - - liftIO $ maybe (return ()) (\outDir -> copyFile (preludeFile adapt) (combine outDir (takeFileName (preludeFile adapt)))) outDir - sequence_ (map (writeIsaUnit adaptTable (reservedKeywords adapt)) convertedUnits) - liftIO $ case outDir of Nothing -> putStrLn $ SML.gshow ( List.nubBy (let f (Isa.Module t _ _ _) = t in \m1 m2 -> f m1 == f m2) - $ concatMap (\(IsaUnit l _ _) -> (if metaParseShallow then G.everywhere (G.mkT (\s -> case s of Isa.Function f -> Isa.ML f; x -> x)) else id) l) convertedUnits - , report) - _ -> return () - - -writeIsaUnit :: AdaptionTable -> [String] -> IsaUnit -> Conversion () -writeIsaUnit adapt reserved (IsaUnit thys custThys env) - = mapM_ writeCustomTheory custThys >> - mapM_ (writeTheory adapt reserved env) thys - -writeCustomTheory :: CustomTheory -> Conversion () -writeCustomTheory cust = - do let src = getCustomTheoryPath cust - filename = takeFileName src - getOutputDirMaybe (\outDir -> liftIO $ copyFile src (combine outDir filename)) - -writeTheory :: AdaptionTable -> [String] -> Ident_Env.GlobalE -> Isa.Module -> Conversion () -writeTheory adapt reserved env thy @ (Isa.Module (Isa.ThyName thyname) _ _ _) = do - let content = render (pprint adapt reserved env thy) - let dstName = content `seq` map (\c -> if c == '.' then '_' else c) thyname ++ ".thy" - getOutputDirMaybe (\outLoc -> do - let dstPath = combine outLoc dstName - liftIO $ hPutStrLn stderr $ "writing " ++ dstName ++ "..." - liftIO $ writeFile dstPath content) - -getOutputDirMaybe f = getOutputDir >>= maybe (return ()) f diff --git a/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/Importer/Conversion/Haskell.hs b/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/Importer/Conversion/Haskell.hs deleted file mode 100644 index aa50d0e7ca43b46dd5c4a04854fd71e79f656395..0000000000000000000000000000000000000000 --- a/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/Importer/Conversion/Haskell.hs +++ /dev/null @@ -1,33 +0,0 @@ -module Importer.Conversion.Haskell where - -import qualified Data.Data as D -import qualified Data.Generics as G - -type SS' = String -type SS = SS' -> SS' - -gshows :: D.Data a => a -> SS -gshows = render `G.extQ` (shows :: String -> SS) where - render t - | isTuple = commaSlots' '(' "," ')' - | isListEmpty = showString "[]" - | isList = commaSlots '(' ":" ')' - | isSingleConst = constructor - - | otherwise = showChar '(' - . constructor - . build " " - . showChar ')' - - where constructor = showString . D.showConstr . D.toConstr $ t - - build s = foldr (.) id . D.gmapQ ((showString s .) . gshows) $ t - commaSlots c1 s c2 = showChar c1 . drop (length s) . build s . showChar c2 - commaSlots' c1 s c2 = -- this particular arrangement of tuples is following the ordering chosen in Haskabelle - case D.gmapQ gshows t of x : xs -> foldl (\x1 x2 -> showChar c1 . x1 . showString s . x2 . showChar c2) x xs - filt s = filter (not . flip elem s) (constructor "") - - isTuple = all (==',') (filt "()") - isListEmpty = null (filt "[]") - isList = constructor "" == "(:)" - isSingleConst = null (D.gmapQ (\_ -> ()) t) diff --git a/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/Importer/Conversion/Haskell/C.hs b/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/Importer/Conversion/Haskell/C.hs deleted file mode 100644 index 615509f45d5b61f1124507be9e4b2ca99e45fa87..0000000000000000000000000000000000000000 --- a/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/Importer/Conversion/Haskell/C.hs +++ /dev/null @@ -1,161 +0,0 @@ -{-# LANGUAGE DeriveDataTypeable #-} - -module Importer.Conversion.Haskell.C where - -import Control.Monad -import Data.Function -import System.Directory -import System.FilePath -import System.IO -import Text.Parsec.String (Parser) -import Text.Parsec - -import qualified Data.ByteString as B -import qualified Data.Data as D -import qualified Data.Generics as G -import qualified Language.C as C -import qualified Language.C.Comments as CC -import qualified Language.C.Data.Position as P -import qualified Language.C.System.GCC as GCC -import qualified Language.C.System.Preprocess as CP -import qualified Importer.Conversion.Markup as Markup - -parseComments fic = do - f <- readFile fic - lines f - & foldl (\(buf_all, buf_local) line -> - case parse directive "" line of Left _ -> (buf_all, line : buf_local) - Right (l, s) -> (Left (s, read l :: Int) : flush_local buf_all buf_local, [])) - ([], []) - & (\(buf_all, buf_local) -> reverse $ flush_local buf_all buf_local) - & foldl (\((fic, row), l_comm) line -> - case line of - Left fic_row -> (fic_row, l_comm) - Right body -> - ((fic, row), - map (\x -> x { CC.commentPosition = let pos = CC.commentPosition x in - P.position (P.posOffset pos) fic (row + P.posRow pos - 1) (P.posColumn pos) }) - (CC.commentsFromString $ unlines body) : l_comm)) - (("", 1), []) - & (\ (_, l_comm) -> concat $ reverse l_comm) - & return - where - flush_local buf_all [] = buf_all - flush_local buf_all buf_local = Right (reverse buf_local) : buf_all - - directive = do - char '#' - whitespace - i <- many1 digit - whitespace - char '"' - s <- manyTill anyChar (try $ char '"') - manyTill (digit <|> char ' ') eof - return (i, s) - -whitespace :: Parser () -whitespace = void $ many $ oneOf " \t" - -parseCFilePre0 :: Maybe FilePath -> FilePath -> Either C.ParseError a -> IO (a, ([Comment], [Int])) -parseCFilePre0 fic_orig fic_pre = - either (error . show) (\x -> do cc <- parseComments (case fic_orig of {Nothing -> fic_pre; Just fic_orig -> fic_orig}) - l <- - case fic_orig of Nothing -> return [] - Just fic_orig -> do s <- readFile fic_orig - return $ map length $ lines s - return (x, (map map_comment cc, l))) - -parseCFilePre :: Maybe FilePath -> FilePath -> IO (C.CTranslUnit, ([Comment], [Int])) -parseCFilePre fic_orig fic_pre = - C.parseCFilePre fic_pre >>= parseCFilePre0 fic_orig fic_pre - -parseCFile' :: CP.Preprocessor cpp => cpp -> [String] -> FilePath -> IO (Maybe FilePath, Either C.ParseError C.CTranslUnit) -parseCFile' cpp args input_file = do - (out, input_stream) <- if not (CP.isPreprocessed input_file) - then do outputFile <- mkOutputFile Nothing getOutputFileName input_file - let cpp_args = (CP.rawCppArgs args input_file) { CP.outputFile = Just outputFile } - ic <- CP.runPreprocessor cpp cpp_args >>= handleCppError - return $ (Just outputFile, ic) - else do ic <- C.readInputStream input_file - return $ (Nothing, ic) - return$ (out, C.parseC input_stream (P.initPos input_file)) - where - handleCppError (Left exitCode) = fail $ "Preprocessor failed with " ++ show exitCode - handleCppError (Right ok) = return ok - -parseC' :: C.InputStream -> IO ((C.CTranslUnit, ([Comment], [Int])), [(Int, Int, (String, [(String, String)]))]) -parseC' input = do - fic_orig <- mkOutputFile Nothing id "input.c" - B.writeFile fic_orig input - (fic_pre, parsed) <- parseCFile' (GCC.newGCC "cpp") [] fic_orig - parsed' <- parseCFilePre0 (Just fic_orig) (maybe fic_orig id fic_pre) parsed - mapM removeFile fic_pre - removeFile fic_orig - return $ ( G.everywhere (G.mkT (\pos -> if P.isSourcePos pos then P.position (P.posOffset pos) "" (P.posRow pos) (P.posColumn pos) else pos)) parsed' - , case parsed' of (_, (l_comm, _)) -> map (\(Comment { commentPosition = pos, commentText = txt }) -> (P.posOffset pos, P.posOffset pos + length txt, (Markup.to_ML Markup.ML_COMMENT, []))) l_comm) - --------------------------------------------------------------------------------- --- Same types as language-c-comments with the addition of Data as derived entity - -data CommentFormat = SingleLine | MultiLine deriving (Eq,Show,D.Data) - -data Comment = Comment { - -- | The position of the comment within the source file. - commentPosition :: C.Position, - -- | The text of a comment (including the comment marks). - commentText :: String, - -- | The format of a comment (single- or multi-line). - commentFormat :: CommentFormat -} deriving (Eq,Show,D.Data) - -map_commentFormat x = case x of - CC.SingleLine -> SingleLine - CC.MultiLine -> MultiLine - -map_comment x = - Comment { commentPosition = CC.commentPosition x - , commentText = CC.commentText x - , commentFormat = map_commentFormat $ CC.commentFormat x } - - - ------------------------------------------------------------------------------ --- | --- Module : Language.C.System.Preprocess --- Copyright : (c) 2008 Benedikt Huber --- License : BSD-style --- Maintainer : benedikt.huber@gmail.com --- Stability : experimental --- Portability : portable --- --- Invoking external preprocessors. ------------------------------------------------------------------------------ - --- | file extension of a preprocessed file -preprocessedExt :: String -preprocessedExt = ".i" - --- | create an output file, given @Maybe tmpdir@ and @inputfile@ -mkOutputFile :: Maybe FilePath -> (FilePath -> FilePath) -> FilePath -> IO FilePath -mkOutputFile tmp_dir_opt getOutputFileName input_file = - do tmpDir <- getTempDir tmp_dir_opt - mkTmpFile tmpDir (getOutputFileName input_file) - where - getTempDir (Just tmpdir) = return tmpdir - getTempDir Nothing = getTemporaryDirectory - --- | compute output file name from input file name -getOutputFileName :: FilePath -> FilePath -getOutputFileName fp | hasExtension fp = replaceExtension filename preprocessedExt - | otherwise = addExtension filename preprocessedExt - where - filename = takeFileName fp - --- | create a temporary file -mkTmpFile :: FilePath -> FilePath -> IO FilePath -mkTmpFile tmp_dir file_templ = do - -- putStrLn $ "TmpDir: "++tmp_dir - -- putStrLn $ "FileTempl: "++file_templ - (path,file_handle) <- openTempFile tmp_dir file_templ - hClose file_handle - return path diff --git a/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/Importer/Conversion/Markup.hs b/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/Importer/Conversion/Markup.hs deleted file mode 100644 index 88066202501a5a8c72ffa26c609b390c940ec881..0000000000000000000000000000000000000000 --- a/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/Importer/Conversion/Markup.hs +++ /dev/null @@ -1,174 +0,0 @@ -{- Title: Pure/PIDE/markup.ML - Author: Makarius - -Quasi-abstract markup elements. --} - -module Importer.Conversion.Markup where - --- cd src/Pure/PIDE; grep ': T$' markup.ML | rev | cut -d ':' -f 2 | cut -d ' ' -f 1 | rev | while read i ; do echo " | ${i^^}" ; done -data T = EMPTY - | LANGUAGE_METHOD - | LANGUAGE_ATTRIBUTE - | LANGUAGE_ANTIQUOTATION - | LANGUAGE_RAIL - | LANGUAGE_PATH - | LANGUAGE_MIXFIX - | BINDING - | COMPLETION - | NO_COMPLETION - | POSITION - | FBREAK - | ITEM - | WORDS - | HIDDEN - | TFREE - | TVAR - | FREE - | SKOLEM - | BOUND - | VAR - | NUMERAL - | LITERAL - | DELIMITER - | INNER_STRING - | INNER_CARTOUCHE - | INNER_COMMENT - | TOKEN_RANGE - | SORTING - | TYPING - | CLASS_PARAMETER - | ML_KEYWORD1 - | ML_KEYWORD2 - | ML_KEYWORD3 - | ML_DELIMITER - | ML_TVAR - | ML_NUMERAL - | ML_CHAR - | ML_STRING - | ML_COMMENT - | SML_STRING - | SML_COMMENT - | ML_TYPING - | ANTIQUOTED - | ANTIQUOTE - | PARAGRAPH - | TEXT_FOLD - | MARKDOWN_PARAGRAPH - | COMMAND_KEYWORD - | STRING - | ALT_STRING - | VERBATIM - | CARTOUCHE - | COMMENT - | KEYWORD1 - | KEYWORD2 - | KEYWORD3 - | QUASI_KEYWORD - | IMPROPER - | OPERATOR - | GOAL - | ACCEPTED - | FORKED - | JOINED - | RUNNING - | FINISHED - | FAILED - | CONSOLIDATED - | STATUS - | RESULT - | WRITELN - | STATE - | INFORMATION - | TRACING - | WARNING - | LEGACY - | ERROR - | SYSTEM - | REPORT - | NO_REPORT - | INTENSIFY - --- cd src/Pure/PIDE; grep ': T$' markup.ML | rev | cut -d ':' -f 2 | cut -d ' ' -f 1 | rev | while read i ; do echo " ${i^^} -> \"$i\"" ; done -to_ML x = case x of - EMPTY -> "empty" - LANGUAGE_METHOD -> "language_method" - LANGUAGE_ATTRIBUTE -> "language_attribute" - LANGUAGE_ANTIQUOTATION -> "language_antiquotation" - LANGUAGE_RAIL -> "language_rail" - LANGUAGE_PATH -> "language_path" - LANGUAGE_MIXFIX -> "language_mixfix" - BINDING -> "binding" - COMPLETION -> "completion" - NO_COMPLETION -> "no_completion" - POSITION -> "position" - FBREAK -> "fbreak" - ITEM -> "item" - WORDS -> "words" - HIDDEN -> "hidden" - TFREE -> "tfree" - TVAR -> "tvar" - FREE -> "free" - SKOLEM -> "skolem" - BOUND -> "bound" - VAR -> "var" - NUMERAL -> "numeral" - LITERAL -> "literal" - DELIMITER -> "delimiter" - INNER_STRING -> "inner_string" - INNER_CARTOUCHE -> "inner_cartouche" - INNER_COMMENT -> "inner_comment" - TOKEN_RANGE -> "token_range" - SORTING -> "sorting" - TYPING -> "typing" - CLASS_PARAMETER -> "class_parameter" - ML_KEYWORD1 -> "ML_keyword1" - ML_KEYWORD2 -> "ML_keyword2" - ML_KEYWORD3 -> "ML_keyword3" - ML_DELIMITER -> "ML_delimiter" - ML_TVAR -> "ML_tvar" - ML_NUMERAL -> "ML_numeral" - ML_CHAR -> "ML_char" - ML_STRING -> "ML_string" - ML_COMMENT -> "ML_comment" - SML_STRING -> "SML_string" - SML_COMMENT -> "SML_comment" - ML_TYPING -> "ML_typing" - ANTIQUOTED -> "antiquoted" - ANTIQUOTE -> "antiquote" - PARAGRAPH -> "paragraph" - TEXT_FOLD -> "text_fold" - MARKDOWN_PARAGRAPH -> "markdown_paragraph" - COMMAND_KEYWORD -> "command_keyword" - STRING -> "string" - ALT_STRING -> "alt_string" - VERBATIM -> "verbatim" - CARTOUCHE -> "cartouche" - COMMENT -> "comment" - KEYWORD1 -> "keyword1" - KEYWORD2 -> "keyword2" - KEYWORD3 -> "keyword3" - QUASI_KEYWORD -> "quasi_keyword" - IMPROPER -> "improper" - OPERATOR -> "operator" - GOAL -> "goal" - ACCEPTED -> "accepted" - FORKED -> "forked" - JOINED -> "joined" - RUNNING -> "running" - FINISHED -> "finished" - FAILED -> "failed" - CONSOLIDATED -> "consolidated" - STATUS -> "status" - RESULT -> "result" - WRITELN -> "writeln" - STATE -> "state" - INFORMATION -> "information" - TRACING -> "tracing" - WARNING -> "warning" - LEGACY -> "legacy" - ERROR -> "error" - SYSTEM -> "system" - REPORT -> "report" - NO_REPORT -> "no_report" - INTENSIFY -> "intensify" diff --git a/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/Importer/Conversion/SML.hs b/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/Importer/Conversion/SML.hs deleted file mode 100644 index f35ac6285872d50327c30a7c951de9c91d3dae2b..0000000000000000000000000000000000000000 --- a/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/Importer/Conversion/SML.hs +++ /dev/null @@ -1,65 +0,0 @@ -module Importer.Conversion.SML where - -import qualified Data.Char as Char -import qualified Data.Data as D -import qualified Data.Generics.Aliases as G -import qualified Text.Printf as Printf - -render_string_wrap = True - -char_escape c = c >= '\b' && c <= '\n' - || c == '\r' - || c == '"' - -char c = char_escape c - || c >= ' ' && c <= '~' && (c /= '\\' && c /= '<' {- the escaping of string comments for future ML parsing to succeed -}) - -type SS' = String -type SS = SS' -> SS' - -monad_String = showString -monad_Char = showChar -monad_Drop = drop - -gshows :: D.Data a => a -> SS -gshows = render `G.extQ` (render_bool :: Bool -> SS) - `G.extQ` (render_string :: String -> SS) - `G.extQ` (render_char :: Char -> SS) - `G.extQ` (render_int :: Int -> SS) - `G.extQ` (render_integer :: Integer -> SS) where - render_bool b = monad_String $ if b then "true" else "false" - render_string = - let (monad_String_show, monad_String') = if render_string_wrap then (monad_String' . show, \s -> monad_String ("From.string " ++ s)) else (shows, monad_String) in - \s -> if all char s then monad_String_show s - else monad_String' $ "\"" ++ concatMap (\c -> if char c && not (char_escape c) then [c] - else Printf.printf "\\%03d" (Char.ord c)) s ++ "\"" - render_char c = monad_Char '#' . render_string [c] - render_int i = monad_String "From.nat " . if i < 0 then monad_Char '~' . shows (-i) else shows i - render_integer = render_int - render t - | isTuple = commaSlots' '(' "," ')' - | isListEmpty = monad_String "[]" - | isList = commaSlots '(' "::" ')' - | isOption = case D.showConstr . D.toConstr $ t of - "Just" -> monad_String "SOME" . commaSlots '(' "," ')' - "Nothing" -> monad_String "NONE" - | isSingleConst = constructor - - | otherwise = constructor - . commaSlots '(' "," ')' - - where constructor = monad_String . D.showConstr . D.toConstr $ t - - build s = foldr (.) id . D.gmapQ ((monad_String s .) . gshows) $ t - commaSlots c1 s c2 = monad_Char c1 . monad_Drop (length s) . build s . monad_Char c2 - commaSlots' c1 s c2 = -- this particular arrangement of tuples is following the ordering chosen in Haskabelle - case D.gmapQ gshows t of x : xs -> foldl (\x1 x2 -> monad_Char c1 . x1 . monad_String s . x2 . monad_Char c2) x xs - filt s = filter (not . flip elem s) (constructor "") - - isTuple = all (==',') (filt "()") - isListEmpty = null (filt "[]") - isList = constructor "" == "(:)" - isOption = let c = constructor "" in c == "Just" || c == "Nothing" - isSingleConst = null (D.gmapQ (\_ -> ()) t) - -gshow f = gshows f "" diff --git a/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/Importer/Convert.hs b/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/Importer/Convert.hs deleted file mode 100644 index 6f6b9ceb94d2a8c4aee9349d02f5c12cca9cc90b..0000000000000000000000000000000000000000 --- a/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/Importer/Convert.hs +++ /dev/null @@ -1,1536 +0,0 @@ -{-# LANGUAGE - MultiParamTypeClasses, - FunctionalDependencies, - FlexibleContexts, - FlexibleInstances, - TypeSynonymInstances, - GeneralizedNewtypeDeriving, - Rank2Types #-} - -{-| Author: Tobias C. Rittweiler, TU Muenchen - -Conversion from abstract Haskell code to abstract Isar/HOL theory. --} - -module Importer.Convert (convertHskUnit, Conversion, runConversion, parseHskFiles, IsaUnit(..), - liftIO, getOutputDir, getExportCode, getTryImport, getOnlyTypes, getBasePathAbs, getIgnoreNotInScope, getAbsMutParams, getCustomisations, getInputFilesRecursively) where - -import Importer.Library -import qualified Importer.AList as AList -import qualified Data.Generics as G -import Data.Function -import Data.List (nub, unzip4, partition, isSuffixOf) -import Data.Maybe -import qualified Data.Set as Set hiding (Set) -import Data.Set (Set) -import qualified Data.Map as Map hiding (Map) -import Data.Map (Map) -import Data.Tree -import Data.Graph - -import qualified Language.Preprocessor.Unlit as Unlit - -import Control.Monad (foldM, mapAndUnzipM) -import Control.Monad.State (StateT, MonadState, get, put, modify, execStateT, runStateT) -import Control.Monad.Except (MonadError) -import Control.Monad.Reader (ReaderT, MonadReader, MonadIO, liftIO, ask, lift, runReaderT, local) -import Control.Monad.Writer (WriterT, MonadWriter, runWriterT, tell) - -import System.FilePath -import System.Directory -import System.IO - -import qualified Importer.Msg as Msg -import qualified Importer.Gensym as Gensym -import Importer.Configuration hiding (getMonadInstance, getCustomTheory) -import qualified Importer.Configuration as Config (getMonadInstance) -import qualified Importer.Configuration as Config (getCustomTheory) -import Importer.Adapt (makeAdaptionTable_FromHsModule, extractHskEntries, - AdaptionTable, adaptGlobalEnv, adaptModules, Adaption(..)) -import qualified Importer.Ident_Env as Ident_Env -import qualified Importer.Preprocess as Preprocess -import qualified Importer.DeclDependencyGraph as DeclDependencyGraph - -import qualified Language.Haskell.Exts as Hsx -import qualified Importer.Hsx as Hsx -import qualified Importer.Isa as Isa - - -{-| - This is the main function of the conversion process; converts a Unit of Haskell - ASTs into a Unit of Isar/HOL ASTs. --} -convertHskUnit :: Customisations -> Bool -> Bool -> Bool -> Adaption -> HskUnit -> (AdaptionTable, IsaUnit) -convertHskUnit custs exportCode ignoreNotInScope absMutParams adapt (HskUnit hsmodules custMods initialGlobalEnv) - = let pragmass = map (accumulate (fold add_pragmas) . snd) hsmodules - hsmodules' = map (Preprocess.preprocessModule (usedConstNames adapt) . Hsx.fmapUnit . fst) hsmodules - env = Ident_Env.environmentOf custs hsmodules' custMods - adaptionTable = makeAdaptionTable_FromHsModule adapt env hsmodules' - initial_env = Ident_Env.augmentGlobalEnv initialGlobalEnv $ extractHskEntries adaptionTable - global_env_hsk = Ident_Env.unionGlobalEnvs env initial_env - - hskmodules = map (toHskModule ignoreNotInScope global_env_hsk) $ Hsx.zipMod hsmodules' - - isathys = Isa.retopologizeModule $ fst $ runConversion' custs adapt global_env_hsk $ - mapM (convertModule exportCode absMutParams) (zip pragmass hskmodules) - custThys = Map.elems custMods - adaptedEnv = adaptGlobalEnv adaptionTable global_env_hsk - isaunit = IsaUnit isathys custThys adaptedEnv - in - (adaptionTable, adaptIsaUnit adaptionTable global_env_hsk isaunit) - where - toHskModule :: Bool -> Ident_Env.GlobalE -> (Hsx.ModuleName (), Hsx.Module ()) -> HskModule - toHskModule ignoreNotInScope globalEnv (modul, Hsx.Module loc _ _ _ decls) = - HskModule loc modul ((map HskDependentDecls . DeclDependencyGraph.arrangeDecls ignoreNotInScope globalEnv modul) decls) - adaptIsaUnit adaptionTable globalEnv (IsaUnit modules custThys adaptedGlobalEnv) = - IsaUnit (adaptModules adaptionTable adaptedGlobalEnv globalEnv modules) custThys adaptedGlobalEnv - - -type Pragma = (String, [String]) - -permissive_pragma = "permissive" - -pragmas :: [String] -pragmas = [permissive_pragma] - -add_pragmas :: Hsx.UnknownPragma -> [Pragma] -> [Pragma] -add_pragmas (Hsx.UnknownPragma src line) = - case words line of - "HASKABELLE" : pragma -> - if null pragma then error ("empty pragma encountered at " ++ Hsx.srcspan2string src) - else let - directive : args = pragma - in if directive `elem` pragmas - then AList.map_default (directive, []) (fold insert args) - else error ("unknown pragma " ++ directive ++ " encountered at " ++ Hsx.srcspan2string src) - _ -> id - - --- The naming scheme "HsFoo" is treated as being owned by the parser --- libary Language.Haskell.Exts. We use "HskFoo" instead to --- differentiate between what's defined by us and by that library. --- --- (Ok, this might sound somewhat confusing, at least we're consistent --- about it.) - -data HskModule = HskModule () (Hsx.ModuleName ()) [HskDependentDecls] - deriving Show - -{-| - This data structure is supposed to collect function declarations - that depend mutually recursive on each other. --} -newtype HskDependentDecls = HskDependentDecls [Hsx.Decl ()] - deriving Show - -{-| - ??? --} -data Context = Context { - _theory :: Isa.ThyName, - _globalEnv :: Ident_Env.GlobalE, - _warnings :: [Warning], - _backtrace :: [String], - _adapt :: Adaption, - _monad :: Maybe MonadInstance } - -initContext adapt env = Context { - _theory = Isa.ThyName "Scratch", {- FIXME: Default Hsx.ModuleName in Haskell - is called `Main'; clashes with Isabelle. -} - _globalEnv = env, - _warnings = [], - _backtrace = [], - _adapt = adapt, - _monad = Nothing } - -{-| - Instead of accessing a record directly by their `_foo' slots, we - use the respective `foo' surrogate which consists of an appropriate - getter and setter -- which allows functions to both query and - update a record by slot name. --} -type FieldSurrogate field = (Context -> field, Context -> field -> Context) - -theory :: FieldSurrogate Isa.ThyName -theory = (_theory, \c f -> c { _theory = f }) -globalEnv :: FieldSurrogate Ident_Env.GlobalE -globalEnv = (_globalEnv, \c f -> c { _globalEnv = f }) -warnings :: FieldSurrogate [Warning] -warnings = (_warnings, \c f -> c { _warnings = f }) -backtrace :: FieldSurrogate [String] -backtrace = (_backtrace, \c f -> c { _backtrace = f }) -adapt :: FieldSurrogate Adaption -adapt = (_adapt, \c f -> c { _adapt = f }) -monad :: FieldSurrogate (Maybe MonadInstance) -monad = (_monad, \c f -> c { _monad = f }) - -currentModule :: FieldSurrogate (Hsx.ModuleName ()) -currentModule = (\c -> let (Isa.ThyName n) = _theory c in Hsx.ModuleName () n, \c f -> c) - -getMonadInstance :: String -> ContextM (Maybe MonadInstance) -getMonadInstance name = ask >>= (return . flip Config.getMonadInstance name) - -getMonadInstance' :: Hsx.Type () -> ContextM (Maybe MonadInstance) -getMonadInstance' ty = - case Hsx.typeConName . Hsx.returnType $ ty of - Nothing -> return Nothing - Just name -> getMonadInstance name - -withFunctionType :: Hsx.Type () -> ContextM a -> ContextM a -withFunctionType ty contextm = - do mbMon <- getMonadInstance' ty - withUpdatedContext monad (const mbMon) contextm - -withFunctionType' :: Maybe (Hsx.Type ()) -> ContextM a -> ContextM a -withFunctionType' mbTy contextm = - case mbTy of - Nothing -> contextm - Just ty -> withFunctionType ty contextm - -withPossibleLift :: Hsx.Exp () -> ContextM a -> ContextM a -withPossibleLift name contextm = - do mbMon <- queryContext monad - case mbMon of - Nothing -> contextm - Just mon -> - case varName name >>= getMonadLift mon of - Nothing -> contextm - newMon@(Just _) -> - withUpdatedContext monad (const newMon) contextm - where uname (Hsx.Qual _ _ n) = n - uname (Hsx.UnQual _ n) = n - sname (Hsx.Ident _ n) = n - sname (Hsx.Symbol _ n) = n - qname (Hsx.Var _ n) = Just n - qname _ = Nothing - varName = liftM sname . liftM uname . qname - -getCurrentMonadFunction :: Hsx.QName () -> ContextM (Hsx.QName ()) -getCurrentMonadFunction name = - do mbMon <- queryContext monad - case mbMon of - Nothing -> return name - Just mon -> - case name of - Hsx.Qual l mod uName -> return $ Hsx.Qual l mod (lookup mon uName) - Hsx.UnQual l uName -> return $ Hsx.UnQual l (lookup mon uName) - def -> return def - where lookup mon (Hsx.Ident l name) = Hsx.Ident l $ getMonadConstant mon name - lookup mon (Hsx.Symbol l name) = Hsx.Symbol l $ getMonadConstant mon name - -getCurrentMonadDoSyntax :: ContextM (Maybe DoSyntax) -getCurrentMonadDoSyntax = - do mbMon <- queryContext monad - case mbMon of - Nothing -> return Nothing - Just mon -> return . Just $ getMonadDoSyntax mon - - -{-| - The conversion process is done in this monad. --} -newtype ContextM v = ContextM (ReaderT Customisations (StateT Context Gensym.GensymM) v) - deriving (Monad, MonadState Context, Functor, Applicative, MonadReader Customisations) - -queryCustomisations = ask - -{-| - This function lifts a gensym computation to a context computation --} -liftGensym :: Gensym.GensymM a -> ContextM a -liftGensym = ContextM . lift . lift - -{-| - This function executes the given conversion with the given environment as - the context. --} -runConversion' :: Customisations -> Adaption -> Ident_Env.GlobalE -> ContextM v -> (v, Context) -runConversion' custs adapt env (ContextM m) = - Gensym.evalGensym Gensym.countInit $ runStateT (runReaderT m custs) (initContext adapt env) - -{-| - This function queries the given field in the context monad --} -queryContext :: (FieldSurrogate field) -> ContextM field -queryContext (query, _) - = do context <- get; return (query context) - -{-| - This function updates the given field in the context monad using the given function. --} -updateContext :: (FieldSurrogate field) -> (field -> field) -> ContextM () -updateContext (query, update) updateField - = do context <- get - put (update context (updateField (query context))) - return () - -{-| - This function changes the given field in the given context monad using the given - function. The original context is restored afterwards. --} -withUpdatedContext :: (FieldSurrogate field) -> (field -> field) -> ContextM a -> ContextM a -withUpdatedContext surrogate updateField body - = do oldval <- queryContext surrogate - updateContext surrogate updateField - result <- body - updateContext surrogate (\_ -> oldval) - return result - -{-| - This data structure is supposed to contain warning messages --} -newtype Warning = Warning String - deriving (Show, Eq, Ord) - -{-| - This function issues a warning in the current conversion monad. --} -warn :: String -> ContextM () -warn msg = updateContext warnings (\warnings -> warnings ++ [(Warning msg)]) - -{-| - This function quits the conversion with an error providing the given error - message. --} -die :: String -> ContextM t -die msg - = do backtrace <- queryContext backtrace - error $ msg ++ "\n\n" - ++ "Backtrace:\n" - ++ concat (map (++ "\n\n") (reverse backtrace)) - -{-| - This function quits the conversion with an error providing the given error - message and source location. --} -dieWithLoc :: (){-Hsx.SrcLoc-} -> String -> ContextM t -dieWithLoc loc msg - = do backtrace <- queryContext backtrace - error $ {-Hsx.srcloc2string loc ++ ": " ++-} msg ++ "\n\n" - ++ "Backtrace:\n" - ++ concat (map (++ "\n\n") (reverse backtrace)) -{-| - This function quits the conversion with an error that is due to a - pattern matching case that was observed but not anticipated. The object - causing this and an a string describing the context has to be provided. --} -pattern_match_exhausted :: (Show a) => String -> a -> ContextM t -pattern_match_exhausted str obj - = die (str ++ ": Pattern match exhausted for\n" ++ Msg.prettyShow obj) - - - -{-| - This function generates the auxiliary functions for the given Haskell - data type declaration. This includes accessor functions and update functions --} -generateRecordAux :: [Pragma] -> Hsx.Decl () -> ContextM [Isa.Stmt] -generateRecordAux pragmas (Hsx.DataDecl _loc _kind _context _declhead condecls _deriving) - = let strip (Hsx.QualConDecl _loc _FIXME _context decl) = decl - decls = map strip condecls - (tyconN, tyvarNs) = Hsx.split_declhead _declhead - in do tyvars <- mapM (convert pragmas) tyvarNs - let vs = map (rpair []) tyvars - tycon <- convert pragmas tyconN - let dataTy = Isa.Type tycon (map Isa.TVar tyvars) - let fieldNames = concatMap extrFieldNames decls - fields <- mapM (liftM fromJust . lookupIdentifier_Constant . Hsx.UnQual ()) (nub fieldNames) - let funBinds = map (mkAFunBinds (length decls) vs dataTy) fields - ++ map (mkUFunBinds (length decls) vs dataTy) fields - return funBinds - where extrFieldNames (Hsx.RecDecl _ conName fields) = map fst $ Hsx.flattenRecFields fields - extrFieldNames _ = [] - mkAFunBinds numCon vs dty (Ident_Env.Constant (Ident_Env.Field Ident_Env.LexInfo{Ident_Env.nameOf=fname, Ident_Env.typschemeOf=(_, fty)} constrs)) = - let binds = map (mkAFunBind fname) constrs - fname' = Isa.Name fname - funTy = Isa.Func dty (Ident_Env.toIsa fty) - in Isa.Function (Isa.Function_Stmt Isa.Primrec [Isa.TypeSign fname' vs funTy] binds) - mkAFunBind fname (Ident_Env.RecordConstr _ Ident_Env.LexInfo{Ident_Env.nameOf=cname} fields) = - let fname' = Isa.Name fname - con = Isa.Const $ Isa.Name cname - genArg (Ident_Env.RecordField n _) - | n == fname = Isa.Const (Isa.Name "x") - | otherwise = Isa.Const (Isa.Name "_") - conArgs = map genArg fields - pat = Isa.Parenthesized $ foldl Isa.App con conArgs - term = Isa.Const (Isa.Name "x") - in (fname', [pat], term) - mkUFunBinds numCon vs dty (Ident_Env.Constant (Ident_Env.Field Ident_Env.LexInfo{Ident_Env.nameOf=fname, Ident_Env.typschemeOf=(_, fty)} constrs)) = - let uname = "update_" ++ fname - binds = map (mkUFunBind fname uname) constrs - uname' = Isa.Name uname - funTy = Isa.Func (Ident_Env.toIsa fty) (Isa.Func dty dty) - in Isa.Function (Isa.Function_Stmt Isa.Primrec [Isa.TypeSign uname' vs funTy] binds) - mkUFunBind fname uname (Ident_Env.RecordConstr _ Ident_Env.LexInfo{Ident_Env.nameOf=cname} fields) = - let uname' = Isa.Name uname - con = Isa.Const $ Isa.Name cname - genPatArg (i,(Ident_Env.RecordField n _)) - | n == fname = Isa.Const (Isa.Name "_") - | otherwise = Isa.Const (Isa.Name ("f" ++ show i)) - genTermArg (i,(Ident_Env.RecordField n _)) - | n == fname = Isa.Const (Isa.Name "x") - | otherwise = Isa.Const (Isa.Name ("f" ++ show i)) - patArgs = map genPatArg (zip [1..] fields) - termArgs = map genTermArg (zip [1..] fields) - pat = Isa.Parenthesized $ foldl Isa.App con patArgs - term = Isa.Parenthesized $ foldl Isa.App con termArgs - arg = Isa.Const (Isa.Name "x") - in (uname', [arg,pat], term) - - -{-| - This function converts a Haskell data type declaration into a - Isabelle data type definition . --} -convertDataDecl :: [Pragma] -> Hsx.Decl () -> ContextM (Isa.TypeSpec, [(Isa.Name, [Isa.Type])]) -convertDataDecl pragmas (Hsx.DataDecl _loc _kind _context _declhead condecls _deriving) - = let strip (Hsx.QualConDecl _loc _FIXME _context decl) = decl - decls = map strip condecls - (tyconN, tyvarNs) = Hsx.split_declhead _declhead - in do tyvars <- mapM (convert pragmas) tyvarNs - tycon <- convert pragmas tyconN - decls' <- mapM cnvt decls - return $ (Isa.TypeSpec tyvars tycon, decls') - where cnvt (Hsx.ConDecl _ name types) - = do name' <- convert pragmas name - tyvars <- mapM (convert pragmas) types - return $ (name', tyvars) - cnvt (Hsx.RecDecl _ name fields) = - let types = map snd (Hsx.flattenRecFields fields) - in do name' <- convert pragmas name - tyvars <- mapM (convert pragmas) types - return $ (name', tyvars) - -{-| - Instances of this class constitute pairs of types s.t. the first one - (a Haskell entity) can be converted into the last one (an Isabelle entity). - - Instance declarations are supposed to implement 'convert'' instead of - 'convert'. The latter uses the first by adding further boilerplate code. --} -class Show a => Convert a b | a -> b where - convert' :: [Pragma] -> Convert a b => a -> ContextM b - convert :: [Pragma] -> Convert a b => a -> ContextM b - convert pragmas hsexpr = withUpdatedContext backtrace - (\bt -> let frameName = "frame" ++ show (length bt) - in Msg.prettyShow' frameName hsexpr : bt) - $ convert' pragmas hsexpr - -convertModule :: Bool -> Bool -> ([Pragma], HskModule) -> ContextM Isa.Module -convertModule exportCode absMutParams (pragmas, HskModule _loc modul dependentDecls) = - do - thy <- convert pragmas modul - env <- queryContext globalEnv - adaption <- queryContext adapt - custs <- queryCustomisations - let imps = filter (not . isStandardTheory (usedThyNames adaption)) (lookupImports thy env custs) - withUpdatedContext theory (\t -> assert (t == Isa.ThyName "Scratch") thy) - $ do - stmts <- mapsM (convertDependentDecls absMutParams pragmas) dependentDecls - return (Isa.retopologize (Isa.Module thy imps stmts exportCode)) - where isStandardTheory usedThyNames (Isa.ThyName n) = n `elem` usedThyNames - -lookupImports :: Isa.ThyName -> Ident_Env.GlobalE -> Customisations -> [Isa.ThyName] -lookupImports thy globalEnv custs - = map (rename .(\(Ident_Env.Import name _ _) -> Ident_Env.toIsa name)) - $ Ident_Env.lookupImports (Ident_Env.fromIsa thy) globalEnv - where rename orig@(Isa.ThyName name) = case Config.getCustomTheory custs (Hsx.ModuleName () name) of - Nothing -> orig - Just ct -> getCustomTheoryName ct - -convertDependentDecls :: Bool -> [Pragma] -> HskDependentDecls -> ContextM [Isa.Stmt] -convertDependentDecls _ pragmas (HskDependentDecls []) = - return [] -convertDependentDecls _ pragmas (HskDependentDecls [d]) = do - d <- convertDecl pragmas d - return d -convertDependentDecls absMutParams pragmas (HskDependentDecls decls@(decl:_)) - | isFunBind decl = assert (all isFunBind decls) - $ do funcmds <- mapsM (convertDecl pragmas) decls - let (kinds, sigs, eqs) = unzip3 (map splitFunCmd funcmds) - let kind = if any (== Isa.Function_Sorry) kinds then Isa.Function_Sorry else Isa.Fun - return [Isa.Function (Isa.Function_Stmt kind sigs (flat eqs))] - | otherwise = - let (decls', tydecls) = partition isDataDecl decls - decls'' = G.everywhere (G.mkT $ replaceTy (map (\t -> case t of Hsx.TypeDecl _ (Hsx.DHead _ i) ty -> ((i, Nothing), ty) - Hsx.TypeDecl _ (Hsx.DHApp _ (Hsx.DHead _ i) (Hsx.UnkindedVar _ i')) ty -> ((i, Just i'), ty)) tydecls)) decls' in - do - dataDefs <- mapM (convertDataDecl pragmas) decls'' - params' <- foldM (\res (Isa.TypeSpec params _, _) -> - if all (uncurry (==)) (zip res params) then - return $ if length res > length params then res else params - else - error Msg.unsupported_semantics_decl) - [] - dataDefs - auxCmds <- mapM (generateRecordAux pragmas) decls'' - tyDefs <- mapM (\x -> convertDependentDecls absMutParams pragmas $ HskDependentDecls [x]) tydecls - return (Isa.Datatype (map (let names = dataDefs - & map (\(Isa.TypeSpec _ name, _) -> name) - & Set.fromList in - \(tySpec, ty) -> ( replaceParamsTySpec params' names tySpec - , G.everywhere' (G.mkT $ replaceParamsTy (map Isa.TVar params') names) ty)) dataDefs) - : concat (auxCmds ++ tyDefs)) - where - isFunBind (Hsx.FunBind _ _) = True - isFunBind _ = False - isDataDecl (Hsx.DataDecl _ _ _ _ _ _) = True - isDataDecl _ = False - splitFunCmd (Isa.Function (Isa.Function_Stmt kind [sig] eqs)) = (kind, sig, eqs) - replaceTy :: [((Hsx.Name (), Maybe (Hsx.Name ())), Hsx.Type ())] -> Hsx.Type () -> Hsx.Type () - replaceTy tydecls t = case t of Hsx.TyCon _ (Hsx.UnQual _ i) -> maybe t id $ AList.lookup tydecls (i, Nothing) - Hsx.TyApp _ (Hsx.TyCon _ (Hsx.UnQual _ i)) (Hsx.TyVar _ i') -> maybe t id $ AList.lookup tydecls (i, Just i') - _ -> G.gmapT (G.mkT $ replaceTy tydecls) t - replaceParamsTySpec :: [Isa.Name] -> Set Isa.Name -> Isa.TypeSpec -> Isa.TypeSpec - replaceParamsTySpec params set t@(Isa.TypeSpec _ name) = if Set.member name set then Isa.TypeSpec params name else t - replaceParamsTy :: [Isa.Type] -> Set Isa.Name -> Isa.Type -> Isa.Type - replaceParamsTy params set (Isa.Type name t') = replaceParamsTy' (if absMutParams then params else t' ++ foldl (\params _ -> tail params) params t') set name (Isa.Type name (map (replaceParamsTy params set) t')) - replaceParamsTy params set (Isa.Func t1 t2) = Isa.Func (replaceParamsTy params set t1) (replaceParamsTy params set t2) - replaceParamsTy params set t@(Isa.TVar name) = replaceParamsTy' params set name t - replaceParamsTy params set Isa.NoType = Isa.NoType - replaceParamsTy' params set name t = if Set.member name set then Isa.Type name params else t - - -instance Convert (Hsx.Module ()) Isa.Stmt where - convert' pragmas (Hsx.Module loc _ _ _ _) - = dieWithLoc loc "Internal Error: Each Hsx.Module should have been pre-converted to HskModule." - - ---- Trivially convertable stuff. - -instance Convert (Hsx.ModuleName ()) Isa.ThyName where - convert' pragmas m = return (Ident_Env.toIsa (Ident_Env.fromHsk m :: Ident_Env.ModuleID)) - -instance Convert (Hsx.Name ()) Isa.Name where - convert' pragmas n = return (Ident_Env.toIsa (Ident_Env.fromHsk n :: Ident_Env.Name)) - -instance Convert (Hsx.QName ()) Isa.Name where - convert' pragmas qn = return (Ident_Env.toIsa (Ident_Env.fromHsk qn :: Ident_Env.Name)) - -instance Convert (Hsx.Type ()) Isa.Type where - convert' pragmas t @ (Hsx.TyForall _ _ _ _) = pattern_match_exhausted "Hsx.Type () -> Isa.Type" t - convert' pragmas t = return (Ident_Env.toIsa (Ident_Env.fromHsk t :: Ident_Env.Type)) - -instance Convert (Hsx.TyVarBind ()) Isa.Name where - convert' pragmas (Hsx.KindedVar _ n _) = convert' pragmas n - convert' pragmas (Hsx.UnkindedVar _ n) = convert' pragmas n - -convert_type_sign :: Hsx.Name () -> Hsx.Type () -> Isa.TypeSign -convert_type_sign n typ = - let - n' = Ident_Env.toIsa (Ident_Env.fromHsk n :: Ident_Env.Name) - (e_vs, e_typ) = Ident_Env.typscheme_of_hsk_typ typ - vs' = map (\(v, sort) -> (Ident_Env.toIsa v, Ident_Env.isa_of_sort sort)) e_vs - typ' = Ident_Env.toIsa e_typ - in Isa.TypeSign n' vs' typ' - -instance Convert (Hsx.QOp ()) Isa.Term where - convert' pragmas (Hsx.QVarOp _ qname) = do qname' <- convert pragmas qname; return (Isa.Const qname') - convert' pragmas (Hsx.QConOp _ qname) = do qname' <- convert pragmas qname; return (Isa.Const qname') - -- convert' junk = pattern_match_exhausted "Hsx.QOp () -> Isa.Term" junk - -instance Convert (Hsx.Op ()) Isa.Name where - convert' pragmas (Hsx.VarOp _ qname) = convert pragmas qname - convert' pragmas (Hsx.ConOp _ qname) = convert pragmas qname - -- convert' junk = pattern_match_exhausted "HsOp -> Isa.Name" junk - -instance Convert (Hsx.Literal ()) Isa.Literal where - convert' pragmas (Hsx.Int _ i _) = return (Isa.Int i) - convert' pragmas (Hsx.Char _ ch _) = return (Isa.Char ch) - convert' pragmas (Hsx.String _ str _) = return (Isa.String str) - convert' pragmas junk = pattern_match_exhausted "HsLiteral -> Isa.Literal" junk - - ---- Not so trivially convertable stuff. - -convertDecl :: [Pragma] -> Hsx.Decl () -> ContextM [Isa.Stmt] -convertDecl pragmas (Hsx.TypeDecl _loc _declhead typ) - = let (tyconN, tyvarNs) = Hsx.split_declhead _declhead in - do tyvars <- mapM (convert pragmas) tyvarNs - tycon <- convert pragmas tyconN - typ' <- convert pragmas typ - return [Isa.TypeSynonym [(Isa.TypeSpec tyvars tycon, typ')]] - -convertDecl pragmas decl@(Hsx.DataDecl _ _ _ _ _ _) = - do dataDef <- convertDataDecl pragmas decl - accCmds <- generateRecordAux pragmas decl - return (Isa.Datatype [dataDef] : accCmds) - -convertDecl pragmas (Hsx.InfixDecl _loc assoc prio ops) - = do (assocs, prios) <- mapAndUnzipM (lookupInfixOp . toQOp) ops - assert (all (== assoc) assocs && all (== prio) prios) - $ return [] - where toQOp (Hsx.VarOp _ n) = Hsx.QVarOp () (Hsx.UnQual () n) - toQOp (Hsx.ConOp _ n) = Hsx.QConOp () (Hsx.UnQual () n) - -convertDecl pragmas (Hsx.TypeSig _loc names typ) - = do globalEnv <- queryContext globalEnv - modul <- queryContext currentModule - types <- liftM catMaybes $ mapM (lookupType . Hsx.UnQual ()) names - assert (all (== typ) types) - $ return [] - - -- Remember that at this stage there are _no_ local declarations in the Hsx - -- AST anymore, as we made those global during the preprocessing stage. - -- - -- E.g. fun g0 :: "Int => Int" - -- g0 :: Int -> Int where - -- f :: Int -> Int g0 0 = 0 "g0 0 = 0" - -- f x = g x g0 n = n + g0 (n-1) | "g0 n = n + g0 (n - 1)" - -- where g :: Int -> Int ==> ==> - -- g 0 = 0 f :: Int -> Int fun f :: "Int => Int" - -- g n = n + g (n-1) f x = g0 x where - -- "f x = g0 x" - -- -convertDecl pragmas (Hsx.FunBind _ matchs) - = do let (names, patterns, bodies, wbinds) = unzip4 (map splitMatch matchs) - assert (all (== head names) (tail names)) (return ()) - assert (all Preprocess.isEmptyBinds wbinds) (return ()) -- all decls are global at this point. - ftype <- lookupType (Hsx.UnQual () (names !! 0)) -- as all names are equal, pick first one. - let name = names !! 0 - name' <- convert' pragmas name - let n = name_of name - let kind = if n `elem` these (lookup permissive_pragma pragmas) - then Isa.Function_Sorry else Isa.Fun - let fsig' = case ftype of { - Nothing -> Isa.TypeSign name' [] Isa.NoType; - Just typ -> convert_type_sign name typ } - patsNames <- mapM (mapM (convert pragmas)) patterns - let patsNames' = map unzip patsNames - patterns' = map fst patsNames' - aliases = map (concat.snd) patsNames' - bodies' <- withFunctionType' ftype $ - mapM (convert pragmas) bodies - let bodies'' = zipWith mkSimpleLet aliases bodies' - thy <- queryContext theory - return [Isa.Function (Isa.Function_Stmt kind [fsig'] - (zip3 (repeat (Isa.name_of_type_sign fsig')) patterns' bodies''))] - where splitMatch (Hsx.Match _loc name patterns (Hsx.UnGuardedRhs _ body) wherebind) - = (name, patterns, body, wherebind) - splitMatch (Hsx.InfixMatch _loc pattern name patterns (Hsx.UnGuardedRhs _ body) wherebind) - = (name, pattern : patterns, body, wherebind) - name_of (Hsx.Ident _ n) = n - name_of _ = "" - -convertDecl pragmas (Hsx.PatBind loc pattern rhs _wherebinds) - = case pattern of - pat@(Hsx.PVar _ name) - -> do name' <- convert pragmas name - (pat', aliases) <- convert pragmas pat - rhs' <- convert pragmas rhs - let rhs'' = mkSimpleLet aliases rhs' - ftype <- lookupType (Hsx.UnQual () name) - let sig' = case ftype of { - Nothing -> Isa.TypeSign name' [] Isa.NoType; - Just typ -> convert_type_sign name typ } - return [Isa.Function (Isa.Function_Stmt Isa.Definition [sig'] [(name', [], rhs'')])] - _ -> dieWithLoc loc (Msg.complex_toplevel_patbinding) - -convertDecl pragmas decl@(Hsx.ClassDecl _ ctx declhead _ class_decls) - = check_class_decl decl - $ do let (classN, _) = Hsx.split_declhead declhead - let superclassNs = Hsx.extractSuperclassNs ctx - superclassNs' <- mapM (convert pragmas) superclassNs - classN' <- convert pragmas classN - typesigs' <- mapsM convertToTypeSig $ class_decls_list class_decls - return [Isa.Class classN' superclassNs' typesigs'] - where - class_decls_list Nothing = [] - class_decls_list (Just l) = l - check_class_decl (Hsx.ClassDecl loc ctx declhead fundeps decls) cont - | length (snd $ Hsx.split_declhead declhead) /= 1 = dieWithLoc loc (Msg.only_one_tyvar_in_class_decl) - | not (null fundeps) = dieWithLoc loc (Msg.no_fundeps_in_class_decl) - | not (all isTypeSig $ class_decls_list decls) = dieWithLoc loc (Msg.no_default_methods_in_class_decl) - | otherwise = cont - isTypeSig decl = case decl of - Hsx.ClsDecl _ (Hsx.TypeSig _ _ _) -> True - _ -> False - convertToTypeSig (Hsx.ClsDecl _ (Hsx.TypeSig _ names typ)) - = do names' <- mapM (convert pragmas) names - typ' <- convert pragmas typ {-FIXME-} - return (map (\name' -> Isa.TypeSign name' [] typ') names') - -convertDecl pragmas (Hsx.InstDecl loc _ instrule (Just stmts)) = - case get_instrule instrule of - (_, ctx, insthead) -> - case Hsx.split_insthead insthead of - (cls, [typ]) -> - do - cls' <- convert pragmas cls - typ' <- convert pragmas typ - case dest_typ_tvars typ' of - Nothing -> dieWithLoc loc Msg.only_simple_instantiations - Just (tyco', vs') -> do - raw_arities <- mapM (convert_arity) (case ctx of Nothing -> [] ; Just ctx -> Hsx.dest_typcontext ctx) - let arities' = AList.make (the . AList.lookup raw_arities) vs'; - identifier <- lookupIdentifier_Type cls - let classinfo = case fromJust identifier of - Ident_Env.TypeDecl (Ident_Env.Class _ classinfo) -> classinfo - t -> error $ "found:\n" ++ show t - let methods = Ident_Env.methodsOf classinfo - let classVarN = Ident_Env.classVarOf classinfo - let inst_envtype = Ident_Env.fromHsk typ - let tyannots = map (mk_method_annotation classVarN inst_envtype) methods - withUpdatedContext globalEnv (\e -> Ident_Env.augmentGlobalEnv e tyannots) $ - do stmts' <- mapsM (convertDecl pragmas) (map toHsDecl stmts) - let fun_stmts' = map (\(Isa.Function fun_stmt) -> fun_stmt) stmts' - return [Isa.Instance cls' tyco' arities' fun_stmts'] - where - dest_typ_tvars (Isa.Type tyco typs) = case perhaps_map dest_tvar typs of - Nothing -> Nothing - Just vs -> Just (tyco, vs) - dest_typ_tvars _ = Nothing - dest_tvar (Isa.TVar v) = Just v - dest_tvar _ = Nothing - convert_arity (v, sort) = do - v' <- convert pragmas v - sort' <- mapM (convert pragmas) sort - return (v', sort') - toHsDecl (Hsx.InsDecl _ decl) = decl - mk_method_annotation :: Ident_Env.Name -> Ident_Env.Type -> Ident_Env.Identifier -> Ident_Env.Identifier - mk_method_annotation tyvarN tycon class_method_annot - = assert (Ident_Env.isTypeAnnotation class_method_annot) - $ let lexinfo = Ident_Env.lexInfoOf class_method_annot - (_, typ) = Ident_Env.typschemeOf lexinfo - typ' = Ident_Env.substituteTyVars [(Ident_Env.TyVar tyvarN, tycon)] typ - in Ident_Env.Constant (Ident_Env.TypeAnnotation (lexinfo { Ident_Env.typschemeOf = ([], typ') })) - _ -> dieWithLoc loc (Msg.only_one_tyvar_in_class_decl) - - -convertDecl pragmas junk = pattern_match_exhausted "Hsx.Decl () -> Isa.Stmt" junk - - -get_instrule (Hsx.IRule _ t c h) = (t, c, h) -get_instrule (Hsx.IParen _ r) = get_instrule r - -instance Convert (Hsx.Binds ()) [Isa.Stmt] where - convert' pragmas (Hsx.BDecls _ decls) = mapsM (convertDecl pragmas) decls - convert' pragmas junk = pattern_match_exhausted "Hsx.Binds () -> Isa.Stmt" junk - -mkList :: [Isa.Term] -> Isa.Term -mkList = foldr - (\x xs -> Isa.App (Isa.App (Isa.Const (Isa.Name "List.Cons")) x) xs) - (Isa.Const (Isa.Name "List.Nil")) - -mkSimpleLet :: [(Isa.Name, Isa.Term)] -> Isa.Term -> Isa.Term -mkSimpleLet [] body = body -mkSimpleLet binds body = Isa.Let binds' body - where binds' = map (\(a,b) -> (Isa.Const a, b)) binds - -type PatternE = Bool -type PatternO = [(Isa.Name,Isa.Term)] - -newtype PatternM a = PatternM ((ReaderT PatternE (WriterT PatternO ContextM)) a) - deriving (Monad, MonadReader PatternE, MonadWriter PatternO, Functor, Applicative) - -runPatternM :: PatternM a -> ContextM (a,PatternO) -runPatternM (PatternM pm) = (runWriterT (runReaderT pm False)) - -liftConvert :: ContextM a -> PatternM a -liftConvert = PatternM . lift . lift - -withAsPattern :: PatternM a -> PatternM a -withAsPattern = local (const True) - -isInsideAsPattern :: PatternM Bool -isInsideAsPattern = ask - -addAlias :: (Isa.Name, Isa.Term) -> PatternM () -addAlias = tell . (:[]) - -convertPat :: [Pragma] -> Hsx.Pat () -> PatternM Isa.Pat -convertPat pragmas (Hsx.PVar _ name) = - do name' <- liftConvert $ convert pragmas name - return (Isa.Const name') -convertPat pragmas (Hsx.PLit _ (Hsx.Signless _) lit) = - do lit' <- liftConvert $ convert pragmas lit - return (Isa.Literal lit') - -convertPat pragmas infixapp@Hsx.PInfixApp{} = - do (Hsx.PInfixApp _ p1 qname p2) <- liftConvert $ fixOperatorFixities' infixapp - p1' <- convertPat pragmas p1 - qname' <- liftConvert $ convert pragmas qname - p2' <- convertPat pragmas p2 - return (Isa.App (Isa.App (Isa.Const qname') p1') p2') - -convertPat pragmas (Hsx.PApp _ qname pats) = - do qname' <- liftConvert $ convert pragmas qname - pats' <- mapM (convertPat pragmas) pats - return $ foldl Isa.App (Isa.Const qname') pats' - -convertPat pragmas (Hsx.PTuple _ Hsx.Boxed comps) = - convertPat pragmas (foldr Hsx.hskPPair (Hsx.PParen () (last comps)) (init comps)) - -convertPat pragmas (Hsx.PList _ []) = - do list_datacon_name <- liftConvert $ convert pragmas (Hsx.Special () (Hsx.ListCon ())) - return (Isa.Const list_datacon_name) - -convertPat pragmas (Hsx.PList _ els) = - convertPat pragmas $ foldr Hsx.hskPCons Hsx.hskPNil els - -convertPat pragmas (Hsx.PParen _ pat) = - do pat' <- convertPat pragmas pat - return (Isa.Parenthesized pat') - -convertPat pragmas (Hsx.PRec _ qname fields) = - do mbConstr <- liftConvert $ lookupIdentifier_Constant qname - case mbConstr of - Just (Ident_Env.Constant (Ident_Env.Constructor (Ident_Env.RecordConstr _ _ recFields))) -> - do isAs <- isInsideAsPattern - let fields' = map (\(Hsx.PFieldPat _ name pat) -> (Ident_Env.fromHsk name, pat)) fields - toSimplePat (Ident_Env.RecordField iden _) = - case lookup iden fields' of - Nothing -> if isAs - then liftConvert . liftGensym . liftM Isa.Const . liftM Isa.Name $ - Gensym.gensym "a" - else return (Isa.Const (Isa.Name "_")) - Just pat -> convertPat pragmas pat - recArgs <- mapM toSimplePat recFields - qname' <- liftConvert $ convert pragmas qname - return $ Isa.Parenthesized (foldl Isa.App (Isa.Const qname') recArgs) - _ -> liftConvert . die $ "Record constructor " ++ Msg.quote qname ++ " is not declared in environment!" - -convertPat pragmas (Hsx.PAsPat _ name pat) = - do name' <- liftConvert $ convert pragmas name - pat' <- withAsPattern $ convertPat pragmas pat - addAlias (name', pat') - return pat' -convertPat pragmas (Hsx.PWildCard _) = - do isAs <- isInsideAsPattern - if isAs - then liftConvert . liftGensym . liftM Isa.Const . liftM Isa.Name $ - Gensym.gensym "a" - else return (Isa.Const (Isa.Name "_")) - -convertPat pragmas junk = liftConvert $ pattern_match_exhausted - "Hsx.Pat () -> Isa.Term" - junk -instance Convert (Hsx.Pat ()) (Isa.Pat, [(Isa.Name, Isa.Term)]) where - convert' pragmas = runPatternM . convertPat pragmas - -instance Convert (Hsx.Rhs ()) Isa.Term where - convert' pragmas (Hsx.UnGuardedRhs _ exp) = convert pragmas exp - -- convert (Hsx.GuardedRhss rhss) ; FIXME - convert' pragmas junk = pattern_match_exhausted "Hsx.Rhs () -> Isa.Term" junk - -instance Convert (Hsx.FieldUpdate ()) (Isa.Name, Isa.Term) where - convert' pragmas (Hsx.FieldUpdate _ qname exp) - = do qname' <- convert pragmas qname - exp' <- convert pragmas exp - return (qname', exp') - -instance Convert (Hsx.Alt ()) (Isa.Term, Isa.Term) where - convert' pragmas (Hsx.Alt _loc pat (Hsx.UnGuardedRhs _ exp) _wherebinds) - = do (pat',aliases) <- convert pragmas pat - exp' <- convert pragmas exp - let exp'' = mkSimpleLet aliases exp' - return (pat', exp'') - convert' pragmas junk - = pattern_match_exhausted "Hsx.Alt () -> (Isa.Term, Isa.Term)" junk - - -instance Convert (Hsx.Exp ()) Isa.Term where - convert' pragmas (Hsx.Lit _ lit) = convert pragmas lit >>= (\l -> return (Isa.Literal l)) - convert' pragmas (Hsx.Var _ qname) = - do qname' <- getCurrentMonadFunction qname - convert pragmas qname' >>= (\n -> return (Isa.Const n)) - convert' pragmas (Hsx.Con _ qname) = convert pragmas qname >>= (\n -> return (Isa.Const n)) - convert' pragmas (Hsx.Paren _ exp) = convert pragmas exp >>= (\e -> return (Isa.Parenthesized e)) - -- convert' (Hsx.WildCard _) = return (Isa.Const (Isa.Name "_")) - convert' pragmas (Hsx.NegApp _ exp) = convert pragmas (Hsx.hsk_negate exp) - - convert' pragmas (Hsx.List _ []) = do - list_datacon_name <- convert pragmas (Hsx.Special () (Hsx.ListCon ())) - return (Isa.Const list_datacon_name) - convert' pragmas (Hsx.List _ exps) - = convert pragmas $ foldr Hsx.hsk_cons Hsx.hsk_nil exps - - -- We have to wrap the last expression in an explicit HsParen as that last - -- expression may itself be a pair. If we didn't, we couldn't distinguish - -- between "((1,2), (3,4))" and "((1,2), 3, 4)" afterwards anymore. - convert' pragmas (Hsx.Tuple _ Hsx.Boxed exps) = convert pragmas (foldr Hsx.hsk_pair (Hsx.Paren () (last exps)) (init exps)) - - convert' pragmas (Hsx.App _ exp1 exp2) - = do exp1' <- convert pragmas exp1 - exp2' <- withPossibleLift exp1 $ convert pragmas exp2 - return (Isa.App exp1' exp2') - - convert' pragmas infixapp@(Hsx.InfixApp _ _ _ _) - = do (Hsx.InfixApp _ exp1 op exp2) <- fixOperatorFixities infixapp - exp1' <- convert pragmas exp1 - op' <- convert pragmas op - exp2' <- if isApp op - then withPossibleLift exp1 $ convert pragmas exp2 - else convert pragmas exp2 - return (mkInfixApp exp1' op' exp2') - where - uname (Hsx.Qual _ _ n) = n - uname (Hsx.UnQual _ n) = n - isApp (Hsx.QVarOp _ qname) = - case uname qname of - Hsx.Ident _ _ -> False - Hsx.Symbol _ sym -> sym == "$" - isApp _ = False - mkInfixApp t1 op t2 = Isa.App (Isa.App op t1) t2 - - convert' pragmas (Hsx.LeftSection _ e qop) - = do e' <- convert pragmas e - qop' <- convert pragmas qop - g <- liftGensym (Gensym.genIsaName (Isa.Name "arg")) - return (makeAbs [g] $ Isa.App (Isa.App qop' e') (Isa.Const g)) - - convert' pragmas (Hsx.RightSection _ qop e) - = do e' <- convert pragmas e - qop' <- convert pragmas qop - g <- liftGensym (Gensym.genIsaName (Isa.Name "arg")) - return (makeAbs [g] $ Isa.App (Isa.App qop' (Isa.Const g)) e') - - convert' pragmas (Hsx.RecConstr _ qname updates) = - do mbConstr <- lookupIdentifier_Constant qname - case mbConstr of - Just (Ident_Env.Constant (Ident_Env.Constructor (Ident_Env.RecordConstr _ _ recFields))) -> - let updates' = map (\(Hsx.FieldUpdate _ name exp) -> (Ident_Env.fromHsk name, exp)) updates - toSimplePat (Ident_Env.RecordField iden _) = - case lookup iden updates' of - Nothing -> Hsx.Var () (Hsx.UnQual () (Hsx.Ident () "undefined")) - Just exp -> exp - recArgs = map toSimplePat recFields - in convert' pragmas $ foldl (Hsx.App ()) (Hsx.Con () qname) recArgs - _ -> die $ "Record constructor " ++ Msg.quote qname ++ " is not declared in environment!" - - convert' pragmas (Hsx.RecUpdate _ exp updates) = - do exp' <- convert pragmas exp - fstupd:upds <- mapM convUpd updates - let updateFunction = Isa.Parenthesized (foldr comp fstupd upds) - return $ Isa.App updateFunction exp' - where comp a b = Isa.App (Isa.App (Isa.Const (Isa.Name "\\<circ>" {- FIXME use a lookup in the adaption table instead of the raw string -})) a) b - convUpd (Hsx.FieldUpdate _ fname fexp) = - do fexp' <- convert pragmas fexp - let ufun = Isa.Const (Isa.Name ("update_" ++ unqual fname)) - return $ Isa.App ufun fexp' - unqual (Hsx.Qual _ _ n) = uname n - unqual (Hsx.UnQual _ n) = uname n - uname (Hsx.Ident _ n) = n - uname (Hsx.Symbol _ n) = n - - convert' pragmas (Hsx.If _ t1 t2 t3) - = do t1' <- convert pragmas t1; t2' <- convert pragmas t2; t3' <- convert pragmas t3 - return (Isa.If t1' t2' t3') - - convert' pragmas (Hsx.Case _ exp alts) - = do exp' <- convert pragmas exp - alts' <- mapM (convert pragmas) alts - return $ Isa.Case exp' alts' - - convert' pragmas x@(Hsx.Lambda _loc pats body) - = do patsNames <- mapM (convert pragmas) pats - let (pats', aliases) = unzip patsNames - aliases' = concat aliases - body' <- convert pragmas body - let body'' = mkSimpleLet aliases' body' - if all isConst pats' then return $ makeAbs [n | Isa.Const n <- pats'] body'' - else makePatternMatchingAbs pats' body'' - where isConst (Isa.Const _) = True - isConst _ = False - - convert' pragmas expr@(Hsx.Let _ (Hsx.BDecls _ bindings) body) - = let (_, patbindings) = partition isTypeSig bindings - in assert (all isPatBinding patbindings) - $ do let (pats, rhss) = unzip (map (\(Hsx.PatBind _ pat rhs _) -> (pat, rhs)) patbindings) - patsNames <- mapM (convert pragmas) pats - let (pats', aliases) = unzip patsNames - rhss' <- mapM (convert pragmas) rhss - let rhss'' = zipWith mkSimpleLet aliases rhss' - body' <- convert pragmas body - return (Isa.Let (zip pats' rhss'') body') - where isTypeSig (Hsx.TypeSig _ _ _) = True - isTypeSig _ = False - isPatBinding (Hsx.PatBind _ _ _ (Just (Hsx.BDecls _ []))) = True - isPatBinding (Hsx.PatBind _ _ _ Nothing) = True - isPatBinding _ = False - - convert' pragmas (Hsx.ListComp _ e stmts) - = do e' <- convert pragmas e - stmts' <- liftM concat $ mapM convertListCompStmt stmts - return (Isa.ListCompr e' stmts') - where convertListCompStmt (Hsx.QualStmt _ (Hsx.Qualifier _ b)) = convert pragmas b >>= (return . (:[]) . Isa.Guard) - convertListCompStmt (Hsx.QualStmt _ (Hsx.Generator _ p e)) = do - (p',as) <- convert pragmas p - let gens = mkSimpleGens as - e' <- convert pragmas e - return $ [Isa.Generator (p', e')] ++ gens - convertListCompStmt _ - = die "Such statements not supported in List Comprehensions." - mkSimpleGens = map (\(n,t) -> Isa.Generator (Isa.Const n, mkList [t])) - convert' pragmas (Hsx.Do _ stmts) - = do isaStmts <- liftM concat $ mapM (convert pragmas) stmts - mbDo <- getCurrentMonadDoSyntax - case mbDo of - Nothing -> die "Do syntax is used without sufficient type information!" - Just (DoParen pre post) -> - return $ Isa.DoBlock pre isaStmts post - - convert' pragmas junk = pattern_match_exhausted "Hsx.Exp () -> Isa.Term" junk - -instance Convert (Hsx.Stmt ()) [Isa.DoBlockFragment] where - - convert' pragmas (Hsx.Generator _ pat exp) = - do exp' <- convert pragmas exp - (pat', aliases) <- convert pragmas pat - aliases' <- mkDoLet pragmas aliases - return (Isa.DoGenerator pat' exp' : aliases') - convert' pragmas (Hsx.Qualifier _ exp) = liftM ( (:[]) . Isa.DoQualifier) (convert pragmas exp) - convert' pragmas (Hsx.LetStmt _ binds) = - case binds of - Hsx.BDecls _ [Hsx.PatBind _ pat (Hsx.UnGuardedRhs _ exp) _] -> - do exp' <- convert pragmas exp - (pat', aliases) <- convert pragmas pat - aliases' <- mkDoLet pragmas aliases - ret <- mkReturn pragmas - return (Isa.DoGenerator pat' (Isa.App ret exp') : aliases') - -- liftM2 Isa.DoGenerator (convert pat) (convert (Hsx.App (Hsx.Var (Hsx.UnQual (Hsx.Ident "return"))) exp)) - def -> pattern_match_exhausted "Hsx.Stmt -> Isa.DoBlockFragment" def - -mkReturn :: [Pragma] -> ContextM Isa.Term -mkReturn pragmas = convert pragmas . Hsx.Var () . Hsx.UnQual () .Hsx.Ident () $ "return" - -mkDoLet :: [Pragma] -> [(Isa.Name, Isa.Term)] -> ContextM [Isa.DoBlockFragment] -mkDoLet pragmas aliases = - do ret <- mkReturn pragmas - let mkSingle (name, term) = Isa.DoGenerator (Isa.Const name) (Isa.App ret term) - return $ map mkSingle aliases - -{-| - We desugare lambda expressions to true unary functions, i.e. to - lambda expressions binding only one argument. - -} -makeAbs :: [Isa.Name] -> Isa.Term -> Isa.Term -makeAbs varNs body - = assert (not (null varNs)) $ foldr Isa.Abs body varNs - -{-| - Since HOL doesn't have true n-tuple constructors (it uses nested - pairs to represent n-tuples), we simply return a lambda expression - that takes n parameters and constructs the nested pairs within its - body. - -} - -makeTupleDataCon :: [Pragma] -> Int -> ContextM Isa.Term -makeTupleDataCon pragmas n -- n < 2 cannot happen (cf. Language.Haskell.Exts.Hsx.TupleCon) - = assert (n > 2) $ -- n == 2, i.e. pairs, can and are dealt with by usual conversion. - do argNs <- mapM (liftGensym . Gensym.genHsQName) (replicate n (Hsx.UnQual () (Hsx.Ident () "arg"))) - args <- return (map (Hsx.Var ()) argNs) - argNs' <- mapM (convert pragmas) argNs - args' <- convert pragmas (Hsx.Tuple () Hsx.Boxed args) - return $ Isa.Parenthesized (makeAbs argNs' args') - where pair x y = Hsx.App () (Hsx.App () (Hsx.Con () (Hsx.Special () (Hsx.TupleCon () Hsx.Boxed 2))) x) y - -{-| - HOL does not support pattern matching directly within a lambda - expression, so we transform a @Hsx.Abs pat1 pat2 .. patn -> body@ to - - @ - Isa.Abs g1 . - Isa.Case g1 of pat1' => - Isa.Abs g2 . - Isa.Case g2 of pat2' => ... => Isa.Abs gn . - Isa.Case gn of patn' => body' - @ - where @g1@, ..., @gn@ are fresh identifiers. --} -makePatternMatchingAbs :: [Isa.Pat] -> Isa.Term -> ContextM Isa.Term -makePatternMatchingAbs patterns theBody - = foldM mkMatchingAbs theBody (reverse patterns) -- foldM is a left fold. - where mkMatchingAbs body pat - = do g <- liftGensym (Gensym.genIsaName (Isa.Name "arg")) - return $ Isa.Abs g (Isa.Case (Isa.Const g) [(pat, body)]) - - -makeRecordCmd :: [Pragma] -> Hsx.Name () -- ^type constructor - -> [Hsx.Name ()] -- ^type variable arguments to the constructor - -> [Hsx.ConDecl ()] -- ^a singleton list containing a record declaration - -> ContextM Isa.Stmt -- ^the resulting record declaration -makeRecordCmd pragmas tyconN tyvarNs [Hsx.RecDecl _ name slots] -- cf. `isRecDecls' - = do tycon <- convert pragmas tyconN - tyvars <- mapM (convert pragmas) tyvarNs - slots' <- mapsM cnvSlot slots - return $ Isa.Record (Isa.TypeSpec tyvars tycon) slots' - where cnvSlot (Hsx.FieldDecl _ names typ) - = do names' <- mapM (convert pragmas) names - typ' <- convert pragmas typ - return (zip names' (cycle [typ'])) - - -{-| - Hsx parses every infix application simply from left to right without - taking operator associativity or binding priority into account. So - we gotta fix that up ourselves. (We also properly consider infix - declarations to get user defined operator right.) --} -fixOperatorFixities :: Hsx.Exp () -> ContextM (Hsx.Exp ()) - --- Notice that `1 * 2 + 3 / 4' is parsed as `((1 * 2) + 3) / 4', i.e. --- --- Hsx.InfixApp (Hsx.InfixApp (Hsx.InfixApp 1 * 2) + 3) / 4 --- --- whereas `1 * 2 + (3 / 4)' is parsed as --- --- Hsx.InfixApp (Hsx.InfixApp 1 * 2) + (HsParen (Hsx.InfixApp 3 / 4)) --- --- and `1 * (2 + 3) / 4' is parsed as --- --- Hsx.InfixApp (Hsx.InfixApp 1 (HsParen (Hsx.InfixApp 2 + 3))) / 4 --- --- Thus we _know_ that the second operand of an infix application, --- i.e. the e2 in `Hsx.InfixApp e1 op e2', can _never_ be a bare infix --- application that we might have to consider during fixup. --- -fixOperatorFixities app@(Hsx.InfixApp _ (Hsx.InfixApp _ e1 op1 e2) op2 e3) - -- We assume that `(e1, op1, e2)' is correct already - -- and from above, we also know that `e3' cannot possibly - -- interfere, so we just have to find the proper place of `op2'. - = do (assoc1', prio1) <- lookupInfixOp op1 - (assoc2', prio2) <- lookupInfixOp op2 - let assoc1 = normalizeAssociativity assoc1' - let assoc2 = normalizeAssociativity assoc2' - case prio1 `compare` prio2 of - GT -> return app - LT -> liftM (Hsx.InfixApp () e1 op1) (fixOperatorFixities (Hsx.InfixApp () e2 op2 e3)) - EQ -> if assoc2 /= assoc1 then - die (Msg.assoc_mismatch op1 assoc1 op2 assoc2) - else case assoc2 of - Hsx.AssocLeft _ -> return app - Hsx.AssocRight _ -> return (Hsx.InfixApp () e1 op1 (Hsx.InfixApp () e2 op2 e3)) - Hsx.AssocNone _ -> die ("fixupOperatorFixities: Internal error " ++ - "(AssocNone should have already been normalized away.)") -fixOperatorFixities nonNestedInfixApp = return nonNestedInfixApp - - -{-| - Hsx parses every infix application simply from left to right without - taking operator associativity or binding priority into account. So - we gotta fix that up ourselves. (We also properly consider infix - declarations to get user defined operator right.) --} -fixOperatorFixities' :: Hsx.Pat () -> ContextM (Hsx.Pat ()) -fixOperatorFixities' app@(Hsx.PInfixApp _ (Hsx.PInfixApp _ e1 op1 e2) op2 e3) - = do (assoc1', prio1) <- lookupInfixOpName op1 - (assoc2', prio2) <- lookupInfixOpName op2 - let assoc1 = normalizeAssociativity assoc1' - let assoc2 = normalizeAssociativity assoc2' - case prio1 `compare` prio2 of - GT -> return app - LT -> liftM (Hsx.PInfixApp () e1 op1) (fixOperatorFixities' (Hsx.PInfixApp () e2 op2 e3)) - EQ -> if assoc2 /= assoc1 then - die (Msg.assoc_mismatch op1 assoc1 op2 assoc2) - else case assoc2 of - Hsx.AssocLeft _ -> return app - Hsx.AssocRight _ -> return (Hsx.PInfixApp () e1 op1 (Hsx.PInfixApp () e2 op2 e3)) - Hsx.AssocNone _ -> die ("fixupOperatorFixities: Internal error " ++ - "(AssocNone should have already been normalized away.)") -fixOperatorFixities' nonNestedInfixApp = return nonNestedInfixApp - - -{-| - Enforces left associativity as default. --} -normalizeAssociativity :: Hsx.Assoc () -> Hsx.Assoc () -normalizeAssociativity (Hsx.AssocNone _) = Hsx.AssocLeft () -- as specified in Haskell98. -normalizeAssociativity etc = etc - -{-| - This function looks up the lexical information for the - given constant identifier. --} -lookupIdentifier_Constant :: Hsx.QName () -> ContextM (Maybe Ident_Env.Identifier) -lookupIdentifier_Constant qname - = do globalEnv <- queryContext globalEnv - modul <- queryContext currentModule - return (Ident_Env.lookupConstant (Ident_Env.fromHsk modul) (Ident_Env.fromHsk qname) globalEnv) - -{-| - This function looks up the lexical information for the given - type identifier. --} -lookupIdentifier_Type' :: Ident_Env.Name -> ContextM (Maybe Ident_Env.Identifier) -lookupIdentifier_Type' envName - = do globalEnv <- queryContext globalEnv - modul <- queryContext currentModule - return (Ident_Env.lookupType (Ident_Env.fromHsk modul) envName globalEnv) -{-| - This function looks up the lexical information for the given - type identifier. --} -lookupIdentifier_Type :: Hsx.QName () -> ContextM (Maybe Ident_Env.Identifier) -lookupIdentifier_Type qname - = do globalEnv <- queryContext globalEnv - modul <- queryContext currentModule - return (Ident_Env.lookupType (Ident_Env.fromHsk modul) (Ident_Env.fromHsk qname) globalEnv) - -{-| - This function looks up the fixity declaration for the given - infix operator. --} -lookupInfixOp :: Hsx.QOp () -> ContextM (Hsx.Assoc (), Maybe Int) -lookupInfixOp = lookupInfixOpName . qop2name - where qop2name (Hsx.QVarOp _ n) = n - qop2name (Hsx.QConOp _ n) = n -{-| - This function looks up the fixity declaration for the given - infix operator. --} -lookupInfixOpName :: Hsx.QName () -> ContextM (Hsx.Assoc (), Maybe Int) -lookupInfixOpName qname - = do identifier <- lookupIdentifier_Constant (qname) - case identifier of - Just (Ident_Env.Constant (Ident_Env.InfixOp _ envassoc prio)) - -> return (Ident_Env.toHsk envassoc, prio) - Nothing -> do globalEnv <- queryContext globalEnv; - warn (Msg.missing_infix_decl qname globalEnv) - return (Hsx.AssocLeft (), Just 9) -- default values in Haskell98 - where qop2name (Hsx.QVarOp _ n) = n - qop2name (Hsx.QConOp _ n) = n - - -{-| - This function looks up the type for the given identifier. --} -lookupType :: Hsx.QName () -> ContextM (Maybe (Hsx.Type ())) -lookupType fname = do - identifier <- lookupIdentifier_Constant fname - case identifier of - Nothing -> return Nothing - Just id -> let typscheme = Ident_Env.typschemeOf (Ident_Env.lexInfoOf id) - in if snd typscheme == Ident_Env.TyNone - then return Nothing else return $ Just (Ident_Env.hsk_typ_of_typscheme typscheme) - - --- A Conversion Unit - -{-| - This data structure combines several Haskell modules and the corresponding environment. - into one coherent unit. --} -type HskModulePragma = (Hsx.Module Hsx.SrcLoc, [Hsx.UnknownPragma]) -data HskUnit = HskUnit [HskModulePragma] CustomTranslations Ident_Env.GlobalE - deriving (Show) - -{-| - This data structure combines several Isabelle theories and the corresponding environment - into one coherent unit. --} -data IsaUnit = IsaUnit [Isa.Module] [CustomTheory] Ident_Env.GlobalE - deriving (Show) - -newtype Conversion a = Conversion (ReaderT Config IO a) - deriving (Functor, Applicative, Monad, MonadReader Config, MonadIO, MonadError IOError) - -isCustomModule :: Hsx.ModuleName () -> Conversion Bool -isCustomModule - = liftM isJust . getCustomTheory - -getCustomisations :: Conversion Customisations -getCustomisations = ask >>= return . customisations - -getCustomTheory :: Hsx.ModuleName () -> Conversion (Maybe CustomTheory) -getCustomTheory mod = - ask >>= return . (`Config.getCustomTheory` mod) . customisations - -getInputFilesRecursively :: Conversion [FilePath] -getInputFilesRecursively - = do config <- ask - let locs = inputLocations config - liftIO $ liftM concat $ mapM getFiles locs - where getFiles :: Location -> IO [FilePath] - getFiles (FileLocation path) - = do fileEx <- doesFileExist path - if fileEx - then return [path] - else do dirEx <- doesDirectoryExist path - if dirEx - then getFilesRecursively path - else hPutStrLn stderr ("Warning: File or directory \"" ++ path ++ "\" does not exist!") >> return [] - - -{-| - This function recursively searches the given directory for Haskell source files. --} -getFilesRecursively :: FilePath -> IO [FilePath] -getFilesRecursively dir = traverseDir dir action - where action fp = return fp - -{-| - This function traverses the file system beneath the given path executing the given - action at every file and directory that is encountered. The result of each action is - accumulated to a list which is returned. --} -traverseDir :: FilePath -> (FilePath -> IO a) -> IO [a] -traverseDir dirpath op = do - fps <- getDirectoryContents dirpath `catchIO` const (return []) - let fps' = map (combine dirpath) . filter (`notElem` [".", ".."]) $ fps - fmap concat $ mapM work fps' - where work f = do - res <- op f - res' <- traverseDir f op - return $ res:res' - -getOutputDir :: Conversion (Maybe FilePath) -getOutputDir = ask >>= return . fmap fileLocation . outputLocation - -getExportCode :: Conversion Bool -getExportCode = ask >>= return . exportCode - -getTryImport :: Conversion Bool -getTryImport = ask >>= return . tryImport - -getOnlyTypes :: Conversion Bool -getOnlyTypes = ask >>= return . onlyTypes - -getBasePathAbs :: Conversion (Maybe FilePath) -getBasePathAbs = ask >>= return . basePathAbs - -getIgnoreNotInScope :: Conversion Bool -getIgnoreNotInScope = ask >>= return . ignoreNotInScope - -getAbsMutParams :: Conversion Bool -getAbsMutParams = ask >>= return . absMutParams - -runConversion :: Config -> Conversion a -> IO a -runConversion config (Conversion parser) = runReaderT parser config - - -{-| - This function takes a parsed Haskell module and produces a Haskell unit by parsing - all module imported by the given module and add including the initial global environment - as given by 'Ident_Env.initialGlobalEnv'. --} -parseHskFiles :: Bool -> Bool -> Maybe FilePath -> [HaskellDocument] -> Conversion [HskUnit] -parseHskFiles tryImport onlyTypes basePathAbs paths - = do (hsmodules,custTrans) <- parseFilesAndDependencies tryImport basePathAbs paths - (depGraph, fromVertex, _) <- makeDependencyGraph hsmodules - let cycles = cyclesFromGraph depGraph - when (not (null cycles)) -- not a DAG? - $ let toModuleName v = case fromVertex v of (_, Hsx.ModuleName _ n,_) -> n - in fail (Msg.cycle_in_dependency_graph (map toModuleName (head cycles))) - let toModule v = case fromVertex v of (m,_,_) -> m - case map (map toModule . flatten) (components depGraph) of - -- this should not happen - [] -> fail $ "Internal error: No Haskell module was parsed!" - modss -> - let mkUnit mods = HskUnit mods custTrans Ident_Env.initialGlobalEnv - in return $ map (mkUnit . if onlyTypes then G.everywhere (G.mkT filter_decl) else id) modss - where filter_decl :: [Hsx.Decl Hsx.SrcLoc] -> [Hsx.Decl Hsx.SrcLoc] - filter_decl = concatMap (\t -> case t of Hsx.TypeDecl _ _ _ -> [t] - Hsx.DataDecl _ _ _ _ _ _ -> [t] - _ -> []) - -{-| - This function computes a list of all cycles in the given graph. - The cycles are represented by the vertexes which constitute them. --} -cyclesFromGraph :: Graph -> [[Vertex]] -cyclesFromGraph graph - = filter ((>1) . length) $ map flatten (scc graph) - -{-| - This function computes the graph depicting the dependencies between all modules - imported by the given module plus itself. The result comes with two functions to convert - between the modules an the vertices of the graph (as provided by 'Data.Graph.graphFromEdges'). --} -makeDependencyGraph :: [HskModulePragma] - -> Conversion (Graph, - Vertex -> (HskModulePragma, Hsx.ModuleName (), [Hsx.ModuleName ()]), - Hsx.ModuleName () -> Maybe Vertex) -makeDependencyGraph hsmodules - = do edges <- mapM makeEdge $ Hsx.zipMod0 fst hsmodules - return $ graphFromEdges edges - where makeEdge (modul, hsmodule@(Hsx.Module _ _ _ imports _, _)) - = do let imported_modules = map (Hsx.importModule . Hsx.fmapUnit) imports - imported_modules' <- filterM isCustomModule imported_modules - return (hsmodule, modul, imported_modules) - -type HaskellDocument = Either FilePath String -type ModuleImport = (HaskellDocument, Maybe (Hsx.ModuleName ())) - -data GrovelS = GrovelS{gVisitedPaths :: Set FilePath, - gRemainingPaths :: [ModuleImport], - gParsedModules :: [HskModulePragma], - gCustTrans :: CustomTranslations, - gTryImport :: Bool, - gBasePathAbs :: Maybe FilePath} - -newtype GrovelM a = GrovelM (StateT GrovelS Conversion a) - deriving (Monad, Functor, Applicative, MonadState GrovelS, MonadIO) - - - -liftConv :: Conversion a -> GrovelM a -liftConv = GrovelM . lift - -checkVisited :: FilePath -> GrovelM Bool -checkVisited path = liftM (Set.member path . gVisitedPaths) get - -getTryImport' :: GrovelM Bool -getTryImport' = liftM gTryImport get - -getBasePathAbs' :: GrovelM (Maybe FilePath) -getBasePathAbs' = liftM gBasePathAbs get - -addModule :: Hsx.SrcLoc -> HskModulePragma -> GrovelM () -addModule loc mod - = modify (\ state@(GrovelS{gVisitedPaths = visited, gParsedModules = mods}) -> - state{gVisitedPaths = Set.insert (Hsx.srcFilename loc) visited, gParsedModules = mod:mods}) - -addImports :: [ModuleImport] -> GrovelM () -addImports imps = modify (\state@(GrovelS{gRemainingPaths = files}) -> state{gRemainingPaths = imps ++ files}) - -{-| - This function checks if the given module is a custom module. If it - is it is added to the set of custom modules in the state and @True@ - is returned. Otherwise just @False@ is returned. --} --- addCustMod :: Hsx.ModuleName () -> GrovelM Bool -addCustMod mod = - do state <- get - mbCustThy <- liftConv $ getCustomTheory mod - case mbCustThy of - Nothing -> return False - Just custThy -> - put state{gCustTrans = Map.insert mod custThy (gCustTrans state)} - >> return True - -{-| - Same as 'addCustMod' but @True@ and @False@ are swapped. --} -addCustMod' :: Hsx.ModuleName () -> GrovelM Bool -addCustMod' = liftM not . addCustMod - -nextImport :: GrovelM (Maybe ModuleImport) -nextImport = - do state <- get - case gRemainingPaths state of - [] -> return Nothing - p:ps -> - do put $ state{gRemainingPaths = ps} - return$ Just p - -parseFilesAndDependencies :: Bool -> Maybe FilePath -> [HaskellDocument] -> Conversion ([HskModulePragma],CustomTranslations) -parseFilesAndDependencies tryImport basePathAbs files = - let GrovelM grovel = grovelImports - mkImp file = (file,Nothing) - imps = map mkImp files - state = GrovelS Set.empty imps [] Map.empty tryImport basePathAbs - in do state' <- execStateT grovel state - return (gParsedModules state' , gCustTrans state') - -grovelImports :: GrovelM () -grovelImports = - do mbFile <- nextImport - case mbFile of - Nothing -> return () - Just file -> grovelFile file - -grovelFile :: ModuleImport -> GrovelM () -grovelFile imp@(Left file,_) = - do v <- checkVisited file - if v - then grovelImports - else parseHskFile imp - -grovelFile imp@(Right _,_) = parseHskFile imp - --- grovelModule :: Hsx.ModuleName () -> GrovelM () -grovelModule loc hsmodule@(Hsx.Module _ baseMod _ imports _, _) = - do let newModules = map Hsx.importModule imports - realModules <- filterM addCustMod' newModules - basePathAbs <- getBasePathAbs' - let modImps = map (mkModImp basePathAbs) realModules - tryImport <- getTryImport' - modImps' <- liftIO $ mapM (checkImp tryImport) modImps - addImports $ concatMap id modImps' - grovelImports - where baseLoc = Hsx.srcFilename loc - mkModImp basePathAbs mod = (computeSrcPath baseMod (baseLoc, basePathAbs) mod, Just mod) - checkImp tryImport (file,Just mod) = - do ext <- doesFileExist file - if ext then return $ [(Left file, Just mod)] - else do - (if tryImport then hPutStrLn stderr else fail) - $ "The module \"" ++ Hsx.showModuleName mod - ++ maybe "" (\(Hsx.ModuleHead _ baseMod _ _) -> "\" imported from module \"" ++ Hsx.showModuleName baseMod) baseMod - ++ "\" cannot be found at \"" ++ file ++ "\"!" - return [] - -{-| - This function computes the path where to look for an imported module. --} - -computeSrcPath :: Maybe (Hsx.ModuleHead ()) -- ^the module that is importing - -> (FilePath, Maybe FilePath) -- ^the path to the importing module - -> Hsx.ModuleName () -- ^the module that is to be imported - -> FilePath -- ^the assumed path to the module to be imported -computeSrcPath importingMod (basePath, basePathAbs) m - = let baseDir = shrinkPath . joinPath $ maybe (splitPath (takeDirectory basePath) ++ replicate (maybe 0 (\(Hsx.ModuleHead _ m _ _) -> Hsx.moduleHierarchyDepth m) importingMod) "..") splitPath basePathAbs - in combine baseDir (Hsx.module2FilePath m) - -shrinkPath :: FilePath -> FilePath -shrinkPath = joinPath . shrinkPath' . splitPath - where shrinkPath' [] = [] - shrinkPath' [x] = [x] - shrinkPath' (x:y:xs) - | x /= "/" && y `elem` ["..", "../"] = shrinkPath' xs - | otherwise = x : shrinkPath' (y:xs) - -parseHskFile :: ModuleImport -> GrovelM () -parseHskFile (file, mbMod) = - do result <- let extensions = [Hsx.EnableExtension Hsx.ExplicitForAll] in - case file of - Left file -> liftIO $ Hsx.parseFileWithCommentsAndPragmas (Hsx.defaultParseMode { Hsx.extensions = extensions, Hsx.parseFilename = file }) file - `catchIO` (\ioError -> fail $ "An error occurred while reading module file \"" ++ file ++ "\": " ++ show ioError) - Right cts -> return $ parseFileContentsWithCommentsAndPragmas (Hsx.defaultParseMode { Hsx.extensions = extensions }) cts - (loc, mod@(Hsx.Module _ name _ _ _, _)) <- - case result of - (Hsx.ParseFailed loc msg) -> - fail $ "An error occurred while parsing module file: " ++ Msg.failed_parsing loc msg - (Hsx.ParseOk (m@(Hsx.Module loc mName _ _ _), _, pragma)) -> - let m' = fmap Hsx.getPointLoc m in - case (file, mbMod) of - (Left file, Just expMod) -> - case mName of - (Just (Hsx.ModuleHead _ mName _ _)) -> - if Hsx.fmapUnit mName == expMod - then return (Hsx.getPointLoc loc, (m', pragma)) - else fail $ "Name mismatch: Name of imported module in \"" - ++ file ++"\" is " ++ Hsx.showModuleName (Hsx.fmapUnit mName) - ++ ", expected was " ++ Hsx.showModuleName expMod - _ -> return (Hsx.getPointLoc loc, (m', pragma)) - cust <- case name of Nothing -> return False - Just (Hsx.ModuleHead _ name _ _) -> addCustMod $ Hsx.fmapUnit name - if cust then grovelImports - else addModule loc mod - >> grovelModule loc (case mod of (m, u) -> (Hsx.fmapUnit m, u)) - --- | Converts a parse result with comments to a parse result with comments and --- unknown pragmas. --- (Adapted from haskell-src-exts) -separatePragmas :: Hsx.ParseResult (Hsx.Module Hsx.SrcSpanInfo, [Hsx.Comment]) - -> Hsx.ParseResult (Hsx.Module Hsx.SrcSpanInfo, [Hsx.Comment], [Hsx.UnknownPragma]) -separatePragmas r = - case r of - Hsx.ParseOk (m, comments) -> - let (pragmas, comments') = partition pragLike comments - in Hsx.ParseOk (m, comments', map commentToPragma pragmas) - where commentToPragma (Hsx.Comment _ l s) = - Hsx.UnknownPragma l $ init $ drop 1 s - pragLike (Hsx.Comment b _ s) = b && pcond s - pcond s = length s > 1 && take 1 s == "#" && last s == '#' - Hsx.ParseFailed l s -> Hsx.ParseFailed l s - --- | Parse a source file from a string using a custom parse mode retaining comments --- as well as unknown pragmas. --- (Adapted from haskell-src-exts) -parseFileContentsWithCommentsAndPragmas - :: Hsx.ParseMode -> String - -> Hsx.ParseResult (Hsx.Module Hsx.SrcSpanInfo, [Hsx.Comment], [Hsx.UnknownPragma]) -parseFileContentsWithCommentsAndPragmas pmode str = separatePragmas parseResult - where parseResult = Hsx.parseFileContentsWithComments pmode str diff --git a/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/Importer/DeclDependencyGraph.hs b/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/Importer/DeclDependencyGraph.hs deleted file mode 100644 index 593ee9e3d9e049bb059d273cd4fa108bbdea100a..0000000000000000000000000000000000000000 --- a/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/Importer/DeclDependencyGraph.hs +++ /dev/null @@ -1,167 +0,0 @@ -{-# LANGUAGE FlexibleContexts #-} - -{-| Author: Tobias C. Rittweiler, TU Muenchen --} - -module Importer.DeclDependencyGraph - (arrangeDecls) where - -import Importer.Library - -import Data.Maybe -import qualified Data.List as List -import Data.Function -import Data.Graph as Graph -import qualified Data.Map as Map -import Data.Set (Set) -import qualified Data.Set as Set hiding (Set) -import Data.Traversable -import qualified Data.Tree as Tree - -import Control.Monad - -import qualified Importer.Msg as Msg -import qualified Importer.Ident_Env as Ident_Env - -import qualified Language.Haskell.Exts as Hsx -import qualified Importer.Hsx as Hsx - - --- We have to canonicalize the names in our graph, as there may appear --- "some_fun", and "Foo.some_fun", and they may be reffering to the --- same. We use our GlobalEnv for this purpose. - -{-| - This data structure represents the dependency graph of Haskell declarations. - The nodes of this graph are elements of type 'Hsx.Decl' keys are of type 'Ident_Env.Name'. --} -type HskDecl = (Int, Hsx.Decl ()) -type HskDeclDepGraphKey = (Maybe Int, Ident_Env.Name) -data HskDeclDepGraph = HskDeclDepGraph (Graph, - Vertex -> (HskDecl, HskDeclDepGraphKey, [HskDeclDepGraphKey]), - HskDeclDepGraphKey -> Maybe Vertex) - -{-| - This function computes the dependency graph of the given Haskell declarations of the - given module in the given environment. An edge from a declaration A to declaration B - means the definition of A depends on B. --} -makeDeclDepGraph :: Bool -> Ident_Env.GlobalE -> Hsx.ModuleName () -> [Hsx.Decl ()] -> HskDeclDepGraph -makeDeclDepGraph ignoreNotInScope globalEnv modul decls = HskDeclDepGraph declDepGraph - where declDepGraph = graphFromEdges - $ handleDuplicateEdges - $ concatMap (makeEdgesFromDecl ignoreNotInScope globalEnv modul) (zip [0..] decls) - -{-| - This function constructs the outgoing edges of the given declaration in the given environment - module. --} -makeEdgesFromDecl :: Bool -> Ident_Env.GlobalE -> Hsx.ModuleName () -> HskDecl -> [(HskDecl, Ident_Env.Name, [Ident_Env.Name])] -makeEdgesFromDecl ignoreNotInScope globalEnv modul (pos, decl) = - let - canonicalize hsqname = Ident_Env.resolveName_OrLose globalEnv (Ident_Env.fromHsk modul) (Ident_Env.fromHsk hsqname) - canonicalize' = - if ignoreNotInScope then - \hsqname -> let hsqname' = Ident_Env.fromHsk hsqname in - maybe hsqname' id (Ident_Env.resolveName_NoLose globalEnv (Ident_Env.fromHsk modul) hsqname') - else - canonicalize - names = map canonicalize $ Hsx.namesFromDeclInst decl - used_names = Set.map canonicalize' $ Set.unions [Hsx.extractFreeVarNs decl, Hsx.extractDataConNs decl, Hsx.extractFieldNs decl] - used_types = Set.map canonicalize' $ Hsx.extractTypeConNs decl - impl_types = catMaybes $ Set.toList $ Set.map (Ident_Env.getDepDataType globalEnv (Ident_Env.fromHsk modul)) used_names - in - [ ((pos, decl), name, Set.toList (Set.union used_names used_types) ++ impl_types) | name <- names ] - -{-| - ??? --} -handleDuplicateEdges :: [(HskDecl, Ident_Env.Name, [Ident_Env.Name])] -> [(HskDecl, HskDeclDepGraphKey, [HskDeclDepGraphKey])] -handleDuplicateEdges edges - = edges - & groupByFull (\(_,x,_) -> x) - & concatMap handleGroup - & List.sortBy (let f ((n, _), _, _) = n in \a1 a2 -> compare (f a1) (f a2)) - & mapAccumLsnd (\ mapIdent decl@((n,d), (bk, k), (nl,l)) -> - ( if isClass decl || isInstance decl then Map.insert k n mapIdent else mapIdent - , ((n,d), (bk, k), maybe id (\i l -> let v = (Just i, k) in if v `elem` l then l else v : l) nl (map (\k -> (Map.lookup k mapIdent, k)) l)))) - Map.empty - where handleGroup edges - = edges - & partition_single isTypeAnnotation - & (\ee -> case ee of - (Nothing, edges) -> edges - (Just (_, _, l0), edges) -> map (\(d, n, l1) -> (d, n, l0 ++ l1)) edges) - & (\edges -> if ambiguous_edges edges then error (Msg.ambiguous_decl_definitions edges) else edges) - & partition_single isClass - & (\(edge_c, edges) -> - let pos_c = fmap (\((n, _), _, _) -> n) edge_c in - mapAccumLsnd (\n ((decl_n, decl_d), decl_k, decl_l) -> (Just decl_n, ((decl_n, decl_d), (case n of Nothing -> Nothing ; _ -> Just decl_n, decl_k), (n, decl_l)))) - pos_c - edges - & maybe id (\(d, k, l) -> (:) (d, (pos_c, k), (Nothing, l))) edge_c) - - ambiguous_edges edges - = length edges > 1 && any (\e -> not (isClass e || isInstance e)) edges - mapAccumLsnd f acc = snd . mapAccumL f acc - partition_single f l = case List.partition f l of ([], l) -> (Nothing, l) - ([x], l) -> (Just x, l) - _ -> error Msg.unsupported_semantics_decl - groupByFull f = Map.elems . foldr (\x map -> let k = f x in Map.insert k (x : maybe [] id (Map.lookup k map)) map) Map.empty - isTypeAnnotation ((_, Hsx.TypeSig _ _ _), _ , _) = True - isTypeAnnotation _ = False - isInstance ((_, Hsx.InstDecl _ _ _ _), _, _) = True - isInstance _ = False - isClass ((_, Hsx.ClassDecl _ _ _ _ _), _, _) = True - isClass _ = False - - - --- In Haskell definitions may appear anywhere in a source file, but in --- Isar/HOL (like in ML), definitions that are used in another definition --- must appear lexically before that other definition. - -{-| - This function takes a dependency graph of Haskell declarations and linearises it, such that - functions are declared before they are used by another function definition. The result is a - list of list of declaration each list of declarations forms a set of declarations that depend - on each other in a mutually recursive way. --} - -flattenDeclDepGraph :: HskDeclDepGraph -> [[Hsx.Decl ()]] -flattenDeclDepGraph (HskDeclDepGraph (graph, fromVertex, _)) - -- We first partition the graph into groups of mutually-dependent declarations - -- (i.e. its strongly-connected components); we then sort these components according - -- their dependencies (decls used later must come first.) - -- - -- Additionally we sort each declaration in such a component source-line wise, - -- and also sort source-line wise if two components are completely independent. - -- Objective: To preserve the ordering of the original source code file as - -- much as possible. - = let declFromVertex v = (let ((_, decl),_,_) = fromVertex v in decl) - in map (map declFromVertex) - $ List.sortBy orderComponents_ByDependencies - (map (List.sortBy orderVertices_BySourceLine . Tree.flatten) $ scc graph) - where - orderVertices_BySourceLine v1 v2 - = let (decl1,_,_) = fromVertex v1 - (decl2,_,_) = fromVertex v2 - in Hsx.orderDeclsBySourceLine decl1 decl2 - - orderComponents_ByDependencies vs1 vs2 - = let used_vs_in_1 = concatMap (reachable graph) vs1 - used_vs_in_2 = concatMap (reachable graph) vs2 - in if (isContained used_vs_in_1 vs2) -- does vs2 define stuff needed in vs1? - then assert (not (isContained used_vs_in_2 vs1)) $ GT - else if (isContained used_vs_in_2 vs1) -- does vs1 define stuff needed in vs2? - then assert (not (isContained used_vs_in_1 vs2)) $ LT - else -- vs1 and vs2 are independant. - let (decl1,_,_) = fromVertex (head vs1) - (decl2,_,_) = fromVertex (head vs2) - in Hsx.orderDeclsBySourceLine decl1 decl2 - where - isContained xs ys = not (null (List.intersect xs ys)) - -arrangeDecls :: Bool -> Ident_Env.GlobalE -> Hsx.ModuleName () -> [Hsx.Decl ()] -> [[Hsx.Decl ()]] -arrangeDecls ignoreNotInScope globalEnv modul = flattenDeclDepGraph . makeDeclDepGraph ignoreNotInScope globalEnv modul - diff --git a/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/Importer/Env.hs b/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/Importer/Env.hs deleted file mode 100644 index 899760266d49ec35166cbf75e86c7ae004567108..0000000000000000000000000000000000000000 --- a/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/Importer/Env.hs +++ /dev/null @@ -1,278 +0,0 @@ -{-# LANGUAGE - UndecidableInstances, - ExistentialQuantification, - MultiParamTypeClasses, - RankNTypes, - FlexibleInstances #-} - -{-| Author: Patrick Bahr, NICTA - -This module provides traversal schemes for SYB that enable access to -modular defined environment information. --} - -module Importer.Env - ( EnvDef, - everywhereEnv, - everythingEnv, - mkE, - extE, - liftE, - extByC, - uniEloc, - Envs(..), - Repl(..) - ) -where - -import Data.Generics -import Data.Monoid -import Control.Monad -import Control.Monad.Reader - -class Component t c where - extract :: t -> c - liftC :: (c -> c) -> (t -> t) - -instance Component (a, b) a where - extract (a,b) = a - liftC f (a,b) = (f a,b) - -instance Component (a, b) b where - extract (a,b) = b - liftC f (a,b) = (a,f b) - -{-| - Elements of this type define how environments of type @e@ are changed - during the generic traversal of a data structure. --} -newtype EnvDef m e = EnvDef (forall a. Data a => a -> m [e -> e]) -data Envs e = Envs [e] -data Repl e = Set e | Keep - -{-| - This function turns a simple query function into a function - that returns a list repeating the original result as often as - there are immediate subterms in the argument. --} -uniE :: (Monad m, Data a) => (a -> m b) -> (a -> m (Envs b)) -uniE query node = - do res <- query node - return $ Envs $ replicate (glength node) res - -{-| - This function is similar to 'uniE' but it can be used locally, i.e., - in the definition of a particular environment transformation function. - It returns a list repeating second argument as often as - there are immediate subterms in first argument value the argument. --} -uniEloc :: (Data a) => a -> b -> Envs b -uniEloc node env = Envs $ replicate (glength node) env - -{-| - This function turns pure environment transformation into monadic ones. --} -pureE :: Monad m => (a -> e) -> (a -> m e) -pureE pure node = return (pure node) - -{-| - This function turns constant environment transformations into environment - transformations that accumulate the environment values. --} -accE :: (Monad m, Monoid e) => (a -> m (Envs e)) -> (a -> m (Envs (e -> e))) -accE accum node = - do Envs res <- accum node - return $ Envs $ map (flip mappend) res - -{-| - This function turns constant environment transformations into environment - transformations that replace the current environment with a new - value (for @Set@) or keep it (for @Keep@) --} -replE :: (Monad m) => (a -> m (Envs (Repl e))) -> (a -> m (Envs (e -> e))) -replE repl node = - do Envs res <- repl node - return $ Envs $ map replMb res - where replMb Keep old = old - replMb (Set new) _ = new - -{-| - This environment definition will result in no changes to - the environment during the generic traversal. --} - -nilE :: (Monad m) => EnvDef m e -nilE = EnvDef (return . flip replicate id. glength) - -{-| - This function constructs an environment definition from - a function that produces an transformation for a specific - type @a@. The environment transformations from the list are applied to the respective immediate - subterm of the data type @a@, i.e., the first element is applied to the first component - of the type etc. For all other types the environment is left unchanged. --} -mkE :: (EnvFunction b e, Monad m, Data a) => (a -> b) -> EnvDef m e -mkE = extE nilE - -{-| - This function constructs an environment definition from - a monadic function that produces an environment transformation for a specific - type @a@. The environment transformations from the list are applied to the respective immediate - subterm of the data type @a@, i.e., the first element is applied to the first component - of the type etc. For all other types the environment is left unchanged. --} -mkEm :: (EnvFunction b e, Monad m, Data a) => (a -> m b) -> EnvDef m e -mkEm = extEm nilE - - -{-| - This function extends the given base environment definition by - a function that produces an environment transformation for a specific - type @a@. The environment transformations from the list are applied to the respective - successor of the data type @a@, i.e., the first element is applied to the first component - of the type etc. For all other types the environment is transformed as by the - base transformer that was given to this function. --} - -extE :: (EnvFunction b e, Monad m, Data a) => EnvDef m e -> (a -> b) -> EnvDef m e -extE base trans = extEm base (pureE trans) - -{-| - This function extends the given base environment definition by - a monadic function that produces an environment transformation for a specific - type @a@. The environment transformations from the list are applied to the respective - successor of the data type @a@, i.e., the first element is applied to the first component - of the type etc. For all other types the environment is transformed as by the - base transformer that was given to this function. --} - -extEm :: (EnvFunction b e, Monad m, Data a) => EnvDef m e -> (a -> m b) -> EnvDef m e -extEm (EnvDef base) trans = EnvDef ( base `extQ` ext) - where ext node = do Envs res <- toEnvFunction trans node - return res - - - -class EnvFunction b e where - toEnvFunction :: (Monad m, Data a) => (a -> m b) -> (a -> m (Envs (e -> e))) - -instance EnvFunction (Envs(e -> e)) e where - toEnvFunction = id - -instance EnvFunction (e -> e) e where - toEnvFunction = uniE - -instance EnvFunction (Envs( Repl e)) e where - toEnvFunction = replE - -instance EnvFunction (Repl e) e where - toEnvFunction = replE . uniE - -instance (Monoid e) => EnvFunction (Envs e) e where - toEnvFunction = accE - -instance (Monoid e) => EnvFunction e e where - toEnvFunction = accE . uniE - - -{-| - This function takes a transformer for environments of type @c@ and - lifts it to a corresponding transformer for environments of type @e@ - that has @c@ as a component. The resulting transformer only acts on the - @c@ component of @e@. --} - -liftE :: (Monad m, Component e c) => EnvDef m c -> EnvDef m e -liftE (EnvDef query) = (EnvDef query') - where query' node = - do res <- query node - return $ map liftC res - -{-| - This function extends a transformer for environments of type @e@ - by a transformer for environments of type @c@ which is a component - of $e$. --} - -extByC :: (Monad m, Component e c) => EnvDef m e -> EnvDef m c -> EnvDef m e -extByC (EnvDef base) (EnvDef ext) = (EnvDef query) - where query node = - do extRes <- ext node - baseRes <-base node - return $ zipWith (.) baseRes (map liftC extRes) - - -{-| - This function applies the given monadic transformation function everywhere - in a bottom-up manner and provides environment information during the traversal - as generated by the given environment transformer. --} -everywhereEnv :: MonadReader e m => - EnvDef m e -> GenericM m -> GenericM m -everywhereEnv envDef@(EnvDef envTrans) f node = - do trans <- envTrans node - node' <- gmapEnvT trans (everywhereEnv envDef f) node - f node' - -{-| - This function summarises the queried results collected by - a traversal and provides environment information during the traversal - as generated by the given environment transformer. --} - -everythingEnv :: MonadReader e m => - EnvDef m e -> (q -> q -> q) -> GenericQ (m q) -> GenericQ (m q) -everythingEnv envDef@(EnvDef envTrans) combine f node = - do trans <- envTrans node - children <- gmapEnvQ trans (everythingEnv envDef combine f) node - current <- f node - return $ foldl combine current children - -{-| - This function checks that the given node has the same number of immediate subterms as - there are elements in the list. If so the last argument is returned. Otherwise an - exception is thrown. --} -checkTrans :: Data a => a -> [r -> r] -> b -> b -checkTrans node trans x - | children > ts = error $ "Too few environment transformations for constructor \"" - ++ show (toConstr node) ++ "\": Expected " - ++ show children ++ ", but found " ++ show ts - | children < ts = error $ "Too many environment transformations for constructor \"" - ++ show (toConstr node) ++ "\": Expected " - ++ show children ++ ", but found " ++ show ts - | otherwise = x - - where children = glength node - ts = length trans - -{-| - A type definition needed to define 'gmapEnvT'. --} -newtype EnvT m a r = EnvT (m ([a -> a],r)) -unEnvT (EnvT x) = x - -{-| - This function applies the given monadic transformer to all immediate - subterms. The environments of the resulting monadic computations are - modified as given by the list of environment transformation functions, where - the i-th function in the list is used for the i-th subterm. --} -gmapEnvT ::MonadReader r m => [r -> r] -> GenericM m -> GenericM m -gmapEnvT trans f node = checkTrans node trans $ - unEnvT (gfoldl k z node) >>= (return . snd) - where z x = EnvT $ return (trans,x) - k (EnvT c) x = EnvT $ - do (t:ts,c') <- c - x' <- local t (f x) - return (ts, c' x') - -{-| - This function applies the given monadic query to all immediate - subterms. The environments of the resulting monadic computations are - modified as given by the list of environment transformation functions, where - the i-th function in the list is used for the i-th subterm. --} -gmapEnvQ :: MonadReader r m => [r -> r] -> GenericQ (m q) -> GenericQ (m [q]) -gmapEnvQ trans f node = checkTrans node trans $ - sequence $ zipWith local trans (gmapQ f node) \ No newline at end of file diff --git a/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/Importer/Gensym.hs b/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/Importer/Gensym.hs deleted file mode 100644 index 5a2f240e488e4df758b269aeff9c1a8874d2574f..0000000000000000000000000000000000000000 --- a/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/Importer/Gensym.hs +++ /dev/null @@ -1,50 +0,0 @@ -{-# LANGUAGE GeneralizedNewtypeDeriving #-} - -{-| Author: Tobias C. Rittweiler, TU Muenchen --} - -module Importer.Gensym where - -import Control.Monad.State - -import qualified Language.Haskell.Exts as Hsx (Name(..), QName(..)) -import qualified Importer.Isa as Isa (Name(..)) - -data Count = Count { sym :: Int, pos :: Int } - -posInit = 0 -countInit = Count {sym = 0, pos = posInit} - -newtype GensymM a = GensymM (State Count a) - deriving (Monad, Functor, Applicative, MonadFix, MonadState Count) - -gensym :: String -> GensymM String -gensym prefix = do count <- get - put (count { sym = sym count + 1 }) - return (prefix ++ show (sym count)) - -setPos :: Int -> GensymM () -setPos pos = do count <- get - put (count { pos = pos }) - -askPos :: GensymM Int -askPos = do count <- get - return $ pos count - -genHsName :: Hsx.Name l -> GensymM (Hsx.Name l) -genHsName (Hsx.Ident l prefix) = liftM (Hsx.Ident l) (gensym prefix) -genHsName (Hsx.Symbol l prefix) = liftM (Hsx.Symbol l) (gensym prefix) - -genHsQName :: Hsx.QName l -> GensymM (Hsx.QName l) -genHsQName (Hsx.Qual l m prefix) = liftM (Hsx.Qual l m) (genHsName prefix) -genHsQName (Hsx.UnQual l prefix) = liftM (Hsx.UnQual l) (genHsName prefix) - -genIsaName :: Isa.Name -> GensymM Isa.Name -genIsaName (Isa.QName t prefix) = liftM (Isa.QName t) (gensym prefix) -genIsaName (Isa.Name prefix) = liftM Isa.Name (gensym prefix) - -evalGensym :: Count -> GensymM a -> a -evalGensym init (GensymM state) = evalState state init - -runGensym :: Count -> GensymM a -> (a, Count) -runGensym init (GensymM state) = runState state init diff --git a/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/Importer/Hsx.hs b/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/Importer/Hsx.hs deleted file mode 100644 index 44773a9dcd526321987895d712b8b44ddefb70f0..0000000000000000000000000000000000000000 --- a/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/Importer/Hsx.hs +++ /dev/null @@ -1,694 +0,0 @@ -{-# LANGUAGE - UndecidableInstances, - FlexibleInstances, - GeneralizedNewtypeDeriving, - Rank2Types #-} - -{-| Author: Tobias C. Rittweiler, TU Muenchen - -Haskell ASTs. --} - -module Importer.Hsx where - -import Importer.Library -import qualified Importer.AList as AList -import Data.Maybe -import Data.List (sort, sortBy) -import Data.Map (Map) -import qualified Data.Map as Map hiding (Map) -import Data.Set (Set) -import qualified Data.Set as Set hiding (Set) -import qualified Data.Array as Array (inRange) -import qualified Data.Char as Char (toLower) - -import Data.Generics -import Data.Generics.Basics -import Data.Generics.Uniplate.Data - -import Control.Monad.Reader - -import qualified Importer.Gensym as Gensym -import qualified Importer.Env as Env - -import qualified Language.Haskell.Exts as Hsx -import qualified Language.Haskell.Exts.SrcLoc as HsxL - - -type SLoc l = Maybe l - -fmapNone :: (Eq l, Data l, Ord l, Show l) => Functor m => m a -> m (SLoc l) -fmapNone = fmap (\_ -> Nothing) - -fmapJust :: (Eq l, Data l, Ord l, Show l) => Functor m => m l -> m (SLoc l) -fmapJust = fmap Just - -fmapUnit :: Functor m => m a -> m () -fmapUnit = fmap (\_ -> ()) - -{-| - The prelude's module name --} -hsk_prelude :: Hsx.ModuleName () -hsk_prelude = Hsx.ModuleName () "Prelude" - -zipMod0 :: (a -> Hsx.Module l) -> [a] -> [(Hsx.ModuleName (), a)] -zipMod0 f = map (\(modulN, modul) -> - ( case f modul of Hsx.Module _ (Just (Hsx.ModuleHead _ m _ _)) _ _ _ -> fmapUnit m - _ -> Hsx.ModuleName () (show modulN) - , modul)) - . zip [0..] - -zipMod :: [Hsx.Module l] -> [(Hsx.ModuleName (), Hsx.Module l)] -zipMod = zipMod0 id - -{-| - This function takes a constant identifier name and converts it into a - Haskell expression of a qualified --} -prelude_fn :: String -> Hsx.Exp () -prelude_fn fn_name = Hsx.Var () (Hsx.Qual () hsk_prelude (Hsx.Ident () fn_name)) - -{-| - This function provides the return type of a type. E.g. - returnType (a -> b -> c) = c --} -returnType :: Hsx.Type () -> Hsx.Type () -returnType (Hsx.TyForall _ _ _ ty) = ty -returnType (Hsx.TyFun _ _ ty) = ty -returnType (Hsx.TyKind _ ty _) = ty -returnType ty = ty - - -{-| - This function provides the (unqualified) name of the type constructor that constructed - the given type or nothing if the given type is not a constructor application. --} -typeConName :: Hsx.Type () -> Maybe String -typeConName (Hsx.TyApp _ (Hsx.TyCon _ qname) _) = - case qname of - Hsx.Qual _ _ (Hsx.Ident _ name) -> Just name - Hsx.UnQual _ (Hsx.Ident _ name) -> Just name - _ -> Nothing -typeConName _ = Nothing - - -isHskSymbol :: Char -> Bool -isHskSymbol = flip elem ['_', ':', '"', '[', ']', '!', '#', '$', '%', '&', - '*', '+', '.', '/', '<', '=', '>', '?', '@', - '\\', '^', '|', '-', '~' ] - -isOperator :: String -> Bool -isOperator = all isHskSymbol - -{-| - This function takes a Haskell expression and applies it to the argument - given in the list --} -hsk_apply :: Hsx.Exp () -> [Hsx.Exp ()] -> Hsx.Exp () -hsk_apply fn_expr args - = foldl (Hsx.App ()) fn_expr args - -{-| - The Haskell empty list. --} -hskPNil :: Hsx.Pat () -hskPNil = Hsx.PList () [] - -{-| - The Haskell list constructor. This function takes two Haskell expressions and applies - the list constructor @(:)@ to it. --} -hskPCons :: Hsx.Pat () -> Hsx.Pat () -> Hsx.Pat () -hskPCons x y = Hsx.PApp () (Hsx.Special () (Hsx.Cons ())) [x, y] - -{-| - The Haskell empty list. --} -hsk_nil :: Hsx.Exp () -hsk_nil = Hsx.List () [] - -{-| - The Haskell list constructor. This function takes two Haskell expressions and applies - the list constructor @(:)@ to it. --} -hsk_cons :: Hsx.Exp () -> Hsx.Exp () -> Hsx.Exp () -hsk_cons x y = Hsx.App () (Hsx.App () (Hsx.Con () (Hsx.Special () (Hsx.Cons ()))) x) y - -{-| - The Haskell pair constructor. This function takes two Haskell expressions and applies - the pair constructor @(,)@ to them. --} -hskPPair :: Hsx.Pat () -> Hsx.Pat () -> Hsx.Pat () -hskPPair x y = Hsx.PApp () (Hsx.Special () (Hsx.TupleCon () Hsx.Boxed 2)) [x, y] - -{-| - The Haskell pair constructor. This function takes two Haskell expressions and applies - the pair constructor @(,)@ to them. --} -hsk_pair :: Hsx.Exp () -> Hsx.Exp () -> Hsx.Exp () -hsk_pair x y = Hsx.App () (Hsx.App () (Hsx.Con () (Hsx.Special () (Hsx.TupleCon () Hsx.Boxed 2))) x) y - -{-| - The Haskell logical negation. This function takes a Haskell expression and applies - the negation 'negate' to it. --} -hsk_negate :: Hsx.Exp () -> Hsx.Exp () -hsk_negate e = hsk_apply (prelude_fn "negate") [e] - -{-| - The Haskell if-then-else. This function takes three arguments - condition, if branch, else branch - - and forms a corresponding if-then-else expression. --} -hsk_if :: Hsx.Exp () -> Hsx.Exp () -> Hsx.Exp () -> Hsx.Exp () -hsk_if = Hsx.If () - -{-| - The Haskell lambda abstraction. --} -hsk_lambda :: [Hsx.Pat ()] -> Hsx.Exp () -> Hsx.Exp () -hsk_lambda = Hsx.Lambda () - -{-| - The Haskell (ungarded!) case expression. --} -hsk_case :: Hsx.Exp () -> [(Hsx.Pat (), Hsx.Exp ())] -> Hsx.Exp () -hsk_case e cases - = Hsx.Case () e [ Hsx.Alt () pat (Hsx.UnGuardedRhs () exp) Nothing | (pat, exp) <- cases ] - -{-| - This function turns a string into a Haskell name. Depending on the - actual string it is considered a symbol (cf. 'Hsx.Symbol') or an - identifier (cf. 'Hsx.Ident'). --} -string2Name :: String -> Hsx.Name () -string2Name string = case isSymbol string of - True -> Hsx.Symbol () string - False -> Hsx.Ident () string - where isSymbol string = and $ map (`elem` symbols) string - symbols = "!@$%&*+./<=>?¹\\^|~" - -{-| - This function turns a source location into a human readable string. --} -srcloc2string :: Hsx.SrcLoc -> String -srcloc2string (Hsx.SrcLoc { Hsx.srcFilename=filename, Hsx.srcLine=line, Hsx.srcColumn=column }) - = filename ++ ":" ++ (show line) ++ ":" ++ (show column) - -srcspan2string :: HsxL.SrcSpan -> String -srcspan2string (HsxL.SrcSpan { HsxL.srcSpanFilename=filename, HsxL.srcSpanStartLine=line1, HsxL.srcSpanStartColumn=column1, HsxL.srcSpanEndLine=line2, HsxL.srcSpanEndColumn=column2 }) - = "(" ++ srcloc2string (Hsx.SrcLoc { Hsx.srcFilename=filename, Hsx.srcLine=line1, Hsx.srcColumn=column1 }) - ++ ", " - ++ srcloc2string (Hsx.SrcLoc { Hsx.srcFilename=filename, Hsx.srcLine=line2, Hsx.srcColumn=column2 }) - ++ ")" - -{-| - This function computes the relative file path to the given module name. - E.g. \"Some.Hsx.ModuleName.Name\" ==> \"Some\/Hsx.ModuleName\/Name\" --} -module2FilePath :: Hsx.ModuleName () -> FilePath -module2FilePath (Hsx.ModuleName _ name) - = map (\c -> if c == '.' then '/' else c) name ++ ".hs" -{- -moduleFileLocation :: Hsx.Module () -> FilePath -moduleFileLocation (Hsx.Module Hsx.SrcLoc{Hsx.srcFilename = file} _ _ _ _) = file --} -moduleHierarchyDepth :: Hsx.ModuleName () -> Int -moduleHierarchyDepth (Hsx.ModuleName _ name) = length $ filter (== '.') name - -{-| - This predicate checks whether the given file path refers to a Haskell - source file. --} -isHaskellSourceFile :: FilePath -> Bool -isHaskellSourceFile fp = map Char.toLower (last (slice (== '.') fp)) == "hs" - -{-| - This function takes a context (from a class definition) and extracts - the super classes' names. - - TODO: This is to specific: Contexts can be more complex. This function only returns - the \"super classes\" if the context's assertion have the class' type variable as their - only argument. Also other kinds of assertions are not considered. --} -extractSuperclassNs' :: [Hsx.Asst ()] -> [Hsx.QName ()] -extractSuperclassNs' ctx = map extract ctx - where extract (Hsx.ClassA _ qn _) = qn - extract (Hsx.ParenA _ a) = extract a - -extractSuperclassNs :: Maybe (Hsx.Context ()) -> [Hsx.QName ()] -extractSuperclassNs = extractSuperclassNs' . (\x -> case x of Nothing -> [] - Just l -> contextList l) - -contextList :: Hsx.Context () -> [Hsx.Asst ()] -contextList (Hsx.CxSingle _ a) = [a] -contextList (Hsx.CxTuple _ la) = la -contextList (Hsx.CxEmpty _) = [] - -dest_typcontext :: Hsx.Context () -> [(Hsx.Name (), [Hsx.QName ()])] -dest_typcontext ctx = AList.group (maps dest_entry $ contextList ctx) where - dest_entry (Hsx.ClassA _ cls typs) = [ (v, cls) | v <- map dest_tyvar typs ] - dest_entry (Hsx.ParenA _ a) = dest_entry a - dest_tyvar (Hsx.TyVar _ v) = v - -{-| - This function extracts the type declarations of the given list of - class-internal declarations. --} -extractMethodSigs :: Maybe [Hsx.ClassDecl ()] -> [Hsx.Decl ()] -extractMethodSigs class_decls - = filter isTypeSig (map (\(Hsx.ClsDecl _ d) -> d) (case class_decls of Nothing -> [] ; Just l -> l)) - where isTypeSig (Hsx.TypeSig _ _ _) = True - isTypeSig _ = False - -{-| - This function extracts all Haskell names that are affected by the given - declaration. If the given kind of declaration is not supported an exception - is thrown. --} -namesFromDecl :: Hsx.Decl () -> Either [Hsx.QName ()] (Hsx.QName ()) -namesFromDecl decl = case decl of - Hsx.TypeDecl _ name _ -> namesFromDeclHead name - Hsx.DataDecl _ _ _ name _ _ -> namesFromDeclHead name - Hsx.ClassDecl _ _ name _ _ -> namesFromDeclHead name - Hsx.InstDecl _ _ irule _ -> namesFromInstRule irule - Hsx.TypeSig _ names _ -> Left $ map (Hsx.UnQual ()) names - Hsx.InfixDecl _ _ _ ops -> Left [Hsx.UnQual () n | n <- (universeBi ops :: Data l => [Hsx.Name l])] - Hsx.PatBind _ pat _ _ -> Left $ bindingsFromPats [pat] - Hsx.FunBind _ (Hsx.Match _ fname _ _ _ : ms ) - -> Left [Hsx.UnQual () fname] - Hsx.FunBind _ (Hsx.InfixMatch _ _ fname _ _ _ : ms ) - -> Left [Hsx.UnQual () fname] - decl -> error $ "Internal error: The given declaration " ++ show decl ++ " is not supported!" - where - namesFromDeclHead name = Left [(Hsx.UnQual () . fst . split_declhead) name] - namesFromInstRule (Hsx.IRule _ _ _ ihead) = Right ((fst . split_insthead) ihead) - -namesFromDeclInst :: Hsx.Decl () -> [Hsx.QName ()] -namesFromDeclInst decl = case namesFromDecl decl of Left l -> l ; Right n -> [n] - -namesFromDecl' :: Hsx.Decl () -> [Hsx.QName ()] -namesFromDecl' decl = case namesFromDecl decl of Left l -> l ; Right _ -> [] - -split_declhead :: Hsx.DeclHead l -> (Hsx.Name l, [Hsx.TyVarBind l]) -split_declhead dh = case dh of Hsx.DHead _ n -> (n, []) - Hsx.DHInfix _ t n -> (n, [t]) - Hsx.DHParen _ dh -> split_declhead dh - Hsx.DHApp _ dh t -> let (n, l) = split_declhead dh in (n, l ++ [t]) - -split_insthead :: Hsx.InstHead l -> (Hsx.QName l, [Hsx.Type l]) -split_insthead dh = case dh of Hsx.IHCon _ n -> (n, []) - Hsx.IHInfix _ t n -> (n, [t]) - Hsx.IHParen _ dh -> split_insthead dh - Hsx.IHApp _ dh t -> let (n, l) = split_insthead dh in (n, l ++ [t]) - -{-| - Instances of this class represent pieces of Haskell syntax that can bind - variables. --} - -class HasBindings a where - {-| - This function is supposed to provide a list of all Haskell variables that - are bound by the given syntax. - -} - extractBindingNs :: a -> [Hsx.QName ()] - -{-| - Lift all instances to lists. --} -instance HasBindings a => HasBindings [a] where - extractBindingNs list = concatMap extractBindingNs list - -instance HasBindings (Hsx.Pat ()) where - extractBindingNs pattern = bindingsFromPats [pattern] - -instance HasBindings (Hsx.Decl ()) where - extractBindingNs decl = bindingsFromDecls [decl] - -instance HasBindings (Hsx.Binds ()) where - extractBindingNs (Hsx.BDecls _ decls) = extractBindingNs decls - extractBindingNs (Hsx.IPBinds _ (Hsx.IPBind loc _ _ : _)) - = error $ show {-srcloc2string-} loc ++ ": Implicit parameter bindings are not supported!" - extractBindingNs (Hsx.IPBinds _ []) = [] - -instance HasBindings (Maybe (Hsx.Binds ())) where - extractBindingNs (Just b) = extractBindingNs b - extractBindingNs Nothing = [] - -instance HasBindings (Hsx.Stmt ()) where - extractBindingNs (Hsx.Qualifier _ b) = [] - extractBindingNs (Hsx.Generator _ pat exp) = extractBindingNs pat - extractBindingNs (Hsx.LetStmt _ binds) = extractBindingNs binds - -instance HasBindings (Hsx.QualStmt ()) where - extractBindingNs (Hsx.QualStmt _ stmt) = extractBindingNs stmt - extractBindingNs _ = [] - - -{-| - This function extracts from the given Haskell pattern a list of all Haskell variables - that are bound by the pattern. --} -bindingsFromPats :: [Hsx.Pat ()] -> [Hsx.QName ()] -bindingsFromPats pattern = [ Hsx.UnQual l n | Hsx.PVar l n <- universeBi pattern ] - ++ [ Hsx.UnQual l n | Hsx.PAsPat l n _ <- universeBi pattern ] - -{-| - This function extracts the variables bound by the given declaration. --} -bindingsFromDecls :: [Hsx.Decl ()] -> [Hsx.QName ()] -bindingsFromDecls decls = assert (not (has_duplicates bindings)) bindings - -- Type signatures do not create new bindings, but simply annotate them. - where bindings = concatMap namesFromDeclInst (filter (not . isTypeSig) decls) - isTypeSig (Hsx.TypeSig _ _ _) = True - isTypeSig _ = False - - -type HskNames = Set (Hsx.QName ()) -newtype BindingM a = BindingM (Reader HskNames a) - deriving (Monad, MonadReader HskNames, Functor, Applicative) - -runBindingM :: BindingM a -> a -runBindingM (BindingM m) = runReader m Set.empty - -class BindingMonad m where - boundNames :: m HskNames - isBound :: Hsx.QName () -> m Bool - - -instance MonadReader HskNames m => BindingMonad m where - isBound name = ask >>= (return . Set.member name) - boundNames = ask - -type Subst = Map (Hsx.QName ()) (Hsx.Exp ()) - -{-| - This function extracts the set of the names that are bound by - the given piece of Haskell Syntax. --} - -boundNamesEnv :: Monad m => Env.EnvDef m HskNames -boundNamesEnv = Env.mkE fromExp - `Env.extE` fromAlt - `Env.extE` fromDecl - `Env.extE` fromMatch - `Env.extE` fromStmts - where fromExp :: Hsx.Exp () -> Env.Envs HskNames - fromExp (Hsx.Let _ binds _) - = let bound = Set.fromList $ extractBindingNs binds - in Env.Envs [bound, bound, bound] - fromExp (Hsx.Lambda _ pats _) - = let bound = Set.fromList $ extractBindingNs pats - in Env.Envs [Set.empty, bound, bound] - fromExp (Hsx.MDo _ stmts) - = let bound = Set.fromList $ extractBindingNs stmts - in Env.Envs [bound] - fromExp (Hsx.ListComp _ _ stmts) - = let bound = Set.fromList $ extractBindingNs stmts - in Env.Envs [bound, bound, bound] - fromExp exp = Env.uniEloc exp Set.empty - - fromAlt :: Hsx.Alt () -> HskNames - fromAlt (Hsx.Alt _ pat _ _) = Set.fromList $ extractBindingNs pat - - fromDecl :: Hsx.Decl () -> HskNames - fromDecl (Hsx.PatBind _ _ _ whereBinds) = Set.fromList $ - extractBindingNs whereBinds - fromDecl _ = Set.empty - - fromMatch :: Hsx.Match () -> HskNames - fromMatch (Hsx.Match _ _ pats _ whereBinds) - = Set.fromList $ - extractBindingNs whereBinds ++ extractBindingNs pats - fromMatch (Hsx.InfixMatch _ pat _ pats _ whereBinds) - = Set.fromList $ - extractBindingNs whereBinds ++ extractBindingNs pat ++ extractBindingNs pats - - fromStmts :: [Hsx.Stmt ()] -> Env.Envs HskNames - fromStmts [] = Env.Envs [] - fromStmts (Hsx.Generator loc pat exp : _) - = let bound = Set.fromList $ extractBindingNs pat - in Env.Envs [Set.empty, bound] - fromStmts (Hsx.Qualifier _ _ : _) - = Env.Envs [Set.empty, Set.empty] - fromStmts (Hsx.LetStmt _ binds : _) - = let bound = Set.fromList $ extractBindingNs binds - in Env.Envs [bound, bound] - -{-| - This is a monadic query function that returns - if the argument is a free name a singleton set - containing that name and otherwise an empty set. --} -freeNamesLocal :: GenericQ (BindingM HskNames) -freeNamesLocal hs = case name hs of - Nothing -> return Set.empty - Just name -> - do bound <- isBound name - if bound - then return Set.empty - else return (Set.singleton name) - where name = mkQ Nothing fromExp - `extQ`fromQOp - fromExp (Hsx.Var _ name) = Just name - fromExp _ = Nothing - - fromQOp (Hsx.QVarOp _ name) = Just name - fromQOp _ = Nothing - - -{-| - This function extracts names that are implicitly declared, such as data constructors - and record fields. --} -extractImplDeclNs :: Hsx.Decl () -> HskNames -extractImplDeclNs decl@(Hsx.DataDecl _ _ _ _ _ _) = - everything Set.union (mkQ Set.empty fromConDecl) decl - where fromConDecl (Hsx.ConDecl _ name _) = Set.singleton (Hsx.UnQual () name) - fromConDecl (Hsx.RecDecl _ name fields) = - Set.singleton (Hsx.UnQual () name) - `Set.union` Set.fromList (map (Hsx.UnQual ()) (concatMap (\(Hsx.FieldDecl _ ln _) -> ln) fields)) - -extractImplDeclNs _ = Set.empty - -{-| - This function extracts the names of data constructors used - in patters from the given piece of Haskell syntax. --} - -extractDataConNs :: Data a => a -> HskNames -extractDataConNs = everything Set.union (mkQ Set.empty fromPat) - where fromPat (Hsx.PApp _ name _) = Set.singleton name - fromPat (Hsx.PRec _ name _) = Set.singleton name - fromPat (Hsx.PInfixApp _ _ name _) = Set.singleton name - fromPat _ = Set.empty - -{-| - This function extracts the names of type constructors in the given piece of - Haskell syntax --} -extractTypeConNs :: Data a => a -> HskNames -extractTypeConNs = everything Set.union (mkQ Set.empty fromType `extQ` fromAsst) where - fromType (Hsx.TyCon _ name) = Set.singleton name - fromType (Hsx.TyVar _ _) = Set.empty - fromType (Hsx.TyTuple _ Hsx.Boxed typs) = Set.unions (map fromType typs) - fromType (Hsx.TyFun _ typ1 typ2) = Set.union (fromType typ1) (fromType typ2) - fromType (Hsx.TyForall _ _ _ typ) = fromType typ - fromType (Hsx.TyApp _ typ1 typ2) = Set.union (fromType typ1) (fromType typ2) - fromType (Hsx.TyParen _ typ) = fromType typ - fromType (Hsx.TyList _ typ) = fromType (Hsx.TyApp () (Hsx.TyCon () (Hsx.Special () (Hsx.ListCon ()))) typ) - fromType (Hsx.TyBang _ _ _ typ) = fromType typ - fromType typ = error ("extractTypeConNs: bad type " ++ show typ) - fromAsst :: Hsx.Asst () -> HskNames - fromAsst (Hsx.ClassA _ name _) = Set.singleton name - fromAsst (Hsx.ParenA _ ass) = fromAsst ass - fromAsst ass = error ("extractTypeConNs: bad asst " ++ show ass) - -{-| - This function returns the set of names of free variables - in the given piece of Haskell syntax. --} -extractFreeVarNs :: Data a => a -> HskNames -extractFreeVarNs = runBindingM . Env.everythingEnv boundNamesEnv Set.union freeNamesLocal - -{-| - This function extracts all used field labels --} -extractFieldNs :: Data a => a -> HskNames -extractFieldNs = everything Set.union (mkQ Set.empty fromPat `extQ` fromExp) - where fromPat (Hsx.PFieldPat _ field _) = Set.singleton field - fromExp (Hsx.FieldUpdate _ field _) = Set.singleton field - -applySubst :: Subst -> GenericT -applySubst subst = runBindingM . Env.everywhereEnv boundNamesEnv (applySubstLocal subst) - -applySubstLocal :: Subst -> GenericM BindingM -applySubstLocal subst node = - do bound <- boundNames - let apply = mkT applyExp - - applyExp exp@(Hsx.Var _ name) - = case doSubst name of - Nothing -> exp - Just new -> new - applyExp exp@(Hsx.InfixApp _ exp1 (Hsx.QVarOp _ name) exp2) - = case doSubst name of - Nothing -> exp - Just new -> Hsx.App () (Hsx.App () new exp1) exp2 - applyExp exp@(Hsx.LeftSection _ exp' (Hsx.QVarOp _ name)) - = case doSubst name of - Nothing -> exp - Just new -> Hsx.App () new exp' - applyExp exp@(Hsx.RightSection _ (Hsx.QVarOp _ name) exp') - = case doSubst name of - Nothing -> exp - Just new -> Hsx.App () (Hsx.App () (Hsx.Var () (Hsx.UnQual () (Hsx.Ident () "flip"))) new) exp' - applyExp exp = exp - - doSubst' name - | name `Set.member` bound - = Nothing - | otherwise - = Map.lookup name subst - doSubst = doSubst' - return (apply node) - -renameFreeVarsLocal :: [Renaming] -> GenericM BindingM -renameFreeVarsLocal renamings node = - do bound <- boundNames - let apply = mkT applyExp - `extT` applyQOp - - applyExp (Hsx.Var l name) = Hsx.Var l (ren name) - applyExp exp = exp - - applyQOp (Hsx.QVarOp l name) = Hsx.QVarOp l (ren name) - applyQOp qop = qop - - ren' name - | name `Set.member` bound - = name - | otherwise - = fromMaybe name (lookup name renamings) - ren = ren' - return (apply node) - -renameFreeVars :: Data a => [Renaming] -> a -> a -renameFreeVars renamings node = runBindingM $ Env.everywhereEnv boundNamesEnv (renameFreeVarsLocal renamings) node - -{-| - This type is used to describe renamings of variables. --} -type Renaming = (Hsx.QName (), Hsx.QName ()) - -{-| - This function generates renamings for all variables given in the - list to provide fresh names. --} -freshIdentifiers :: [Hsx.QName ()] -> Gensym.GensymM [Renaming] -freshIdentifiers qnames - = do freshs <- mapM Gensym.genHsQName qnames - return (zip qnames freshs) - -{-| - This function takes a list of variables (which are supposed to be bound) and a renaming - and reduces this renaming such that it does not affect bound variables. --} -shadow :: [Hsx.QName ()] -> [Renaming] -> [Renaming] -shadow boundNs renamings = filter ((`notElem` boundNs) . fst) renamings - -{-| - This function applies the given renaming to the given variable. --} -qtranslate :: [Renaming] -> Hsx.QName () -> Hsx.QName () -qtranslate renamings qname - = fromMaybe qname (lookup qname renamings) - -{-| - This function applies the given renaming to the given unqualified variable. --} -translate :: [Renaming] -> Hsx.Name () -> Hsx.Name () -translate renamings name - = let (Hsx.UnQual _ name') = qtranslate renamings (Hsx.UnQual () name) in name' - -{-| - This function applies the given renaming to all variables in the given - pattern. --} -renamePat :: [Renaming] -> Hsx.Pat () -> Hsx.Pat () -renamePat renams pat - = case pat of - Hsx.PVar l name -> Hsx.PVar l (translate renams name) - Hsx.PLit l s lit -> Hsx.PLit l s lit - Hsx.PInfixApp l pat1 qname pat2 -> Hsx.PInfixApp l pat1' qname' pat2' - where pat1' = renamePat renams pat1 - qname' = qtranslate renams qname - pat2' = renamePat renams pat2 - Hsx.PApp l qname pats -> Hsx.PApp l qname' pats' - where qname' = qtranslate renams qname - pats' = map (renamePat renams) pats - Hsx.PTuple l b pats -> Hsx.PTuple l b (map (renamePat renams) pats) - Hsx.PList l pats -> Hsx.PList l (map (renamePat renams) pats) - Hsx.PParen l pat -> Hsx.PParen l (renamePat renams pat) - Hsx.PWildCard l -> Hsx.PWildCard l - Hsx.PAsPat l name pat' -> Hsx.PAsPat l (translate renams name) (renamePat renams pat') - Hsx.PRec l name fields -> Hsx.PRec l name fields' - where fields' = map ren fields - ren (Hsx.PFieldPat l n p) = Hsx.PFieldPat l n (renamePat renams p) - _ -> error ("rename.Pat: Fall through: " ++ show pat) - -{-| - This function applies the given renaming to names bound by the given - Haskell declaration (only type signatures, function and pattern bindings - are affected). --} -renameDecl :: [Renaming] -> Hsx.Decl () -> Hsx.Decl () -renameDecl renamings decl = - case decl of - Hsx.TypeSig l names typ - -> Hsx.TypeSig l (map (translate renamings) names) typ - Hsx.FunBind l matches - -> Hsx.FunBind l (map renMatch matches) - Hsx.PatBind l pat rhs binds - -> Hsx.PatBind l (renamePat renamings pat) rhs binds - _ -> decl - where renMatch (Hsx.Match l name pats rhs binds) - = Hsx.Match l (translate renamings name) pats rhs binds -extractVarNs thing - = let varNs = [ qn | Hsx.Var _ qn <- universeBi thing ] - varopNs = [ qn | Hsx.QVarOp _ qn <- universeBi thing ] - ++ [ qn | Hsx.QConOp _ qn <- universeBi thing ] - in varNs ++ varopNs - -{-| - This function compares the two given declarations w.r.t. the - source location. --} -orderDeclsBySourceLine :: (Int, a) -> (Int, a) -> Ordering -orderDeclsBySourceLine (decl1, _) (decl2, _) = compare decl1 decl2 - -getSrcLoc :: Hsx.Decl () -> Hsx.SrcLoc -getSrcLoc decl - = head . sortBy compareLines $ (childrenBi decl :: [Hsx.SrcLoc]) - where compareLines loc1 loc2 - = compare (Hsx.srcLine loc1) (Hsx.srcLine loc2) - - -{-| - This function provides the source line where the given - declaration is made. --} -getSourceLine :: Hsx.Decl () -> Int -getSourceLine decl - = let srclocs = childrenBi decl :: [Hsx.SrcLoc] - lines = map Hsx.srcLine srclocs - in head (sort lines) - -showModuleName :: Hsx.ModuleName () -> String -showModuleName (Hsx.ModuleName _ name) = name - - -flattenRecFields :: [Hsx.FieldDecl ()] -> [(Hsx.Name (),Hsx.Type ())] -flattenRecFields = concatMap flatten - where flatten (Hsx.FieldDecl _ ns bType) = zip ns (replicate (length ns) bType) diff --git a/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/Importer/Ident_Env.hs b/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/Importer/Ident_Env.hs deleted file mode 100644 index 9874b4e6fa0a8da845a32df89963ea2149c5e1df..0000000000000000000000000000000000000000 --- a/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/Importer/Ident_Env.hs +++ /dev/null @@ -1,1455 +0,0 @@ -{-# LANGUAGE MultiParamTypeClasses, FlexibleContexts, FlexibleInstances, TypeSynonymInstances, GeneralizedNewtypeDeriving #-} - -{-| Author: Tobias C. Rittweiler, TU Muenchen - -Definition of a Global Environment for identifier resolution and information -retrieval. --} - -module Importer.Ident_Env - ( GlobalE, - Assoc(..), - Identifier(..), - Constant(..), - Type(..), - TypeDecl(..), - Name(..), - LexInfo(..), - Import(..), - Constructor(..), - RecordField(..), - ModuleID, - IdentifierID, - identifier2name, - getDepDataType, - fromHsk, - toHsk, - fromIsa, - toIsa, - typscheme_of_hsk_typ, - hsk_typ_of_typscheme, - isa_of_sort, - resolveName_OrLose, - resolveName_NoLose, - makeLexInfo, - makeClassInfo, - initialGlobalEnv, - isInfixOp, - isUnaryOp, - isClass, - isType, - isInstance, - isFunction, - isData, - isTypeAnnotation, - qualifyName, - resolveConstantName, - resolveTypeName, - unionGlobalEnvs, - augmentGlobalEnv, - updateGlobalEnv, - updateIdentifier, - renameHsModuleNames, - environmentOf, - makeGlobalEnv, - lookupConstant, lookupConstant_OrLose, - lookupType, lookupType_OrLose, - substituteTyVars, - lookupIdentifiers_OrLose, - lookupImports, - lexInfoOf, - methodsOf, - classVarOf, - prelude - ) where - -import Importer.Library -import qualified Importer.AList as AList -import Data.Function -import Data.Maybe -import Data.List (partition, nub) -import qualified Data.Map as Map - -import Control.Monad.Reader - -import qualified Importer.Msg as Msg -import Importer.Configuration hiding (getCustomTheory) -import qualified Importer.Configuration as Conf (getCustomTheory) - -import qualified Language.Haskell.Exts as Hsx -import qualified Importer.Hsx as Hsx -import qualified Importer.Isa as Isa - - -newtype LexM a = LexM (Reader Customisations a) - deriving (Functor, Applicative, Monad, MonadReader Customisations) - -runLexM :: Customisations -> LexM a -> a -runLexM c (LexM m) = runReader m c - -{-| - This function returns the custom theory for given module name if there is one. --} -getCustomTheory :: Hsx.ModuleName () -> LexM (Maybe CustomTheory) -getCustomTheory mod - = do custs <- ask - return $ Conf.getCustomTheory custs mod - - ---- ---- Identifier information --- --- This is used for information retrieval about an identifier. --- E.g. if an identifier represents a function, or a class, etc. --- - -type ModuleID = String -type IdentifierID = String - - -{-| - This data structure represents types. NB: It also contains an 'EnvTyNone' type to - indicate that no type information is present. --} -data Type = TyVar Name - | TyCon Name [Type] - | TyFun Type Type - | TyNone - deriving (Eq, Ord, Show) - -{-| - This data structure represents the associativity declaration of binary operators. --} -data Assoc = AssocRight | AssocLeft | AssocNone - deriving (Eq, Ord, Show) - -{-| - This data structure represents identifier name in either unqualified or qualified form. --} -data Name = QualName ModuleID IdentifierID - | UnqualName IdentifierID - deriving (Eq, Ord, Show) - -{-| - Checks whether an environment name is qualified by a module. --} - -isQualified :: Name -> Bool -isQualified (QualName _ _) = True -isQualified (UnqualName _) = False - -{-| - Qualifies an existing environment name with a module. - If the name is already qualified nothing is changed. --} - -qualifyName :: ModuleID -> Name -> Name -qualifyName mID qn@(QualName mID' _) = qn -qualifyName mID (UnqualName n) = QualName mID n - -{-| - If the given environment name is qualified with the given - module the qualification is removed and the corresponding - unqualified name is returned. If the modules do not match an exception - is thrown. - Unqualified environment names are left untouched. --} - -unqualifyName :: ModuleID -> Name -> Name -unqualifyName mID (QualName mID' id) = assert (mID == mID') $ UnqualName id -unqualifyName mID n@(UnqualName _) = n - - -{-| - This function substitutes type variables by types - as given by the substitution argument. - E.g.: - @substituteTyVars [(a, Quux)] (Foo a -> Foobar a b -> Bar a b)@ - ==> - @Foo Quux -> Foobar Quux b -> Bar Quux b@ --} -substituteTyVars :: [(Type, Type)] -- ^the substitution to use - -> Type -- ^the type to apply the substitution to - -> Type -- ^the resulting type -substituteTyVars alist typ - = let lookup' = Prelude.lookup in - case typ of - t@(TyVar _) -> case lookup' t alist of - Just t' -> t' - Nothing -> t - t@(TyCon cN ts) -> case lookup' t alist of - Just t' -> t' - Nothing -> TyCon cN (map (substituteTyVars alist) ts) - t@(TyFun t1 t2) -> case lookup' t alist of - Just t' -> t' - Nothing -> TyFun (substituteTyVars alist t1) - (substituteTyVars alist t2) - t@(TyNone) -> case lookup' t alist of { Just t' -> t'; Nothing -> t } - -{-| - This data type collects identifier information attached to - an identifier --} - -data LexInfo = LexInfo { - nameOf :: IdentifierID, - typschemeOf :: ([(Name, [Name])], Type), - moduleOf :: ModuleID -} deriving (Eq, Ord, Show) - - -{-| - This data type collects information that is - attached to a class. --} -data ClassInfo = ClassInfo { - superclassesOf :: [Name], - methodsOf :: [Identifier], - classVarOf :: Name, - instancesOf :: [InstanceInfo] - } - deriving (Eq, Ord, Show) - -{-| - This data type collects information about --} - -data InstanceInfo = InstanceInfo { specializedTypeOf :: Type } - deriving (Eq, Ord, Show) - -{-| - This data structure represents identifier information for - different kinds of constants. --} - -data Constant = Variable LexInfo - | Constructor Constructor - | Field LexInfo [Constructor] - | Function LexInfo - | UnaryOp LexInfo Int - | InfixOp LexInfo Assoc (Maybe Int) - | TypeAnnotation LexInfo - deriving (Eq, Ord, Show) - -data Constructor = SimpleConstr {constrTypeName :: Name, constrLexInfo :: LexInfo} - | RecordConstr {constrTypeName :: Name, constrLexInfo :: LexInfo, constrFields :: [RecordField]} - deriving (Eq, Ord, Show) - -data RecordField = RecordField IdentifierID Type - deriving (Eq, Ord, Show) - -{-| - This data structure represents identifier information for - different kinds of type declaration. --} -data TypeDecl = Data LexInfo [Constructor] - | TypeDef LexInfo - | Class LexInfo ClassInfo - | Instance LexInfo [InstanceInfo] - deriving (Eq, Ord, Show) - -{-| - Identifier forms the union of the 'Type' and 'Constant' type. The reasong for this - is that types and constants live in different namespaces. --} -data Identifier = Constant Constant - | TypeDecl TypeDecl - deriving (Eq, Ord, Show) - -{-| - This function constructs a identifier information structure, given a module - the identifier and the type of the identifier. --} -makeLexInfo :: ModuleID -> IdentifierID -> ([(Name, [Name])], Type) -> LexInfo -makeLexInfo moduleID identifierID t = LexInfo { - nameOf = identifierID, - typschemeOf = t, - moduleOf = if moduleID == "" then prelude else moduleID -} - -{-| - This function constructs a class information structure, given a list of its - super classes, a list of the methods defined in the class and the variable - that is declared to be in the class. --} -makeClassInfo :: [Name] -> [Identifier] -> Name -> ClassInfo -makeClassInfo superclasses methods classVarName - = assert (all isTypeAnnotation methods) - $ ClassInfo { superclassesOf = superclasses, - methodsOf = methods, - classVarOf = classVarName, - instancesOf = [] } -{-| - ??? --} -makeInstanceInfo :: Type -> InstanceInfo -makeInstanceInfo t - = InstanceInfo { specializedTypeOf = t } - -{-| - Returns true for identifiers being a constant. --} -isConstant :: Identifier -> Bool -isConstant (Constant _) = True -isConstant _ = False - -{-| - Returns true for identifiers being a type. --} -isType :: Identifier -> Bool -isType (TypeDecl _) = True -isType _ = False - -{-| - Returns true for identifiers being a variable. --} -isVariable :: Identifier -> Bool -isVariable (Constant (Variable _)) = True -isVariable _ = False - -{-| - Returns true for identifiers being a function. --} -isFunction :: Identifier -> Bool -isFunction (Constant (Function _)) = True -isFunction _ = False - -{-| - Returns true for identifiers being unary operators. --} -isUnaryOp :: Identifier -> Bool -isUnaryOp (Constant (UnaryOp _ _)) = True -isUnaryOp _ = False - -{-| - Returns true for identifiers being infix operators. --} -isInfixOp :: Identifier -> Bool -isInfixOp (Constant (InfixOp _ _ _)) = True -isInfixOp _ = False - -{-| - Returns true for identifiers being type annotations. --} -isTypeAnnotation :: Identifier -> Bool -isTypeAnnotation (Constant (TypeAnnotation _)) = True -isTypeAnnotation _ = False - - -{-| - Returns true for identifiers being classes. --} -isClass :: Identifier -> Bool -isClass (TypeDecl (Class _ _)) = True -isClass _ = False - -{-| - Returns true for identifiers being instance declarations. --} -isInstance :: Identifier -> Bool -isInstance (TypeDecl (Instance _ _)) = True -isInstance _ = False - -{-| - Returns true for identifiers being data types. --} -isData :: Identifier -> Bool -isData (TypeDecl (Data _ _)) = True -isData _ = False - -{-| - This function provides the information attached to the - given identifier. --} -lexInfoOf :: Identifier -> LexInfo -lexInfoOf identifier - = case identifier of - Constant c -> lexInfoOf_con c - TypeDecl t -> lexInfoOf_typ t - where - lexInfoOf_con (Variable i) = i - lexInfoOf_con (Field i _) = i - lexInfoOf_con (Function i) = i - lexInfoOf_con (UnaryOp i _) = i - lexInfoOf_con (InfixOp i _ _) = i - lexInfoOf_con (TypeAnnotation i) = i - lexInfoOf_con (Constructor con) = - case con of - SimpleConstr _ i -> i - RecordConstr _ i _ -> i - - lexInfoOf_typ (Class i _) = i - lexInfoOf_typ (Instance i _) = i - lexInfoOf_typ (Data i _) = i - lexInfoOf_typ (TypeDef i ) = i - - - -getDepDataType :: GlobalE -> ModuleID -> Name -> Maybe Name -getDepDataType env mod name = - case lookupConstant mod name env of - Nothing -> Nothing - Just (Constant c) -> - case c of - Field _ (constr:_) -> Just $ constrTypeName constr - Constructor constr -> Just $ constrTypeName constr - _ -> Nothing - - -{-| - This function updates the identifier information attached to the - given identifier. --} -updateIdentifier :: Identifier -> LexInfo -> Identifier -updateIdentifier identifier lexinfo - = case identifier of - Constant c -> Constant (updateConstant c lexinfo) - TypeDecl t -> TypeDecl (updateType t lexinfo) - where - updateConstant (Variable _) lexinfo = Variable lexinfo - updateConstant (Field _ constr) lexinfo = Field lexinfo constr - updateConstant (Constructor c) lexinfo - = Constructor $ - case c of - SimpleConstr dataTy _ -> SimpleConstr dataTy lexinfo - RecordConstr dataTy _ fs -> RecordConstr dataTy lexinfo fs - updateConstant (Function _) lexinfo = Function lexinfo - updateConstant (UnaryOp _ p) lexinfo = UnaryOp lexinfo p - updateConstant (InfixOp _ a p) lexinfo = InfixOp lexinfo a p - updateConstant (TypeAnnotation _) lexinfo = TypeAnnotation lexinfo - - updateType (Data _ conNs) lexinfo = Data lexinfo conNs - updateType (Class _ classinfo) lexinfo = Class lexinfo classinfo - updateType (Instance _ instinfo) lexinfo = Instance lexinfo instinfo - updateType (TypeDef _) lexinfo = TypeDef lexinfo -{-| - This function provides the environment name for the given identifier --} -identifier2name :: Identifier -> Name -identifier2name identifier - = let lexinfo = lexInfoOf identifier - name = nameOf lexinfo - modul = moduleOf lexinfo - in assert (modul /= "") $ QualName modul name - -{-| - This function provides the environment name for the given constant. --} -constant2name :: Constant -> Name -constant2name c = identifier2name (Constant c) - -{-| - This function provides the environment name for the given type. --} -type2name :: TypeDecl -> Name -type2name t = identifier2name (TypeDecl t) - -{-| - This function splits the given list into a list of constants and - a list of types. --} -splitIdentifiers :: [Identifier] -> ([Constant], [TypeDecl]) -splitIdentifiers ids - = let (c_ids, t_ids) - = partition (\i -> case i of {Constant _ -> True; _ -> False}) ids - in - ([ c | Constant c <- c_ids ], [ t | TypeDecl t <- t_ids ]) - - -{-| - Instances of this class are pairs of at the one hand a Haskell entity and on the - other and an environment entity that can be translated into each other. --} -class Hsk2Env a b where - fromHsk :: Show a => a -> b - toHsk :: Show b => b -> a - toHsk b = error ("(toHsk) Internal Error: Don't know how to convert: " ++ show b) - - -instance Hsk2Env (Hsx.ModuleName ()) ModuleID where - fromHsk (Hsx.ModuleName _ id) = id - toHsk id = Hsx.ModuleName () id - -instance Hsk2Env (Hsx.QName ()) IdentifierID where - fromHsk (Hsx.Qual _ _ n) = fromHsk n - fromHsk (Hsx.UnQual _ n) = fromHsk n - fromHsk (Hsx.Special _ s) = fromHsk (translateSpecialCon DataCon s) - - toHsk junk = error ("toHsk ConstantID -> Hsx.Name: " ++ show junk) - -instance Hsk2Env (Hsx.Name ()) IdentifierID where - fromHsk (Hsx.Ident _ s) = s - fromHsk (Hsx.Symbol _ s) = s - toHsk id = Hsx.string2Name id - - -instance Hsk2Env (Hsx.QName ()) Name where - fromHsk (Hsx.Qual _ m n) = QualName (fromHsk m) (fromHsk n) - fromHsk (Hsx.UnQual _ n) = UnqualName (fromHsk n) - fromHsk (Hsx.Special _ s) = fromHsk (translateSpecialCon DataCon s) - - toHsk (QualName moduleId id) = let qname = Hsx.Qual () (toHsk moduleId) (toHsk id) - in case retranslateSpecialCon DataCon qname of - Just s -> Hsx.Special () s - Nothing -> qname - toHsk (UnqualName id) = Hsx.UnQual () (toHsk id) - -instance Hsk2Env (Hsx.Name ()) Name where - fromHsk hsname = UnqualName (fromHsk hsname) - toHsk (UnqualName id) = toHsk id - toHsk junk = error ("toHsk Ident_Env.Name -> Hsx.Name: " ++ show junk) - -instance Hsk2Env (Hsx.Assoc ()) Assoc where - fromHsk (Hsx.AssocRight ()) = AssocRight - fromHsk (Hsx.AssocLeft ()) = AssocLeft - fromHsk (Hsx.AssocNone ()) = AssocNone - - toHsk AssocRight = Hsx.AssocRight () - toHsk AssocLeft = Hsx.AssocLeft () - toHsk AssocNone = Hsx.AssocNone () - -instance Hsk2Env (Hsx.TyVarBind ()) Name where - fromHsk (Hsx.KindedVar _ n _) = fromHsk n - fromHsk (Hsx.UnkindedVar _ n) = fromHsk n - -instance Hsk2Env (Hsx.Type ()) Type where - fromHsk (Hsx.TyVar _ name) = TyVar (fromHsk name) - fromHsk (Hsx.TyCon _ qname) = TyCon (fromHsk (translate qname)) [] - where translate (Hsx.Special _ s) = translateSpecialCon TypeCon s - translate etc = etc - - fromHsk (Hsx.TyTuple _ Hsx.Boxed []) = TyCon (fromHsk unit_tyco) [] - fromHsk (Hsx.TyTuple _ Hsx.Boxed [typ]) = fromHsk typ - fromHsk (Hsx.TyTuple _ Hsx.Boxed (typ1 : typ2 : typs)) = combl - (\typ1 -> \typ2 -> TyCon (fromHsk pair_tyco) [typ1, fromHsk typ2]) - (TyCon (fromHsk pair_tyco) [fromHsk typ1, fromHsk typ2]) typs - - fromHsk (Hsx.TyFun _ type1 type2) = let - type1' = fromHsk type1 - type2' = fromHsk type2 - in TyFun type1' type2' - - -- Types aren't curried or partially appliable in HOL, so we must pull a nested - -- chain of type application inside out: - -- - -- T a b ==> Hsx.TyApp (Hsx.TyApp (Hsx.Type T) (Hsx.TyVar a)) (Hsx.TyVar b) - -- - -- ==> Type T [(TyVar a), (TyVar b)] - -- - fromHsk tyapp@(Hsx.TyApp _ _ _) - = let (tycon, tyvars) = uncombl dest tyapp - tycon' = fromHsk tycon - tyvars' = map fromHsk tyvars - in case tycon' of TyCon n [] -> TyCon n tyvars' - where dest (Hsx.TyApp _ typ1 typ2) = Just (typ1, typ2) - dest (Hsx.TyCon _ _) = Nothing - dest junk = error ("Hsx.Type -> Ident_Env.Type (dest Hsx.TyApp): " ++ show junk) - - fromHsk (Hsx.TyParen _ typ) = fromHsk typ - fromHsk (Hsx.TyForall _ _ _ typ) = fromHsk typ - fromHsk (Hsx.TyBang _ _ _ typ) = fromHsk typ - - fromHsk (Hsx.TyList _ typ) = fromHsk (Hsx.TyApp () (Hsx.TyCon () (Hsx.Special () (Hsx.ListCon ()))) typ) - - fromHsk junk = error ("Hsx.Type -> Ident_Env.Type: Fall Through: " ++ Msg.prettyShow' "thing" junk) - - toHsk (TyVar n) = Hsx.TyVar () (toHsk n) - toHsk (TyFun t1 t2) = Hsx.TyFun () (toHsk t1) (toHsk t2) - toHsk (TyCon qn []) = Hsx.TyCon () (toHsk qn) - toHsk (TyCon qn tyvars) - = let tycon' = toHsk (TyCon qn []) - tyvar':tyvars' = map toHsk tyvars - in foldl (Hsx.TyApp ()) (Hsx.TyApp () tycon' tyvar') tyvars' - -typscheme_of_hsk_typ :: Hsx.Type () -> ([(Name, [Name])], Type) -typscheme_of_hsk_typ (Hsx.TyForall _ _ (Just ctx) typ) = - (map (map_pair fromHsk (map fromHsk)) (Hsx.dest_typcontext ctx), fromHsk typ) -typscheme_of_hsk_typ typ = ([], fromHsk typ) - -hsk_typ_of_typscheme :: ([(Name, [Name])], Type) -> Hsx.Type () -hsk_typ_of_typscheme (vs, typ) = Hsx.TyForall () Nothing (Just (Hsx.CxTuple () ctx)) (toHsk typ) where - aux = AList.group $ concat [ map (flip (,) tyvarN) classNs | (tyvarN, classNs) <- vs ] - ctx = [ Hsx.ClassA () (toHsk classN) (map (Hsx.TyVar () . toHsk) tyvarNs) | (classN, tyvarNs) <- aux ] - -{- toHsk (TyScheme alist t) = Hsx.TyForall Nothing ctx (toHsk t) - where - revalist = AList.group - $ concat [ map (flip (,) tyvarN) classNs | (tyvarN, classNs) <- alist ] - ctx = [ Hsx.ClassA (toHsk classN) (map (Hsx.TyVar . toHsk) tyvarNs) - | (classN, tyvarNs) <- revalist ] - - toHsk junk = error ("Type -> Hsx.Type: Fall Through: " ++ Msg.prettyShow' "thing" junk) -} -instance Hsk2Env (Hsx.ExportSpec ()) Export where - fromHsk (Hsx.EVar _ qname) = ExportVar (fromHsk qname) - fromHsk (Hsx.EAbs _ _ qname) = ExportAbstr (fromHsk qname) -- FIXME namespace ignored in matched pattern - fromHsk (Hsx.EThingWith _ _ qname _) = ExportAll (fromHsk qname) -- FIXME this is an over-approximation - fromHsk (Hsx.EModuleContents _ m) = ExportMod (fromHsk m) - -instance Hsk2Env (Hsx.ImportDecl ()) Import where - fromHsk (Hsx.ImportDecl { Hsx.importModule=m, - Hsx.importQualified=qual, - Hsx.importAs=nick}) - = Import (fromHsk m) qual - (case nick of - Nothing -> Nothing - Just nick' -> Just $ fromHsk nick') - -{-| - Instances of this class are two types, on the one hand side Isabelle entities and on the other - hand side environment entities, that can be converted into each other. --} -class Isa2Env a b where - fromIsa :: Show a => a -> b - toIsa :: Show b => b -> a - toIsa b = error ("(toIsa) Internal Error: Don't know how to lift " ++ show b) - -instance Isa2Env Isa.ThyName ModuleID where - fromIsa (Isa.ThyName thyN) = thyN - toIsa moduleID = Isa.ThyName moduleID - -instance Isa2Env Isa.Name Name where - fromIsa (Isa.QName thy n) = QualName (fromIsa thy) n - fromIsa (Isa.Name n) = UnqualName n - - toIsa (QualName moduleId id) = Isa.QName (toIsa moduleId) id - toIsa (UnqualName id) = Isa.Name id - -instance Isa2Env Assoc Assoc where - fromIsa AssocRight = AssocRight - fromIsa AssocLeft = AssocLeft - fromIsa AssocNone = AssocNone - - toIsa AssocRight = AssocRight - toIsa AssocLeft = AssocLeft - toIsa AssocNone = AssocNone - -instance Isa2Env Isa.Type Type where - fromIsa Isa.NoType = TyNone - fromIsa (Isa.TVar n) = TyVar (fromIsa n) - fromIsa (Isa.Func t1 t2) = TyFun (fromIsa t1) (fromIsa t2) - fromIsa (Isa.Type qn tyvars) = TyCon (fromIsa qn) (map fromIsa tyvars) - - toIsa TyNone = Isa.NoType - toIsa (TyVar n) = Isa.TVar (toIsa n) - toIsa (TyFun t1 t2) = Isa.Func (toIsa t1) (toIsa t2) - toIsa (TyCon qn tyvars) = Isa.Type (toIsa qn) (map toIsa tyvars) - -isa_of_sort :: [Name] -> [Isa.Name] -isa_of_sort = map toIsa - -{-| - This data type represents which kind a particular constructor is of. - I.e. a data or a type constructor. We have to translate those to names, - because they're not special in Isabelle, and hence not in our Global Environment. --} - -data ConKind = DataCon | TypeCon deriving Show - -{-| - This function translates special constructors to primitive qualified names. --} -translateSpecialCon :: ConKind -- ^the kind of the constructor - -> Hsx.SpecialCon () -- ^the constructor to translate - -> Hsx.QName () -- ^the translated constructor -translateSpecialCon DataCon con = case Prelude.lookup con primitive_datacon_table of - Just name -> name - Nothing -> error $ "Internal error: Special data constructor " ++ show con ++ " not found!" -translateSpecialCon TypeCon con = case Prelude.lookup con primitive_tycon_table of - Just name -> name - Nothing -> error $ "Internal error: Special type constructor " ++ show con ++ " not found!" - -{-| - This is the \"reverse\" of 'translateSpecialCon'. It translates qualified names into - special syntax constructors if possible. --} -retranslateSpecialCon :: ConKind -> Hsx.QName () -> Maybe (Hsx.SpecialCon ()) -retranslateSpecialCon DataCon qname - = Prelude.lookup qname [ (y,x) | (x,y) <- primitive_datacon_table ] -retranslateSpecialCon TypeCon qname - = Prelude.lookup qname [ (y,x) | (x,y) <- primitive_tycon_table ] - -unit_tyco = Hsx.Ident () "UnitTyCon" -pair_tyco = Hsx.Ident () "PairTyCon" - -primitive_tycon_table, primitive_datacon_table :: [(Hsx.SpecialCon (), Hsx.QName ())] - -primitive_tycon_table - = [(Hsx.ListCon (), Hsx.Qual () (Hsx.ModuleName () "Prelude") (Hsx.Ident () "ListTyCon")), - (Hsx.UnitCon (), Hsx.Qual () (Hsx.ModuleName () "Prelude") unit_tyco), - (Hsx.TupleCon () Hsx.Boxed 2, Hsx.Qual () (Hsx.ModuleName () "Prelude") pair_tyco) - ] - -primitive_datacon_table - = [(Hsx.Cons (), Hsx.Qual () (Hsx.ModuleName () "Prelude") (Hsx.Ident () ":")), - (Hsx.ListCon (), Hsx.Qual () (Hsx.ModuleName () "Prelude") (Hsx.Ident () "[]")), - (Hsx.UnitCon (), Hsx.Qual () (Hsx.ModuleName () "Prelude") (Hsx.Ident () "()")), - (Hsx.TupleCon () Hsx.Boxed 2, Hsx.Qual () (Hsx.ModuleName () "Prelude") (Hsx.Ident () "PairDataCon")) - ] - - --- --- Mappings between identifier's name and the Identifier data type. --- - -{-| - This data structure provides identifier information for constants and types. --} -data ConstTypes = ConstTypes (Map.Map IdentifierID Constant) (Map.Map IdentifierID TypeDecl) - deriving Show - -{-| - This function takes a list of identifiers (that contain identifier information) and collects the - identifier information in a lexical environment. The identifiers are normalized, i.e. possibly merged. --} -makeEnvConstTypes :: [Identifier] -> ConstTypes -makeEnvConstTypes identifiers - = let (constants, types) = splitIdentifiers identifiers - constant_bindings = zip (map (nameOf . lexInfoOf . Constant) constants) constants - type_bindings = zip (map (nameOf . lexInfoOf . TypeDecl) types) types - constants_map = Map.fromListWith mergeConstants_OrFail constant_bindings - types_map = Map.fromListWith mergeTypes_OrFail type_bindings - in - ConstTypes constants_map types_map - -{-| - Same as 'mergeConstants' but throws an exception if it was not successful. - - There are some declarations which affect the same identifier even though the declarations - are apart from each other. We merge the information comming from such declarations. - - E.g. explicit type annotations affect function-binding declarations, - instance declarations affect the class defined by some class declaration. --} - -mergeConstants_OrFail :: Constant -> Constant -> Constant -mergeConstants_OrFail c1 c2 - = case mergeConstants c1 c2 of - Just result -> result - Nothing -> error (Msg.merge_collision "mergeConstants_OrFail" c1 c2) - -{-| - Same as 'mergeTypes' but throws an exception if it was not successful. --} -mergeTypes_OrFail :: TypeDecl -> TypeDecl -> TypeDecl -mergeTypes_OrFail t1 t2 - = case mergeTypes t1 t2 of - Just result -> result - Nothing -> error (Msg.merge_collision "mergeTypes_OrFail" t1 t2) - -{-| - This function merges two identifier information blocks involving classes (i.e., also instance declarations for - a particular class). It throws an exception if the arguments have different names. - It merges instances into the instancesOf slot of the corresponding class's ClassInfo - structure. --} -mergeTypes :: TypeDecl -> TypeDecl -> Maybe TypeDecl -mergeTypes t1 t2 - = assert (nameOf (lexInfoOf (TypeDecl t1)) == nameOf (lexInfoOf (TypeDecl t2))) - $ case (t1, t2) of - (Class lexinfo classinfo@(ClassInfo { instancesOf = old_insts }), Instance _ instinfos) - -> Just $ Class lexinfo (classinfo { instancesOf = instinfos ++ old_insts}) - (Instance _ instinfos, Class lexinfo classinfo@(ClassInfo { instancesOf = old_insts })) - -> Just $ Class lexinfo (classinfo { instancesOf = instinfos ++ old_insts}) - (Instance lexinfo instinfos1, Instance _ instinfos2) - -> Just $ Instance lexinfo (instinfos1 ++ instinfos2) - (_,_) | t1 == t2 -> Just t1 - | otherwise -> Nothing - -{-| - This function merges type annotations with identifier information for constants. --} -mergeConstants :: Constant -> Constant -> Maybe Constant -mergeConstants c1 c2 - = assert (constant2name c1 == constant2name c2) - $ let merge c1 c2 - = case (c1, c2) of - -- Update saved types from explicit type annotations: - (Variable i, TypeAnnotation ann) -> Just $ Variable (update i ann) - (Function i, TypeAnnotation ann) -> Just $ Function (update i ann) - (UnaryOp i p, TypeAnnotation ann) -> Just $ UnaryOp (update i ann) p - (InfixOp i a p, TypeAnnotation ann) -> Just $ InfixOp (update i ann) a p - (_,_) -> Nothing - in case merge c1 c2 of { Just c' -> Just c'; Nothing -> merge c2 c1 } - where - update lexinfo@(LexInfo { typschemeOf = ([], TyNone) }) (LexInfo { typschemeOf = typ }) - = lexinfo { typschemeOf = typ } - update lexinfo typ -- Cannot merge + internal inconsistency. - = error ("Internal Error (mergeLexInfo): Type collision between `" ++ show lexinfo ++ "'" - ++ " and `" ++ show typ ++ "'.") - -{-| - This function merges two lexical environments by merging constants and types - separately. If two identifiers cannot be merged the identifier from the first - environment is discarded! --} -mergeEnvConstTypess (ConstTypes cmap1 tmap1) (ConstTypes cmap2 tmap2) - = ConstTypes (Map.unionWith constant_merger cmap1 cmap2) - (Map.unionWith type_merger tmap1 tmap2) - where - constant_merger c1 c2 = case mergeConstants c1 c2 of - Nothing -> c2 -- favorize second argument. - Just res -> res - type_merger t1 t2 = case mergeTypes t1 t2 of - Nothing -> t2 - Just res -> res - -{-| - This data structure represents export declarations. --} -data Export = ExportVar Name -- ^exporting a variable - | ExportAbstr Name -- ^exporting a class or data type abstractly - | ExportAll Name -- ^exporting a class or data type completely - | ExportMod ModuleID -- ^re-exporting a module - deriving (Show, Eq) - -{-| - This data structure represents import declarations. - This includes - - * the name of the imported module, - - * a flag indicating whether the import is qualified, and - - * possibly an alias name. --} -data Import = Import ModuleID Bool (Maybe ModuleID) - deriving (Show, Eq) - - -{-| - This data structure represents the environment of a complete module. - This includes the name of the module, a list of its imports, a list of its exports - and its lexical environment. --} -data Module = Module { moduleEName :: ModuleID, moduleEImports :: [Import], - moduleEExports :: [Export], moduleELex :: ConstTypes } - deriving (Show) - -{-| - The default import. --} -defaultImports = [Import prelude False Nothing] - - -{-| - This function checks whether the import is declared to be - qualified. --} -isQualifiedImport :: Import -> Bool -isQualifiedImport (Import _ isQual _) = isQual - -{-| - This function constructs a module environment from a list of imports, a predicate - indicating which identifier to export and a list of declared identifiers. --} -makeEnvModule :: [Import] -- ^import declarations - -> (Identifier -> Bool) -- ^predicate indicating which identifiers to export - -> [Identifier] -- ^declared identifiers - -> Module -- ^constructed environment -makeEnvModule imports shall_export_p identifiers - = let m = moduleOf (lexInfoOf (head identifiers)) - in assert (all (== m) $ map (moduleOf . lexInfoOf) (tail identifiers)) - $ Module m imports exports (makeEnvConstTypes identifiers) - where - exports = map export (filter shall_export_p identifiers) - export id@(TypeDecl (Data _ _)) = ExportAll (identifier2name id) - export id = ExportVar (identifier2name id) - -{-| - This function constructs a module environment from a Haskell module. --} -makeEnvModule_FromModule :: Hsx.ModuleName () -> Hsx.Module () -> LexM Module -makeEnvModule_FromModule modul (Hsx.Module lmod exports _ imports topdecls) - = let env = makeEnvConstTypes (concatMap (computeConstantMappings modul) topdecls) - imports' = map fromHsk imports ++ defaultImports - exports' = case exports of - Just (Hsx.ModuleHead _ _ _ (Just (Hsx.ExportSpecList _ jexports))) -> map fromHsk jexports - _ -> [ExportMod (fromHsk modul)] - mod = fromHsk modul - in return $ Module mod imports' exports' env - -customExportList :: ModuleID -> CustomTheory -> [Export] -customExportList mod custThy - = let constants = getCustomConstants custThy - constants' = map (ExportVar . QualName mod) constants - types = getCustomTypes custThy - types' = map (ExportAll . QualName mod) types - in constants' ++ types' - -customEnvConstTypes :: ModuleID -> CustomTheory -> ConstTypes -customEnvConstTypes mod custThy - = let constants = getCustomConstants custThy - types = getCustomTypes custThy - in ConstTypes (env Variable constants) (env (`Data` []) types) - where env ctr exps = Map.fromListWith (\a b -> a) $ - map (\a -> (a,ctr $ LexInfo {nameOf = a, typschemeOf = ([], TyNone), moduleOf = mod})) exps - -{-| - This function infers identifier information for the identifiers mentioned in the given Haskell - declaration. --} -computeConstantMappings :: Hsx.ModuleName () -> Hsx.Decl () -> [Identifier] -computeConstantMappings modul decl - = do name <- Hsx.namesFromDeclInst decl - let nameID = fromHsk name - let moduleID = fromHsk modul - let defaultLexInfo = LexInfo { nameOf=nameID, typschemeOf=([], TyNone), moduleOf=moduleID} - let declHead ns = case ns of Hsx.DHead _ n -> (n, []) - Hsx.DHInfix _ t n -> (n, [t]) - Hsx.DHParen _ ns -> declHead ns - Hsx.DHApp _ ns t -> map_pair id (\l -> l ++ [t]) $ declHead ns - case decl of - Hsx.PatBind _ _ _ _ -> [Constant (Variable defaultLexInfo)] - Hsx.FunBind _ _ -> [Constant (Function defaultLexInfo)] - Hsx.InfixDecl _ a p _ -> [Constant (InfixOp defaultLexInfo (fromHsk a) p)] - Hsx.TypeSig _ _ typ -> [Constant (TypeAnnotation (defaultLexInfo { typschemeOf = typscheme_of_hsk_typ typ }))] - Hsx.ClassDecl _ ctx ns _ ds -> let - sups = map fromHsk (Hsx.extractSuperclassNs ctx) - typesigs = Hsx.extractMethodSigs ds - m = modul - methods = concatMap (computeConstantMappings m) typesigs - -- If length ns > 1, we will die later in Convert.hs anyway. - classInfo = makeClassInfo sups methods (fromHsk (head $ snd $ declHead ns)) - in [TypeDecl (Class defaultLexInfo classInfo)] - -- If length ts > 1, we will die later in Convert.hs anyway. - Hsx.InstDecl _ _ ts _ -> let - instRule ts = case ts of Hsx.IRule _ _ _ t -> instHead t - Hsx.IParen _ ts -> instRule ts - instHead ts = case ts of Hsx.IHCon _ _ -> [] - Hsx.IHInfix _ t _ -> [t] - Hsx.IHParen _ ts -> instHead ts - Hsx.IHApp _ ts t -> instHead ts ++ [t] - in [TypeDecl (Instance defaultLexInfo $ [makeInstanceInfo (fromHsk (head $ instRule ts))])] - Hsx.DataDecl _ _ _ con_tyvar condecls _ - -> assert (fromHsk conN == nameID) $ - let tycon = mkType (fromHsk name) tyvarNs - constructors = map (mkDataCon tycon) condecls - constructors' = map (Constant . Constructor) constructors - fields = concatMap mkRecordFields constructors - fields' = mergeFields fields - in [TypeDecl (Data (defaultLexInfo { typschemeOf = ([], tycon) }) constructors)] ++ constructors' - ++ fields' - where - (conN, tyvarNs) = declHead con_tyvar - mergeFields fields = Map.elems $ Map.fromListWith mergePair fields - mergePair (Constant (Field lex constrs)) (Constant (Field lex' constrs')) - = (Constant (Field lex (constrs ++ constrs'))) - mkRecordFields (SimpleConstr _ _) = [] - mkRecordFields constr@(RecordConstr _ _ fields) = - let mkField (RecordField id ty) = (id,Constant (Field (LexInfo id ([], ty) moduleID) [constr])) - in map mkField fields - mkType name tyvarNs - = TyCon name $ map (TyVar . fromHsk) $ tyvarNs - conNe = case fromHsk conN of - UnqualName name -> QualName moduleID name - mkDataCon :: Type -> Hsx.QualConDecl () -> Constructor - mkDataCon tycon (Hsx.QualConDecl _ _ _ (Hsx.ConDecl l n args)) - = let typ = foldr TyFun tycon (map fromHsk args) - in SimpleConstr conNe (makeLexInfo moduleID (fromHsk n) ([], typ)) - mkDataCon tycon (Hsx.QualConDecl _ _ _ (Hsx.RecDecl l name fields)) - = let fields' = Hsx.flattenRecFields fields - typ = foldr TyFun tycon (map (fromHsk. snd) fields') - mkField (n,ty) = RecordField (fromHsk n) (fromHsk ty) - recFields = map mkField fields' - in RecordConstr conNe (makeLexInfo moduleID (fromHsk name) ([], typ)) recFields - Hsx.TypeDecl _ _ _ -> [TypeDecl (TypeDef defaultLexInfo)] - -{-| - This function merges two module environments provided they have the same name (otherwise, - an exception is thrown). Duplicates in the resulting imports and exports are removed, and - the lexical environment is merged by 'mergeEnvConstTypess'. --} - -mergeEnvModules (Module m1 is1 es1 lex1) (Module m2 is2 es2 lex2) - = assert (m1 == m2) - $ Module m1 (nub $ is1 ++ is2) (nub $ es1 ++ es2) (mergeEnvConstTypess lex1 lex2) - - -{-| - This function provides a list of all module names that are imported in fully qualified form. --} - -importedModuleIDs :: Module -> [ModuleID] -importedModuleIDs (Module _ imports _ _) - = map (\(imp@(Import m isQualified nickname )) - -> case (isQualified, isJust nickname) of - -- Notice: Hsx.ModuleName names can _always_ be explicitly qualified. - (False, False) -> m - (True, False) -> m - (True, True) -> m - (False, True) - -> error ("<importedModules> Internal Error: bogus import:" ++ show imp)) - imports -{-| - This function checks whether the module identified by the given name is imported in the - given module environment. --} -isImportedModule :: ModuleID -> Module -> Bool -isImportedModule moduleID moduleEnv - = case filter (== moduleID) (importedModuleIDs moduleEnv) of - [] -> False - [name] -> True - etc -> error ("Internal error (isImportedModule): Fall through. [" ++ show etc ++ "]") - - - --- --- GlobalEnv --- - -{-| - This data structure represents a global environment. --} -data GlobalE = GlobalEnv (Map.Map ModuleID Module) - deriving Show - -{-| - Name of the prelude module. --} -prelude :: ModuleID -prelude = "Prelude" - -{-| - The initial global environment. --} -initialGlobalEnv :: GlobalE -initialGlobalEnv = GlobalEnv - $ Map.singleton prelude - (Module prelude [] [] (ConstTypes (Map.empty) (Map.empty))) - -renameHsModuleNames :: (ModuleID -> Maybe ModuleID) -> GlobalE -> GlobalE -renameHsModuleNames ren (GlobalEnv env) = GlobalEnv . Map.fromList . map rename . Map.toList $ env - where rename orig@(name, mod) = case ren name of - Nothing -> orig - Just newName -> (newName, mod{moduleEName = newName}) - -{-| - This function constructs a global environment from a function generating the imports for a - module name, a predicate identifying identifiers that should be exported, and a list of - identifiers. - - This list of Identifiers is normalized, i.e. Instances and Classes are possibly - merged, and Identifiers may get annotated by the type information - of explicit TypeAnnotations. --} - -makeGlobalEnv :: (ModuleID -> [Import]) -> (Identifier -> Bool) -> [Identifier] -> GlobalE -makeGlobalEnv compute_imports shall_export_p identifiers - = GlobalEnv - $ Map.fromListWith failDups - $ do let (constants, types) = splitIdentifiers identifiers - let types' = mergeInstancesWithClasses types - (moduleID, ids) <- groupIdentifiers (map Constant constants ++ map TypeDecl types') - return (moduleID, makeEnvModule (compute_imports moduleID) shall_export_p ids) - where - failDups a b = error ("Duplicate modules: " ++ show a ++ ", " ++ show b) - -{-| - Merges instance and corresponding class declarations using 'mergeTypes_OrFail'. --} -mergeInstancesWithClasses :: [TypeDecl] -> [TypeDecl] -mergeInstancesWithClasses ts - = let type_map = Map.fromListWith (++) [ (nameOf (lexInfoOf (TypeDecl t)), [t]) | t <- ts ] - instances = filter (isInstance . TypeDecl) ts - type_map' = foldl (\map i -> Map.adjust (\ts -> case ts of - [t] -> [t] - ts -> [foldl1 mergeTypes_OrFail ts]) - (nameOf (lexInfoOf (TypeDecl i))) - type_map) - type_map - instances - in concat $ Map.elems type_map' - -{-| - This function groups the given identifier by the respective module they are declared in. --} -groupIdentifiers :: [Identifier] -> [(ModuleID, [Identifier])] -groupIdentifiers identifiers - = AList.group [ (moduleOf (lexInfoOf id), id) | id <- identifiers ] - -environmentOf :: Customisations -> [Hsx.Module ()] -> CustomTranslations -> GlobalE -environmentOf custs ms custMods = runLexM custs $ makeGlobalEnv_FromModule ms custMods - -{-| - This function constructs a global environment given a list of Haskell modules. --} -makeGlobalEnv_FromModule :: [Hsx.Module ()] -> CustomTranslations -> LexM GlobalE -makeGlobalEnv_FromModule ms custMods - = do mapping <- mapM (\ (modul, m) -> - do env <- makeEnvModule_FromModule modul m - return (fromHsk modul,env) ) $ Hsx.zipMod ms - let custMapping = map (\(m, ct) -> let mid = fromHsk m in (mid, makeEnvModule_FromCustThy mid ct)) (Map.toList custMods) - return $ GlobalEnv $ Map.fromListWith failDups (mapping ++ custMapping) - where failDups a b = error ("Duplicate modules: " ++ show a ++ ", " ++ show b) - -makeEnvModule_FromCustThy :: ModuleID -> CustomTheory -> Module -makeEnvModule_FromCustThy mod custThy = - Module mod [] (customExportList mod custThy) (customEnvConstTypes mod custThy) - -{-| - This method builds the union of two global environments, prioritising the first one. - Instance declarations are merged with class declaration of the two environments. --} -unionGlobalEnvs :: GlobalE -> GlobalE -> GlobalE -unionGlobalEnvs globalEnv1 globalEnv2 - = let compute_old_imports mID - = let get_imports (Module _ is _ _) = is - in case mapMaybe (findEnvModule mID) [globalEnv1, globalEnv2] of - [] -> error ("unionGlobalEnvs: Internal error during computation of imports.") - [m] -> get_imports m - [m1,m2] -> get_imports m1 ++ get_imports m2 - was_exported_p id - = isExported id (moduleOf (lexInfoOf id)) globalEnv1 || - isExported id (moduleOf (lexInfoOf id)) globalEnv2 - in - -- We explicitly recreate a GlobalE from new to merge Instances with Classes - -- across all modules. - makeGlobalEnv compute_old_imports was_exported_p - $ allIdentifiers (simple_union globalEnv1 globalEnv2) - where - -- This will merge the two envs module-wise; it'll especially merge Instances - -- with Classes within the boundaries of one module only. - simple_union (GlobalEnv map1) (GlobalEnv map2) - = GlobalEnv - $ Map.unionWithKey - (\m moduleEnv1 moduleEnv2 - -> let env1 = if Map.member m map1 then moduleEnv1 else moduleEnv2 - env2 = if Map.member m map1 then moduleEnv2 else moduleEnv1 - in - mergeEnvModules env1 env2) - map1 map2 - - -{-| - This method looks up the module environment in the given global environment using - the given module name. --} -findEnvModule :: ModuleID -> GlobalE -> Maybe Module -findEnvModule mID (GlobalEnv globalmap) - = Map.lookup mID globalmap -{-| - Same as 'findEnvModule' but throws an exception on failure. --} -findEnvModule_OrLose m globalEnv - = case findEnvModule m globalEnv of - Just env -> env - Nothing -> error ("Couldn't find module `" ++ show m ++ "'.") - -{-| - This function provides a list of all identifier names that are exported by the - module identified by the given module name in the given global environment. --} -computeExportedNames :: ModuleID -> GlobalE -> [IdentifierID] -computeExportedNames moduleID globalEnv - = case findEnvModule moduleID globalEnv of - Nothing -> [] - Just (Module moduleID' _ exports (ConstTypes constants_map types_map)) - -> assert (moduleID == moduleID') $ do - export <- exports -- List Monad concats implicitly for us. - case export of - ExportVar qn -> [idOf (unqualifyName moduleID qn)] - ExportAbstr qn -> [idOf (unqualifyName moduleID qn)] - ExportAll qn - -> case lookupType moduleID qn globalEnv of - Just t@(TypeDecl (Data _ constructors)) - -> let id_of = nameOf . lexInfoOf - in id_of t : map (id_of . Constant . Constructor) constructors - Nothing -> [] - etc -> error ("Internal error (computeExportedNames): " ++ show etc) - ExportMod m - -- export everything: - | m == moduleID -> Map.keys constants_map ++ Map.keys types_map - | otherwise -> computeExportedNames m globalEnv - where idOf :: Name -> IdentifierID - idOf (UnqualName id) = id - -{-| - This is a predicate deciding whether the given identifier is exported by the - module, given by the module name, in the given global environment --} -isExported :: Identifier -> ModuleID -> GlobalE -> Bool -isExported identifier moduleID globalEnv - = nameOf (lexInfoOf identifier) `elem` (computeExportedNames moduleID globalEnv) - -{-| - This function looks up the given module name in the imports of the - given module environment and provides the full-qualified name of it. - In case the module name cannot be found the input name is just returned. - This function is supposed to be used to get the full-qualified name for a alias of - a module name. --} -resolveModuleID :: ModuleID -> Module -> ModuleID -resolveModuleID moduleID (Module _ imps _ _) - = fromMaybe moduleID (lookfor moduleID imps) - where - lookfor _ [] = Nothing - lookfor mID (Import mID' _ nick:imports) - = case nick of - Just nickID | mID == nickID -> Just mID' - _ -> lookfor mID imports - --- module Imp1 (alpha) where --- alpha = 1 --- beta = 2 - --- module Imp2 (Thing(ThingA, ThingB)) where --- data Thing = ThingA | ThingB | ThingC deriving (Show) - --- module Imp3 (Stuff(..)) where --- data Stuff = StuffA | StuffB | StuffC deriving (Show) - --- module Foo (b) where --- --- import Imp1 --- import qualified Imp2 --- import qualified Imp3 as Quux --- --- a = "a" --- b = "b" - --- lookup "Foo" "a" => Just ... --- lookup "Foo" "Foo.a" => Just ... --- lookup "Foo" "Foo.b" => Just ... - --- lookup "Foo" "alpha" => Just ... --- lookup "Foo" "Imp1.alpha" => Just ... --- lookup "Foo" "Imp1.beta" => Nothing - --- lookup "Foo" "ThingA" => Nothing --- lookup "Foo" "Imp2.ThingA" => Just ... --- lookup "Foo" "Imp2.ThingC" => Nothing - --- lookup "Foo" "Quux.StuffA" => Just ... --- lookup "Foo" "Imp3.StuffA" => Just ... --- lookup "Foo" "Imp3.StuffC" => Just ... --- lookup "Foo" "Imp1.beta" => Nothing - -{-| - This function looks up the given name in the import list of the given module. - Note that types and constants have different namespaces. Hence the result can be a type - and a constant. --} -lookupName :: ModuleID -> Name -> GlobalE -> (Maybe Constant, Maybe TypeDecl) -lookupName currentModule qname globalEnv - = let (cs, ts) = splitIdentifiers (lookup' currentModule qname globalEnv) - in (listToMaybe cs, listToMaybe ts) - where - lookup' :: ModuleID -> Name -> GlobalE -> [Identifier] - lookup' currentModule qname globalEnv - = case findEnvModule currentModule globalEnv of - Nothing -> [] - Just currentEnvModule -> - case qname of - QualName m n - | m == currentModule - -> lookup' m (UnqualName n) globalEnv - | isImportedModule (resolveModuleID m currentEnvModule) currentEnvModule - -> let identifiers = lookup' m (UnqualName n) globalEnv - in (filter (\id -> isExported id m globalEnv) identifiers) - | otherwise - -> [] - UnqualName n -> - let (Module _ imports _ (ConstTypes cmap tmap)) = currentEnvModule - local_con = Map.lookup n cmap - local_typ = Map.lookup n tmap - others = concatMap (\(Import m _ _) -> lookup' currentModule (QualName m n) globalEnv) - $ filter (not . isQualifiedImport) imports - (other_cs, other_ts) = splitIdentifiers others - in map Constant (consider local_con other_cs) ++ map TypeDecl (consider local_typ other_ts) - where consider Nothing [] = [] - consider (Just x) [] = [x] - consider Nothing [x] = [x] - consider Nothing xs - = error (Msg.identifier_collision_in_lookup currentModule qname xs) - consider (Just x) xs - = error (Msg.identifier_collision_in_lookup currentModule qname (x:xs)) - -{-| - Looks up the given identifier name in the given module's import list. - Note that types and constants have different namespaces hence the result can - be a list of length two (at most), containing a type and a constructor with - the same name. --} -lookupIdentifiers_OrLose :: ModuleID -> Name -> GlobalE -> [Identifier] -lookupIdentifiers_OrLose mID n globalEnv - = case lookupName mID n globalEnv of - (Just c, Nothing) -> [Constant c] - (Nothing, Just t) -> [TypeDecl t] - (Just c, Just t) -> [Constant c, TypeDecl t] - (Nothing, Nothing) -> error (Msg.failed_lookup "Identifier" mID n globalEnv) - -{-| - This function looks up the given identifier name, which is supposed to identify a constant, in the - import list of the given module. --} -lookupConstant :: ModuleID -> Name -> GlobalE -> Maybe Identifier -lookupConstant m n env - = case lookupName m n env of - (Just c, _) -> Just (Constant c) - _ -> Nothing - -{-| - Same as 'lookupConstant' but throws an exception on failure. --} -lookupConstant_OrLose :: ModuleID -> Name -> GlobalE -> Identifier -lookupConstant_OrLose m n env - = case lookupConstant m n env of - Just c -> c - _ -> error (Msg.failed_lookup "Constant" m n env) - -{-| - This function looks up the given identifier name, which is supposed to identify a type, in the - import list of the given module. --} -lookupType :: ModuleID -> Name -> GlobalE -> Maybe Identifier -lookupType m n env - = case lookupName m n env of - (_, Just t) -> Just (TypeDecl t) - _ -> Nothing - -{-| - Same as 'lookupType' but throws an exception on failure. --} -lookupType_OrLose :: ModuleID -> Name -> GlobalE -> Identifier -lookupType_OrLose m n env - = case lookupType m n env of - Just t -> t - _ -> error (Msg.failed_lookup "Type" m n env) -{-| - This function looks up the import list of the given module. --} -lookupImports :: ModuleID -> GlobalE -> [Import] -lookupImports moduleID globalEnv - = case findEnvModule moduleID globalEnv of Just (Module _ imps _ _) -> imps - Nothing -> [] - -{-| - This function looks up the given name in the given module's import list to get - a qualified name. --} -resolveName_NoLose :: GlobalE -> ModuleID -> Name -> Maybe Name -resolveName_NoLose globalEnv mID name - = case lookupName mID name globalEnv of - (Just c, Nothing) -> Just $ constant2name c - (Nothing, Just t) -> Just $ type2name t - (Nothing, Nothing) -> Nothing - (Just c, Just t) -> assert (constant2name c == type2name t) - $ Just $ constant2name c - -{-| - This function looks up the given name in the given module's import list to get - a qualified name. --} -resolveName_OrLose :: GlobalE -> ModuleID -> Name -> Name -resolveName_OrLose globalEnv mID name - = case resolveName_NoLose globalEnv mID name of - Just n -> n - Nothing -> error (Msg.failed_lookup "Constant or Type" mID name globalEnv) - -{-| - This function looks up the given name, which is supposed to identify a constant, in the - given module's import list to get a qualified name. --} -resolveConstantName :: GlobalE -> ModuleID -> Name -> Maybe Name -resolveConstantName globalEnv mID name - = case lookupConstant mID name globalEnv of - Nothing -> Nothing - Just c -> Just (identifier2name c) - -{-| - This function looks up the given name, which is supposed to identify a type, in the given - module's import list to get a qualified name. --} -resolveTypeName :: GlobalE -> ModuleID -> Name -> Maybe Name -resolveTypeName globalEnv mID name - = case lookupType mID name globalEnv of - Nothing -> Nothing - Just c -> Just (identifier2name c) - -{-| - This function provides a list of all identifiers declared in the given global environment. --} -allIdentifiers :: GlobalE -> [Identifier] -allIdentifiers (GlobalEnv modulemap) - = concatMap (\(Module _ _ _ (ConstTypes cmap tmap)) - -> map Constant (Map.elems cmap) ++ - map TypeDecl (Map.elems tmap)) - $ Map.elems modulemap - -{-| - ??? --} -updateGlobalEnv :: (Name -> [Identifier]) -> GlobalE -> GlobalE -updateGlobalEnv update globalEnv@(GlobalEnv modulemaps) - = let all_ids = allIdentifiers globalEnv - id_alist = AList.group $ concatMap (\id -> case update (identifier2name id) - & filter (\new -> case (new, id) of - (TypeDecl _, Constant (Constructor _)) -> moduleOf' new == moduleOf' id - _ -> True) - of [] -> [(id, id)] - new_ids -> [ (new, id) | new <- new_ids ]) - all_ids - mod_alist = nub (concat [ [ (moduleOf' n, moduleOf' o) | o <- os ] - | (n, os) <- id_alist ]) - id_tbl = Map.fromListWith (failDups "id_tbl") id_alist -- Map from new_id to [old_id] - mod_tbl = Map.fromListWith (failDups "mod_tbl") mod_alist -- Map from new_mID to old_mID - rev_mod_tbl = Map.fromListWith (failDups "rev_mod_tbl") -- Map from old_mID to [new_mID] - (AList.group [ (o,n) | (n,o) <- mod_alist ]) - - -- The new Module gets the same imports as the old Module, but we - -- have to account for old imports being possibly updated themselves. - -- E.g. if `Foo' imported `Prelude', and `Prelude` was split into `List', - -- and `Datatype`, then 'Foo' now has to import 'Prelude', 'List', - -- and 'Datatype'. - recompute_imports new_mID - = let old_mID = fromMaybe (error $ "Internal error: New module " ++ new_mID ++ " not found during update of global environment!") - (Map.lookup new_mID mod_tbl) - old_mEnv = findEnvModule_OrLose old_mID globalEnv - old_imports = (let (Module _ imps _ _) = old_mEnv in imps) - old_import_mIDs = importedModuleIDs old_mEnv - in - do (old_imported_mID, old_import) <- zip old_import_mIDs old_imports - let res = fromMaybe (error $ "Internal error: Old module " ++ new_mID ++ " not found during update of global environment!") - (Map.lookup old_imported_mID rev_mod_tbl) - case res of - [] -> return old_import - mIDs -> let new_imports = map (\mID -> Import mID False Nothing) mIDs - in if old_imported_mID `elem` mIDs then new_imports - else old_import : new_imports - - -- The new Module must export all those identifiers that are the same - -- as the exported identifiers in the old Module, and all those that - -- resulted from updating any such identifier. - recompute_exports new_id - = or (do old_id <- fromMaybe (error $ "Internal error: New identifier " ++ show new_id ++ " not found during update of global environment!") - (Map.lookup new_id id_tbl) - old_mID <- (let oldm = moduleOf' old_id - newm = moduleOf' new_id - in assert (oldm == fromMaybe (error $ "Internal error: New module " ++ show newm ++ " not found during assertion in update of global environment") (Map.lookup newm mod_tbl)) - $ return oldm) - return (isExported old_id old_mID globalEnv)) - - in - makeGlobalEnv recompute_imports recompute_exports (map fst id_alist) - - where failDups str a b = error (Msg.found_duplicates ("computing " ++ str) a b) - moduleOf' = moduleOf . lexInfoOf -{-| - ??? --} -augmentGlobalEnv :: GlobalE -> [Identifier] -> GlobalE -augmentGlobalEnv globalEnv new_identifiers - = let all_identifiers = allIdentifiers globalEnv - tmp = partition (`elem` all_identifiers) new_identifiers - updated_identifiers = fst tmp - really_new_identifiers = snd tmp - env1 = makeGlobalEnv (const []) (const True) really_new_identifiers - env2 = updateGlobalEnv (\qn@(QualName mID _) - -> let old_ids = lookupIdentifiers_OrLose mID qn globalEnv - new_ids = filter (\id -> qn == identifier2name id) - updated_identifiers - in if null new_ids - then old_ids - else old_ids ++ new_ids) - globalEnv - in unionGlobalEnvs env2 env1 diff --git a/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/Importer/Isa.hs b/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/Importer/Isa.hs deleted file mode 100644 index 77e690c34401adf5974f7bbba98cf3e1c05f7c05..0000000000000000000000000000000000000000 --- a/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/Importer/Isa.hs +++ /dev/null @@ -1,273 +0,0 @@ -{-# LANGUAGE DeriveDataTypeable #-} - -{-| Author: Tobias C. Rittweiler, TU Muenchen - -Abstract representation of Isar/HOL theory. --} - -module Importer.Isa (ThyName(..), Name(..), Type(..), Literal(..), Term(..), Pat, - ListComprFragment(..), DoBlockFragment(..), - Function_Kind(..), Function_Stmt(..), Stmt(..), TypeSpec(..), TypeSign(..), Module(..), - dest_Type, dest_TVar, base_name_of, name_of_type_sign, retopologize, retopologizeModule) where - -import Prelude hiding ((*>)) -import Importer.Library -import Data.Graph as Graph -import Data.Generics.Basics - - -{- Names -} - -newtype ThyName = ThyName String - deriving (Show, Eq, Ord, Data, Typeable) - -data Name = QName ThyName String | Name String -- FIXME unqualified names should be classified as variables - deriving (Show, Eq, Ord, Data) - -is_qualified :: Name -> Bool -is_qualified (QName _ _) = True -is_qualified (Name _) = False - -base_name_of :: Name -> String -base_name_of (QName _ n) = n -base_name_of (Name n) = n - - -{- Expressions -} - -type Sort = [Name] - -data Type = - Type Name [Type] - | Func Type Type - | TVar Name - | NoType - deriving (Show, Data) - -dest_Type :: Type -> (Name, [Type]) -dest_Type (Type n tys) = (n, tys) - -dest_TVar :: Type -> Name -dest_TVar (TVar n) = n - -data Literal = Int Integer | Char Char | String String - deriving (Show, Data) - -data Term = - Literal Literal - | Const Name - | Abs Name Term - | App Term Term - | If Term Term Term - | Let [(Pat, Term)] Term - | Case Term [(Pat, Term)] - | ListCompr Term [ListComprFragment] - | RecConstr Name [(Name, Term)] - | RecUpdate Term [(Name, Term)] - | DoBlock String [DoBlockFragment] String -- syntactic sugar for translating Haskell do expressions - | Parenthesized Term - deriving (Show, Data) - -type Pat = Term - -data ListComprFragment = - Generator (Pat, Term) - | Guard Term - deriving (Show, Data) - -data DoBlockFragment = - DoGenerator Pat Term - | DoQualifier Term - | DoLetStmt [(Pat, Term)] - deriving (Show, Data) - - -{- Statements -} - -data TypeSpec = TypeSpec [Name] Name - deriving (Show, Data) - -data TypeSign = TypeSign Name [(Name, Sort)] Type - deriving (Show, Data) - -name_of_type_sign :: TypeSign -> Name -name_of_type_sign (TypeSign name _ _) = name - -data Function_Kind = Definition | Primrec | Fun | Function_Sorry - deriving (Show, Eq, Data) - -data Function_Stmt = Function_Stmt Function_Kind [TypeSign] [(Name, [Pat], Term)] - deriving (Show, Data) - -data Stmt = - Datatype [(TypeSpec, [(Name, [Type])])] - | Record TypeSpec [(Name, Type)] - | TypeSynonym [(TypeSpec, Type)] - | Function Function_Stmt - | Class Name [Name] [TypeSign] - | Instance Name Name [(Name, Sort)] [Function_Stmt] - | Comment String - | ML Function_Stmt - deriving (Show, Data) - -data Module = Module ThyName [ThyName] [Stmt] Bool - deriving (Show, Data) - - -{- Identifier categories -} - -data Ident = ClassI Name | TycoI Name | ConstI Name - deriving (Eq, Ord, Show) - -add_idents_type :: Type -> [Ident] -> [Ident] -add_idents_type (Type n tys) = - insert (TycoI n) *> fold add_idents_type tys -add_idents_type (Func ty1 ty2) = - add_idents_type ty1 *> add_idents_type ty2 -add_idents_type (TVar _) = - id -add_idents_type NoType = - id - -add_idents_term :: Term -> [Ident] -> [Ident] -add_idents_term (Literal _) = - id -add_idents_term (Const n) = - if is_qualified n || True then insert (ConstI n) else id -add_idents_term (Abs n t) = - add_idents_term t -add_idents_term (App t1 t2) = - add_idents_term t1 *> add_idents_term t2 -add_idents_term (If tb t1 t2) = - add_idents_term tb *> add_idents_term t1 *> add_idents_term t2 -add_idents_term (Let bs t) = - fold (\(p, t) -> add_idents_term p *> add_idents_term t) bs *> add_idents_term t -add_idents_term (Case t bs) = - add_idents_term t *> fold (\(p, t) -> add_idents_term p *> add_idents_term t) bs -add_idents_term (ListCompr t cprs) = - add_idents_term t *> fold add_idents_compr cprs -add_idents_term (RecConstr n fs) = - insert (ConstI n) *> fold (\(n, t) -> insert (ConstI n) *> add_idents_term t) fs -add_idents_term (RecUpdate t fs) = - add_idents_term t *> fold (\(n, t) -> insert (ConstI n) *> add_idents_term t) fs -add_idents_term (DoBlock _ dobls _) = - fold add_idents_dobl dobls -add_idents_term (Parenthesized t) = - add_idents_term t - -add_idents_compr :: ListComprFragment -> [Ident] -> [Ident] -add_idents_compr (Generator (p, t)) = - add_idents_term p *> add_idents_term t -add_idents_compr (Guard t) = - add_idents_term t - -add_idents_dobl :: DoBlockFragment -> [Ident] -> [Ident] -add_idents_dobl (DoGenerator p t) = - add_idents_term p *> add_idents_term t -add_idents_dobl (DoQualifier t) = - add_idents_term t -add_idents_dobl (DoLetStmt bs) = - fold (\(p, t) -> add_idents_term p *> add_idents_term t) bs - -add_idents_typespec :: TypeSpec -> [Ident] -> [Ident] -add_idents_typespec (TypeSpec _ n) = - insert (TycoI n) - -idents_of_typctxt :: [(Name, Sort)] -> [Ident] -idents_of_typctxt = map ClassI . maps snd - -idents_of_typesign :: TypeSign -> (Ident, [Ident]) -idents_of_typesign (TypeSign n vs ty) = - (ConstI n, accumulate add_idents_type ty ++ idents_of_typctxt vs) - -idents_of_function_stmt :: Function_Stmt -> (([Ident], [Ident]), [Ident]) -idents_of_function_stmt (Function_Stmt kind sigs eqns) = - let - (xs1, xs3a) = map_split idents_of_typesign sigs - xs3b = flat xs3a |> fold (\(_, ps, t) -> fold add_idents_term ps *> add_idents_term t) eqns - in ((xs1, []), xs3b) - -idents_of_stmt :: Stmt -> (([Ident], [Ident]), [Ident]) -idents_of_stmt (Datatype specs) = - let - xs1 = accumulate (fold (add_idents_typespec . fst)) specs - xs2 = accumulate (fold (fold (insert . ConstI . fst) . snd)) specs - xs3 = accumulate (fold (fold (fold add_idents_type . snd) . snd)) specs - in ((xs1, xs2), xs3) -idents_of_stmt (Record tyspec selectors) = - let - xs1 = accumulate add_idents_typespec tyspec - xs2 = accumulate (fold (\(n, _) -> insert (ConstI n))) selectors - xs3 = accumulate (fold (\(_, ty) -> add_idents_type ty)) selectors - in ((xs1, xs2), xs3) -idents_of_stmt (TypeSynonym specs) = - let - xs1 = accumulate (fold (add_idents_typespec . fst)) specs - xs3 = accumulate (fold (add_idents_type . snd)) specs - in ((xs1, []), xs3) -idents_of_stmt (Function stmt) = idents_of_function_stmt stmt -idents_of_stmt (Class n superclasses sigs) = - let - x1 = ClassI n - (xs2, xs3a) = map_split idents_of_typesign sigs - xs3b = flat xs3a |> fold (insert . ClassI) superclasses - in (([x1], xs2), xs3b) -idents_of_stmt (Instance c tyco vs stmts) = -- this is only an approximation - let - xs3a = ClassI c : TycoI tyco : idents_of_typctxt vs - (_, xs3b) = map_split idents_of_function_stmt stmts - xs3 = fold insert (flat xs3b) xs3a - in (([], []), xs3) -idents_of_stmt (Comment _) = - (([], []), []) - -retopologize (Module thyname imports stmts exportCode) = - {- This does some additional work to arrange statements - in a topological order. It would be better to unify this - with the tasks of Importer.DeclDependencyGraph.arrangeDecls -} - let - (representants, proto_deps) = map_split mk_raw_deps stmts - raw_deps = clear_junk (flat proto_deps) - strong_conns = (map_filter only_strong_conns . stronglyConnComp . dummy_nodes) raw_deps - acyclic_deps = fold (\ys -> map (complete_strong_conn ys)) strong_conns raw_deps - (stmts', _) = ultimately select (representants, acyclic_deps) - in Module thyname imports stmts' exportCode where - mk_raw_deps stmt = - let - ((xs1, xs2), xs3) = idents_of_stmt stmt - xs12 = xs1 ++ xs2 - x = split_list xs12 - xs3' = xs3 |> fold insert xs1 |> fold insert xs2 - in ((x, stmt), map (rpair xs3') xs12) - weave_deps ((xs1, xs2), xs3) = - let - xs3' = xs3 |> fold insert xs1 |> fold insert xs2 - in map (rpair xs3') (xs1 ++ xs2) - clear_junk deps = let ys = map fst deps - in map (\(x, xs) -> (x, filter (flip elem (remove x ys)) xs)) deps - dummy_nodes = map (\(x, xs) -> (x, x, xs)) - no_dummy_nodes = map (\(_, x, xs) -> (x, xs)) - with_dummy_nodes f = no_dummy_nodes . f . dummy_nodes - only_strong_conns (Graph.AcyclicSCC _) = Nothing - only_strong_conns (Graph.CyclicSCC xs) = Just xs - complete_strong_conn ys (x, xs) = if x `elem` ys - then (x, fold remove ys xs) - else if any (\y -> y `elem` xs) ys - then (x, fold insert ys xs) - else (x, xs) - select ([], []) = Nothing - select ((Nothing, stmt) : xs, deps) = Just (stmt, (xs, deps)) - select ((Just (x, ws), stmt) : xs, deps) = if null (these (lookup x deps)) - then let - zs = x : ws - deps' = map_filter (\(y, ys) -> if y `elem` zs then Nothing - else Just (y, filter_out (flip elem zs) ys)) deps - in Just (stmt, (xs, deps')) - else case select (xs, deps) of - Just (stmt', (xs', deps')) -> Just (stmt', ((Just (x, ws), stmt) : xs', deps')) - - -retopologizeModule :: [Module] -> [Module] -retopologizeModule l = - let (graph, fromVertex, _) = graphFromEdges (map (\m@(Module thyname imports _ _) -> (m, thyname, imports)) l) in - reverse $ map (\v -> let (n, _, _) = fromVertex v in n) $ topSort graph diff --git a/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/Importer/Library.hs b/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/Importer/Library.hs deleted file mode 100644 index d8eaa4f39dd84597afc1b1d16f1788eea6bef90b..0000000000000000000000000000000000000000 --- a/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/Importer/Library.hs +++ /dev/null @@ -1,248 +0,0 @@ -{-| Author: Tobias C. Rittweiler and Florian Haftmann, TU Muenchen - -A collection of generic functions. --} - -module Importer.Library ( - assert, asserting, tracing, - (|>), (*>), - pair, rpair, map_fst, map_snd, map_both, map_pair, - the, these, the_default, - split_list, - filter_out, fold, fold_rev, map_filter, flat, maps, - map2, fold2, map_split, - nth_map, map_index, fold_index, burrow_indices, - insert, remove, has_duplicates, accumulate, - separate, slice, - perhaps, perhaps_map, ultimately, - combl, combr, uncombl, uncombr, - liftM, filterM, mapsM, when, - catchIO -) where - -import Prelude hiding ((*>)) -import qualified Data.List as List -import qualified Data.Maybe as Maybe -import qualified Control.Monad as Monad -import qualified Control.Exception as Exception -import qualified Debug.Trace as Debug - - -{- diagnostics -} - -trace :: String -> a -> a -trace = Debug.trace - -assert :: Bool -> a -> a -assert = Exception.assert - -tracing :: (a -> String) -> a -> a -tracing f x = trace (f x) x - -asserting :: (a -> Bool) -> a -> a -asserting f x = assert (f x) x - - -{- functions -} - -infixl 1 |> -x |> f = f x - -infixl 1 *> -f *> g = g . f - - -{- pairs -} - -pair :: a -> b -> (a, b) -pair x y = (x, y) - -rpair :: b -> a -> (a, b) -rpair y x = (x, y) - -map_fst :: (a -> b) -> (a, c) -> (b, c) -map_fst f (x, y) = (f x, y) - -map_snd :: (a -> b) -> (c, a) -> (c, b) -map_snd f (x, y) = (x, f y) - -map_both :: (a -> b) -> (a, a) -> (b, b) -map_both f (x, y) = (f x, f y) - -map_pair :: (a -> b) -> (c -> d) -> (a, c) -> (b, d) -map_pair f g (x, y) = (f x, g y) - - -{- options -} - -the :: Maybe a -> a -the = Maybe.fromJust - -these :: Maybe [a] -> [a] -these Nothing = [] -these (Just xs) = xs - -the_default :: a -> Maybe a -> a -the_default = Maybe.fromMaybe - - -{- lists -} - -split_list :: [a] -> Maybe (a, [a]) -split_list [] = Nothing -split_list (x : xs) = Just (x, xs) - -filter_out :: (a -> Bool) -> [a] -> [a] -filter_out f = filter (not . f) - -fold :: (a -> b -> b) -> [a] -> b -> b -fold f [] y = y -fold f (x : xs) y = fold f xs (f x y) - -fold_rev :: (a -> b -> b) -> [a] -> b -> b -fold_rev _ [] y = y -fold_rev f (x : xs) y = f x (fold_rev f xs y) - -map_filter :: (a -> Maybe b) -> [a] -> [b] -map_filter = Maybe.mapMaybe - -flat :: [[a]] -> [a] -flat = List.concat - -maps :: (a -> [b]) -> [a] -> [b] -maps = List.concatMap - - -unequal_lengths :: a -unequal_lengths = error "UnequalLengths" - -map2 :: (a -> b -> c) -> [a] -> [b] -> [c] -map2 f [] [] = [] -map2 f (x : xs) (y : ys) = f x y : map2 f xs ys -map2 _ _ _ = unequal_lengths; - -fold2 :: (a -> b -> c -> c) -> [a] -> [b] -> c -> c -fold2 f [] [] z = z -fold2 f (x : xs) (y : ys) z = fold2 f xs ys (f x y z) -fold2 f _ _ _ = unequal_lengths; - -map_split :: (a -> (b, c)) -> [a] -> ([b], [c]) -map_split f [] = ([], []) -map_split f (x : xs) = - let - (y, w) = f x - (ys, ws) = map_split f xs - in (y : ys, w : ws) - - -index_too_large :: a -index_too_large = [] !! 0 - -nth_map :: Int -> (a -> a) -> [a] -> [a] -nth_map 0 f (x : xs) = f x : xs -nth_map n f (x : xs) = x : nth_map (n - 1) f xs -nth_map _ _ [] = index_too_large - -map_index :: ((Int, a) -> b) -> [a] -> [b] -map_index f = mapp 0 where - mapp _ [] = [] - mapp i (x : xs) = f (i, x) : mapp (i + 1) xs - -fold_index :: ((Int, a) -> b -> b) -> [a] -> b -> b -fold_index f = foldd 0 where - foldd _ [] y = y - foldd i (x : xs) y = foldd (i + 1) xs (f (i, x) y) - -burrow_indices :: [Int] -> ([a] -> [a]) -> [a] -> [a] -burrow_indices is f xs = - let - ys = f (map ((!!) xs) is) - in if length xs /= length ys then unequal_lengths - else fold (\i -> nth_map i (\_ -> ys !! i)) is xs - - -insert :: Eq a => a -> [a] -> [a] -insert x xs = if x `elem` xs then xs else x : xs - -remove :: Eq a => a -> [a] -> [a] -remove = List.delete - -has_duplicates :: Eq a => [a] -> Bool -has_duplicates = dups where - dups [] = False - dups (x : xs) = x `elem` xs || dups xs - -accumulate :: (a -> [b] -> [b]) -> a -> [b] -accumulate f x = f x [] - - -separate :: a -> [[a]] -> [a] -separate _ [] = [] -separate _ [ys] = ys -separate x (ys : yss) = ys ++ x : separate x yss - -slice :: (a -> Bool) -> [a] -> [[a]] -slice f [] = [] -slice f xs = let (ys, zs) = List.break f xs - in ys : if null zs then [] else slice f (List.tail zs) - - -perhaps :: (a -> Maybe a) -> a -> a -perhaps f x = the_default x (f x) - -perhaps_map :: (a -> Maybe b) -> [a] -> Maybe [b] -perhaps_map f [] = Just [] -perhaps_map f (x : xs) = case f x of - Nothing -> Nothing - Just y -> case perhaps_map f xs of - Nothing -> Nothing - Just ys -> Just (y : ys) - -ultimately :: (a -> Maybe (b, a)) -> a -> ([b], a) -ultimately f x = case f x of - Nothing -> ([], x) - Just (r, y) -> let (rs, z) = ultimately f y in (r : rs, z) - - -{- structural operations -} - -combl :: (a -> b -> a) -> a -> [b] -> a -combl f = flip (fold (flip f)) - -combr :: (b -> a -> a) -> [b] -> a -> a -combr = fold_rev - -uncombl :: (a -> Maybe (a, b)) -> a -> (a, [b]) -uncombl dest x = uncomb x [] where - uncomb x zs = case dest x of - Nothing -> (x, zs) - Just (y, z) -> uncomb y (z : zs) - -uncombr :: (a -> Maybe (b, a)) -> a -> ([b], a) -uncombr dest x = case dest x of - Nothing -> ([], x) - Just (z, y) -> (z : zs, y') where (zs, y') = uncombr dest y - - -{- monads -} - -liftM :: Monad m => (a -> b) -> m a -> m b -liftM = Monad.liftM - -filterM :: Monad m => (a -> m Bool) -> [a] -> m [a] -filterM = Monad.filterM - -mapsM :: Monad m => (a -> m [b]) -> [a] -> m [b] -mapsM f [] = return [] -mapsM f (x : xs) = do - ys <- f x - zs <- mapsM f xs - return (ys ++ zs) - -when :: Monad m => Bool -> m () -> m () -when = Monad.when - - -{- exceptions -} -catchIO :: IO a -> (IOError -> IO a) -> IO a -catchIO = Exception.catch diff --git a/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/Importer/Msg.hs b/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/Importer/Msg.hs deleted file mode 100644 index f43b35d8a0f02125a6a1fe6779c19c28c02cad39..0000000000000000000000000000000000000000 --- a/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/Importer/Msg.hs +++ /dev/null @@ -1,115 +0,0 @@ -{-| Author: Tobias C. Rittweiler, TU Muenchen - -Messages. --} - -module Importer.Msg where - -import Data.List (intersperse) -import Data.Maybe (fromMaybe) - -import qualified Language.Haskell.Exts as Hsx -import qualified Importer.Hsx as Hsx - - -spacify x = x ++ " " -linify x = x ++ "\n\n" - -quote :: Show a => a -> String -quote x = "`" ++ (show x) ++ "'" - -prettyShow' prefix obj = let str = prefix ++ " = " ++ show obj - (Hsx.ParseOk (Hsx.Module _ _ _ _ decls)) - = Hsx.parseModule str - in concatMap Hsx.prettyPrint decls - -prettyShow obj = prettyShow' "foo" obj - -printEnv env = "The Global Environment looked like:\n" - ++ prettyShow' "globalenv" env - -assoc_mismatch op1 assoc1 op2 assoc2 - = let { op1' = quote op1; assoc1' = quote assoc1; } in - let { op2' = quote op2; assoc2' = quote assoc2; } in - "Associativity mismatch: " ++ op1' ++ " has " ++ assoc1' ++ - ", whereas " ++ op2' ++ " has " ++ assoc2' ++ "." - -missing_infix_decl name env - = "Missing infix declaration for " ++ (quote name) ++ - ", assuming left associativity and a fixity of 9.\n\n" - ++ printEnv env - -missing_fun_sig name env - = "Missing function signature for " ++ (quote name) ++ ". (FIXME)\n\n" - ++ printEnv env - -failed_import m errormsg - = "While trying to import " ++ quote (Hsx.module2FilePath m) - ++ ", the following error occured:\n" ++ errormsg - -duplicate_import ms - = "Duplicate in imported modules: " ++ show ms - -failed_parsing loc msg - = Hsx.srcloc2string loc ++ ": " ++ msg - -cycle_in_dependency_graph moduleNs - = "Dependency graph is not a DAG. In particular, a cycle was found between\n" - ++ "the following modules: " ++ concatMap (spacify . quote) moduleNs - -prettyHsx hs = Hsx.prettyPrint hs - -free_vars_found loc freeVariableNames - = Hsx.srcloc2string loc ++ ": " ++ "Closures disallowed. The following variables occur free: " - ++ concatMap (spacify . quote . prettyHsx) freeVariableNames - -merge_collision fn_str x y - = "Internal Error (" ++ fn_str ++ "): Merge collision between" ++ "\n" - ++ " " ++ quote x ++ "\n" - ++ "and " ++ "\n" - ++ " " ++ quote y ++ "." - -found_duplicates str x y - = "Found duplicates while " ++ str ++ ": " ++ "\n" - ++ " " ++ quote x ++ "\n" - ++ "and " ++ quote y ++ "\n" - -identifier_collision_in_lookup curModuleName qname foundIdentifiers - = "Ambiguous occurences found for " ++ quote qname ++ "\n" - ++ "while trying to look it up in " ++ quote curModuleName ++ ":\n\n" - ++ concatMap (linify . prettyShow' (show qname)) foundIdentifiers - -failed_lookup lookup_kind_str curModuleName envname globalEnv - = "No entry for the " ++ lookup_kind_str ++ " " ++ quote envname ++ "\n" - ++ "found in global environment while trying to look it up in " ++ quote curModuleName ++ ".\n" - ++ printEnv globalEnv - -ambiguous_decl_definitions decls - = "Ambiguous definitions between\n" ++ concatMap (linify . prettyShow' "decl") decls - -complex_toplevel_patbinding - = "Complex pattern binding on toplevel is not supported by Isar/HOL." - -only_one_tyvar_in_class_decl - = "Only one type variable allowed in class declarations." - -no_fundeps_in_class_decl - = "No functional dependencies allowed in class declarations." - -no_default_methods_in_class_decl - = "No default methods, or infix declarations allowed in class declarations." - -only_simple_instantiations - = "Only simple instantiations in the manner of Haskell 1.0 allowed." - -unsupported_semantics_decl - = "The support of this particular semantics of Haskell declarations has to be implemented." - -recursive_bindings_disallowed srcloc - = Hsx.srcloc2string srcloc ++ ": " ++ "Recursive bindings disallowed." - -forward_bindings_disallowed srcloc - = Hsx.srcloc2string srcloc ++ ": " ++ "Forward references to bindings disallowed." - -found_inconsistency_in_guards srcloc - = Hsx.srcloc2string srcloc ++ ": " ++ "Guard inconsistency." diff --git a/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/Importer/Preprocess.hs b/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/Importer/Preprocess.hs deleted file mode 100644 index ae88a3662156457540f8c50f1f3ab3a0c5da712b..0000000000000000000000000000000000000000 --- a/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/Importer/Preprocess.hs +++ /dev/null @@ -1,518 +0,0 @@ -{-# LANGUAGE - GeneralizedNewtypeDeriving, - ScopedTypeVariables #-} - -{-| Author: Tobias C. Rittweiler, TU Muenchen - --} - -module Importer.Preprocess (isEmptyBinds, preprocessModule) where - -import Importer.Library -import Data.Function -import Data.Maybe -import Data.List -import Data.Map (Map) -import qualified Data.Map as Map hiding (Map) -import Data.Set (Set) -import qualified Data.Set as Set hiding (Set) -import Data.Graph -import Data.Tree - -import Data.Generics -import Data.Generics.Biplate -import Data.Generics.Str - -import Control.Monad.Reader (ReaderT, MonadReader, ask, runReaderT, runReader, Reader) -import Control.Monad.Writer (WriterT, MonadWriter, tell, runWriterT, lift, MonadFix) - -import Importer.Env - -import qualified Importer.Gensym as Gensym -import qualified Importer.Msg as Msg - -import qualified Language.Haskell.Exts as Hsx -import qualified Importer.Hsx as Hsx - - --- import Importer.Test.Generators --- import Test.QuickCheck --- import qualified Test.QuickCheck.Monadic as QC (assert) --- import Test.QuickCheck.Monadic hiding (assert) - -type HskDecl = (Int, Hsx.Decl ()) - -{-| - This function preprocesses the given Haskell module to make things easier for the - conversion. --} -preprocessModule :: [String] -> Hsx.Module () -> Hsx.Module () -preprocessModule reserved (Hsx.Module l modul pragmas imports topdecls) = - Hsx.Module l modul pragmas imports topdecls4 where - topdecls1 = map (whereToLet . deguardify) topdecls - ((topdecls2, topdecls2'), gensymcount) - = Gensym.runGensym Gensym.countInit (evalDelocaliser Set.empty (delocaliseAll (zip [Gensym.posInit ..] topdecls1))) - topdecls3 = topdecls2' - & foldl (\m (pos, decl) -> Map.insertWith (++) pos [decl] m) - (Map.fromList (map (\(pos, x) -> (pos, [x])) topdecls2)) - & Map.toList - & concatMap snd - topdecls4 = Gensym.evalGensym gensymcount (mapM (normalizeNames_Decl reserved) topdecls3) - - -{-| - /Delocalization of Hsx.Decls/ - - Since Isabelle/HOL does not really support local function - declarations, we convert the Haskell AST to an equivalent AST - where every local function declaration is made a global - declaration. This includes where as well as let expressions. - - Additionally, all variables defined in a where clause - are converted to an equivalent let expression. - - - We keep track of the names that are directly bound by a declaration, - as functions must not close over them. See below for an explanation. - -} -newtype DelocaliserM a = DelocaliserM (ReaderT Hsx.HskNames (WriterT [HskDecl] Gensym.GensymM) a) - deriving (Monad, Functor, Applicative, MonadFix, MonadReader Hsx.HskNames, MonadWriter [HskDecl]) - -{-instance MonadWriter [HskDecl] DelocaliserM where - tell _ = error "" - listen _ = error "" - pass _ = error "" - -[HskDecl] -> DelocaliserM () -DelocaliserM a -> DelocaliserM (a, [HskDecl]) -DelocaliserM (a, [HskDecl] -> [HskDecl]) -> DelocaliserM a-} - -addTopDecls :: [Hsx.Decl ()] -> DelocaliserM () -addTopDecls decls = do pos <- liftGensym Gensym.askPos - tell $ zip (repeat pos) decls - -addTopDecl :: Hsx.Decl () -> DelocaliserM () -addTopDecl = addTopDecls . (:[]) - -liftGensym :: Gensym.GensymM a -> DelocaliserM a -liftGensym = DelocaliserM . lift . lift - - -{-| - This function executes the given delocaliser monad starting with an - empty list of bound variables. --} -evalDelocaliser :: Hsx.HskNames -> DelocaliserM a -> Gensym.GensymM (a,[HskDecl]) -evalDelocaliser state (DelocaliserM sm) = - let wm = runReaderT sm state in - runWriterT wm - -delocaliseAll :: GenericM DelocaliserM -delocaliseAll = everywhereEnv Hsx.boundNamesEnv delocalise - -delocalise :: GenericM DelocaliserM -delocalise = mkM delocaliseLet - `extM` delocaliseClsDecl - `extM` delocaliseDecl - -delocaliseDecl :: HskDecl -> DelocaliserM HskDecl -delocaliseDecl (pos, decl) = - do liftGensym $ Gensym.setPos pos - return (pos, decl) - -delocaliseClsDecl :: Hsx.ClassDecl () -> DelocaliserM (Hsx.ClassDecl ()) -delocaliseClsDecl clsDecl@(Hsx.ClsDecl _ decl) = - do addTopDecl decl - return clsDecl - -{-| - This data structure is supposed to comprise the definition - of a function and possibly its type signature declaration. --} -data FunDef = FunDef { funBind :: Hsx.Decl (), funSig :: Maybe (Hsx.Decl ()), funFreeNames :: Hsx.HskNames} - -funName :: FunDef -> Hsx.QName () -funName FunDef{funBind = Hsx.FunBind _ (Hsx.Match _ name _ _ _ : _)} = Hsx.UnQual () name - -{-| - This function renames the function name of the given function definition. --} -renameFunDef :: [Hsx.Renaming] -> FunDef -> FunDef -renameFunDef ren def@(FunDef{ funBind = bind, funSig = sig}) - = let bind' = Hsx.renameDecl ren bind - sig' = liftM (Hsx.renameDecl ren) sig - in def{ funBind = bind', funSig = sig'} - -{-| - This function partitions bindings into a pair (signature declarations, other bindings) --} -groupFunDefs :: [Hsx.Decl ()] -> [FunDef] -groupFunDefs decls = - let (funBinds,funSigs) = partition isFunBind decls - funSigs' = concatMap flattenTypeSig funSigs - sigMap = Map.fromList $ map sigName funSigs' - mkFunDef bind@(Hsx.FunBind _ (Hsx.Match _ name _ _ _ : _)) - = FunDef bind (Map.lookup name sigMap) (Hsx.extractFreeVarNs bind) - in map mkFunDef funBinds - where isFunBind (Hsx.FunBind _ _) = True - isFunBind _ = False - sigName decl@(Hsx.TypeSig _ [name] _) = (name,decl) - - -funDefComponents :: [FunDef] -> [[FunDef]] -funDefComponents funDefs = - let names = Set.fromList $ map funName funDefs - graphConstr = map graphComp funDefs - graphComp funDef = (funDef, funName funDef, Set.toList . Set.intersection names . funFreeNames $ funDef) - (graph, extr,_) = graphFromEdges graphConstr - forest = components graph - in map (map ((\(n,_,_) -> n) . extr) . flatten) forest - -{-| - This function adds an additional argument to the given match that contains the - environment of a closure. --} -addEnvArgToMatch :: Hsx.Name () -- ^the name of the environment variable - -> [Hsx.Name ()] -- ^the names of the variables in the environment - -> Hsx.Match () -- ^the match that should be enriched by an environment argument - -> Hsx.Match () -- ^the resulting match -addEnvArgToMatch envName closureNames match@(Hsx.Match loc name pats rhs binds) - = let boundNames = map uname (Hsx.extractBindingNs pats) - toPat name = if name `elem` boundNames - then Hsx.PWildCard () - else Hsx.PVar () name - allBound = all (`elem` boundNames) closureNames - tuple = case closureNames of - [closureName] -> toPat closureName - _ -> Hsx.PTuple () Hsx.Boxed (map toPat closureNames) - passing = (Hsx.UnQual () envName) `Set.member` Hsx.extractFreeVarNs match - envArg = if passing then if allBound - then Hsx.PVar () envName - else Hsx.PAsPat () envName tuple - else if allBound - then Hsx.PWildCard () - else tuple - in (Hsx.Match loc name (envArg : pats) rhs binds) - where uname (Hsx.Qual _ _ name) = name - uname (Hsx.UnQual _ name) = name - -{-| - This function adds an additional argument to the given function binding that contains the - environment of a closure. --} -addEnvArgToDecl :: Hsx.Name () -- ^the name of the environment variable - -> [Hsx.Name ()] -- ^the names of the variables in the environment - -> Hsx.Decl () -- ^the match that should be enriched by an environment argument - -> Hsx.Decl () -- ^the resulting match -addEnvArgToDecl envName closureNames (Hsx.FunBind l matches) - = let matches' = map (addEnvArgToMatch envName closureNames) matches - in Hsx.FunBind l matches' - -addPatBindsToMatch :: [Hsx.Decl ()] -> Hsx.Match () -> Hsx.Match () -addPatBindsToMatch patBinds match@(Hsx.Match loc name pats (Hsx.UnGuardedRhs _ exp) binds) - = let neededPatBinds = filter patBindNeeded patBinds - shadowedPatBinds = map shadowPatBind neededPatBinds - rhs' = Hsx.UnGuardedRhs () (Hsx.Let () (Hsx.BDecls () shadowedPatBinds) exp) - in if null neededPatBinds - then match - else Hsx.Match loc name pats rhs' binds - where patBindNeeded patBind - = not (Set.null ( Set.fromList (Hsx.extractBindingNs patBind) - `Set.intersection` Hsx.extractFreeVarNs exp )) - boundNames = Set.fromList (Hsx.extractBindingNs pats) - shadowPatBind :: Hsx.Decl () -> Hsx.Decl () - shadowPatBind (Hsx.PatBind loc pat rhs binds) - = (Hsx.PatBind loc (shadow pat) rhs binds) - shadowPVar :: Hsx.Pat () -> Hsx.Pat () - shadowPVar var@(Hsx.PVar _ name) - | Hsx.UnQual () name `Set.member` boundNames = Hsx.PWildCard () - | otherwise = var - shadowPVar oth = oth - - shadow :: GenericT - shadow = everywhere (mkT shadowPVar) - -addPatBindsToDecl :: [Hsx.Decl ()] -> Hsx.Decl () -> Hsx.Decl () -addPatBindsToDecl patBinds (Hsx.FunBind l matches) = - let matches' = map (addPatBindsToMatch patBinds) matches - in Hsx.FunBind l matches' -addPatBindsToDecl _ decl@(Hsx.TypeSig _ _ _) = decl -addPatBindsToDecl patBinds decl = error $ "Function binding expected but found:\n" ++ Hsx.prettyPrint decl - - -delocaliseFunDefs :: [FunDef] -> DelocaliserM [Hsx.Decl ()] -delocaliseFunDefs funDefs = - do envNames <- Hsx.boundNames - let freeNames = Set.unions (map funFreeNames funDefs) - closureNames = freeNames `Set.intersection` envNames - closureNameList = Set.toList closureNames - closureUNameList = map uname closureNameList - funNames = map funName funDefs - renamings <- liftGensym $ Hsx.freshIdentifiers funNames - envUName <- liftGensym $ Gensym.genHsName (Hsx.Ident () "env") - let envName = Hsx.UnQual () envUName - addEnv (orig,ren) = (orig, Hsx.App () (Hsx.Var () ren) (Hsx.Var () envName)) - envTuple = case closureNameList of - [closureName] -> Hsx.Var () closureName - _ -> Hsx.Tuple () Hsx.Boxed (map (Hsx.Var ()) closureNameList) - patBind f (orig,ren) = Hsx.PatBind - () - (Hsx.PVar () $ uname orig) - (Hsx.UnGuardedRhs () $ f (Hsx.Var () ren)) - Nothing - addEnvTuple = patBind (\x -> Hsx.App () x envTuple) - withoutEnvTuple = patBind id - subst = Map.fromList $ map addEnv renamings - funs = map funBind funDefs - funsRenamed = map (Hsx.renameDecl renamings) funs - funsNoEnvPassing = map (Hsx.renameFreeVars renamings) funsRenamed - funsEnvPassing = Hsx.applySubst subst funsRenamed - funsDeloc = if null closureNameList - then funsNoEnvPassing - else map (addEnvArgToDecl envUName closureUNameList) funsEnvPassing - newPatBinds = if null closureNameList - then map withoutEnvTuple renamings - else map addEnvTuple renamings - addTopDecls funsDeloc - return newPatBinds - where uname (Hsx.Qual _ _ name) = name - uname (Hsx.UnQual _ name) = name - -delocaliseLet :: Hsx.Exp () -> DelocaliserM (Hsx.Exp ()) -delocaliseLet (Hsx.Let l binds exp) = - let (Hsx.BDecls _ patBinds, Hsx.BDecls _ funBinds) = splitPatBinds (checkBindings binds) - funBinds' = map (addPatBindsToDecl patBinds) funBinds - funDefs = funDefComponents (groupFunDefs funBinds') - in do newPatBinds <- mapM delocaliseFunDefs funDefs - let newBinds = Hsx.BDecls () $ (concat newPatBinds) ++ patBinds - return $ Hsx.Let l newBinds exp -delocaliseLet exp = return exp - - - -{-| - This predicates checks whether the argument is a pattern binding. --} -isPatBind :: Hsx.Decl () -> Bool -isPatBind (Hsx.PatBind _ _ _ _) = True -isPatBind _ = False - - -{-| - This function partitions bindings into a pair (pattern bindings, other bindings) --} -splitPatBinds :: Hsx.Binds () -> (Hsx.Binds (), Hsx.Binds ()) -splitPatBinds (Hsx.BDecls _ decls) - = let (patDecls, typeSigs, otherDecls) = unzip3 (map split decls) - (patDecls', typeSigs', otherDecls') = (catMaybes patDecls, - concatMap flattenTypeSig (catMaybes typeSigs), - catMaybes otherDecls) - (patTypeSigs, otherTypeSigs) - = partition (let patNs = concatMap Hsx.namesFromDeclInst patDecls' - in \sig -> head (Hsx.namesFromDeclInst sig) `elem` patNs) - typeSigs' - in (Hsx.BDecls () (patTypeSigs ++ patDecls'), Hsx.BDecls () (otherTypeSigs ++ otherDecls')) - - where split decl@(Hsx.PatBind _ _ _ _) = (Just decl, Nothing, Nothing) - split decl@(Hsx.TypeSig _ _ _) = (Nothing, Just decl, Nothing) - split decl = (Nothing, Nothing, Just decl) -splitPatBinds junk = error ("splitPatBinds: Fall through. " ++ show junk) - -getPatDecls :: Hsx.Binds () -> [Hsx.Decl ()] -getPatDecls bindings - = let Hsx.BDecls _ patdecls = fst (splitPatBinds bindings) in patdecls - -flattenTypeSig :: Hsx.Decl () -> [Hsx.Decl ()] -flattenTypeSig (Hsx.TypeSig loc names typ) - = map (\n -> Hsx.TypeSig loc [n] typ) names - ----- Normalization of names. --- --- Function definitions are restricted in Isar/HOL such that names of --- constants must not be used as a bound variable name in those definitions. --- --- We simply rename all those identifiers. --- - -should_be_renamed :: [String] -> Hsx.QName () -> Bool -should_be_renamed reserved qn = case qn of - Hsx.Qual _ _ n -> consider n - Hsx.UnQual _ n -> consider n - where consider (Hsx.Ident _ s) = s `elem` reserved - consider (Hsx.Symbol _ s) = s `elem` reserved - -normalizeNames_Decl :: [String] -> Hsx.Decl () -> Gensym.GensymM (Hsx.Decl ()) -normalizeNames_Decl reserved (Hsx.FunBind l matchs) - = do matchs' <- mapM normalizePatterns_Match matchs - return (Hsx.FunBind l matchs') - where - normalizePatterns_Match (Hsx.Match loc name pats (Hsx.UnGuardedRhs loc' body) where_binds) - = let bound_var_ns = Hsx.bindingsFromPats pats - clashes = filter (should_be_renamed reserved) bound_var_ns - in do renames <- Hsx.freshIdentifiers clashes - pats' <- return (map (Hsx.renamePat renames) pats) - body' <- return (Hsx.renameFreeVars renames body) - binds' <- mapM normalizeNames_Binds where_binds - return (Hsx.Match loc name pats' (Hsx.UnGuardedRhs loc' body') binds') - normalizePatterns_Match (Hsx.InfixMatch loc pat name pats (Hsx.UnGuardedRhs loc' body) where_binds) - = do Hsx.Match loc name (pat : pats) body where_binds <- normalizePatterns_Match (Hsx.Match loc name (pat : pats) (Hsx.UnGuardedRhs loc' body) where_binds) - return (Hsx.InfixMatch loc pat name pats body where_binds) - - normalizeNames_Binds (Hsx.BDecls loc decls) - = do decls' <- mapM (normalizeNames_Decl reserved) decls - return (Hsx.BDecls loc decls') - -normalizeNames_Decl reserved decl - -- There aren't any subdecls in decl anymore after delocalization. - = return decl - --- normalizeModuleNameName :: String -> String - - -whereToLet :: Hsx.Decl () -> Hsx.Decl () -whereToLet = - everywhere $ mkT - whereToLetDecl `extT` - whereToLetMatch `extT` - whereToLetAlt - -isEmptyBinds :: Maybe (Hsx.Binds ()) -> Bool -isEmptyBinds (Just (Hsx.BDecls _ [])) = True -isEmptyBinds (Just (Hsx.IPBinds _ [])) = True -isEmptyBinds Nothing = True -isEmptyBinds _ = False - -whereToLetRhs _ (Hsx.GuardedRhss _ _) = assert False undefined -whereToLetRhs binds (Hsx.UnGuardedRhs _ exp) = - Hsx.UnGuardedRhs () $ Hsx.Let () (case binds of Nothing -> Hsx.BDecls () [] ; Just binds -> binds) exp - -whereToLetDecl :: Hsx.Decl () -> Hsx.Decl () -whereToLetDecl (Hsx.PatBind loc pat rhs binds) - | not $ isEmptyBinds binds = Hsx.PatBind loc pat (whereToLetRhs binds rhs) Nothing -whereToLetDecl decl = decl - -whereToLetMatch :: Hsx.Match () -> Hsx.Match () -whereToLetMatch match@(Hsx.Match loc name pats rhs binds) - | isEmptyBinds binds = match - | otherwise = Hsx.Match loc name pats (whereToLetRhs binds rhs) Nothing -whereToLetMatch match@(Hsx.InfixMatch loc pat name pats rhs binds) - | isEmptyBinds binds = match - | otherwise = Hsx.InfixMatch loc pat name pats (whereToLetRhs binds rhs) Nothing - -whereToLetAlt :: Hsx.Alt () -> Hsx.Alt () -whereToLetAlt orig@(Hsx.Alt loc pat alt binds) - | isEmptyBinds binds = orig - | otherwise = Hsx.Alt loc pat (whereToLetRhs binds alt) Nothing - - ----- Deguardification - -type DeguardifyEnv = Reader Bool - -runDeguardifyEnv :: DeguardifyEnv a -> a -runDeguardifyEnv m = runReader m False - -{-| - This environment defines a Boolean value indicating whether we are inside - the last match in a function definition --} -deguardify :: forall l. (Eq l, Data l, Ord l, Show l) => Hsx.Decl l -> Hsx.Decl l -deguardify decl = runDeguardifyEnv $ everywhereEnv deguardifyEnv deguardifyLocal decl - where - deguardifyEnv :: (Monad m) => EnvDef m Bool - deguardifyEnv = mkE fromMatches - fromMatches :: [Hsx.Match l] -> Envs (Repl Bool) - fromMatches [] = Envs [] - fromMatches [_] = Envs [Set True,Set False] - fromMatches (_:_) = Envs [Set False,Set False] - - deguardifyLocal :: GenericM DeguardifyEnv - deguardifyLocal = mkM (deguardifyRhs :: Hsx.Rhs () -> DeguardifyEnv (Hsx.Rhs ())) - `extM` (deguardifyAlts :: Hsx.Rhs () -> DeguardifyEnv (Hsx.Rhs ())) - - -deguardifyRhs :: Hsx.Rhs () -> DeguardifyEnv (Hsx.Rhs ()) -deguardifyRhs rhs@(Hsx.UnGuardedRhs _ _) = return rhs -deguardifyRhs (Hsx.GuardedRhss _ guards) = liftM (Hsx.UnGuardedRhs ()) $ deguardifyGuards guards - -deguardifyAlts :: Hsx.Rhs () -> DeguardifyEnv (Hsx.Rhs ()) -deguardifyAlts alt@(Hsx.UnGuardedRhs _ _) = return alt -deguardifyAlts (Hsx.GuardedRhss _ guards) = - liftM (Hsx.UnGuardedRhs ()) . - deguardifyGuards . - (map (\(Hsx.GuardedRhs l ss e) -> Hsx.GuardedRhs l ss e)) $ - guards -deguardifyGuards :: [Hsx.GuardedRhs ()] -> DeguardifyEnv (Hsx.Exp ()) -deguardifyGuards guards = - do isLast <- ask - let findOtherwiseExpr guards - = case break isTrivial guards of - (guards', (Hsx.GuardedRhs _ _ last_expr):_) -> (guards', last_expr) - (guards',[]) - | isLast -> let Hsx.GuardedRhs srcLoc _ _ = last guards' - in error $ show {-Msg.found_inconsistency_in_guards-} srcLoc - | otherwise -> (guards', bottom) - (guards', otherwise_expr) = findOtherwiseExpr guards - return $ foldr deguardify otherwise_expr guards' - where otherwise_stmt = Hsx.Qualifier () (Hsx.Var () (Hsx.UnQual () (Hsx.Ident () "otherwise"))) - true_stmt = Hsx.Qualifier () (Hsx.Var () (Hsx.UnQual () (Hsx.Ident () "True"))) - bottom = Hsx.Var () (Hsx.Qual () (Hsx.ModuleName () "Prelude") (Hsx.Symbol () "_|_")) - isTrivial (Hsx.GuardedRhs _ stmts _) = - stmts `elem` [[otherwise_stmt], [true_stmt]] - deguardify x@(Hsx.GuardedRhs loc stmts clause) body - = Hsx.If () (makeGuardExpr stmts) clause body - makeGuardExpr stmts = if null stmts - then (Hsx.Var () (Hsx.UnQual () (Hsx.Ident () "True"))) - else foldl1 andify (map expify stmts) - where expify (Hsx.Qualifier _ exp) = exp - andify e1 e2 = Hsx.InfixApp () e1 (Hsx.QVarOp () (Hsx.Qual () (Hsx.ModuleName () "Prelude") (Hsx.Symbol () "&&"))) e2 - - --- `let' in Haskell is actually a letrec, but Isar/HOL does not allow --- recursive let expressions. We hence check the bindings in question --- whether or not we can deal with them. --- -checkBindings :: Hsx.Binds () -> Hsx.Binds () -checkBindings bindings - = checkForRecursiveBinds . checkForForwardRefs $ bindings - --- Check for forward references, e.g. prohibit --- --- let a = b * 42 --- b = 23 in ... --- --- as `b' is referenced before its binding is established. --- --- Notice that do allow forward referencing to functions like for --- instance in --- --- let a x = 32 + b x --- b y = c (- y) --- c z = 42 * z in ... --- --- We can allow this because the function will be globalized, and --- hence moved out of the `let' expression. --- -checkForForwardRefs bindings - = let vardecls = getPatDecls bindings - in case filter (\(decl, forwardNss) - -> any (`elem` concat forwardNss) $ Set.toList (Hsx.extractFreeVarNs decl)) - $ zip vardecls - -- These are the consecutively following binding names: - (tails (map Hsx.extractBindingNs vardecls)) - of [] -> bindings - (decl, _):_ -> error (Msg.forward_bindings_disallowed (Hsx.getSrcLoc decl)) - --- Check for recursive binding attempts, e.g. prohibit --- --- let ones = 1 : ones in ... --- --- For the same reasons as above (forward refs), we do all recursive --- local function definitions. --- -checkForRecursiveBinds bindings - = let find_recursive_binds = filter (\d -> any (`elem` Hsx.extractBindingNs d) - $ Hsx.extractVarNs d) - in case find_recursive_binds (getPatDecls bindings) of - [] -> bindings - d:_ -> error (Msg.recursive_bindings_disallowed (Hsx.getSrcLoc d)) diff --git a/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/Importer/Printer.hs b/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/Importer/Printer.hs deleted file mode 100644 index d20423b775a005b56187507e3b0c652ccb683c7e..0000000000000000000000000000000000000000 --- a/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/Importer/Printer.hs +++ /dev/null @@ -1,627 +0,0 @@ -{-# LANGUAGE FlexibleContexts, PatternGuards #-} - -{-| Author: Tobias C. Rittweiler, TU Muenchen - -Pretty printing of abstract Isar/HOL theory. --} - -module Importer.Printer (pprint) where - -import Importer.Library -import qualified Importer.AList as AList -import Control.Monad (ap, liftM, liftM2) - -import qualified Text.PrettyPrint as P - -import qualified Language.Haskell.Exts as Hsx (Boxed(..), SpecialCon(..), QName(..)) - -import Importer.Adapt as Adapt (AdaptionTable(AdaptionTable)) -import qualified Importer.Ident_Env as Ident_Env - -import qualified Importer.Isa as Isa - - -data PPState = PPState { globalEnv :: Ident_Env.GlobalE, - currentTheory :: Isa.ThyName, - -- Are we in an Infix Application? - currentAppFlavor :: Maybe AppFlavor, - currentTyScheme :: [(Isa.Name, [Isa.Name])], - -- If True, we're already in doubly-quoted section. - withinHOL :: Bool - } - -data DocM v = DocM (PPState -> (v, PPState)) - -emptyPPState = PPState { globalEnv = Ident_Env.initialGlobalEnv, - currentTheory = Isa.ThyName "Scratch", - currentAppFlavor = Nothing, - currentTyScheme = [], - withinHOL = False - } - -instance Functor DocM where - fmap = Control.Monad.liftM - -instance Applicative DocM where - pure = return - (<*>) = ap - -instance Monad DocM where - return value = DocM (\state -> (value, state)) - DocM sf0 >>= f - = DocM $ \s0 -> let (v1, s1) = sf0 s0 - DocM sf1 = f v1 - (v2, s2) = sf1 s1 in (v2, s2) - -queryPP :: (PPState -> field) -> DocM field -queryPP query - = DocM $ \pps -> (query pps, pps) - -updatePP :: (PPState -> PPState) -> DocM () -updatePP update - = DocM $ \pps -> ((), update pps) - -type Doc = DocM P.Doc - --- The pretty printing combinators - -empty :: Doc -empty = return P.empty - -nest :: Int -> Doc -> Doc -nest i dm = dm >>= return . P.nest i - - --- Literals - -text, ptext :: String -> Doc -text = return . P.text -ptext = return . P.text - -char :: Char -> Doc -char = return . P.char - -int :: Int -> Doc -int = return . P.int - -integer :: Integer -> Doc -integer = return . P.integer - -float :: Float -> Doc -float = return . P.float - -double :: Double -> Doc -double = return . P.double - -rational :: Rational -> Doc -rational = return . P.rational - - --- Constants - -semi, comma, colon, dot, apostroph, space :: Doc -lparen, rparen, lbrack, rbrack, lbrace, rbrace :: Doc - -semi = return P.semi -comma = return P.comma -colon = return P.colon -dot = char '.' -apostroph = char '\'' -space = return P.space - -lparen = return P.lparen -rparen = return P.rparen -lbrack = return P.lbrack -rbrack = return P.rbrack -lbrace = return P.lbrace -rbrace = return P.rbrace - -equals, prod, plus, rightarrow :: Doc - -equals = return P.equals -prod = text "\\<times>" -plus = char '+' -rightarrow = text "\\<Rightarrow>" - - - - --- Simple Combining Forms - -parens, brackets, braces, quotes, doubleQuotes, bananas, blankline :: Doc -> Doc -parens d = d >>= return . P.parens -brackets d = d >>= return . P.brackets -braces d = d >>= return . P.braces -quotes d = d >>= return . P.quotes -doubleQuotes d = d >>= return . P.doubleQuotes - -bananas d = text "(|" <+> d <+> text "|)" -blankline d = space $$ d - -parensIf :: Bool -> Doc -> Doc -parensIf True = parens -parensIf False = id - -withCurrentTheory :: Isa.ThyName -> Doc -> Doc -withCurrentTheory thy d - = do oldthy <- queryPP (\pps -> currentTheory pps) - updatePP (\pps -> pps { currentTheory = thy }) - result <- d - updatePP (\pps -> pps { currentTheory = thy }) - return result - -maybeWithinHOL :: Doc -> Doc -maybeWithinHOL d - = do within_p <- queryPP withinHOL - if within_p then d - else do updatePP (\pps -> pps { withinHOL = True }) - result <- doubleQuotes d - updatePP (\pps -> pps { withinHOL = False }) - return result - -withinHOL_if :: Bool -> Doc -> Doc -withinHOL_if pred doc - | pred = do within_p <- queryPP withinHOL - if within_p then doc - else do updatePP (\pps -> pps { withinHOL = True }) - result <- doubleQuotes doc - updatePP (\pps -> pps { withinHOL = False }) - return result - | otherwise = doc - -withinApplication :: AppFlavor -> Doc -> Doc -withinApplication app d - = do old_app <- queryPP (\pps -> currentAppFlavor pps) - updatePP (\pps -> pps { currentAppFlavor = Just app }) - result <- d - updatePP (\pps -> pps { currentAppFlavor = old_app }) - return result - - -withTyScheme :: [(Isa.Name, [Isa.Name])] -> Doc -> Doc -withTyScheme ctx d - = do old_ctx <- queryPP (\pps -> currentTyScheme pps) - updatePP (\pps -> pps { currentTyScheme = ctx }) - result <- d - updatePP (\pps -> pps { currentTyScheme = old_ctx }) - return result - -comment :: Doc -> Doc -comment d = text "(*" <+> d <+> text "*)" - --- fill-paragraph str = vcat $ map text (lines str) - --- Combinators - -(<>),(<+>),($$),($+$) :: Doc -> Doc -> Doc -(<>) = liftM2 (P.<>) -(<+>) = liftM2 (P.<+>) -($$) = liftM2 (P.$$) -($+$) = liftM2 (P.$+$) - -ncat, hcat, hsep, vcat, sep, cat, fsep, fcat, parcommas, brcommas :: [Doc] -> Doc -ncat = foldr ($+$) empty -hcat dl = sequence dl >>= return . P.hcat -hsep dl = sequence dl >>= return . P.hsep -vcat dl = sequence dl >>= return . P.vcat -sep dl = sequence dl >>= return . P.sep -cat dl = sequence dl >>= return . P.cat -fsep dl = sequence dl >>= return . P.fsep -fcat dl = sequence dl >>= return . P.fcat -parcommas dl = sequence dl >>= return . P.parens . P.hsep . P.punctuate P.comma -brcommas dl = sequence dl >>= return . P.braces . P.hsep . P.punctuate P.comma - --- Some More - -hang :: Doc -> Int -> Doc -> Doc -hang dM i rM = do{d<-dM; r<-rM; return $ P.hang d i r} - -punctuate :: Doc -> [Doc] -> [Doc] -punctuate _ [] = [] -punctuate p (d1:ds) = go d1 ds - where go d [] = [d] - go d (e:es) = (d <> p) : go e es - -accentuate :: Doc -> [Doc] -> [Doc] -accentuate d list = map (d<>) list - -indent = 3 - -class Printer a where - pprint' :: AdaptionTable -> [String] -> a -> DocM P.Doc - pprint :: AdaptionTable -> [String] -> Ident_Env.GlobalE -> a -> P.Doc - pprint adapt reserved env obj = let - DocM sf = pprint' adapt reserved obj - (doc, _state) = sf (emptyPPState { globalEnv = env }) - in doc - -instance Printer Isa.Module where - - pprint' adapt reserved (Isa.Module thy imps cmds exportCode) - = do env <- queryPP globalEnv - let imps' = map (pprint' adapt reserved) (imps ++ [Isa.ThyName Ident_Env.prelude]) - withCurrentTheory thy $ - text "theory" <+> pprint' adapt reserved thy $+$ - text "imports " <> fsep imps' $+$ - text "begin" $+$ - (vcat $ (map (pprint' adapt reserved) cmds ++ - if exportCode then [text "ML\\<open>Haskabelle.export (Path.variable \"REGRESSION_DST\") @{theory}\\<close>"] else [])) $+$ - text "\nend\n" - -instance Printer Isa.Function_Stmt where - - pprint' adapt reserved (Isa.Function_Stmt kind sigs eqns) = - blankline $ - text prologue <+> vcat (punctuate (text " and ") (map (pprint' adapt reserved) sigs)) $$ - text "where" $$ - vcat (zipWith (<+>) (space : repeat (char '|')) - (map pprint_eqn eqns)) $$ - text epilogue - where - (prologue, epilogue) = case kind of - Isa.Definition -> ("definition", "") - Isa.Primrec -> ("primrec", "") - Isa.Fun -> ("fun", "") - Isa.Function_Sorry -> ("function (sequential)", "sorry termination sorry") - pprint_eqn (fname, pattern, term) = do - thy <- queryPP currentTheory - env <- queryPP globalEnv - let lookup = (\n -> lookupIdentifier thy n env) - maybeWithinHOL $ - pprint' adapt reserved fname <+> - hsep (map (pprint' adapt reserved) pattern) <+> - equals <+> - parensIf (isCompound adapt term lookup) (pprint' adapt reserved term) - -printFunDef adapt reserved prologue epilogue tysigs equations - = blankline $ - text prologue <+> vcat (punctuate (text " and ") (map (pprint' adapt reserved) tysigs)) $$ - text "where" $$ - vcat (zipWith (<+>) (space : repeat (char '|')) - (map ppEquation equations)) $$ - text epilogue - where - ppEquation (fname, pattern, term) - = do thy <- queryPP currentTheory - env <- queryPP globalEnv - let lookup = (\n -> lookupIdentifier thy n env) - maybeWithinHOL $ - pprint' adapt reserved fname <+> - hsep (map (pprint' adapt reserved) pattern) <+> - equals <+> - parensIf (isCompound adapt term lookup) (pprint' adapt reserved term) - -instance Printer Isa.Stmt where - - pprint' adapt reserved (Isa.Comment string) = empty -- blankline $ comment string - - pprint' adapt reserved (Isa.Datatype (decl : decls)) = - blankline $ vcat (text "datatype" <+> pprintDecl decl : - map ((text "and " <+>) . pprintDecl) decls) where - pprintDecl (tyspec, dataspecs) = - pprint' adapt reserved tyspec <+> vcat (zipWith (<+>) (equals : repeat (char '|')) - (map pprintConstr dataspecs)) - pprintConstr (con, types) = - hsep $ pprint' adapt reserved con : map (pprint' adapt reserved) types - - pprint' adapt reserved (Isa.Record tyspec conspecs) - = blankline $ - text "record" <+> pprint' adapt reserved tyspec <+> equals $$ - space <+> vcat (map pp conspecs) - where pp (slotName, slotType) = pprint' adapt reserved slotName <+> text "::" <+> pprint' adapt reserved slotType - - pprint' adapt reserved (Isa.Function stmt) = pprint' adapt reserved stmt - - pprint' adapt reserved (Isa.Class classN superclassNs typesigs) - = blankline $ - text "class" - <+> pprint' adapt reserved classN - <+> (if null superclassNs && null typesigs then empty else equals) - <+> hsep (punctuate plus (map (pprint' adapt reserved) superclassNs)) - <+> (if null superclassNs || null typesigs then empty else plus) $$ - space <> space <> - vcat (zipWith (<+>) (repeat (text "fixes")) (map ppSig typesigs)) - where ppSig (Isa.TypeSign n arities t) - = pprint' adapt reserved n <+> text "::" <+> withTyScheme arities (pprint' adapt reserved t) - - pprint' adapt reserved (Isa.Instance classN tycoN arities stmts) = do - thy <- queryPP currentTheory - let stmts' = map (renameFunctionStmt thy) stmts - blankline $ - text "instantiation" <+> pprint' adapt reserved tycoN <+> text "::" - <+> (if null arities then pprint' adapt reserved classN - else parcommas (map (pprint_sort adapt reserved . snd) arities) <+> pprint' adapt reserved classN) $$ - text "begin" $$ - space <> space <> vcat (map (pprint' adapt reserved) stmts') $$ - (blankline $ text "instance sorry\n" $$ text "end") - where - suffix = Isa.base_name_of tycoN - suffix_tyco (Isa.QName t n) = Isa.QName t (concat [n, "_", suffix]) - suffix_tyco (Isa.Name n) = Isa.Name (concat [n, "_", suffix]) - renameTypeSign (Isa.TypeSign name vs ty) = Isa.TypeSign (suffix_tyco name) vs ty - renameClause (name, pats, body) = (suffix_tyco name, pats, body) - renameFunctionStmt thy (Isa.Function_Stmt kind tysigs clauses) = - Isa.Function_Stmt kind (map renameTypeSign tysigs) (map renameClause clauses) - - pprint' adapt reserved (Isa.TypeSynonym aliases) = blankline $ foldl ($+$) empty (map pp aliases) - where - pp (spec, typ) = text "type_synonym" <+> pprint' adapt reserved spec - <+> equals <+> pprint' adapt reserved typ - -instance Printer Isa.ThyName where - pprint' adapt reserved (Isa.ThyName name) = - text (map (\c -> if c == '.' then '_' else c) name) - -- FIXME need uniform rename of theory names - -instance Printer Isa.TypeSpec where - pprint' adapt reserved (Isa.TypeSpec [] tycon) - = pprint' adapt reserved tycon - pprint' adapt reserved (Isa.TypeSpec tyvars tycon) - = let tyvars' = parens . hsep . punctuate comma . accentuate apostroph $ - map (pprint' adapt reserved) tyvars - in tyvars' <+> pprint' adapt reserved tycon - -instance Printer Isa.Name where - pprint' adapt reserved n = case n of - Isa.Name str -> pprintName reserved str - Isa.QName _ str -> pprintName reserved str -- FIXME - -pprintName reserved str = withinHOL_if (isReservedKeyword str) - $ do thy <- queryPP currentTheory - env <- queryPP globalEnv - app <- queryPP currentAppFlavor - case app of - Just (InfixApp _ _ _) -> text str - _ -> let lookup s = lookupIdentifier thy (Isa.Name s) env - in if (isInfixOp lookup str || isUnaryOp lookup str) - then parens $ text "op" <+> text str - else text str - where - isReservedKeyword :: String -> Bool - isReservedKeyword str = str `elem` reserved - -pprint_sort :: AdaptionTable -> [String] -> [Isa.Name] -> DocM P.Doc -pprint_sort adapt reserved [cls] = pprint' adapt reserved cls -pprint_sort adapt reserved sort = brcommas $ map (pprint' adapt reserved) sort - -instance Printer Isa.Type where - pprint' adapt reserved (Isa.NoType) = text "" - pprint' adapt reserved (Isa.TVar vname) - = do alist <- queryPP currentTyScheme - let tyvar_doc = apostroph <> pprint' adapt reserved vname - let sort = these (lookup vname alist) - if null sort - then tyvar_doc - else parens (tyvar_doc <+> text "::" <+> pprint_sort adapt reserved sort) - - pprint' adapt reserved (Isa.Type cname []) = pprint' adapt reserved cname - pprint' adapt reserved (Isa.Type cname [typ]) = - maybeWithinHOL $ - parensIf (isCompoundType typ) (pprint' adapt reserved typ) - <+> pprint' adapt reserved cname - pprint' adapt reserved (Isa.Type (Isa.QName (Isa.ThyName "Product_Type") "prod") [typ1, typ2]) = - {- FIXME hardwired syntax -} - maybeWithinHOL $ parensIf (isCompoundType typ1) (pprint' adapt reserved typ1) - <+> text "*" <+> parensIf (isCompoundType typ2) (pprint' adapt reserved typ2) - pprint' adapt reserved (Isa.Type cname typs) = - maybeWithinHOL $ - parcommas (map (pprint' adapt reserved) typs) - <+> pprint' adapt reserved cname - - pprint' adapt reserved (Isa.Func t1 t2) - = maybeWithinHOL $ - case t1 of Isa.Func _ _ -> parens (pprint' adapt reserved t1) <+> rightarrow <+> pprint' adapt reserved t2 - _ -> pprint' adapt reserved t1 <+> rightarrow <+> pprint' adapt reserved t2 - - -instance Printer Isa.TypeSign where - pprint' adapt reserved (Isa.TypeSign name _ Isa.NoType) = pprint' adapt reserved name - pprint' adapt reserved (Isa.TypeSign name arities typ) = pprint' adapt reserved name <+> text "::" - <+> maybeWithinHOL (withTyScheme arities (pprint' adapt reserved typ)) - -instance Printer Isa.Literal where - -- We annotate Integer literals explicitly to be of our sort "num" - -- (cf. Prelude.thy), because otherwise Isabelle's type inference - -- would come up with a too general type, resulting in - -- non-workingness. - pprint' adapt reserved (Isa.Int i) = let cc = colon <> colon in - integer i - -- parens $ integer i <> cc <> text "_" <> cc <> text "num" - pprint' adapt reserved (Isa.Char ch) = text "CHR" <+> quotes (quotes (char ch)) - pprint' adapt reserved (Isa.String str) = quotes . quotes . text $ str - -instance Printer Isa.Term where - pprint' adapt reserved (Isa.Const vname) = pprint' adapt reserved vname - pprint' adapt reserved (Isa.Literal lit) = pprint' adapt reserved lit - pprint' adapt reserved (Isa.Parenthesized t) - = do thy <- queryPP currentTheory - env <- queryPP globalEnv - let lookup = (\n -> lookupIdentifier thy n env) - parensIf (not (isSelfEvaluating adapt t lookup)) - $ pprint' adapt reserved t - - pprint' adapt reserved app @ (Isa.App t1 t2) - = do thy <- queryPP currentTheory - env <- queryPP globalEnv - let lookup = (\n -> lookupIdentifier thy n env) - let flavor = categorizeApp adapt app lookup - withinApplication flavor $ - case flavor of - ListApp l -> pprintAsList adapt reserved l - TupleApp l -> pprintAsTuple adapt reserved l - InfixApp x op y -> let x' = parensIf (isCompound adapt x lookup) $ pprint' adapt reserved x - y' = parensIf (isCompound adapt y lookup) $ pprint' adapt reserved y - in x' <+> pprint' adapt reserved op <+> y' - FunApp -> pprint' adapt reserved t1 <+> parensIf (isCompound adapt t2 lookup) (pprint' adapt reserved t2) - UnaryOpApp -> pprint' adapt reserved t1 <+> parensIf (isCompound adapt t2 lookup) (pprint' adapt reserved t2) - - pprint' adapt reserved (Isa.If t1 t2 t3) - = fsep [text "if" <+> pprint' adapt reserved t1, - text "then" <+> pprint' adapt reserved t2, - text "else" <+> pprint' adapt reserved t3] - - pprint' adapt reserved lexpr@(Isa.Abs _ _) - = let (argNs, body) = flattenLambdas lexpr in - fsep [text "%" <+> hsep (map (pprint' adapt reserved) argNs) <+> dot, - nest 2 (pprint' adapt reserved body)] - - pprint' adapt reserved (Isa.RecConstr recordN updates) - = pprint' adapt reserved recordN <+> (bananas . vcat . punctuate comma $ map pp updates) - where pp (vname, typ) = pprint' adapt reserved vname <+> equals <+> pprint' adapt reserved typ - - pprint' adapt reserved (Isa.RecUpdate term updates) - = pprint' adapt reserved term <+> (bananas . vcat . punctuate comma $ map pp updates) - where pp (vname, typ) = pprint' adapt reserved vname <+> text ":=" <+> pprint' adapt reserved typ - - pprint' adapt reserved (Isa.Case term matchs) - = hang (text "case" <+> pprint' adapt reserved term <+> text "of") - 1 - (vcat $ zipWith (<+>) (space : repeat (char '|')) - (map pp matchs)) - where pp (pat, term) = (pprint' adapt reserved pat) <+> rightarrow <+> pprint' adapt reserved term - - - pprint' adapt reserved (Isa.Let bindings body) - = text "let" <+> vcat (punctuate semi (map ppBinding bindings)) - $$ text "in" <+> pprint' adapt reserved body - where ppBinding (pat, term) - = pprint' adapt reserved pat <+> equals <+> pprint' adapt reserved term - - pprint' adapt reserved (Isa.ListCompr body stmts) - = brackets $ pprint' adapt reserved body <+> text "." <+> - (vcat (punctuate comma (map ppStmt stmts))) - where - ppStmt (Isa.Guard b) - = pprint' adapt reserved b - ppStmt (Isa.Generator (p, e)) - = pprint' adapt reserved p <+> text "<-" <+> pprint' adapt reserved e - - pprint' adapt reserved (Isa.DoBlock pre stmts post) = - text pre <+> (vcat $ (printStmts stmts) ++ [text post]) - where printStmts [stmt] = [pprint' adapt reserved stmt] - printStmts (stmt:stmts) = (pprint' adapt reserved stmt <> semi) : (printStmts stmts) - -instance Printer Isa.DoBlockFragment where - pprint' adapt reserved (Isa.DoGenerator pat exp) = pprint' adapt reserved pat <+> text "<-" <+> pprint' adapt reserved exp - pprint' adapt reserved (Isa.DoQualifier exp) = pprint' adapt reserved exp - - -reAdaptEnvName :: AdaptionTable -> Ident_Env.Name -> Maybe Ident_Env.Name -reAdaptEnvName adapt name - = let AdaptionTable mappings = adapt - mappings' = [ (Ident_Env.identifier2name id2, Ident_Env.identifier2name id1) - | (id1, id2) <- mappings ] - in lookup name mappings' - -isNil, isCons, isPairCon :: AdaptionTable -> Isa.Name -> Bool - -mk_isFoo adapt foo n = case reAdaptEnvName adapt (Ident_Env.fromIsa n) of - Nothing -> False - Just x -> case Ident_Env.toHsk x of - Hsx.Special _ con -> con == foo - _ -> False - -isNil adapt = mk_isFoo adapt (Hsx.ListCon ()) -isCons adapt = mk_isFoo adapt (Hsx.Cons ()) -isPairCon adapt = mk_isFoo adapt (Hsx.TupleCon () Hsx.Boxed 2) - -pprintAsList :: AdaptionTable -> [String] -> [Isa.Term] -> DocM P.Doc -pprintAsList adapt reserved ts = brackets (hsep (punctuate comma (map (pprint' adapt reserved) ts))) - -pprintAsTuple :: AdaptionTable -> [String] -> (Isa.Term, Isa.Term) -> DocM P.Doc -pprintAsTuple adapt reserved (t1, t2) = (parens . hsep . punctuate comma . map (pprint' adapt reserved)) [t1, t2] - - -data AppFlavor = ListApp [Isa.Term] - | TupleApp (Isa.Term, Isa.Term) - | InfixApp Isa.Term Isa.Term Isa.Term - | UnaryOpApp - | FunApp - deriving (Show) - --- This makes use of pattern guards which are not Haskell98, but quite --- portable across implementations nontheless. --- --- Cf. http://www.haskell.org/ghc/docs/latest/html/users_guide/syntax-extns.html#pattern-guards --- - -categorizeApp :: AdaptionTable -> Isa.Term -> (Isa.Name -> Maybe Ident_Env.Identifier) -> AppFlavor -categorizeApp adapt app@(Isa.App (Isa.App (Isa.Const opN) t1) t2) lookupFn - | isCons adapt opN, Just list <- flattenListApp adapt app = ListApp list - | isPairCon adapt opN, Just list <- destTupleApp adapt app = TupleApp list - | isInfixOp lookupFn opN = InfixApp t1 (Isa.Const opN) t2 -categorizeApp _ (Isa.App (Isa.Const opN) _) lookupFn - | isUnaryOp lookupFn opN = UnaryOpApp - | otherwise = FunApp -categorizeApp _ _ _ = FunApp - -flattenListApp :: AdaptionTable -> Isa.Term -> Maybe [Isa.Term] -flattenListApp adapt t = case uncombr dest_cons t of - (ts, Isa.Const c) | isNil adapt c -> Just ts - _ -> Nothing - where - dest_cons (Isa.App (Isa.App (Isa.Const c) t1) t2) | isCons adapt c = Just (t1, t2) - dest_cons _ = Nothing - -destTupleApp :: AdaptionTable -> Isa.Term -> Maybe (Isa.Term, Isa.Term) -destTupleApp adapt (Isa.App (Isa.App (Isa.Const c) t1) t2) | isPairCon adapt c = Just (t1, t2) -destTupleApp _ _ = Nothing - --- flattenLambdas ``%x . %y . %z . foo'' => ([x,y,z], foo) --- -flattenLambdas :: Isa.Term -> ([Isa.Name], Isa.Term) -flattenLambdas (Isa.Abs arg1 (Isa.Abs arg2 body)) - = let (args, real_body) = flattenLambdas body - in ([arg1,arg2]++args, real_body) -flattenLambdas (Isa.Abs arg body) = ([arg], body) -flattenLambdas t = ([], t) - -isSelfEvaluating :: AdaptionTable -> Isa.Term -> (Isa.Name -> Maybe Ident_Env.Identifier) -> Bool -isSelfEvaluating adapt t lookupFn - = case t of - Isa.Const _ -> True - Isa.Literal _ -> True - Isa.Parenthesized _ -> True - Isa.App _ _ -> case categorizeApp adapt t lookupFn of - ListApp _ -> True - TupleApp _ -> True - FunApp -> False - UnaryOpApp -> False - InfixApp _ _ _ -> False - _ -> False - -isCompound :: AdaptionTable -> Isa.Term -> (Isa.Name -> Maybe Ident_Env.Identifier) -> Bool -isCompound adapt t lookupFn - = case t of - Isa.Const _ -> False - Isa.Literal _ -> False - Isa.Parenthesized _ -> False - Isa.App _ _ -> case categorizeApp adapt t lookupFn of - ListApp _ -> False - TupleApp _ -> False - FunApp -> False - UnaryOpApp -> True - InfixApp _ _ _ -> True - _ -> True - -isCompoundType :: Isa.Type -> Bool -isCompoundType t = case t of - Isa.TVar _ -> False - Isa.Type _ [] -> False - _ -> True - -isInfixOp :: (a -> Maybe Ident_Env.Identifier) -> a -> Bool -isInfixOp lookupFn name - = case lookupFn name of - Just id -> Ident_Env.isInfixOp id - _ -> False - -isUnaryOp :: (a -> Maybe Ident_Env.Identifier) -> a -> Bool -isUnaryOp lookupFn name - = case lookupFn name of - Just id -> Ident_Env.isUnaryOp id - _ -> False - -lookupIdentifier :: Isa.ThyName -> Isa.Name -> Ident_Env.GlobalE -> Maybe Ident_Env.Identifier -lookupIdentifier thy n globalEnv - = Ident_Env.lookupConstant (Ident_Env.fromIsa thy) (Ident_Env.fromIsa n) globalEnv diff --git a/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/Importer/Test/Diag.hs b/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/Importer/Test/Diag.hs deleted file mode 100644 index f4e539d29d80a7a9d3054c9f367e401c37e5ef93..0000000000000000000000000000000000000000 --- a/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/Importer/Test/Diag.hs +++ /dev/null @@ -1,66 +0,0 @@ -{-| Author: Tobias Rittweiler, TU Muenchen - -Collection of various diagnostic function --} - -module Importer.Test.Diag where - -import System.FilePath -import Data.Tree -import Text.PrettyPrint (render, vcat, text, (<>), Doc) - -import Importer.Library - -import Language.Haskell.Exts.Pretty -import Language.Haskell.Exts.Syntax - -import Importer.ConversionUnit -import Importer.Configuration -import Importer.Printer (pprint) -import Importer.Preprocess - - -{-| - This function pretty prints the given Isabelle Unit. --} -pprintIsaUnit :: IsaUnit -> Doc -pprintIsaUnit (IsaUnit thys _ env) - = vcat (map (dashes . flip pprint env) thys) - where dashes d = d <> (text "\n") <> (text (replicate 60 '-')) - -printIsaUnit_asAST :: IsaUnit -> Doc -printIsaUnit_asAST (IsaUnit thys _ env) - = vcat (map (dashes . text . prettyShow) thys) - where dashes d = d <> (text "\n") <> (text (replicate 60 '-')) - -{-| - This function writes the given Haskell unit into the given directory. --} -writeHskUnit :: HskUnit -> FilePath -> IO () -writeHskUnit (HskUnit modules _ _) outDir - = mapM_ (`writeHskHs.ModuleName` outDir) modules - - -{-| - This function writes a single Haskell module into the given - destination directory. --} -writeHskHs.ModuleName :: Hs.ModuleName -> FilePath -> IO () -writeHskHs.ModuleName mod@(Hs.ModuleName _ (Hs.ModuleName modName) _ _ _) dir - = do let modCont = prettyPrint mod - let dstName = map (\c -> if c == '.' then '_' else c) modName ++ ".hs" - let dstPath = combine dir dstName - writeFile dstPath modCont - -{-| - This function preprocesses the given Haskell file an stores - the resulting Haskell file into the given destination directory. --} -preprocessFile :: FilePath -> FilePath -> IO () -preprocessFile inFile outDir = do - hskUnits <- runConversion (defaultConfig [] outDir defaultCustomisations) $ parseHskFiles [inFile] - let [HskUnit modules custMods env] = hskUnits - let ppHs.ModuleNames = map preprocessHs.ModuleName modules - let ppUnit = HskUnit ppHs.ModuleNames custMods env - writeHskUnit ppUnit outDir - \ No newline at end of file diff --git a/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/Importer/Test/Generators.hs b/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/Importer/Test/Generators.hs deleted file mode 100644 index 3d6d1c20ad91b43420107c12f43460284cb430be..0000000000000000000000000000000000000000 --- a/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/Importer/Test/Generators.hs +++ /dev/null @@ -1,208 +0,0 @@ -{-# LANGUAGE TemplateHaskell #-} - -{-| Author: Patrick Bahr, NICTA - -This module provides data generators as used by /QuickCheck/ for types from external -libraries. Data generators of types defined in this application should be defined -locally with the definition of the type. --} - -module Importer.Test.Generators where - -import Importer.Test.Utils -import Test.QuickCheck -import Test.QuickCheck.Arbitrary -import Language.Haskell.TH -import Control.Monad -import Control.Monad.State -import Language.Haskell.Exts.Syntax -import Language.Haskell.Exts.Pretty -import Data.Set (Set) -import qualified Data.Set as Set hiding (Set) - --- some example declarations -{- -instance Arbitrary SrcLoc where - arbitrary = liftM3 SrcLoc arbitrary arbitrary arbitrary - shrink (SrcLoc a b c) = [SrcLoc a' b' c' | a' <- shrink a, b' <- shrink b, c' <- shrink c] - -instance Arbitrary SrcLoc where - arbitrary = sized $ \ size -> let newSize = ((size - 1) `div` 3) `max` 0 in - do a <- resize newSize arbitrary - b <- resize newSize arbitrary - c <- resize newSize arbitrary - return $ SrcLoc a b c - shrink (SrcLoc a b c) = [SrcLoc a' b' c' | a' <- shrink a, b' <- shrink b, c' <- shrink c] --} - -instance Arbitrary HsReify where - arbitrary = error "Arbitrary HsReify" - -instance (Arbitrary a , Ord a) => Arbitrary (Set a) where - arbitrary = liftM Set.fromList arbitrary - - -$(deriveArbitrary_shrink ''SrcLoc - [| - do size <- sized (\ n -> elements [0..n]) - let symbol = elements $ ['a'..'z'] ++ ['A'..'Z'] ++ "._-" - let sep = return '/' - let single = frequency [(5,symbol),(1,sep)] - file <- replicateM size single - NonNegative line <- arbitrary - NonNegative col <- arbitrary - return $ SrcLoc file line col - |]) - -{-| - This generator only generates type signatures --} - -$(deriveGenForConstrs "typeSigDecl" ['Hs.TypeSig]) - -{-| - Hs.Binds --} -$(deriveArbitraryForConstrs ['Hs.BDecls]) - -{-| - HsLiteral --} -$(deriveArbitraryForConstrs ['HsChar,'HsString, 'HsInt]) - -{-| - Hs.Pat --} -$(deriveArbitraryForConstrs [ - 'Hs.PVar, - 'Hs.PLit, - 'Hs.PNeg, - 'Hs.PInfixApp, - 'Hs.PApp, - 'Hs.PTuple, - 'Hs.PList, - 'Hs.PParen, - 'Hs.PRec, - 'Hs.PAsPat, - 'Hs.PWildCard --- 'HsPIrrPat, --- 'Hs.PatTypeSig - ]) - -{-| - Hs.ClassDecl --} -$(deriveArbitraryForConstrs [ - 'Hs.ClsDecl --- 'Hs.ClsDataFam, --- 'Hs.ClsTyFam, --- 'Hs.ClsTyDef - ]) - -{-| - Hs.Exp --} -$(deriveArbitraryForConstrs [ - 'Hs.Var, - 'HsIPVar, - 'Hs.Con, - 'HsLit, - 'Hs.InfixApp, - 'Hs.App, - 'HsNegApp, - 'Hs.Lambda, - 'Hs.Let, - 'HsDLet, - 'HsWith, - 'Hs.If, - 'Hs.Case, - 'HsDo, - 'Hs.MDo, - 'Hs.Tuple, - 'Hs.List, - 'HsParen, - 'Hs.LeftSection, - 'Hs.RightSection, - 'HsRecConstr, - 'HsRecUpdate, - 'HsEnumFrom, - 'HsEnumFromTo, - 'HsEnumFromThen, - 'HsEnumFromThenTo, - 'Hs.ListComp, - 'Hs.ExpTypeSig --- 'HsAsPat, --- 'HsWildCard, --- 'HsIrrPat, - --- Post-ops for parsing left sections and regular patterns. Not to be left in the final tree. --- 'HsPostOp, - --- HaRP --- 'HsSeqRP, --- 'HsGuardRP, --- 'HsEitherRP, --- 'HsCAsRP, - --- Template Haskell --- 'Hs.VarQuote, --- 'Hs.TypQuote, --- 'HsBracketExp, --- 'HsSpliceExp, - --- Hsx --- 'HsXTag, --- 'HsXETag, --- 'HsXPcdata, --- 'HsXExpTag, --- 'HsXRPats - ]) - -$(deriveArbitraryAll [ --- ''SrcLoc, - ''Hs.Rhs, - ''Hs.ModuleName, - ''Hs.SpecialCon, - ''Hs.QName, - ''Hs.Name, - ''HsIPName, - ''Hs.QOp, - ''HsOp, - ''HsCName, - ''Hs.ExportSpec, - ''Hs.ImportDecl, - ''HsImportSpec, - ''Hs.Assoc, - ''DataOrNew, - ''Hs.ConDecl, - ''HsGadtDecl, - ''Hs.QualConDecl, - ''Hs.Match, - ''Hs.IPBind, - ''Hs.Decl, - ''Hs.ModuleName, - ''Hs.InstDecl, - ''Hs.BangType, - ''Hs.GuardedRhs, - ''Hs.Type, - ''HsBoxed, - ''Hs.TyVarBind, - ''HsKind, - ''HsFunDep, - ''HsAsst, - ''HsXName, - ''HsXAttr, - ''HsBracket, - ''HsSplice, - ''HsSafety, - ''HsCallConv, - ''HsPXAttr, - ''HsRPatOp, - ''HsRPat, - ''Hs.PatField, - ''Hs.Stmt, - ''Hs.FieldUpdate, - ''Hs.Alt, - ''Hs.GuardedAlts, - ''Hs.GuardedAlt - ]) diff --git a/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/Importer/Test/Utils.hs b/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/Importer/Test/Utils.hs deleted file mode 100644 index e856d54b9669a8352c8ae98d2fc33e1cf2960031..0000000000000000000000000000000000000000 --- a/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/Importer/Test/Utils.hs +++ /dev/null @@ -1,317 +0,0 @@ -{-# LANGUAGE TemplateHaskell #-} - -{-| Author: Patrick Bahr, NICTA - -This module provides template functions to derive instance declarations of data types for the class 'Arbitrary'. --} - -module Importer.Test.Utils - ( -- * Deriving Functions - deriveArbitrary, - deriveArbitraryAll, - deriveArbitraryForConstrs, - deriveArbitrary_shrink, - deriveGenForConstrs - - -- * What is Derived - -- $example - - -- ** Deriving @arbitrary@ - -- $example_arbitrary - - -- ** Deriving @shrink@ - -- $example_shrink - - -- ** Using @deriveGenForConstrs@ - -- $example_partial - ) where - -import Test.QuickCheck -import Language.Haskell.TH -import Control.Monad -import Data.Maybe - - -{- $example - Let's assume we have the following data type: - - @ - data Foo = FooA A B - | FooB C D E - | FooC F - @ - - where we also assume that we have the types @A@, ..., @F@. - - The function 'deriveArbitrary' will produces the following for @Foo@ - - @ - instance Arbitrary Foo where - arbitrary = ... - shrink = ... - @ - - Details of the definition of @arbitrary@ and @shrink@ are shown in the subsequent sections. - -} - -{- $example_arbitrary - - @ - arbitrary = oneof [genFooA , genFooB , genFooC] - where genFooA = sized $ \ size -> - let newSize = (((size - 1) `div` 2) `max` 0) - in do x1 <- resize newSize arbitrary - x2 <- resize newSize arbitrary - return $ FooA x1 x2 - genFooB = sized $ \ size -> - let newSize = (((size - 1) `div` 3) `max` 0) - in do x1 <- resize newSize arbitrary - x2 <- resize newSize arbitrary - x3 <- resize newSize arbitrary - return $ FooB x1 x2 x3 - genFooC = sized $ \ size -> - let newSize = (((size - 1) `div` 1) `max` 0) - in do x1 <- resize newSize arbitrary - return $ FooC x1 - @ - --} - -{- $example_shrink - - @ - shrink (FooA x1 x2) = tail [ FooA x1' x2' | x1' <- x1 : shrink x1, x2' <- x2 : shrink x2 ] - shrink (FooB x1 x2 x3) = tail [ FooB x1' x2' x3 | x1' <- x1 : shrink x1, x2' <- x2 : shrink x2, x3' <- x3 : shrink x3 ] - shrink (FooC x1) = tail [ FooC x1' | x1' <- x1 : shrink x1] - @ - --} - -{- $example_partial - - The function 'deriveGenForConstrs' generates a generator that only - produces values of a subset of the possible values of the - type. The generator only generates values that can be constructed by - the constructors given as the argument to 'deriveGenForConstrs'. - - For example the splice @$(deriveGenForConstrs \"noFooB\" [\'FooA, \'FooB])@ - will produces the following result: - - @ - noFooB = oneof [genFooA , genFooC] - where genFooA = sized $ \ size -> - let newSize = (((size - 1) `div` 2) `max` 0) - in do x1 <- resize newSize arbitrary - x2 <- resize newSize arbitrary - return $ FooA x1 x2 - genFooC = sized $ \ size -> - let newSize = (((size - 1) `div` 1) `max` 0) - in do x1 <- resize newSize arbitrary - return $ FooC x1 - @ - --} - - --------------------------- --- Exported Definitions -- --------------------------- - -{-| - This template function generates the definition of the 'shrink' function of the class - 'Arbitrary' for the given data type name. It is necessary that all types that are used - by the data type definition are themselves instances of 'Arbitrary'. - - Usage: - - @ - $(deriveArbitrary_shrink ''MyDatatype [| /<custom definition for arbitrary>/ |]) - @ --} -deriveArbitrary_shrink :: Name -> Q Exp -> Q [Dec] -deriveArbitrary_shrink dt arbitraryExp - = do TyConI (DataD _cxt name args constrs _deriving) <- abstractNewtypeQ $ reify dt - let complType = foldl1 AppT (ConT name : map VarT args) - let classType = AppT (ConT ''Arbitrary) complType - arbitraryDecl <- funD 'arbitrary [clause [] (normalB arbitraryExp) []] - shrinkDecl <- generateShrinkDecl constrs - return $ [InstanceD [] classType [arbitraryDecl, shrinkDecl]] - - -{-| - This template function generates an instance declaration of the given data type - name for the class 'Arbitrary'. It is necessary that all types that are used by the data type definition are - themselves instances of 'Arbitrary'. --} -deriveArbitrary :: Name -> Q [Dec] -deriveArbitrary dt = do TyConI (DataD _cxt name args constrs _deriving) <- abstractNewtypeQ $ reify dt - let complType = foldl1 AppT (ConT name : map VarT args) - let classType = AppT (ConT ''Arbitrary) complType - arbitraryDecl <- generateArbitraryDecl constrs - shrinkDecl <- generateShrinkDecl constrs - return $ [InstanceD [] classType [arbitraryDecl, shrinkDecl]] - -{-| - This template function generates instance declaration for each data type name in the - given list for the class 'Arbitrary'. It is necessary that all types that are used - by the data type definitions are themselves instances of 'Arbitrary'. --} -deriveArbitraryAll :: [Name] -> Q [Dec] -deriveArbitraryAll = liftM concat . mapM deriveArbitrary - -{-| - This template function generates a generator for a data type using only - the given constructors --} -deriveGenForConstrs :: String -> [Name] -> Q [Dec] -deriveGenForConstrs genName constrNs - = do (_,constrs) <- getConstrs constrNs - liftM (:[]) $ generateGenDecl (mkName genName) constrs - - -deriveArbitraryForConstrs :: [Name] -> Q[Dec] -deriveArbitraryForConstrs constrNs = - do (dt,constrs') <- getConstrs constrNs - TyConI (DataD _cxt name args constrs _deriving) <- abstractNewtypeQ $ reify dt - let complType = foldl1 AppT (ConT name : map VarT args) - let classType = AppT (ConT ''Arbitrary) complType - arbitraryDecl <- generateArbitraryDecl constrs' - shrinkDecl <- generateShrinkDecl constrs - return $ [InstanceD [] classType [arbitraryDecl, shrinkDecl]] - --------------------------- --- Internal definitions -- --------------------------- - -getConstrs :: [Name] -> Q (Name,[Con]) -getConstrs constrNs - = do if (null constrNs) then report False "List of constructors must not be empty!" >> return undefined else do - (typeName, typeConstrs) <- getTypeConstrs $ head constrNs - let maybeConstrs = map (`lookupConstr` typeConstrs) constrNs - let confl = notFound maybeConstrs constrNs - when (not $ null confl) $ fail $ (show $ head confl) ++ " is not a constructor for " ++ (show typeName) ++"!" - return (typeName, map fromJust maybeConstrs) - where notFound :: [Maybe Con] -> [Name] -> [Name] - notFound cons names = foldr (\ e l -> case e of - (Nothing, name) -> name : l - (Just _,_) -> l - ) [] $ zip cons names -{-| - This function provides the name and the arity of the given data constructor. --} -abstractConType :: Con -> (Name,Int) -abstractConType (NormalC constr args) = (constr, length args) -abstractConType (RecC constr args) = (constr, length args) -abstractConType (InfixC _ constr _) = (constr, 2) -abstractConType (ForallC _ _ constr) = abstractConType constr - -{-| - This function provides a list (of the given length) of new names based - on the given string. --} -newNames :: Int -> String -> Q [Name] -newNames n name = replicateM n (newName name) - -{-| - This function takes the name of a constructor and returns the type it constructs and - all constructors for this type. --} -getTypeConstrs :: Name -> Q (Name,[Con]) -getTypeConstrs name = do DataConI _name _type datatypeName _fixity <- reify name - TyConI tyDecl <- reify datatypeName - let ret = - case tyDecl of - NewtypeD _ _ _ constr _ -> [constr] - DataD _ _ _ constrs _ -> constrs - return (datatypeName, ret) - -{-| - This function checks whether the given name names one of the given constructors. - If so the first such constructor is returned, if not @Nothing@ is returned. --} -lookupConstr :: Name -> [Con] -> Maybe Con -lookupConstr name [] = Nothing -lookupConstr name (constr : constrs) = case constr of - NormalC cname _ -> if cname == name - then Just constr - else lookupConstr name constrs - _ -> lookupConstr name constrs - -{-| - This function generates a declaration of the method 'arbitrary' for the given - list of constructors using 'generateGenDecl'. --} -generateArbitraryDecl :: [Con] -> Q Dec -generateArbitraryDecl = generateGenDecl 'arbitrary - -{-| - This function generates a declaration of a generator having the given name using - the given constructors, i.e., something like this: - - @ - \<name\> :: Gen \<type\> - \<name\> = ... - @ - - where @\<type\>@ is the type of the given constructors. If the constructors do not belong - to the same type this function fails. The generated function will generate only elements of - this type using the given constructors. All argument types of these constructors are supposed - to be instances of 'Arbitrary'. --} -generateGenDecl :: Name -> [Con] -> Q Dec -generateGenDecl genName constrs - = do let genList = listE $ map (constrGen . abstractConType) constrs - genBody <- [| oneof $genList |] - let genClause = Clause [] (NormalB genBody) [] - return $ FunD genName [genClause] - where constrGen (constr, n) - = do varNs <- newNames n "x" - newSizeN <- newName "newSize" - let newSizeE = varE newSizeN - let newSizeP = varP newSizeN - let constrsE = litE . IntegerL . toInteger $ n - let binds = (`map` varNs) (\var -> bindS - (varP var) - [| resize $newSizeE arbitrary |] ) - let apps = appsE (conE constr: map varE varNs) - let build = doE $ - binds ++ - [noBindS [|return $apps|]] - [| sized $ \ size -> - $(letE [valD - newSizeP - (normalB [|((size - 1) `div` $constrsE ) `max` 0|]) - [] ] - build) |] - -{-| - This function generates a declaration for the method 'shrink' using the given constructors. - The constructors are supposed to belong to the same type. --} -generateShrinkDecl :: [Con] -> Q Dec -generateShrinkDecl constrs - = let clauses = map (generateClause.abstractConType) constrs - in funD 'shrink clauses - where generateClause (constr, n) - = do varNs <- newNames n "x" - resVarNs <- newNames n "x'" - binds <- mapM (\(var,resVar) -> bindS (varP resVar) [| $(varE var) : shrink $(varE var) |]) $ zip varNs resVarNs - let ret = NoBindS $ AppE (VarE 'return) (foldl1 AppE ( ConE constr: map VarE resVarNs )) - stmtSeq = binds ++ [ret] - pat = ConP constr $ map VarP varNs - return $ Clause [pat] (NormalB $ AppE (VarE 'tail) (DoE stmtSeq)) [] - -{-| - This is the @Q@-lifted version of 'abstractNewtypeQ. --} -abstractNewtypeQ :: Q Info -> Q Info -abstractNewtypeQ = liftM abstractNewtype - -{-| - This function abstracts away @newtype@ declaration, it turns them into - @data@ declarations. --} -abstractNewtype :: Info -> Info -abstractNewtype (TyConI (NewtypeD cxt name args constr derive)) - = TyConI (DataD cxt name args [constr] derive) -abstractNewtype owise = owise \ No newline at end of file diff --git a/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/Importer/Version.hs b/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/Importer/Version.hs deleted file mode 100644 index 8559ba1b30ddccf956f3df3075fcd2ab6a83893f..0000000000000000000000000000000000000000 --- a/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/Importer/Version.hs +++ /dev/null @@ -1,9 +0,0 @@ -{-| Author: Florian Haftmann, TU Muenchen - -Version information. Substituted by admin/makedist -- DO NOT EDIT! --} - -module Importer.Version where - -version :: String -version = "Haskabelle (repository snapshot)" diff --git a/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/Main.hs b/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/Main.hs deleted file mode 100644 index f2cbc33fdb771cc01c298ca9bee04c75979cd375..0000000000000000000000000000000000000000 --- a/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/Main.hs +++ /dev/null @@ -1,97 +0,0 @@ -{-# OPTIONS_GHC -O -o bin/haskabelle_bin -odir build -hidir build -stubdir build #-} - -{- Author: Florian Haftmann, TU Muenchen - -Toplevel interface to Haskabelle importer. --} - -module Main where - -import Data.Function -import qualified Data.List as List - -import System.Environment (getArgs, getProgName) -import System.Exit (exitWith, ExitCode (ExitFailure)) -import System.IO - -import Importer.Conversion (importProject, importFiles) -import Importer.Adapt (readAdapt, Adaption (..)) -import Importer.Configuration (readConfig) -import Importer.Version (version) - -{- - Usage of the haskabelle binary: - - haskabelle_bin --internal <ADAPT> <SRC1> .. <SRCn> <DST> - haskabelle_bin --internal <ADAPT> --config <CONFIG> - haskabelle_bin --version - - Import Haskell files <SRC1> .. <SRCn> into Isabelle theories in directory - <DST>, optionally using customary adaption in directory <ADAPT> OR import - Haskell files according to configuration file <CONFIG>. --} - -readBool :: String -> IO Bool -readBool "true" = return True -readBool "false" = return False -readBool _ = exitWith (ExitFailure 2) - -tryImport = False -onlyTypes = False -basePathAbs = Nothing -ignoreNotInScope = False -absMutParams = False -metaParseShallow = False -metaParse = Nothing -hskContents = [] - -mainInterface :: [(String, [String])] -> IO () -mainInterface (("internal", [adaptDir]) : ("export", [exportVar]) : ("config", [configFile]) : []) = do - exportCode <- readBool exportVar - config <- readConfig configFile exportCode - importProject config adaptDir metaParseShallow metaParse hskContents -mainInterface (("internal", [adaptDir]) : ("export", [exportVar]) : ("try-import", [tryImportVar]) : ("only-types", [onlyTypesVar]) : ("base-path-abs", basePathAbs) : ("ignore-not-in-scope", [ignoreNotInScopeVar]) : ("abstract-mutual-data-params", [absMutParamsVar]) : ("dump-output", []) : ("meta-parse-shallow", [metaParseShallowVar]) : ("meta-parse-load", metaParseLoad) : ("meta-parse-imports", metaParseImports) : ("meta-parse-code", metaParseCode) : ("hsk-name", hskName) : ("hsk-contents", hskContents) : ("files", srcs) : []) = do - tryImport <- readBool tryImportVar - onlyTypes <- readBool onlyTypesVar - ignoreNotInScope <- readBool ignoreNotInScopeVar - absMutParams <- readBool absMutParamsVar - metaParseShallow <- readBool metaParseShallowVar - mainInterfaceDump exportVar srcs tryImport onlyTypes (case basePathAbs of [] -> Nothing ; [x] -> Just (x)) ignoreNotInScope absMutParams adaptDir metaParseShallow (case (metaParseLoad, metaParseImports, metaParseCode, hskName) of ([], [], [], []) -> Nothing ; (l, i, [c], [n]) -> Just (l, i, c, n)) hskContents -mainInterface (("internal", [adaptDir]) : ("export", [exportVar]) : ("files", srcs @ [_]) : []) = mainInterfaceDump exportVar srcs tryImport onlyTypes basePathAbs ignoreNotInScope absMutParams adaptDir metaParseShallow metaParse hskContents -mainInterface (("internal", [adaptDir]) : ("export", [exportVar]) : ("files", srcs_dst @ (_ : _ : _)) : []) = do - exportCode <- readBool exportVar - importFiles (init srcs_dst) (Just (last srcs_dst)) exportCode tryImport onlyTypes basePathAbs ignoreNotInScope absMutParams adaptDir metaParseShallow metaParse hskContents - -mainInterface (("internal", arg) : args) = do - hPutStrLn stderr "Error calling internal haskabelle binary. Wrong parameters:" - hPutStrLn stderr (" " ++ show arg ++ " " ++ show args) - exitWith (ExitFailure 2) - -mainInterface (("version", _) : _) = do - putStrLn (version ++ ".") - -mainInterface _ = do - hPutStrLn stderr "Do not invoke linked Haskabelle binary directly" - hPutStrLn stderr " -- invoke it as described in the Haskabelle manual." - hPutStrLn stderr "" - hPutStrLn stderr "Have a nice day!" - hPutStrLn stderr "" - exitWith (ExitFailure 2) - -mainInterfaceDump exportVar srcs tryImport onlyTypes basePathAbs ignoreNotInScope absMutParams adaptDir metaParseShallow metaParse hskContents = do - exportCode <- readBool exportVar - importFiles srcs Nothing exportCode tryImport onlyTypes basePathAbs ignoreNotInScope absMutParams adaptDir metaParseShallow metaParse hskContents - -main :: IO () -main = getArgs >>= mapM (return . \s -> case s of '-' : '-' : s -> Left s ; s -> Right s) - >>= (\l -> - let isLeft = either (\_ -> True) (\_ -> False) - isRight = either (\_ -> False) (\_ -> True) - in l - & List.groupBy (\a1 a2 -> isRight a1 && isRight a2) - & map (\t -> case t of [Left t] -> Left t ; l -> Right (map (\(Right e) -> e) l)) - & List.groupBy (\a1 a2 -> isLeft a1 && isRight a2) - & map (\l -> case l of [Left t] -> (t, []) - [Left t0, Right t1] -> (t0, t1)) - & return) - >>= mainInterface diff --git a/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/README b/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/README deleted file mode 100644 index 973dc6c1d4543bf7d5fb8f9643e1c7d21457b68b..0000000000000000000000000000000000000000 --- a/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/README +++ /dev/null @@ -1,29 +0,0 @@ -This is Haskabelle, an importer from Haskell source files -to Isabelle/HOL Isar theories. - -An overview how to use it can be found in the manual - - doc/haskabelle.pdf - -If this is not present, you have to build it first; for this you need -a source (!) distribution of Isabelle2009-2, as available from - - http://isabelle.in.tum.de/repos/isabelle/rev/!!!FIXME!!! - -See further - - http://isabelle.in.tum.de/ - -for general hints on Isabelle2009-2. - -Then, invoke - - admin/builddoc - -By default, this uses the Isabelle version accessible on your PATH. -Set shell variable ISABELLE_TOOL explicitly if this does not use -the desired Isabelle version. - -Sources of Haskabelle itself are available via mercurial: - - https://isabelle.in.tum.de/repos/haskabelle diff --git a/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/admin/builddoc b/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/admin/builddoc deleted file mode 100755 index 020143f65ba072421e212d2236c1c3d958b8ed5e..0000000000000000000000000000000000000000 --- a/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/admin/builddoc +++ /dev/null @@ -1,46 +0,0 @@ -#!/bin/bash -# -# Author: Florian Haftmann, TU Muenchen -# -# Building the Haskabelle documentation -# -# Must be run in an isabelle environment (e.g. via "isabelle env") - -## environment - -PRG="$(basename "$0")" -HASKABELLE_HOME="$(cd "$(dirname "$0")"; cd "$(pwd -P)"; cd ..; pwd)" - -## diagnostics - -function fail() -{ - echo "$1" >&2 - exit 2 -} - -## building - -FORMATS="false dvi pdf" - -OUTPUT="$ISABELLE_TMP_PREFIX$$" -mkdir -p "$OUTPUT" || fail "Bad directory: \"$OUTPUT\"" - -RC=0 -for FORMAT in $FORMATS -do - if [ "$RC" = 0 ]; then - $ISABELLE_TOOL build -D "$HASKABELLE_HOME/doc-src" -c \ - -o browser_info=false -o "document=$FORMAT" \ - -o "document_output=$OUTPUT" - RC=$? - fi -done - -if [ "$RC" = 0 ]; then - cp -f "$OUTPUT"/*.dvi "$OUTPUT"/*.pdf "$HASKABELLE_HOME/doc/" -fi - -rm -r "$OUTPUT" - -[ $RC -eq 0 ] || fail "building documentation sources failed" diff --git a/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/admin/config b/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/admin/config deleted file mode 100644 index 5af116b70faa58797c8903c7e29b59c457b9c11e..0000000000000000000000000000000000000000 --- a/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/admin/config +++ /dev/null @@ -1,16 +0,0 @@ -#!/bin/bash -# -# Author: Florian Haftmann, TU Muenchen -# -# Configuration for automatic Haskabelle test. - -ISABELLE_DOC_SRC=/home/isatest/hg-isabelle/doc-src -ISABELLE_HOME=/home/isatest/isadist/Isabelle -ISABELLE_PROCESS="$ISABELLE_HOME/bin/isabelle-process" -ISABELLE_TOOL="$ISABELLE_HOME/bin/isabelle" -ISABELLE_GHC=/usr/local/ldist/bin/ghc -SHORT=at-poly - -TEST_HOME=/home/isatest - -NOTIFY='kleing@cse.unsw.edu.au noschinl@in.tum.de' diff --git a/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/admin/haskabelle b/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/admin/haskabelle deleted file mode 100755 index 08be0780c2bd4cb6915a23f6ba159ee514be7d16..0000000000000000000000000000000000000000 --- a/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/admin/haskabelle +++ /dev/null @@ -1,11 +0,0 @@ -#!/bin/bash -# -# Run haskabelle, without being registered as an component. -# Give this script as a parameter to "isabelle env". - -HASKABELLE_HOME="$(cd "$(dirname "$0")"; cd "$(pwd -P)"; cd ..; pwd)" -export HASKABELLE_HOME -HASKABELLE_HOME_USER="$ISABELLE_HOME_USER/Haskabelle" -export HASKABELLE_HOME_USER - -"$HASKABELLE_HOME/lib/Tools/haskabelle" $@ diff --git a/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/admin/mail-attach b/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/admin/mail-attach deleted file mode 100755 index 1ec164ebac156435811f363f52ab57fc94281480..0000000000000000000000000000000000000000 --- a/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/admin/mail-attach +++ /dev/null @@ -1,103 +0,0 @@ -#!/usr/bin/env bash -# -# Author: Gerwin Klein, TU Muenchen -# -# Send email with text attachments. -# (works for "mail" command of SunOS 5.8, and sendmail on SuSE) -# - -PRG="$(basename "$0")" - -MIME_BOUNDARY="==PM_=_37427935" - -function usage() -{ - echo - echo "Usage: $PRG subject recipient <body> [<attachments>]" - echo - echo " Send email with text attachments. <body> is a file." - echo - exit 1 -} - -function fail() -{ - echo "$1" >&2 - exit 2 -} - -# -# print_attachment <file> -# -# print mime "encoded" <file> to stdout (text/plain, 8bit) -# -function print_attachment() -{ - local FILE=$1 - local NAME=${FILE##*/} - - cat <<EOF ---$MIME_BOUNDARY -Content-Type: text/plain -Content-Transfer-Encoding: 8bit -Content-Disposition: attachment; filename="$NAME" - -EOF - cat $FILE - echo -} - - -# -# print_body subject <message-file> [<attachments>] -# -# prints mime "encoded" message with text attachments to stdout -# -function print_body() -{ - local SUBJECT=$1 - local BODY=$2 - shift 2 - - cat <<EOF -Subject: $SUBJECT -Mime-Version: 1.0 -Content-Type: multipart/mixed; boundary="$MIME_BOUNDARY" - ---$MIME_BOUNDARY -Content-Type: text/plain -Content-Transfer-Encoding: 8bit - -EOF - cat $BODY - echo - - for a in $@; do print_attachment $a; done - - echo "--$MIME_BOUNDARY--" - echo -} - -## main - -# argument checking - -[ "$1" = "-?" ] && usage -[ "$#" -lt "3" ] && usage - -SUBJECT="$1" -TO="$2" -BODY="$3" - -shift 3 - -[ -r "$BODY" ] || fail "could not read $BODY" - -case `uname -s` in - SunOs) - print_body "$SUBJECT" "$BODY" $@ | mail -t "$TO" - ;; - Linux) - print_body "$SUBJECT" "$BODY" $@ | /usr/sbin/sendmail "$TO" - ;; -esac diff --git a/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/admin/makedist b/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/admin/makedist deleted file mode 100755 index a911fffbd786fb384b7295c37d2b9cc6258d29d3..0000000000000000000000000000000000000000 --- a/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/admin/makedist +++ /dev/null @@ -1,106 +0,0 @@ -#!/bin/bash -# -# Author: Florian Haftmann, TU Muenchen -# -# Building a Haskabelle distribution from repository. -# -# Must be run in an isabelle environment (e.g. via "isabelle env") - -## diagnostics - -function fail() -{ - echo "$1" >&2 - exit 2 -} - -## environment - -HASKABELLE_HOME="$(cd "$(dirname "$0")"; cd "$(pwd -P)"; cd ..; pwd)" -export HASKABELLE_HOME - -if [ -z "$HG" ] -then - HG=hg -fi -if type -p $HG > /dev/zero -then - HG=$(type -p $HG) -else - fail "Mercurial not found" -fi - -if [ -z $REPOSITORY ] -then - REPOSITORY="file://$("$HG" root)" -fi - -if [ "$1" == "--regression" ] -then - REGRESSION=1 - shift -else - REGRESSION= -fi - -if [ -z "$1" ] -then - REVISION=tip - VERSION="" - ARCHIVE="Haskabelle-$("$HG" tip --template '{date|shortdate}')" -else - REVISION="$1" - VERSION="$REVISION" - ARCHIVE="$REVISION" -fi - -DIST_HOME="${DIST_HOME:-$HOME/tmp/haskabelle-dist}" -mkdir -p "$DIST_HOME" || fail "Could not allocate directory $DIST_HOME" - -## check out - -cd "$DIST_HOME" -mkdir "$ARCHIVE" || fail "Directory $ARCHIVE already exists (in $(pwd))" -cd "$ARCHIVE" -"$HG" -R "$REPOSITORY" archive -t files -r "$REVISION" . || fail "Could not check out source files" - -## remove junk - -rm README -rm .hgignore -rm .hgtags -rm .hg_archival.txt -rm $(find ex/src_hs -name "*.disabled") - -## brand version - -if [ -n "$VERSION" ] -then - perl -i -pe 's/"Haskabelle \(repository snapshot\)"/"'$VERSION'"/g' Importer/Version.hs -fi - -## building generated files - -admin/builddoc > /dev/null || fail "Could not build documentation" - -## include manual - -mv -f doc-src/Haskabelle/haskabelle.pdf doc/haskabelle.pdf -rm -rf doc-src -rm -f lib/texinputs - -## regression, if desired - -if [ "$REGRESSION" ] -then - lib/regression || fail "Could not carry out regression test" -fi - -## remove admin, build - -rm -rf admin build - -## dist bundle - -cd .. -tar -czvf "$ARCHIVE.tar.gz" "$ARCHIVE" || fail "Could not build archive" diff --git a/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/admin/mira.py b/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/admin/mira.py deleted file mode 100644 index 8f298e34131e82be4126365460f251d76f7c67b5..0000000000000000000000000000000000000000 --- a/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/admin/mira.py +++ /dev/null @@ -1,28 +0,0 @@ -""" - Test configuration descriptions for mira. -""" - -import os -from os import path - -from configurations import Isabelle as isabelle - - -@configuration(repos = [Haskabelle, Isabelle], deps = [(isabelle.HOL, [1])]) -def Haskabelle(env, case, paths, dep_paths, playground): - - """Testing integration of Haskabelle with Isabelle""" - - (loc_haskabelle, loc_isabelle) = paths - (dep_isabelle,) = dep_paths - isabelle.prepare_isabelle_repository(loc_isabelle, env.settings.contrib, dep_isabelle) - os.chdir(loc_haskabelle) - - (return_code, log) = env.run_process('admin/makedist', '--regression', - ISABELLE_HOME = loc_isabelle, - ISABELLE_DOC_SRC = path.join(loc_isabelle, 'doc-src'), - ISABELLE_PROCESS = path.join(loc_isabelle, 'bin', 'isabelle-process'), - ISABELLE_TOOL = path.join(loc_isabelle, 'bin', 'isabelle'), - DIST_HOME = playground) - - return (return_code == 0, isabelle.extract_isabelle_run_summary(log), {}, {'log': log}, None) diff --git a/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/admin/regression_isatest b/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/admin/regression_isatest deleted file mode 100755 index 9390cf085e5f39f3455cbea0e42017ac63dc370e..0000000000000000000000000000000000000000 --- a/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/admin/regression_isatest +++ /dev/null @@ -1,71 +0,0 @@ -#!/bin/bash -# -# Author: Florian Haftmann, TU Muenchen -# -# Run regression with logging and mail failures -# Supposed to be run in isatest environment - -## environment - -HASKABELLE_HOME="$(cd "$(dirname "$0")"; cd "$(pwd -P)"; cd ..; pwd)" -cd "$HASKABELLE_HOME" - -MAIL=admin/mail-attach - -. admin/config -export ISABELLE_TOOL -export ISABELLE_PROCESS -export ISABELLE_DOC_SRC -export ISABELLE_GHC - -ERRORDIR="$TEST_HOME/var" -RUNNING="$TEST_HOME/var/running" - -## log - -mkdir -p log -LOG=log/haskabelle-$(date +'%Y-%m-%d_%H:%M:%S').log - -## selecting isatest Isabelle settings - -SETTINGS=~/settings/$SHORT -cat $SETTINGS >> $ISABELLE_HOME/etc/settings - -## check whether Isabelle works - -if [ -f "$RUNNING/$SHORT.running" -o -e $ERRORDIR/$SHORT*.log ]; then - echo "Skipped test. Isabelle devel version broken." > $LOG - exit 1 -fi - -## clean regression dir - -export DIST_HOME="${DIST_HOME:-$HOME/tmp/haskabelle-dist}" -rm -rf "$DIST_HOME" - -## run regression - -admin/makedist --regression > "$LOG" 2>&1 -EXIT=$? -echo "Exited with $EXIT." >> "$LOG" - -if [ $EXIT -ne 0 ] -then - - MAILTEXT=/tmp/haskabelle-$(date +'%Y-%m-%d_%H:%M:%S').mail - - cat > "$MAILTEXT" <<EOF -Haskabelle test failed. See attached log. - -Have a nice day, - isatest - -EOF - - for RECEIVER in $NOTIFY - do - "$MAIL" 'test failed (Haskabelle)' "$RECEIVER" "$MAILTEXT" "$LOG" - done - rm "$MAILTEXT" - -fi diff --git a/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/default/Prelude.thy b/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/default/Prelude.thy deleted file mode 100644 index 3c90f122e03298e97bc150407c1093e357bb9896..0000000000000000000000000000000000000000 --- a/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/default/Prelude.thy +++ /dev/null @@ -1,199 +0,0 @@ -(* Author: Tobias Rittweiler, Florian Haftmann, TU Muenchen -*) - -chapter {* Base environment for theories generated by the Haskell importer. *} - -theory Prelude -imports Main -begin - -text {* - You can place here what you want. However, in practice it - is recommended to restrict additions here only to ingredients - of the Haskell Prelude; further Haskell library modules - should be obtained in source and just imported, probably - with prior modifications. -*} - -subsection {* Equality *} - -class eq = - fixes eq :: "'a \<Rightarrow> 'a \<Rightarrow> bool" - fixes not_eq :: "'a \<Rightarrow> 'a \<Rightarrow> bool" - assumes not_eq [simp]: "not_eq x y \<longleftrightarrow> \<not> eq x y" - -instantiation bool :: eq -begin - -definition - "eq p q \<longleftrightarrow> (p \<longleftrightarrow> q)" - -definition - "not_eq p q \<longleftrightarrow> \<not> (p \<longleftrightarrow> q)" - -instance proof -qed (simp_all add: eq_bool_def not_eq_bool_def) - -end - -instantiation unit :: eq -begin - -definition - "eq (u::unit) v \<longleftrightarrow> True" - -definition - "not_eq (u::unit) v \<longleftrightarrow> False" - -instance proof -qed (simp_all add: eq_unit_def not_eq_unit_def) - -end - -instantiation prod :: (eq, eq) eq -begin - -definition - "eq x y \<longleftrightarrow> (x :: _ * _) = y" - -definition - "not_eq x y \<longleftrightarrow> (x :: _ * _) \<noteq> y" - -instance proof -qed (simp_all add: eq_prod_def not_eq_prod_def) - -end - -instantiation list :: (eq) eq -begin - -definition - "eq x y \<longleftrightarrow> (x :: _ list) = y" - -definition - "not_eq x y \<longleftrightarrow> (x :: _ list) \<noteq> y" - -instance proof -qed (simp_all add: eq_list_def not_eq_list_def) - -end - -instantiation option :: (eq) eq -begin - -definition - "eq x y \<longleftrightarrow> (x :: _ option) = y" - -definition - "not_eq x y \<longleftrightarrow> (x :: _ option) \<noteq> y" - -instance proof -qed (simp_all add: eq_option_def not_eq_option_def) - -end - -instantiation int :: eq -begin - -definition - "eq x y \<longleftrightarrow> x = (y::int)" - -definition - "not_eq x y \<longleftrightarrow> x \<noteq> (y::int)" - -instance proof -qed (simp_all add: eq_int_def not_eq_int_def) - -end - - -subsection {* Fundamental prelude ingredients *} - -axiomatization error :: "string \<Rightarrow> 'a" - -abbreviation (input) rapp :: "('a \<Rightarrow> 'b) \<Rightarrow> 'a \<Rightarrow> 'b" (infixr "$" 60) where - "f $ x \<equiv> f x" - -abbreviation (input) const :: "'a \<Rightarrow> 'b \<Rightarrow> 'b" where - "const x y \<equiv> y" - - -subsection {* Options *} - -definition the_default :: "'a \<Rightarrow> 'a option \<Rightarrow> 'a" where - "the_default x y = (case y of Some z \<Rightarrow> z | None \<Rightarrow> x)" - -abbreviation (input) maybe :: "'b \<Rightarrow> ('a \<Rightarrow> 'b) \<Rightarrow> 'a option \<Rightarrow> 'b" where - "maybe x f y \<equiv> the_default x (map_option f y)" - - -subsection {* Either *} - -datatype ('a, 'b) Either = Left 'a | Right 'b - -subsection {* Lists *} - -abbreviation (input) null :: "'a list \<Rightarrow> bool" where - "null xs \<equiv> xs = []" - -definition member :: "'a::eq \<Rightarrow> 'a list \<Rightarrow> bool" where - "member x ys \<longleftrightarrow> (\<exists>y\<in>set ys. eq x y)" - -abbreviation (input) not_member :: "'a::eq \<Rightarrow> 'a list \<Rightarrow> bool" where - "not_member x xs \<equiv> \<not> member x xs" - -definition nth :: "'a list \<Rightarrow> int \<Rightarrow> 'a" where - "nth xs k = (if k < 0 then error ''negative index'' else List.nth xs (nat k))" - -definition length :: "'a list \<Rightarrow> int" where - "length xs = int (List.length xs)" - -definition replicate :: "int \<Rightarrow> 'a \<Rightarrow> 'a list" where - "replicate k = List.replicate (nat k)" - -primrec separate :: "'a \<Rightarrow> 'a list \<Rightarrow> 'a list" where - "separate x [] = []" - | "separate x (y # ys) = (if ys = [] then [y] else y # x # separate x ys)" - - -subsection {* Counterparts for fundamental Haskell classes *} - -class ord = eq + linorder - -instance int :: ord .. - -class print = - fixes print :: "'a \<Rightarrow> string" - -instantiation list :: (print) print -begin - -definition - "print xs = ''['' @ concat (separate '', '' (map print xs)) @ '']''" - -instance .. - -end - -class num = comm_ring_1 + abs + sgn + eq + print - -instance int :: num .. - -subsection {* Regression Testing *} - -ML\<open> -structure Haskabelle = struct -fun export dst thy = - let - val thy_name = Context.theory_name thy - val ctxt = Proof_Context.init_global thy - in Code_Target.export_code - ctxt - false - (Code_Thingol.read_const_exprs ctxt [thy_name ^ "._"]) - [(((("Haskell", thy_name), SOME dst)), [])] - end -end -\<close> - -end diff --git a/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/default/README b/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/default/README deleted file mode 100644 index 063ad4535d54602ea60c391aad72dec5b78fdb58..0000000000000000000000000000000000000000 --- a/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/default/README +++ /dev/null @@ -1,3 +0,0 @@ -All files in this directory are generated and will be replaced -everytime the default adaptation table is rebuild (e.g. by -"isabelle haskabelle -r"). diff --git a/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/default/adapt.txt b/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/default/adapt.txt deleted file mode 100644 index 46d56fc48e58a7e44a303bf8bdc8ee2a10b1a205..0000000000000000000000000000000000000000 --- a/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/default/adapt.txt +++ /dev/null @@ -1,97 +0,0 @@ -(* Author: Tobias C. Rittweiler and Florian Haftmann, TU Muenchen - -Default adaption table. -*) - -classes - "Prelude.Eq" "Prelude.eq" - parameter "Prelude.(==)" "a -> a -> bool" - parameter "Prelude.(/=)" "a -> a -> bool" - "Prelude.Ord" "Prelude.ord" - parameter "Prelude.(<=)" "a -> a -> bool" - parameter "Prelude.(<)" "a -> a -> bool" - "Prelude.Show" "Prelude.print" - parameter "Prelude.show" "a -> String" - "Prelude.Num" "Prelude.num" - -types - "Prelude.Bool" "bool" - "Prelude.UnitTyCon" "unit" - "Prelude.PairTyCon" "prod" - "Prelude.ListTyCon" "list" - "Prelude.Maybe" "option" - "Prelude.Char" "char" - "Prelude.String" "string" - "Prelude.Int" "int" - "Prelude.Integer" "int" - "Prelude.Either" "Prelude.Either" - -consts - "Prelude.True" "True" - "Prelude.False" "False" - "Prelude.not" "Not" - "Prelude.(&&)" "conj" - "Prelude.(||)" "disj" - - "Prelude._|_" "HOL.undefined" - "Prelude.error" "Prelude.error" - - "Prelude.($)" "Prelude.rapp" - "Prelude.const" "Prelude.const" - "Prelude.id" "Fun.id" - "Prelude.(.)" "Fun.comp" - "Prelude.curry" "curry" - "Prelude.uncurry" "case_prod" - - "Prelude.(==)" "Prelude.eq" - "Prelude.(/=)" "Prelude.not_eq" - - "Prelude.(())" "Unity" - "Prelude.PairDataCon" "Pair" - "Prelude.fst" "fst" - "Prelude.snd" "snd" - - "Prelude.([])" "List.Nil" - "Prelude.(:)" "List.Cons" - "Prelude.null" "Prelude.null" - "Prelude.head" "List.hd" - "Prelude.tail" "List.tl" - "Prelude.map" "List.map" - "Prelude.filter" "List.filter" - "Prelude.(++)" "List.append" - "Prelude.concat" "List.concat" - "Prelude.reverse" "List.rev" - "Prelude.elem" "Prelude.member" - "Prelude.notElem" "Prelude.not_member" - "Prelude.replicate" "Prelude.replicate" - "Prelude.(!!)" "Prelude.nth" - "Prelude.length" "Prelude.length" - "Prelude.any" "List.list_ex" - "Prelude.all" "List.list_all" - "Prelude.zip" "List.zip" - "Prelude.foldl" "List.foldl" - "Prelude.foldr" "List.foldr" - - "Prelude.Nothing" "Option.None" - "Prelude.Just" "Option.Some" - "Prelude.maybe" "Prelude.maybe" - - "Prelude.Left" "Prelude.Left" - "Prelude.Right" "Prelude.Right" - - "Prelude.show" "Prelude.print" - - "Prelude.(+)" "Groups.plus" - "Prelude.(*)" "Groups.times" - "Prelude.negate" "Groups.uminus" - "Prelude.(-)" "Groups.minus" - "Prelude.(<)" "Orderings.less" - "Prelude.(<=)" "Orderings.less_eq" - "Prelude.(>)" "Orderings.greater" - "Prelude.(>=)" "Orderings.greater_eq" - "Prelude.abs" "Groups.abs" - "Prelude.sgn" "Groups.sgn" - "Prelude.fromInteger" "Int.of_int" - "Prelude.divMod" "semiring_numeral_div_int_inst.divmod_int" - "Prelude.min" "Orderings.min" - "Prelude.max" "Orderings.max" diff --git a/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/doc-src/Haskabelle/Haskabelle.thy b/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/doc-src/Haskabelle/Haskabelle.thy deleted file mode 100644 index 53d5823dfdbd957f9f70be175cab44e7c185b7cc..0000000000000000000000000000000000000000 --- a/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/doc-src/Haskabelle/Haskabelle.thy +++ /dev/null @@ -1,669 +0,0 @@ -theory Haskabelle -imports Main Setup -begin - -chapter {* Haskabelle *} - -section {* Introduction *} - -subsection {* What is Haskabelle? *} - -text {* - @{text Haskabelle} is a converter from @{text Haskell} source - files to @{text "Isabelle/HOL"} \cite{isa-tutorial} theories - implemented in @{text Haskell} itself. -*} - -subsection {* Motivation *} - -text {* - - @{text "Isabelle/HOL"} can be regarded as a combination of a - functional programming language and logic. Just like functional - programming languages, it has its foundation in the typed lambda - calculus, but is additionally crafted to allow the user to write - arbitrary mathematical theorems in a structured and convenient way. - - @{text Haskell} is a functional programming language that has - succeeded in getting more and more momentum, not only in academia - but increasingly also in industry. It is used for all kinds of - programming tasks despite (or, perhaps, rather because) of its - pureness, that is its complete lack of side-effects. - - This pureness makes @{text Haskell} relate to @{text "Isabelle/HOL"} - more closely than other functional languages. In fact, @{text - "Isabelle/HOL"} can be considered a subset of @{text Haskell}. - - Writing a converter from the convertible subset of @{text Haskell} - to @{text "Isabelle/HOL"} seems thus like the obvious next step to - facilitate machine-aided verification of @{text Haskell} - programs. @{text Haskabelle} is exactly such a converter. - -*} - -subsection {* Implementation *} - -text {* - - There is one major design decision which users have to keep in - mind. @{text Haskabelle} works on the Abstract Syntax Tree (AST) - representation of @{text Haskell} programs exclusively. As a result, - it is very restricted on what it knows about the validity of the - program; for example, it does not perform type inference. - - In fact, input source files are not checked at all beyond syntactic - validity that is performed by the parser. Users are supposed to - first run their @{text Haskell} implementation of choice on the - files to catch programming mistakes. In practice, this is not an - impediment as it matches the putative workflow: @{text Haskabelle} - is supposed to help the verification of already-written, or - just-written programs. - - Also, no proof checking is involved; that work is delegated to - @{text Isabelle}. This means that only because the conversion - seemingly succeeded, does not necessarily mean that @{text Isabelle} - won't complain. A common example is that a @{text Haskell} function - could be syntactically transformed to a corresponding @{text - "Isabelle/HOL"} function, but @{text Isabelle} will refuse to accept - it as it's not able to determine termination by itself. - -*} - -text {* - - @{text Haskabelle} performs its work in the following 5 phases. - -*} - - -subsubsection {* Parsing *} - -text {* - - Each @{text Haskell} input file is parsed into an @{text Haskell} - Abstract Syntax Tree representation. Additionally, module resolution - is performed, i.e. the source files of the modules that the input - files depend on are also read and parsed. So the actual output of - this phase is a forest of @{text Haskell} ASTs. - -*} - - -subsubsection {* Preprocessing *} - -text {* - - Each @{text Haskell} AST is normalised to a semantically equivalent - but canonicalised form to simplify the subsequent converting - phase. At the moment, the following transformations are performed: - - \begin{itemize} - - \item{ identifiers that would clash with reserved keywords or - constants in @{text "Isabelle/HOL"} are renamed. } - - \item{ pattern guards are transformed into nested \code{if} - expressions. } - - \item{ \code{where} clauses are transformed into \code{let} - expressions. } - - \item{ local function definitions are made global by renaming then - uniquely. } - - \end{itemize} - -*} - - -subsubsection {* Converting *} - -text {* - - After preprocessing, each @{text Haskell} AST consists entirely of - toplevel definitions. Before the actual conversion, a dependency - graph is generated for these toplevel definitions for two purposes: - first to ensure that definitions appear textually before their uses; - second to group mutually-recursive function together. Both points - are necessary to comply with requirements imposed by @{text - "Isabelle/HOL"}. - -*} - -text {* - - Furthermore, a global environment is built in this phase that - contains information about all identifiers, e.g. what they - represent, in which module they belong to, whether they're exported, - etc. - -*} - - -text {* - - What @{text Haskell} language features are translated to which - @{text "Isabelle/HOL"} constructs, is explained in section - \ref{sec:Haskabelle-what-is-supported}. - -*} - -text {* - - The output of this phase is a forest of @{text "Isabelle/HOL"} ASTs. - -*} - - -subsubsection {* Adapting *} - -text {* - - While the previous phase converted the @{text Haskell} ASTs into - their syntactically equivalent @{text "Isabelle/HOL"} ASTs, it has - not attempted to map functions, operators, or algebraic data types, - that preexist in Haskell, to their pedants in @{text - "Isabelle/HOL"}. Such a mapping (or adaption) is performed in this - phase. - -*} - - -subsubsection {* Printing *} - -text {* - - The @{text "Isabelle/HOL"} ASTs are pretty-printed into an human-readable format so - users can subsequently work with the resulting definitions, supply additional - theorems, and verify their work. - -*} - -section {* Setup and usage *} - -subsection {* Prerequisites *} - -text {* - - We assume that the reader of this tutorial has some basic experience - with @{text UNIX}, @{text Haskell}, and @{text "Isabelle/HOL"}. - - @{text Haskabelle} is shipped in source code; this means you have to - provide a working @{text Haskell} environment yourself, including - some libraries. In order to make use of the theories generated by - @{text Haskabelle}, you will also need an @{text Isabelle} release. - -*} - -subsubsection {* @{text Haskell} environment *} - -text {* - - The given version numbers just indicate which constellation has been - tested -- others might work, too. - - \noindent First, the @{text Haskell} suite itself: - - \begin{description} - - \item[GHC] Glasgow Haskell Compiler \url{http://www.haskell.org/ghc/} - (version 7.6.3) - - \end{description} - - \noindent The following libraries are required: - - \begin{description} - - \item[mtl] Monad transformer library. \\ - \url{http://hackage.haskell.org/cgi-bin/hackage-scripts/package/mtl-2.1.1} - - \item[xml] A simple XML library. \\ - \url{http://hackage.haskell.org/cgi-bin/hackage-scripts/package/xml-1.3.12} - - \item[uniplate] Uniform type generic traversals. \\ - \url{http://hackage.haskell.org/cgi-bin/hackage-scripts/package/uniplate-1.6.7} - - \item[cpphs] A liberalised re-implementation of cpp, the C pre-processor. \\ - \url{http://hackage.haskell.org/cgi-bin/hackage-scripts/package/cpphs-1.13.3} - - \item[Happy] Happy is a parser generator for Haskell. \\ - \url{http://hackage.haskell.org/cgi-bin/hackage-scripts/package/happy-1.18.9} - - The installation process provides a binary \shell{happy} - which must be accessible on your \shell{PATH} to - proceed! - - \item[haskell-src-exts] Manipulating Haskell source: abstract syntax, lexer, parser, and pretty-printer. \\ - \url{http://hackage.haskell.org/cgi-bin/hackage-scripts/package/haskell-src-exts-0.4.8} - (newer versions won't work) - - \end{description} -*} - -subsubsection {* @{text Isabelle} release *} - -text {* - - The latest @{text Isabelle} release is available from - \url{http://isabelle.in.tum.de/download.html}. - -*} - -subsubsection {* @{text Haskabelle} distribution *} - -text {* - - The current @{text Haskabelle} release as available from - \url{http://isabelle.in.tum.de/haskabelle.html} is tailored to the - latest @{text Isabelle} release. - -*} - - -subsection {* Basic usage *} - -subsubsection {* Understanding the distribution structure *} - -text {* - - Throughout this manual, qualified paths of executables on the shell - prompt are relative to the root directory of the @{text Haskabelle} - distribution. - - Therein, among others, the following directories can be found: - -*} - -text %quote {* - \begin{description} - - \item [\shell{doc/}] Documentation - - \item [\shell{default/}] Default adaption files (see - \secref{sec:adaption}) - - \item [\shell{ex/}] Examples (see \secref{sec:examples}) - - \end{description} -*} - -subsubsection {* Installing and configuring Haskabelle *} - -text {* - If you are using the Haskabelle component shipping with Isabelle, - you only need to make sure that \shell{ISABELLE_GHC} is set in - your Isabelle settings file and points to your GHC binary. Also - the right GHC libraries must be installed. -*} - -subsubsection {* Converting theories *} - -text {* - @{text Haskabelle} is invoked using the following command line - (\shell{isabelle} is the binary of your isabelle distribution): -*} - -text %quote {* - \shell{isabelle haskabelle <SRC1> .. <SRCn> <DST>} -*} - -text {* - - \noindent where \shell{<SRC1>} \ldots \shell{<SRCn>} is a list of - @{text Haskell} source files to convert and \shell{<DST>} is a - directory to put the generated @{text "Isabelle/HOL"} theory files - inside. - - The @{text Prelude} theory the generated theory files depend on can - be found in \shell{default/Prelude.thy}. - -*} - - - -section {* A bluffer's glance at Haskabelle \label{sec:Haskabelle-what-is-supported}*} - -text {* - - In this section we want to provide a few examples to give the reader - an impression of @{text Haskabelle}'s capabilities. - -*} - -text {* - - The following @{text Haskell} code represents a very simple - interpreter: - -*} - -text %quotetypewriter {* -module Example where -\\ -\\ -evalExp :: Exp -> Int - -evalExp (Plus e1 e2) ~= evalExp e1 + evalExp e2 \\ -evalExp (Times e1 e2) = evalExp e1 * evalExp e2 \\ -evalExp (Cond b e1 e2) \\ -\hspace*{0pt} ~~| evalBexp b = evalExp e1 \\ -\hspace*{0pt} ~~| otherwise ~= evalExp e2 \\ -evalExp (Val i) = i -\\ -\\ -evalBexp :: Bexp -> Bool - -evalBexp (Equal e1 e2) ~~= evalExp e1 == evalExp e2\\ -evalBexp (Greater e1 e2) = evalExp e1 > evalExp e2 -\\ -\\ -data Exp ~= Plus Exp Exp\\ -\hspace*{0pt} ~~~~~~~~~| Times Exp Exp\\ -\hspace*{0pt} ~~~~~~~~~| Cond Bexp Exp Exp\\ -\hspace*{0pt} ~~~~~~~~~| Val Int\\ - -data Bexp = Equal Exp Exp\\ -\hspace*{0pt} ~~~~~~~~~| Greater Exp Exp - -*} - -text {* - - \noindent @{text Haskabelle} will transform the above into the following: - -*} - -text %quotetypewriter {* -theory Example\\ -imports Prelude\\ -begin\\ -\\ -datatype Exp = Plus Exp Exp\\ -\hspace*{0pt} ~~~~~~~~~| Times Exp Exp\\ -\hspace*{0pt} ~~~~~~~~~| Cond Bexp Exp Exp\\ -\hspace*{0pt} ~~~~~~~~~| Val int\\ -and Bexp = Equal Exp Exp\\ -\hspace*{0pt} ~~~~~~~~~| Greater Exp Exp\\ -\\ -\\ -\\ -\\ -\\ -fun evalExp ~:: "Exp => int" and\\ -\hspace*{0pt} ~~~evalBexp :: "Bexp => bool"\\ -where\\ -\hspace*{0pt} ~"evalExp (Plus e1 e2) = (evalExp e1 + evalExp e2)"\\ -| "evalExp (Times e1 e2) = (evalExp e1 * evalExp e2)"\\ -| "evalExp (Cond b e1 e2) = (if evalBexp b then evalExp e1\\ -\hspace*{0pt} ~~~~~~~~~~~~~~~~~~~~~~~~~~~~else evalExp e2)"\\ -| "evalExp (Val i) = i"\\ -| "evalBexp (Equal e1 e2) = heq (evalExp e1) (evalExp e2)"\\ -| "evalBexp (Greater e1 e2) = (evalExp e1 > evalExp e2)"\\ -\\ -end -*} - -text {* - - \noindent We can note a couple of things at this point: - - \begin{itemize} - - \item{ The data type definitions have been moved before their uses. - } - - \item{ The two data type definitions have been chained together by - an explicit {\tt and} keyword. Likewise the function - definitions have been grouped together. This stems from the mutual - recursion inherent in the definitions. } - - \item We use @{text Isabelle}'s function package. - % (FIXME: Add reference.) - - \item{ The pattern guards in {\tt evalExp} have been - transformed to an {\tt if} expression. } - - \item{ Preexisting @{text Haskell} functions and operators have been mapped - to @{text "Isabelle/HOL"} counterparts. } - - \item{ @{text Haskell} modules inherit from an implicit module - {\tt Prelude}; @{text Haskabelle} comes with a - {\tt Prelude.thy} which provides necessary context to - cope with some @{text Haskell} features. We can see that an import of - this the {\tt Prelude} module is explicitly added by - @{text Haskabelle}. } - - \item{ The @{text Haskell} comparison operator {\tt ==} has been - transformed to {isatypewriter heq} which is not defined by with - @{text "Isabelle/HOL"} itself but within the {\tt - Prelude.thy} file. It names both an operator and a type class - which has been constructed to match {\tt ==}, and - @{text Haskell}'s type class {\tt Eq}. } - - \end{itemize} - -*} - -text {* - - \noindent The next example illustrates a simple use of type classes. - -*} - -text %quotetypewriter {* -module Classes where - -class Monoid a where\\ -\hspace*{0pt} ~~nothing :: a\\ -\hspace*{0pt} ~~plus :: a -> a -> a -\\ -\\ -instance Monoid Integer where\\ -\hspace*{0pt} ~~nothing = 0\\ -\hspace*{0pt} ~~plus = (+) -\\ -\\ --- prevent name clash with Prelude.sum\\ -summ :: (Monoid a) => [a] -> a\\ -summ [] = nothing\\ -summ (x:xs) = plus x (summ xs) -\\ -\\ -class (Monoid a) => Group a where\\ -\hspace*{0pt} ~~inverse :: a -> a -\\ -\\ -instance Group Integer where\\ -\hspace*{0pt} ~~inverse = negate -\\ -\\ -sub :: (Group a) => a -> a -> a\\ -sub a b = plus a (inverse b) - -*} - -text {* - - @{text Haskabelle} will transform this into the following: - -*} - -text %quotetypewriter {* -theory Classes\\ -imports Nats Prelude\\ -begin -\\ -class Monoid = type +\\ -\hspace*{0pt} ~~fixes nothing :: 'a\\ -\hspace*{0pt} ~~fixes plus :: "'a => 'a => 'a" -\\ -\\ -instantiation int :: Monoid\\ -begin\\ -\hspace*{0pt} ~~definition nothing\_int :: "int"\\ -\hspace*{0pt} ~~where\\ -\hspace*{0pt} ~~~~"nothing\_int = 0" \\ -\hspace*{0pt} ~~definition plus\_int :: "int => int => int"\\ -\hspace*{0pt} ~~where\\ -\hspace*{0pt} ~~~~"plus\_int = (op +)" \\ -instance ..\\ -end -\\ -\\ -fun summ :: "('a :: Monoid) list => ('a :: Monoid)"\\ -where\\ -\hspace*{0pt} ~~"summ Nil = nothing"\\ -|~~"summ (x \# xs) = plus x (summ xs)" -\\ -\\ -class Group = Monoid +\\ -\hspace*{0pt} ~~fixes inverse :: "'a => 'a" -\\ -\\ -instantiation int :: Group\\ -begin \\ -\hspace*{0pt} ~~definition inverse\_int :: "int => int"\\ -\hspace*{0pt} ~~where\\ -\hspace*{0pt} ~~~~"inverse\_int = uminus" \\ -instance ..\\ -end -\\ -\\ -fun sub :: "('a :: Group) => ('a :: Group) => ('a :: Group)"\\ -where\\ -\hspace*{0pt} ~~"sub a b = plus a (inverse b)"\\ -\\ -end -*} - -text {* -*} - -(* FIXME: Add reference to class paper - - FIXME: Describe insertion of class annotations. - - FIXME: Explain constraints. *) - - -section {* Adaption \label{sec:adaption} *} - -subsection {* The concept *} - -text {* - - Adaption allows to identify functions, types etc. from the @{text Haskell} - source files with pre-existing counterparts in @{text - "Isabelle/HOL"} by means of two mechanisms: - - \begin{itemize} - - \item An \emph{adaption table} in a simple domain-specific - language which specifies a table between identifiers of classes, - types and functions in @{text Haskell} to their corresponding - identifiers in @{text "Isabelle/HOL"}. - - \item A prelude theory containing a @{text "Isabelle/HOL"} base - environment where @{text Haskabelle}'s output is supposed to be - run implicitly within. By extending this, it is possible to - adapt even more complex features of the @{text Haskell} - programming language. - - \end{itemize} - -*} - - -subsection {* Setting up your own adaption *} - -text {* - - @{text Haskabelle} provides some default adaptions already in - directory \shell{default}. You can setup your own adaption - according to the following steps: - -*} - -subsubsection {* Copy \shell{default} *} - -text {* - - Typically you will want to use the default adaption as a starting - point, so copy the \shell{default} directory to a directory of - your choice (which we will refer to as \shell{<ADAPT>}). - -*} - -subsubsection {* Adapt the prelude theory *} - -text {* - - If desired, adapt the prelude theory \shell{<ADAPT>/Prelude.thy}. - -*} - -subsubsection {* Edit adaption table *} - -text {* - - The adaptions themselves reside in \shell{<ADAPT>/adapt.txt} and can - be edited there. - -*} - -subsubsection {* Process adaptions *} - -text {* - - To make the adaptions accessible to @{text Haskabelle}, execute the - following: - -*} - -text %quote {* - \shell{isabelle haskabelle -r -a <ADAPT>} -*} - -text {* - - \noindent This also includes some basic consistency checking. -*} - -subsubsection {* Use this adaption during conversion *} - -text {* - - A particular adaption other than default is selected using the - \shell{-a} command line switch: - -*} - -text %quote {* - \shell{isabelle haskabelle -a <ADAPT> <SRC1> .. <SRCn> <DST>} -*} - - -section {* Examples \label{sec:examples} *} - -text {* - - Examples for @{text Haskabelle} can be found in the - \shell{ex/src\_hs} directory in the distribution. They can be - converted at a glance using the following command: - -*} - -text %quote {* - \shell{isabelle haskabelle -e} -*} - -text {* - - \noindent Each generated theory then is re-imported into @{text - Isabelle}. - -*} - -end - diff --git a/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/doc-src/Haskabelle/Setup.thy b/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/doc-src/Haskabelle/Setup.thy deleted file mode 100644 index 71fdfc0a7e24e69f720e15a9753ae13aada8f32b..0000000000000000000000000000000000000000 --- a/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/doc-src/Haskabelle/Setup.thy +++ /dev/null @@ -1,5 +0,0 @@ -theory Setup -imports Main -begin - -end diff --git a/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/doc-src/Haskabelle/document/build b/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/doc-src/Haskabelle/document/build deleted file mode 100755 index 1e6553a183dbef38776ca29ee53eddb675fcda5a..0000000000000000000000000000000000000000 --- a/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/doc-src/Haskabelle/document/build +++ /dev/null @@ -1,15 +0,0 @@ -#!/bin/bash - -set -e - -FORMAT="$1" -VARIANT="$2" - -"$ISABELLE_TOOL" logo -n isabelle_isar Isar - -cp "$ISABELLE_HOME/src/Doc/iman.sty" . -cp "$ISABELLE_HOME/src/Doc/extra.sty" . -cp "$ISABELLE_HOME/src/Doc/isar.sty" . -cp "$ISABELLE_HOME/src/Doc/manual.bib" . - -"$ISABELLE_HOME/src/Doc/prepare_document" "$FORMAT" diff --git a/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/doc-src/Haskabelle/document/root.tex b/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/doc-src/Haskabelle/document/root.tex deleted file mode 100644 index 00649097c3343a5e097760f14eb1d02b3626e110..0000000000000000000000000000000000000000 --- a/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/doc-src/Haskabelle/document/root.tex +++ /dev/null @@ -1,47 +0,0 @@ -\documentclass[12pt,a4paper,fleqn]{report} -\usepackage{latexsym,graphicx} -\usepackage[refpage]{nomencl} -\usepackage{iman,extra,isar} -\usepackage{isabelle,isabellesym} -\usepackage{style} -\usepackage{pdfsetup} - -\newcommand{\code}[1]{#1} -\newcommand{\listing}[1]{#1} - - -\hyphenation{Isabelle} -\hyphenation{Isar} -\isadroptag{theory} - -\title{\includegraphics[scale=0.5]{isabelle_isar} - \\[4ex] Haskabelle -- converting Haskell source files to Isabelle/HOL theories} -\author{\emph{Tobias Rittweiler}, \emph{Florian Haftmann}} - -\begin{document} - -\maketitle - -\begin{abstract} - This document gives an introduction to Haskabelle, an importer from - Haskell source files to Isabelle/HOL theories. -\end{abstract} - -\thispagestyle{empty}\clearpage - -\pagenumbering{roman} -\clearfirst - -\input{Haskabelle.tex} - -\begingroup -\bibliographystyle{plain} \small\raggedright\frenchspacing -\bibliography{manual} -\endgroup - -\end{document} - -%%% Local Variables: -%%% mode: latex -%%% TeX-master: t -%%% End: diff --git a/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/doc-src/Haskabelle/document/style.sty b/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/doc-src/Haskabelle/document/style.sty deleted file mode 100644 index 1482d9f033f287067f7bac1338212b1942db5f14..0000000000000000000000000000000000000000 --- a/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/doc-src/Haskabelle/document/style.sty +++ /dev/null @@ -1,61 +0,0 @@ - -%% toc -\newcommand{\tocentry}[1]{\cleardoublepage\phantomsection\addcontentsline{toc}{chapter}{#1} -\@mkboth{\MakeUppercase{#1}}{\MakeUppercase{#1}}} - -%% paragraphs -\setlength{\parindent}{1em} - -%% references -\newcommand{\secref}[1]{\S\ref{#1}} -\newcommand{\figref}[1]{figure~\ref{#1}} - -%% logical markup -\newcommand{\strong}[1]{{\bfseries {#1}}} -\newcommand{\qn}[1]{\emph{#1}} - -%% typographic conventions -\newcommand{\qt}[1]{``{#1}''} -\newcommand{\ditem}[1]{\item[\isastyletext #1]} - -%% quote environment -\isakeeptag{quote} -\renewenvironment{quote} - {\list{}{\leftmargin2em\rightmargin0pt}\parindent0pt\parskip0pt\item\relax} - {\endlist} -\renewcommand{\isatagquote}{\begin{quote}} -\renewcommand{\endisatagquote}{\end{quote}} -\newcommand{\quotebreak}{\\[1.2ex]} - -%% typewriter text -\newenvironment{typewriter}{\renewcommand{\isastyletext}{}% -\renewcommand{\isadigit}[1]{{##1}}% -\parindent0pt% -\makeatletter\isa@parindent0pt\makeatother% -\isabellestyle{tt}\isastyle% -\fontsize{9pt}{9pt}\selectfont}{} - -\isakeeptag{quotetypewriter} -\renewcommand{\isatagquotetypewriter}{\begin{quote}\begin{typewriter}} -\renewcommand{\endisatagquotetypewriter}{\end{typewriter}\end{quote}} - -%% presentation -\setcounter{secnumdepth}{2} \setcounter{tocdepth}{2} - -%% character detail -\renewcommand{\isadigit}[1]{\isamath{#1}} -\binperiod -\underscoreoff - -%% format -\pagestyle{headings} -\isabellestyle{it} - -%% conceptual markup -\newcommand{\shell}[1]{{\tt {#1}}} - - -%%% Local Variables: -%%% mode: latex -%%% TeX-master: "implementation" -%%% End: diff --git a/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/doc-src/ROOT b/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/doc-src/ROOT deleted file mode 100644 index 3a03c7ff958bfc75ca8e19c271326341e35384ac..0000000000000000000000000000000000000000 --- a/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/doc-src/ROOT +++ /dev/null @@ -1,15 +0,0 @@ -session Haskabelle (doc) in "Haskabelle" = HOL + - options [document_variants = "haskabelle"] - theories [document = false] Setup - theories Haskabelle - files - "$ISABELLE_HOME/src/Doc/prepare_document" - "$ISABELLE_HOME/src/Doc/pdfsetup.sty" - "$ISABELLE_HOME/src/Doc/iman.sty" - "$ISABELLE_HOME/src/Doc/extra.sty" - "$ISABELLE_HOME/src/Doc/isar.sty" - "$ISABELLE_HOME/src/Doc/manual.bib" - document_files - "build" - "root.tex" - "style.sty" diff --git a/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/doc/Contents b/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/doc/Contents deleted file mode 100644 index 187455ba748e51e44fa97fce406b6961d6c332bd..0000000000000000000000000000000000000000 --- a/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/doc/Contents +++ /dev/null @@ -1,2 +0,0 @@ -Haskabelle - haskabelle Haskabelle user guide diff --git a/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/etc/settings b/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/etc/settings deleted file mode 100644 index 9adc8da3f14488b3c991c63524cce18bcd354d0b..0000000000000000000000000000000000000000 --- a/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/etc/settings +++ /dev/null @@ -1,7 +0,0 @@ -# -*- shell-script -*- :mode=shellscript: - -HASKABELLE_HOME="$COMPONENT" -HASKABELLE_HOME_USER="$ISABELLE_HOME_USER/$(basename "$HASKABELLE_HOME")" - -ISABELLE_TOOLS="$ISABELLE_TOOLS:$COMPONENT/lib/Tools" -ISABELLE_DOCS="$ISABELLE_DOCS:$COMPONENT/doc" diff --git a/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/ex/StateMonads.thy b/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/ex/StateMonads.thy deleted file mode 100644 index d2d7ef676910e98abd8083b8fc1ff7336ece2ad7..0000000000000000000000000000000000000000 --- a/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/ex/StateMonads.thy +++ /dev/null @@ -1,69 +0,0 @@ -theory StateMonads -imports Main -begin - -types 'a StateM = "int => ('a * int)" - -constdefs - return :: "'a => 'a StateM" - "return a == % s. (a,s)" - - bind :: "'a StateM => ('a => 'b StateM) => 'b StateM" - (infixl ">>=" 60) - "bind f g == %s. let (r, s') = f s in g r s'" - -constdefs - get :: "int StateM" - "get == %s. (s,s)" - - put :: "int => unit StateM" - "put s == %_. ((),s)" - -nonterminals - dobinds dobind nobind - -syntax - "dobind" :: "pttrn => 'a => dobind" ("(_ <-/ _)" 10) - "" :: "dobind => dobinds" ("_") - "nobind" :: "'a => dobind" ("_") - "dobinds" :: "dobind => dobinds => dobinds" ("(_);//(_)") - "_do_" :: "dobinds => 'a => 'a" ("(do (_);// (_)//od)" 100) -syntax (xsymbols) - "dobind" :: "pttrn => 'a => dobind" ("(_ \<leftarrow>/ _)" 10) - -translations - "_do_ (dobinds b bs) e" == "_do_ b (_do_ bs e)" - "_do_ (nobind b) e" == "b >>= (%_.e)" - "do x <- b; e od" == "b >>= (%x. e)" - - -types 'a ErrorM = "(string + 'a) StateM" - -constdefs - returnE :: "'a => 'a ErrorM" - "returnE == return o Inr" - - bindE :: "'a ErrorM => ('a => 'b ErrorM) => 'b ErrorM" - (infixl ">>=E" 60) - "bindE f g == bind f (%r. case r of - Inl e => return (Inl e) - | Inr v => g v)" - -constdefs - "throwError == return o Inl" - -constdefs - lift :: "'a StateM => 'a ErrorM" - "lift f == %s. let (v,s') = f s in (Inr v, s')" - - whenE :: "bool => unit ErrorM => unit ErrorM" - "whenE b m == if b then m else returnE () " - -syntax - "_doE_" :: "dobinds => 'a => 'a" ("(doE (_);// (_)//odE)" 100) - -translations - "_doE_ (dobinds b bs) e" == "_doE_ b (_doE_ bs e )" - "_doE_ (nobind b) e " == "b >>=E (%_. e)" - "doE x <- b; e odE" == "b >>=E (%x. e)" -end \ No newline at end of file diff --git a/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/ex/monads.xml b/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/ex/monads.xml deleted file mode 100644 index 6bc29355be70f890d7a6ff54e17732d09794071b..0000000000000000000000000000000000000000 --- a/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/ex/monads.xml +++ /dev/null @@ -1,44 +0,0 @@ -<?xml version="1.0" encoding="UTF-8"?> -<translation - xmlns="http://www.haskell.org/hsimp/config" - xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance" - xsi:schemaLocation="http://www.haskell.org/hsimp/config config.xsd"> - <input> - <path location="src_hs/UseMonads.hs" /> - </input> - <output location="dst_thy" /> - <customisation> - - <monadInstance name="StateM"> - <doSyntax>do od</doSyntax> - <constants> - when when - return return - </constants> - </monadInstance> - - <monadInstance name="ErrorM"> - <doSyntax>doE odE</doSyntax> - <constants> - when whenE - throwError throwError - return returnE - </constants> - <lifts> - <lift from="StateM" by="lift" /> - </lifts> - </monadInstance> - - <replace> - <module name="Monads" /> - <theory name="StateMonads" location="StateMonads.thy"> - <monads> - StateM ErrorM - </monads> - <constants> - get put - </constants> - </theory> - </replace> - </customisation> -</translation> diff --git a/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/ex/src_hs/AVL.hs b/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/ex/src_hs/AVL.hs deleted file mode 100644 index e71a7b62b02e8a57312ccd4b97076ec7bf3cc074..0000000000000000000000000000000000000000 --- a/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/ex/src_hs/AVL.hs +++ /dev/null @@ -1,258 +0,0 @@ -module AVL where { - - -data Nat = Suc Nat | Zero; - -data Set a = Insert a (Set a) | Empty; - -data Tree a = Mkt a (Tree a) (Tree a) Nat | Et; - -ht :: forall a. Tree a -> Nat; -ht (Mkt x l r h) = h; -ht Et = Zero; - -bex :: forall a. Set a -> (a -> Bool) -> Bool; -bex Empty p = False; -bex (Insert a aa) p = p a || bex aa p; - -data Tree_isub_0 a = MKT_isub_0 a (Tree_isub_0 a) (Tree_isub_0 a) | ET_isub_0; - -erase :: forall a. Tree a -> Tree_isub_0 a; -erase (Mkt x l r h) = MKT_isub_0 x (erase l) (erase r); -erase Et = ET_isub_0; - -less_eq_nat :: Nat -> Nat -> Bool; -less_eq_nat (Suc m) n = less_nat m n; -less_eq_nat Zero n = True; - -less_nat :: Nat -> Nat -> Bool; -less_nat m (Suc n) = less_eq_nat m n; -less_nat n Zero = False; - -maxa :: Nat -> Nat -> Nat; -maxa a b = (if less_eq_nat a b then b else a); - -one_nat :: Nat; -one_nat = Suc Zero; - -plus_nat :: Nat -> Nat -> Nat; -plus_nat (Suc m) n = plus_nat m (Suc n); -plus_nat Zero n = n; - -height :: forall a. Tree_isub_0 a -> Nat; -height (MKT_isub_0 n l r) = plus_nat one_nat (maxa (height l) (height r)); -height ET_isub_0 = Zero; - -eq_nat :: Nat -> Nat -> Bool; -eq_nat Zero Zero = True; -eq_nat (Suc m) (Suc n) = eq_nat m n; -eq_nat Zero (Suc a) = False; -eq_nat (Suc a) Zero = False; - -hinv :: forall a. Tree a -> Bool; -hinv (Mkt x l r h) = - eq_nat h (plus_nat one_nat (maxa (height (erase l)) (height (erase r)))) && - (hinv l && hinv r); -hinv Et = True; - -is_bal :: forall a. Tree_isub_0 a -> Bool; -is_bal (MKT_isub_0 n l r) = - (eq_nat (height l) (height r) || - (eq_nat (height l) (plus_nat one_nat (height r)) || - eq_nat (height r) (plus_nat one_nat (height l)))) - && (is_bal l && is_bal r); -is_bal ET_isub_0 = True; - -avl :: forall a. Tree a -> Bool; -avl t = is_bal (erase t) && hinv t; - -ball :: forall a. Set a -> (a -> Bool) -> Bool; -ball Empty p = True; -ball (Insert a aa) p = p a && ball aa p; - -mkta :: forall a. a -> Tree a -> Tree a -> Tree a; -mkta x l r = Mkt x l r (plus_nat (maxa (ht l) (ht r)) one_nat); - -member :: Nat -> Set Nat -> Bool; -member a aa = bex aa (eq_nat a); - -union :: Set Nat -> Set Nat -> Set Nat; -union a Empty = a; -union Empty a = a; -union (Insert a aa) b = - let { - c = union aa b; - } in (if member a b then c else Insert a c); - -tree_case :: - forall t a. t -> (a -> Tree a -> Tree a -> Nat -> t) -> Tree a -> t; -tree_case f1 f2 Et = f1; -tree_case f1 f2 (Mkt a tree1 tree2 n) = f2 a tree1 tree2 n; - -r_bal :: forall a. (a, (Tree a, Tree a)) -> Tree a; -r_bal (n, (l, Mkt rn rl rr h)) = - (if less_nat (ht rr) (ht rl) - then (case rl of { - Et -> Et; - Mkt rln rll rlr ha -> mkta rln (mkta n l rll) (mkta rn rlr rr); - }) - else mkta rn (mkta n l rl) rr); - -l_bal :: forall a. (a, (Tree a, Tree a)) -> Tree a; -l_bal (n, (Mkt ln ll lr h, r)) = - (if less_nat (ht ll) (ht lr) - then (case lr of { - Et -> Et; - Mkt lrn lrl lrr lrh -> mkta lrn (mkta ln ll lrl) (mkta n lrr r); - }) - else mkta ln ll (mkta n lr r)); - -insrt :: Nat -> Tree Nat -> Tree Nat; -insrt x (Mkt n l r h) = - (if eq_nat x n then Mkt n l r h - else (if less_nat x n - then let { - l' = insrt x l; - hl' = ht l'; - hr = ht r; - } in (if eq_nat hl' - (plus_nat (Suc (Suc Zero)) hr) - then l_bal (n, (l', r)) - else Mkt n l' r (plus_nat one_nat (maxa hl' hr))) - else let { - r' = insrt x r; - hl = ht l; - hr' = ht r'; - } in (if eq_nat hr' - (plus_nat (Suc (Suc Zero)) hl) - then r_bal (n, (l, r')) - else Mkt n l r' (plus_nat one_nat (maxa hl hr'))))); -insrt x Et = Mkt x Et Et one_nat; - -is_in :: Nat -> Tree Nat -> Bool; -is_in k (Mkt n l r h) = - (if eq_nat k n then True else (if less_nat k n then is_in k l else is_in k r)); -is_in k Et = False; - -set_of :: Tree_isub_0 Nat -> Set Nat; -set_of (MKT_isub_0 n l r) = Insert n (union (set_of l) (set_of r)); -set_of ET_isub_0 = Empty; - -is_ord :: Tree_isub_0 Nat -> Bool; -is_ord (MKT_isub_0 n l r) = - ball (set_of l) (\ n' -> less_nat n' n) && - (ball (set_of r) (less_nat n) && (is_ord l && is_ord r)); -is_ord ET_isub_0 = True; - --- eq_tree :: forall a. (Eq a) => Tree a -> Tree a -> Bool; --- eq_tree Et Et = True; --- eq_tree (Mkt a tree1 tree2 nat) (Mkt a' tree1' tree2' nat') = --- a == a' && --- (eq_tree tree1 tree1' && (eq_tree tree2 tree2' && eq_nat nat nat')); --- eq_tree Et (Mkt a b c d) = False; --- eq_tree (Mkt a b c d) Et = False; - -tree_rec :: - forall t a. t -> (a -> Tree a -> Tree a -> Nat -> t -> t -> t) -> Tree a -> t; -tree_rec f1 f2 (Mkt a tree1 tree2 n) = - f2 a tree1 tree2 n (tree_rec f1 f2 tree1) (tree_rec f1 f2 tree2); -tree_rec f1 f2 Et = f1; - -size_tree :: forall a. Tree a -> Nat; -size_tree (Mkt a tree1 tree2 n) = - plus_nat (plus_nat (size_tree tree1) (size_tree tree2)) (Suc Zero); -size_tree Et = Zero; - -tree_size :: forall a. (a -> Nat) -> Tree a -> Nat; -tree_size fa (Mkt a tree1 tree2 n) = - plus_nat - (plus_nat (plus_nat (fa a) (tree_size fa tree1)) (tree_size fa tree2)) - (Suc Zero); -tree_size fa Et = Zero; - -tree_isub_0_case :: - forall t a. - t -> (a -> Tree_isub_0 a -> Tree_isub_0 a -> t) -> Tree_isub_0 a -> t; -tree_isub_0_case f1 f2 ET_isub_0 = f1; -tree_isub_0_case f1 f2 (MKT_isub_0 a tree_isub_01 tree_isub_02) = - f2 a tree_isub_01 tree_isub_02; - -r_bal_isub_0 :: forall a. (a, (Tree_isub_0 a, Tree_isub_0 a)) -> Tree_isub_0 a; -r_bal_isub_0 (n, (l, MKT_isub_0 rn rl rr)) = - (if less_nat (height rr) (height rl) - then (case rl of { - ET_isub_0 -> ET_isub_0; - MKT_isub_0 rln rll rlr -> - MKT_isub_0 rln (MKT_isub_0 n l rll) (MKT_isub_0 rn rlr rr); - }) - else MKT_isub_0 rn (MKT_isub_0 n l rl) rr); - -l_bal_isub_0 :: forall a. (a, (Tree_isub_0 a, Tree_isub_0 a)) -> Tree_isub_0 a; -l_bal_isub_0 (n, (MKT_isub_0 ln ll lr, r)) = - (if less_nat (height ll) (height lr) - then (case lr of { - ET_isub_0 -> ET_isub_0; - MKT_isub_0 lrn lrl lrr -> - MKT_isub_0 lrn (MKT_isub_0 ln ll lrl) (MKT_isub_0 n lrr r); - }) - else MKT_isub_0 ln ll (MKT_isub_0 n lr r)); - -insrt_isub_0 :: Nat -> Tree_isub_0 Nat -> Tree_isub_0 Nat; -insrt_isub_0 x (MKT_isub_0 n l r) = - (if eq_nat x n then MKT_isub_0 n l r - else (if less_nat x n - then let { - l' = insrt_isub_0 x l; - } in (if eq_nat (height l') - (plus_nat (Suc (Suc Zero)) - (height r)) - then l_bal_isub_0 (n, (l', r)) else MKT_isub_0 n l' r) - else let { - r' = insrt_isub_0 x r; - } in (if eq_nat (height r') - (plus_nat (Suc (Suc Zero)) - (height l)) - then r_bal_isub_0 (n, (l, r')) else MKT_isub_0 n l r'))); -insrt_isub_0 x ET_isub_0 = MKT_isub_0 x ET_isub_0 ET_isub_0; - -is_in_isub_0 :: Nat -> Tree_isub_0 Nat -> Bool; -is_in_isub_0 k (MKT_isub_0 n l r) = - (if eq_nat k n then True - else (if less_nat k n then is_in_isub_0 k l else is_in_isub_0 k r)); -is_in_isub_0 k ET_isub_0 = False; - --- eq_tree_isub_0 :: forall a. (Eq a) => Tree_isub_0 a -> Tree_isub_0 a -> Bool; --- eq_tree_isub_0 ET_isub_0 ET_isub_0 = True; --- eq_tree_isub_0 (MKT_isub_0 a tree_isub_01 tree_isub_02) --- (MKT_isub_0 a' tree_isub_01' tree_isub_02') = --- a == a' && --- (eq_tree_isub_0 tree_isub_01 tree_isub_01' && --- eq_tree_isub_0 tree_isub_02 tree_isub_02'); --- eq_tree_isub_0 ET_isub_0 (MKT_isub_0 a b c) = False; --- eq_tree_isub_0 (MKT_isub_0 a b c) ET_isub_0 = False; - -tree_isub_0_rec :: - forall t a. - t -> (a -> Tree_isub_0 a -> Tree_isub_0 a -> t -> t -> t) -> - Tree_isub_0 a -> t; -tree_isub_0_rec f1 f2 (MKT_isub_0 a tree_isub_01 tree_isub_02) = - f2 a tree_isub_01 tree_isub_02 (tree_isub_0_rec f1 f2 tree_isub_01) - (tree_isub_0_rec f1 f2 tree_isub_02); -tree_isub_0_rec f1 f2 ET_isub_0 = f1; - -size_tree_isub_0 :: forall a. Tree_isub_0 a -> Nat; -size_tree_isub_0 (MKT_isub_0 a tree_isub_01 tree_isub_02) = - plus_nat - (plus_nat (size_tree_isub_0 tree_isub_01) (size_tree_isub_0 tree_isub_02)) - (Suc Zero); -size_tree_isub_0 ET_isub_0 = Zero; - -tree_isub_0_size :: forall a. (a -> Nat) -> Tree_isub_0 a -> Nat; -tree_isub_0_size fa (MKT_isub_0 a tree_isub_01 tree_isub_02) = - plus_nat - (plus_nat (plus_nat (fa a) (tree_isub_0_size fa tree_isub_01)) - (tree_isub_0_size fa tree_isub_02)) - (Suc Zero); -tree_isub_0_size fa ET_isub_0 = Zero; - -} diff --git a/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/ex/src_hs/Adaptions.hs b/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/ex/src_hs/Adaptions.hs deleted file mode 100644 index 41a2b8adf671d1b9346eb9191b4f47b60d7d4c55..0000000000000000000000000000000000000000 --- a/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/ex/src_hs/Adaptions.hs +++ /dev/null @@ -1,27 +0,0 @@ --- some rather fundamental adaptions - -module Adaptions where - -implies :: Bool -> Bool -> Bool -implies False _ = True -implies True True = True -implies True False = False - -nand :: Bool -> Bool -> Bool -nand p q = not (p && q) - -nor :: Bool -> Bool -> Bool -nor p q = not (p || q) - -append :: [a] -> [a] -> [a] -append [] ys = ys -append xs [] = xs -append (x:xs) ys = x : append xs ys - -rev :: [a] -> [a] -rev [] = [] -rev (x:xs) = append (rev xs) [x] - -who_am_i_smile :: (a -> b) -> Maybe a -> Maybe b -who_am_i_smile f Nothing = Nothing -who_am_i_smile f (Just x) = Just (f x) diff --git a/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/ex/src_hs/AsPattern.hs b/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/ex/src_hs/AsPattern.hs deleted file mode 100644 index 5192555b08043c97528a18a1541c8ff4de1e594e..0000000000000000000000000000000000000000 --- a/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/ex/src_hs/AsPattern.hs +++ /dev/null @@ -1,27 +0,0 @@ - -module AsPatterns where - -data MyRecord = A{ one :: [Int], two:: Int, three :: Char } - -f () = () - -foo [] = [] -foo (a@(x1,x2):b@(y1,y2):rest) = a:b:rest - -bar x = case x of - [a@(b,c)] -> a - c@(a@(x1,x2):b@(y1,y2):rest) -> a - -quux x = (\a@(r,s) -> x ++ [a]) - -unsound :: [Int] -> [Int] -unsound l@(_:_) = 0 : l -unsound l@([]) = 1 : l - -record :: MyRecord -> MyRecord -record a@A{one = []} = a - - -long :: Show a => [a] -> String -long l@(_:_:_) = show l ++ " is long enough!" -long l = show l ++ " is too short!" \ No newline at end of file diff --git a/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/ex/src_hs/Base.hs b/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/ex/src_hs/Base.hs deleted file mode 100644 index f1a27f2966bbe4e06d355c292b3bfaf2b5cc5ec7..0000000000000000000000000000000000000000 --- a/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/ex/src_hs/Base.hs +++ /dev/null @@ -1,47 +0,0 @@ -module Base where - -fold f [] y = y -fold f (x : xs) y = fold f xs (f x y) - -fold_map :: (a -> s -> (b, s)) -> [a] -> s -> ([b], s) -fold_map f [] y = ([], y) -fold_map f (x:xs) y = - let - (x', y') = f x y - (xs', y'') = fold_map f xs y' - in (x' : xs', y'') - -maps :: (a -> [b]) -> [a] -> [b] -maps f [] = [] -maps f (x : xs) = f x ++ maps f xs - -map_index :: ((Int, a) -> b) -> [a] -> [b] -map_index f = mapp 0 where - mapp _ [] = [] - mapp i (x : xs) = f (i, x) : mapp (i + 1) xs - -map2 :: (a -> b -> c) -> [a] -> [b] -> [c] -map2 _ [] [] = [] -map2 f (x : xs) (y : ys) = f x y : map2 f xs ys -map2 _ _ _ = error "unequal lengths" - -map_split :: (a -> (b, c)) -> [a] -> ([b], [c]) -map_split f [] = ([], []) -map_split f (x : xs) = - let - (y, w) = f x - (ys, ws) = map_split f xs - in (y : ys, w : ws) - -map_product :: (a -> b -> c) -> [a] -> [b] -> [c] -map_product f _ [] = [] -map_product f [] _ = [] -map_product f (x : xs) ys = map (f x) ys ++ map_product f xs ys - -member :: Eq a => [a] -> a -> Bool -member [] y = False -member (x : xs) y = x == y || member xs y - -distincts :: Eq a => [a] -> [a] -distincts [] = [] -distincts (x : xs) = if member xs x then distincts xs else x : distincts xs diff --git a/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/ex/src_hs/ClassAdaptions.hs b/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/ex/src_hs/ClassAdaptions.hs deleted file mode 100644 index 24d96117a2db28eb1fa3b24c079a8ad4aa5dbd7c..0000000000000000000000000000000000000000 --- a/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/ex/src_hs/ClassAdaptions.hs +++ /dev/null @@ -1,19 +0,0 @@ - -module ClassAdaptions where - -data Nat = Succ Nat | Zero deriving Show; - -instance Eq Nat where - Zero == Zero = True - (Succ m) == (Succ n) = m == n - Zero == (Succ n) = False - (Succ m) == Zero = False - -class (Eq a) => Ident a where - ident :: a -> a -> Bool - -fromEq :: (Eq a) => a -> a -> b -> Maybe b -fromEq a1 a2 b = if a1 == a2 then Just b else Nothing - -fromIdent :: (Ident a) => a -> a -> b -> Maybe b -fromIdent a1 a2 b = if ident a1 a2 then Just b else Nothing diff --git a/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/ex/src_hs/Classes.hs b/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/ex/src_hs/Classes.hs deleted file mode 100644 index 4ff8d154978470fd5d33733a70c341ad621a5e2a..0000000000000000000000000000000000000000 --- a/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/ex/src_hs/Classes.hs +++ /dev/null @@ -1,99 +0,0 @@ -module Classes where - -import Nats - - -{- some algebra -} - -class Monoid a where - nothing :: a - plus :: a -> a -> a - -instance Monoid Nat where - nothing = Zero - plus = plus_nat - -instance Monoid Integer where - nothing = 0 - plus = (+) - -summ :: forall a. (Monoid a) => [a] -> a -summ [] = nothing -summ (x : xs) = plus x (summ xs) - -class (Monoid a) => Group a where - inverse :: a -> a - -instance Group Integer where - inverse = negate - -sub :: forall a. (Group a) => a -> a -> a -sub a b = plus a (inverse b) - -pow_nat :: forall a. (Monoid a) => Nat -> a -> a -pow_nat Zero _ = nothing -pow_nat (Suc n) x = plus x (pow_nat n x) - -pow_int :: forall a. (Group a) => Integer -> a -> a; {-# HASKABELLE permissive pow_int #-} -pow_int k x = - if k == 0 then nothing - else if k < 0 then pow_int (- k) (inverse x) - else plus x (pow_int (k - 1) x) - - -{- standard orderings -} - -class Order a where - less_eq :: a -> a -> Bool - less :: a -> a -> Bool - -instance Order Nat where - less_eq = less_eq_nat - less = less_nat - -instance Order Integer where - less_eq = (<=) - less = (<) - -instance (Order a, Order b) => Order (a, b) where - less_eq (x, y) (w, z) = less x w || not (less w x) && less_eq y z - less (x, y) (w, z) = less x w || not (less w x) && less y z - -instance (Order a) => Order [a] where - less_eq (x : xs) (y : ys) = less x y || not (less y x) && less_eq xs ys - less_eq [] xs = True - less_eq (x : xs) [] = False - less (x : xs) (y : ys) = less x y || not (less y x) && less xs ys - less xs [] = False - less [] (x : xs) = True - - -data Linord = Less | Equal | Greater - -class Eq a => Linorder a where - linord :: a -> a -> Linord - -instance Linorder Nat where - linord Zero (Suc _) = Less - linord Zero Zero = Equal - linord (Suc _) Zero = Greater - linord (Suc m) (Suc n) = linord m n - -instance Linorder Integer where - linord k l = if k < l then Less - else if l < k then Greater else Equal - -instance (Linorder a, Linorder b) => Linorder (a, b) where - linord (x, y) (w, z) = case linord x w of - Less -> Less - Equal -> linord y z - Greater -> Greater - -instance (Linorder a) => Linorder [a] where - linord [] [] = Equal - linord xs [] = Greater - linord [] ys = Less - linord (x : xs) (y : ys) = case linord x y of - Less -> Less - Equal -> linord xs ys - Greater -> Greater diff --git a/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/ex/src_hs/Closure.hs b/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/ex/src_hs/Closure.hs deleted file mode 100644 index d4ee2b89cd3d2efa06fce42294137024d7175dc9..0000000000000000000000000000000000000000 --- a/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/ex/src_hs/Closure.hs +++ /dev/null @@ -1,9 +0,0 @@ -module Closure -where - - -func x y = sum x + addToX y - where addToX y = x + y - addToY x = x + y - w = addToY x - sum x = w + x diff --git a/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/ex/src_hs/Depend.hs b/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/ex/src_hs/Depend.hs deleted file mode 100644 index bee32593275e5db30cd7d0ca1866fddf6f4ee5f8..0000000000000000000000000000000000000000 --- a/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/ex/src_hs/Depend.hs +++ /dev/null @@ -1,7 +0,0 @@ -module Depend -where -import Depend.DependB - -alias = 1 - -somefun = map $ (+) 1 \ No newline at end of file diff --git a/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/ex/src_hs/Depend/DependB.hs b/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/ex/src_hs/Depend/DependB.hs deleted file mode 100644 index d7c5872a692901d27ae4de35326dbe5431bdc1a8..0000000000000000000000000000000000000000 --- a/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/ex/src_hs/Depend/DependB.hs +++ /dev/null @@ -1,3 +0,0 @@ -module Depend.DependB where - -bla = 1 diff --git a/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/ex/src_hs/Enumerations.hs b/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/ex/src_hs/Enumerations.hs deleted file mode 100644 index 29a8ac3db1b73ff538bf7fddf1de621d16063e32..0000000000000000000000000000000000000000 --- a/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/ex/src_hs/Enumerations.hs +++ /dev/null @@ -1,100 +0,0 @@ -{-# OPTIONS_GHC -fglasgow-exts #-} - -module Enumerations where { - - -data Nat = Zero | Suc Nat; - -mapa :: forall b a. (b -> a) -> [b] -> [a]; -mapa f [] = []; -mapa f (x : xs) = f x : mapa f xs; - -list_case :: forall a b. a -> (b -> [b] -> a) -> [b] -> a; -list_case f1 f2 (a : list) = f2 a list; -list_case f1 f2 [] = f1; - -zipa :: forall a b. [a] -> [b] -> [(a, b)]; -zipa xs [] = []; -zipa xs (y : ys) = case xs of { - [] -> []; - z : zs -> (z, y) : zipa zs ys; - }; - -class Finite a where { -}; - -class (Finite a) => Enuma a where { - enum :: [a]; -}; - -data Sum a b = Inl a | Inr b; - -append :: forall a. [a] -> [a] -> [a]; -append [] ys = ys; -append (x : xs) ys = x : append xs ys; - -enuma :: forall a b. (Enuma a, Enuma b) => [(Sum a b)]; -enuma = append (mapa Inl enum) (mapa Inr enum); - -producta :: forall a b. [a] -> [b] -> [(a, b)]; -producta [] uu = []; -producta (x : xs) ys = append (mapa (\ a -> (x, a)) ys) (producta xs ys); - -enumb :: forall a b. (Enuma a, Enuma b) => [(a, b)]; -enumb = producta enum enum; - -map_of :: forall b a. (Eq b) => [(b, a)] -> b -> Maybe a; -map_of ((l, v) : ps) k = (if l == k then Just v else map_of ps k); -map_of [] k = Nothing; - -the :: forall a. Maybe a -> a; -the (Just x) = x; - -list_all :: forall a. (a -> Bool) -> [a] -> Bool; -list_all p [] = True; -list_all p (x : xs) = p x && list_all p xs; - -eq_fun :: forall a b. (Enuma a, Eq b) => (a -> b) -> (a -> b) -> Bool; -eq_fun f g = list_all (\ x -> f x == g x) enum; - -concata :: forall a. [[a]] -> [a]; -concata [] = []; -concata (x : xs) = append x (concata xs); - -n_lists :: forall a. Nat -> [a] -> [[a]]; -n_lists Zero xs = [[]]; -n_lists (Suc n) xs = - concata (mapa (\ ys -> mapa (\ y -> y : ys) xs) (n_lists n xs)); - -plus_nat :: Nat -> Nat -> Nat; -plus_nat (Suc m) n = plus_nat m (Suc n); -plus_nat Zero n = n; - -len :: [a] -> Nat; -len [] = Zero; -len (_ : xs) = Suc (len xs); - -enum_fun :: forall a b. (Eq a, Enuma a, Enuma b) => [(a -> b)]; -enum_fun = - let { - enum_a = enum; - } in mapa (\ ys -> the . map_of (zipa enum_a ys)) - (n_lists (len enum_a) enum); - -sublists :: forall a. [a] -> [[a]]; -sublists [] = [[]]; -sublists (x : xs) = - let { - xss = sublists xs; - } in append (mapa (\ a -> x : a) xss) xss; - -enum_bool :: [Bool]; -enum_bool = [False, True]; - -enum_unit :: [()]; -enum_unit = [()]; - -enum_option :: forall a. (Enuma a) => [(Maybe a)]; -enum_option = Nothing : mapa Just enum; - -} diff --git a/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/ex/src_hs/Finite_Map.hs b/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/ex/src_hs/Finite_Map.hs deleted file mode 100644 index 6198fe41008eb8cbe43c12d37afbae7ae7031e2f..0000000000000000000000000000000000000000 --- a/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/ex/src_hs/Finite_Map.hs +++ /dev/null @@ -1,452 +0,0 @@ - -module Finite_Map ( - FiniteMap, -- abstract type - - emptyFM, unitFM, listToFM, - - addToFM, - addToFM_C, - addListToFM, - addListToFM_C, - delFromFM , - delListFromFM, - - plusFM, - plusFM_C, - minusFM, - foldFM, - - intersectFM , - intersectFM_C , - mapFM , mapMaybeFM , filterFM , - - sizeFM, isEmptyFM, elemFM, lookupFM, lookupWithDefaultFM, - - fmToList, keysFM, eltsFM - - - ) where - -isJust :: Maybe a -> Bool -isJust (Just _) = True -isJust Nothing = False - --- BUILDING -emptyFM :: FiniteMap key elt -unitFM :: key -> elt -> FiniteMap key elt -listToFM :: (Ord key {--}) => [(key,elt)] -> FiniteMap key elt - -- In the case of duplicates, the last is taken - - --- ADDING AND DELETING - -- Throws away any previous binding - -- In the list case, the items are added starting with the - -- first one in the list -addToFM :: (Ord key {--}) => FiniteMap key elt -> key -> elt -> FiniteMap key elt -addListToFM :: (Ord key {--}) => FiniteMap key elt -> [(key,elt)] -> FiniteMap key elt - - -- Combines with previous binding - -- In the combining function, the first argument is the "old" element, - -- while the second is the "new" one. -addToFM_C :: (Ord key {--}) => (elt -> elt -> elt) - -> FiniteMap key elt -> key -> elt - -> FiniteMap key elt -addListToFM_C :: (Ord key {--}) => (elt -> elt -> elt) - -> FiniteMap key elt -> [(key,elt)] - -> FiniteMap key elt - - -- Deletion doesn't complain if you try to delete something - -- which isn't there -delFromFM :: (Ord key {--}) => FiniteMap key elt -> key -> FiniteMap key elt -delListFromFM :: (Ord key {--}) => FiniteMap key elt -> [key] -> FiniteMap key elt - --- COMBINING - -- Bindings in right argument shadow those in the left -plusFM :: (Ord key {--}) => FiniteMap key elt -> FiniteMap key elt - -> FiniteMap key elt - - -- Combines bindings for the same thing with the given function -plusFM_C :: (Ord key {--}) => (elt -> elt -> elt) - -> FiniteMap key elt -> FiniteMap key elt -> FiniteMap key elt - -minusFM :: (Ord key {--}) => FiniteMap key elt -> FiniteMap key elt -> FiniteMap key elt - -- (minusFM a1 a2) deletes from a1 any bindings which are bound in a2 - -intersectFM :: (Ord key {--}) => FiniteMap key elt -> FiniteMap key elt -> FiniteMap key elt -intersectFM_C :: (Ord key {--}) => (elt1 -> elt2 -> elt3) - -> FiniteMap key elt1 -> FiniteMap key elt2 -> FiniteMap key elt3 - --- MAPPING, FOLDING, FILTERING -foldFM :: (key -> elt -> a -> a) -> a -> FiniteMap key elt -> a -mapFM :: (key -> elt1 -> elt2) -> FiniteMap key elt1 -> FiniteMap key elt2 -filterFM :: (Ord key {--}) => (key -> elt -> Bool) - -> FiniteMap key elt -> FiniteMap key elt -mapMaybeFM :: (Ord key {--}) - => (key -> elt1 -> Maybe elt2) - -> FiniteMap key elt1 - -> FiniteMap key elt2 - --- INTERROGATING -sizeFM :: FiniteMap key elt -> Int -isEmptyFM :: FiniteMap key elt -> Bool - -elemFM :: (Ord key {--}) => key -> FiniteMap key elt -> Bool -lookupFM :: (Ord key {--}) => FiniteMap key elt -> key -> Maybe elt -lookupWithDefaultFM - :: (Ord key {--}) => FiniteMap key elt -> elt -> key -> elt - -- lookupWithDefaultFM supplies a "default" elt - -- to return for an unmapped key - --- LISTIFYING -fmToList :: FiniteMap key elt -> [(key,elt)] -keysFM :: FiniteMap key elt -> [key] -eltsFM :: FiniteMap key elt -> [elt] - -data FiniteMap key elt - = EmptyFM - | Branch key elt -- Key and elt stored here - Int{-STRICT-} -- Size >= 1 - (FiniteMap key elt) -- Children - (FiniteMap key elt) - -emptyFM = EmptyFM -{- -emptyFM - = Branch bottom bottom 0 bottom bottom - where - bottom = panic "emptyFM" --} - --- #define EmptyFM (Branch _ _ 0 _ _) - -unitFM key elt = Branch key elt 1 emptyFM emptyFM - -listToFM = addListToFM emptyFM - -addToFM fm key elt = addToFM_C (\ old new -> new) fm key elt - -addToFM_C combiner EmptyFM key elt = unitFM key elt -addToFM_C combiner (Branch key elt size fm_l fm_r) new_key new_elt - - | new_key < key = mkBalBranch key elt (addToFM_C combiner fm_l new_key new_elt) fm_r - | new_key > key = mkBalBranch key elt fm_l (addToFM_C combiner fm_r new_key new_elt) - | otherwise = Branch new_key (combiner elt new_elt) size fm_l fm_r - - -addListToFM fm key_elt_pairs = addListToFM_C (\ old new -> new) fm key_elt_pairs - -addListToFM_C combiner fm key_elt_pairs - = foldl add fm key_elt_pairs -- foldl adds from the left - where - add fmap (key,elt) = addToFM_C combiner fmap key elt - -delFromFM EmptyFM del_key = emptyFM -delFromFM (Branch key elt size fm_l fm_r) del_key = - if del_key > key then mkBalBranch key elt fm_l (delFromFM fm_r del_key) - else if del_key < key then mkBalBranch key elt (delFromFM fm_l del_key) fm_r - else glueBal fm_l fm_r - - -delListFromFM fm keys = foldl delFromFM fm keys - -plusFM_C combiner EmptyFM fm2 = fm2 -plusFM_C combiner fm1 EmptyFM = fm1 -plusFM_C combiner fm1 (Branch split_key elt2 _ left right) - = mkVBalBranch split_key new_elt - (plusFM_C combiner lts left) - (plusFM_C combiner gts right) - where - lts = splitLT fm1 split_key - gts = splitGT fm1 split_key - new_elt = case lookupFM fm1 split_key of - Nothing -> elt2 - Just elt1 -> combiner elt1 elt2 - --- It's worth doing plusFM specially, because we don't need --- to do the lookup in fm1. - -plusFM EmptyFM fm2 = fm2 -plusFM fm1 EmptyFM = fm1 -plusFM fm1 (Branch split_key elt1 _ left right) - = mkVBalBranch split_key elt1 (plusFM lts left) (plusFM gts right) - where - lts = splitLT fm1 split_key - gts = splitGT fm1 split_key - -minusFM EmptyFM fm2 = emptyFM -minusFM fm1 EmptyFM = fm1 -minusFM fm1 (Branch split_key elt _ left right) - = glueVBal (minusFM lts left) (minusFM gts right) - -- The two can be way different, so we need glueVBal - where - lts = splitLT fm1 split_key -- NB gt and lt, so the equal ones - gts = splitGT fm1 split_key -- are not in either. - -intersectFM fm1 fm2 = intersectFM_C (\ left right -> right) fm1 fm2 - -intersectFM_C combiner fm1 EmptyFM = emptyFM -intersectFM_C combiner EmptyFM fm2 = emptyFM -intersectFM_C combiner fm1 (Branch split_key elt2 _ left right) - - | isJust maybe_elt1 -- split_elt *is* in intersection - = mkVBalBranch split_key (combiner elt1 elt2) (intersectFM_C combiner lts left) - (intersectFM_C combiner gts right) - - | otherwise -- split_elt is *not* in intersection - = glueVBal (intersectFM_C combiner lts left) (intersectFM_C combiner gts right) - - where - lts = splitLT fm1 split_key -- NB gt and lt, so the equal ones - gts = splitGT fm1 split_key -- are not in either. - - maybe_elt1 = lookupFM fm1 split_key - elt1 = case maybe_elt1 of Just x -> x - -foldFM k z EmptyFM = z -foldFM k z (Branch key elt _ fm_l fm_r) - = foldFM k (k key elt (foldFM k z fm_r)) fm_l - -mapFM f EmptyFM = emptyFM -mapFM f (Branch key elt size fm_l fm_r) - = Branch key (f key elt) size (mapFM f fm_l) (mapFM f fm_r) - -mapMaybeFM f EmptyFM = emptyFM -mapMaybeFM f (Branch key elt _ fm_l fm_r) = - case f key elt of - Nothing -> glueVBal (mapMaybeFM f fm_l) (mapMaybeFM f fm_r) - Just elt' -> mkVBalBranch key elt' (mapMaybeFM f fm_l) (mapMaybeFM f fm_r) - -filterFM p EmptyFM = emptyFM -filterFM p (Branch key elt _ fm_l fm_r) - | p key elt -- Keep the item - = mkVBalBranch key elt (filterFM p fm_l) (filterFM p fm_r) - - | otherwise -- Drop the item - = glueVBal (filterFM p fm_l) (filterFM p fm_r) - ---{-# INLINE sizeFM #-} -sizeFM EmptyFM = 0 -sizeFM (Branch _ _ size _ _) = size - -isEmptyFM fm = sizeFM fm == 0 - -lookupFM EmptyFM key = Nothing -lookupFM (Branch key elt _ fm_l fm_r) key_to_find - - | key_to_find < key = lookupFM fm_l key_to_find - | key_to_find > key = lookupFM fm_r key_to_find - | otherwise = Just elt - - -key `elemFM` fm - = case (lookupFM fm key) of { Nothing -> False; Just elt -> True } - -lookupWithDefaultFM fm deflt key - = case (lookupFM fm key) of { Nothing -> deflt; Just elt -> elt } - -fmToList fm = foldFM (\ key elt rest -> (key,elt) : rest) [] fm -keysFM fm = foldFM (\ key elt rest -> key : rest) [] fm -eltsFM fm = foldFM (\ key elt rest -> elt : rest) [] fm - -sIZE_RATIO :: Int -sIZE_RATIO = 5 - -mkBranch :: (Ord key {--}) -- Used for the assertion checking only - => Int - -> key -> elt - -> FiniteMap key elt -> FiniteMap key elt - -> FiniteMap key elt - -mkBranch which key elt fm_l fm_r - = --{--} - - let - result = Branch key elt (unbox (1 + left_size + right_size)) fm_l fm_r - in --- if sizeFM result <= 8 then - result --- else --- pprTrace ("mkBranch:"++(show which)) (ppr PprDebug result) ( --- result --- ) - where - left_ok = case fm_l of - EmptyFM -> True - Branch left_key _ _ _ _ -> let - biggest_left_key = fst (findMax fm_l) - in - biggest_left_key < key - right_ok = case fm_r of - EmptyFM -> True - Branch right_key _ _ _ _ -> let - smallest_right_key = fst (findMin fm_r) - in - key < smallest_right_key - balance_ok = True -- sigh -{- LATER: - balance_ok - = -- Both subtrees have one or no elements... - (left_size + right_size <= 1) --- NO || left_size == 0 -- ??? --- NO || right_size == 0 -- ??? - -- ... or the number of elements in a subtree does not exceed - -- sIZE_RATIO times the number of elements in the other subtree - || (left_size * sIZE_RATIO >= right_size && - right_size * sIZE_RATIO >= left_size) --} - - left_size = sizeFM fm_l - right_size = sizeFM fm_r - - - unbox :: Int -> Int - unbox x = x - -mkBalBranch :: (Ord key {--}) - => key -> elt - -> FiniteMap key elt -> FiniteMap key elt - -> FiniteMap key elt - -mkBalBranch key elt fm_L fm_R - - | size_l + size_r < 2 - = mkBranch 1{-which-} key elt fm_L fm_R - - | size_r > sIZE_RATIO * size_l -- Right tree too big - = case fm_R of - Branch _ _ _ fm_rl fm_rr - | sizeFM fm_rl < 2 * sizeFM fm_rr -> single_L fm_L fm_R - | otherwise -> double_L fm_L fm_R - -- Other case impossible - - | size_l > sIZE_RATIO * size_r -- Left tree too big - = case fm_L of - Branch _ _ _ fm_ll fm_lr - | sizeFM fm_lr < 2 * sizeFM fm_ll -> single_R fm_L fm_R - | otherwise -> double_R fm_L fm_R - -- Other case impossible - - | otherwise -- No imbalance - = mkBranch 2{-which-} key elt fm_L fm_R - - where - size_l = sizeFM fm_L - size_r = sizeFM fm_R - - single_L fm_l (Branch key_r elt_r _ fm_rl fm_rr) - = mkBranch 3{-which-} key_r elt_r (mkBranch 4{-which-} key elt fm_l fm_rl) fm_rr - - double_L fm_l (Branch key_r elt_r _ (Branch key_rl elt_rl _ fm_rll fm_rlr) fm_rr) - = mkBranch 5{-which-} key_rl elt_rl (mkBranch 6{-which-} key elt fm_l fm_rll) - (mkBranch 7{-which-} key_r elt_r fm_rlr fm_rr) - - single_R (Branch key_l elt_l _ fm_ll fm_lr) fm_r - = mkBranch 8{-which-} key_l elt_l fm_ll (mkBranch 9{-which-} key elt fm_lr fm_r) - - double_R (Branch key_l elt_l _ fm_ll (Branch key_lr elt_lr _ fm_lrl fm_lrr)) fm_r - = mkBranch 10{-which-} key_lr elt_lr (mkBranch 11{-which-} key_l elt_l fm_ll fm_lrl) - (mkBranch 12{-which-} key elt fm_lrr fm_r) - -mkVBalBranch :: (Ord key {--}) - => key -> elt - -> FiniteMap key elt -> FiniteMap key elt - -> FiniteMap key elt - --- Assert: in any call to (mkVBalBranch_C comb key elt l r), --- (a) all keys in l are < all keys in r --- (b) all keys in l are < key --- (c) all keys in r are > key - -mkVBalBranch key elt EmptyFM fm_r = addToFM fm_r key elt -mkVBalBranch key elt fm_l EmptyFM = addToFM fm_l key elt - -mkVBalBranch key elt fm_l@(Branch key_l elt_l _ fm_ll fm_lr) - fm_r@(Branch key_r elt_r _ fm_rl fm_rr) - | sIZE_RATIO * size_l < size_r - = mkBalBranch key_r elt_r (mkVBalBranch key elt fm_l fm_rl) fm_rr - - | sIZE_RATIO * size_r < size_l - = mkBalBranch key_l elt_l fm_ll (mkVBalBranch key elt fm_lr fm_r) - - | otherwise - = mkBranch 13{-which-} key elt fm_l fm_r - - where - size_l = sizeFM fm_l - size_r = sizeFM fm_r - -glueBal :: (Ord key {--}) - => FiniteMap key elt -> FiniteMap key elt - -> FiniteMap key elt - -glueBal EmptyFM fm2 = fm2 -glueBal fm1 EmptyFM = fm1 -glueBal fm1 fm2 - -- The case analysis here (absent in Adams' program) is really to deal - -- with the case where fm2 is a singleton. Then deleting the minimum means - -- we pass an empty tree to mkBalBranch, which breaks its invariant. - | sizeFM fm2 > sizeFM fm1 - = mkBalBranch mid_key2 mid_elt2 fm1 (deleteMin fm2) - - | otherwise - = mkBalBranch mid_key1 mid_elt1 (deleteMax fm1) fm2 - where - (mid_key1, mid_elt1) = findMax fm1 - (mid_key2, mid_elt2) = findMin fm2 - -glueVBal :: (Ord key {--}) - => FiniteMap key elt -> FiniteMap key elt - -> FiniteMap key elt - -glueVBal EmptyFM fm2 = fm2 -glueVBal fm1 EmptyFM = fm1 -glueVBal fm_l@(Branch key_l elt_l _ fm_ll fm_lr) - fm_r@(Branch key_r elt_r _ fm_rl fm_rr) - | sIZE_RATIO * size_l < size_r - = mkBalBranch key_r elt_r (glueVBal fm_l fm_rl) fm_rr - - | sIZE_RATIO * size_r < size_l - = mkBalBranch key_l elt_l fm_ll (glueVBal fm_lr fm_r) - - | otherwise -- We now need the same two cases as in glueBal above. - = glueBal fm_l fm_r - where - size_l = sizeFM fm_l - size_r = sizeFM fm_r - -splitLT, splitGT :: (Ord key {--}) => FiniteMap key elt -> key -> FiniteMap key elt - --- splitLT fm split_key = fm restricted to keys < split_key --- splitGT fm split_key = fm restricted to keys > split_key - -splitLT EmptyFM split_key = emptyFM -splitLT (Branch key elt _ fm_l fm_r) split_key - - | split_key < key = splitLT fm_l split_key - | split_key > key = mkVBalBranch key elt fm_l (splitLT fm_r split_key) - | otherwise = fm_l - - -splitGT EmptyFM split_key = emptyFM -splitGT (Branch key elt _ fm_l fm_r) split_key - - | split_key > key = splitGT fm_r split_key - | split_key < key = mkVBalBranch key elt (splitGT fm_l split_key) fm_r - | otherwise = fm_r - - -findMin :: FiniteMap key elt -> (key,elt) -findMin (Branch key elt _ EmptyFM _) = (key,elt) -findMin (Branch key elt _ fm_l _) = findMin fm_l - -deleteMin :: (Ord key {--}) => FiniteMap key elt -> FiniteMap key elt -deleteMin (Branch key elt _ EmptyFM fm_r) = fm_r -deleteMin (Branch key elt _ fm_l fm_r) = mkBalBranch key elt (deleteMin fm_l) fm_r - -findMax :: FiniteMap key elt -> (key,elt) -findMax (Branch key elt _ _ EmptyFM) = (key,elt) -findMax (Branch key elt _ _ fm_r) = findMax fm_r - -deleteMax :: (Ord key {--}) => FiniteMap key elt -> FiniteMap key elt -deleteMax (Branch key elt _ fm_l EmptyFM) = fm_l -deleteMax (Branch key elt _ fm_l fm_r) = mkBalBranch key elt fm_l (deleteMax fm_r) diff --git a/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/ex/src_hs/Float.hs b/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/ex/src_hs/Float.hs deleted file mode 100644 index 434739f9d9a154d979f2cb46e8f85ddfb2e3d96d..0000000000000000000000000000000000000000 --- a/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/ex/src_hs/Float.hs +++ /dev/null @@ -1,641 +0,0 @@ -{-# OPTIONS_GHC -fglasgow-exts #-} - -module Float where { - -positive :: Integer -> Integer; -positive k = if k < 0 then 0 else k; - -leta :: forall b a. b -> (b -> a) -> a; -leta s f = f s; - -class One a where { - one :: a; -}; - -class Plus a where { - plus :: a -> a -> a; -}; - -class Zero a where { - zero :: a; -}; - -class Minus a where { - minus :: a -> a -> a; -}; - -class Times a where { - times :: a -> a -> a; -}; - -data Itself a = Type; - -data Floata = Floata Integer Integer; - -data Rat = Fract Integer Integer; - -inverse_rat :: Rat -> Rat; -inverse_rat (Fract a b) = - (if b == 0 then Fract 1 0 - else (if a < 0 then Fract (negate b) (negate a) else Fract b a)); - -newtype Reala = Ratreal Rat; - -inverse_real :: Reala -> Reala; -inverse_real (Ratreal x) = Ratreal (inverse_rat x); - -abs_int :: Integer -> Integer; -abs_int i = (if i < 0 then negate i else i); - -split :: forall b c a. (b -> c -> a) -> (b, c) -> a; -split f (a, b) = f a b; - -sgn_int :: Integer -> Integer; -sgn_int i = (if i == 0 then 0 else (if 0 < i then 1 else negate 1)); - -apsnd :: forall c b a. (c -> b) -> (a, c) -> (a, b); -apsnd f (x, y) = (x, f y); - -div_mod :: Integer -> Integer -> (Integer, Integer); {-# HASKABELLE permissive div_mod #-}; -div_mod m n = - (if n == 0 || m < n then (0, m) - else let { - (q, a) = div_mod (m - n) n; - } in (q + 1, a)); - -divmoda :: Integer -> Integer -> (Integer, Integer); {-# HASKABELLE permissive divmoda #-}; -divmoda k l = - (if k == 0 then (0, 0) - else (if l == 0 then (0, k) - else apsnd (\ a -> sgn_int l * a) - (if sgn_int k == sgn_int l - then (\k l -> div_mod (abs k) (abs l)) k l - else let { - (r, s) = (\k l -> div_mod (abs k) (abs l)) k l; - } in (if s == 0 then (negate r, 0) - else (negate r - 1, abs_int l - s))))); - -div_int :: Integer -> Integer -> Integer; -div_int a b = fst (divmoda a b); - -divmod :: Integer -> Integer -> (Integer, Integer); -divmod n m = (if m == 0 then (0, n) else div_mod n m); - -mod_nat :: Integer -> Integer -> Integer; -mod_nat m n = snd (divmod m n); - -gcd_nat :: Integer -> Integer -> Integer; {-# HASKABELLE permissive gcd_nat #-}; -gcd_nat x y = (if y == 0 then x else gcd_nat y (mod_nat x y)); - -gcd_int :: Integer -> Integer -> Integer; -gcd_int x y = - id (gcd_nat (positive (abs_int x)) (positive (abs_int y))); - -fract_norm :: Integer -> Integer -> Rat; {-# HASKABELLE permissive fract_norm #-}; -fract_norm a b = - (if a == 0 || b == 0 then Fract 0 1 - else let { - c = gcd_int a b; - } in (if 0 < b then Fract (div_int a c) (div_int b c) - else Fract (negate (div_int a c)) (negate (div_int b c)))); - -times_rat :: Rat -> Rat -> Rat; -times_rat (Fract a b) (Fract c d) = fract_norm (a * c) (b * d); - -times_real :: Reala -> Reala -> Reala; -times_real (Ratreal x) (Ratreal y) = Ratreal (times_rat x y); - -instance Times Reala where { - times = times_real; -}; - -class (One a, Times a) => Power a where { -}; - -one_real :: Reala; -one_real = Ratreal (Fract 1 1); - -instance One Reala where { - one = one_real; -}; - -instance Power Reala where { -}; - -minus_nat :: Integer -> Integer -> Integer; -minus_nat n m = positive (id n - id m); - -power :: forall a. (Power a) => a -> Integer -> a; {-# HASKABELLE permissive power #-}; -power a n = - (if n == 0 then one else times a (power a (minus_nat n 1))); - -pow2 :: Integer -> Reala; -pow2 a = - (if 0 <= a then power (Ratreal (Fract 2 1)) (positive a) - else inverse_real (power (Ratreal (Fract 2 1)) (positive (negate a)))); - -class Neg a where { - neg :: a -> a; -}; - -instance Times Integer where { - times a b = a * b; -}; - -class (Times a) => Dvd a where { -}; - -instance Dvd Integer where { -}; - -class (One a, Zero a) => Zero_neq_one a where { -}; - -class (Times a) => Semigroup_mult a where { -}; - -class (Plus a) => Semigroup_add a where { -}; - -class (Semigroup_add a) => Ab_semigroup_add a where { -}; - -class (Ab_semigroup_add a, Semigroup_mult a) => Semiring a where { -}; - -class (Times a, Zero a) => Mult_zero a where { -}; - -class (Zero a, Semigroup_add a) => Monoid_add a where { -}; - -class (Ab_semigroup_add a, Monoid_add a) => Comm_monoid_add a where { -}; - -class (Comm_monoid_add a, Mult_zero a, Semiring a) => Semiring_0 a where { -}; - -class (Semigroup_add a) => Cancel_semigroup_add a where { -}; - -class (Ab_semigroup_add a, - Cancel_semigroup_add a) => Cancel_ab_semigroup_add a where { -}; - -class (Cancel_ab_semigroup_add a, - Comm_monoid_add a) => Cancel_comm_monoid_add a where { -}; - -class (Cancel_comm_monoid_add a, Semiring_0 a) => Semiring_0_cancel a where { -}; - -class (Semigroup_mult a, Power a) => Monoid_mult a where { -}; - -class (Monoid_mult a, Semiring_0 a, Zero_neq_one a) => Semiring_1 a where { -}; - -class (Semiring_0_cancel a, Semiring_1 a) => Semiring_1_cancel a where { -}; - -class (Minus a, Neg a, Monoid_add a) => Group_add a where { -}; - -class (Cancel_comm_monoid_add a, Group_add a) => Ab_group_add a where { -}; - -class (Ab_group_add a, Semiring_0_cancel a) => Ring a where { -}; - -class (Ring a, Semiring_1_cancel a) => Ring_1 a where { -}; - -of_int :: forall a. (Ring_1 a) => Integer -> a; {-# HASKABELLE permissive of_int #-}; -of_int k = - (if k == 0 then zero - else (if k < 0 then neg (of_int (negate k)) - else let { - (l, m) = divmoda k 2; - l' = of_int l; - } in (if m == 0 then plus l' l' else plus (plus l' l') one))); - -instance One Integer where { - one = 1; -}; - -foldla :: forall a b. (a -> b -> a) -> a -> [b] -> a; -foldla f a [] = a; -foldla f a (x : xs) = foldla f (f a x) xs; - -data Nibble = Nibble0 | Nibble1 | Nibble2 | Nibble3 | Nibble4 | Nibble5 - | Nibble6 | Nibble7 | Nibble8 | Nibble9 | NibbleA | NibbleB | NibbleC - | NibbleD | NibbleE | NibbleF; - -data Chara = Chara Nibble Nibble; - -class (Dvd a) => Div a where { - diva :: a -> a -> a; - moda :: a -> a -> a; -}; - -scale :: Floata -> Integer; -scale (Floata a b) = b; - -instance Plus Integer where { - plus a b = a + b; -}; - -instance Zero Integer where { - zero = 0; -}; - -bitlen :: Integer -> Integer; {-# HASKABELLE permissive bitlen #-}; -bitlen x = - (if x == 0 then 0 else (if x == (-1) then 1 else 1 + bitlen (div_int x 2))); - -times_float :: Floata -> Floata -> Floata; -times_float (Floata a_m a_e) (Floata b_m b_e) = Floata (a_m * b_m) (a_e + b_e); - -mod_int :: Integer -> Integer -> Integer; -mod_int a b = snd (divmoda a b); - -even_int :: Integer -> Bool; -even_int x = mod_int x 2 == 0; - -normfloat :: Floata -> Floata; {-# HASKABELLE permissive normfloat #-}; -normfloat (Floata a b) = - (if not (a == 0) && even_int a then normfloat (Floata (div_int a 2) (b + 1)) - else (if a == 0 then Floata 0 0 else Floata a b)); - -instance Power Integer where { -}; - -lapprox_posrat :: Integer -> Integer -> Integer -> Floata; -lapprox_posrat prec x y = - let { - l = positive (id prec + bitlen y - bitlen x); - d = div_int (x * power 2 l) y; - } in normfloat (Floata d (negate (id l))); - -neg_float :: Floata -> Floata; -neg_float (Floata m e) = Floata (negate m) e; - -rapprox_posrat :: Integer -> Integer -> Integer -> Floata; -rapprox_posrat prec x y = - let { - l = positive (id prec + bitlen y - bitlen x); - xa = x * power 2 l; - d = div_int xa y; - m = mod_int xa y; - } in normfloat - (Floata (d + (if m == 0 then 0 else 1)) (negate (id l))); - -zero_float :: Floata; -zero_float = Floata 0 0; - -rapprox_rat :: Integer -> Integer -> Integer -> Floata; -rapprox_rat prec x y = - (if y == 0 then zero_float - else (if 0 <= x - then (if 0 < y then rapprox_posrat prec x y - else neg_float (lapprox_posrat prec x (negate y))) - else (if 0 < y then neg_float (lapprox_posrat prec (negate x) y) - else rapprox_posrat prec (negate x) (negate y)))); - -float_divr :: Integer -> Floata -> Floata -> Floata; -float_divr prec (Floata m1 s1) (Floata m2 s2) = - let { - r = rapprox_rat prec m1 m2; - f = Floata 1 (s1 - s2); - } in times_float f r; - -ceiling_fl :: Floata -> Floata; -ceiling_fl (Floata m e) = - (if 0 <= e then Floata m e - else Floata (div_int m (power 2 (positive (negate e))) + 1) 0); - -plus_float :: Floata -> Floata -> Floata; -plus_float (Floata a_m a_e) (Floata b_m b_e) = - (if a_e <= b_e then Floata (a_m + b_m * power 2 (positive (b_e - a_e))) a_e - else Floata (a_m * power 2 (positive (a_e - b_e)) + b_m) b_e); - -minus_float :: Floata -> Floata -> Floata; -minus_float z w = plus_float z (neg_float w); - -lb_mod :: Integer -> Floata -> Floata -> Floata -> Floata; -lb_mod prec x ub lb = - minus_float x (times_float (ceiling_fl (float_divr prec x lb)) ub); - -lapprox_rat :: Integer -> Integer -> Integer -> Floata; -lapprox_rat prec x y = - (if y == 0 then zero_float - else (if 0 <= x - then (if 0 < y then lapprox_posrat prec x y - else neg_float (rapprox_posrat prec x (negate y))) - else (if 0 < y then neg_float (rapprox_posrat prec (negate x) y) - else lapprox_posrat prec (negate x) (negate y)))); - -float_divl :: Integer -> Floata -> Floata -> Floata; -float_divl prec (Floata m1 s1) (Floata m2 s2) = - let { - l = lapprox_rat prec m1 m2; - f = Floata 1 (s1 - s2); - } in times_float f l; - -floor_fl :: Floata -> Floata; -floor_fl (Floata m e) = - (if 0 <= e then Floata m e - else Floata (div_int m (power 2 (positive (negate e)))) 0); - -ub_mod :: Integer -> Floata -> Floata -> Floata -> Floata; -ub_mod prec x ub lb = - minus_float x (times_float (floor_fl (float_divl prec x ub)) lb); - -instance Div Integer where { - diva = div_int; - moda = mod_int; -}; - -eq_float :: Floata -> Floata -> Bool; -eq_float (Floata int1 int2) (Floata int1' int2') = - int1 == int1' && int2 == int2'; - -mantissa :: Floata -> Integer; -mantissa (Floata a b) = a; - -zero_real :: Reala; -zero_real = Ratreal (Fract 0 1); - -instance Zero Reala where { - zero = zero_real; -}; - -instance Zero_neq_one Reala where { -}; - -instance Semigroup_mult Reala where { -}; - -plus_rat :: Rat -> Rat -> Rat; -plus_rat (Fract a b) (Fract c d) = - (if b == 0 then Fract c d - else (if d == 0 then Fract a b else fract_norm (a * d + c * b) (b * d))); - -plus_real :: Reala -> Reala -> Reala; -plus_real (Ratreal x) (Ratreal y) = Ratreal (plus_rat x y); - -instance Plus Reala where { - plus = plus_real; -}; - -instance Semigroup_add Reala where { -}; - -instance Ab_semigroup_add Reala where { -}; - -instance Semiring Reala where { -}; - -instance Mult_zero Reala where { -}; - -instance Monoid_add Reala where { -}; - -instance Comm_monoid_add Reala where { -}; - -instance Semiring_0 Reala where { -}; - -instance Monoid_mult Reala where { -}; - -instance Semiring_1 Reala where { -}; - -instance Cancel_semigroup_add Reala where { -}; - -instance Cancel_ab_semigroup_add Reala where { -}; - -instance Cancel_comm_monoid_add Reala where { -}; - -instance Semiring_0_cancel Reala where { -}; - -instance Semiring_1_cancel Reala where { -}; - -neg_rat :: Rat -> Rat; -neg_rat (Fract a b) = Fract (negate a) b; - -neg_real :: Reala -> Reala; -neg_real (Ratreal x) = Ratreal (neg_rat x); - -instance Neg Reala where { - neg = neg_real; -}; - -minus_rat :: Rat -> Rat -> Rat; -minus_rat (Fract a b) (Fract c d) = - (if b == 0 then Fract (negate c) d - else (if d == 0 then Fract a b else fract_norm (a * d - c * b) (b * d))); - -minus_real :: Reala -> Reala -> Reala; -minus_real (Ratreal x) (Ratreal y) = Ratreal (minus_rat x y); - -instance Minus Reala where { - minus = minus_real; -}; - -instance Group_add Reala where { -}; - -instance Ab_group_add Reala where { -}; - -instance Ring Reala where { -}; - -instance Ring_1 Reala where { -}; - -of_float :: Floata -> Reala; -of_float (Floata a b) = times_real (of_int a) (pow2 b); - -round_up :: Integer -> Floata -> Floata; {-# HASKABELLE permissive round_up #-}; -round_up prec (Floata m e) = - let { - d = bitlen m - id prec; - } in (if 0 < d - then let { - p = power 2 (positive d); - n = div_int m p; - r = mod_int m p; - } in Floata (n + (if r == 0 then 0 else 1)) (e + d) - else Floata m e); - -float_abs :: Floata -> Floata; -float_abs (Floata m e) = Floata (abs_int m) e; - -abs_float :: Floata -> Floata; -abs_float x = float_abs x; - -one_float :: Floata; -one_float = Floata 1 0; - -instance Semigroup_mult Integer where { -}; - -instance Semigroup_add Integer where { -}; - -instance Ab_semigroup_add Integer where { -}; - -instance Semiring Integer where { -}; - -float_nprt :: Floata -> Floata; -float_nprt (Floata a e) = (if 0 <= a then zero_float else Floata a e); - -float_pprt :: Floata -> Floata; -float_pprt (Floata a e) = (if 0 <= a then Floata a e else zero_float); - -float_size :: Floata -> Integer; -float_size (Floata int1 int2) = 0; - -less_rat :: Rat -> Rat -> Bool; -less_rat (Fract a b) (Fract c d) = - (if b == 0 then 0 < sgn_int c * sgn_int d - else (if d == 0 then sgn_int a * sgn_int b < 0 - else (a * abs_int d * sgn_int b) < c * (abs_int b * sgn_int d))); - -less_real :: Reala -> Reala -> Bool; -less_real (Ratreal x) (Ratreal y) = less_rat x y; - -less_float :: Floata -> Floata -> Bool; -less_float z w = less_real (of_float z) (of_float w); - -round_down :: Integer -> Floata -> Floata; {-# HASKABELLE permissive round_down #-}; -round_down prec (Floata m e) = - let { - d = bitlen m - id prec; - } in (if 0 < d - then let { - p = power 2 (positive d); - n = div_int m p; - } in Floata n (e + d) - else Floata m e); - -instance Mult_zero Integer where { -}; - -instance Monoid_add Integer where { -}; - -instance Comm_monoid_add Integer where { -}; - -instance Semiring_0 Integer where { -}; - -instance Zero_neq_one Integer where { -}; - -instance Monoid_mult Integer where { -}; - -instance Semiring_1 Integer where { -}; - -class (Times a, Zero a) => No_zero_divisors a where { -}; - -instance No_zero_divisors Integer where { -}; - -class (Semigroup_mult a) => Ab_semigroup_mult a where { -}; - -class (Ab_semigroup_mult a, Semiring a) => Comm_semiring a where { -}; - -class (Comm_semiring a, Semiring_0 a) => Comm_semiring_0 a where { -}; - -class (Ab_semigroup_mult a, Monoid_mult a) => Comm_monoid_mult a where { -}; - -class (Comm_monoid_mult a, Comm_semiring_0 a, Dvd a, - Semiring_1 a) => Comm_semiring_1 a where { -}; - -class (Comm_semiring_0 a, - Semiring_0_cancel a) => Comm_semiring_0_cancel a where { -}; - -class (Comm_semiring_0_cancel a, Comm_semiring_1 a, - Semiring_1_cancel a) => Comm_semiring_1_cancel a where { -}; - -class (Div a, Comm_semiring_1_cancel a, - No_zero_divisors a) => Semiring_div a where { -}; - -instance Cancel_semigroup_add Integer where { -}; - -instance Cancel_ab_semigroup_add Integer where { -}; - -instance Cancel_comm_monoid_add Integer where { -}; - -instance Semiring_0_cancel Integer where { -}; - -instance Semiring_1_cancel Integer where { -}; - -instance Ab_semigroup_mult Integer where { -}; - -instance Comm_semiring Integer where { -}; - -instance Comm_semiring_0 Integer where { -}; - -instance Comm_monoid_mult Integer where { -}; - -instance Comm_semiring_1 Integer where { -}; - -instance Comm_semiring_0_cancel Integer where { -}; - -instance Comm_semiring_1_cancel Integer where { -}; - -instance Semiring_div Integer where { -}; - -less_eq_rat :: Rat -> Rat -> Bool; -less_eq_rat (Fract a b) (Fract c d) = - (if b == 0 then 0 <= sgn_int c * sgn_int d - else (if d == 0 then sgn_int a * sgn_int b <= 0 - else (a * abs_int d * sgn_int b) <= (c * abs_int b * sgn_int d))); - -less_eq_real :: Reala -> Reala -> Bool; -less_eq_real (Ratreal x) (Ratreal y) = less_eq_rat x y; - -less_eq_float :: Floata -> Floata -> Bool; -less_eq_float z w = less_eq_real (of_float z) (of_float w); - -} diff --git a/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/ex/src_hs/Fset.hs b/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/ex/src_hs/Fset.hs deleted file mode 100644 index fd657947d8750cf0bfbb862ed95e063cc9ebb123..0000000000000000000000000000000000000000 --- a/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/ex/src_hs/Fset.hs +++ /dev/null @@ -1,107 +0,0 @@ -{-# OPTIONS_GHC -fglasgow-exts #-} - -module Fset where { - - -data Nat = Zero | Suc Nat; - -newtype Fset a = Set [a]; - -mapb :: forall b a. (b -> a) -> [b] -> [a]; -mapb f [] = []; -mapb f (x : xs) = f x : mapb f xs; - -membera :: forall a. (Eq a) => a -> [a] -> Bool; -membera x [] = False; -membera x (y : ys) = x == y || membera x ys; - -remdups :: forall a. (Eq a) => [a] -> [a]; -remdups [] = []; -remdups (x : xs) = (if membera x xs then remdups xs else x : remdups xs); - -mapa :: forall b a. (Eq a) => (b -> a) -> Fset b -> Fset a; -mapa f (Set xs) = Set (remdups (mapb f xs)); - -length_unique :: forall a. (Eq a) => [a] -> Nat; -length_unique [] = Zero; -length_unique (x : xs) = - (if membera x xs then length_unique xs else Suc (length_unique xs)); - -card :: forall a. (Eq a) => Fset a -> Nat; -card (Set xs) = length_unique xs; - -nulla :: forall a. [a] -> Bool; -nulla [] = True; -nulla (x : xs) = False; - -empty :: forall a. Fset a; -empty = Set []; - -list_ex :: forall a. (a -> Bool) -> [a] -> Bool; -list_ex p [] = False; -list_ex p (x : xs) = p x || list_ex p xs; - -exists :: forall a. (a -> Bool) -> Fset a -> Bool; -exists p (Set xs) = list_ex p xs; - -member :: forall a. (Eq a) => Fset a -> a -> Bool; -member a y = exists (\ aa -> y == aa) a; - -filterb :: forall a. (a -> Bool) -> [a] -> [a]; -filterb p [] = []; -filterb p (x : xs) = (if p x then x : filterb p xs else filterb p xs); - -filtera :: forall a. (a -> Bool) -> Fset a -> Fset a; -filtera p (Set xs) = Set (filterb p xs); - -inter :: forall a. (Eq a) => Fset a -> Fset a -> Fset a; -inter a b = filtera (member a) b; - -inserta :: forall a. (Eq a) => a -> [a] -> [a]; -inserta x xs = (if membera x xs then xs else x : xs); - -insert :: forall a. (Eq a) => a -> Fset a -> Fset a; -insert x (Set xs) = Set (inserta x xs); - -foldla :: forall a b. (a -> b -> a) -> a -> [b] -> a; -foldla f a [] = a; -foldla f a (x : xs) = foldla f (f a x) xs; - -union :: forall a. (Eq a) => Fset a -> Fset a -> Fset a; -union (Set xs) a = foldla (\ aa x -> insert x aa) a xs; - -list_all :: forall a. (a -> Bool) -> [a] -> Bool; -list_all p [] = True; -list_all p (x : xs) = p x && list_all p xs; - -foralla :: forall a. (a -> Bool) -> Fset a -> Bool; -foralla p (Set xs) = list_all p xs; - -intera :: forall a. (Eq a) => Fset (Fset a) -> Fset a; -intera (Set (a : asa)) = foldla inter a asa; - -remove_all :: forall a. (Eq a) => a -> [a] -> [a]; -remove_all x xs = filterb (not . (\ a -> x == a)) xs; - -remove :: forall a. (Eq a) => a -> Fset a -> Fset a; -remove x (Set xs) = Set (remove_all x xs); - -uniona :: forall a. (Eq a) => Fset (Fset a) -> Fset a; -uniona (Set asa) = foldla union empty asa; - -subfset_eq :: forall a. (Eq a) => Fset a -> Fset a -> Bool; -subfset_eq a b = foralla (member b) a; - -eq_fset :: forall a. (Eq a) => Fset a -> Fset a -> Bool; -eq_fset a b = subfset_eq a b && subfset_eq b a; - -subfset :: forall a. (Eq a) => Fset a -> Fset a -> Bool; -subfset a b = subfset_eq a b && not (subfset_eq b a); - -is_empty :: forall a. Fset a -> Bool; -is_empty (Set xs) = nulla xs; - -subtracta :: forall a. (Eq a) => Fset a -> Fset a -> Fset a; -subtracta (Set xs) a = foldla (\ aa x -> remove x aa) a xs; - -} diff --git a/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/ex/src_hs/Guards.hs.disabled b/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/ex/src_hs/Guards.hs.disabled deleted file mode 100644 index e2f8ad6bea68c750ca2cbda18d47d7455175d365..0000000000000000000000000000000000000000 --- a/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/ex/src_hs/Guards.hs.disabled +++ /dev/null @@ -1,33 +0,0 @@ -module Guards where - -import Nats - -foo n | not (less_nat n Zero_nat) = Suc (Zero_nat) - | otherwise = Zero_nat - -bar n | not (less_nat n ten) = Suc (Suc (Zero_nat)) - | eq_nat n ten = Suc (Zero_nat) - | otherwise = Zero_nat - where ten = (Suc (Suc (Suc (Suc (Suc (Suc (Suc (Suc (Suc (Suc Zero_nat)))))))))) - -zero = Zero_nat -one = Suc (Zero_nat) -two = Suc (Suc (Zero_nat)) -three = Suc (Suc (Suc (Zero_nat))) - -quux n | eq_nat n three = zero - | less_nat n three = one - | greater_nat n three = two - -foomb mb = case mb of - Nothing -> zero - Just n - | eq_nat n three -> zero - | less_nat n three -> one - | greater_nat n three -> two - -fallthrough n = case n of - n | eq_nat n (Suc Zero_nat) -> zero - Zero_nat -> one - _ -> two - \ No newline at end of file diff --git a/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/ex/src_hs/Integers.hs b/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/ex/src_hs/Integers.hs deleted file mode 100644 index 66a0b7257ce2202d33de9c27eb67f8cecfdf8a4e..0000000000000000000000000000000000000000 --- a/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/ex/src_hs/Integers.hs +++ /dev/null @@ -1,18 +0,0 @@ -module Integers where - -fibs :: Integer -> [Integer] -> [Integer] -fibs k xs - = if k <= 0 then reverse xs - else fibs (k - 1) ys' - where ys' = case xs of - (x : y : _) -> x + y : xs - _ -> 1 : xs - --- Same as above, but using pattern guards. - --- fibs2 :: Integer -> [Integer] -> [Integer] --- fibs2 k xs | k <= 0 = reverse xs --- | True = fibs (k - 1) ys' --- where ys' = case xs of --- (x : y : _) -> x + y : xs --- _ -> 1 : xs diff --git a/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/ex/src_hs/LambdaFu.hs b/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/ex/src_hs/LambdaFu.hs deleted file mode 100644 index c546dca9fcc5201d1571f0d111a1eea5d318bb8e..0000000000000000000000000000000000000000 --- a/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/ex/src_hs/LambdaFu.hs +++ /dev/null @@ -1,25 +0,0 @@ - -module LambdaFu where - --- Testing simple lambda expressions. LC-style pair encoding. - -true = \x y -> x -false = \x y -> y - -pair = \x y f -> f x y -first = \p -> p true -second = \p -> p false -nil = \x -> true -null = \p -> p (\x y -> false) - - --- Testing lambda expressions with simple pattern matching: - -maybe_numbers = [Just 1,Just 3,Just 5,Just 7] -numbers = map (\(Just i) -> i) maybe_numbers - - - - - - diff --git a/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/ex/src_hs/ListComprehensions.hs b/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/ex/src_hs/ListComprehensions.hs deleted file mode 100644 index 619bb9c0b6c60efb8b0d84d315aa6f7fe9385031..0000000000000000000000000000000000000000 --- a/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/ex/src_hs/ListComprehensions.hs +++ /dev/null @@ -1,12 +0,0 @@ - -module ListComprehensions where - -list = [1, 2, 3, 4, 5] - -dot_product f l1 l2 = [ f x y | x <- l1, y <- l2 ] - -list2 = dot_product (+) list list - -list3 = [ x*x | x <- list, x == 1 || x == 2 ] - --- list4 = [ if (x == 1) then "eins" else "zwei" | x <- list, x == 1 || x == 2 ] \ No newline at end of file diff --git a/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/ex/src_hs/Lists.hs b/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/ex/src_hs/Lists.hs deleted file mode 100644 index 249109e086a135cfc9d6f506560c6d3f1115cef1..0000000000000000000000000000000000000000 --- a/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/ex/src_hs/Lists.hs +++ /dev/null @@ -1,453 +0,0 @@ -{-# OPTIONS_GHC -fglasgow-exts #-} - -module Lists where { - - -data Inta = Number_of_int Inta | Bit1 Inta | Bit0 Inta | Min | Pls; - -data Nat = Suc Nat | Zero; - -leta :: forall b a. b -> (b -> a) -> a; -leta s f = f s; - -class Orda a where { - less_eq :: a -> a -> Bool; - less :: a -> a -> Bool; -}; - -hd :: forall a. [a] -> a; -hd (x : xs) = x; - -tl :: forall a. [a] -> [a]; -tl [] = []; -tl (x : xs) = xs; - -class Plus a where { - plus :: a -> a -> a; -}; - -class Zero a where { - zero :: a; -}; - -preda :: Inta -> Inta; -preda (Bit1 k) = Bit0 k; -preda (Bit0 k) = Bit1 (preda k); -preda Min = Bit0 Min; -preda Pls = Min; - -succa :: Inta -> Inta; -succa (Bit1 k) = Bit0 (succa k); -succa (Bit0 k) = Bit1 k; -succa Min = Pls; -succa Pls = Bit1 Pls; - -data Nibble = NibbleF | NibbleE | NibbleD | NibbleC | NibbleB | NibbleA - | Nibble9 | Nibble8 | Nibble7 | Nibble6 | Nibble5 | Nibble4 | Nibble3 - | Nibble2 | Nibble1 | Nibble0; - -data Chara = Chara Nibble Nibble; - -mapa :: forall b a. (b -> a) -> [b] -> [a]; -mapa f [] = []; -mapa f (x : xs) = f x : mapa f xs; - -nat_case :: forall t. t -> (Nat -> t) -> Nat -> t; -nat_case f1 f2 (Suc nat) = f2 nat; -nat_case f1 f2 Zero = f1; - -nth :: forall a. [a] -> Nat -> a; -nth (x : xs) n = (case n of { - Zero -> x; - Suc a -> nth xs a; - }); - -foldla :: forall a b. (a -> b -> a) -> a -> [b] -> a; -foldla f a [] = a; -foldla f a (x : xs) = foldla f (f a x) xs; - -rev :: forall a. [a] -> [a]; -rev xs = foldla (\ xsa x -> x : xsa) [] xs; - -insert :: forall a. (Eq a) => a -> (a -> Bool) -> a -> Bool; -insert y a x = y == x || a x; - -empty :: forall a. a -> Bool; -empty x = False; - -set :: forall a. (Eq a) => [a] -> a -> Bool; -set [] = empty; -set (x : xs) = insert x (set xs); - -less_eq_nat :: Nat -> Nat -> Bool; -less_eq_nat (Suc m) n = less_nat m n; -less_eq_nat Zero n = True; - -less_nat :: Nat -> Nat -> Bool; -less_nat m (Suc n) = less_eq_nat m n; -less_nat n Zero = False; - -list_case :: forall t a. t -> (a -> [a] -> t) -> [a] -> t; -list_case f1 f2 (a : list) = f2 a list; -list_case f1 f2 [] = f1; - -zipa :: forall a b. [a] -> [b] -> [(a, b)]; -zipa xs [] = []; -zipa xs (y : ys) = - (case xs of { - [] -> []; - z : zs -> (z, y) : zipa zs ys; - }); - -dropa :: forall a. Nat -> [a] -> [a]; -dropa n [] = []; -dropa n (x : xs) = - (case n of { - Zero -> x : xs; - Suc m -> dropa m xs; - }); - -nulla :: forall a. [a] -> Bool; -nulla [] = True; -nulla (x : xs) = False; - -lasta :: forall a. [a] -> a; -lasta (x : xs) = (if nulla xs then x else lasta xs); - -class (Orda a) => Preorder a where { -}; - -class (Preorder a) => Order a where { -}; - -class (Order a) => Linorder a where { -}; - -insort :: forall a. (Linorder a) => a -> [a] -> [a]; -insort x [] = [x]; -insort x (y : ys) = - (if less_eq x y then x : y : ys else y : insort x ys); - -sort :: forall a. (Linorder a) => [a] -> [a]; -sort [] = []; -sort (x : xs) = insort x (sort xs); - -takea :: forall a. Nat -> [a] -> [a]; -takea n [] = []; -takea n (x : xs) = - (case n of { - Zero -> []; - Suc m -> x : takea m xs; - }); - -class (Linorder a) => Finite_intvl_succ a where { - successor :: a -> a; -}; - -data Itself a = Type; - -foldra :: forall b a. (b -> a -> a) -> [b] -> a -> a; -foldra f [] a = a; -foldra f (x : xs) a = f x (foldra f xs a); - -membera :: forall a. a -> (a -> Bool) -> Bool; -membera x s = s x; - -append :: forall a. [a] -> [a] -> [a]; -append [] ys = ys; -append (x : xs) ys = x : append xs ys; - -concata :: forall a. [[a]] -> [a]; -concata [] = []; -concata (x : xs) = append x (concata xs); - -filtera :: forall a. (a -> Bool) -> [a] -> [a]; -filtera p [] = []; -filtera p (x : xs) = (if p x then x : filtera p xs else filtera p xs); - -member :: forall a. (Eq a) => a -> [a] -> Bool; -member x [] = False; -member x (y : ys) = x == y || member x ys; - -rotate1 :: forall a. [a] -> [a]; -rotate1 xs = (case xs of { - [] -> []; - x : xsa -> append xsa [x]; - }); - -fun_pow :: forall a. Nat -> (a -> a) -> a -> a; -fun_pow Zero f = id; -fun_pow (Suc n) f = f . fun_pow n f; - -rotate :: forall a. Nat -> [a] -> [a]; -rotate n = fun_pow n rotate1; - -sorted :: forall a. (Linorder a) => [a] -> Bool; -sorted [] = True; -sorted [x] = True; -sorted (x : y : zs) = less_eq x y && sorted (y : zs); - -splice :: forall a. [a] -> [a] -> [a]; -splice (x : xs) (y : ys) = x : y : splice xs ys; -splice xs [] = xs; - -plus_int :: Inta -> Inta -> Inta; -plus_int (Number_of_int v) (Number_of_int w) = - Number_of_int (plus_int v w); -plus_int (Bit1 k) (Bit1 l) = Bit0 (plus_int k (succa l)); -plus_int (Bit1 k) (Bit0 l) = Bit1 (plus_int k l); -plus_int (Bit0 k) (Bit1 l) = Bit1 (plus_int k l); -plus_int (Bit0 k) (Bit0 l) = Bit0 (plus_int k l); -plus_int k Min = preda k; -plus_int k Pls = k; -plus_int Min k = preda k; -plus_int Pls k = k; - -butlast :: forall a. [a] -> [a]; -butlast [] = []; -butlast (x : xs) = (if nulla xs then [] else x : butlast xs); - -list_ex :: forall a. (a -> Bool) -> [a] -> Bool; -list_ex p [] = False; -list_ex p (x : xs) = p x || list_ex p xs; - -class (Plus a) => Semigroup_add a where { -}; - -class (Zero a, Semigroup_add a) => Monoid_add a where { -}; - -listsum :: forall a. (Monoid_add a) => [a] -> a; -listsum [] = zero; -listsum (x : xs) = plus x (foldla plus zero xs); - -remdups :: forall a. (Eq a) => [a] -> [a]; -remdups [] = []; -remdups (x : xs) = (if member x xs then remdups xs else x : remdups xs); - -remove1 :: forall a. (Eq a) => a -> [a] -> [a]; -remove1 x [] = []; -remove1 x (y : xs) = (if x == y then xs else y : remove1 x xs); - -plus_nat :: Nat -> Nat -> Nat; -plus_nat (Suc m) n = plus_nat m (Suc n); -plus_nat Zero n = n; - -size_list :: forall a. [a] -> Nat; -size_list [] = Zero; -size_list (a : list) = plus_nat (size_list list) (Suc Zero); - -split :: forall b c a. (b -> c -> a) -> (b, c) -> a; -split f (a, b) = f a b; - -distinct :: forall a. (Eq a) => [a] -> Bool; -distinct [] = True; -distinct (x : xs) = not (member x xs) && distinct xs; - -list_all :: forall a. (a -> Bool) -> [a] -> Bool; -list_all p [] = True; -list_all p (x : xs) = p x && list_all p xs; - -list_rec :: forall t a. t -> (a -> [a] -> t -> t) -> [a] -> t; -list_rec f1 f2 [] = f1; -list_rec f1 f2 (a : list) = f2 a list (list_rec f1 f2 list); - -char_size :: Chara -> Nat; -char_size c = Zero; - -dropWhilea :: forall a. (a -> Bool) -> [a] -> [a]; -dropWhilea p [] = []; -dropWhilea p (x : xs) = (if p x then dropWhilea p xs else x : xs); - -option_case :: forall t a. t -> (a -> t) -> Maybe a -> t; -option_case f1 f2 (Just a) = f2 a; -option_case f1 f2 Nothing = f1; - -filtermap :: forall a b. (a -> Maybe b) -> [a] -> [b]; -filtermap f [] = []; -filtermap f (x : xs) = - (case f x of { - Nothing -> filtermap f xs; - Just y -> y : filtermap f xs; - }); - -list_all2 :: forall a b. (a -> b -> Bool) -> [a] -> [b] -> Bool; -list_all2 p (x : xs) (y : ys) = p x y && list_all2 p xs ys; -list_all2 p xs [] = nulla xs; -list_all2 p [] ys = nulla ys; - -list_size :: forall a. (a -> Nat) -> [a] -> Nat; -list_size fa [] = Zero; -list_size fa (a : list) = - plus_nat (plus_nat (fa a) (list_size fa list)) (Suc Zero); - -partition :: forall a. (a -> Bool) -> [a] -> ([a], [a]); -partition p [] = ([], []); -partition p (x : xs) = - let { - a = partition p xs; - (yes, no) = a; - } in (if p x then (x : yes, no) else (yes, x : no)); - -removeAll :: forall a. (Eq a) => a -> [a] -> [a]; -removeAll x [] = []; -removeAll x (y : xs) = - (if x == y then removeAll x xs else y : removeAll x xs); - -replicatea :: forall a. Nat -> a -> [a]; -replicatea Zero x = []; -replicatea (Suc n) x = x : replicatea n x; - -size_char :: Chara -> Nat; -size_char c = Zero; - -takeWhilea :: forall a. (a -> Bool) -> [a] -> [a]; -takeWhilea p [] = []; -takeWhilea p (x : xs) = (if p x then x : takeWhilea p xs else []); - -list_inter :: forall a. (Eq a) => [a] -> [a] -> [a]; -list_inter [] bs = []; -list_inter (a : asa) bs = - (if member a bs then a : list_inter asa bs else list_inter asa bs); - -map_filter :: forall a b. (a -> b) -> (a -> Bool) -> [a] -> [b]; -map_filter f p [] = []; -map_filter f p (x : xs) = - (if p x then f x : map_filter f p xs else map_filter f p xs); - -nibble_rec :: - forall t. - t -> t -> t -> t -> t -> t -> t -> -t -> t -> t -> t -> t -> t -> t -> t -> t -> Nibble -> t; -nibble_rec f1 f2 f3 f4 f5 f6 f7 f8 f9 f10 f11 f12 f13 f14 f15 f16 - Nibble0 = f1; -nibble_rec f1 f2 f3 f4 f5 f6 f7 f8 f9 f10 f11 f12 f13 f14 f15 f16 - Nibble1 = f2; -nibble_rec f1 f2 f3 f4 f5 f6 f7 f8 f9 f10 f11 f12 f13 f14 f15 f16 - Nibble2 = f3; -nibble_rec f1 f2 f3 f4 f5 f6 f7 f8 f9 f10 f11 f12 f13 f14 f15 f16 - Nibble3 = f4; -nibble_rec f1 f2 f3 f4 f5 f6 f7 f8 f9 f10 f11 f12 f13 f14 f15 f16 - Nibble4 = f5; -nibble_rec f1 f2 f3 f4 f5 f6 f7 f8 f9 f10 f11 f12 f13 f14 f15 f16 - Nibble5 = f6; -nibble_rec f1 f2 f3 f4 f5 f6 f7 f8 f9 f10 f11 f12 f13 f14 f15 f16 - Nibble6 = f7; -nibble_rec f1 f2 f3 f4 f5 f6 f7 f8 f9 f10 f11 f12 f13 f14 f15 f16 - Nibble7 = f8; -nibble_rec f1 f2 f3 f4 f5 f6 f7 f8 f9 f10 f11 f12 f13 f14 f15 f16 - Nibble8 = f9; -nibble_rec f1 f2 f3 f4 f5 f6 f7 f8 f9 f10 f11 f12 f13 f14 f15 f16 - Nibble9 = f10; -nibble_rec f1 f2 f3 f4 f5 f6 f7 f8 f9 f10 f11 f12 f13 f14 f15 f16 - NibbleA = f11; -nibble_rec f1 f2 f3 f4 f5 f6 f7 f8 f9 f10 f11 f12 f13 f14 f15 f16 - NibbleB = f12; -nibble_rec f1 f2 f3 f4 f5 f6 f7 f8 f9 f10 f11 f12 f13 f14 f15 f16 - NibbleC = f13; -nibble_rec f1 f2 f3 f4 f5 f6 f7 f8 f9 f10 f11 f12 f13 f14 f15 f16 - NibbleD = f14; -nibble_rec f1 f2 f3 f4 f5 f6 f7 f8 f9 f10 f11 f12 f13 f14 f15 f16 - NibbleE = f15; -nibble_rec f1 f2 f3 f4 f5 f6 f7 f8 f9 f10 f11 f12 f13 f14 f15 f16 - NibbleF = f16; - -itself_char :: Itself Chara; -itself_char = Type; - -itself_list :: forall a. Itself [a]; -itself_list = Type; - -list_update :: forall a. [a] -> Nat -> a -> [a]; -list_update [] i v = []; -list_update (x : xs) i v = - (case i of { - Zero -> v : xs; - Suc j -> x : list_update xs j v; - }); - -nibble_case :: - forall t. - t -> t -> t -> t -> t -> t -> t -> -t -> t -> t -> t -> t -> t -> t -> t -> t -> Nibble -> t; -nibble_case f1 f2 f3 f4 f5 f6 f7 f8 f9 f10 f11 f12 f13 f14 f15 f16 - NibbleF = f16; -nibble_case f1 f2 f3 f4 f5 f6 f7 f8 f9 f10 f11 f12 f13 f14 f15 f16 - NibbleE = f15; -nibble_case f1 f2 f3 f4 f5 f6 f7 f8 f9 f10 f11 f12 f13 f14 f15 f16 - NibbleD = f14; -nibble_case f1 f2 f3 f4 f5 f6 f7 f8 f9 f10 f11 f12 f13 f14 f15 f16 - NibbleC = f13; -nibble_case f1 f2 f3 f4 f5 f6 f7 f8 f9 f10 f11 f12 f13 f14 f15 f16 - NibbleB = f12; -nibble_case f1 f2 f3 f4 f5 f6 f7 f8 f9 f10 f11 f12 f13 f14 f15 f16 - NibbleA = f11; -nibble_case f1 f2 f3 f4 f5 f6 f7 f8 f9 f10 f11 f12 f13 f14 f15 f16 - Nibble9 = f10; -nibble_case f1 f2 f3 f4 f5 f6 f7 f8 f9 f10 f11 f12 f13 f14 f15 f16 - Nibble8 = f9; -nibble_case f1 f2 f3 f4 f5 f6 f7 f8 f9 f10 f11 f12 f13 f14 f15 f16 - Nibble7 = f8; -nibble_case f1 f2 f3 f4 f5 f6 f7 f8 f9 f10 f11 f12 f13 f14 f15 f16 - Nibble6 = f7; -nibble_case f1 f2 f3 f4 f5 f6 f7 f8 f9 f10 f11 f12 f13 f14 f15 f16 - Nibble5 = f6; -nibble_case f1 f2 f3 f4 f5 f6 f7 f8 f9 f10 f11 f12 f13 f14 f15 f16 - Nibble4 = f5; -nibble_case f1 f2 f3 f4 f5 f6 f7 f8 f9 f10 f11 f12 f13 f14 f15 f16 - Nibble3 = f4; -nibble_case f1 f2 f3 f4 f5 f6 f7 f8 f9 f10 f11 f12 f13 f14 f15 f16 - Nibble2 = f3; -nibble_case f1 f2 f3 f4 f5 f6 f7 f8 f9 f10 f11 f12 f13 f14 f15 f16 - Nibble1 = f2; -nibble_case f1 f2 f3 f4 f5 f6 f7 f8 f9 f10 f11 f12 f13 f14 f15 f16 - Nibble0 = f1; - -nibble_size :: Nibble -> Nat; -nibble_size Nibble0 = Zero; -nibble_size Nibble1 = Zero; -nibble_size Nibble2 = Zero; -nibble_size Nibble3 = Zero; -nibble_size Nibble4 = Zero; -nibble_size Nibble5 = Zero; -nibble_size Nibble6 = Zero; -nibble_size Nibble7 = Zero; -nibble_size Nibble8 = Zero; -nibble_size Nibble9 = Zero; -nibble_size NibbleA = Zero; -nibble_size NibbleB = Zero; -nibble_size NibbleC = Zero; -nibble_size NibbleD = Zero; -nibble_size NibbleE = Zero; -nibble_size NibbleF = Zero; - -size_nibble :: Nibble -> Nat; -size_nibble Nibble0 = Zero; -size_nibble Nibble1 = Zero; -size_nibble Nibble2 = Zero; -size_nibble Nibble3 = Zero; -size_nibble Nibble4 = Zero; -size_nibble Nibble5 = Zero; -size_nibble Nibble6 = Zero; -size_nibble Nibble7 = Zero; -size_nibble Nibble8 = Zero; -size_nibble Nibble9 = Zero; -size_nibble NibbleA = Zero; -size_nibble NibbleB = Zero; -size_nibble NibbleC = Zero; -size_nibble NibbleD = Zero; -size_nibble NibbleE = Zero; -size_nibble NibbleF = Zero; - -itself_nibble :: Itself Nibble; -itself_nibble = Type; - -length_unique :: forall a. (Eq a) => [a] -> Nat; -length_unique [] = Zero; -length_unique (x : xs) = - (if member x xs then length_unique xs else Suc (length_unique xs)); - -successor_int :: Inta -> Inta; -successor_int = (\ i -> plus_int i (Number_of_int (Bit1 Pls))); - -} diff --git a/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/ex/src_hs/ListsAndMaps.hs b/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/ex/src_hs/ListsAndMaps.hs deleted file mode 100644 index 749b2e3f44330513fe6c29c24f8f2220e6d6dfad..0000000000000000000000000000000000000000 --- a/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/ex/src_hs/ListsAndMaps.hs +++ /dev/null @@ -1,348 +0,0 @@ -module ListsAndMaps where { - - -data Inta = Number_of_int Inta | Bit1 Inta | Bit0 Inta | Min | Pls; - -data Nat = Suc Nat | Zero; - -leta :: forall b a. b -> (b -> a) -> a; -leta s f = f s; - -class Orda a where { - less_eq :: a -> a -> Bool; - less :: a -> a -> Bool; -}; - -hd :: forall a. [a] -> a; -hd (x : xs) = x; - -tl :: forall a. [a] -> [a]; -tl (x : xs) = xs; -tl [] = []; - -eqop :: forall a. (Eq a) => a -> a -> Bool; -eqop a = (\ b -> a == b); - -class Plus a where { - plus :: a -> a -> a; -}; - -class Zero a where { - zero :: a; -}; - -preda :: Inta -> Inta; -preda (Bit1 k) = Bit0 k; -preda (Bit0 k) = Bit1 (preda k); -preda Min = Bit0 Min; -preda Pls = Min; - -succa :: Inta -> Inta; -succa (Bit1 k) = Bit0 (succa k); -succa (Bit0 k) = Bit1 k; -succa Min = Pls; -succa Pls = Bit1 Pls; - -data Nibble = NibbleF | NibbleE | NibbleD | NibbleC | NibbleB | NibbleA - | Nibble9 | Nibble8 | Nibble7 | Nibble6 | Nibble5 | Nibble4 | Nibble3 - | Nibble2 | Nibble1 | Nibble0; - -data Chara = Chara Nibble Nibble; - -mapa :: forall b a. (b -> a) -> [b] -> [a]; -mapa f (x : xs) = f x : mapa f xs; -mapa f [] = []; - -nat_case :: forall t. t -> (Nat -> t) -> Nat -> t; -nat_case f1 f2 Zero = f1; -nat_case f1 f2 (Suc nat) = f2 nat; - -nth :: forall a. [a] -> Nat -> a; -nth (x : xs) n = (case n of { - Zero -> x; - Suc a -> nth xs a; - }); - -foldla :: forall a b. (a -> b -> a) -> a -> [b] -> a; -foldla f a (x : xs) = foldla f (f a x) xs; -foldla f a [] = a; - -rev :: forall a. [a] -> [a]; -rev xs = foldla (\ xsa x -> x : xsa) [] xs; - -less_eq_nat :: Nat -> Nat -> Bool; -less_eq_nat (Suc m) n = less_nat m n; -less_eq_nat Zero n = True; - -less_nat :: Nat -> Nat -> Bool; -less_nat m (Suc n) = less_eq_nat m n; -less_nat n Zero = False; - --- No Termination order --- upt :: Nat -> Nat -> [Nat]; --- upt i j = (if less_nat i j then i : upt (Suc i) j else []); - -list_case :: forall t a. t -> (a -> [a] -> t) -> [a] -> t; -list_case f1 f2 [] = f1; -list_case f1 f2 (a : list) = f2 a list; - -zipa :: forall a b. [a] -> [b] -> [(a, b)]; -zipa xs (y : ys) = (case xs of { - [] -> []; - z : zs -> (z, y) : zipa zs ys; - }); -zipa xs [] = []; - -dropa :: forall a. Nat -> [a] -> [a]; -dropa n (x : xs) = (case n of { - Zero -> x : xs; - Suc m -> dropa m xs; - }); -dropa n [] = []; - -nulla :: forall a. [a] -> Bool; -nulla (x : xs) = False; -nulla [] = True; - -lasta :: forall a. [a] -> a; -lasta (x : xs) = (if nulla xs then x else lasta xs); - -class (Orda a) => Order a where { -}; - -class (Order a) => Linorder a where { -}; - -insort :: forall a. (Linorder a) => a -> [a] -> [a]; -insort x (y : ys) = (if less_eq x y then x : y : ys else y : insort x ys); -insort x [] = [x]; - -sort :: forall a. (Linorder a) => [a] -> [a]; -sort (x : xs) = insort x (sort xs); -sort [] = []; - -takea :: forall a. Nat -> [a] -> [a]; -takea n (x : xs) = (case n of { - Zero -> []; - Suc m -> x : takea m xs; - }); -takea n [] = []; - -class (Linorder a) => Finite_intvl_succ a where { - successor :: a -> a; -}; - --- No Termination order --- upto :: forall a. (Finite_intvl_succ a) => a -> a -> [a]; --- upto i j = (if less_eq i j then i : upto (successor i) j else []); - -data Itself a = Type; - -foldra :: forall b a. (b -> a -> a) -> [b] -> a -> a; -foldra f (x : xs) a = f x (foldra f xs a); -foldra f [] a = a; - -map_of :: forall b c. (Eq b) => [(b, c)] -> b -> Maybe c; -map_of ((l, v) : ps) k = (if eqop l k then Just v else map_of ps k); -map_of [] k = Nothing; - -append :: forall a. [a] -> [a] -> [a]; -append (x : xs) ys = x : append xs ys; -append [] ys = ys; - -concata :: forall a. [[a]] -> [a]; -concata (x : xs) = append x (concata xs); -concata [] = []; - -filtera :: forall a. (a -> Bool) -> [a] -> [a]; -filtera p (x : xs) = (if p x then x : filtera p xs else filtera p xs); -filtera p [] = []; - -member :: forall a. (Eq a) => a -> [a] -> Bool; -member x (y : ys) = (if eqop y x then True else member x ys); -member x [] = False; - -rotate1 :: forall a. [a] -> [a]; -rotate1 xs = (case xs of { - [] -> []; - x : xsa -> append xsa [x]; - }); - -fun_pow :: forall a. Nat -> (a -> a) -> a -> a; -fun_pow (Suc n) f = f . fun_pow n f; -fun_pow Zero f = id; - -rotate :: forall a. Nat -> [a] -> [a]; -rotate n = fun_pow n rotate1; - -sorted :: forall a. (Linorder a) => [a] -> Bool; -sorted (x : y : zs) = less_eq x y && sorted (y : zs); -sorted [x] = True; -sorted [] = True; - -splice :: forall a. [a] -> [a] -> [a]; -splice (x : xs) (y : ys) = x : y : splice xs ys; -splice xs [] = xs; -splice [] ys = ys; - -option_case :: forall t a. t -> (a -> t) -> Maybe a -> t; -option_case f1 f2 Nothing = f1; -option_case f1 f2 (Just a) = f2 a; - -map_add :: forall a b. (a -> Maybe b) -> (a -> Maybe b) -> a -> Maybe b; -map_add m1 m2 = - (\ x -> (case m2 x of { - Nothing -> m1 x; - Just a -> Just a; - })); - -plus_int :: Inta -> Inta -> Inta; -plus_int (Number_of_int v) (Number_of_int w) = Number_of_int (plus_int v w); -plus_int (Bit1 k) (Bit1 l) = Bit0 (plus_int k (succa l)); -plus_int (Bit1 k) (Bit0 l) = Bit1 (plus_int k l); -plus_int (Bit0 k) (Bit1 l) = Bit1 (plus_int k l); -plus_int (Bit0 k) (Bit0 l) = Bit0 (plus_int k l); -plus_int k Min = preda k; -plus_int k Pls = k; -plus_int Min k = preda k; -plus_int Pls k = k; - -butlast :: forall a. [a] -> [a]; -butlast (x : xs) = (if nulla xs then [] else x : butlast xs); -butlast [] = []; - -list_ex :: forall a. (a -> Bool) -> [a] -> Bool; -list_ex p (x : xs) = p x || list_ex p xs; -list_ex p [] = False; - -class (Plus a) => Semigroup_add a where { -}; - -class (Zero a, Semigroup_add a) => Monoid_add a where { -}; - -listsum :: forall a. (Monoid_add a) => [a] -> a; -listsum (x : xs) = plus x (foldla plus zero xs); -listsum [] = zero; - -remdups :: forall a. (Eq a) => [a] -> [a]; -remdups (x : xs) = (if member x xs then remdups xs else x : remdups xs); -remdups [] = []; - -remove1 :: forall a. (Eq a) => a -> [a] -> [a]; -remove1 x (y : xs) = (if eqop x y then xs else y : remove1 x xs); -remove1 x [] = []; - -map_comp :: forall b c a. (b -> Maybe c) -> (a -> Maybe b) -> a -> Maybe c; -map_comp f g = (\ k -> (case g k of { - Nothing -> Nothing; - Just a -> f a; - })); - -map_upds :: forall a b. (Eq a) => (a -> Maybe b) -> [a] -> [b] -> a -> Maybe b; -map_upds m xs ys = map_add m (map_of (rev (zipa xs ys))); - -plus_nat :: Nat -> Nat -> Nat; -plus_nat (Suc m) n = plus_nat m (Suc n); -plus_nat Zero n = n; - -char_rec :: forall t. (Nibble -> Nibble -> t) -> Chara -> t; -char_rec f1 (Chara nibble1 nibble2) = f1 nibble1 nibble2; - -distinct :: forall a. (Eq a) => [a] -> Bool; -distinct (x : xs) = not (member x xs) && distinct xs; -distinct [] = True; - -list_all :: forall a. (a -> Bool) -> [a] -> Bool; -list_all p (x : xs) = p x && list_all p xs; -list_all p [] = True; - -list_rec :: forall t a. t -> (a -> [a] -> t -> t) -> [a] -> t; -list_rec f1 f2 (a : list) = f2 a list (list_rec f1 f2 list); -list_rec f1 f2 [] = f1; - -char_case :: forall t. (Nibble -> Nibble -> t) -> Chara -> t; -char_case f1 (Chara nibble1 nibble2) = f1 nibble1 nibble2; - -char_size :: Chara -> Nat; -char_size (Chara nibble1 nibble2) = Zero; - -dropWhilea :: forall a. (a -> Bool) -> [a] -> [a]; -dropWhilea p (x : xs) = (if p x then dropWhilea p xs else x : xs); -dropWhilea p [] = []; - -filtermap :: forall a b. (a -> Maybe b) -> [a] -> [b]; -filtermap f (x : xs) = - (case f x of { - Nothing -> filtermap f xs; - Just y -> y : filtermap f xs; - }); -filtermap f [] = []; - -list_all2 :: forall a b. (a -> b -> Bool) -> [a] -> [b] -> Bool; -list_all2 p (x : xs) (y : ys) = p x y && list_all2 p xs ys; -list_all2 p xs [] = nulla xs; -list_all2 p [] ys = nulla ys; - -list_size :: forall a. (a -> Nat) -> [a] -> Nat; -list_size fa (a : list) = - plus_nat (plus_nat (fa a) (list_size fa list)) (Suc Zero); -list_size fa [] = Zero; - -split :: forall b c a. (b -> c -> a) -> (b, c) -> a; -split f (a, b) = f a b; - -partition :: forall a. (a -> Bool) -> [a] -> ([a], [a]); -partition p (x : xs) = - let { - a = partition p xs; - (yes, no) = a; - } in (if p x then (x : yes, no) else (yes, x : no)); -partition p [] = ([], []); - -replicatea :: forall a. Nat -> a -> [a]; -replicatea (Suc n) x = x : replicatea n x; -replicatea Zero x = []; - -size_char :: Chara -> Nat; -size_char (Chara nibble1 nibble2) = Zero; - -size_list :: forall a. [a] -> Nat; -size_list (a : list) = plus_nat (size_list list) (Suc Zero); -size_list [] = Zero; - -takeWhilea :: forall a. (a -> Bool) -> [a] -> [a]; -takeWhilea p (x : xs) = (if p x then x : takeWhilea p xs else []); -takeWhilea p [] = []; - -list_inter :: forall a. (Eq a) => [a] -> [a] -> [a]; -list_inter (a : asa) bs = - (if member a bs then a : list_inter asa bs else list_inter asa bs); -list_inter [] bs = []; - -map_filter :: forall a b. (a -> b) -> (a -> Bool) -> [a] -> [b]; -map_filter f p (x : xs) = - (if p x then f x : map_filter f p xs else map_filter f p xs); -map_filter f p [] = []; - -itself_char :: Itself Chara; -itself_char = Type; - -itself_list :: forall a. Itself [a]; -itself_list = Type; - -list_update :: forall a. [a] -> Nat -> a -> [a]; -list_update (x : xs) i v = - (case i of { - Zero -> v : xs; - Suc j -> x : list_update xs j v; - }); -list_update [] i v = []; - -itself_nibble :: Itself Nibble; -itself_nibble = Type; - -successor_int :: Inta -> Inta; -successor_int = (\ i -> plus_int i (Number_of_int (Bit1 Pls))); - -} diff --git a/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/ex/src_hs/Monads.hs.disabled b/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/ex/src_hs/Monads.hs.disabled deleted file mode 100644 index a16860d9cb1e8b2b99883638717b39c6d86afd60..0000000000000000000000000000000000000000 --- a/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/ex/src_hs/Monads.hs.disabled +++ /dev/null @@ -1,38 +0,0 @@ -module Monads - (module Monads, - module Control.Monad) -where - -import Control.Monad - -newtype StateM a = StateM ( Int -> (a,Int) ) - -instance Monad StateM where - (StateM f') >>= g = StateM (\s -> let (r,s') = f' s - StateM g' = g r - in g' s') - return v = StateM (\s -> (v,s)) - -put :: Int -> StateM () -put state = StateM (\_ -> ((),state)) - -get :: StateM Int -get = StateM (\s -> (s,s)) - -newtype ErrorM a = ErrorM (StateM (Either String a)) - -instance Monad ErrorM where - (ErrorM f') >>= g = ErrorM comb - where comb = do r <- f' - case r of - Left e -> return (Left e) - Right v -> let ErrorM g' = g v - in g' - return v = ErrorM (return (Right v)) - -lift :: StateM a -> ErrorM a -lift sm = ErrorM (sm >>= (return . Right)) - - -throwError :: String -> ErrorM a -throwError e = ErrorM (return (Left e)) diff --git a/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/ex/src_hs/MutualRecursion.hs b/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/ex/src_hs/MutualRecursion.hs deleted file mode 100644 index 23a09962b5756c36957a1778239ea5ff9adb3f6d..0000000000000000000000000000000000000000 --- a/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/ex/src_hs/MutualRecursion.hs +++ /dev/null @@ -1,17 +0,0 @@ -module MutualRecursion where - -evalExp :: Exp -> Int -evalExp (Plus e1 e2) = evalExp e1 + evalExp e2 -evalExp (Times e1 e2) = evalExp e1 * evalExp e2 -evalExp (Cond b e1 e2) - | evalBexp b = evalExp e1 - | otherwise = evalExp e2 -evalExp (Val i) = i - -evalBexp :: Bexp -> Bool -evalBexp (Equal e1 e2) = evalExp e1 == evalExp e2 -evalBexp (Greater e1 e2) = evalExp e1 > evalExp e2 - -data Exp = Plus Exp Exp | Times Exp Exp | Cond Bexp Exp Exp | Val Int - -data Bexp = Equal Exp Exp | Greater Exp Exp diff --git a/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/ex/src_hs/Nats.hs b/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/ex/src_hs/Nats.hs deleted file mode 100644 index ab8bdc39b7ebfed625bef1b31d1c894fddb943c1..0000000000000000000000000000000000000000 --- a/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/ex/src_hs/Nats.hs +++ /dev/null @@ -1,54 +0,0 @@ -module Nats where - - -data Nat = Suc Nat | Zero deriving Show - -eq_nat :: Nat -> Nat -> Bool -eq_nat Zero Zero = True -eq_nat (Suc m) (Suc n) = eq_nat m n -eq_nat Zero (Suc a) = False -eq_nat (Suc a) Zero = False - -instance Eq Nat where - (==) = eq_nat - -less_eq_nat :: Nat -> Nat -> Bool -less_eq_nat (Suc m) n = less_nat m n -less_eq_nat Zero n = True - -less_nat :: Nat -> Nat -> Bool -less_nat m (Suc n) = less_eq_nat m n -less_nat n Zero = False - -greater_nat :: Nat -> Nat -> Bool -greater_nat m n = not (less_eq_nat m n) - -mina :: Nat -> Nat -> Nat -mina a b = (if less_eq_nat a b then a else b) - -nat_rec :: t -> (Nat -> t -> t) -> Nat -> t -nat_rec f1 f2 (Suc n) = f2 n (nat_rec f1 f2 n) -nat_rec f1 f2 Zero = f1 - -one_nat :: Nat -one_nat = Suc Zero - -maxa :: Nat -> Nat -> Nat -maxa a b = (if less_eq_nat a b then b else a) - -nat_case :: t -> (Nat -> t) -> Nat -> t -nat_case f1 f2 Zero = f1 -nat_case f1 f2 (Suc n) = f2 n - -plus_nat :: Nat -> Nat -> Nat -plus_nat (Suc m) n = plus_nat m (Suc n) -plus_nat Zero n = n - -minus_nat :: Nat -> Nat -> Nat -minus_nat (Suc m) (Suc n) = minus_nat m n -minus_nat Zero n = Zero -minus_nat m Zero = m - -times_nat :: Nat -> Nat -> Nat -times_nat (Suc m) n = plus_nat n (times_nat m n) -times_nat Zero n = Zero diff --git a/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/ex/src_hs/Primitive.hs b/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/ex/src_hs/Primitive.hs deleted file mode 100644 index 10bc221b65932abe6ae4cc35e312a0e980c2078d..0000000000000000000000000000000000000000 --- a/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/ex/src_hs/Primitive.hs +++ /dev/null @@ -1,30 +0,0 @@ -module Primitive where - -data Nat = Zero | Succ Nat - -id :: a -> a -id x = x - -foo :: a -> a -foo = \x -> x - -incr :: Nat -> Nat -incr n = Succ n - -decr :: Nat -> Nat -decr (Succ n) = n - - --- The following is to test mutually-recursive function definitions. - -data Boolean = Verum | Falsum - -isEven :: Nat -> Boolean -isEven Zero = Verum -isEven (Succ Zero) = Falsum -isEven n = isOdd (decr n) - -isOdd :: Nat -> Boolean -isOdd Zero = Falsum -isOdd (Succ Zero) = Verum -isOdd n = isEven (decr n) \ No newline at end of file diff --git a/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/ex/src_hs/Radix.hs b/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/ex/src_hs/Radix.hs deleted file mode 100644 index 38daaf7f18350e948d75920f362483798d4a25c0..0000000000000000000000000000000000000000 --- a/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/ex/src_hs/Radix.hs +++ /dev/null @@ -1,17 +0,0 @@ -module Radix where - -import Nats - -divmod :: Nat -> Nat -> (Nat, Nat) ; {-# HASKABELLE permissive divmod #-} -divmod m n = if eq_nat n Zero || less_nat m n then (Zero, m) - else let (q, r) = divmod (minus_nat m n) n - in (Suc q, r) - -radix :: (Nat -> a) -> Nat -> Nat -> [a] ; {-# HASKABELLE permissive radix rad0 #-} -radix ch _ Zero = [ch Zero] -radix ch r n = reverse (rad ch r n) where - rad _ _ Zero = [] - rad ch r n = let (m, d) = divmod n r in ch d : rad ch r m - -radix_10 :: Nat -> [Nat] -radix_10 = radix id (Suc (Suc (Suc (Suc (Suc (Suc (Suc (Suc (Suc (Suc Zero)))))))))) diff --git a/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/ex/src_hs/Rationals.hs b/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/ex/src_hs/Rationals.hs deleted file mode 100644 index 4c0efeb3517a948ca84103d86ca9c34ef8cec622..0000000000000000000000000000000000000000 --- a/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/ex/src_hs/Rationals.hs +++ /dev/null @@ -1,563 +0,0 @@ -{-# OPTIONS_GHC -fglasgow-exts #-} - -module Rationals where { - - -data Nat = Zero | Suc Nat; - -leta :: forall b a. b -> (b -> a) -> a; -leta s f = f s; - -class One a where { - one :: a; -}; - -class Orda a where { - less_eq :: a -> a -> Bool; - less :: a -> a -> Bool; -}; - -nat_aux :: Integer -> Nat -> Nat; -nat_aux i n = (if i <= 0 then n else nat_aux (i - 1) (Suc n)); - -nat :: Integer -> Nat; -nat i = nat_aux i Zero; - -class Plus a where { - plus :: a -> a -> a; -}; - -class Zero a where { - zero :: a; -}; - -class Minus a where { - minus :: a -> a -> a; -}; - -class Times a where { - times :: a -> a -> a; -}; - -data Itself a = Type; - -class Inverse a where { - inverse :: a -> a; - divide :: a -> a -> a; -}; - -class Uminus a where { - neg :: a -> a; -}; - -instance Times Integer where { - times a b = a * b; -}; - -class (Times a) => Dvd a where { -}; - -instance Dvd Integer where { -}; - -class (One a, Zero a) => Zero_neq_one a where { -}; - -class (Times a) => Semigroup_mult a where { -}; - -class (Plus a) => Semigroup_add a where { -}; - -class (Semigroup_add a) => Ab_semigroup_add a where { -}; - -class (Ab_semigroup_add a, Semigroup_mult a) => Semiring a where { -}; - -class (Times a, Zero a) => Mult_zero a where { -}; - -class (Zero a, Semigroup_add a) => Monoid_add a where { -}; - -class (Ab_semigroup_add a, Monoid_add a) => Comm_monoid_add a where { -}; - -class (Comm_monoid_add a, Mult_zero a, Semiring a) => Semiring_0 a where { -}; - -class (Semigroup_add a) => Cancel_semigroup_add a where { -}; - -class (Ab_semigroup_add a, - Cancel_semigroup_add a) => Cancel_ab_semigroup_add a where { -}; - -class (Cancel_ab_semigroup_add a, - Comm_monoid_add a) => Cancel_comm_monoid_add a where { -}; - -class (Cancel_comm_monoid_add a, Semiring_0 a) => Semiring_0_cancel a where { -}; - -class (One a, Times a) => Power a where { -}; - -class (Semigroup_mult a, Power a) => Monoid_mult a where { -}; - -class (Monoid_mult a, Semiring_0 a, Zero_neq_one a) => Semiring_1 a where { -}; - -class (Semiring_0_cancel a, Semiring_1 a) => Semiring_1_cancel a where { -}; - -split :: forall b c a. (b -> c -> a) -> (b, c) -> a; -split f (a, b) = f a b; - -abs_int :: Integer -> Integer; -abs_int i = (if i < 0 then negate i else i); - -sgn_int :: Integer -> Integer; -sgn_int i = (if i == 0 then 0 else (if 0 < i then 1 else negate 1)); - -apsnd :: forall c b a. (c -> b) -> (a, c) -> (a, b); -apsnd f (x, y) = (x, f y); - -divmod_int :: Integer -> Integer -> (Integer, Integer); {-# HASKABELLE permissive divmod_int divmod'0 #-}; -divmod_int k l = - (if k == 0 then (0, 0) - else (if l == 0 then (0, k) - else apsnd (\ a -> sgn_int l * a) - (if sgn_int k == sgn_int l - then (\k l -> divmod' (abs k) (abs l)) k l - else let { - (r, s) = (\k l -> divmod' (abs k) (abs l)) k l; - } in (if s == 0 then (negate r, 0) - else (negate r - 1, abs_int l - s))))) where { - divmod' k l = if l == 0 || k < l then (0, k) - else let (q, r) = divmod' (k - l) l in (q + 1, r); - }; - -class (Minus a, Uminus a, Monoid_add a) => Group_add a where { -}; - -class (Cancel_comm_monoid_add a, Group_add a) => Ab_group_add a where { -}; - -class (Ab_group_add a, Semiring_0_cancel a) => Ring a where { -}; - -class (Ring a, Semiring_1_cancel a) => Ring_1 a where { -}; - -of_int :: forall a. (Ring_1 a) => Integer -> a; {-# HASKABELLE permissive of_int #-}; -of_int k = - (if k == 0 then zero - else (if k < 0 then neg (of_int (negate k)) - else let { - (l, m) = divmod_int k 2; - l' = of_int l; - } in (if m == 0 then plus l' l' else plus (plus l' l') one))); - -instance One Integer where { - one = 1; -}; - -eq_nat :: Nat -> Nat -> Bool; -eq_nat (Suc nat') Zero = False; -eq_nat Zero (Suc nat') = False; -eq_nat (Suc nat) (Suc nat') = eq_nat nat nat'; -eq_nat Zero Zero = True; - -of_nat_aux :: forall a. (Semiring_1 a) => (a -> a) -> Nat -> a -> a; -of_nat_aux inc Zero i = i; -of_nat_aux inc (Suc n) i = of_nat_aux inc n (inc i); - -of_nat :: forall a. (Semiring_1 a) => Nat -> a; {-# HASKABELLE permissive of_nat #-}; -of_nat n = of_nat_aux (\ i -> plus i one) n zero; - -data Nibble = Nibble0 | Nibble1 | Nibble2 | Nibble3 | Nibble4 | Nibble5 - | Nibble6 | Nibble7 | Nibble8 | Nibble9 | NibbleA | NibbleB | NibbleC - | NibbleD | NibbleE | NibbleF; - -data Chara = Chara Nibble Nibble; - -class (Dvd a) => Div a where { - diva :: a -> a -> a; - moda :: a -> a -> a; -}; - -minus_nat :: Nat -> Nat -> Nat; -minus_nat (Suc m) (Suc n) = minus_nat m n; -minus_nat Zero n = Zero; -minus_nat m Zero = m; - -less_eq_nat :: Nat -> Nat -> Bool; -less_eq_nat (Suc m) n = less_nat m n; -less_eq_nat Zero n = True; - -less_nat :: Nat -> Nat -> Bool; -less_nat m (Suc n) = less_eq_nat m n; -less_nat n Zero = False; - -divmod :: Nat -> Nat -> (Nat, Nat); {-# HASKABELLE permissive divmod #-}; -divmod m n = - (if eq_nat n Zero || less_nat m n then (Zero, m) - else let { - (q, a) = divmod (minus_nat m n) n; - } in (Suc q, a)); - -mod_nat :: Nat -> Nat -> Nat; -mod_nat m n = snd (divmod m n); - -gcd_nat :: Nat -> Nat -> Nat; {-# HASKABELLE permissive gcd_nat #-}; -gcd_nat x y = (if eq_nat y Zero then x else gcd_nat y (mod_nat x y)); - -instance Zero Integer where { - zero = 1; -}; - -instance Zero_neq_one Integer where { -}; - -instance Semigroup_mult Integer where { -}; - -instance Plus Integer where { - plus a b = a + b; -}; - -instance Semigroup_add Integer where { -}; - -instance Ab_semigroup_add Integer where { -}; - -instance Semiring Integer where { -}; - -instance Mult_zero Integer where { -}; - -instance Monoid_add Integer where { -}; - -instance Comm_monoid_add Integer where { -}; - -instance Semiring_0 Integer where { -}; - -instance Power Integer where { -}; - -instance Monoid_mult Integer where { -}; - -instance Semiring_1 Integer where { -}; - -gcd_int :: Integer -> Integer -> Integer; -gcd_int x y = of_nat (gcd_nat (nat (abs_int x)) (nat (abs_int y))); - -data Rat = Fract Integer Integer; - -collect :: forall a. (a -> Bool) -> a -> Bool; -collect p = p; - -scomp :: forall a c d b. (a -> (c, d)) -> (c -> d -> b) -> a -> b; -scomp f g = (\ x -> let { - (a, b) = f x; - } in g a b); - -data Typerep = Typerep String [Typerep]; - -data Term = Const String Typerep | App Term Term; - -mod_int :: Integer -> Integer -> Integer; -mod_int a b = snd (divmod_int a b); - -div_int :: Integer -> Integer -> Integer; -div_int a b = fst (divmod_int a b); - -instance Div Integer where { - diva = div_int; - moda = mod_int; -}; - -maxaa :: forall a. (a -> a -> Bool) -> a -> a -> a; -maxaa less_eq a b = (if less_eq a b then b else a); - -maxa :: forall a. (Orda a) => a -> a -> a; -maxa = maxaa less_eq; - -minaa :: forall a. (a -> a -> Bool) -> a -> a -> a; -minaa less_eq a b = (if less_eq a b then a else b); - -mina :: forall a. (Orda a) => a -> a -> a; -mina = minaa less_eq; - -class (Semiring_1 a) => Semiring_char_0 a where { -}; - -class (Semiring_char_0 a, Ring_1 a) => Ring_char_0 a where { -}; - -eq_rat :: Rat -> Rat -> Bool; -eq_rat (Fract a b) (Fract c d) = - (if b == 0 then c == 0 || d == 0 - else (if d == 0 then a == 0 || b == 0 else a * d == b * c)); - -class (Times a, Zero a) => No_zero_divisors a where { -}; - -class (No_zero_divisors a, Ring a) => Ring_no_zero_divisors a where { -}; - -class (Ring_1 a, Ring_no_zero_divisors a) => Ring_1_no_zero_divisors a where { -}; - -class (Inverse a, Ring_1_no_zero_divisors a) => Division_ring a where { -}; - -class (Semigroup_mult a) => Ab_semigroup_mult a where { -}; - -class (Ab_semigroup_mult a, Semiring a) => Comm_semiring a where { -}; - -class (Comm_semiring a, Semiring_0 a) => Comm_semiring_0 a where { -}; - -class (Ab_semigroup_mult a, Monoid_mult a) => Comm_monoid_mult a where { -}; - -class (Comm_monoid_mult a, Comm_semiring_0 a, Dvd a, - Semiring_1 a) => Comm_semiring_1 a where { -}; - -class (Comm_semiring_0 a, - Semiring_0_cancel a) => Comm_semiring_0_cancel a where { -}; - -class (Comm_semiring_0_cancel a, Comm_semiring_1 a, - Semiring_1_cancel a) => Comm_semiring_1_cancel a where { -}; - -class (Comm_semiring_0_cancel a, Ring a) => Comm_ring a where { -}; - -class (Comm_ring a, Comm_semiring_1_cancel a, Ring_1 a) => Comm_ring_1 a where { -}; - -class (Comm_ring_1 a, Ring_1_no_zero_divisors a) => Idom a where { -}; - -class (Division_ring a, Idom a) => Field a where { -}; - -class (Ring_char_0 a, Field a) => Field_char_0 a where { -}; - -of_rat :: forall a. (Field_char_0 a) => Rat -> a; {-# HASKABELLE permissive of_rat #-}; -of_rat (Fract a b) = - (if not (b == 0) then divide (of_int a) (of_int b) else zero); - -one_rat :: Rat; -one_rat = Fract 1 1; - -instance One Rat where { - one = one_rat; -}; - -less_rat :: Rat -> Rat -> Bool; -less_rat (Fract a b) (Fract c d) = - (if b == 0 then 0 < sgn_int c * sgn_int d - else (if d == 0 then sgn_int a * sgn_int b < 0 - else (a * abs_int d * sgn_int b) < (c * abs_int b * sgn_int d))); - -less_eq_rat :: Rat -> Rat -> Bool; -less_eq_rat (Fract a b) (Fract c d) = - (if b == 0 then 0 <= sgn_int c * sgn_int d - else (if d == 0 then sgn_int a * sgn_int b <= 0 - else (a * abs_int d * sgn_int b) <= (c * abs_int b * sgn_int d))); - -instance Orda Rat where { - less_eq = less_eq_rat; - less = less_rat; -}; - -abs_rat :: Rat -> Rat; -abs_rat (Fract a b) = Fract (abs_int a) (abs_int b); - -inf_rat :: Rat -> Rat -> Rat; -inf_rat = mina; - -fract_norm :: Integer -> Integer -> Rat; -fract_norm a b = - (if a == 0 || b == 0 then Fract 0 1 - else let { - c = gcd_int a b; - } in (if 0 < b then Fract (div_int a c) (div_int b c) - else Fract (negate (div_int a c)) (negate (div_int b c)))); - -plus_rat :: Rat -> Rat -> Rat; -plus_rat (Fract a b) (Fract c d) = - (if b == 0 then Fract c d - else (if d == 0 then Fract a b else fract_norm (a * d + c * b) (b * d))); - -instance Plus Rat where { - plus = plus_rat; -}; - -times_rat :: Rat -> Rat -> Rat; -times_rat (Fract a b) (Fract c d) = fract_norm (a * c) (b * d); - -instance Times Rat where { - times = times_rat; -}; - -instance Semigroup_mult Rat where { -}; - -instance Semigroup_add Rat where { -}; - -instance Ab_semigroup_add Rat where { -}; - -instance Semiring Rat where { -}; - -zero_rat :: Rat; -zero_rat = Fract 0 1; - -instance Zero Rat where { - zero = zero_rat; -}; - -instance Mult_zero Rat where { -}; - -instance Monoid_add Rat where { -}; - -instance Comm_monoid_add Rat where { -}; - -instance Semiring_0 Rat where { -}; - -instance Cancel_semigroup_add Rat where { -}; - -instance Cancel_ab_semigroup_add Rat where { -}; - -instance Cancel_comm_monoid_add Rat where { -}; - -instance Semiring_0_cancel Rat where { -}; - -neg_rat :: Rat -> Rat; -neg_rat (Fract a b) = Fract (negate a) b; - -instance Uminus Rat where { - neg = neg_rat; -}; - -minus_rat :: Rat -> Rat -> Rat; -minus_rat (Fract a b) (Fract c d) = - (if b == 0 then Fract (negate c) d - else (if d == 0 then Fract a b else fract_norm (a * d - c * b) (b * d))); - -instance Minus Rat where { - minus = minus_rat; -}; - -instance Group_add Rat where { -}; - -instance Ab_group_add Rat where { -}; - -instance Ring Rat where { -}; - -instance Zero_neq_one Rat where { -}; - -instance Power Rat where { -}; - -instance Monoid_mult Rat where { -}; - -instance Semiring_1 Rat where { -}; - -instance Semiring_1_cancel Rat where { -}; - -instance Ring_1 Rat where { -}; - -sgn_rat :: Rat -> Rat; -sgn_rat (Fract a b) = of_int (sgn_int a * sgn_int b); - -sup_rat :: Rat -> Rat -> Rat; -sup_rat = maxa; - -divide_rat :: Rat -> Rat -> Rat; -divide_rat (Fract a b) (Fract c d) = fract_norm (a * d) (b * c); - -instance No_zero_divisors Integer where { -}; - -class (Div a, Comm_semiring_1_cancel a, - No_zero_divisors a) => Semiring_div a where { -}; - -instance Cancel_semigroup_add Integer where { -}; - -instance Cancel_ab_semigroup_add Integer where { -}; - -instance Cancel_comm_monoid_add Integer where { -}; - -instance Semiring_0_cancel Integer where { -}; - -instance Semiring_1_cancel Integer where { -}; - -instance Ab_semigroup_mult Integer where { -}; - -instance Comm_semiring Integer where { -}; - -instance Comm_semiring_0 Integer where { -}; - -instance Comm_monoid_mult Integer where { -}; - -instance Comm_semiring_1 Integer where { -}; - -instance Comm_semiring_0_cancel Integer where { -}; - -instance Comm_semiring_1_cancel Integer where { -}; - -instance Semiring_div Integer where { -}; - -} diff --git a/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/ex/src_hs/Records.hs b/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/ex/src_hs/Records.hs deleted file mode 100644 index 4eb4dcd858f96572bb72fd0cbf58c454f0622a99..0000000000000000000000000000000000000000 --- a/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/ex/src_hs/Records.hs +++ /dev/null @@ -1,18 +0,0 @@ -module Records where - -data Identity a = Id { this :: a } - -data MyRecord = A { aField1 :: String, common1 :: Bool, common2 :: Int } - | B { bField1 :: Bool, bField2 :: Int, common1 :: Bool, common2 :: Int } - | C Bool Int String - -constr :: MyRecord -constr = A { aField1 = "foo", common1 = True } - -update :: MyRecord -> MyRecord -update x = x { common2 = 1, common1 = False } - -pattern :: MyRecord -> Int -pattern A { common2 = val } = val -pattern B { bField2 = val } = val -pattern (C _ val _) = val diff --git a/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/ex/src_hs/ReservedNames.hs b/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/ex/src_hs/ReservedNames.hs deleted file mode 100644 index 7d9dea0c293e2e754c97c6932c30031570b19433..0000000000000000000000000000000000000000 --- a/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/ex/src_hs/ReservedNames.hs +++ /dev/null @@ -1,12 +0,0 @@ - -module ReservedNames where - -foo nat set = nat : ([nat] ++ set) - -bar nat = let set = [nat] in set - -quux nat = frob nat [] - where frob nat set = nat : set - -zurp x = knorks x [] - where knorks x set = [x] ++ set \ No newline at end of file diff --git a/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/ex/src_hs/Sections.hs b/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/ex/src_hs/Sections.hs deleted file mode 100644 index f270d4e5d3cbc7a4b882a5f4ab658785d673ef62..0000000000000000000000000000000000000000 --- a/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/ex/src_hs/Sections.hs +++ /dev/null @@ -1,6 +0,0 @@ - -module Sections where - -foo list = map (++ [42]) list - -bar list = map ([23] ++) list \ No newline at end of file diff --git a/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/ex/src_hs/Sets.hs b/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/ex/src_hs/Sets.hs deleted file mode 100644 index ca384e95aba829e78c63d761e886ea8dec763ea2..0000000000000000000000000000000000000000 --- a/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/ex/src_hs/Sets.hs +++ /dev/null @@ -1,82 +0,0 @@ -module Sets where { - - -data Nat = Suc Nat | Zero; - -data Set a = Insert a (Set a) | Empty; - -bex :: forall a. Set a -> (a -> Bool) -> Bool; -bex Empty p = False; -bex (Insert a aa) p = p a || bex aa p; - -ball :: forall a. Set a -> (a -> Bool) -> Bool; -ball Empty p = True; -ball (Insert a aa) p = p a && ball aa p; - -member :: Nat -> Set Nat -> Bool; -member a aa = bex aa (eq_nat a); - -uniona :: Set Nat -> Set Nat -> Set Nat; -uniona a Empty = a; -uniona Empty a = a; -uniona (Insert a aa) b = - let { - c = uniona aa b; - } in (if member a b then c else Insert a c); - -union :: forall b. Set b -> (b -> Set Nat) -> Set Nat; -union Empty f = Empty; -union (Insert a aa) f = uniona (f a) (union aa f); - -image :: forall b. (b -> Nat) -> Set b -> Set Nat; -image f a = union a (\ x -> Insert (f x) Empty); - -intersect :: Set Nat -> Set Nat -> Set Nat; -intersect a Empty = Empty; -intersect Empty a = Empty; -intersect (Insert a aa) b = - let { - c = intersect aa b; - } in (if member a b then Insert a c else c); - -intera :: forall b. Set b -> (b -> Set Nat) -> Set Nat; -intera (Insert a Empty) f = f a; -intera (Insert a aa) f = intersect (f a) (intera aa f); - -inter :: Set (Set Nat) -> Set Nat; -inter a = intera a (\ x -> x); - -eq_nat :: Nat -> Nat -> Bool; -eq_nat Zero Zero = True; -eq_nat (Suc m) (Suc n) = eq_nat m n; -eq_nat Zero (Suc a) = False; -eq_nat (Suc a) Zero = False; - -less_eq_set :: Set Nat -> Set Nat -> Bool; -less_eq_set a b = ball a (\ x -> member x b); - -eq_set :: Set Nat -> Set Nat -> Bool; -eq_set a b = less_eq_set a b && less_eq_set b a; - -unionb :: Set (Set Nat) -> Set Nat; -unionb a = union a (\ x -> x); - -project :: (Nat -> Bool) -> Set Nat -> Set Nat; -project p a = union a (\ aa -> (if p aa then Insert aa Empty else Empty)); - -minus_set :: Set Nat -> Set Nat -> Set Nat; -minus_set a Empty = a; -minus_set Empty a = Empty; -minus_set (Insert a aa) b = - let { - c = minus_set aa b; - } in (if member a b then c else Insert a c); - -is_empty :: forall a. Set a -> Bool; -is_empty Empty = True; -is_empty (Insert a aa) = False; - -less_set :: Set Nat -> Set Nat -> Bool; -less_set a b = less_eq_set a b && not (less_eq_set b a); - -} diff --git a/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/ex/src_hs/Shadowing.hs.disabled b/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/ex/src_hs/Shadowing.hs.disabled deleted file mode 100644 index e014e407d71f33f3295ff0db22b05b6a00b31b9f..0000000000000000000000000000000000000000 --- a/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/ex/src_hs/Shadowing.hs.disabled +++ /dev/null @@ -1,7 +0,0 @@ -module Shadowing -where - -foo = let foo = (\x -> x + 1) - v = foo 1 - in v - where foo x = x \ No newline at end of file diff --git a/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/ex/src_hs/Stmt_Dependencies.hs b/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/ex/src_hs/Stmt_Dependencies.hs deleted file mode 100644 index 4e6eda59145499c0d20ce0e38c936cf607e7dd63..0000000000000000000000000000000000000000 --- a/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/ex/src_hs/Stmt_Dependencies.hs +++ /dev/null @@ -1,22 +0,0 @@ -module Stmt_Dependencies where - - -data Twin a b = Twin a b - -dest_Twin :: Twin a b -> (a, b) -dest_Twin (Twin x y) = (x, y) - -f :: a -> (a, a) -f x = dest_Twin (g x) - -g :: a -> Twin a a -g x = Twin (h x) (h x) - -h :: a -> a -h x = x - -{-double :: a -> Twin a a -double x = Twin x x-} - -k :: (a, b) -> (a, b) -k (x, y) = dest_Twin (Twin x y) diff --git a/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/ex/src_hs/Strings.hs b/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/ex/src_hs/Strings.hs deleted file mode 100644 index eebb777fd90c5f32dc80a18dbe3daf200afeb569..0000000000000000000000000000000000000000 --- a/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/ex/src_hs/Strings.hs +++ /dev/null @@ -1,19 +0,0 @@ -module Strings where - -import Nats - -digit10 :: Nat -> Char -digit10 Zero = '0' -digit10 (Suc Zero) = '1' -digit10 (Suc (Suc Zero)) = '2' -digit10 (Suc (Suc (Suc Zero))) = '3' -digit10 (Suc (Suc (Suc (Suc Zero)))) = '4' -digit10 (Suc (Suc (Suc (Suc (Suc Zero))))) = '5' -digit10 (Suc (Suc (Suc (Suc (Suc (Suc Zero)))))) = '6' -digit10 (Suc (Suc (Suc (Suc (Suc (Suc (Suc Zero))))))) = '7' -digit10 (Suc (Suc (Suc (Suc (Suc (Suc (Suc (Suc Zero)))))))) = '8' -digit10 (Suc (Suc (Suc (Suc (Suc (Suc (Suc (Suc (Suc Zero))))))))) = '9' - -{- radix_digit10 :: Nat -> String -radix_digit10 = radix digit10 - (Suc (Suc (Suc (Suc (Suc (Suc (Suc (Suc (Suc (Suc Zero)))))))))) -} diff --git a/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/ex/src_hs/Tree.hs b/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/ex/src_hs/Tree.hs deleted file mode 100644 index 60d36ad83f8f0f0579466443cc5380a9b2175339..0000000000000000000000000000000000000000 --- a/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/ex/src_hs/Tree.hs +++ /dev/null @@ -1,15 +0,0 @@ -module Tree where - -import Nats - -data Tree a = Tip a | Branch (Tree a) (Tree a) - -size :: Tree a -> Nat -size (Tip a) = Suc Zero -size (Branch x y) = plus_nat (size x) (size y) - -insert :: a -> Tree a -> Tree a -insert x (Tip y) = Branch (Tip x) (Tip y) -insert x (Branch y z) = if less_eq_nat (size y) (size z) - then Branch (insert x y) z - else Branch y (insert x z) diff --git a/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/ex/src_hs/TreeMapping.hs b/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/ex/src_hs/TreeMapping.hs deleted file mode 100644 index 9eace0e3cea90703653cd24c85b211e1db6300bc..0000000000000000000000000000000000000000 --- a/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/ex/src_hs/TreeMapping.hs +++ /dev/null @@ -1,186 +0,0 @@ -{-# OPTIONS_GHC -fglasgow-exts #-} - -module TreeMapping where { - - -data Nat = Zero | Suc Nat; - -class Orda a where { - less_eq :: a -> a -> Bool; - less :: a -> a -> Bool; -}; - -mapa :: forall b a. (b -> a) -> [b] -> [a]; -mapa f [] = []; -mapa f (x : xs) = f x : mapa f xs; - -nth :: forall a. [a] -> Nat -> a; -nth (x : xs) (Suc n) = nth xs n; -nth (x : xs) Zero = x; - -insert :: forall a. (Eq a) => a -> (a -> Bool) -> a -> Bool; -insert y a x = y == x || a x; - -class (Orda a) => Preorder a where { -}; - -class (Preorder a) => Bot a where { - bot :: a; -}; - -instance Orda Bool where { - less_eq True b = b; - less_eq False b = True; - less True b = False; - less False b = b; -}; - -instance Preorder Bool where { -}; - -instance Bot Bool where { - bot = False; -}; - -bot_fun :: forall a b. (Bot b) => a -> b; -bot_fun = (\ _ -> bot); - -set :: forall a. (Eq a) => [a] -> a -> Bool; -set [] = bot_fun; -set (x : xs) = insert x (set xs); - -data Tree a b = Empty | Branch b a (Tree a b) (Tree a b); - -dropa :: forall a. Nat -> [a] -> [a]; -dropa n [] = []; -dropa n (x : xs) = case n of { - Zero -> x : xs; - Suc m -> dropa m xs; - }; - -class (Preorder a) => Order a where { -}; - -class (Order a) => Linorder a where { -}; - -insort :: forall a. (Linorder a) => a -> [a] -> [a]; -insort x [] = [x]; -insort x (y : ys) = (if less_eq x y then x : y : ys else y : insort x ys); - -sort :: forall a. (Linorder a) => [a] -> [a]; -sort [] = []; -sort (x : xs) = insort x (sort xs); - -takea :: forall a. Nat -> [a] -> [a]; -takea n [] = []; -takea n (x : xs) = case n of { - Zero -> []; - Suc m -> x : takea m xs; - }; - -data Itself a = Type; - -append :: forall a. [a] -> [a] -> [a]; -append [] ys = ys; -append (x : xs) ys = x : append xs ys; - -keysa :: forall a b. (Linorder a) => Tree a b -> [a]; -keysa Empty = []; -keysa (Branch uu k l r) = k : append (keysa l) (keysa r); - -member :: forall a. (Eq a) => a -> [a] -> Bool; -member x [] = False; -member x (y : ys) = x == y || member x ys; - -remdups :: forall a. (Eq a) => [a] -> [a]; -remdups [] = []; -remdups (x : xs) = (if member x xs then remdups xs else x : remdups xs); - -lookupb :: forall a b. (Eq a, Linorder a) => Tree a b -> a -> Maybe b; -lookupb Empty = (\ _ -> Nothing); -lookupb (Branch v k l r) = - (\ k' -> - (if k' == k then Just v - else (if less_eq k' k then lookupb l k' else lookupb r k'))); - -is_none :: forall a. Maybe a -> Bool; -is_none (Just x) = False; -is_none Nothing = True; - -filtera :: forall a. (a -> Bool) -> [a] -> [a]; -filtera p [] = []; -filtera p (x : xs) = (if p x then x : filtera p xs else filtera p xs); - -plus_nat :: Nat -> Nat -> Nat; -plus_nat (Suc m) n = plus_nat m (Suc n); -plus_nat Zero n = n; - -size_list :: forall a. [a] -> Nat; -size_list [] = Zero; -size_list (a : list) = plus_nat (size_list list) (Suc Zero); - -sizea :: forall a b. (Eq a, Linorder a) => Tree a b -> Nat; -sizea t = - size_list - (filtera (\ x -> not (is_none x)) (mapa (lookupb t) (remdups (keysa t)))); - -foldla :: forall a b. (a -> b -> a) -> a -> [b] -> a; -foldla f a [] = a; -foldla f a (x : xs) = foldla f (f a x) xs; - -newtype (Linorder a) => Map a b = Tree (Tree a b); - -eq_nat :: Nat -> Nat -> Bool; -eq_nat (Suc nat') Zero = False; -eq_nat Zero (Suc nat') = False; -eq_nat (Suc nat) (Suc nat') = eq_nat nat nat'; -eq_nat Zero Zero = True; - -updatea :: forall a b. (Eq a, Linorder a) => a -> b -> Tree a b -> Tree a b; -updatea k v Empty = Branch v k Empty Empty; -updatea k' v' (Branch v k l r) = - (if k' == k then Branch v' k l r - else (if less_eq k' k then Branch v k (updatea k' v' l) r - else Branch v k l (updatea k' v' r))); - -keys :: forall a b. (Eq a, Linorder a) => Map a b -> a -> Bool; -keys (Tree t) = - set (filtera (\ k -> not (is_none (lookupb t k))) (remdups (keysa t))); - -size :: forall a b. (Eq a, Linorder a) => Map a b -> Nat; -size (Tree t) = sizea t; - -less_eq_nat :: Nat -> Nat -> Bool; -less_eq_nat (Suc m) n = less_nat m n; -less_eq_nat Zero n = True; - -less_nat :: Nat -> Nat -> Bool; -less_nat m (Suc n) = less_eq_nat m n; -less_nat n Zero = False; - -eq_tree :: forall a b. (Eq a, Eq b) => Tree a b -> Tree a b -> Bool; -eq_tree (Branch b' a' tree1' tree2') Empty = False; -eq_tree Empty (Branch b' a' tree1' tree2') = False; -eq_tree (Branch b a tree1 tree2) (Branch b' a' tree1' tree2') = - b == b' && (a == a' && (eq_tree tree1 tree1' && eq_tree tree2 tree2')); -eq_tree Empty Empty = True; - -empty :: forall a b. (Linorder a) => Map a b; -empty = Tree Empty; - -minus_nat :: Nat -> Nat -> Nat; -minus_nat (Suc m) (Suc n) = minus_nat m n; -minus_nat Zero n = Zero; -minus_nat m Zero = m; - -lookupa :: forall a b. (Eq a, Linorder a) => Map a b -> a -> Maybe b; -lookupa (Tree t) = lookupb t; - -update :: forall a b. (Eq a, Linorder a) => a -> b -> Map a b -> Map a b; -update k v (Tree t) = Tree (updatea k v t); - -replace :: forall a b. (Eq a, Linorder a) => a -> b -> Map a b -> Map a b; -replace k v m = (if is_none (lookupa m k) then m else update k v m); - -} diff --git a/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/ex/src_hs/Twin.hs b/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/ex/src_hs/Twin.hs deleted file mode 100644 index 562afdd40800e320260a8a663aa0bd5782dd9173..0000000000000000000000000000000000000000 --- a/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/ex/src_hs/Twin.hs +++ /dev/null @@ -1,10 +0,0 @@ -module Twin where - - -data Twin a b = Twin a b - -dest_Twin :: Twin a b -> (a, b) -dest_Twin (Twin x y) = (x, y) - -mk_Twin :: (a, b) -> Twin a b -mk_Twin = uncurry Twin diff --git a/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/ex/src_hs/TypeDefs.hs b/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/ex/src_hs/TypeDefs.hs deleted file mode 100644 index 8709d89d5f91f30a3a003841f39996351d802981..0000000000000000000000000000000000000000 --- a/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/ex/src_hs/TypeDefs.hs +++ /dev/null @@ -1,6 +0,0 @@ -module TypeDefs where - -type SomeType = Int - -fun :: SomeType -> SomeType -fun x = x diff --git a/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/ex/src_hs/UseMonads.hs.disabled b/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/ex/src_hs/UseMonads.hs.disabled deleted file mode 100644 index 0014e8f3c3767cc03b1dbedda489acdcf1550057..0000000000000000000000000000000000000000 --- a/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/ex/src_hs/UseMonads.hs.disabled +++ /dev/null @@ -1,20 +0,0 @@ -module UseMonads -where -import Monads - -addState :: Int -> StateM Int -addState n = do cur <- get - let new = (cur + n) - put new - return new - - -addState' :: Int -> ErrorM Int -addState' n = - do new <- lift (do cur <- get - let new = cur + n - put new - return new) - when (new < 0) $ - throwError "state must not be negative" - return new \ No newline at end of file diff --git a/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/lib/Tools/haskabelle b/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/lib/Tools/haskabelle deleted file mode 100755 index 40de7427c44adde9810bff4e927ae1501a6abbfb..0000000000000000000000000000000000000000 --- a/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/lib/Tools/haskabelle +++ /dev/null @@ -1,149 +0,0 @@ -#!/usr/bin/env bash -# -# Author: Lars Noschinski -# -# DESCRIPTION: Haskabelle interface wrapper - -## diagnostics - -PRG="$(basename "$0")" - -DEFAULT_ADAPT_DIR="$HASKABELLE_HOME_USER/default" -DEFAULT_ADAPT_SRC="$HASKABELLE_HOME/default" - -function usage() -{ - echo - echo "Usage: isabelle $PRG [OPTIONS] [SRC... DST]" - echo - echo " Options are:" - echo " SRC... list of haskell source files" - echo " DST destination directory" - echo " -a DIR custom adaptation table (default $DEFAULT_ADAPT_DIR)" - echo " -c CONFIG configuration file" - echo " -e runs the Haskabelle examples" - echo " -r rebuild adaptation table" - echo " -t generate a theory with at the end a command exporting everything to Haskell" - echo " -v show Haskabelle version" - echo - echo "At least one of SRC... DST, -c or -r must be given. Not both of" - echo "[SRC... DST] and -c may be used at the same time." - echo - echo "Given SRC... DST, import Haskell files SRC... into Isabelle theories" - echo "in directory DST. Given -c, import files according to the" - echo "configuration file." - echo - exit 1 -} - -function die() -{ - echo "$1" >&2 - exit 1 -} - -function fail() -{ - echo "$1" >&2 - exit 2 -} - - -## process command line - -# options - -ADAPT_DIR="" -BUILD_ADAPT=false -CONFIG_FILE="" -RUN_EXAMPLES=false -EXPORT_CODE=false -SHOW_VERSION=false - -function getoptions() -{ - OPTIND=1 - while getopts "a:bc:ertv" OPT - do - case "$OPT" in - a) - ADAPT_DIR="$OPTARG" - ;; - c) - CONFIG_FILE="$OPTARG" - ;; - e) - RUN_EXAMPLES=true - ;; - r) - BUILD_ADAPT=true - ;; - t) - EXPORT_CODE=true - ;; - v) - SHOW_VERSION=true - ;; - \?) - usage - ;; - esac - done - - if [[ "$ADAPT_DIR" = "" && - ( ! -f "$DEFAULT_ADAPT_DIR"/Generated_Adapt.hs || "$BUILD_ADAPT" = true ) ]]; then - echo "Prepare (re)building the default adaptation table ..." - mkdir -p "$DEFAULT_ADAPT_DIR" && - cp "$DEFAULT_ADAPT_SRC"/* "$DEFAULT_ADAPT_DIR" && - BUILD_ADAPT=true || - die "Rebuilding preparations for default adaptation table failed." - fi - - ADAPT_DIR=${ADAPT_DIR:-$DEFAULT_ADAPT_DIR} -} - -getoptions "$@" -shift $(($OPTIND - 1)) - - -## build - -# haskabelle binary - -HASKABELLE_BIN="$HASKABELLE_HOME/bin/haskabelle_bin" - -if [ -n "$ISABELLE_GHC" ]; then - BUILDDIR=build - ( - cd "$HASKABELLE_HOME" - mkdir -p "$BUILDDIR" || fail "Cannot create directory $BUILDDIR" - mkdir -p bin || fail "Cannot create directory bin" - $ISABELLE_GHC -package haskell-src-exts-1.20.1 --make -O -o bin/haskabelle_bin \ - -odir "$BUILDDIR" -hidir "$BUILDDIR" -stubdir "$BUILDDIR" "Main.hs" - ) || fail "Cannot build source. See Haskabelle documentation." -elif [ ! -e "$HASKABELLE_BIN" ]; then - fail "ISABELLE_GHC must be set to build Haskabelle. See Haskabelle documentation." -fi - - -# adaptation table - -if [ "$BUILD_ADAPT" = true ]; then - echo "$HASKABELLE_HOME/lib/mk_adapt" $ADAPT_DIR - "$HASKABELLE_HOME/lib/mk_adapt" $ADAPT_DIR || exit $? -fi - - -## main - -if [ "$SHOW_VERSION" = true ]; then - "$HASKABELLE_BIN" --version -elif [ "$RUN_EXAMPLES" = true ]; then - "$HASKABELLE_HOME/lib/regression" "$@" -elif [ "$CONFIG_FILE" != "" ]; then - "$HASKABELLE_BIN" --internal "$ADAPT_DIR" --export "$EXPORT_CODE" --config "$CONFIG_FILE" || exit $? -elif [ "$#" -ge 2 ]; then - "$HASKABELLE_BIN" --internal "$ADAPT_DIR" --export "$EXPORT_CODE" --files "$@" || exit $? -elif [ "$BUILD_ADAPT" = false ]; then - usage -fi diff --git a/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/lib/config.xsd b/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/lib/config.xsd deleted file mode 100644 index cde3be418144f4cb5ba81a240e34d33a12fa3a0b..0000000000000000000000000000000000000000 --- a/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/lib/config.xsd +++ /dev/null @@ -1,86 +0,0 @@ -<?xml version="1.0"?> -<schema - xmlns="http://www.w3.org/2001/XMLSchema" - elementFormDefault="qualified" - attributeFormDefault="unqualified" - xmlns:conf="http://www.haskell.org/hsimp/config" - targetNamespace="http://www.haskell.org/hsimp/config"> - - <element name="translation" type="conf:translation"/> - - <complexType name="translation"> - <all> - <element name="input" type="conf:input"/> - <element name="output" type="conf:output"/> - <element name="customisation" type="conf:customisation"/> - </all> - </complexType> - - <complexType name="input"> - <sequence> - <choice minOccurs="1" maxOccurs="unbounded"> - <element name="file" type="conf:path"/> - <element name="dir" type="conf:path"/> - <element name="path" type="conf:path"/> - </choice> - </sequence> - </complexType> - - <complexType name="path"> - <attribute name="location" type="string" use="required"/> - </complexType> - - <complexType name="output"> - <attribute name="location" type="string" use="required"/> - </complexType> - - <complexType name="customisation"> - <sequence> - <choice minOccurs="1" maxOccurs="unbounded"> - <element name="monadInstance" type="conf:monadInstance"/> - <element name="replace" type="conf:replace"/> - </choice> - </sequence> - </complexType> - - <complexType name="monadInstance"> - <all> - <element name="doSyntax" type="string"/> - <element name="constants" type="string"/> - <element name="lifts" type="conf:lifts" minOccurs="0"/> - </all> - <attribute name="name" type="string" use="required"/> - </complexType> - - <complexType name="lifts"> - <sequence> - <element name="lift" type="conf:lift" minOccurs="1" maxOccurs="unbounded"/> - </sequence> - </complexType> - - <complexType name="lift"> - <attribute name="from" type="string" use="required" /> - <attribute name="by" type="string" use="required" /> - </complexType> - - <complexType name="replace"> - <all> - <element name="module" type="conf:module"/> - <element name="theory" type="conf:theory"/> - </all> - </complexType> - - <complexType name="module"> - <attribute name="name" type="string" use="required"/> - </complexType> - - <complexType name="theory"> - <all> - <element name="monads" type="string" minOccurs="0"/> - <element name="constants" type="string" minOccurs="0"/> - <element name="types" type="string" minOccurs="0"/> - </all> - <attribute name="name" type="string" use="required"/> - <attribute name="location" type="string" use="required"/> - </complexType> -</schema> diff --git a/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/lib/mk_adapt b/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/lib/mk_adapt deleted file mode 100755 index ca29e5ae735383160c5b1cba0172649fdaf2a250..0000000000000000000000000000000000000000 --- a/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/lib/mk_adapt +++ /dev/null @@ -1,58 +0,0 @@ -#!/bin/bash -# -# Author: Florian Haftmann, TU Muenchen -# -# Shell interface for adaption table builder. -# -# Must be run in an isabelle environment (e.g. via "isabelle env") - -## environment - -PRG="$(basename "$0")" -HASKABELLE_HOME="$(cd "$(dirname "$0")"; cd "$(pwd -P)"; cd ..; pwd)" - -## diagnostics - -function fail() -{ - echo "$1" >&2 - exit 2 -} - -## parameters - -if [ "$1" == "" ] -then - DIR="$HASKABELLE_HOME/default" -else - DIR="$1" -fi - -## file names - -MK_ADAPT_LOC="$HASKABELLE_HOME/lib/mk_adapt.ML" -SRC_LOC="$DIR/adapt.txt" -DST_LOC="$DIR/Generated_Adapt.hs" -PRELUDE_NAME="Prelude" -PRELUDE_NAME_FULL="Draft.$PRELUDE_NAME" -PRELUDE_LOC="$DIR/$PRELUDE_NAME" - -## convert - -FORMAL_CMD="Runtime.toplevel_program (fn () => (use_thy prelude_loc; ML_Context.eval_source_in \ - (SOME (Proof_Context.init_global (Thy_Info.get_theory prelude_name))) \ - ML_Compiler.flags \ - (Input.source true ml_cmd Position.no_range))) \ - handle _ => OS.Process.exit OS.Process.failure;" - -ACTUAL_CMD="val prelude_loc = \"$PRELUDE_LOC\"; \ - val prelude_name = \"$PRELUDE_NAME_FULL\"; \ - val src_loc = \"$SRC_LOC\"; \ - val dst_loc = \"$DST_LOC\"; \ - val mk_adapt_path = Path.explode \"$MK_ADAPT_LOC\"; \ - fun eval_file path = ML_Context.eval_file \ - (ML_Compiler.verbose true ML_Compiler.flags) path; \ - val ml_cmd = \"eval_file mk_adapt_path; Mk_Adapt.run prelude_name src_loc dst_loc\"; \ - $FORMAL_CMD" - -"$ISABELLE_TOOL" process -e "$ACTUAL_CMD" -l HOL || fail "Building adaptation table failed." diff --git a/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/lib/mk_adapt.ML b/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/lib/mk_adapt.ML deleted file mode 100644 index 262544cb2f5f411d63de052abebd2a847acb96ec..0000000000000000000000000000000000000000 --- a/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/lib/mk_adapt.ML +++ /dev/null @@ -1,145 +0,0 @@ -(* Author: Florian Haftmann, TU Muenchen - -Decorate Haskabelle adaptation table with current Isabelle syntax. -*) - -signature MK_ADAPT = -sig - val run: string -> string -> string -> unit -end; - -structure Mk_Adapt : MK_ADAPT = -struct - -(* used constant symbols *) - -fun used_constants thy = [] - |> fold (fn (c, (_, NONE)) => cons c | _ => I) ((#constants o Consts.dest o Sign.consts_of) thy) - |> map (Proof_Context.extern_const (Proof_Context.init_global thy)) - |> filter_out Long_Name.is_qualified; - - -fun assert_class thy class = Sign.certify_class thy class - handle TYPE _ => error ("Not a class: " ^ quote class); -fun assert_type thy c = - case try (Type.the_decl (Sign.tsig_of thy)) (c, Position.none) of - NONE => error ("Not a type constructor: " ^ quote c) - | _ => c; -fun assert_const thy c = - case try (Consts.type_scheme (Sign.consts_of thy)) c of - NONE => error ("Not a constant: " ^ quote c) - | _ => c; - -fun check_class thy = assert_class thy o Sign.intern_class thy; -fun check_type thy = assert_type thy o Sign.intern_type thy; -fun check_const thy = assert_const thy o Sign.intern_const thy; - -fun mk_classentry thy (((hs, raw_isa), raw_super), params) = - let - val isa = check_class thy raw_isa; - val super = map (check_class thy) raw_super; - val s_super = enclose "[" "]" (commas_quote super); - val s_params = enclose "[" "]" (commas (map (fn (n, t) => "(" ^ quote n ^ ", " ^ quote t ^ ")") params)); - val s_entry = "(Class (RawClassInfo { superclasses = " ^ s_super ^ ", classVar = \"a\", methods = " - ^ s_params ^ " }))"; - val s = "(Haskell " ^ quote hs ^ " " ^ s_entry ^ ", Isabelle " ^ quote isa ^ " " ^ s_entry ^ ")"; - in s end; - -fun mk_typentry thy (hs, raw_isa) = - let - val isa = check_type thy raw_isa; - val s = "(Haskell " ^ quote hs ^ " Type, Isabelle " - ^ quote isa ^ " Type)"; - in s end; - -fun mk_constentry thy (hs, raw_isa) = - let - val isa = check_const thy raw_isa; - val syn = Syntax.guess_infix (Sign.syn_of thy) (Lexicon.mark_const isa); - val source_content = translate_string (fn "\\" => "\\\\" | s => s) o Input.source_content; - fun string_of_syn NONE = (isa, "Function") - | string_of_syn (SOME (Infix (s, j, _))) = - (source_content s, enclose "(" ")" ("InfixOp NoneAssoc " ^ string_of_int j)) - | string_of_syn (SOME (Infixl (s, j, _))) = - (source_content s, enclose "(" ")" ("InfixOp LeftAssoc " ^ string_of_int j)) - | string_of_syn (SOME (Infixr (s, j, _))) = - (source_content s, enclose "(" ")" ("InfixOp RightAssoc " ^ string_of_int j)) - | string_of_syn _ = raise Match; - val (sym, syn') = string_of_syn syn; - val s = "(Haskell " ^ quote hs ^ " Function, Isabelle " - ^ quote sym ^ " " ^ syn' ^ ")"; - in s end; - - -(* concrete input syntax *) - -val classesN = "classes"; -val superclassN = "superclass"; -val parameterN = "parameter"; -val typesN = "types"; -val constsN = "consts"; - -val adapt_keywords = - let - val entries = map (fn s => ((s, Position.none), Keyword.no_spec)) - [classesN, superclassN, parameterN, typesN, constsN]; - in Keyword.add_keywords entries Keyword.empty_keywords end; - -fun classes thy = Parse.$$$ classesN |-- - Scan.repeat1 (Parse.name -- Parse.name - -- Scan.optional (Scan.repeat1 (Parse.$$$ superclassN |-- Parse.name)) [] - -- Scan.optional (Scan.repeat1 (Parse.$$$ parameterN |-- Parse.name -- Parse.string)) [] - >> mk_classentry thy); -fun types thy = Parse.$$$ typesN |-- - Scan.repeat1 (Parse.name -- Parse.name >> mk_typentry thy); -fun consts thy = Parse.$$$ constsN |-- - Scan.repeat1 (Parse.name -- Parse.name >> mk_constentry thy); - -fun adapt thy = ( - classes thy @@@ Scan.optional (types thy) [] @@@ Scan.optional (consts thy) [] - || types thy @@@ Scan.optional (consts thy) [] - || consts thy) >> (space_implode ",\n " #> enclose "[" "]"); - -fun convert thy pos = Source.of_string - #> Token.source adapt_keywords pos - #> Token.source_proper - #> Source.source Token.stopper (Scan.single (Scan.error (Parse.!!! (adapt thy)))) - #> Source.exhaust - #> (fn [dst] => dst | _ => error ("Extra input " ^ Position.here pos)) - - -(* glueing it together *) - -val prep_string = - translate_string (fn "\\" => "\\\\" | s => s) - #> quote - #> Pretty.str; - -fun run thy_name src_loc dst_loc = - let - val thy = Thy_Info.get_theory thy_name; - val _ = writeln ("Reading from " ^ src_loc); - val src = File.read (Path.explode src_loc); - val dst_path = Path.explode dst_loc; - val modl_name = (Path.implode o fst o Path.split_ext o Path.base) dst_path; - val adaptions = convert thy (Position.file src_loc) src; - val enumerate_sorted = sort string_ord #> map prep_string #> map single - #> separate [Pretty.str ",", Pretty.fbrk] #> flat #> Pretty.enclose "[" "]"; - val keywords = - let fun dest kw = apply2 Scan.dest_lexicon (Keyword.major_keywords kw, Keyword.minor_keywords kw) - in enumerate_sorted (op @ (dest (Thy_Header.get_keywords thy))) end - val const_names = enumerate_sorted (used_constants thy); - val thy_names = enumerate_sorted (Thy_Info.get_names ()); - val dsts = ["-- THIS IS A GENERATED FILE - DO NOT EDIT!", - "-- Haskell syntax is only superficial.", - "", - "module " ^ modl_name ^ " where", "", - "raw_adaption_table = " ^ adaptions, "", - "reserved_keywords = " ^ Pretty.string_of keywords, "", - "used_const_names = " ^ Pretty.string_of const_names, "", - "used_thy_names = " ^ Pretty.string_of thy_names, ""]; - val _ = File.write dst_path (cat_lines dsts); - val _ = writeln ("Written to " ^ dst_loc); - in () end; - -end; diff --git a/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/lib/regression b/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/lib/regression deleted file mode 100755 index d853dbf74510a06e05611abd1337303310629f88..0000000000000000000000000000000000000000 --- a/Citadelle/src/compiler_generic/isabelle_home/contrib/haskabelle/lib/regression +++ /dev/null @@ -1,82 +0,0 @@ -#!/bin/bash -# -# Author: Florian Haftmann, TU Muenchen -# -# Roundtrip for all Haskell files in the examples directory. -# -# Must be run in an isabelle environment (e.g. via "isabelle env") - -## diagnostics - -function fail() -{ - echo "$1" >&2 - exit 2 -} - -cd "$HASKABELLE_HOME" - -## cleaning - -if [ "$1" == "clean" ] -then - rm -v ex/dst_thy/* ex/dst_hs/* - exit 0 -fi - -## operating mode - -if [ "$1" == "no_reimport" ] -then - REIMPORT="" -else - REIMPORT=1 - if [ "$1" == "no_abort" ] - then - ABORT="" - else - ABORT=1 - fi -fi - -function fail_or_warn() -{ - if [ $ABORT ] - then fail "$1" - else - echo "$1" >&2 - fi -} - - -## testing - -for SRC in ex/src_hs/*.hs -do - DST=ex/dst_thy/ - echo "importing $SRC..." - "$HASKABELLE_HOME/lib/Tools/haskabelle" -t "$SRC" "$DST" || fail "Could not import $SRC" -done - -## re-importing - -if [ $REIMPORT ] -then - cd ex/dst_thy/ - export REGRESSION_PATH=$(pwd) - export REGRESSION_DST="$(pwd)/../../ex/dst_hs/" - mkdir -p "$REGRESSION_DST" - echo 'session "dst_thy" = "HOL" + options [document = false, quick_and_dirty = true] theories '$(basename -s '.thy' *.thy) > ROOT - echo "re-importing all theories..." - "$ISABELLE_TOOL" build -c -D. > /dev/zero 2>&1 || fail_or_warn "Could not re-import all theories" - for THY in *.thy - do - THY_NAME="$(basename $THY .thy)" - HS_FILE="$REGRESSION_DST$THY_NAME.hs" - if [ ! -e "$HS_FILE" ] - then - fail "Something went wrong generating $HS_FILE" - fi - done -fi - diff --git a/Citadelle/src/compiler_generic/isabelle_home/src/HOL/Isabelle_Main0.thy b/Citadelle/src/compiler_generic/isabelle_home/src/HOL/Isabelle_Main0.thy deleted file mode 100644 index d07a65f47fa12b9af562652c74afc74ed565c19a..0000000000000000000000000000000000000000 --- a/Citadelle/src/compiler_generic/isabelle_home/src/HOL/Isabelle_Main0.thy +++ /dev/null @@ -1,45 +0,0 @@ -(****************************************************************************** - * A Meta-Model for the Isabelle API - * - * 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 Isabelle_Main0 -imports "ex/Isabelle_Cartouche_Examples" -begin -end \ No newline at end of file diff --git a/Citadelle/src/compiler_generic/isabelle_home/src/HOL/Isabelle_Main1.thy b/Citadelle/src/compiler_generic/isabelle_home/src/HOL/Isabelle_Main1.thy deleted file mode 100644 index 8d02cd9e373c8610a8c98cfbac15823bed6d1f50..0000000000000000000000000000000000000000 --- a/Citadelle/src/compiler_generic/isabelle_home/src/HOL/Isabelle_Main1.thy +++ /dev/null @@ -1,46 +0,0 @@ -(****************************************************************************** - * A Meta-Model for the Isabelle API - * - * 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 Isabelle_Main1 -imports "../Tools/Code/Isabelle_code_target" - "../Tools/Code/Isabelle_code_runtime" -begin -end \ No newline at end of file diff --git a/Citadelle/src/compiler_generic/isabelle_home/src/HOL/Isabelle_Main2.thy b/Citadelle/src/compiler_generic/isabelle_home/src/HOL/Isabelle_Main2.thy deleted file mode 100644 index 6cec22c091320a1cc9bc2af9a0401944c6907951..0000000000000000000000000000000000000000 --- a/Citadelle/src/compiler_generic/isabelle_home/src/HOL/Isabelle_Main2.thy +++ /dev/null @@ -1,45 +0,0 @@ -(****************************************************************************** - * A Meta-Model for the Isabelle API - * - * 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 Isabelle_Main2 -imports "../Pure/Isar/Isabelle_typedecl" -begin -end \ No newline at end of file diff --git a/Citadelle/src/compiler_generic/isabelle_home/src/HOL/ex/Isabelle_Cartouche_Examples.thy b/Citadelle/src/compiler_generic/isabelle_home/src/HOL/ex/Isabelle_Cartouche_Examples.thy deleted file mode 100644 index 318a28e4ff46da1f3711c1deab483e6f06c271ba..0000000000000000000000000000000000000000 --- a/Citadelle/src/compiler_generic/isabelle_home/src/HOL/ex/Isabelle_Cartouche_Examples.thy +++ /dev/null @@ -1,70 +0,0 @@ -(****************************************************************************** - * ISABELLE COPYRIGHT NOTICE, LICENCE AND DISCLAIMER. - * - * Copyright (c) 1986-2018 Contributors (in the changeset history) - * - * 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 Isabelle_Cartouche_Examples -imports Main -begin - -ML {* -(* Title: HOL/ex/Cartouche_Examples.thy - Author: Makarius -*) - local - fun mk_char (f_char, f_cons, _) (s, _) accu = - fold - (fn c => fn (accu, l) => - (f_char c accu, f_cons c l)) - (rev (map Char.ord (String.explode s))) - accu; - - fun mk_string (_, _, f_nil) accu [] = (accu, f_nil) - | mk_string f accu (s :: ss) = mk_char f s (mk_string f accu ss); - in - fun string_tr f f_mk accu content args = - let fun err () = raise TERM ("string_tr", args) in - (case args of - [(c as Const (@{syntax_const "_constrain"}, _)) $ Free (s, _) $ p] => - (case Term_Position.decode_position p of - SOME (pos, _) => c $ f (mk_string f_mk accu (content (s, pos))) $ p - | NONE => err ()) - | _ => err ()) - end; - end; -*} - -syntax "_cartouche_string" :: "cartouche_position \<Rightarrow> _" ("_") - -end diff --git a/Citadelle/src/compiler_generic/isabelle_home/src/Pure/Isar/Isabelle_typedecl.thy b/Citadelle/src/compiler_generic/isabelle_home/src/Pure/Isar/Isabelle_typedecl.thy deleted file mode 100644 index f92619c623e6373f7733606ceb766f58269a2ff9..0000000000000000000000000000000000000000 --- a/Citadelle/src/compiler_generic/isabelle_home/src/Pure/Isar/Isabelle_typedecl.thy +++ /dev/null @@ -1,77 +0,0 @@ -(****************************************************************************** - * ISABELLE COPYRIGHT NOTICE, LICENCE AND DISCLAIMER. - * - * Copyright (c) 1986-2018 Contributors (in the changeset history) - * - * 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 Isabelle_typedecl -imports Main -begin -ML{* -structure Isabelle_Typedecl = -struct -(* Title: Pure/Isar/typedecl.ML - Author: Makarius - -Type declarations (with object-logic arities) and type abbreviations. -*) - - -(* type abbreviations *) - -local - - -fun read_abbrev b ctxt raw_rhs = - let - val rhs = Proof_Context.read_typ_syntax (ctxt |> Proof_Context.set_defsort []) raw_rhs; - val ignored = Term.fold_atyps_sorts (fn (_, []) => I | (T, _) => insert (op =) T) rhs []; - val _ = - if not (null ignored) andalso Context_Position.is_visible ctxt then - warning - ("Ignoring sort constraints in type variables(s): " ^ - commas_quote (map (Syntax.string_of_typ ctxt) (rev ignored)) ^ - "\nin type abbreviation " ^ (case b of NONE => "" | SOME b => Binding.print b)) - else (); - in rhs end; - -in - -fun abbrev_cmd0 b = read_abbrev b - o Proof_Context.init_global - -end; - -end -*} -end diff --git a/Citadelle/src/compiler_generic/isabelle_home/src/Tools/Code/Isabelle_code_runtime.thy b/Citadelle/src/compiler_generic/isabelle_home/src/Tools/Code/Isabelle_code_runtime.thy deleted file mode 100644 index 4bda9a45d5b524af544f8de13602a9e7d1b94ebc..0000000000000000000000000000000000000000 --- a/Citadelle/src/compiler_generic/isabelle_home/src/Tools/Code/Isabelle_code_runtime.thy +++ /dev/null @@ -1,253 +0,0 @@ -(****************************************************************************** - * ISABELLE COPYRIGHT NOTICE, LICENCE AND DISCLAIMER. - * - * Copyright (c) 1986-2018 Contributors (in the changeset history) - * - * 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 Isabelle_code_runtime -imports Main - keywords "code_reflect'" :: thy_decl -begin - -ML{* -structure Code_Runtime' = -struct -(* Title: Tools/Code/code_runtime.ML - Author: Florian Haftmann, TU Muenchen - -Runtime services building on code generation into implementation language SML. -*) - -open Basic_Code_Symbol; - -(** ML compiler as evaluation environment **) - -(* technical prerequisites *) - - -val trace = Attrib.setup_config_bool @{binding "code_runtime_trace"} (K false); - -fun compile_ML verbose code context = - (if Config.get_generic context trace then tracing code else (); - Code_Preproc.timed "compiling ML" Context.proof_of - (ML_Context.exec (fn () => ML_Compiler0.ML ML_Env.context - {line = 0, file = "generated code", verbose = verbose, - debug = false} code)) context); - - - -(* evaluation into ML language values *) - - - -(* evaluation for truth or nothing *) - - - -(** generator for computations -- partial implementations of the universal morphism from Isabelle to ML terms **) - -(* auxiliary *) - - - -(* possible type signatures of constants *) - - - -(* name mangling *) - - - -(* checks for input terms *) - - - -(* code generation for of the universal morphism *) - - - -(* dedicated preprocessor for computations *) - - - -(* mounting computations *) - - - -(** variants of universal runtime code generation **) - -(*FIXME consolidate variants*) - -fun runtime_code'' ctxt module_name program tycos consts all_public = - let - val thy = Proof_Context.theory_of ctxt; - val (ml_modules, target_names) = - Code_Target.produce_code_for ctxt - Code_Runtime.target NONE module_name [] program all_public (map Constant consts @ map Type_Constructor tycos); - val ml_code = space_implode "\n\n" (map snd ml_modules); - val (consts', tycos') = chop (length consts) target_names; - val consts_map = map2 (fn const => - fn NONE => - error ("Constant " ^ (quote o Code.string_of_const thy) const ^ - "\nhas a user-defined serialization") - | SOME const' => (const, const')) consts consts' - val tycos_map = map2 (fn tyco => - fn NONE => - error ("Type " ^ quote (Proof_Context.markup_type ctxt tyco) ^ - "\nhas a user-defined serialization") - | SOME tyco' => (tyco, tyco')) tycos tycos'; - in (ml_code, (tycos_map, consts_map)) end; - - - -(** code and computation antiquotations **) - - - -(** reflection support **) - -fun check_datatype thy tyco some_consts = - let - val declared_constrs = (map fst o snd o fst o Code.get_type thy) tyco; - val constrs = case some_consts - of SOME [] => [] - | SOME consts => - let - val missing_constrs = subtract (op =) consts declared_constrs; - val _ = if null missing_constrs then [] - else error ("Missing constructor(s) " ^ commas_quote missing_constrs - ^ " for datatype " ^ quote tyco); - val false_constrs = subtract (op =) declared_constrs consts; - val _ = if null false_constrs then [] - else error ("Non-constructor(s) " ^ commas_quote false_constrs - ^ " for datatype " ^ quote tyco) - in consts end - | NONE => declared_constrs; - in (tyco, constrs) end; - -fun add_eval_tyco (tyco, tyco') thy = - let - val k = Sign.arity_number thy tyco; - fun pr pr' _ [] = tyco' - | pr pr' _ [ty] = - Code_Printer.concat [pr' Code_Printer.BR ty, tyco'] - | pr pr' _ tys = - Code_Printer.concat [Code_Printer.enum "," "(" ")" (map (pr' Code_Printer.BR) tys), tyco'] - in - thy - |> Code_Target.set_printings (Type_Constructor (tyco, [(Code_Runtime.target, SOME (k, pr))])) - end; - -fun add_eval_constr (const, const') thy = - let - val k = Code.args_number thy const; - fun pr pr' fxy ts = Code_Printer.brackify fxy - (const' :: the_list (Code_Printer.tuplify pr' Code_Printer.BR (map fst ts))); - in - thy - |> Code_Target.set_printings (Constant (const, - [(Code_Runtime.target, SOME (Code_Printer.simple_const_syntax (k, pr)))])) - end; - -fun add_eval_const (const, const') = Code_Target.set_printings (Constant - (const, [(Code_Runtime.target, SOME (Code_Printer.simple_const_syntax (0, (K o K o K) const')))])); - -fun process_reflection (code, (tyco_map, (constr_map, const_map))) module_name NONE thy = - thy - |> Code_Target.add_reserved Code_Runtime.target module_name - |> Context.theory_map (compile_ML true code) - |> fold (add_eval_tyco o apsnd Code_Printer.str) tyco_map - |> fold (add_eval_constr o apsnd Code_Printer.str) constr_map - |> fold (add_eval_const o apsnd Code_Printer.str) const_map - | process_reflection (code, _) _ (SOME file_name) thy = - let - val preamble = - "(* Generated from " ^ - Path.implode (Resources.thy_path (Path.basic (Context.theory_name thy))) ^ - "; DO NOT EDIT! *)"; - val _ = File.write (Path.explode file_name) (preamble ^ "\n\n" ^ code); - in - thy - end; - -fun gen_code_reflect prep_type prep_const all_public raw_datatypes raw_functions module_name some_file thy = - let - val ctxt = Proof_Context.init_global thy; - val datatypes = map (fn (raw_tyco, raw_cos) => - (prep_type ctxt raw_tyco, (Option.map o map) (prep_const thy) raw_cos)) raw_datatypes; - val (tycos, constrs) = map_split (uncurry (check_datatype thy)) datatypes - |> apsnd flat; - val functions = map (prep_const thy) raw_functions; - val consts = constrs @ functions; - val program = Code_Thingol.consts_program ctxt consts; - val result = runtime_code'' ctxt module_name program tycos consts all_public - |> (apsnd o apsnd) (chop (length constrs)); - in - thy - |> process_reflection result module_name some_file - end; - -val code_reflect_cmd = gen_code_reflect Code_Target.read_tyco Code.read_const; - - -(** Isar setup **) - -local - -val parse_datatype = - Parse.name -- Scan.optional (@{keyword "="} |-- - (((Parse.sym_ident || Parse.string) >> (fn "_" => NONE | _ => Scan.fail ())) - || ((Parse.term ::: (Scan.repeat (@{keyword "|"} |-- Parse.term))) >> SOME))) (SOME []); - -in - -val _ = - Outer_Syntax.command @{command_keyword code_reflect'} - "enrich runtime environment with generated code" - (Scan.optional (@{keyword "open"} |-- Scan.succeed true) false -- - Parse.name -- Scan.optional (@{keyword "datatypes"} |-- Parse.!!! (parse_datatype - ::: Scan.repeat (@{keyword "and"} |-- parse_datatype))) [] - -- Scan.optional (@{keyword "functions"} |-- Parse.!!! (Scan.repeat1 Parse.name)) [] - -- Scan.option (@{keyword "file"} |-- Parse.!!! Parse.name) - >> (fn ((((all_public, module_name), raw_datatypes), raw_functions), some_file) => Toplevel.theory - (code_reflect_cmd all_public raw_datatypes raw_functions module_name some_file))); - -end; (*local*) - - -(** using external SML files as substitute for proper definitions -- only for polyml! **) - -end -*} - -end diff --git a/Citadelle/src/compiler_generic/isabelle_home/src/Tools/Code/Isabelle_code_target.thy b/Citadelle/src/compiler_generic/isabelle_home/src/Tools/Code/Isabelle_code_target.thy deleted file mode 100644 index ea95b67cec7e7375656eb3e966d570570ac57b82..0000000000000000000000000000000000000000 --- a/Citadelle/src/compiler_generic/isabelle_home/src/Tools/Code/Isabelle_code_target.thy +++ /dev/null @@ -1,220 +0,0 @@ -(****************************************************************************** - * ISABELLE COPYRIGHT NOTICE, LICENCE AND DISCLAIMER. - * - * Copyright (c) 1986-2018 Contributors (in the changeset history) - * - * 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 Isabelle_code_target -imports Main - keywords "lazy_code_printing" "apply_code_printing" "apply_code_printing_reflect" - :: thy_decl -begin - -subsection{* beginning (lazy code printing) *} - -ML{* -structure Isabelle_Code_Target = -struct -(* Title: Tools/Code/code_target.ML - Author: Florian Haftmann, TU Muenchen - -Generic infrastructure for target language data. -*) - -open Basic_Code_Symbol; -open Basic_Code_Thingol; - - - -(** checking and parsing of symbols **) - - -val parse_classrel_ident = Parse.class --| @{keyword "<"} -- Parse.class; - - -val parse_inst_ident = Parse.name --| @{keyword "::"} -- Parse.class; - - - -(** serializations and serializer **) - -(* serialization: abstract nonsense to cover different destinies for generated code *) - - - - - -(* serializers: functions producing serializations *) - - - -(** theory data **) - - - -(** serializer usage **) - -(* technical aside: pretty printing width *) - - - -(* montage *) - - - -(* code generation *) - -fun prep_destination (s, pos) = - if s = "" then NONE - else - let - val _ = Position.report pos Markup.language_path; - val path = Path.explode s; - val _ = Position.report pos (Markup.path (Path.smart_implode path)); - in SOME path end; - - -fun export_code_cmd all_public raw_cs seris ctxt = - Code_Target.export_code ctxt all_public - (Code_Thingol.read_const_exprs ctxt raw_cs) - ((map o apfst o apsnd) prep_destination seris); - - - -(** serializer configuration **) - -(* reserved symbol names *) - - - -(* checking of syntax *) - - - -(* custom symbol names *) - - - -(* custom printings *) - - - -(* concrete syntax *) - - - -(** Isar setup **) - -fun parse_single_symbol_pragma parse_keyword parse_isa parse_target = - parse_keyword |-- Parse.!!! (parse_isa --| (@{keyword "\<rightharpoonup>"} || @{keyword "=>"}) - -- Parse.and_list1 (@{keyword "("} |-- (Parse.name --| @{keyword ")"} -- Scan.option parse_target))); - -fun parse_symbol_pragma parse_const parse_tyco parse_class parse_classrel parse_inst parse_module = - parse_single_symbol_pragma @{keyword "constant"} Parse.term parse_const - >> Constant - || parse_single_symbol_pragma @{keyword "type_constructor"} Parse.type_const parse_tyco - >> Type_Constructor - || parse_single_symbol_pragma @{keyword "type_class"} Parse.class parse_class - >> Type_Class - || parse_single_symbol_pragma @{keyword "class_relation"} parse_classrel_ident parse_classrel - >> Class_Relation - || parse_single_symbol_pragma @{keyword "class_instance"} parse_inst_ident parse_inst - >> Class_Instance - || parse_single_symbol_pragma @{keyword "code_module"} Parse.name parse_module - >> Code_Symbol.Module; - -fun parse_symbol_pragmas parse_const parse_tyco parse_class parse_classrel parse_inst parse_module = - Parse.enum1 "|" (Parse.group (fn () => "code symbol pragma") - (parse_symbol_pragma parse_const parse_tyco parse_class parse_classrel parse_inst parse_module)); - -end -*} - -ML{* -structure Code_printing = struct -datatype code_printing = Code_printing of - (string * (bstring * Code_Printer.raw_const_syntax option) list, - string * (bstring * Code_Printer.tyco_syntax option) list, - string * (bstring * string option) list, - (string * string) * (bstring * unit option) list, - (xstring * string) * (bstring * unit option) list, - bstring * (bstring * (string * string list) option) list) - Code_Symbol.attr - list - -structure Data_code = Theory_Data - (type T = code_printing list Symtab.table - val empty = Symtab.empty - val extend = I - val merge = Symtab.merge (K true)) - -val code_empty = "" - -val () = - Outer_Syntax.command @{command_keyword lazy_code_printing} "declare dedicated printing for code symbols" - (Isabelle_Code_Target.parse_symbol_pragmas (Code_Printer.parse_const_syntax) (Code_Printer.parse_tyco_syntax) - Parse.string (Parse.minus >> K ()) (Parse.minus >> K ()) - (Parse.text -- Scan.optional (@{keyword "attach"} |-- Scan.repeat1 Parse.term) []) - >> (fn code => - Toplevel.theory (Data_code.map (Symtab.map_default (code_empty, []) (fn l => Code_printing code :: l))))) - -fun apply_code_printing thy = - (case Symtab.lookup (Data_code.get thy) code_empty of SOME l => rev l | _ => []) - |> (fn l => fold (fn Code_printing l => fold Code_Target.set_printings l) l thy) - -val () = - Outer_Syntax.command @{command_keyword apply_code_printing} "apply dedicated printing for code symbols" - (Parse.$$$ "(" -- Parse.$$$ ")" >> K (Toplevel.theory apply_code_printing)) - -fun reflect_ml source thy = - case ML_Context.exec (fn () => - ML_Context.eval_source (ML_Compiler.verbose false ML_Compiler.flags) source) (Context.Theory thy) of - Context.Theory thy => thy - -fun apply_code_printing_reflect thy = - (case Symtab.lookup (Data_code.get thy) code_empty of SOME l => rev l | _ => []) - |> (fn l => fold (fn Code_printing l => - fold (fn Code_Symbol.Module (_, l) => - fold (fn ("SML", SOME (txt, _)) => reflect_ml (Input.source false txt (Position.none, Position.none)) - | _ => I) l - | _ => I) l) l thy) - -val () = - Outer_Syntax.command @{command_keyword apply_code_printing_reflect} "apply dedicated printing for code symbols" - (Parse.ML_source >> (fn src => Toplevel.theory (apply_code_printing_reflect o reflect_ml src))) - -end - -*} - -end diff --git a/Citadelle/src/compiler_generic/isabelle_para/src/Pure/Isar/outer_syntax.ML b/Citadelle/src/compiler_generic/isabelle_para/src/Pure/Isar/outer_syntax.ML deleted file mode 100644 index bd6bb43f8fe670b3b81d79b1664f9ca8b1a56de2..0000000000000000000000000000000000000000 --- a/Citadelle/src/compiler_generic/isabelle_para/src/Pure/Isar/outer_syntax.ML +++ /dev/null @@ -1,336 +0,0 @@ -(* Title: Pure/Isar/outer_syntax.ML - Author: Markus Wenzel, TU Muenchen - -Isabelle/Isar outer syntax. -*) - -signature OUTER_SYNTAX = -sig - val help: theory -> string list -> unit - val print_commands: theory -> unit - type command_keyword = string * Position.T - val command: command_keyword -> string -> - (Toplevel.transition -> Toplevel.transition) parser -> unit - val command': command_keyword -> string -> - (theory -> Proof.state option -> Toplevel.transition -> Toplevel.transition) parser -> unit - val commands: command_keyword -> string -> - (command_keyword * (Toplevel.transition -> Toplevel.transition)) list parser -> unit - val commands': command_keyword -> string -> - (theory -> Proof.state option -> (command_keyword * (Toplevel.transition -> Toplevel.transition)) list) parser -> unit - val maybe_begin_local_theory: command_keyword -> string -> - (local_theory -> local_theory) parser -> (theory -> local_theory) parser -> unit - val local_theory': command_keyword -> string -> - (bool -> local_theory -> local_theory) parser -> unit - val local_theory: command_keyword -> string -> - (local_theory -> local_theory) parser -> unit - val local_theory_to_proof': command_keyword -> string -> - (bool -> local_theory -> Proof.state) parser -> unit - val local_theory_to_proof: command_keyword -> string -> - (local_theory -> Proof.state) parser -> unit - val bootstrap: bool Config.T - val parse_tokens: theory -> Proof.state option -> Token.T list -> Toplevel.transitions list - val parse: theory -> Proof.state option -> Position.T -> string -> Toplevel.transitions list - val parse_spans: Token.T list -> Command_Span.span list - val make_span: Token.T list -> Command_Span.span - val command_reports: theory -> Token.T -> Position.report_text list - val check_command: Proof.context -> command_keyword -> string -end; - -structure Outer_Syntax: OUTER_SYNTAX = -struct - -(** outer syntax **) - -(* errors *) - -fun err_command msg name ps = - error (msg ^ quote (Markup.markup Markup.keyword1 name) ^ Position.here_list ps); - -fun err_dup_command name ps = - err_command "Duplicate outer syntax command " name ps; - - -(* command parsers *) - -type command0 = (theory -> Proof.state option -> (string -> Toplevel.transition) -> Toplevel.transitions) parser - -datatype command_parser = - Parser of command0 | - Restricted_Parser of (bool * Position.T) option -> command0; - -datatype command = Command of - {comment: string, - command_parser: command_parser, - pos: Position.T, - id: serial}; - -fun eq_command (Command {id = id1, ...}, Command {id = id2, ...}) = id1 = id2; - -fun new_command comment command_parser pos = - Command {comment = comment, command_parser = command_parser, pos = pos, id = serial ()}; - -fun command_pos (Command {pos, ...}) = pos; - -fun command_markup def (name, Command {pos, id, ...}) = - Markup.properties (Position.entity_properties_of def id pos) - (Markup.entity Markup.commandN name); - -fun pretty_command (cmd as (name, Command {comment, ...})) = - Pretty.block - (Pretty.marks_str - ([Active.make_markup Markup.sendbackN {implicit = true, properties = [Markup.padding_line]}, - command_markup false cmd], name) :: Pretty.str ":" :: Pretty.brk 2 :: Pretty.text comment); - - -(* theory data *) - -structure Data = Theory_Data -( - type T = command Symtab.table; - val empty = Symtab.empty; - val extend = I; - fun merge data : T = - data |> Symtab.join (fn name => fn (cmd1, cmd2) => - if eq_command (cmd1, cmd2) then raise Symtab.SAME - else err_dup_command name [command_pos cmd1, command_pos cmd2]); -); - -val get_commands = Data.get; -val dest_commands = get_commands #> Symtab.dest #> sort_by #1; -val lookup_commands = Symtab.lookup o get_commands; - -fun help thy pats = - dest_commands thy - |> filter (fn (name, _) => forall (fn pat => match_string pat name) pats) - |> map pretty_command - |> Pretty.writeln_chunks; - -fun print_commands thy = - let - val keywords = Thy_Header.get_keywords thy; - val minor = Scan.dest_lexicon (Keyword.minor_keywords keywords); - val commands = dest_commands thy; - in - [Pretty.strs ("keywords:" :: map quote minor), - Pretty.big_list "commands:" (map pretty_command commands)] - |> Pretty.writeln_chunks - end; - - -(* maintain commands *) - -fun add_command name cmd thy = - if member (op =) Thy_Header.bootstrap_thys (Context.theory_name thy) then thy - else - let - val _ = - Keyword.is_command (Thy_Header.get_keywords thy) name orelse - err_command "Undeclared outer syntax command " name [command_pos cmd]; - val _ = - (case lookup_commands thy name of - NONE => () - | SOME cmd' => err_dup_command name [command_pos cmd, command_pos cmd']); - val _ = - Context_Position.report_generic (Context.the_generic_context ()) - (command_pos cmd) (command_markup true (name, cmd)); - in Data.map (Symtab.update (name, cmd)) thy end; - -val _ = Theory.setup (Theory.at_end (fn thy => - let - val command_keywords = - Scan.dest_lexicon (Keyword.major_keywords (Thy_Header.get_keywords thy)); - val _ = - (case subtract (op =) (map #1 (dest_commands thy)) command_keywords of - [] => () - | missing => error ("Missing outer syntax command(s) " ^ commas_quote missing)) - in NONE end)); - - -(* implicit theory setup *) - -type command_keyword = string * Position.T; - -fun raw_command (name, pos) comment command_parser = - let val setup = add_command name (new_command comment command_parser pos) - in Context.>> (Context.mapping setup (Local_Theory.background_theory setup)) end; - -fun command (name, pos) comment parse = - raw_command (name, pos) comment (Parser (parse >> (fn f => fn _ => fn _ => fn tr => [f (tr name)]))); - -fun command' (name, pos) comment parse = - raw_command (name, pos) comment (Parser (parse >> (fn f => fn thy => fn st => fn tr => [f thy st (tr name)]))); - -fun commands (name, pos) comment parse = - raw_command (name, pos) comment (Parser (parse >> (fn l => fn _ => fn _ => fn tr => map (fn ((name, _), f) => f (tr name)) l))); - -fun commands' (name, pos) comment parse = - raw_command (name, pos) comment (Parser (parse >> (fn l => fn thy => fn st => fn tr => map (fn ((name, _), f) => f (tr name)) (l thy st)))); - -fun toplevel_return command_keyword f _ _ tr = [ f (tr (#1 command_keyword))] - -fun maybe_begin_local_theory command_keyword comment parse_local parse_global = - raw_command command_keyword comment - (Restricted_Parser (fn restricted => - Parse.opt_target -- parse_local - >> (fn (target, f) => toplevel_return command_keyword (Toplevel.local_theory restricted target f)) || - (if is_some restricted then Scan.fail - else parse_global >> (toplevel_return command_keyword o Toplevel.begin_local_theory true)))); - -fun local_theory_command trans command_keyword comment parse = - raw_command command_keyword comment - (Restricted_Parser (fn restricted => - Parse.opt_target -- parse >> (fn (target, f) => toplevel_return command_keyword (trans restricted target f)))); - -val local_theory' = local_theory_command Toplevel.local_theory'; -val local_theory = local_theory_command Toplevel.local_theory; -val local_theory_to_proof' = local_theory_command Toplevel.local_theory_to_proof'; -val local_theory_to_proof = local_theory_command Toplevel.local_theory_to_proof; - - - -(** toplevel parsing **) - -(* parse commands *) - -val bootstrap = - Config.bool (Config.declare ("Outer_Syntax.bootstrap", \<^here>) (K (Config.Bool true))); - -local - -val before_command = - Scan.option (Parse.position (Parse.private >> K true || Parse.qualified >> K false)); - -fun parse_command thy st = - Scan.ahead (before_command |-- Parse.position Parse.command) :|-- (fn (name, pos) => - let - val keywords = Thy_Header.get_keywords thy; - val command_tags = Parse.command -- Parse.tags; - fun tr0 name = - Toplevel.empty - |> Toplevel.name name - |> Toplevel.position pos - |> Keyword.is_proof_open keywords name ? Toplevel.skip_proof_open - |> Keyword.is_proof_close keywords name ? Toplevel.skip_proof_close; - in - (case lookup_commands thy name of - SOME (Command {command_parser = Parser parse, ...}) => - Parse.!!! (command_tags |-- parse) >> (fn f => f thy st tr0) - | SOME (Command {command_parser = Restricted_Parser parse, ...}) => - before_command :|-- (fn restricted => - Parse.!!! (command_tags |-- parse restricted)) >> (fn f => f thy st tr0) - | NONE => - Scan.fail_with (fn _ => fn _ => - let - val msg = - if Config.get_global thy bootstrap - then "missing theory context for command " - else "undefined command "; - in msg ^ quote (Markup.markup Markup.keyword1 name) end)) - end); - -in - -fun parse_tokens thy st = - filter Token.is_proper - #> Source.of_list - #> Source.source Token.stopper (Scan.bulk (fn xs => Parse.!!! (parse_command thy st) xs)) - #> Source.exhaust; - -fun parse thy st pos text = - Symbol_Pos.explode (text, pos) - |> Token.tokenize (Thy_Header.get_keywords thy) {strict = false} - |> parse_tokens thy st; - -end; - - -(* parse spans *) - -local - -fun ship span = - let - val kind = - if forall Token.is_ignored span then Command_Span.Ignored_Span - else if exists Token.is_error span then Command_Span.Malformed_Span - else - (case find_first Token.is_command span of - NONE => Command_Span.Malformed_Span - | SOME cmd => Command_Span.Command_Span (Token.content_of cmd, Token.pos_of cmd)); - in cons (Command_Span.Span (kind, span)) end; - -fun flush (result, content, ignored) = - result - |> not (null content) ? ship (rev content) - |> not (null ignored) ? ship (rev ignored); - -fun parse tok (result, content, ignored) = - if Token.is_ignored tok then (result, content, tok :: ignored) - else if Token.is_command_modifier tok orelse - Token.is_command tok andalso - (not (exists Token.is_command_modifier content) orelse exists Token.is_command content) - then (flush (result, content, ignored), [tok], []) - else (result, tok :: (ignored @ content), []); - -in - -fun parse_spans toks = - fold parse toks ([], [], []) |> flush |> rev; - -end; - -fun make_span toks = - (case parse_spans toks of - [span] => span - | _ => Command_Span.Span (Command_Span.Malformed_Span, toks)); - - -(* check commands *) - -fun command_reports thy tok = - if Token.is_command tok then - let val name = Token.content_of tok in - (case lookup_commands thy name of - NONE => [] - | SOME cmd => [((Token.pos_of tok, command_markup false (name, cmd)), "")]) - end - else []; - -fun check_command ctxt (name, pos) = - let - val thy = Proof_Context.theory_of ctxt; - val keywords = Thy_Header.get_keywords thy; - in - if Keyword.is_command keywords name then - let - val markup = - Token.explode0 keywords name - |> maps (command_reports thy) - |> map (#2 o #1); - val _ = Context_Position.reports ctxt (map (pair pos) markup); - in name end - else - let - val completion = - Completion.make (name, pos) - (fn completed => - Keyword.dest_commands keywords - |> filter completed - |> sort_strings - |> map (fn a => (a, (Markup.commandN, a)))); - val report = Markup.markup_report (Completion.reported_text completion); - in error ("Bad command " ^ quote name ^ Position.here pos ^ report) end - end; - - -(* 'ML' command -- required for bootstrapping Isar *) - -val _ = - command ("ML", \<^here>) "ML text within theory or local theory" - (Parse.ML_source >> (fn source => - Toplevel.generic_theory - (ML_Context.exec (fn () => - ML_Context.eval_source (ML_Compiler.verbose true ML_Compiler.flags) source) #> - Local_Theory.propagate_ml_env))); - -end; diff --git a/Citadelle/src/compiler_generic/isabelle_para/src/Pure/Isar/toplevel.ML b/Citadelle/src/compiler_generic/isabelle_para/src/Pure/Isar/toplevel.ML deleted file mode 100644 index 31e0e114d0618c9342fa1c30e9a7b571a6727469..0000000000000000000000000000000000000000 --- a/Citadelle/src/compiler_generic/isabelle_para/src/Pure/Isar/toplevel.ML +++ /dev/null @@ -1,777 +0,0 @@ -(* Title: Pure/Isar/toplevel.ML - Author: Markus Wenzel, TU Muenchen - -Isabelle/Isar toplevel transactions. -*) - -signature TOPLEVEL = -sig - exception UNDEF - type state - val theory_toplevel: theory -> state - val toplevel: state - val is_toplevel: state -> bool - val is_theory: state -> bool - val is_proof: state -> bool - val is_skipped_proof: state -> bool - val level: state -> int - val previous_theory_of: state -> theory option - val context_of: state -> Proof.context - val generic_theory_of: state -> generic_theory - val theory_of: state -> theory - val proof_of: state -> Proof.state - val proof_of': state -> Proof.state option - val proof_position_of: state -> int - val is_end_theory: state -> bool - val end_theory: Position.T -> state -> theory - val presentation_context: state -> Proof.context - val presentation_state: Proof.context -> state - val pretty_context: state -> Pretty.T list - val pretty_state: state -> Pretty.T list - val string_of_state: state -> string - val pretty_abstract: state -> Pretty.T - datatype state_read = Load_backup | Load_previous - datatype state_write = Store_backup | Store_default - type transition - type transitions = transition list - val empty: transition - val name_of: transition -> string - val pos_of: transition -> Position.T - val type_error: transition -> string - val name: string -> transition -> transition - val position: Position.T -> transition -> transition - val read_write: state_read * state_write -> transition -> transition - val init_theory: (unit -> theory) -> transition -> transition - val is_init: transition -> bool - val modify_init: (unit -> theory) -> transitions -> transitions - val exit: transition -> transition - val keep: (state -> unit) -> transition -> transition - val keep': (bool -> state -> unit) -> transition -> transition - val keep_proof: (state -> unit) -> transition -> transition - val ignored: Position.T -> transitions - val is_ignored: transitions -> bool - val malformed: Position.T -> string -> transitions - val generic_theory: (generic_theory -> generic_theory) -> transition -> transition - val theory': (bool -> theory -> theory) -> transition -> transition - val theory: (theory -> theory) -> transition -> transition - val begin_local_theory: bool -> (theory -> local_theory) -> transition -> transition - val end_local_theory: transition -> transition - val open_target: (generic_theory -> local_theory) -> transition -> transition - val close_target: transition -> transition - val local_theory': (bool * Position.T) option -> (xstring * Position.T) option -> - (bool -> local_theory -> local_theory) -> transition -> transition - val local_theory: (bool * Position.T) option -> (xstring * Position.T) option -> - (local_theory -> local_theory) -> transition -> transition - val present_local_theory: (xstring * Position.T) option -> (state -> unit) -> - transition -> transition - val local_theory_to_proof': (bool * Position.T) option -> (xstring * Position.T) option -> - (bool -> local_theory -> Proof.state) -> transition -> transition - val local_theory_to_proof: (bool * Position.T) option -> (xstring * Position.T) option -> - (local_theory -> Proof.state) -> transition -> transition - val theory_to_proof: (theory -> Proof.state) -> transition -> transition - val end_proof: (bool -> Proof.state -> Proof.context) -> transition -> transition - val forget_proof: bool -> transition -> transition - val proofs': (bool -> Proof.state -> Proof.state Seq.result Seq.seq) -> transition -> transition - val proof': (bool -> Proof.state -> Proof.state) -> transition -> transition - val proofs: (Proof.state -> Proof.state Seq.result Seq.seq) -> transition -> transition - val proof: (Proof.state -> Proof.state) -> transition -> transition - val actual_proof: (Proof_Node.T -> Proof_Node.T) -> transition -> transition - val skip_proof: (unit -> unit) -> transition -> transition - val skip_proof_open: transition -> transition - val skip_proof_close: transition -> transition - val exec_id: Document_ID.exec -> transitions -> transitions - val setmp_thread_position: transition -> ('a -> 'b) -> 'a -> 'b - val add_hook: (transition -> state -> state -> unit) -> unit - val get_timing: transition -> Time.time - val put_timing: Time.time -> transition -> transition - val transition: bool -> transition -> state -> state * (exn * string) option - val command_errors: bool -> transition -> state -> Runtime.error list * state option - val command_exception: bool -> transition -> state -> state - val reset_theory: state -> state option - val reset_proof: state -> state option - type result - val join_results: result -> (transition * state) list - val element_result: Keyword.keywords -> transition Thy_Syntax.element -> state -> result * state -end; - -structure Toplevel: TOPLEVEL = -struct - -(** toplevel state **) - -exception UNDEF = Runtime.UNDEF; - - -(* datatype node *) - -datatype node = - Theory of generic_theory * Proof.context option - (*theory with presentation context*) | - Proof of Proof_Node.T * ((Proof.context -> generic_theory) * generic_theory) - (*proof node, finish, original theory*) | - Skipped_Proof of int * (generic_theory * generic_theory); - (*proof depth, resulting theory, original theory*) - -val theory_node = fn Theory (gthy, _) => SOME gthy | _ => NONE; -val proof_node = fn Proof (prf, _) => SOME prf | _ => NONE; -val skipped_proof_node = fn Skipped_Proof _ => true | _ => false; - -fun cases_node f _ (Theory (gthy, _)) = f gthy - | cases_node _ g (Proof (prf, _)) = g (Proof_Node.current prf) - | cases_node f _ (Skipped_Proof (_, (gthy, _))) = f gthy; - - -(* datatype state *) - -datatype state = State of node option * node option * - (node option * node option); (*current, previous, backup*) - -fun State' (n1, n2) = State (n1, n2, (n1, n2)) - -fun theory_toplevel thy = - State' (SOME (Theory (Context.Theory thy, NONE)), NONE); - -val toplevel = State' (NONE, NONE); - -fun is_toplevel (State (NONE, _, _)) = true - | is_toplevel _ = false; - -fun level (State (NONE, _, _)) = 0 - | level (State (SOME (Theory _), _, _)) = 0 - | level (State (SOME (Proof (prf, _)), _, _)) = Proof.level (Proof_Node.current prf) - | level (State (SOME (Skipped_Proof (d, _)), _, _)) = d + 1; (*different notion of proof depth!*) - -fun str_of_state (State (NONE, SOME (Theory (Context.Theory thy, _)), _)) = - "at top level, result theory " ^ quote (Context.theory_name thy) - | str_of_state (State (NONE, _, _)) = "at top level" - | str_of_state (State (SOME (Theory (Context.Theory _, _)), _, _)) = "in theory mode" - | str_of_state (State (SOME (Theory (Context.Proof _, _)), _, _)) = "in local theory mode" - | str_of_state (State (SOME (Proof _), _, _)) = "in proof mode" - | str_of_state (State (SOME (Skipped_Proof _), _, _)) = "in skipped proof mode"; - - -(* current node *) - -fun node_of (State (NONE, _, _)) = raise UNDEF - | node_of (State (SOME node, _, _)) = node; - -fun is_theory state = not (is_toplevel state) andalso is_some (theory_node (node_of state)); -fun is_proof state = not (is_toplevel state) andalso is_some (proof_node (node_of state)); -fun is_skipped_proof state = not (is_toplevel state) andalso skipped_proof_node (node_of state); - -fun node_case f g state = cases_node f g (node_of state); - -fun previous_theory_of (State (_, NONE, _)) = NONE - | previous_theory_of (State (_, SOME prev, _)) = - SOME (cases_node Context.theory_of Proof.theory_of prev); - -val context_of = node_case Context.proof_of Proof.context_of; -val generic_theory_of = node_case I (Context.Proof o Proof.context_of); -val theory_of = node_case Context.theory_of Proof.theory_of; -val proof_of = node_case (fn _ => error "No proof state") I; -fun proof_of' st = if is_proof st then SOME (proof_of st) else NONE; - -fun proof_position_of state = - (case node_of state of - Proof (prf, _) => Proof_Node.position prf - | _ => ~1); - -fun is_end_theory (State (NONE, SOME (Theory (Context.Theory _, _)), _)) = true - | is_end_theory _ = false; - -fun end_theory _ (State (NONE, SOME (Theory (Context.Theory thy, _)), _)) = thy - | end_theory pos (State (NONE, _, _)) = error ("Bad theory" ^ Position.here pos) - | end_theory pos (State (SOME _, _, _)) = error ("Unfinished theory" ^ Position.here pos); - - -(* presentation context *) - -structure Presentation_State = Proof_Data -( - type T = state option; - fun init _ = NONE; -); - -fun presentation_context0 state = - (case try node_of state of - SOME (Theory (_, SOME ctxt)) => ctxt - | SOME node => cases_node Context.proof_of Proof.context_of node - | NONE => - (case try Theory.get_pure () of - SOME thy => Proof_Context.init_global thy - | NONE => raise UNDEF)); - -fun presentation_context (state as State (current, _, backup)) = - presentation_context0 state - |> Presentation_State.put (SOME (State (current, NONE, backup))); - -fun presentation_state ctxt = - (case Presentation_State.get ctxt of - NONE => State' (SOME (Theory (Context.Proof ctxt, SOME ctxt)), NONE) - | SOME state => state); - - -(* print state *) - -fun pretty_context state = - (case try node_of state of - NONE => [] - | SOME node => - let - val gthy = - (case node of - Theory (gthy, _) => gthy - | Proof (_, (_, gthy)) => gthy - | Skipped_Proof (_, (_, gthy)) => gthy); - val lthy = Context.cases (Named_Target.theory_init) I gthy; - in Local_Theory.pretty lthy end); - -fun pretty_state state = - (case try node_of state of - NONE => [] - | SOME (Theory _) => [] - | SOME (Proof (prf, _)) => Proof.pretty_state (Proof_Node.current prf) - | SOME (Skipped_Proof (d, _)) => [Pretty.str ("skipped proof: depth " ^ string_of_int d)]); - -val string_of_state = pretty_state #> Pretty.chunks #> Pretty.string_of; - -fun pretty_abstract state = Pretty.str ("<Isar " ^ str_of_state state ^ ">"); - -val _ = ML_system_pp (fn _ => fn _ => Pretty.to_polyml o pretty_abstract); - - - -(** toplevel transitions **) - -(* node transactions -- maintaining stable checkpoints *) - -exception FAILURE of state * exn; - -local - -fun reset_presentation (Theory (gthy, _)) = Theory (gthy, NONE) - | reset_presentation node = node; - -in - -fun apply_transaction gthy f g node = - let - val cont_node = reset_presentation node; - val context = cases_node I (Context.Proof o Proof.context_of) cont_node; - fun state_error e nd = (State (SOME nd, SOME cont_node, gthy), e); - - val (result, err) = - cont_node - |> Runtime.controlled_execution (SOME context) f - |> state_error NONE - handle exn => state_error (SOME exn) cont_node; - in - (case err of - NONE => tap g result - | SOME exn => raise FAILURE (result, exn)) - end; - -fun exit_transaction gthy = - apply_transaction gthy - (fn Theory (Context.Theory thy, _) => Theory (Context.Theory (Theory.end_theory thy), NONE) - | node => node) (K ()) - #> (fn State (node', _, gthy) => State (NONE, node', gthy)); - -end; - - -(* primitive transitions *) - -datatype trans = - Init of unit -> theory | (*init theory*) - Exit | (*formal exit of theory*) - Keep of bool -> state -> unit | (*peek at state*) - Transaction of (bool -> node -> node) * (state -> unit); (*node transaction and presentation*) - -local - -fun apply_tr _ (Init f) (State (NONE, _, gthy)) = - State (SOME (Theory (Context.Theory (Runtime.controlled_execution NONE f ()), NONE)), NONE, gthy) - | apply_tr _ Exit (State (SOME (state as Theory (Context.Theory _, _)), _, gthy)) = - exit_transaction gthy state - | apply_tr int (Keep f) state = - Runtime.controlled_execution (try generic_theory_of state) (fn x => tap (f int) x) state - | apply_tr int (Transaction (f, g)) (State (SOME node, _, gthy)) = - apply_transaction gthy (fn x => f int x) g node - | apply_tr _ _ _ = raise UNDEF; - -fun apply_union _ [] state = raise FAILURE (state, UNDEF) - | apply_union int (tr :: trs) state = - apply_union int trs state - handle Runtime.UNDEF => apply_tr int tr state - | FAILURE (alt_state, UNDEF) => apply_tr int tr alt_state - | exn as FAILURE _ => raise exn - | exn => raise FAILURE (state, exn); - -in - -fun apply_trans int trs state = (apply_union int trs state, NONE) - handle FAILURE (alt_state, exn) => (alt_state, SOME exn) | exn => (state, SOME exn); - -end; - - -(* datatype transition *) - -datatype state_read = Load_backup | Load_previous -datatype state_write = Store_backup | Store_default - -datatype transition = Transition of - {name: string, (*command name*) - pos: Position.T, (*source position*) - timing: Time.time, (*prescient timing information*) - trans: trans list, (*primitive transitions (union)*) - read_write: state_read * state_write}; (*state update status*) - -type transitions = transition list - -fun make_transition (name, pos, timing, trans, read_write) = - Transition {name = name, pos = pos, timing = timing, trans = trans, read_write = read_write}; - -fun map_transition f (Transition {name, pos, timing, trans, read_write}) = - make_transition (f (name, pos, timing, trans, read_write)); - -val empty = make_transition ("", Position.none, Time.zeroTime, [], (Load_previous, Store_default)); - - -(* diagnostics *) - -fun name_of (Transition {name, ...}) = name; -fun pos_of (Transition {pos, ...}) = pos; - -fun command_msg msg tr = - msg ^ "command " ^ quote (Markup.markup Markup.keyword1 (name_of tr)) ^ - Position.here (pos_of tr); - -fun at_command tr = command_msg "At " tr; -fun type_error tr = command_msg "Bad context for " tr; - - -(* modify transitions *) - -fun name name = map_transition (fn (_, pos, timing, trans, read_write) => - (name, pos, timing, trans, read_write)); - -fun position pos = map_transition (fn (name, _, timing, trans, read_write) => - (name, pos, timing, trans, read_write)); - -fun read_write read_write = map_transition (fn (name, pos, timing, trans, _) => - (name, pos, timing, trans, read_write)); - -fun add_trans tr = map_transition (fn (name, pos, timing, trans, read_write) => - (name, pos, timing, tr :: trans, read_write)); - -val reset_trans = map_transition (fn (name, pos, timing, _, read_write) => - (name, pos, timing, [], read_write)); - - -(* basic transitions *) - -fun init_theory f = add_trans (Init f); - -fun is_init (Transition {trans = [Init _], ...}) = true - | is_init _ = false; - -fun modify_init' f tr = if is_init tr then init_theory f (reset_trans tr) else tr; -val modify_init = map o modify_init' - -val exit = add_trans Exit; -val keep' = add_trans o Keep; - -fun present_transaction f g = add_trans (Transaction (f, g)); -fun transaction f = present_transaction f (K ()); - -fun keep f = add_trans (Keep (fn _ => f)); - -fun keep_proof f = - keep (fn st => - if is_proof st then f st - else if is_skipped_proof st then () - else warning "No proof state"); - -fun ignored' pos = empty |> name "<ignored>" |> position pos |> keep (fn _ => ()); -fun ignored pos = [ignored' pos]; -fun is_ignored' tr = name_of tr = "<ignored>"; -val is_ignored = fn [] => false | (tr :: _) => is_ignored' tr; - -fun malformed' pos msg = - empty |> name "<malformed>" |> position pos |> keep (fn _ => error msg); -fun malformed pos msg = [malformed' pos msg]; - - -(* theory transitions *) - -fun generic_theory f = transaction (fn _ => - (fn Theory (gthy, _) => Theory (f gthy, NONE) - | _ => raise UNDEF)); - -fun theory' f = transaction (fn int => - (fn Theory (Context.Theory thy, _) => - let val thy' = thy - |> Sign.new_group - |> f int - |> Sign.reset_group; - in Theory (Context.Theory thy', NONE) end - | _ => raise UNDEF)); - -fun theory f = theory' (K f); - -fun begin_local_theory begin f = transaction (fn _ => - (fn Theory (Context.Theory thy, _) => - let - val lthy = f thy; - val gthy = if begin then Context.Proof lthy else Context.Theory (Named_Target.exit lthy); - val _ = - (case Local_Theory.pretty lthy of - [] => () - | prts => Output.state (Pretty.string_of (Pretty.chunks prts))); - in Theory (gthy, SOME lthy) end - | _ => raise UNDEF)); - -val end_local_theory = transaction (fn _ => - (fn Theory (Context.Proof lthy, _) => Theory (Context.Theory (Named_Target.exit lthy), SOME lthy) - | _ => raise UNDEF)); - -fun open_target f = transaction (fn _ => - (fn Theory (gthy, _) => - let val lthy = f gthy - in Theory (Context.Proof lthy, SOME lthy) end - | _ => raise UNDEF)); - -val close_target = transaction (fn _ => - (fn Theory (Context.Proof lthy, _) => - (case try Local_Theory.close_target lthy of - SOME ctxt' => - let - val gthy' = - if can Local_Theory.assert ctxt' - then Context.Proof ctxt' - else Context.Theory (Proof_Context.theory_of ctxt'); - in Theory (gthy', SOME lthy) end - | NONE => raise UNDEF) - | _ => raise UNDEF)); - -fun restricted_context (SOME (strict, scope)) = - Proof_Context.map_naming (Name_Space.restricted strict scope) - | restricted_context NONE = I; - -fun local_theory' restricted target f = present_transaction (fn int => - (fn Theory (gthy, _) => - let - val (finish, lthy) = Named_Target.switch target gthy; - val lthy' = lthy - |> restricted_context restricted - |> Local_Theory.new_group - |> f int - |> Local_Theory.reset_group; - in Theory (finish lthy', SOME lthy') end - | _ => raise UNDEF)) - (K ()); - -fun local_theory restricted target f = local_theory' restricted target (K f); - -fun present_local_theory target = present_transaction (fn _ => - (fn Theory (gthy, _) => - let val (finish, lthy) = Named_Target.switch target gthy; - in Theory (finish lthy, SOME lthy) end - | _ => raise UNDEF)); - - -(* proof transitions *) - -fun end_proof f = transaction (fn int => - (fn Proof (prf, (finish, _)) => - let val state = Proof_Node.current prf in - if can (Proof.assert_bottom true) state then - let - val ctxt' = f int state; - val gthy' = finish ctxt'; - in Theory (gthy', SOME ctxt') end - else raise UNDEF - end - | Skipped_Proof (0, (gthy, _)) => Theory (gthy, NONE) - | _ => raise UNDEF)); - -local - -fun begin_proof init = transaction (fn int => - (fn Theory (gthy, _) => - let - val (finish, prf) = init int gthy; - val document = Options.default_string "document"; - val skip = (document = "" orelse document = "false") andalso Goal.skip_proofs_enabled (); - val schematic_goal = try Proof.schematic_goal prf; - val _ = - if skip andalso schematic_goal = SOME true then - warning "Cannot skip proof of schematic goal statement" - else (); - in - if skip andalso schematic_goal = SOME false then - Skipped_Proof (0, (finish (Proof.global_skip_proof true prf), gthy)) - else Proof (Proof_Node.init prf, (finish, gthy)) - end - | _ => raise UNDEF)); - -in - -fun local_theory_to_proof' restricted target f = begin_proof - (fn int => fn gthy => - let - val (finish, lthy) = Named_Target.switch target gthy; - val prf = lthy - |> restricted_context restricted - |> Local_Theory.new_group - |> f int; - in (finish o Local_Theory.reset_group, prf) end); - -fun local_theory_to_proof restricted target f = - local_theory_to_proof' restricted target (K f); - -fun theory_to_proof f = begin_proof - (fn _ => fn gthy => - (Context.Theory o Sign.reset_group o Sign.change_check o Proof_Context.theory_of, - (case gthy of - Context.Theory thy => f (Sign.new_group thy) - | _ => raise UNDEF))); - -end; - -fun forget_proof strict = transaction (fn _ => - (fn Proof (prf, (_, orig_gthy)) => - if strict andalso not (Proof.has_bottom_goal (Proof_Node.current prf)) - then raise UNDEF else Theory (orig_gthy, NONE) - | Skipped_Proof (_, (_, orig_gthy)) => Theory (orig_gthy, NONE) - | _ => raise UNDEF)); - -fun proofs' f = transaction (fn int => - (fn Proof (prf, x) => Proof (Proof_Node.applys (f int) prf, x) - | skip as Skipped_Proof _ => skip - | _ => raise UNDEF)); - -fun proof' f = proofs' ((Seq.single o Seq.Result) oo f); -val proofs = proofs' o K; -val proof = proof' o K; - - -(* skipped proofs *) - -fun actual_proof f = transaction (fn _ => - (fn Proof (prf, x) => Proof (f prf, x) - | _ => raise UNDEF)); - -fun skip_proof f = transaction (fn _ => - (fn skip as Skipped_Proof _ => (f (); skip) - | _ => raise UNDEF)); - -val skip_proof_open = transaction (fn _ => - (fn Skipped_Proof (d, x) => Skipped_Proof (d + 1, x) - | _ => raise UNDEF)); - -val skip_proof_close = transaction (fn _ => - (fn Skipped_Proof (0, (gthy, _)) => Theory (gthy, NONE) - | Skipped_Proof (d, x) => Skipped_Proof (d - 1, x) - | _ => raise UNDEF)); - - - -(** toplevel transactions **) - -(* runtime position *) - -fun exec_id' id (tr as Transition {pos, ...}) = - position (Position.put_id (Document_ID.print id) pos) tr; -val exec_id = map o exec_id'; - -fun setmp_thread_position (Transition {pos, ...}) f x = - Position.setmp_thread_data pos f x; - - -(* post-transition hooks *) - -local - val hooks = - Synchronized.var "Toplevel.hooks" ([]: (transition -> state -> state -> unit) list); -in - -fun add_hook hook = Synchronized.change hooks (cons hook); -fun get_hooks () = Synchronized.value hooks; - -end; - - -(* apply transitions *) - -fun get_timing (Transition {timing, ...}) = timing; -fun put_timing timing = map_transition (fn (name, pos, _, trans, read_write) => (name, pos, timing, trans, read_write)); - -local - -fun app int (tr as Transition {trans, ...}) = - setmp_thread_position tr - (Timing.protocol (name_of tr) (pos_of tr) (apply_trans int trans) - ##> Option.map (fn UNDEF => ERROR (type_error tr) | exn => exn)); - -fun state_load (Transition {read_write = (read, _), ...}) (st as State (_, _, (nd1, nd0))) = - case read of Load_backup => State' (nd1, nd0) - | Load_previous => st - -fun state_store (Transition {read_write = (_, write), ...}) (st as State (nd1, nd0, _)) = - case write of Store_backup => State' (nd1, nd0) - | Store_default => st - -in - -fun transition int tr st = - let - val st = state_load tr st - val (st', opt_err) = - Context.setmp_generic_context (try (Context.Proof o presentation_context0) st) - (fn () => app int tr st) () - |> apfst (state_store tr); - val opt_err' = opt_err |> Option.map - (fn Runtime.EXCURSION_FAIL exn_info => exn_info - | exn => (Runtime.exn_context (try context_of st) exn, at_command tr)); - val _ = get_hooks () |> List.app (fn f => (try (fn () => f tr st st') (); ())); - in (st', opt_err') end; - -end; - - -(* managed commands *) - -fun command_errors int tr st = - (case transition int tr st of - (st', NONE) => ([], SOME st') - | (_, SOME (exn, _)) => (Runtime.exn_messages exn, NONE)); - -fun command_exception int tr st = - (case transition int tr st of - (st', NONE) => st' - | (_, SOME (exn, info)) => - if Exn.is_interrupt exn then Exn.reraise exn - else raise Runtime.EXCURSION_FAIL (exn, info)); - -val command = command_exception false; - - -(* reset state *) - -local - -fun reset_state check trans st = - if check st then NONE - else #2 (command_errors false (trans empty) st); - -in - -val reset_theory = reset_state is_theory (forget_proof false); - -val reset_proof = - reset_state is_proof - (transaction (fn _ => - (fn Theory (gthy, _) => Skipped_Proof (0, (gthy, gthy)) - | _ => raise UNDEF))); - -end; - - -(* scheduled proof result *) - -datatype result = - Result of transition * state | - Result_List of result list | - Result_Future of result future; - -fun join_results (Result x) = [x] - | join_results (Result_List xs) = maps join_results xs - | join_results (Result_Future x) = join_results (Future.join x); - -local - -structure Result = Proof_Data -( - type T = result; - fun init _ = Result_List []; -); - -val get_result = Result.get o Proof.context_of; -val put_result = Proof.map_context o Result.put; - -fun timing_estimate elem = - let val trs = tl (Thy_Syntax.flat_element elem) - in fold (fn tr => fn t => get_timing tr + t) trs Time.zeroTime end; - -fun future_proofs_enabled estimate st = - (case try proof_of st of - NONE => false - | SOME state => - not (Proof.is_relevant state) andalso - (if can (Proof.assert_bottom true) state - then Future.proofs_enabled 1 - else Future.proofs_enabled 2 orelse Future.proofs_enabled_timing estimate)); - -fun atom_result keywords tr st = - let - val st' = - if Future.proofs_enabled 1 andalso Keyword.is_diag keywords (name_of tr) then - (Execution.fork - {name = "Toplevel.diag", pos = pos_of tr, pri = ~1} - (fn () => command tr st); st) - else command tr st; - in (Result (tr, st'), st') end; - -in - -fun element_result keywords (Thy_Syntax.Element (tr, NONE)) st = atom_result keywords tr st - | element_result keywords (elem as Thy_Syntax.Element (head_tr, SOME element_rest)) st = - let - val (head_result, st') = atom_result keywords head_tr st; - val (body_elems, end_tr) = element_rest; - val estimate = timing_estimate elem; - in - if not (future_proofs_enabled estimate st') - then - let - val proof_trs = maps Thy_Syntax.flat_element body_elems @ [end_tr]; - val (proof_results, st'') = fold_map (atom_result keywords) proof_trs st'; - in (Result_List (head_result :: proof_results), st'') end - else - let - val finish = Context.Theory o Proof_Context.theory_of; - - val future_proof = - Proof.future_proof (fn state => - Execution.fork - {name = "Toplevel.future_proof", pos = pos_of head_tr, pri = ~1} - (fn () => - let - val State (SOME (Proof (prf, (_, orig_gthy))), prev, backup) = st'; - val prf' = Proof_Node.apply (K state) prf; - val (result, result_state) = - State (SOME (Proof (prf', (finish, orig_gthy))), prev, backup) - |> fold_map (element_result keywords) body_elems ||> command end_tr; - in (Result_List result, presentation_context0 result_state) end)) - #> (fn (res, state') => state' |> put_result (Result_Future res)); - - val forked_proof = - proof (future_proof #> - (fn state => state |> Proof.local_done_proof |> put_result (get_result state))) o - end_proof (fn _ => future_proof #> - (fn state => state |> Proof.global_done_proof |> Result.put (get_result state))); - - val st'' = st' - |> command (head_tr |> reset_trans |> forked_proof); - val end_result = Result (end_tr, st''); - val result = - Result_List [head_result, Result.get (presentation_context0 st''), end_result]; - in (result, st'') end - end; - -end; - -end; diff --git a/Citadelle/src/compiler_generic/isabelle_para/src/Pure/PIDE/command.ML b/Citadelle/src/compiler_generic/isabelle_para/src/Pure/PIDE/command.ML deleted file mode 100644 index 816a38194e81e64d6cc6e6616bbcb70978b5c6b5..0000000000000000000000000000000000000000 --- a/Citadelle/src/compiler_generic/isabelle_para/src/Pure/PIDE/command.ML +++ /dev/null @@ -1,503 +0,0 @@ -(* Title: Pure/PIDE/command.ML - Author: Makarius - -Prover command execution: read -- eval -- print. -*) - -signature COMMAND = -sig - type blob = (string * (SHA1.digest * string list) option) Exn.result - val read_file: Path.T -> Position.T -> Path.T -> Token.file - val read_thy: Toplevel.state -> theory - val read: Keyword.keywords -> theory -> Proof.state option -> Path.T-> (unit -> theory) -> - blob list * int -> Token.T list -> Toplevel.transitions - type eval - val eval_command_id: eval -> Document_ID.command - val eval_exec_id: eval -> Document_ID.exec - val eval_eq: eval * eval -> bool - val eval_running: eval -> bool - val eval_finished: eval -> bool - val eval_result_command: eval -> Toplevel.transitions - val eval_result_state: eval -> Toplevel.state - val eval: Keyword.keywords -> Path.T -> (unit -> theory) -> - blob list * int -> Document_ID.command -> Token.T list -> eval -> eval - type print - type print_fn = Toplevel.transition -> Toplevel.state -> unit - val print0: {pri: int, print_fn: print_fn} -> eval -> print - val print: bool -> (string * string list) list -> Keyword.keywords -> string -> - eval -> print list -> print list option - val parallel_print: print -> bool - type print_function = - {keywords: Keyword.keywords, command_name: string, args: string list, exec_id: Document_ID.exec} -> - {delay: Time.time option, pri: int, persistent: bool, strict: bool, print_fn: print_fn} option - val print_function: string -> print_function -> unit - val no_print_function: string -> unit - type exec = eval * print list - val init_exec: theory option -> exec - val no_exec: exec - val exec_ids: exec option -> Document_ID.exec list - val exec: Document_ID.execution -> exec -> unit - val exec_parallel_prints: Document_ID.execution -> Future.task list -> exec -> exec option -end; - -structure Command: COMMAND = -struct - -(** main phases of execution **) - -fun task_context group f = - f - |> Future.interruptible_task - |> Future.task_context "Command.run_process" group; - - -(* read *) - -type blob = - (string * (SHA1.digest * string list) option) Exn.result; (*file node name, digest, lines*) - -fun read_file_node file_node master_dir pos src_path = - let - val _ = Position.report pos Markup.language_path; - val _ = - (case try Url.explode file_node of - NONE => () - | SOME (Url.File _) => () - | _ => - error ("Prover cannot load remote file " ^ - Markup.markup (Markup.path file_node) (quote file_node))); - val full_path = File.check_file (File.full_path master_dir src_path); - val text = File.read full_path; - val lines = split_lines text; - val digest = SHA1.digest text; - in {src_path = src_path, lines = lines, digest = digest, pos = Path.position full_path} end - handle ERROR msg => error (msg ^ Position.here pos); - -val read_file = read_file_node ""; - -local - -fun blob_file src_path lines digest file_node = - let - val file_pos = - Position.file file_node |> - (case Position.get_id (Position.thread_data ()) of - NONE => I - | SOME exec_id => Position.put_id exec_id); - in {src_path = src_path, lines = lines, digest = digest, pos = file_pos} end - -fun resolve_files keywords master_dir (blobs, blobs_index) toks = - (case Outer_Syntax.parse_spans toks of - [Command_Span.Span (Command_Span.Command_Span (cmd, _), _)] => - (case try (nth toks) blobs_index of - SOME tok => - let - val pos = Token.pos_of tok; - val path = Path.explode (Token.content_of tok) - handle ERROR msg => error (msg ^ Position.here pos); - fun make_file src_path (Exn.Res (file_node, NONE)) = - Exn.interruptible_capture (fn () => - read_file_node file_node master_dir pos src_path) () - | make_file src_path (Exn.Res (file_node, SOME (digest, lines))) = - (Position.report pos Markup.language_path; - Exn.Res (blob_file src_path lines digest file_node)) - | make_file _ (Exn.Exn e) = Exn.Exn e; - val src_paths = Keyword.command_files keywords cmd path; - val files = - if null blobs then - map2 make_file src_paths (map (K (Exn.Res ("", NONE))) src_paths) - else if length src_paths = length blobs then - map2 make_file src_paths blobs - else error ("Misalignment of inlined files" ^ Position.here pos); - in - toks |> map_index (fn (i, tok) => - if i = blobs_index then Token.put_files files tok else tok) - end - | NONE => toks) - | _ => toks); - -fun reports_of_token keywords tok = - let - val malformed_symbols = - Input.source_explode (Token.input_of tok) - |> map_filter (fn (sym, pos) => - if Symbol.is_malformed sym - then SOME ((pos, Markup.bad ()), "Malformed symbolic character") else NONE); - val is_malformed = Token.is_error tok orelse not (null malformed_symbols); - val reports = Token.reports keywords tok @ Token.completion_report tok @ malformed_symbols; - in (is_malformed, reports) end; - -in - -fun read_thy st = Toplevel.theory_of st - handle Toplevel.UNDEF => Pure_Syn.bootstrap_thy; - -fun read keywords thy st master_dir init blobs_info span = - let - val command_reports = Outer_Syntax.command_reports thy; - - val core_range = Token.range_of (drop_suffix Token.is_ignored span); - val pos = - (case find_first Token.is_command span of - SOME tok => Token.pos_of tok - | NONE => #1 core_range); - - val token_reports = map (reports_of_token keywords) span; - val _ = Position.reports_text (maps #2 token_reports @ maps command_reports span); - in - if exists #1 token_reports then Toplevel.malformed pos "Malformed command syntax" - else - (case Outer_Syntax.parse_tokens thy st (resolve_files keywords master_dir blobs_info span) of - [tr] => Toplevel.modify_init init tr - | [] => Toplevel.ignored (#1 (Token.range_of span)) - | _ => Toplevel.malformed (#1 core_range) "Exactly one command expected") - handle ERROR msg => Toplevel.malformed (#1 core_range) msg - end; - -end; - - -(* eval *) - -type ('transition, 'state) eval_state = {failed: bool, command: 'transition, state: 'state}; -type eval_states = (Toplevel.transitions, Toplevel.state list) eval_state; - -fun init_eval_state opt_thy = - {failed = false, - command = [], - state = [case opt_thy of NONE => Toplevel.toplevel | SOME thy => Toplevel.theory_toplevel thy]}; - -datatype eval = - Eval of - {command_id: Document_ID.command, exec_id: Document_ID.exec, eval_process: eval_states lazy}; - -fun eval_command_id (Eval {command_id, ...}) = command_id; - -fun eval_exec_id (Eval {exec_id, ...}) = exec_id; -val eval_eq = op = o apply2 eval_exec_id; - -val eval_running = Execution.is_running_exec o eval_exec_id; -fun eval_finished (Eval {eval_process, ...}) = Lazy.is_finished eval_process; - -fun eval_result (Eval {eval_process, ...}) = - task_context (Future.worker_subgroup ()) Lazy.force eval_process; - -val eval_result_command = #command o eval_result; -val eval_result_state = List.last o #state o eval_result; - -local - -fun reset_state keywords tr st0 = Toplevel.setmp_thread_position tr (fn () => - let - val name = Toplevel.name_of tr; - val res = - if Keyword.is_theory_body keywords name then Toplevel.reset_theory st0 - else if Keyword.is_proof keywords name then Toplevel.reset_proof st0 - else NONE; - in - (case res of - NONE => st0 - | SOME st => (Output.error_message (Toplevel.type_error tr ^ " -- using reset state"); st)) - end) (); - -fun run keywords int tr st = - if Future.proofs_enabled 1 andalso Keyword.is_diag keywords (Toplevel.name_of tr) then - (Execution.fork {name = "Toplevel.diag", pos = Toplevel.pos_of tr, pri = ~1} - (fn () => Toplevel.command_exception int tr st); ([], SOME st)) - else Toplevel.command_errors int tr st; - -fun check_token_comments ctxt tok = - (Thy_Output.check_comments ctxt (Input.source_explode (Token.input_of tok)); []) - handle exn => - if Exn.is_interrupt exn then Exn.reraise exn - else Runtime.exn_messages exn; - -fun check_span_comments ctxt span tr = - Toplevel.setmp_thread_position tr (fn () => maps (check_token_comments ctxt) span) (); - -fun report tr m = - Toplevel.setmp_thread_position tr (fn () => Output.report [Markup.markup_only m]) (); - -fun status tr m = - Toplevel.setmp_thread_position tr (fn () => Output.status (Markup.markup_only m)) (); - -fun command_indent tr st = - (case try Toplevel.proof_of st of - SOME prf => - let val keywords = Thy_Header.get_keywords (Proof.theory_of prf) in - if Keyword.command_kind keywords (Toplevel.name_of tr) = SOME Keyword.prf_script then - (case try Proof.goal prf of - SOME {goal, ...} => - let val n = Thm.nprems_of goal - in if n > 1 then report tr (Markup.command_indent (n - 1)) else () end - | NONE => ()) - else () - end - | NONE => ()); - - -fun eval_state' keywords span tr state = - let - val _ = Thread_Attributes.expose_interrupt (); - - val st = reset_state keywords tr state; - - val _ = command_indent tr st; - val _ = status tr Markup.running; - val (errs1, result) = run keywords true tr st; - val errs2 = - (case result of - NONE => [] - | SOME st' => - (case try Toplevel.presentation_context st' of - NONE => [] - | SOME ctxt' => check_span_comments ctxt' span tr)); - val errs = errs1 @ errs2; - val _ = List.app (Future.error_message (Toplevel.pos_of tr)) errs; - in - (case result of - NONE => - let - val _ = status tr Markup.failed; - val _ = status tr Markup.finished; - val _ = if null errs then (report tr (Markup.bad ()); Exn.interrupt ()) else (); - in {failed = true, command = tr, state = st} end - | SOME st' => - let - val _ = status tr Markup.finished; - in {failed = false, command = tr, state = st'} end) - end; - -fun eval_state keywords span l_tr ({state, ...}: eval_states) = - let val (tr_st, (failed, _)) = - fold_map (fn tr => fn (failed, state) => - let val result = eval_state' keywords span tr state in - ((#command result, #state result), (failed orelse #failed result, #state result)) - end) - l_tr - (false, List.last state) - in {failed = failed, command = map #1 tr_st, state = map #2 tr_st} end; - -in - -fun eval keywords master_dir init blobs_info command_id span eval0 = - let - val exec_id = Document_ID.make (); - fun process () = - let - val eval_state0 = eval_result eval0; - val state0 = List.last (#state eval_state0); - val thy = read_thy state0; - val st = Toplevel.proof_of' state0; - val tr = - Position.setmp_thread_data (Position.id_only (Document_ID.print exec_id)) - (fn () => - read keywords thy st master_dir init blobs_info span |> Toplevel.exec_id exec_id) (); - in eval_state keywords span tr eval_state0 end; - in - Eval {command_id = command_id, exec_id = exec_id, eval_process = Lazy.lazy_name "Command.eval" process} - end; - -end; - - -(* print *) - -datatype print = Print of - {name: string, args: string list, delay: Time.time option, pri: int, persistent: bool, - exec_id: Document_ID.exec, print_process: unit lazy}; - -fun print_exec_id (Print {exec_id, ...}) = exec_id; -val print_eq = op = o apply2 print_exec_id; - -type print_fn = Toplevel.transition -> Toplevel.state -> unit; - -type print_function = - {keywords: Keyword.keywords, command_name: string, args: string list, exec_id: Document_ID.exec} -> - {delay: Time.time option, pri: int, persistent: bool, strict: bool, print_fn: print_fn} option; - -local - -val print_functions = - Synchronized.var "Command.print_functions" ([]: (string * print_function) list); - -fun print_error tr opt_context e = - (Toplevel.setmp_thread_position tr o Runtime.controlled_execution opt_context) e () - handle exn => - if Exn.is_interrupt exn then Exn.reraise exn - else List.app (Future.error_message (Toplevel.pos_of tr)) (Runtime.exn_messages exn); - -fun print_finished (Print {print_process, ...}) = Lazy.is_finished print_process; - -fun print_persistent (Print {persistent, ...}) = persistent; - -val overlay_ord = prod_ord string_ord (list_ord string_ord); - -fun make_print (name, args) {delay, pri, persistent, strict, print_fn} eval = - let - val exec_id = Document_ID.make (); - fun process () = - let - val {failed, command, state = st', ...} = eval_result eval; - val tr = Toplevel.exec_id exec_id command; - in - if failed andalso strict then () - else List.app (fn (tr, st') => print_error tr - (try Toplevel.generic_theory_of st') - (fn () => print_fn tr st')) - (ListPair.zip (tr, st')) - end; - in - Print { - name = name, args = args, delay = delay, pri = pri, persistent = persistent, - exec_id = exec_id, print_process = Lazy.lazy_name "Command.print" process} - end; - -fun bad_print name_args exn = - make_print name_args {delay = NONE, pri = 0, persistent = false, - strict = false, print_fn = fn _ => fn _ => Exn.reraise exn}; - -in - -fun print0 {pri, print_fn} = - make_print ("", [serial_string ()]) - {delay = NONE, pri = pri, persistent = true, strict = true, print_fn = print_fn}; - -fun print command_visible command_overlays keywords command_name eval old_prints = - let - val print_functions = Synchronized.value print_functions; - - fun new_print (name, args) get_pr = - let - val params = - {keywords = keywords, - command_name = command_name, - args = args, - exec_id = eval_exec_id eval}; - in - (case Exn.capture (Runtime.controlled_execution NONE get_pr) params of - Exn.Res NONE => NONE - | Exn.Res (SOME pr) => SOME (make_print (name, args) pr eval) - | Exn.Exn exn => SOME (bad_print (name, args) exn eval)) - end; - - fun get_print (name, args) = - (case find_first (fn Print print => (#name print, #args print) = (name, args)) old_prints of - NONE => - (case AList.lookup (op =) print_functions name of - NONE => - SOME (bad_print (name, args) (ERROR ("Missing print function " ^ quote name)) eval) - | SOME get_pr => new_print (name, args) get_pr) - | some => some); - - val retained_prints = - filter (fn print => print_finished print andalso print_persistent print) old_prints; - val visible_prints = - if command_visible then - fold (fn (name, _) => cons (name, [])) print_functions command_overlays - |> sort_distinct overlay_ord - |> map_filter get_print - else []; - val new_prints = visible_prints @ retained_prints; - in - if eq_list print_eq (old_prints, new_prints) then NONE else SOME new_prints - end; - -fun parallel_print (Print {pri, ...}) = - pri <= 0 orelse (Future.enabled () andalso Options.default_bool "parallel_print"); - -fun print_function name f = - Synchronized.change print_functions (fn funs => - (if name = "" then error "Unnamed print function" else (); - if not (AList.defined (op =) funs name) then () - else warning ("Redefining command print function: " ^ quote name); - AList.update (op =) (name, f) funs)); - -fun no_print_function name = - Synchronized.change print_functions (filter_out (equal name o #1)); - -end; - -val _ = - print_function "Execution.print" - (fn {args, exec_id, ...} => - if null args then - SOME {delay = NONE, pri = Task_Queue.urgent_pri + 2, persistent = false, strict = false, - print_fn = fn _ => fn _ => Execution.fork_prints exec_id} - else NONE); - -val _ = - print_function "print_state" - (fn {keywords, command_name, ...} => - if Options.default_bool "editor_output_state" andalso Keyword.is_printed keywords command_name - then - SOME {delay = NONE, pri = Task_Queue.urgent_pri + 1, persistent = false, strict = false, - print_fn = fn _ => fn st => - if Toplevel.is_proof st then Output.state (Toplevel.string_of_state st) - else ()} - else NONE); - - -(* combined execution *) - -type exec = eval * print list; - -fun init_exec opt_thy : exec = - (Eval - {command_id = Document_ID.none, exec_id = Document_ID.none, - eval_process = Lazy.value (init_eval_state opt_thy)}, []); - -val no_exec = init_exec NONE; - -fun exec_ids NONE = [] - | exec_ids (SOME (eval, prints)) = eval_exec_id eval :: map print_exec_id prints; - -local - -fun run_process execution_id exec_id process = - let val group = Future.worker_subgroup () in - if Execution.running execution_id exec_id [group] then - ignore (task_context group Lazy.force_result process) - else () - end; - -fun ignore_process process = - Lazy.is_running process orelse Lazy.is_finished process; - -fun run_eval execution_id (Eval {exec_id, eval_process, ...}) = - if Lazy.is_finished eval_process then () - else run_process execution_id exec_id eval_process; - -fun fork_print execution_id deps (Print {name, delay, pri, exec_id, print_process, ...}) = - let - val group = Future.worker_subgroup (); - fun fork () = - ignore ((singleton o Future.forks) - {name = name, group = SOME group, deps = deps, pri = pri, interrupts = true} - (fn () => - if ignore_process print_process then () - else run_process execution_id exec_id print_process)); - in - (case delay of - NONE => fork () - | SOME d => ignore (Event_Timer.request (Time.now () + d) fork)) - end; - -fun run_print execution_id (print as Print {exec_id, print_process, ...}) = - if ignore_process print_process then () - else if parallel_print print then fork_print execution_id [] print - else run_process execution_id exec_id print_process; - -in - -fun exec execution_id (eval, prints) = - (run_eval execution_id eval; List.app (run_print execution_id) prints); - -fun exec_parallel_prints execution_id deps (exec as (Eval {eval_process, ...}, prints)) = - if Lazy.is_finished eval_process - then (List.app (fork_print execution_id deps) prints; NONE) - else SOME exec; - -end; - -end; diff --git a/Citadelle/src/compiler_generic/isabelle_para/src/Pure/Thy/thy_info.ML b/Citadelle/src/compiler_generic/isabelle_para/src/Pure/Thy/thy_info.ML deleted file mode 100644 index 13f45fb2214bc335504e6d168cd1c6aab24b03cf..0000000000000000000000000000000000000000 --- a/Citadelle/src/compiler_generic/isabelle_para/src/Pure/Thy/thy_info.ML +++ /dev/null @@ -1,536 +0,0 @@ -(* Title: Pure/Thy/thy_info.ML - Author: Markus Wenzel, TU Muenchen - -Global theory info database, with auto-loading according to theory and -file dependencies. -*) - -signature THY_INFO = -sig - type presentation_context = - {options: Options.T, file_pos: Position.T, adjust_pos: Position.T -> Position.T, - segments: Thy_Output.segment list} - val apply_presentation: presentation_context -> theory -> unit - val add_presentation: (presentation_context -> theory -> unit) -> theory -> theory - val get_names: unit -> string list - val lookup_theory: string -> theory option - val get_theory: string -> theory - val master_directory: string -> Path.T - val remove_thy: string -> unit - type context = - {options: Options.T, - symbols: HTML.symbols, - bibtex_entries: string list, - last_timing: Toplevel.transition -> Time.time} - val use_theories: context -> string -> Path.T -> (string * Position.T) list -> unit - val use_thy: string -> unit - val script_thy: Position.T -> string -> theory -> theory - val register_thy: theory -> unit - val finish: unit -> unit -end; - -structure Thy_Info: THY_INFO = -struct - -(** presentation of consolidated theory **) - -type presentation_context = - {options: Options.T, file_pos: Position.T, adjust_pos: Position.T -> Position.T, - segments: Thy_Output.segment list}; - -structure Presentation = Theory_Data -( - type T = ((presentation_context -> theory -> unit) * stamp) list; - val empty = []; - val extend = I; - fun merge data : T = Library.merge (eq_snd op =) data; -); - -fun apply_presentation (context: presentation_context) thy = - ignore (Presentation.get thy |> Par_List.map (fn (f, _) => f context thy)); - -fun add_presentation f = Presentation.map (cons (f, stamp ())); - -val _ = - Theory.setup (add_presentation (fn {options, file_pos, segments, ...} => fn thy => - if exists (Toplevel.is_skipped_proof o #state) segments then () - else - let - val body = Thy_Output.present_thy options thy segments; - val option = Present.document_option options; - in - if #disabled option then () - else - let - val latex = Latex.isabelle_body (Context.theory_name thy) body; - val output = [Latex.output_text latex, Latex.output_positions file_pos latex]; - val _ = - if Options.bool options "export_document" - then Export.export thy "document.tex" output else (); - val _ = if #enabled option then Present.theory_output thy output else (); - in () end - end)); - - - -(** thy database **) - -(* messages *) - -val show_path = space_implode " via " o map quote; - -fun cycle_msg names = "Cyclic dependency of " ^ show_path names; - - -(* derived graph operations *) - -fun add_deps name parents G = String_Graph.add_deps_acyclic (name, parents) G - handle String_Graph.CYCLES namess => error (cat_lines (map cycle_msg namess)); - -fun new_entry name parents entry = - String_Graph.new_node (name, entry) #> add_deps name parents; - - -(* global thys *) - -type deps = - {master: (Path.T * SHA1.digest), (*master dependencies for thy file*) - imports: (string * Position.T) list}; (*source specification of imports (partially qualified)*) - -fun make_deps master imports : deps = {master = master, imports = imports}; - -fun master_dir_deps (d: deps option) = - the_default Path.current (Option.map (Path.dir o #1 o #master) d); - -local - val global_thys = - Synchronized.var "Thy_Info.thys" - (String_Graph.empty: (deps option * theory option) String_Graph.T); -in - fun get_thys () = Synchronized.value global_thys; - fun change_thys f = Synchronized.change global_thys f; -end; - -fun get_names () = String_Graph.topological_order (get_thys ()); - - -(* access thy *) - -fun lookup thys name = try (String_Graph.get_node thys) name; -fun lookup_thy name = lookup (get_thys ()) name; - -fun get thys name = - (case lookup thys name of - SOME thy => thy - | NONE => error ("Theory loader: nothing known about theory " ^ quote name)); - -fun get_thy name = get (get_thys ()) name; - - -(* access deps *) - -val lookup_deps = Option.map #1 o lookup_thy; - -val master_directory = master_dir_deps o #1 o get_thy; - - -(* access theory *) - -fun lookup_theory name = - (case lookup_thy name of - SOME (_, SOME theory) => SOME theory - | _ => NONE); - -fun get_theory name = - (case lookup_theory name of - SOME theory => theory - | _ => error ("Theory loader: undefined entry for theory " ^ quote name)); - -val get_imports = Resources.imports_of o get_theory; - - - -(** thy operations **) - -(* remove *) - -fun remove name thys = - (case lookup thys name of - NONE => thys - | SOME (NONE, _) => error ("Cannot update finished theory " ^ quote name) - | SOME _ => - let - val succs = String_Graph.all_succs thys [name]; - val _ = writeln ("Theory loader: removing " ^ commas_quote succs); - in fold String_Graph.del_node succs thys end); - -val remove_thy = change_thys o remove; - - -(* update *) - -fun update deps theory thys = - let - val name = Context.theory_long_name theory; - val parents = map Context.theory_long_name (Theory.parents_of theory); - - val thys' = remove name thys; - val _ = map (get thys') parents; - in new_entry name parents (SOME deps, SOME theory) thys' end; - -fun update_thy deps theory = change_thys (update deps theory); - - -(* context *) - -type context = - {options: Options.T, - symbols: HTML.symbols, - bibtex_entries: string list, - last_timing: Toplevel.transition -> Time.time}; - -fun default_context (): context = - {options = Options.default (), - symbols = HTML.no_symbols, - bibtex_entries = [], - last_timing = K Time.zeroTime}; - - -(* scheduling loader tasks *) - -datatype result = - Result of {theory: theory, exec_id: Document_ID.exec, - present: unit -> unit, commit: unit -> unit, weight: int}; - -fun theory_result theory = - Result {theory = theory, exec_id = Document_ID.none, present = I, commit = I, weight = 0}; - -fun result_theory (Result {theory, ...}) = theory; -fun result_present (Result {present, ...}) = present; -fun result_commit (Result {commit, ...}) = commit; -fun result_ord (Result {weight = i, ...}, Result {weight = j, ...}) = int_ord (j, i); - -fun join_theory (Result {theory, exec_id, ...}) = - let - val _ = Execution.join [exec_id]; - val res = Exn.capture Thm.consolidate_theory theory; - val exns = maps Task_Queue.group_status (Execution.peek exec_id); - in res :: map Exn.Exn exns end; - -datatype task = - Task of string list * (theory list -> result) | - Finished of theory; - -fun task_finished (Task _) = false - | task_finished (Finished _) = true; - -fun task_parents deps (parents: string list) = map (the o AList.lookup (op =) deps) parents; - -val schedule_seq = - String_Graph.schedule (fn deps => fn (_, task) => - (case task of - Task (parents, body) => - let - val result = body (task_parents deps parents); - val _ = Par_Exn.release_all (join_theory result); - val _ = result_present result (); - val _ = result_commit result (); - in result_theory result end - | Finished thy => thy)) #> ignore; - -val schedule_futures = Thread_Attributes.uninterruptible (fn _ => fn tasks => - let - val futures = tasks - |> String_Graph.schedule (fn deps => fn (name, task) => - (case task of - Task (parents, body) => - (singleton o Future.forks) - {name = "theory:" ^ name, group = NONE, - deps = map (Future.task_of o #2) deps, pri = 0, interrupts = true} - (fn () => - (case filter (not o can Future.join o #2) deps of - [] => body (map (result_theory o Future.join) (task_parents deps parents)) - | bad => - error - ("Failed to load theory " ^ quote name ^ - " (unresolved " ^ commas_quote (map #1 bad) ^ ")"))) - | Finished theory => Future.value (theory_result theory))); - - val results1 = futures - |> maps (fn future => - (case Future.join_result future of - Exn.Res result => join_theory result - | Exn.Exn exn => [Exn.Exn exn])); - - val results2 = futures - |> map_filter (Exn.get_res o Future.join_result) - |> sort result_ord - |> Par_List.map (fn result => Exn.capture (result_present result) ()); - - (* FIXME more precise commit order (!?) *) - val results3 = futures - |> map (fn future => Exn.capture (fn () => result_commit (Future.join future) ()) ()); - - (* FIXME avoid global Execution.reset (!??) *) - val results4 = map Exn.Exn (maps Task_Queue.group_status (Execution.reset ())); - - val _ = Par_Exn.release_all (results1 @ results2 @ results3 @ results4); - in () end); - - -(* eval theory *) - -datatype span_raw = - Span_cmd of Command_Span.span - | Span_tr of Toplevel.transition - -fun excursion keywords master_dir last_timing init elements = - let - fun prepare_span st = fn - Span_cmd span => - Command_Span.content span - |> Command.read keywords (Command.read_thy st) (Toplevel.proof_of' st) master_dir init ([], ~1) - |> map (fn tr => Toplevel.put_timing (last_timing tr) tr) - | Span_tr tr => [tr]; - - fun element_result elem (st, _) = - let - val (results, st') = Toplevel.element_result keywords elem st; - val pos' = Toplevel.pos_of (Thy_Syntax.last_element elem); - in (results, (st', pos')) end; - - val meta_cmd = fn [_] => false | _ => true - val (results, (end_state, end_pos)) = - let fun aux _ ([], acc) = ([], acc) - | aux prev_xs ((x :: xs), acc) = - let - val x0 = Thy_Syntax.map_element (prepare_span (#1 acc)) x - in - if Thy_Syntax.exists_element meta_cmd x0 then - let val (l_reparse, prev_xs) = - if case x0 of Thy_Syntax.Element (a0, _) => meta_cmd a0 then - prev_xs |> - (Scan.permissive (Scan.one (fn (Thy_Syntax.Element (_, NONE), _) => true | _ => false) >> (fn l => [l])) - || Scan.succeed []) - else ([], prev_xs) - in - aux - prev_xs - (apfst - (fn l => - Thy_Syntax.parse_elements keywords - (fn x => Span_cmd (Command_Span.Span (x, []))) - (fn Span_cmd (Command_Span.Span (x, _)) => x - | Span_tr tr => Command_Span.Command_Span (Toplevel.name_of tr, Toplevel.pos_of tr)) - (List.concat (List.concat [ l, - map (map Span_tr) (Thy_Syntax.flat_element x0), - map Thy_Syntax.flat_element xs]))) - (case map (apfst Thy_Syntax.flat_element) (rev l_reparse) of - [] => ([], acc) - | (x, acc) :: xs => (x :: map #1 xs, acc))) - end - else - let - val x0 = Thy_Syntax.map_element hd x0 - val (x', acc') = element_result x0 acc; - val (xs', acc'') = aux ((Thy_Syntax.map_element Span_tr x0, acc) :: prev_xs) (xs, acc'); - in (x' :: xs', acc'') end - end - in - aux [] (elements, (Toplevel.toplevel, Position.none)) - end; - val thy = Toplevel.end_theory end_pos end_state; - in (results, thy) end; - -fun eval_thy (context: context) update_time master_dir header text_pos text parents = - let - val {options, symbols, bibtex_entries, last_timing} = context; - val (name, _) = #name header; - val keywords = - fold (curry Keyword.merge_keywords o Thy_Header.get_keywords) parents - (Keyword.add_keywords (#keywords header) Keyword.empty_keywords); - - val spans = Outer_Syntax.parse_spans (Token.explode keywords text_pos text); - val elements = map (Thy_Syntax.map_element Span_cmd) - (Thy_Syntax.parse_elements keywords - (fn x => Command_Span.Span (x, [])) - (fn Command_Span.Span (x, _) => x) - spans) - - fun init () = - Resources.begin_theory master_dir header parents - |> Present.begin_theory bibtex_entries update_time - (fn () => implode (map (HTML.present_span symbols keywords) spans)); - - val (results, thy) = - cond_timeit true ("theory " ^ quote name) - (fn () => excursion keywords master_dir last_timing init elements); - - fun present () = - let - fun split_trans [] acc = rev acc - | split_trans (x :: xs) acc = - case chop_prefix let val pos_of = Toplevel.pos_of o fst - val p = pos_of x in fn t => p = pos_of t end - xs of - (xs1, xs2) => split_trans xs2 ((x :: xs1) :: acc); - val segments = (spans ~~ split_trans (maps Toplevel.join_results results) []) - |> map (fn (span, results) => {span = span, command = map #1 results, state = #2 (hd results)}); - val context: presentation_context = - {options = options, file_pos = text_pos, adjust_pos = I, segments = segments}; - in apply_presentation context thy end; - in (thy, present, size text) end; - - -(* require_thy -- checking database entries wrt. the file-system *) - -local - -fun required_by _ [] = "" - | required_by s initiators = s ^ "(required by " ^ show_path (rev initiators) ^ ")"; - -fun load_thy context initiators update_time deps text (name, pos) keywords parents = - let - val _ = remove_thy name; - val _ = writeln ("Loading theory " ^ quote name ^ required_by " " initiators); - val _ = Output.try_protocol_message (Markup.loading_theory name) []; - - val {master = (thy_path, _), imports} = deps; - val dir = Path.dir thy_path; - val header = Thy_Header.make (name, pos) imports keywords; - - val _ = Position.reports (map #2 imports ~~ map Theory.get_markup parents); - - val exec_id = Document_ID.make (); - val _ = - Execution.running Document_ID.none exec_id [] orelse - raise Fail ("Failed to register execution: " ^ Document_ID.print exec_id); - - val timing_start = Timing.start (); - - val text_pos = Position.put_id (Document_ID.print exec_id) (Path.position thy_path); - val (theory, present, weight) = - eval_thy context update_time dir header text_pos text - (if name = Context.PureN then [Context.the_global_context ()] else parents); - - val timing_result = Timing.result timing_start; - val timing_props = [Markup.theory_timing, (Markup.nameN, name)]; - val _ = Output.try_protocol_message (timing_props @ Markup.timing_properties timing_result) [] - - fun commit () = update_thy deps theory; - in - Result {theory = theory, exec_id = exec_id, present = present, commit = commit, weight = weight} - end; - -fun check_deps dir name = - (case lookup_deps name of - SOME NONE => (true, NONE, Position.none, get_imports name, []) - | NONE => - let val {master, text, theory_pos, imports, keywords} = Resources.check_thy dir name - in (false, SOME (make_deps master imports, text), theory_pos, imports, keywords) end - | SOME (SOME {master, ...}) => - let - val {master = master', text = text', theory_pos = theory_pos', imports = imports', - keywords = keywords'} = Resources.check_thy dir name; - val deps' = SOME (make_deps master' imports', text'); - val current = - #2 master = #2 master' andalso - (case lookup_theory name of - NONE => false - | SOME theory => Resources.loaded_files_current theory); - in (current, deps', theory_pos', imports', keywords') end); - -in - -fun require_thys context initiators qualifier dir strs tasks = - fold_map (require_thy context initiators qualifier dir) strs tasks |>> forall I -and require_thy context initiators qualifier dir (s, require_pos) tasks = - let - val {master_dir, theory_name, ...} = Resources.import_name qualifier dir s; - in - (case try (String_Graph.get_node tasks) theory_name of - SOME task => (task_finished task, tasks) - | NONE => - let - val _ = member (op =) initiators theory_name andalso error (cycle_msg initiators); - - val (current, deps, theory_pos, imports, keywords) = check_deps master_dir theory_name - handle ERROR msg => - cat_error msg - ("The error(s) above occurred for theory " ^ quote theory_name ^ - Position.here require_pos ^ required_by "\n" initiators); - - val qualifier' = Resources.theory_qualifier theory_name; - val dir' = Path.append dir (master_dir_deps (Option.map #1 deps)); - - val parents = map (#theory_name o Resources.import_name qualifier' dir' o #1) imports; - val (parents_current, tasks') = - require_thys context (theory_name :: initiators) qualifier' dir' imports tasks; - - val all_current = current andalso parents_current; - val task = - if all_current then Finished (get_theory theory_name) - else - (case deps of - NONE => raise Fail "Malformed deps" - | SOME (dep, text) => - let - val update_time = serial (); - val load = - load_thy context initiators update_time - dep text (theory_name, theory_pos) keywords; - in Task (parents, load) end); - - val tasks'' = new_entry theory_name parents task tasks'; - in (all_current, tasks'') end) - end; - -end; - - -(* use theories *) - -fun use_theories context qualifier master_dir imports = - let val (_, tasks) = require_thys context [] qualifier master_dir imports String_Graph.empty - in if Multithreading.max_threads () > 1 then schedule_futures tasks else schedule_seq tasks end; - -fun use_thy name = - use_theories (default_context ()) Resources.default_qualifier - Path.current [(name, Position.none)]; - - -(* toplevel scripting -- without maintaining database *) - -fun script_thy pos txt thy = - let - val trs = - Outer_Syntax.parse thy NONE pos txt - |> map (Toplevel.modify_init (K thy)); - val end_pos = if null trs then pos else Toplevel.pos_of (List.last (List.last trs)); - val end_state = fold (fold (Toplevel.command_exception true)) trs Toplevel.toplevel; - in Toplevel.end_theory end_pos end_state end; - - -(* register theory *) - -fun register_thy theory = - let - val name = Context.theory_long_name theory; - val {master, ...} = Resources.check_thy (Resources.master_directory theory) name; - val imports = Resources.imports_of theory; - in - change_thys (fn thys => - let - val thys' = remove name thys; - val _ = writeln ("Registering theory " ^ quote name); - in update (make_deps master imports) theory thys' end) - end; - - -(* finish all theories *) - -fun finish () = change_thys (String_Graph.map (fn _ => fn (_, entry) => (NONE, entry))); - -end; - -fun use_thy name = Runtime.toplevel_program (fn () => Thy_Info.use_thy name); diff --git a/Citadelle/src/compiler_generic/isabelle_para/src/Pure/Thy/thy_output.ML b/Citadelle/src/compiler_generic/isabelle_para/src/Pure/Thy/thy_output.ML deleted file mode 100644 index 7f2ab726c133f325905270e18eb787c5f55f7e88..0000000000000000000000000000000000000000 --- a/Citadelle/src/compiler_generic/isabelle_para/src/Pure/Thy/thy_output.ML +++ /dev/null @@ -1,544 +0,0 @@ -(* Title: Pure/Thy/thy_output.ML - Author: Makarius - -Theory document output. -*) - -signature THY_OUTPUT = -sig - val output_document: Proof.context -> {markdown: bool} -> Input.source -> Latex.text list - val check_comments: Proof.context -> Symbol_Pos.T list -> unit - val output_token: Proof.context -> Token.T -> Latex.text list - val output_source: Proof.context -> string -> Latex.text list - type segment = {span: Command_Span.span, command: Toplevel.transitions, state: Toplevel.state} - val present_thy: Options.T -> theory -> segment list -> Latex.text list - val pretty_term: Proof.context -> term -> Pretty.T - val pretty_thm: Proof.context -> thm -> Pretty.T - val lines: Latex.text list -> Latex.text list - val items: Latex.text list -> Latex.text list - val isabelle: Proof.context -> Latex.text list -> Latex.text - val isabelle_typewriter: Proof.context -> Latex.text list -> Latex.text - val typewriter: Proof.context -> string -> Latex.text - val verbatim: Proof.context -> string -> Latex.text - val source: Proof.context -> Token.src -> Latex.text - val pretty: Proof.context -> Pretty.T -> Latex.text - val pretty_source: Proof.context -> Token.src -> Pretty.T -> Latex.text - val pretty_items: Proof.context -> Pretty.T list -> Latex.text - val pretty_items_source: Proof.context -> Token.src -> Pretty.T list -> Latex.text - val antiquotation_pretty: - binding -> 'a context_parser -> (Proof.context -> 'a -> Pretty.T) -> theory -> theory - val antiquotation_pretty_source: - binding -> 'a context_parser -> (Proof.context -> 'a -> Pretty.T) -> theory -> theory - val antiquotation_raw: - binding -> 'a context_parser -> (Proof.context -> 'a -> Latex.text) -> theory -> theory - val antiquotation_verbatim: - binding -> 'a context_parser -> (Proof.context -> 'a -> string) -> theory -> theory -end; - -structure Thy_Output: THY_OUTPUT = -struct - -(* output document source *) - -val output_symbols = single o Latex.symbols_output; - -fun output_comment ctxt (kind, syms) = - (case kind of - Comment.Comment => - Input.cartouche_content syms - |> output_document (ctxt |> Config.put Document_Antiquotation.thy_output_display false) - {markdown = false} - |> Latex.enclose_body "%\n\\isamarkupcmt{" "%\n}" - | Comment.Cancel => - Symbol_Pos.cartouche_content syms - |> output_symbols - |> Latex.enclose_body "%\n\\isamarkupcancel{" "}" - | Comment.Latex => - [Latex.symbols (Symbol_Pos.cartouche_content syms)]) -and output_comment_document ctxt (comment, syms) = - (case comment of - SOME kind => output_comment ctxt (kind, syms) - | NONE => [Latex.symbols syms]) -and output_document_text ctxt syms = - Comment.read_body syms |> maps (output_comment_document ctxt) -and output_document ctxt {markdown} source = - let - val pos = Input.pos_of source; - val syms = Input.source_explode source; - - val output_antiquotes = - maps (Document_Antiquotation.evaluate (output_document_text ctxt) ctxt); - - fun output_line line = - (if Markdown.line_is_item line then [Latex.string "\\item "] else []) @ - output_antiquotes (Markdown.line_content line); - - fun output_block (Markdown.Par lines) = - Latex.block (separate (Latex.string "\n") (map (Latex.block o output_line) lines)) - | output_block (Markdown.List {kind, body, ...}) = - Latex.environment_block (Markdown.print_kind kind) (output_blocks body) - and output_blocks blocks = separate (Latex.string "\n\n") (map output_block blocks); - in - if Toplevel.is_skipped_proof (Toplevel.presentation_state ctxt) then [] - else if markdown andalso exists (Markdown.is_control o Symbol_Pos.symbol) syms - then - let - val ants = Antiquote.parse_comments pos syms; - val reports = Antiquote.antiq_reports ants; - val blocks = Markdown.read_antiquotes ants; - val _ = Context_Position.reports ctxt (reports @ Markdown.reports blocks); - in output_blocks blocks end - else - let - val ants = Antiquote.parse_comments pos (trim (Symbol.is_blank o Symbol_Pos.symbol) syms); - val reports = Antiquote.antiq_reports ants; - val _ = Context_Position.reports ctxt (reports @ Markdown.text_reports ants); - in output_antiquotes ants end - end; - - -(* output tokens with formal comments *) - -local - -val output_symbols_antiq = - (fn Antiquote.Text syms => output_symbols syms - | Antiquote.Control {name = (name, _), body, ...} => - Latex.string (Latex.output_symbols [Symbol.encode (Symbol.Control name)]) :: - output_symbols body - | Antiquote.Antiq {body, ...} => - Latex.enclose_body "%\n\\isaantiq\n" "{}%\n\\endisaantiq\n" (output_symbols body)); - -fun output_comment_symbols ctxt {antiq} (comment, syms) = - (case (comment, antiq) of - (NONE, false) => output_symbols syms - | (NONE, true) => - Antiquote.parse_comments (#1 (Symbol_Pos.range syms)) syms - |> maps output_symbols_antiq - | (SOME comment, _) => output_comment ctxt (comment, syms)); - -fun output_body ctxt antiq bg en syms = - Comment.read_body syms - |> maps (output_comment_symbols ctxt {antiq = antiq}) - |> Latex.enclose_body bg en; - -in - -fun output_token ctxt tok = - let - fun output antiq bg en = - output_body ctxt antiq bg en (Input.source_explode (Token.input_of tok)); - in - (case Token.kind_of tok of - Token.Comment NONE => [] - | Token.Command => output false "\\isacommand{" "}" - | Token.Keyword => - if Symbol.is_ascii_identifier (Token.content_of tok) - then output false "\\isakeyword{" "}" - else output false "" "" - | Token.String => output false "{\\isachardoublequoteopen}" "{\\isachardoublequoteclose}" - | Token.Alt_String => output false "{\\isacharbackquoteopen}" "{\\isacharbackquoteclose}" - | Token.Verbatim => output true "{\\isacharverbatimopen}" "{\\isacharverbatimclose}" - | Token.Cartouche => output false "{\\isacartoucheopen}" "{\\isacartoucheclose}" - | _ => output false "" "") - end handle ERROR msg => error (msg ^ Position.here (Token.pos_of tok)); - -fun output_source ctxt s = - output_body ctxt false "" "" (Symbol_Pos.explode (s, Position.none)); - -fun check_comments ctxt = - Comment.read_body #> List.app (fn (comment, syms) => - let - val pos = #1 (Symbol_Pos.range syms); - val _ = - comment |> Option.app (fn kind => - Context_Position.reports ctxt (map (pair pos) (Markup.cartouche :: Comment.markups kind))); - val _ = output_comment_symbols ctxt {antiq = false} (comment, syms); - in if comment = SOME Comment.Comment then check_comments ctxt syms else () end); - -end; - - - -(** present theory source **) - -(*NB: arranging white space around command spans is a black art*) - -val is_white = Token.is_space orf Token.is_informal_comment; -val is_black = not o is_white; - -val is_white_comment = Token.is_informal_comment; -val is_black_comment = Token.is_formal_comment; - - -(* presentation tokens *) - -datatype token = - Ignore_Token - | Basic_Token of Token.T - | Markup_Token of string * Input.source - | Markup_Env_Token of string * Input.source - | Raw_Token of Input.source; - -fun basic_token pred (Basic_Token tok) = pred tok - | basic_token _ _ = false; - -val white_token = basic_token is_white; -val white_comment_token = basic_token is_white_comment; -val blank_token = basic_token Token.is_blank; -val newline_token = basic_token Token.is_newline; - -fun present_token ctxt tok = - (case tok of - Ignore_Token => [] - | Basic_Token tok => output_token ctxt tok - | Markup_Token (cmd, source) => - Latex.enclose_body ("%\n\\isamarkup" ^ cmd ^ "{") "%\n}\n" - (output_document ctxt {markdown = false} source) - | Markup_Env_Token (cmd, source) => - [Latex.environment_block ("isamarkup" ^ cmd) (output_document ctxt {markdown = true} source)] - | Raw_Token source => - Latex.string "%\n" :: output_document ctxt {markdown = true} source @ [Latex.string "\n"]); - - -(* command spans *) - -type command = string * Position.T * string list; (*name, position, tags*) -type source = (token * (string * int)) list; (*token, markup flag, meta-comment depth*) - -datatype span = Span of command * (source * source * source * source) * bool; - -fun make_span cmd src = - let - fun chop_newline (tok :: toks) = - if newline_token (fst tok) then ([tok], toks, true) - else ([], tok :: toks, false) - | chop_newline [] = ([], [], false); - val (((src_prefix, src_main), src_suffix1), (src_suffix2, src_appendix, newline)) = - src - |> chop_prefix (white_token o fst) - ||>> chop_suffix (white_token o fst) - ||>> chop_prefix (white_comment_token o fst) - ||> chop_newline; - in Span (cmd, (src_prefix, src_main, src_suffix1 @ src_suffix2, src_appendix), newline) end; - - -(* present spans *) - -local - -fun err_bad_nesting pos = - error ("Bad nesting of commands in presentation" ^ pos); - -fun edge which f (x: string option, y) = - if x = y then I - else (case which (x, y) of NONE => I | SOME txt => cons (Latex.string (f txt))); - -val begin_tag = edge #2 Latex.begin_tag; -val end_tag = edge #1 Latex.end_tag; -fun open_delim delim e = edge #2 Latex.begin_delim e #> delim #> edge #2 Latex.end_delim e; -fun close_delim delim e = edge #1 Latex.begin_delim e #> delim #> edge #1 Latex.end_delim e; - -fun read_tag s = - (case space_explode "%" s of - ["", b] => (SOME b, NONE) - | [a, b] => (NONE, SOME (a, b)) - | _ => error ("Bad document_tags specification: " ^ quote s)); - -in - -fun make_command_tag options keywords = - let - val document_tags = - map read_tag (space_explode "," (Options.string options \<^system_option>\<open>document_tags\<close>)); - val document_tags_default = map_filter #1 document_tags; - val document_tags_command = map_filter #2 document_tags; - in - fn {cmd_name, cmd_tags, tag, active_tag} => fn state => fn state' => - let - val tag' = try hd (fold (update (op =)) cmd_tags (the_list tag)); - - val keyword_tags = - if cmd_name = "end" andalso Toplevel.is_end_theory state' then ["theory"] - else Keyword.command_tags keywords cmd_name; - val command_tags = - the_list (AList.lookup (op =) document_tags_command cmd_name) @ - keyword_tags @ document_tags_default; - - val active_tag' = - if is_some tag' then tag' - else - (case command_tags of - default_tag :: _ => SOME default_tag - | [] => - if Keyword.is_vacuous keywords cmd_name andalso Toplevel.is_proof state - then active_tag - else NONE); - in {tag' = tag', active_tag' = active_tag'} end - end; - -fun present_span thy command_tag span state state' - (tag_stack, active_tag, newline, latex, present_cont) = - let - val ctxt' = - Toplevel.presentation_context state' - handle Toplevel.UNDEF => Proof_Context.get_global thy Context.PureN; - val present = fold (fn (tok, (flag, 0)) => - fold cons (present_token ctxt' tok) - #> cons (Latex.string flag) - | _ => I); - - val Span ((cmd_name, cmd_pos, cmd_tags), srcs, span_newline) = span; - - val (tag, tags) = tag_stack; - val {tag', active_tag'} = - command_tag {cmd_name = cmd_name, cmd_tags = cmd_tags, tag = tag, active_tag = active_tag} - state state'; - val edge = (active_tag, active_tag'); - - val nesting = Toplevel.level state' - Toplevel.level state; - - val newline' = - if is_none active_tag' then span_newline else newline; - - val tag_stack' = - if nesting = 0 andalso not (Toplevel.is_proof state) then tag_stack - else if nesting >= 0 then (tag', replicate nesting tag @ tags) - else - (case drop (~ nesting - 1) tags of - tg :: tgs => (tg, tgs) - | [] => err_bad_nesting (Position.here cmd_pos)); - - val latex' = - latex - |> end_tag edge - |> close_delim (fst present_cont) edge - |> snd present_cont - |> open_delim (present (#1 srcs)) edge - |> begin_tag edge - |> present (#2 srcs); - val present_cont' = - if newline then (present (#3 srcs), present (#4 srcs)) - else (I, present (#3 srcs) #> present (#4 srcs)); - in (tag_stack', active_tag', newline', latex', present_cont') end; - -fun present_trailer ((_, tags), active_tag, _, latex, present_cont) = - if not (null tags) then err_bad_nesting " at end of theory" - else - latex - |> end_tag (active_tag, NONE) - |> close_delim (fst present_cont) (active_tag, NONE) - |> snd present_cont; - -end; - - -(* present_thy *) - -local - -val markup_true = "\\isamarkuptrue%\n"; -val markup_false = "\\isamarkupfalse%\n"; - -val space_proper = - Scan.one Token.is_blank -- Scan.many is_white_comment -- Scan.one is_black; - -val is_improper = not o (is_black orf Token.is_begin_ignore orf Token.is_end_ignore); -val improper = Scan.many is_improper; -val improper_end = Scan.repeat (Scan.unless space_proper (Scan.one is_improper)); -val blank_end = Scan.repeat (Scan.unless space_proper (Scan.one Token.is_blank)); - -val opt_newline = Scan.option (Scan.one Token.is_newline); - -val ignore = - Scan.depend (fn d => opt_newline |-- Scan.one Token.is_begin_ignore - >> pair (d + 1)) || - Scan.depend (fn d => Scan.one Token.is_end_ignore --| - (if d = 0 then Scan.fail_with (K (fn () => "Bad nesting of meta-comments")) else opt_newline) - >> pair (d - 1)); - -val tag = (improper -- Parse.$$$ "%" -- improper) |-- Parse.!!! (Parse.tag_name --| blank_end); - -val locale = - Scan.option ((Parse.$$$ "(" -- improper -- Parse.$$$ "in") |-- - Parse.!!! (improper |-- Parse.name --| (improper -- Parse.$$$ ")"))); - -in - -type segment = {span: Command_Span.span, command: Toplevel.transitions, state: Toplevel.state}; - -fun present_thy options thy (segments: segment list) = - let - val keywords = Thy_Header.get_keywords thy; - - - (* tokens *) - - val ignored = Scan.state --| ignore - >> (fn d => (NONE, (Ignore_Token, ("", d)))); - - fun markup pred mk flag = Scan.peek (fn d => - improper |-- - Parse.position (Scan.one (fn tok => - Token.is_command tok andalso pred keywords (Token.content_of tok))) -- - Scan.repeat tag -- - Parse.!!!! ((improper -- locale -- improper) |-- Parse.document_source --| improper_end) - >> (fn (((tok, pos'), tags), source) => - let val name = Token.content_of tok - in (SOME (name, pos', tags), (mk (name, source), (flag, d))) end)); - - val command = Scan.peek (fn d => - Scan.optional (Scan.one Token.is_command_modifier ::: improper) [] -- - Scan.one Token.is_command -- Scan.repeat tag - >> (fn ((cmd_mod, cmd), tags) => - map (fn tok => (NONE, (Basic_Token tok, ("", d)))) cmd_mod @ - [(SOME (Token.content_of cmd, Token.pos_of cmd, tags), - (Basic_Token cmd, (markup_false, d)))])); - - val cmt = Scan.peek (fn d => - Scan.one is_black_comment >> (fn tok => (NONE, (Basic_Token tok, ("", d))))); - - val other = Scan.peek (fn d => - Parse.not_eof >> (fn tok => (NONE, (Basic_Token tok, ("", d))))); - - val tokens = - (ignored || - markup Keyword.is_document_heading Markup_Token markup_true || - markup Keyword.is_document_body Markup_Env_Token markup_true || - markup Keyword.is_document_raw (Raw_Token o #2) "") >> single || - command || - (cmt || other) >> single; - - - (* spans *) - - val is_eof = fn (_, (Basic_Token x, _)) => Token.is_eof x | _ => false; - val stopper = Scan.stopper (K (NONE, (Basic_Token Token.eof, ("", 0)))) is_eof; - - val cmd = Scan.one (is_some o fst); - val non_cmd = Scan.one (is_none o fst andf not o is_eof) >> #2; - - val white_comments = Scan.many (white_comment_token o fst o snd); - val blank = Scan.one (blank_token o fst o snd); - val newline = Scan.one (newline_token o fst o snd); - val before_cmd = - Scan.option (newline -- white_comments) -- - Scan.option (newline -- white_comments) -- - Scan.option (blank -- white_comments) -- cmd; - - val span = - Scan.repeat non_cmd -- cmd -- - Scan.repeat (Scan.unless before_cmd non_cmd) -- - Scan.option (newline >> (single o snd)) - >> (fn (((toks1, (cmd, tok2)), toks3), tok4) => - make_span (the cmd) (toks1 @ (tok2 :: (toks3 @ the_default [] tok4)))); - - val spans = segments - |> maps (Command_Span.content o #span) - |> drop_suffix Token.is_space - |> Source.of_list - |> Source.source' 0 Token.stopper (Scan.error (Scan.bulk tokens >> flat)) - |> Source.source stopper (Scan.error (Scan.bulk span)) - |> Source.exhaust; - - val command_results = - segments |> map_filter (fn {command, state, ...} => - if Toplevel.is_ignored command then NONE else SOME (command, state)); - - - (* present commands *) - - val command_tag = make_command_tag options keywords; - - fun present_command trs span st st' = - Toplevel.setmp_thread_position (hd trs) - (present_span thy command_tag span st st'); - - fun present _ [] = I - | present st ((span, (tr, st')) :: rest) = present_command tr span st st' #> present st' rest; - in - if length command_results = length spans then - ((NONE, []), NONE, true, [], (I, I)) - |> present Toplevel.toplevel (spans ~~ command_results) - |> present_trailer - |> rev - else error "Messed-up outer syntax for presentation" - end; - -end; - - - -(** standard output operations **) - -(* pretty printing *) - -fun pretty_term ctxt t = - Syntax.pretty_term (Variable.auto_fixes t ctxt) t; - -fun pretty_thm ctxt = pretty_term ctxt o Thm.full_prop_of; - - -(* default output *) - -val lines = separate (Latex.string "\\isanewline%\n"); -val items = separate (Latex.string "\\isasep\\isanewline%\n"); - -fun isabelle ctxt body = - if Config.get ctxt Document_Antiquotation.thy_output_display - then Latex.environment_block "isabelle" body - else Latex.block (Latex.enclose_body "\\isa{" "}" body); - -fun isabelle_typewriter ctxt body = - if Config.get ctxt Document_Antiquotation.thy_output_display - then Latex.environment_block "isabellett" body - else Latex.block (Latex.enclose_body "\\isatt{" "}" body); - -fun typewriter ctxt s = - isabelle_typewriter ctxt [Latex.string (Latex.output_ascii s)]; - -fun verbatim ctxt = - if Config.get ctxt Document_Antiquotation.thy_output_display - then Document_Antiquotation.indent_lines ctxt #> typewriter ctxt - else split_lines #> map (typewriter ctxt) #> lines #> Latex.block; - -fun source ctxt = - Token.args_of_src - #> map (Token.unparse #> Document_Antiquotation.prepare_lines ctxt) - #> space_implode " " - #> output_source ctxt - #> isabelle ctxt; - -fun pretty ctxt = - Document_Antiquotation.output ctxt #> Latex.string #> single #> isabelle ctxt; - -fun pretty_source ctxt src prt = - if Config.get ctxt Document_Antiquotation.thy_output_source - then source ctxt src else pretty ctxt prt; - -fun pretty_items ctxt = - map (Document_Antiquotation.output ctxt #> Latex.string) #> items #> isabelle ctxt; - -fun pretty_items_source ctxt src prts = - if Config.get ctxt Document_Antiquotation.thy_output_source - then source ctxt src else pretty_items ctxt prts; - - -(* antiquotation variants *) - -fun antiquotation_pretty name scan f = - Document_Antiquotation.setup name scan - (fn {context = ctxt, argument = x, ...} => pretty ctxt (f ctxt x)); - -fun antiquotation_pretty_source name scan f = - Document_Antiquotation.setup name scan - (fn {context = ctxt, source = src, argument = x} => pretty_source ctxt src (f ctxt x)); - -fun antiquotation_raw name scan f = - Document_Antiquotation.setup name scan - (fn {context = ctxt, argument = x, ...} => f ctxt x); - -fun antiquotation_verbatim name scan f = - antiquotation_raw name scan (fn ctxt => verbatim ctxt o f ctxt); - -end; diff --git a/Citadelle/src/compiler_generic/isabelle_para/src/Pure/Thy/thy_syntax.ML b/Citadelle/src/compiler_generic/isabelle_para/src/Pure/Thy/thy_syntax.ML deleted file mode 100644 index 8cdc32616515c9c7558e38112854880104e7b4a6..0000000000000000000000000000000000000000 --- a/Citadelle/src/compiler_generic/isabelle_para/src/Pure/Thy/thy_syntax.ML +++ /dev/null @@ -1,87 +0,0 @@ -(* Title: Pure/Thy/thy_syntax.ML - Author: Makarius - -Theory syntax elements. -*) - -signature THY_SYNTAX = -sig - datatype 'a element = Element of 'a * ('a element list * 'a) option - val atom: 'a -> 'a element - val map_element: ('a -> 'b) -> 'a element -> 'b element - val exists_element: ('a -> bool) -> 'a element -> bool - val flat_element: 'a element -> 'a list - val last_element: 'a element -> 'a - val parse_elements: Keyword.keywords -> (Command_Span.kind -> 'a) -> ('a -> Command_Span.kind) -> 'a list -> 'a element list -end; - -structure Thy_Syntax: THY_SYNTAX = -struct - -(* datatype element: command with optional proof *) - -datatype 'a element = Element of 'a * ('a element list * 'a) option; - -fun element (a, b) = Element (a, SOME b); -fun atom a = Element (a, NONE); - -fun map_element f (Element (a, NONE)) = Element (f a, NONE) - | map_element f (Element (a, SOME (elems, b))) = - Element (f a, SOME ((map o map_element) f elems, f b)); - -fun exists_element f (Element (a, NONE)) = f a - | exists_element f (Element (a, SOME (elems, b))) = - f a orelse (exists o exists_element) f elems orelse f b; - -fun flat_element (Element (a, NONE)) = [a] - | flat_element (Element (a, SOME (elems, b))) = a :: maps flat_element elems @ [b]; - -fun last_element (Element (a, NONE)) = a - | last_element (Element (_, SOME (_, b))) = b; - - -(* scanning spans *) - -fun eof f_mk = f_mk (Command_Span.Command_Span ("", Position.none)); - -fun is_eof f name = (case f name of Command_Span.Command_Span ("", _) => true | _ => false); - -fun not_eof f = not o is_eof f; - -fun stopper f_mk f = Scan.stopper (K (eof f_mk)) (is_eof f); - - -(* parse *) - -local - -fun command_with f pred = - Scan.one - (fn name => case f name of Command_Span.Command_Span (name, _) => pred name | _ => false); - -fun parse_element keywords f = - let - val proof_atom = - Scan.one - (fn name => - case f name of Command_Span.Command_Span (name, _) => Keyword.is_proof_body keywords name - | _ => true) >> atom; - fun proof_element x = - (command_with f (Keyword.is_proof_goal keywords) -- proof_rest >> element || proof_atom) x - and proof_rest x = - (Scan.repeat proof_element -- command_with f (Keyword.is_qed keywords)) x; - in - command_with f (Keyword.is_theory_goal keywords) -- proof_rest >> element || - Scan.one (not_eof f) >> atom - end; - -in - -fun parse_elements keywords f_mk f = - Source.of_list #> - Source.source (stopper f_mk f) (Scan.bulk (parse_element keywords f)) #> - Source.exhaust; - -end; - -end; diff --git a/Citadelle/src/compiler_generic/meta_isabelle/Meta_Isabelle.thy b/Citadelle/src/compiler_generic/meta_isabelle/Meta_Isabelle.thy deleted file mode 100644 index 4004f720950a4deabbda413973731fadac24e49a..0000000000000000000000000000000000000000 --- a/Citadelle/src/compiler_generic/meta_isabelle/Meta_Isabelle.thy +++ /dev/null @@ -1,496 +0,0 @@ -(****************************************************************************** - * A Meta-Model for the Isabelle API - * - * 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. - ******************************************************************************) - -section\<open>Isabelle Meta-Model aka. AST definition of Isabelle\<close> - -theory Meta_Isabelle -imports Meta_Pure - Meta_SML -begin - -subsection\<open>Type Definition\<close> - -text\<open>The following datatypes beginning with \verb|semi__| represent semi-concrete syntax, - deliberately not minimal abstract syntax like (Pure) Term, - this is for example to facilitate the pretty-printing process, - or for manipulating recursively data-structures through an abstract and typed API.\<close> - -datatype semi__typ = Typ_apply semi__typ "semi__typ list" - | Typ_apply_bin string \<comment> \<open>binop\<close> semi__typ semi__typ - | Typ_apply_paren string \<comment> \<open>left\<close> string \<comment> \<open>right\<close> semi__typ - | Typ_base string - -datatype semi__datatype_version = Datatype_new - | Datatype_old - | Datatype_old_atomic - | Datatype_old_atomic_sub - -datatype "datatype" = Datatype semi__datatype_version - "(( string \<comment> \<open>name\<close> - \<times> string list \<comment> \<open>arguments\<close>) - \<times> (string \<comment> \<open>name\<close> \<times> semi__typ list \<comment> \<open>arguments\<close>) list \<comment> \<open>constructors\<close>) - list \<comment> \<open>mutual recursivity\<close>" - -datatype "type_synonym" = Type_synonym "( string \<comment> \<open>name\<close> - \<times> string list \<comment> \<open>parametric variables\<close>)" - semi__typ \<comment> \<open>content\<close> - -datatype semi__term = Term_rewrite semi__term \<comment> \<open>left\<close> string \<comment> \<open>symb rewriting\<close> semi__term \<comment> \<open>right\<close> - | Term_basic "string list" - | Term_annot semi__term semi__typ - | Term_bind string \<comment> \<open>symbol\<close> semi__term \<comment> \<open>arg\<close> semi__term - | Term_fun_case "semi__term \<comment> \<open>value\<close> option" \<comment> \<open>none: function\<close> "(semi__term \<comment> \<open>pattern\<close> \<times> semi__term \<comment> \<open>to return\<close>) list" - | Term_apply semi__term "semi__term list" - | Term_paren string \<comment> \<open>left\<close> string \<comment> \<open>right\<close> semi__term - | Term_if_then_else semi__term semi__term semi__term - | Term_let "(semi__term \<comment> \<open>left\<close> \<times> semi__term \<comment> \<open>right\<close>) list" semi__term \<comment> \<open>body\<close> - | Term_term "string list" \<comment> \<open>simulate a pre-initialized context (de bruijn variables under "lam")\<close> - "term" \<comment> \<open>usual continuation of inner syntax term\<close> - -datatype "type_notation" = Type_notation string \<comment> \<open>name\<close> - string \<comment> \<open>content\<close> - -datatype "instantiation" = Instantiation string \<comment> \<open>name\<close> - string \<comment> \<open>name in definition\<close> - semi__term - -datatype "overloading" = Overloading string \<comment> \<open>name consts\<close> semi__term - string \<comment> \<open>name def\<close> semi__term \<comment> \<open>content\<close> - -datatype "consts" = Consts string \<comment> \<open>name\<close> - semi__typ - string \<comment> \<open>expression in 'post' mixfix\<close> - -datatype "definition" = Definition semi__term - | Definition_where1 string \<comment> \<open>name\<close> "semi__term \<comment> \<open>syntax extension\<close> \<times> nat \<comment> \<open>priority\<close>" semi__term - | Definition_where2 string \<comment> \<open>name\<close> semi__term \<comment> \<open>syntax extension\<close> semi__term - -datatype semi__thm_attribute = Thm_thm string \<comment> \<open>represents a single thm\<close> - | Thm_thms string \<comment> \<open>represents several thms\<close> - | Thm_THEN semi__thm_attribute semi__thm_attribute - | Thm_simplified semi__thm_attribute semi__thm_attribute - | Thm_symmetric semi__thm_attribute - | Thm_where semi__thm_attribute "(string \<times> semi__term) list" - | Thm_of semi__thm_attribute "semi__term list" - | Thm_OF semi__thm_attribute semi__thm_attribute - -datatype semi__thm = Thms_single semi__thm_attribute - | Thms_mult semi__thm_attribute - -type_synonym semi__thm_l = "semi__thm list" - -datatype "lemmas" = Lemmas_simp_thm bool \<comment> \<open>True : simp\<close> - string \<comment> \<open>name\<close> - "semi__thm_attribute list" - | Lemmas_simp_thms string \<comment> \<open>name\<close> - "string \<comment> \<open>thms\<close> list" - -datatype semi__method_simp = Method_simp_only semi__thm_l - | Method_simp_add_del_split semi__thm_l \<comment> \<open>add\<close> semi__thm_l \<comment> \<open>del\<close> semi__thm_l \<comment> \<open>split\<close> - -datatype semi__method = Method_rule "semi__thm_attribute option" - | Method_drule semi__thm_attribute - | Method_erule semi__thm_attribute - | Method_intro "semi__thm_attribute list" - | Method_elim semi__thm_attribute - | Method_subst bool \<comment> \<open>asm\<close> - "string \<comment> \<open>nat\<close> list" \<comment> \<open>pos\<close> - semi__thm_attribute - | Method_insert semi__thm_l - | Method_plus "semi__method list" - | Method_option "semi__method list" - | Method_or "semi__method list" - | Method_one semi__method_simp - | Method_all semi__method_simp - | Method_auto_simp_add_split semi__thm_l "string list" - | Method_rename_tac "string list" - | Method_case_tac semi__term - | Method_blast "nat option" - | Method_clarify - | Method_metis "string list" \<comment> \<open>e.g. \<open>no_types\<close> (\<open>override_type_encs\<close>)\<close> - "semi__thm_attribute list" - -datatype semi__command_final = Command_done - | Command_by "semi__method list" - | Command_sorry - -datatype semi__command_state = Command_apply_end "semi__method list" \<comment> \<open>\<^theory_text>\<open>apply_end (\<dots>, \<dots>)\<close>\<close> - -datatype semi__command_proof = Command_apply "semi__method list" \<comment> \<open>\<^theory_text>\<open>apply (\<dots>, \<dots>)\<close>\<close> - | Command_using semi__thm_l \<comment> \<open>\<^theory_text>\<open>using \<dots>\<close>\<close> - | Command_unfolding semi__thm_l \<comment> \<open>\<^theory_text>\<open>unfolding \<dots>\<close>\<close> - | Command_let semi__term \<comment> \<open>name\<close> semi__term - | Command_have string \<comment> \<open>name\<close> - bool \<comment> \<open>true: add \<open>[simp]\<close>\<close> - semi__term - semi__command_final - | Command_fix_let "string list" - "(semi__term \<comment> \<open>name\<close> \<times> semi__term) list" \<comment> \<open>let statements\<close> (* TODO merge recursively *) - "( semi__term list \<comment> \<open>\<^theory_text>\<open>show \<dots> \<Longrightarrow> \<dots> \<close>\<close> - \<times> semi__term list \<comment> \<open>\<^theory_text>\<open>when \<dots> \<dots>\<close>\<close>) option" \<comment> \<open>\<open>None \<Rightarrow> ?thesis\<close>\<close> - "semi__command_state list" \<comment> \<open>\<^theory_text>\<open>qed apply_end \<dots>\<close>\<close> - -datatype "lemma" = Lemma string \<comment> \<open>name\<close> "semi__term list" \<comment> \<open>specification to prove\<close> - "semi__method list list" \<comment> \<open>tactics: \<^theory_text>\<open>apply (\<dots>, \<dots>) apply \<dots>\<close>\<close> - semi__command_final - | Lemma_assumes string \<comment> \<open>name\<close> - "(string \<comment> \<open>name\<close> \<times> bool \<comment> \<open>true: add \<open>[simp]\<close>\<close> \<times> semi__term) list" \<comment> \<open>specification to prove (assms)\<close> - semi__term \<comment> \<open>specification to prove (conclusion)\<close> - "semi__command_proof list" - semi__command_final - -datatype "axiomatization" = Axiomatization string \<comment> \<open>name\<close> - semi__term - -datatype "section" = Section nat \<comment> \<open>nesting level\<close> - string \<comment> \<open>content\<close> - -datatype "text" = Text string - -datatype "text_raw" = Text_raw string - -datatype "ML" = SML semi__term' - -datatype "setup" = Setup semi__term' - -datatype "thm" = Thm "semi__thm_attribute list" - -datatype "interpretation" = Interpretation string \<comment> \<open>name\<close> - string \<comment> \<open>locale name\<close> - "semi__term list" \<comment> \<open>locale param\<close> - semi__command_final - -datatype "hide_const" = Hide_const bool (* true: 'open' *) - "string list" - -datatype "abbreviation" = Abbreviation semi__term - -datatype code_reflect' = Code_reflect' bool (* true: 'open' *) - string (* module name *) - "string list" (* functions *) - -datatype semi__theory = Theory_datatype "datatype" - | Theory_type_synonym "type_synonym" - | Theory_type_notation "type_notation" - | Theory_instantiation "instantiation" - | Theory_overloading "overloading" - | Theory_consts "consts" - | Theory_definition "definition" - | Theory_lemmas "lemmas" - | Theory_lemma "lemma" - | Theory_axiomatization "axiomatization" - | Theory_section "section" - | Theory_text "text" - | Theory_text_raw "text_raw" - | Theory_ML "ML" - | Theory_setup "setup" - | Theory_thm "thm" - | Theory_interpretation "interpretation" - | Theory_hide_const "hide_const" - | Theory_abbreviation "abbreviation" - | Theory_code_reflect' code_reflect' - -record semi__locale = - HolThyLocale_name :: string - HolThyLocale_header :: "( (semi__term \<comment> \<open>name\<close> \<times> semi__typ \<comment> \<open>\<^theory_text>\<open>fix\<close> statement\<close>) list - \<times> (string \<comment> \<open>name\<close> \<times> semi__term \<comment> \<open>\<^theory_text>\<open>assumes\<close> statement\<close>) option \<comment> \<open>None: no \<^theory_text>\<open>assumes\<close> to generate\<close>) list" - -datatype semi__theories = Theories_one semi__theory - | Theories_locale semi__locale "semi__theory list \<comment> \<open>positioning comments can occur before and after this group of commands\<close> list" - -subsection\<open>Extending the Meta-Model\<close> - -locale T -begin -definition "thm = Thm_thm" -definition "thms = Thm_thms" -definition "THEN = Thm_THEN" -definition "simplified = Thm_simplified" -definition "symmetric = Thm_symmetric" -definition "where = Thm_where" -definition "of' = Thm_of" -definition "OF = Thm_OF" -definition "OF_l s l = List.fold (\<lambda>x acc. Thm_OF acc x) l s" -definition "simplified_l s l = List.fold (\<lambda>x acc. Thm_simplified acc x) l s" -end - -lemmas [code] = - \<comment> \<open>def\<close> - T.thm_def - T.thms_def - T.THEN_def - T.simplified_def - T.symmetric_def - T.where_def - T.of'_def - T.OF_def - T.OF_l_def - T.simplified_l_def - -definition "Opt s = Typ_apply (Typ_base \<open>option\<close>) [Typ_base s]" -definition "Raw = Typ_base" -definition "Datatype' n l = Datatype Datatype_new [((n, []), l)]" -definition "Type_synonym' n = Type_synonym (n, [])" -definition "Type_synonym'' n l f = Type_synonym (n, l) (f l)" -definition "Term_annot' e s = Term_annot e (Typ_base s)" -definition "Term_lambdas s = Term_bind \<open>\<lambda>\<close> (Term_basic s)" -definition "Term_lambda x = Term_lambdas [x]" -definition "Term_lambdas0 = Term_bind \<open>\<lambda>\<close>" -definition "Term_lam x f = Term_lambdas0 (Term_basic [x]) (f x)" -definition "Term_some = Term_paren \<open>\<lfloor>\<close> \<open>\<rfloor>\<close>" -definition "Term_parenthesis \<comment> \<open>mandatory parenthesis\<close> = Term_paren \<open>(\<close> \<open>)\<close>" -definition "Term_warning_parenthesis \<comment> \<open>optional parenthesis that can be removed but a warning will be raised\<close> = Term_parenthesis" -definition "Term_pat b = Term_basic [\<open>?\<close> @@ b]" -definition "Term_And x f = Term_bind \<open>\<And>\<close> (Term_basic [x]) (f x)" -definition "Term_exists x f = Term_bind \<open>\<exists>\<close> (Term_basic [x]) (f x)" -definition "Term_binop = Term_rewrite" -definition "term_binop s l = (case rev l of x # xs \<Rightarrow> List.fold (\<lambda>x. Term_binop x s) xs x)" -definition "term_binop' s l = (case rev l of x # xs \<Rightarrow> List.fold (\<lambda>x. Term_parenthesis o Term_binop x s) xs x)" -definition "Term_set l = (case l of [] \<Rightarrow> Term_basic [\<open>{}\<close>] | _ \<Rightarrow> Term_paren \<open>{\<close> \<open>}\<close> (term_binop \<open>,\<close> l))" -definition "Term_list l = (case l of [] \<Rightarrow> Term_basic [\<open>[]\<close>] | _ \<Rightarrow> Term_paren \<open>[\<close> \<open>]\<close> (term_binop \<open>,\<close> l))" -definition "Term_list' f l = Term_list (L.map f l)" -definition "Term_pair e1 e2 = Term_parenthesis (Term_binop e1 \<open>,\<close> e2)" -definition "Term_pair' l = (case l of [] \<Rightarrow> Term_basic [\<open>()\<close>] | _ \<Rightarrow> Term_paren \<open>(\<close> \<open>)\<close> (term_binop \<open>,\<close> l))" -definition "Term_pairs' f l = Term_pair' (L.map f l)" -definition \<open>Term_string s = Term_basic [S.flatten [\<open>"\<close>, s, \<open>"\<close>]]\<close> -definition "Term_string' s = Term_basic [S.flatten [\<open>\\\<close>, \<open><open>\<close>, s, \<open>\\\<close>, \<open><close>\<close>]]" -definition "Term_string'' f s = Term_apply f [Term_string' s]" -definition "Term_applys0 e l = Term_parenthesis (Term_apply e (L.map Term_parenthesis l))" -definition "Term_applys e l = Term_applys0 (Term_parenthesis e) l" -definition "Term_app e = Term_applys0 (Term_basic [e])" -definition "Term_preunary e1 e2 = Term_apply e1 [e2]" \<comment> \<open>no parenthesis and separated with one space\<close> -definition "Term_postunary e1 e2 = Term_apply e1 [e2]" \<comment> \<open>no parenthesis and separated with one space\<close> -definition "Term_case = Term_fun_case o Some" -definition "Term_function = Term_fun_case None" -definition "Term_term' = Term_term []" -definition "Lemmas_simp = Lemmas_simp_thm True" -definition "Lemmas_nosimp = Lemmas_simp_thm False" -definition "Consts_value = \<open>(_)\<close>" -definition "Consts_raw0 s l e o_arg = - Consts s l (String.replace_integers (\<lambda>n. if n = 0x5F then \<open>'_\<close> else \<degree>n\<degree>) e @@ (case o_arg of - None \<Rightarrow> \<open>\<close> - | Some arg \<Rightarrow> - let ap = \<lambda>s. \<open>'(\<close> @@ s @@ \<open>')\<close> in - ap (if arg = 0 then - \<open>\<close> - else - Consts_value @@ (S.flatten (L.map (\<lambda>_. \<open>,\<close> @@ Consts_value) (L.upto 2 arg))))))" -definition "Ty_arrow = Typ_apply_bin \<open>\<Rightarrow>\<close>" -definition "Ty_times = Typ_apply_bin \<open>\<times>\<close>" -definition "Ty_arrow' x = Ty_arrow x (Typ_base \<open>_\<close>)" -definition "Ty_paren = Typ_apply_paren \<open>(\<close> \<open>)\<close>" -definition "Consts' s l e = Consts_raw0 s (Ty_arrow (Typ_base \<open>'\<alpha>\<close>) l) e None" -definition "Overloading' n ty = Overloading n (Term_annot (Term_basic [n]) ty)" - -locale M -begin -definition "Method_simp_add_del l_a l_d = Method_simp_add_del_split l_a l_d []" -definition "Method_subst_l = Method_subst False" - -definition "rule' = Method_rule None" -definition "rule = Method_rule o Some" -definition "drule = Method_drule" -definition "erule = Method_erule" -definition "intro = Method_intro" -definition "elim = Method_elim" -definition "subst_l0 = Method_subst" -definition "subst_l = Method_subst_l" -definition insert where "insert = Method_insert o L.map Thms_single" -definition plus where "plus = Method_plus" -definition "option = Method_option" -definition "or = Method_or" -definition "meth_gen_simp = Method_simp_add_del [] []" -definition "meth_gen_simp_add2 l1 l2 = Method_simp_add_del (L.flatten [ L.map Thms_mult l1 - , L.map (Thms_single o Thm_thm) l2]) - []" -definition "meth_gen_simp_add_del l1 l2 = Method_simp_add_del (L.map (Thms_single o Thm_thm) l1) - (L.map (Thms_single o Thm_thm) l2)" -definition "meth_gen_simp_add_del_split l1 l2 l3 = Method_simp_add_del_split (L.map Thms_single l1) - (L.map Thms_single l2) - (L.map Thms_single l3)" -definition "meth_gen_simp_add_split l1 l2 = Method_simp_add_del_split (L.map Thms_single l1) - [] - (L.map Thms_single l2)" -definition "meth_gen_simp_only l = Method_simp_only (L.map Thms_single l)" -definition "meth_gen_simp_only' l = Method_simp_only (L.map Thms_mult l)" -definition "meth_gen_simp_add0 l = Method_simp_add_del (L.map Thms_single l) []" -definition "simp = Method_one meth_gen_simp" -definition "simp_add2 l1 l2 = Method_one (meth_gen_simp_add2 l1 l2)" -definition "simp_add_del l1 l2 = Method_one (meth_gen_simp_add_del l1 l2)" -definition "simp_add_del_split l1 l2 l3 = Method_one (meth_gen_simp_add_del_split l1 l2 l3)" -definition "simp_add_split l1 l2 = Method_one (meth_gen_simp_add_split l1 l2)" -definition "simp_only l = Method_one (meth_gen_simp_only l)" -definition "simp_only' l = Method_one (meth_gen_simp_only' l)" -definition "simp_add0 l = Method_one (meth_gen_simp_add0 l)" -definition "simp_add = simp_add2 []" -definition "simp_all = Method_all meth_gen_simp" -definition "simp_all_add l = Method_all (meth_gen_simp_add2 [] l)" -definition "simp_all_only l = Method_all (meth_gen_simp_only l)" -definition "simp_all_only' l = Method_all (meth_gen_simp_only' l)" -definition "auto_simp_add2 l1 l2 = Method_auto_simp_add_split (L.flatten [ L.map Thms_mult l1 - , L.map (Thms_single o Thm_thm) l2]) []" -definition "auto_simp_add_split l = Method_auto_simp_add_split (L.map Thms_single l)" -definition "rename_tac = Method_rename_tac" -definition "case_tac = Method_case_tac" -definition "blast = Method_blast" -definition "clarify = Method_clarify" -definition "metis = Method_metis []" -definition "metis0 = Method_metis" - -definition "subst_asm b = subst_l0 b [\<open>0\<close>]" -definition "subst = subst_l [\<open>0\<close>]" -definition "auto_simp_add = auto_simp_add2 []" -definition "auto = auto_simp_add []" -end - -lemmas [code] = - \<comment> \<open>def\<close> - M.Method_simp_add_del_def - M.Method_subst_l_def - M.rule'_def - M.rule_def - M.drule_def - M.erule_def - M.intro_def - M.elim_def - M.subst_l0_def - M.subst_l_def - M.insert_def - M.plus_def - M.option_def - M.or_def - M.meth_gen_simp_def - M.meth_gen_simp_add2_def - M.meth_gen_simp_add_del_def - M.meth_gen_simp_add_del_split_def - M.meth_gen_simp_add_split_def - M.meth_gen_simp_only_def - M.meth_gen_simp_only'_def - M.meth_gen_simp_add0_def - M.simp_def - M.simp_add2_def - M.simp_add_del_def - M.simp_add_del_split_def - M.simp_add_split_def - M.simp_only_def - M.simp_only'_def - M.simp_add0_def - M.simp_add_def - M.simp_all_def - M.simp_all_add_def - M.simp_all_only_def - M.simp_all_only'_def - M.auto_simp_add2_def - M.auto_simp_add_split_def - M.rename_tac_def - M.case_tac_def - M.blast_def - M.clarify_def - M.metis_def - M.metis0_def - M.subst_asm_def - M.subst_def - M.auto_simp_add_def - M.auto_def - -definition "ty_arrow l = (case rev l of x # xs \<Rightarrow> List.fold Ty_arrow xs x)" - -locale C -begin -definition "done = Command_done" -definition "by = Command_by" -definition "sorry = Command_sorry" -definition "apply_end = Command_apply_end" -definition "apply = Command_apply" -definition "using = Command_using o L.map Thms_single" -definition "unfolding = Command_unfolding o L.map Thms_single" -definition "let' = Command_let" -definition "fix_let = Command_fix_let" -definition "fix l = Command_fix_let l [] None []" -definition "have n = Command_have n False" -definition "have0 = Command_have" -end - -lemmas [code] = - \<comment> \<open>def\<close> - C.done_def - C.by_def - C.sorry_def - C.apply_end_def - C.apply_def - C.using_def - C.unfolding_def - C.let'_def - C.fix_let_def - C.fix_def - C.have_def - C.have0_def - -fun cross_abs_aux where - "cross_abs_aux f l x = (\<lambda> (Suc n, Abs s _ t) \<Rightarrow> f s (cross_abs_aux f (s # l) (n, t)) - | (_, e) \<Rightarrow> Term_term l e) - x" - -definition "cross_abs f n l = cross_abs_aux f [] (n, l)" - -subsection\<open>Operations of Fold, Map, ..., on the Meta-Model\<close> - -definition "map_lemma f = (\<lambda> Theory_lemma x \<Rightarrow> Theory_lemma (f x) - | x \<Rightarrow> x)" - -fun hol_to_sml where - "hol_to_sml e = - (\<lambda> Term_rewrite t1 s t2 \<Rightarrow> (if s \<triangleq> \<open>=\<close> then SML_rewrite else SML_binop) - (hol_to_sml t1) - s - (hol_to_sml t2) - | Term_basic l \<Rightarrow> SML_basic l - | Term_apply t l \<Rightarrow> SML.app_pair (hol_to_sml t) (map hol_to_sml l) - | Term_paren _ _ (Term_let l e) \<Rightarrow> hol_to_sml (Term_let l e) - | Term_paren s1 s2 t \<Rightarrow> SML_paren s1 s2 (hol_to_sml t) - | Term_let l e \<Rightarrow> - SML_let (SML_top (List.map (\<lambda>(e1, e2). - SML_val_fun (Some Sval) - (SML.rewrite (hol_to_sml e1) \<open>=\<close> (hol_to_sml e2))) - l)) - (hol_to_sml e)) e" - -end diff --git a/Citadelle/src/compiler_generic/meta_isabelle/Meta_Pure.thy b/Citadelle/src/compiler_generic/meta_isabelle/Meta_Pure.thy deleted file mode 100644 index 49e6a84fa25d61e7920e3d1d4f23a861d7bc992e..0000000000000000000000000000000000000000 --- a/Citadelle/src/compiler_generic/meta_isabelle/Meta_Pure.thy +++ /dev/null @@ -1,91 +0,0 @@ -(****************************************************************************** - * A Meta-Model for the Isabelle API - * - * 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. - ******************************************************************************) - -section\<open>(Pure) Term Meta-Model aka. AST definition of (Pure) Term\<close> - -theory Meta_Pure -imports "../Init" -begin - -subsection\<open>Type Definition\<close> - -type_synonym indexname = "string \<times> nat" -type_synonym "class" = string -type_synonym sort = "class list" -datatype "typ" = - Type string "typ list" | - TFree string sort | - TVar indexname sort -datatype "term" = - Const string "typ" | - Free string "typ" | - Var indexname "typ" | - Bound nat | - Abs string "typ" "term" | - App "term" "term" (infixl "$" 200) - -subsection\<open>Operations of Fold, Map, ..., on the Meta-Model\<close> - -fun map_Const where - "map_Const f expr = (\<lambda> Const s ty \<Rightarrow> Const (f s ty) ty - | Free s ty \<Rightarrow> Free s ty - | Var i ty \<Rightarrow> Var i ty - | Bound n \<Rightarrow> Bound n - | Abs s ty term \<Rightarrow> Abs s ty (map_Const f term) - | App term1 term2 \<Rightarrow> App (map_Const f term1) - (map_Const f term2)) - expr" - -fun fold_Const where - "fold_Const f accu expr = (\<lambda> Const s _ \<Rightarrow> f accu s - | Abs _ _ term \<Rightarrow> fold_Const f accu term - | App term1 term2 \<Rightarrow> fold_Const f (fold_Const f accu term1) term2 - | _ \<Rightarrow> accu) - expr" - -fun fold_Free where - "fold_Free f accu expr = (\<lambda> Free s _ \<Rightarrow> f accu s - | Abs _ _ term \<Rightarrow> fold_Free f accu term - | App term1 term2 \<Rightarrow> fold_Free f (fold_Free f accu term1) term2 - | _ \<Rightarrow> accu) - expr" - -end diff --git a/Citadelle/src/compiler_generic/meta_isabelle/Meta_SML.thy b/Citadelle/src/compiler_generic/meta_isabelle/Meta_SML.thy deleted file mode 100644 index e9565c55f9299ba152e8b8cd50a0c8cb7913a20e..0000000000000000000000000000000000000000 --- a/Citadelle/src/compiler_generic/meta_isabelle/Meta_SML.thy +++ /dev/null @@ -1,131 +0,0 @@ -(****************************************************************************** - * A Meta-Model for the Isabelle API - * - * 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. - ******************************************************************************) - -section\<open>SML Meta-Model aka. AST definition of SML\<close> - -theory Meta_SML -imports "../Init" -begin - -subsection\<open>Type Definition\<close> - -text\<open>The following datatypes beginning with \verb|semi__| represent semi-concrete syntax, - deliberately not minimal abstract syntax like (Pure) Term, - this is for example to facilitate the pretty-printing process, - or for manipulating recursively data-structures through an abstract and typed API.\<close> - -datatype semi__val_fun = Sval - | Sfun - -datatype semi__term'0 = SML_string string - | SML_rewrite semi__term'0 \<comment> \<open>left\<close> string \<comment> \<open>symb rewriting\<close> semi__term'0 \<comment> \<open>right\<close> - | SML_basic "string list" - | SML_binop semi__term'0 string semi__term'0 - | SML_annot semi__term'0 string \<comment> \<open>type\<close> - | SML_function "(semi__term'0 \<comment> \<open>pattern\<close> \<times> semi__term'0 \<comment> \<open>to return\<close>) list" - | SML_apply semi__term'0 "semi__term'0 list" - | SML_paren string \<comment> \<open>left\<close> string \<comment> \<open>right\<close> semi__term'0 - | SML_let semi__term' semi__term'0 - and semi__term'1 = SML_open string - | SML_val_fun "semi__val_fun option" semi__term'0 - and semi__term' = SML_top "semi__term'1 list" - -subsection\<open>Extending the Meta-Model\<close> - -locale SML -begin -no_type_notation abr_string ("string") definition "string = SML_string" -definition "rewrite = SML_rewrite" -definition "basic = SML_basic" -definition "binop = SML_binop" -definition "annot = SML_annot" -definition "function = SML_function" -definition "apply = SML_apply" -definition "paren = SML_paren" - -definition "app s = apply (basic [s])" -definition "app0 s1 s2 = SML_top [SML_val_fun None (app s1 s2)]" -definition "none = basic [\<open>NONE\<close>]" -definition "some s = app \<open>SOME\<close> [s]" -definition "option' f l = (case map_option f l of None \<Rightarrow> none | Some s \<Rightarrow> some s)" -definition "option = option' id" -definition "parenthesis \<comment> \<open>mandatory parenthesis\<close> = paren \<open>(\<close> \<open>)\<close>" -definition "binop_l s l = (case rev l of x # xs \<Rightarrow> List.fold (\<lambda>x. binop x s) xs x)" -definition "list l = (case l of [] \<Rightarrow> basic [\<open>[]\<close>] | _ \<Rightarrow> paren \<open>[\<close> \<open>]\<close> (binop_l \<open>,\<close> l))" -definition "list' f l = list (L.map f l)" -definition "pair0 l = paren \<open>(\<close> \<open>)\<close> (binop_l \<open>,\<close> l)" -definition "pair e1 e2 = parenthesis (binop e1 \<open>,\<close> e2)" -definition "pair' f1 f2 = (\<lambda> (e1, e2) \<Rightarrow> parenthesis (binop (f1 e1) \<open>,\<close> (f2 e2)))" -definition "rewrite_val e1 s e2 = SML_top [SML_val_fun (Some Sval) (rewrite e1 s e2)]" -definition "rewrite_fun e1 s e2 = SML_top [SML_val_fun (Some Sfun) (rewrite e1 s e2)]" -definition "let_open s = SML_let (SML_top [SML_open s])" -definition "app_pair e l = apply e (case l of [] \<Rightarrow> [] | _ \<Rightarrow> [pair0 l])" -end - -lemmas [code] = - \<comment> \<open>def\<close> - SML.string_def - SML.rewrite_def - SML.basic_def - SML.binop_def - SML.annot_def - SML.function_def - SML.apply_def - SML.paren_def - SML.app_def - SML.app0_def - SML.none_def - SML.some_def - SML.option'_def - SML.option_def - SML.parenthesis_def - SML.binop_l_def - SML.list_def - SML.list'_def - SML.pair0_def - SML.pair_def - SML.pair'_def - SML.rewrite_val_def - SML.rewrite_fun_def - SML.let_open_def - SML.app_pair_def - -end diff --git a/Citadelle/src/compiler_generic/meta_isabelle/Parser_Pure.thy b/Citadelle/src/compiler_generic/meta_isabelle/Parser_Pure.thy deleted file mode 100644 index 4e870441182f5be13f61ea7b2a8163630681c24b..0000000000000000000000000000000000000000 --- a/Citadelle/src/compiler_generic/meta_isabelle/Parser_Pure.thy +++ /dev/null @@ -1,82 +0,0 @@ -(****************************************************************************** - * A Meta-Model for the Isabelle API - * - * 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. - ******************************************************************************) - -section\<open>Instantiating the Parser of (Pure) Term\<close> - -theory Parser_Pure -imports Meta_Pure - Parser_init -begin - -subsection\<open>Main\<close> - -context Parse -begin - -definition "of_pure_indexname a b = of_pair a b (of_string a b) (of_nat a b)" - -definition "of_pure_class = of_string" - -definition "of_pure_sort a b = of_list a b (of_pure_class a b)" - -definition "of_pure_typ a b = rec_typ - (ap2 a (b \<open>Type\<close>) (of_string a b) (of_list a b snd)) - (ap2 a (b \<open>TFree\<close>) (of_string a b) (of_pure_sort a b)) - (ap2 a (b \<open>TVar\<close>) (of_pure_indexname a b) (of_pure_sort a b))" - -definition "of_pure_term a b = (\<lambda>f0 f1 f2 f3 f4 f5. rec_term f0 f1 f2 f3 (co2 K f4) (\<lambda>_ _. f5)) - (ap2 a (b \<open>Const\<close>) (of_string a b) (of_pure_typ a b)) - (ap2 a (b \<open>Free\<close>) (of_string a b) (of_pure_typ a b)) - (ap2 a (b \<open>Var\<close>) (of_pure_indexname a b) (of_pure_typ a b)) - (ap1 a (b \<open>Bound\<close>) (of_nat a b)) - (ar3 a (b \<open>Abs\<close>) (of_string a b) (of_pure_typ a b)) - (ar2 a (b \<open>App\<close>) id)" - -end - -lemmas [code] = - Parse.of_pure_indexname_def - Parse.of_pure_class_def - Parse.of_pure_sort_def - Parse.of_pure_typ_def - Parse.of_pure_term_def - -end diff --git a/Citadelle/src/compiler_generic/meta_isabelle/Parser_init.thy b/Citadelle/src/compiler_generic/meta_isabelle/Parser_init.thy deleted file mode 100644 index a731a72ce6e56f4ed81f8e1e4ec1e50e44822cf6..0000000000000000000000000000000000000000 --- a/Citadelle/src/compiler_generic/meta_isabelle/Parser_init.thy +++ /dev/null @@ -1,141 +0,0 @@ -(****************************************************************************** - * Citadelle - * - * 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. - ******************************************************************************) - -section\<open>Initializing the Parser\<close> - -theory Parser_init -imports "../Init" -begin - -subsection\<open>Some Generic Combinators\<close> - -definition "K x _ = x" - -definition "co1 = (o)" -definition "co2 f g x1 x2 = f (g x1 x2)" -definition "co3 f g x1 x2 x3 = f (g x1 x2 x3)" -definition "co4 f g x1 x2 x3 x4 = f (g x1 x2 x3 x4)" -definition "co5 f g x1 x2 x3 x4 x5 = f (g x1 x2 x3 x4 x5)" -definition "co6 f g x1 x2 x3 x4 x5 x6 = f (g x1 x2 x3 x4 x5 x6)" -definition "co7 f g x1 x2 x3 x4 x5 x6 x7 = f (g x1 x2 x3 x4 x5 x6 x7)" -definition "co8 f g x1 x2 x3 x4 x5 x6 x7 x8 = f (g x1 x2 x3 x4 x5 x6 x7 x8)" -definition "co9 f g x1 x2 x3 x4 x5 x6 x7 x8 x9 = f (g x1 x2 x3 x4 x5 x6 x7 x8 x9)" -definition "co10 f g x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 = f (g x1 x2 x3 x4 x5 x6 x7 x8 x9 x10)" -definition "co11 f g x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 x11 = f (g x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 x11)" -definition "co12 f g x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 x11 x12 = f (g x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 x11 x12)" -definition "co13 f g x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 x11 x12 x13 = f (g x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 x11 x12 x13)" -definition "co14 f g x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 x11 x12 x13 x14 = f (g x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 x11 x12 x13 x14)" -definition "co15 f g x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 x11 x12 x13 x14 x15 = f (g x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 x11 x12 x13 x14 x15)" - -definition "ap1 a v0 f1 v1 = a v0 [f1 v1]" -definition "ap2 a v0 f1 f2 v1 v2 = a v0 [f1 v1, f2 v2]" -definition "ap3 a v0 f1 f2 f3 v1 v2 v3 = a v0 [f1 v1, f2 v2, f3 v3]" -definition "ap4 a v0 f1 f2 f3 f4 v1 v2 v3 v4 = a v0 [f1 v1, f2 v2, f3 v3, f4 v4]" -definition "ap5 a v0 f1 f2 f3 f4 f5 v1 v2 v3 v4 v5 = a v0 [f1 v1, f2 v2, f3 v3, f4 v4, f5 v5]" -definition "ap6 a v0 f1 f2 f3 f4 f5 f6 v1 v2 v3 v4 v5 v6 = a v0 [f1 v1, f2 v2, f3 v3, f4 v4, f5 v5, f6 v6]" -definition "ap7 a v0 f1 f2 f3 f4 f5 f6 f7 v1 v2 v3 v4 v5 v6 v7 = a v0 [f1 v1, f2 v2, f3 v3, f4 v4, f5 v5, f6 v6, f7 v7]" -definition "ap8 a v0 f1 f2 f3 f4 f5 f6 f7 f8 v1 v2 v3 v4 v5 v6 v7 v8 = a v0 [f1 v1, f2 v2, f3 v3, f4 v4, f5 v5, f6 v6, f7 v7, f8 v8]" -definition "ap9 a v0 f1 f2 f3 f4 f5 f6 f7 f8 f9 v1 v2 v3 v4 v5 v6 v7 v8 v9 = a v0 [f1 v1, f2 v2, f3 v3, f4 v4, f5 v5, f6 v6, f7 v7, f8 v8, f9 v9]" -definition "ap10 a v0 f1 f2 f3 f4 f5 f6 f7 f8 f9 f10 v1 v2 v3 v4 v5 v6 v7 v8 v9 v10 = a v0 [f1 v1, f2 v2, f3 v3, f4 v4, f5 v5, f6 v6, f7 v7, f8 v8, f9 v9, f10 v10]" -definition "ap11 a v0 f1 f2 f3 f4 f5 f6 f7 f8 f9 f10 f11 v1 v2 v3 v4 v5 v6 v7 v8 v9 v10 v11 = a v0 [f1 v1, f2 v2, f3 v3, f4 v4, f5 v5, f6 v6, f7 v7, f8 v8, f9 v9, f10 v10, f11 v11]" -definition "ap12 a v0 f1 f2 f3 f4 f5 f6 f7 f8 f9 f10 f11 f12 v1 v2 v3 v4 v5 v6 v7 v8 v9 v10 v11 v12 = a v0 [f1 v1, f2 v2, f3 v3, f4 v4, f5 v5, f6 v6, f7 v7, f8 v8, f9 v9, f10 v10, f11 v11, f12 v12]" -definition "ap13 a v0 f1 f2 f3 f4 f5 f6 f7 f8 f9 f10 f11 f12 f13 v1 v2 v3 v4 v5 v6 v7 v8 v9 v10 v11 v12 v13 = a v0 [f1 v1, f2 v2, f3 v3, f4 v4, f5 v5, f6 v6, f7 v7, f8 v8, f9 v9, f10 v10, f11 v11, f12 v12, f13 v13]" -definition "ap14 a v0 f1 f2 f3 f4 f5 f6 f7 f8 f9 f10 f11 f12 f13 f14 v1 v2 v3 v4 v5 v6 v7 v8 v9 v10 v11 v12 v13 v14 = a v0 [f1 v1, f2 v2, f3 v3, f4 v4, f5 v5, f6 v6, f7 v7, f8 v8, f9 v9, f10 v10, f11 v11, f12 v12, f13 v13, f14 v14]" -definition "ap15 a v0 f1 f2 f3 f4 f5 f6 f7 f8 f9 f10 f11 f12 f13 f14 f15 v1 v2 v3 v4 v5 v6 v7 v8 v9 v10 v11 v12 v13 v14 v15 = a v0 [f1 v1, f2 v2, f3 v3, f4 v4, f5 v5, f6 v6, f7 v7, f8 v8, f9 v9, f10 v10, f11 v11, f12 v12, f13 v13, f14 v14, f15 v15]" -definition "ap16 a v0 f1 f2 f3 f4 f5 f6 f7 f8 f9 f10 f11 f12 f13 f14 f15 f16 v1 v2 v3 v4 v5 v6 v7 v8 v9 v10 v11 v12 v13 v14 v15 v16 = a v0 [f1 v1, f2 v2, f3 v3, f4 v4, f5 v5, f6 v6, f7 v7, f8 v8, f9 v9, f10 v10, f11 v11, f12 v12, f13 v13, f14 v14, f15 v15, f16 v16]" - -definition "ar1 a v0 z = a v0 [z]" -definition "ar2 a v0 f1 v1 z = a v0 [f1 v1, z]" -definition "ar3 a v0 f1 f2 v1 v2 z = a v0 [f1 v1, f2 v2, z]" -definition "ar4 a v0 f1 f2 f3 v1 v2 v3 z = a v0 [f1 v1, f2 v2, f3 v3, z]" -definition "ar5 a v0 f1 f2 f3 f4 v1 v2 v3 v4 z = a v0 [f1 v1, f2 v2, f3 v3, f4 v4, z]" -definition "ar6 a v0 f1 f2 f3 f4 f5 v1 v2 v3 v4 v5 z = a v0 [f1 v1, f2 v2, f3 v3, f4 v4, f5 v5, z]" -definition "ar7 a v0 f1 f2 f3 f4 f5 f6 v1 v2 v3 v4 v5 v6 z = a v0 [f1 v1, f2 v2, f3 v3, f4 v4, f5 v5, f6 v6, z]" -definition "ar8 a v0 f1 f2 f3 f4 f5 f6 f7 v1 v2 v3 v4 v5 v6 v7 z = a v0 [f1 v1, f2 v2, f3 v3, f4 v4, f5 v5, f6 v6, f7 v7, z]" -definition "ar9 a v0 f1 f2 f3 f4 f5 f6 f7 f8 v1 v2 v3 v4 v5 v6 v7 v8 z = a v0 [f1 v1, f2 v2, f3 v3, f4 v4, f5 v5, f6 v6, f7 v7, f8 v8, z]" -definition "ar10 a v0 f1 f2 f3 f4 f5 f6 f7 f8 f9 v1 v2 v3 v4 v5 v6 v7 v8 v9 z = a v0 [f1 v1, f2 v2, f3 v3, f4 v4, f5 v5, f6 v6, f7 v7, f8 v8, f9 v9, z]" -definition "ar11 a v0 f1 f2 f3 f4 f5 f6 f7 f8 f9 f10 v1 v2 v3 v4 v5 v6 v7 v8 v9 v10 z = a v0 [f1 v1, f2 v2, f3 v3, f4 v4, f5 v5, f6 v6, f7 v7, f8 v8, f9 v9, f10 v10, z]" -definition "ar12 a v0 f1 f2 f3 f4 f5 f6 f7 f8 f9 f10 f11 v1 v2 v3 v4 v5 v6 v7 v8 v9 v10 v11 z = a v0 [f1 v1, f2 v2, f3 v3, f4 v4, f5 v5, f6 v6, f7 v7, f8 v8, f9 v9, f10 v10, f11 v11, z]" -definition "ar13 a v0 f1 f2 f3 f4 f5 f6 f7 f8 f9 f10 f11 f12 v1 v2 v3 v4 v5 v6 v7 v8 v9 v10 v11 v12 z = a v0 [f1 v1, f2 v2, f3 v3, f4 v4, f5 v5, f6 v6, f7 v7, f8 v8, f9 v9, f10 v10, f11 v11, f12 v12, z]" -definition "ar14 a v0 f1 f2 f3 f4 f5 f6 f7 f8 f9 f10 f11 f12 f13 v1 v2 v3 v4 v5 v6 v7 v8 v9 v10 v11 v12 v13 z = a v0 [f1 v1, f2 v2, f3 v3, f4 v4, f5 v5, f6 v6, f7 v7, f8 v8, f9 v9, f10 v10, f11 v11, f12 v12, f13 v13, z]" -definition "ar15 a v0 f1 f2 f3 f4 f5 f6 f7 f8 f9 f10 f11 f12 f13 f14 v1 v2 v3 v4 v5 v6 v7 v8 v9 v10 v11 v12 v13 v14 z = a v0 [f1 v1, f2 v2, f3 v3, f4 v4, f5 v5, f6 v6, f7 v7, f8 v8, f9 v9, f10 v10, f11 v11, f12 v12, f13 v13, f14 v14, z]" - -subsection\<open>Generic Locale for Parsing\<close> - -locale Parse = - fixes ext :: "string \<Rightarrow> string" - - \<comment> \<open>(effective) first order\<close> - fixes of_string :: "('a \<Rightarrow> 'a list \<Rightarrow> 'a) \<Rightarrow> (string \<Rightarrow> 'a) \<Rightarrow> string \<Rightarrow> 'a" - fixes of_string\<^sub>b\<^sub>a\<^sub>s\<^sub>e :: "('a \<Rightarrow> 'a list \<Rightarrow> 'a) \<Rightarrow> (string \<Rightarrow> 'a) \<Rightarrow> string\<^sub>b\<^sub>a\<^sub>s\<^sub>e \<Rightarrow> 'a" - fixes of_nat :: "('a \<Rightarrow> 'a list \<Rightarrow> 'a) \<Rightarrow> (string \<Rightarrow> 'a) \<Rightarrow> natural \<Rightarrow> 'a" - fixes of_unit :: "(string \<Rightarrow> 'a) \<Rightarrow> unit \<Rightarrow> 'a" - fixes of_bool :: "(string \<Rightarrow> 'a) \<Rightarrow> bool \<Rightarrow> 'a" - - \<comment> \<open>(simulation) higher order\<close> - fixes Of_Pair Of_Nil Of_Cons Of_None Of_Some :: string -begin - -definition "of_pair a b f1 f2 = (\<lambda>f. \<lambda>(c, d) \<Rightarrow> f c d) - (ap2 a (b Of_Pair) f1 f2)" - -definition "of_list a b f = (\<lambda>f0. rec_list f0 o co1 K) - (b Of_Nil) - (ar2 a (b Of_Cons) f)" - -definition "of_option a b f = rec_option - (b Of_None) - (ap1 a (b Of_Some) f)" - -end - -lemmas [code] = - Parse.of_pair_def - Parse.of_list_def - Parse.of_option_def - -text\<open> -This theory and all the deriving one could -also be prefixed by ``print'' instead of ``parse''. -In any case, we are converting (or printing) the above datatypes to another format, -and finally this format will be ``parsed'' by Isabelle!\<close> - -end diff --git a/Citadelle/src/compiler_generic/meta_isabelle/Printer_Isabelle.thy b/Citadelle/src/compiler_generic/meta_isabelle/Printer_Isabelle.thy deleted file mode 100644 index b7e2e2c85f431ec670a866a0799abd398b23ed05..0000000000000000000000000000000000000000 --- a/Citadelle/src/compiler_generic/meta_isabelle/Printer_Isabelle.thy +++ /dev/null @@ -1,479 +0,0 @@ -(****************************************************************************** - * A Meta-Model for the Isabelle API - * - * 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. - ******************************************************************************) - -section\<open>Instantiating the Printer for Isabelle\<close> - -theory Printer_Isabelle -imports Meta_Isabelle - Printer_Pure - Printer_SML -begin - -context Print -begin - -fun of_semi__typ where "of_semi__typ e = (\<lambda> - Typ_base s \<Rightarrow> To_string s - | Typ_apply name l \<Rightarrow> \<open>%s %s\<close> (let s = String_concat \<open>, \<close> (List.map of_semi__typ l) in - case l of [_] \<Rightarrow> s | _ \<Rightarrow> \<open>(%s)\<close> s) - (of_semi__typ name) - | Typ_apply_bin s ty1 ty2 \<Rightarrow> \<open>%s %s %s\<close> (of_semi__typ ty1) (To_string s) (of_semi__typ ty2) - | Typ_apply_paren s1 s2 ty \<Rightarrow> \<open>%s%s%s\<close> (To_string s1) (of_semi__typ ty) (To_string s2)) e" - -definition "of_semi__typ' = (\<lambda> (n, v). if v = [] then - To_string n - else - of_semi__typ (Typ_apply (Typ_base n) (L.map Typ_base v)))" - -definition "of_datatype _ = (\<lambda> Datatype _ [] \<Rightarrow> \<open>\<close> - | Datatype version (d # ds) \<Rightarrow> - let of_datatype = (\<lambda>type (n, l). - \<open>%s %s = %s\<close> - type - (of_semi__typ' n) - (String_concat \<open> - | \<close> - (L.map - (\<lambda>(n, l). - \<open>%s %s\<close> - (To_string n) - (String_concat \<open> \<close> (L.map (\<lambda>x. \<open>\"%s\"\<close> (of_semi__typ x)) l))) l) )) in - \<open>%s%s\<close> (of_datatype (case version of Datatype_new \<Rightarrow> \<open>datatype\<close> - | Datatype_old \<Rightarrow> \<open>old_datatype\<close> - | Datatype_old_atomic \<Rightarrow> \<open>atomic_old_datatype\<close> - | Datatype_old_atomic_sub \<Rightarrow> \<open>sub_atomic_old_datatype\<close>) d) - (String_concat \<open>\<close> (L.map (of_datatype \<open> -and\<close>) ds)))" - -definition "of_type_synonym _ = (\<lambda> Type_synonym n l \<Rightarrow> - \<open>type_synonym %s = \"%s\"\<close> (of_semi__typ' n) (of_semi__typ l))" - -fun of_semi__term where "of_semi__term e = (\<lambda> - Term_rewrite e1 symb e2 \<Rightarrow> \<open>%s %s %s\<close> (of_semi__term e1) (To_string symb) (of_semi__term e2) - | Term_basic l \<Rightarrow> \<open>%s\<close> (String_concat \<open> \<close> (L.map To_string l)) - | Term_annot e s \<Rightarrow> \<open>(%s::%s)\<close> (of_semi__term e) (of_semi__typ s) - | Term_bind symb e1 e2 \<Rightarrow> \<open>(%s%s. %s)\<close> (To_string symb) (of_semi__term e1) (of_semi__term e2) - | Term_fun_case e_case l \<Rightarrow> \<open>(%s %s)\<close> - (case e_case of None \<Rightarrow> \<open>\<lambda>\<close> - | Some e \<Rightarrow> \<open>case %s of\<close> (of_semi__term e)) - (String_concat \<open> - | \<close> (List.map (\<lambda> (s1, s2) \<Rightarrow> \<open>%s \<Rightarrow> %s\<close> (of_semi__term s1) (of_semi__term s2)) l)) - | Term_apply e l \<Rightarrow> \<open>%s %s\<close> (of_semi__term e) (String_concat \<open> \<close> (List.map (\<lambda> e \<Rightarrow> \<open>%s\<close> (of_semi__term e)) l)) - | Term_paren p_left p_right e \<Rightarrow> \<open>%s%s%s\<close> (To_string p_left) (of_semi__term e) (To_string p_right) - | Term_if_then_else e_if e_then e_else \<Rightarrow> \<open>if %s then %s else %s\<close> (of_semi__term e_if) (of_semi__term e_then) (of_semi__term e_else) - | Term_let l e_body \<Rightarrow> \<open>let %s in %s\<close> (String_concat \<open>; \<close> (List.map (\<lambda>(e1, e2). \<open>%s = %s\<close> (of_semi__term e1) (of_semi__term e2)) l)) (of_semi__term e_body) - | Term_term l pure \<Rightarrow> of_pure_term True (L.map To_string l) pure) e" - -definition "of_type_notation _ = (\<lambda> Type_notation n e \<Rightarrow> - \<open>type_notation %s (\"%s\")\<close> (To_string n) (To_string e))" - -definition "of_instantiation _ = (\<lambda> Instantiation n n_def expr \<Rightarrow> - let name = To_string n in - \<open>instantiation %s :: object -begin - definition %s_%s_def : \"%s\" - instance .. -end\<close> - name - (To_string n_def) - name - (of_semi__term expr))" - -definition "of_overloading _ = (\<lambda> Overloading n_c e_c n e \<Rightarrow> - \<open>overloading %s \<equiv> \"%s\" -begin - definition %s : \"%s\" -end\<close> (To_string n_c) (of_semi__term e_c) (To_string n) (of_semi__term e))" - -definition "of_consts _ = (\<lambda> Consts n ty symb \<Rightarrow> - \<open>consts %s :: \"%s\" (\"%s %s\")\<close> (To_string n) (of_semi__typ ty) (To_string Consts_value) (To_string symb))" - -definition "of_definition _ = (\<lambda> - Definition e \<Rightarrow> \<open>definition \"%s\"\<close> (of_semi__term e) - | Definition_where1 name (abbrev, prio) e \<Rightarrow> \<open>definition %s (\"(1%s)\" %d) - where \"%s\"\<close> (To_string name) (of_semi__term abbrev) (To_nat prio) (of_semi__term e) - | Definition_where2 name abbrev e \<Rightarrow> \<open>definition %s (\"%s\") - where \"%s\"\<close> (To_string name) (of_semi__term abbrev) (of_semi__term e))" - -definition "(of_semi__thm_attribute_aux_gen :: String.literal \<times> String.literal \<Rightarrow> _ \<Rightarrow> _ \<Rightarrow> _) m lacc s = - (let s_base = (\<lambda>s lacc. \<open>%s[%s]\<close> (To_string s) (String_concat \<open>, \<close> (L.map (\<lambda>(s, x). \<open>%s %s\<close> s x) lacc))) in - s_base s (m # lacc))" - -definition "of_semi__thm_attribute_aux_gen_where l = - (\<open>where\<close>, String_concat \<open> and \<close> (L.map (\<lambda>(var, expr). \<open>%s = \"%s\"\<close> - (To_string var) - (of_semi__term expr)) l))" - -definition "of_semi__thm_attribute_aux_gen_of l = - (\<open>of\<close>, String_concat \<open> \<close> (L.map (\<lambda>expr. \<open>\"%s\"\<close> (of_semi__term expr)) l))" - -fun of_semi__thm_attribute_aux where "of_semi__thm_attribute_aux lacc e = - (\<lambda> Thm_thm s \<Rightarrow> To_string s - | Thm_thms s \<Rightarrow> To_string s - - | Thm_THEN (Thm_thm s) e2 \<Rightarrow> of_semi__thm_attribute_aux_gen (\<open>THEN\<close>, of_semi__thm_attribute_aux [] e2) lacc s - | Thm_THEN (Thm_thms s) e2 \<Rightarrow> of_semi__thm_attribute_aux_gen (\<open>THEN\<close>, of_semi__thm_attribute_aux [] e2) lacc s - | Thm_THEN e1 e2 \<Rightarrow> of_semi__thm_attribute_aux ((\<open>THEN\<close>, of_semi__thm_attribute_aux [] e2) # lacc) e1 - - | Thm_simplified (Thm_thm s) e2 \<Rightarrow> of_semi__thm_attribute_aux_gen (\<open>simplified\<close>, of_semi__thm_attribute_aux [] e2) lacc s - | Thm_simplified (Thm_thms s) e2 \<Rightarrow> of_semi__thm_attribute_aux_gen (\<open>simplified\<close>, of_semi__thm_attribute_aux [] e2) lacc s - | Thm_simplified e1 e2 \<Rightarrow> of_semi__thm_attribute_aux ((\<open>simplified\<close>, of_semi__thm_attribute_aux [] e2) # lacc) e1 - - | Thm_symmetric (Thm_thm s) \<Rightarrow> of_semi__thm_attribute_aux_gen (\<open>symmetric\<close>, \<open>\<close>) lacc s - | Thm_symmetric (Thm_thms s) \<Rightarrow> of_semi__thm_attribute_aux_gen (\<open>symmetric\<close>, \<open>\<close>) lacc s - | Thm_symmetric e1 \<Rightarrow> of_semi__thm_attribute_aux ((\<open>symmetric\<close>, \<open>\<close>) # lacc) e1 - - | Thm_where (Thm_thm s) l \<Rightarrow> of_semi__thm_attribute_aux_gen (of_semi__thm_attribute_aux_gen_where l) lacc s - | Thm_where (Thm_thms s) l \<Rightarrow> of_semi__thm_attribute_aux_gen (of_semi__thm_attribute_aux_gen_where l) lacc s - | Thm_where e1 l \<Rightarrow> of_semi__thm_attribute_aux (of_semi__thm_attribute_aux_gen_where l # lacc) e1 - - | Thm_of (Thm_thm s) l \<Rightarrow> of_semi__thm_attribute_aux_gen (of_semi__thm_attribute_aux_gen_of l) lacc s - | Thm_of (Thm_thms s) l \<Rightarrow> of_semi__thm_attribute_aux_gen (of_semi__thm_attribute_aux_gen_of l) lacc s - | Thm_of e1 l \<Rightarrow> of_semi__thm_attribute_aux (of_semi__thm_attribute_aux_gen_of l # lacc) e1 - - | Thm_OF (Thm_thm s) e2 \<Rightarrow> of_semi__thm_attribute_aux_gen (\<open>OF\<close>, of_semi__thm_attribute_aux [] e2) lacc s - | Thm_OF (Thm_thms s) e2 \<Rightarrow> of_semi__thm_attribute_aux_gen (\<open>OF\<close>, of_semi__thm_attribute_aux [] e2) lacc s - | Thm_OF e1 e2 \<Rightarrow> of_semi__thm_attribute_aux ((\<open>OF\<close>, of_semi__thm_attribute_aux [] e2) # lacc) e1) e" - -definition "of_semi__thm_attribute = of_semi__thm_attribute_aux []" - -definition "of_semi__thm = (\<lambda> Thms_single thy \<Rightarrow> of_semi__thm_attribute thy - | Thms_mult thy \<Rightarrow> of_semi__thm_attribute thy)" - -definition "of_semi__thm_attribute_l l = String_concat \<open> - \<close> (L.map of_semi__thm_attribute l)" -definition "of_semi__thm_attribute_l1 l = String_concat \<open> \<close> (L.map of_semi__thm_attribute l)" - -definition "of_semi__thm_l l = String_concat \<open> \<close> (L.map of_semi__thm l)" - -definition "of_lemmas _ = (\<lambda> Lemmas_simp_thm simp s l \<Rightarrow> - \<open>lemmas%s%s = %s\<close> - (if String.is_empty s then \<open>\<close> else \<open> %s\<close> (To_string s)) - (if simp then \<open>[simp,code_unfold]\<close> else \<open>\<close>) - (of_semi__thm_attribute_l l) - | Lemmas_simp_thms s l \<Rightarrow> - \<open>lemmas%s [simp,code_unfold] = %s\<close> - (if String.is_empty s then \<open>\<close> else \<open> %s\<close> (To_string s)) - (String_concat \<open> - \<close> (L.map To_string l)))" - -definition "(of_semi__attrib_genA :: (semi__thm list \<Rightarrow> String.literal) - \<Rightarrow> String.literal \<Rightarrow> semi__thm list \<Rightarrow> String.literal) f attr l = \<comment> \<open>error reflection: to be merged\<close> - (if l = [] then - \<open>\<close> - else - \<open> %s: %s\<close> attr (f l))" - -definition "(of_semi__attrib_genB :: (string list \<Rightarrow> String.literal) - \<Rightarrow> String.literal \<Rightarrow> string list \<Rightarrow> String.literal) f attr l = \<comment> \<open>error reflection: to be merged\<close> - (if l = [] then - \<open>\<close> - else - \<open> %s: %s\<close> attr (f l))" - -definition "of_semi__attrib = of_semi__attrib_genA of_semi__thm_l" -definition "of_semi__attrib1 = of_semi__attrib_genB (\<lambda>l. String_concat \<open> \<close> (L.map To_string l))" - -definition "of_semi__method_simp (s :: \<comment> \<open>polymorphism weakening needed by \<^theory_text>\<open>code_reflect\<close>\<close> - String.literal) = - (\<lambda> Method_simp_only l \<Rightarrow> \<open>%s only: %s\<close> s (of_semi__thm_l l) - | Method_simp_add_del_split l1 l2 [] \<Rightarrow> \<open>%s%s%s\<close> - s - (of_semi__attrib \<open>add\<close> l1) - (of_semi__attrib \<open>del\<close> l2) - | Method_simp_add_del_split l1 l2 l3 \<Rightarrow> \<open>%s%s%s%s\<close> - s - (of_semi__attrib \<open>add\<close> l1) - (of_semi__attrib \<open>del\<close> l2) - (of_semi__attrib \<open>split\<close> l3))" - -fun of_semi__method where "of_semi__method expr = (\<lambda> - Method_rule o_s \<Rightarrow> \<open>rule%s\<close> (case o_s of None \<Rightarrow> \<open>\<close> - | Some s \<Rightarrow> \<open> %s\<close> (of_semi__thm_attribute s)) - | Method_drule s \<Rightarrow> \<open>drule %s\<close> (of_semi__thm_attribute s) - | Method_erule s \<Rightarrow> \<open>erule %s\<close> (of_semi__thm_attribute s) - | Method_intro l \<Rightarrow> \<open>intro %s\<close> (of_semi__thm_attribute_l1 l) - | Method_elim s \<Rightarrow> \<open>elim %s\<close> (of_semi__thm_attribute s) - | Method_subst asm l s => - let s_asm = if asm then \<open>(asm) \<close> else \<open>\<close> in - if L.map String.meta_of_logic l = [STR ''0''] then - \<open>subst %s%s\<close> s_asm (of_semi__thm_attribute s) - else - \<open>subst %s(%s) %s\<close> s_asm (String_concat \<open> \<close> (L.map To_string l)) (of_semi__thm_attribute s) - | Method_insert l => \<open>insert %s\<close> (of_semi__thm_l l) - | Method_plus t \<Rightarrow> \<open>(%s)+\<close> (String_concat \<open>, \<close> (List.map of_semi__method t)) - | Method_option t \<Rightarrow> \<open>(%s)?\<close> (String_concat \<open>, \<close> (List.map of_semi__method t)) - | Method_or t \<Rightarrow> \<open>(%s)\<close> (String_concat \<open> | \<close> (List.map of_semi__method t)) - | Method_one s \<Rightarrow> of_semi__method_simp \<open>simp\<close> s - | Method_all s \<Rightarrow> of_semi__method_simp \<open>simp_all\<close> s - | Method_auto_simp_add_split l_simp l_split \<Rightarrow> \<open>auto%s%s\<close> - (of_semi__attrib \<open>simp\<close> l_simp) - (of_semi__attrib1 \<open>split\<close> l_split) - | Method_rename_tac l \<Rightarrow> \<open>rename_tac %s\<close> (String_concat \<open> \<close> (L.map To_string l)) - | Method_case_tac e \<Rightarrow> \<open>case_tac \"%s\"\<close> (of_semi__term e) - | Method_blast None \<Rightarrow> \<open>blast\<close> - | Method_blast (Some n) \<Rightarrow> \<open>blast %d\<close> (To_nat n) - | Method_clarify \<Rightarrow> \<open>clarify\<close> - | Method_metis l_opt l \<Rightarrow> \<open>metis %s%s\<close> (if l_opt = [] then \<open>\<close> - else - \<open>(%s) \<close> (String_concat \<open>, \<close> (L.map To_string l_opt))) (of_semi__thm_attribute_l1 l)) expr" - -definition "of_semi__command_final = (\<lambda> Command_done \<Rightarrow> \<open>done\<close> - | Command_by l_apply \<Rightarrow> \<open>by(%s)\<close> (String_concat \<open>, \<close> (L.map of_semi__method l_apply)) - | Command_sorry \<Rightarrow> \<open>sorry\<close>)" - -definition "of_semi__command_state = ( - \<lambda> Command_apply_end [] \<Rightarrow> \<open>\<close> - | Command_apply_end l_apply \<Rightarrow> \<open> apply_end(%s) -\<close> (String_concat \<open>, \<close> (L.map of_semi__method l_apply)))" - -definition \<open>of_semi__command_proof = ( - let thesis = \<open>?thesis\<close> - ; scope_thesis_gen = \<lambda>proof show when. \<open> proof - %s show %s%s -\<close> proof - show - (if when = [] then - \<open>\<close> - else - \<open> when %s\<close> (String_concat \<open> \<close> (L.map (\<lambda>t. \<open>"%s"\<close> (of_semi__term t)) when))) - ; scope_thesis = \<lambda>s. scope_thesis_gen s thesis [] in - \<lambda> Command_apply [] \<Rightarrow> \<open>\<close> - | Command_apply l_apply \<Rightarrow> \<open> apply(%s) -\<close> (String_concat \<open>, \<close> (L.map of_semi__method l_apply)) - | Command_using l \<Rightarrow> \<open> using %s -\<close> (of_semi__thm_l l) - | Command_unfolding l \<Rightarrow> \<open> unfolding %s -\<close> (of_semi__thm_l l) - | Command_let e_name e_body \<Rightarrow> scope_thesis (\<open>let %s = "%s"\<close> (of_semi__term e_name) (of_semi__term e_body)) - | Command_have n b e e_last \<Rightarrow> scope_thesis (\<open>have %s%s: "%s" %s\<close> (To_string n) (if b then \<open>[simp]\<close> else \<open>\<close>) (of_semi__term e) (of_semi__command_final e_last)) - | Command_fix_let l l_let o_show _ \<Rightarrow> - scope_thesis_gen - (\<open>fix %s%s\<close> (String_concat \<open> \<close> (L.map To_string l)) - (String_concat \<open> -\<close> (L.map - (\<lambda>(e_name, e_body). - \<open> let %s = "%s"\<close> (of_semi__term e_name) (of_semi__term e_body)) - l_let))) - (case o_show of None \<Rightarrow> thesis - | Some (l_show, _) \<Rightarrow> \<open>"%s"\<close> (String_concat \<open> \<Longrightarrow> \<close> (L.map of_semi__term l_show))) - (case o_show of None \<Rightarrow> [] | Some (_, l_when) \<Rightarrow> l_when))\<close> - -definition "of_lemma _ = - (\<lambda> Lemma n l_spec l_apply tactic_last \<Rightarrow> - \<open>lemma %s : \"%s\" -%s%s\<close> - (To_string n) - (String_concat \<open> \<Longrightarrow> \<close> (L.map of_semi__term l_spec)) - (String_concat \<open>\<close> (L.map (\<lambda> [] \<Rightarrow> \<open>\<close> | l_apply \<Rightarrow> \<open> apply(%s) -\<close> - (String_concat \<open>, \<close> (L.map of_semi__method l_apply))) - l_apply)) - (of_semi__command_final tactic_last) - | Lemma_assumes n l_spec concl l_apply tactic_last \<Rightarrow> - \<open>lemma %s :%s -%s%s%s\<close> - (To_string n) - (String_concat \<open>\<close> (L.map (\<lambda>(n, b, e). - \<open> -assumes %s\"%s\"\<close> - (let (n, b) = if b then (\<open>%s[simp]\<close> (To_string n), False) else (To_string n, String.is_empty n) in - if b then \<open>\<close> else \<open>%s: \<close> n) - (of_semi__term e)) l_spec - @@@@ - [\<open> -shows \"%s\"\<close> (of_semi__term concl)])) - (String_concat \<open>\<close> (L.map of_semi__command_proof l_apply)) - (of_semi__command_final tactic_last) - (String_concat \<open>\<close> - (L.map - (\<lambda>l_apply_e. - \<open>%s qed\<close> - (if l_apply_e = [] then - \<open>\<close> - else - \<open> -%s\<close> - (String_concat \<open>\<close> (L.map of_semi__command_state l_apply_e)))) - (List.map_filter - (\<lambda> Command_let _ _ \<Rightarrow> Some [] | Command_have _ _ _ _ \<Rightarrow> Some [] | Command_fix_let _ _ _ l \<Rightarrow> Some l | _ \<Rightarrow> None) - (rev l_apply)))))" - - -definition "of_axiomatization _ = (\<lambda> Axiomatization n e \<Rightarrow> \<open>axiomatization where %s: -\"%s\"\<close> (To_string n) (of_semi__term e))" - -definition "of_section _ = (\<lambda> Section n section_title \<Rightarrow> - \<open>%s \<open>%s\<close>\<close> - (\<open>%ssection\<close> (if n = 0 then \<open>\<close> - else if n = 1 then \<open>sub\<close> - else \<open>subsub\<close>)) - (To_string section_title))" - -definition "of_text _ = (\<lambda> Text s \<Rightarrow> \<open>text \<open>%s\<close>\<close> (To_string s))" - -definition "of_text_raw _ = (\<lambda> Text_raw s \<Rightarrow> \<open>text_raw \<open>%s\<close>\<close> (To_string s))" - -definition "of_ML _ = (\<lambda> SML e \<Rightarrow> \<open>ML \<open>%s\<close>\<close> (of_semi__term' e))" - -definition "of_setup _ = (\<lambda> Setup e \<Rightarrow> \<open>setup \<open>%s\<close>\<close> (of_semi__term' e))" - -definition "of_thm _ = (\<lambda> Thm thm \<Rightarrow> \<open>thm %s\<close> (of_semi__thm_attribute_l1 thm))" - -definition \<open>of_interpretation _ = (\<lambda> Interpretation n loc_n loc_param tac \<Rightarrow> - \<open>interpretation %s: %s%s -%s\<close> (To_string n) - (To_string loc_n) - (String_concat \<open>\<close> (L.map (\<lambda>s. \<open> "%s"\<close> (of_semi__term s)) loc_param)) - (of_semi__command_final tac))\<close> - -definition "of_hide_const _ = (\<lambda> Hide_const b l \<Rightarrow> - \<open>hide_const %s%s\<close> (if b then \<open>(open) \<close> else \<open>\<close>) - (String_concat \<open> \<close> (L.map To_string l)))" - -definition "of_abbreviation _ = (\<lambda> Abbreviation e \<Rightarrow> - \<open>abbreviation \"%s\"\<close> (of_semi__term e))" - -definition "of_code_reflect' _ = (\<lambda> Code_reflect' b s l \<Rightarrow> - \<open>code_reflect' %s%s%s\<close> - (if b then \<open>open \<close> else \<open>\<close>) - (To_string s) - (case l of [] \<Rightarrow> \<open>\<close> | _ \<Rightarrow> \<open> functions %s\<close> (String_concat \<open> \<close> (L.map To_string l))))" - -definition "of_semi__theory env = - (\<lambda> Theory_datatype dataty \<Rightarrow> of_datatype env dataty - | Theory_type_synonym ty_synonym \<Rightarrow> of_type_synonym env ty_synonym - | Theory_type_notation ty_notation \<Rightarrow> of_type_notation env ty_notation - | Theory_instantiation instantiation_class \<Rightarrow> of_instantiation env instantiation_class - | Theory_overloading overloading \<Rightarrow> of_overloading env overloading - | Theory_consts consts_class \<Rightarrow> of_consts env consts_class - | Theory_definition definition_hol \<Rightarrow> of_definition env definition_hol - | Theory_lemmas lemmas_simp \<Rightarrow> of_lemmas env lemmas_simp - | Theory_lemma lemma_by \<Rightarrow> of_lemma env lemma_by - | Theory_axiomatization axiom \<Rightarrow> of_axiomatization env axiom - | Theory_section section_title \<Rightarrow> of_section env section_title - | Theory_text text \<Rightarrow> of_text env text - | Theory_text_raw text \<Rightarrow> of_text_raw env text - | Theory_ML ml \<Rightarrow> of_ML env ml - | Theory_setup setup \<Rightarrow> of_setup env setup - | Theory_thm thm \<Rightarrow> of_thm env thm - | Theory_interpretation thm \<Rightarrow> of_interpretation env thm - | Theory_hide_const const \<Rightarrow> of_hide_const env const - | Theory_abbreviation abbreviation \<Rightarrow> of_abbreviation env abbreviation - | Theory_code_reflect' code_reflect' \<Rightarrow> of_code_reflect' env code_reflect')" - -definition "String_concat_map s f l = String_concat s (L.map f l)" - -definition \<open>of_semi__theories env = - (\<lambda> Theories_one t \<Rightarrow> of_semi__theory env t - | Theories_locale data l \<Rightarrow> - \<open>locale %s = -%s -begin -%s -end\<close> (To_string (HolThyLocale_name data)) - (String_concat_map - \<open> -\<close> - (\<lambda> (l_fix, o_assum). - \<open>%s%s\<close> (String_concat_map \<open> -\<close> (\<lambda>(e, ty). \<open>fixes "%s" :: "%s"\<close> (of_semi__term e) (of_semi__typ ty)) l_fix) - (case o_assum of None \<Rightarrow> \<open>\<close> - | Some (name, e) \<Rightarrow> \<open> -assumes %s: "%s"\<close> (To_string name) (of_semi__term e))) - (HolThyLocale_header data)) - (String_concat_map \<open> - -\<close> (String_concat_map \<open> - -\<close> (of_semi__theory env)) l))\<close> - -end - -lemmas [code] = - \<comment> \<open>def\<close> - Print.of_semi__typ'_def - Print.of_datatype_def - Print.of_type_synonym_def - Print.of_type_notation_def - Print.of_instantiation_def - Print.of_overloading_def - Print.of_consts_def - Print.of_definition_def - Print.of_semi__thm_attribute_aux_gen_def - Print.of_semi__thm_attribute_aux_gen_where_def - Print.of_semi__thm_attribute_aux_gen_of_def - Print.of_semi__thm_attribute_def - Print.of_semi__thm_def - Print.of_semi__thm_attribute_l_def - Print.of_semi__thm_attribute_l1_def - Print.of_semi__thm_l_def - Print.of_lemmas_def - Print.of_semi__attrib_genA_def - Print.of_semi__attrib_genB_def - Print.of_semi__attrib_def - Print.of_semi__attrib1_def - Print.of_semi__method_simp_def - Print.of_semi__command_final_def - Print.of_semi__command_state_def - Print.of_semi__command_proof_def - Print.of_lemma_def - Print.of_axiomatization_def - Print.of_section_def - Print.of_text_def - Print.of_text_raw_def - Print.of_ML_def - Print.of_setup_def - Print.of_thm_def - Print.of_interpretation_def - Print.of_hide_const_def - Print.of_abbreviation_def - Print.of_code_reflect'_def - Print.of_semi__theory_def - Print.String_concat_map_def - Print.of_semi__theories_def - - \<comment> \<open>fun\<close> - Print.of_semi__typ.simps - Print.of_semi__term.simps - Print.of_semi__thm_attribute_aux.simps - Print.of_semi__method.simps - -end diff --git a/Citadelle/src/compiler_generic/meta_isabelle/Printer_Pure.thy b/Citadelle/src/compiler_generic/meta_isabelle/Printer_Pure.thy deleted file mode 100644 index 02e22ea3d7c6666206a2bc728f91f5c489d17a21..0000000000000000000000000000000000000000 --- a/Citadelle/src/compiler_generic/meta_isabelle/Printer_Pure.thy +++ /dev/null @@ -1,88 +0,0 @@ -(****************************************************************************** - * A Meta-Model for the Isabelle API - * - * 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. - ******************************************************************************) - -section\<open>Instantiating the Printer for (Pure) Term\<close> - -theory Printer_Pure -imports Meta_Pure - Printer_init -begin - -context Print -begin - -fun of_pure_typ where "of_pure_typ e = (\<lambda> - Type s l \<Rightarrow> if s \<triangleq> \<langle>STR ''fun''\<rangle> then - \<open>(%s)\<close> (String_concat \<open> \<Rightarrow> \<close> (List.map of_pure_typ l)) - else if s \<triangleq> \<langle>STR ''Product_Type.prod''\<rangle> then - \<open>(%s)\<close> (String_concat \<open> \<times> \<close> (List.map of_pure_typ l)) - else - \<open>%s%s\<close> (case l of [] \<Rightarrow> \<open>\<close> - | _ \<Rightarrow> \<open>(%s) \<close> (String_concat \<open>, \<close> (List.map of_pure_typ l))) - (To_string s) - | TFree _ _ \<Rightarrow> \<open>_\<close>) e" - -definition "pure_typ0 show_t s t = - (let s = To_string s in - if show_t then - \<open>(%s :: %s)\<close> s (of_pure_typ t) - else - s)" - -fun of_pure_term where "of_pure_term show_t l e = (\<lambda> - Const s t \<Rightarrow> pure_typ0 show_t s t - | Free s t \<Rightarrow> pure_typ0 show_t s t - | App t1 t2 \<Rightarrow> \<open>(%s) (%s)\<close> (of_pure_term show_t l t1) (of_pure_term show_t l t2) - | Abs s st t \<Rightarrow> - \<open>(\<lambda> %s. %s)\<close> (pure_typ0 show_t s st) (of_pure_term show_t (To_string s # l) t) - | Bound n \<Rightarrow> \<open>%s\<close> (l ! nat_of_natural n)) e" - -end - -lemmas [code] = - \<comment> \<open>def\<close> - Print.pure_typ0_def - - \<comment> \<open>fun\<close> - Print.of_pure_typ.simps - Print.of_pure_term.simps - -end diff --git a/Citadelle/src/compiler_generic/meta_isabelle/Printer_SML.thy b/Citadelle/src/compiler_generic/meta_isabelle/Printer_SML.thy deleted file mode 100644 index 65597b677518f3e51948649138f9d7aab698b3c8..0000000000000000000000000000000000000000 --- a/Citadelle/src/compiler_generic/meta_isabelle/Printer_SML.thy +++ /dev/null @@ -1,87 +0,0 @@ -(****************************************************************************** - * A Meta-Model for the Isabelle API - * - * 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. - ******************************************************************************) - -section\<open>Instantiating the Printer for SML\<close> - -theory Printer_SML -imports Meta_SML - Printer_init -begin - -context Print -begin - -definition "of_semi__val_fun = (\<lambda> Sval \<Rightarrow> \<open>val\<close> - | Sfun \<Rightarrow> \<open>fun\<close>)" - -fun of_semi__term'0 and - of_semi__term'1 and - of_semi__term' where - \<open>of_semi__term'0 e = (\<lambda> - SML_string s \<Rightarrow> \<open>"%s"\<close> (To_string (escape_sml s)) - | SML_rewrite e1 symb e2 \<Rightarrow> \<open>%s %s %s\<close> (of_semi__term'0 e1) (To_string symb) (of_semi__term'0 e2) - | SML_basic l \<Rightarrow> \<open>%s\<close> (String_concat \<open> \<close> (L.map To_string l)) - | SML_binop e1 s e2 \<Rightarrow> \<open>%s %s %s\<close> (of_semi__term'0 e1) (of_semi__term'0 (SML_basic [s])) (of_semi__term'0 e2) - | SML_annot e s \<Rightarrow> \<open>(%s:%s)\<close> (of_semi__term'0 e) (To_string s) - | SML_function l \<Rightarrow> \<open>(fn %s)\<close> (String_concat \<open> - | \<close> (List.map (\<lambda> (s1, s2) \<Rightarrow> \<open>%s => %s\<close> (of_semi__term'0 s1) (of_semi__term'0 s2)) l)) - | SML_apply e l \<Rightarrow> \<open>(%s %s)\<close> (of_semi__term'0 e) (String_concat \<open> \<close> (List.map (\<lambda> e \<Rightarrow> \<open>(%s)\<close> (of_semi__term'0 e)) l)) - | SML_paren p_left p_right e \<Rightarrow> \<open>%s%s%s\<close> (To_string p_left) (of_semi__term'0 e) (To_string p_right) - | SML_let e1 e2 \<Rightarrow> \<open>let %s in %s end\<close> (of_semi__term' e1) (of_semi__term'0 e2)) e\<close> - | \<open>of_semi__term'1 e = (\<lambda> - SML_open s \<Rightarrow> \<open>open %s\<close> (To_string s) - | SML_val_fun val_fun e \<Rightarrow> \<open>%s%s\<close> (case val_fun of None \<Rightarrow> \<open>\<close> - | Some val_fun \<Rightarrow> \<open>%s \<close> (of_semi__val_fun val_fun)) - (of_semi__term'0 e)) e\<close> - | \<open>of_semi__term' e = (\<lambda> - SML_top l \<Rightarrow> String_concat \<open> \<close> (List.map of_semi__term'1 l)) e\<close> - -end - -lemmas [code] = - \<comment> \<open>def\<close> - Print.of_semi__val_fun_def - \<comment> \<open>fun\<close> - Print.of_semi__term'0.simps - Print.of_semi__term'1.simps - Print.of_semi__term'.simps - -end diff --git a/Citadelle/src/compiler_generic/meta_isabelle/Printer_init.thy b/Citadelle/src/compiler_generic/meta_isabelle/Printer_init.thy deleted file mode 100644 index 36c2f2dfce4d40f0913448714092e38629c26d04..0000000000000000000000000000000000000000 --- a/Citadelle/src/compiler_generic/meta_isabelle/Printer_init.thy +++ /dev/null @@ -1,434 +0,0 @@ -(****************************************************************************** - * Citadelle - * - * 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. - ******************************************************************************) - -section\<open>Initializing the Printer\<close> - -theory Printer_init -imports "../Init" - "../isabelle_home/src/HOL/Isabelle_Main1" -begin - -text\<open>At the time of writing, the following target languages supported - by Isabelle are also supported by the meta-compiler: - Haskell, OCaml, Scala, SML.\<close> - -subsection\<open>Kernel Code for Target Languages\<close> - - (* We put in 'CodeConst' functions using characters - not allowed in a Isabelle 'code_const' expr - (e.g. '_', '"', ...) *) - -lazy_code_printing code_module "CodeType" \<rightharpoonup> (Haskell) \<open> - type MlInt = Integer -; type MlMonad a = IO a -\<close> | code_module "CodeConst" \<rightharpoonup> (Haskell) \<open> - import System.Directory -; import System.IO -; import qualified CodeConst.Printf - -; outFile1 f file = (do - fileExists <- doesFileExist file - if fileExists then error ("File exists " ++ file ++ "\n") else do - h <- openFile file WriteMode - f (\pat -> hPutStr h . CodeConst.Printf.sprintf1 pat) - hClose h) - -; outStand1 :: ((String -> String -> IO ()) -> IO ()) -> IO () -; outStand1 f = f (\pat -> putStr . CodeConst.Printf.sprintf1 pat) -\<close> | code_module "CodeConst.Monad" \<rightharpoonup> (Haskell) \<open> - bind a = (>>=) a -; return :: a -> IO a -; return = Prelude.return -\<close> | code_module "CodeConst.Printf" \<rightharpoonup> (Haskell) \<open> - import Text.Printf -; sprintf0 = id - -; sprintf1 :: PrintfArg a => String -> a -> String -; sprintf1 = printf - -; sprintf2 :: PrintfArg a => PrintfArg b => String -> a -> b -> String -; sprintf2 = printf - -; sprintf3 :: PrintfArg a => PrintfArg b => PrintfArg c => String -> a -> b -> c -> String -; sprintf3 = printf - -; sprintf4 :: PrintfArg a => PrintfArg b => PrintfArg c => PrintfArg d => String -> a -> b -> c -> d -> String -; sprintf4 = printf - -; sprintf5 :: PrintfArg a => PrintfArg b => PrintfArg c => PrintfArg d => PrintfArg e => String -> a -> b -> c -> d -> e -> String -; sprintf5 = printf -\<close> | code_module "CodeConst.String" \<rightharpoonup> (Haskell) \<open> - concat s [] = [] -; concat s (x : xs) = x ++ concatMap ((++) s) xs -\<close> | code_module "CodeConst.Sys" \<rightharpoonup> (Haskell) \<open> - import System.Directory -; isDirectory2 = doesDirectoryExist -\<close> | code_module "CodeConst.To" \<rightharpoonup> (Haskell) \<open> - nat = id - -\<close> | code_module "" \<rightharpoonup> (OCaml) \<open> -module CodeType = struct - type mlInt = int - - type 'a mlMonad = 'a option -end - -module CodeConst = struct - let outFile1 f file = - try - let () = if Sys.file_exists file then Printf.eprintf "File exists \"%S\"\n" file else () in - let oc = open_out file in - let b = f (fun s a -> try Some (Printf.fprintf oc s a) with _ -> None) in - let () = close_out oc in - b - with _ -> None - - let outStand1 f = - f (fun s a -> try Some (Printf.fprintf stdout s a) with _ -> None) - - module Monad = struct - let bind = function - None -> fun _ -> None - | Some a -> fun f -> f a - let return a = Some a - end - - module Printf = struct - include Printf - let sprintf0 = sprintf - let sprintf1 = sprintf - let sprintf2 = sprintf - let sprintf3 = sprintf - let sprintf4 = sprintf - let sprintf5 = sprintf - end - - module String = String - - module Sys = struct open Sys - let isDirectory2 s = try Some (is_directory s) with _ -> None - end - - module To = struct - let nat big_int x = Big_int.int_of_big_int (big_int x) - end -end - -\<close> | code_module "" \<rightharpoonup> (Scala) \<open> -object CodeType { - type mlMonad [A] = Option [A] - type mlInt = Int -} - -object CodeConst { - def outFile1 [A] (f : (String => A => Option [Unit]) => Option [Unit], file0 : String) : Option [Unit] = { - val file = new java.io.File (file0) - if (file .isFile) { - None - } else { - val writer = new java.io.PrintWriter (file) - f ((fmt : String) => (s : A) => Some (writer .write (fmt .format (s)))) - Some (writer .close ()) - } - } - - def outStand1 [A] (f : (String => A => Option [Unit]) => Option [Unit]) : Option[Unit] = { - f ((fmt : String) => (s : A) => Some (print (fmt .format (s)))) - } - - object Monad { - def bind [A, B] (x : Option [A], f : A => Option [B]) : Option [B] = x match { - case None => None - case Some (a) => f (a) - } - def Return [A] (a : A) = Some (a) - } - object Printf { - def sprintf0 (x0 : String) = x0 - def sprintf1 [A1] (fmt : String, x1 : A1) = fmt .format (x1) - def sprintf2 [A1, A2] (fmt : String, x1 : A1, x2 : A2) = fmt .format (x1, x2) - def sprintf3 [A1, A2, A3] (fmt : String, x1 : A1, x2 : A2, x3 : A3) = fmt .format (x1, x2, x3) - def sprintf4 [A1, A2, A3, A4] (fmt : String, x1 : A1, x2 : A2, x3 : A3, x4 : A4) = fmt .format (x1, x2, x3, x4) - def sprintf5 [A1, A2, A3, A4, A5] (fmt : String, x1 : A1, x2 : A2, x3 : A3, x4 : A4, x5 : A5) = fmt .format (x1, x2, x3, x4, x5) - } - object String { - def concat (s : String, l : List [String]) = l filter (_ .nonEmpty) mkString s - } - object Sys { - def isDirectory2 (s : String) = Some (new java.io.File (s) .isDirectory) - } - object To { - def nat [A] (f : A => BigInt, x : A) = f (x) .intValue () - } -} - -\<close> | code_module "" \<rightharpoonup> (SML) \<open> -structure CodeType = struct - type mlInt = string - type 'a mlMonad = 'a option -end - -structure CodeConst = struct - structure Monad = struct - val bind = fn - NONE => (fn _ => NONE) - | SOME a => fn f => f a - val return = SOME - end - - structure Printf = struct - local - fun sprintf s l = - case String.fields (fn #"%" => true | _ => false) s of - [] => "" - | [x] => x - | x :: xs => - let fun aux acc l_pat l_s = - case l_pat of - [] => rev acc - | x :: xs => aux (String.extract (x, 1, NONE) :: hd l_s :: acc) xs (tl l_s) in - String.concat (x :: aux [] xs l) - end - in - fun sprintf0 s_pat = s_pat - fun sprintf1 s_pat s1 = sprintf s_pat [s1] - fun sprintf2 s_pat s1 s2 = sprintf s_pat [s1, s2] - fun sprintf3 s_pat s1 s2 s3 = sprintf s_pat [s1, s2, s3] - fun sprintf4 s_pat s1 s2 s3 s4 = sprintf s_pat [s1, s2, s3, s4] - fun sprintf5 s_pat s1 s2 s3 s4 s5 = sprintf s_pat [s1, s2, s3, s4, s5] - end - end - - structure String = struct - val concat = String.concatWith - end - - structure Sys = struct - val isDirectory2 = SOME o File.is_dir o Path.explode handle ERROR _ => K NONE - end - - structure To = struct - fun nat f = Int.toString o f - end - - fun outFile1 f file = - let - val pfile = Path.explode file - val () = if File.exists pfile then error ("File exists \"" ^ file ^ "\"\n") else () - val oc = Unsynchronized.ref [] - val _ = f (fn a => fn b => SOME (oc := Printf.sprintf1 a b :: (Unsynchronized.! oc))) in - SOME (File.write_list pfile (rev (Unsynchronized.! oc))) handle _ => NONE - end - - fun outStand1 f = outFile1 f (Unsynchronized.! stdout_file) -end - -\<close> - -subsection\<open>Interface with Types\<close> - -datatype ml_int = ML_int -code_printing type_constructor ml_int \<rightharpoonup> (Haskell) "CodeType.MlInt" \<comment> \<open>syntax!\<close> - | type_constructor ml_int \<rightharpoonup> (OCaml) "CodeType.mlInt" - | type_constructor ml_int \<rightharpoonup> (Scala) "CodeType.mlInt" - | type_constructor ml_int \<rightharpoonup> (SML) "CodeType.mlInt" - -datatype 'a ml_monad = ML_monad 'a -code_printing type_constructor ml_monad \<rightharpoonup> (Haskell) "CodeType.MlMonad _" \<comment> \<open>syntax!\<close> - | type_constructor ml_monad \<rightharpoonup> (OCaml) "_ CodeType.mlMonad" - | type_constructor ml_monad \<rightharpoonup> (Scala) "CodeType.mlMonad [_]" - | type_constructor ml_monad \<rightharpoonup> (SML) "_ CodeType.mlMonad" - -(* *) - -type_synonym ml_string = String.literal - -subsection\<open>Interface with Constants\<close> - -text\<open>module CodeConst\<close> - -consts out_file1 :: "((ml_string \<Rightarrow> '\<alpha>1 \<Rightarrow> unit ml_monad) \<comment> \<open>fprintf\<close> \<Rightarrow> unit ml_monad) \<Rightarrow> ml_string \<Rightarrow> unit ml_monad" -code_printing constant out_file1 \<rightharpoonup> (Haskell) "CodeConst.outFile1" - | constant out_file1 \<rightharpoonup> (OCaml) "CodeConst.outFile1" - | constant out_file1 \<rightharpoonup> (Scala) "CodeConst.outFile1" - | constant out_file1 \<rightharpoonup> (SML) "CodeConst.outFile1" - -consts out_stand1 :: "((ml_string \<Rightarrow> '\<alpha>1 \<Rightarrow> unit ml_monad) \<comment> \<open>fprintf\<close> \<Rightarrow> unit ml_monad) \<Rightarrow> unit ml_monad" -code_printing constant out_stand1 \<rightharpoonup> (Haskell) "CodeConst.outStand1" - | constant out_stand1 \<rightharpoonup> (OCaml) "CodeConst.outStand1" - | constant out_stand1 \<rightharpoonup> (Scala) "CodeConst.outStand1" - | constant out_stand1 \<rightharpoonup> (SML) "CodeConst.outStand1" - -text\<open>module Monad\<close> - -consts bind :: "'a ml_monad \<Rightarrow> ('a \<Rightarrow> 'b ml_monad) \<Rightarrow> 'b ml_monad" -code_printing constant bind \<rightharpoonup> (Haskell) "CodeConst.Monad.bind" - | constant bind \<rightharpoonup> (OCaml) "CodeConst.Monad.bind" - | constant bind \<rightharpoonup> (Scala) "CodeConst.Monad.bind" - | constant bind \<rightharpoonup> (SML) "CodeConst.Monad.bind" - -consts return :: "'a \<Rightarrow> 'a ml_monad" -code_printing constant return \<rightharpoonup> (Haskell) "CodeConst.Monad.return" - | constant return \<rightharpoonup> (OCaml) "CodeConst.Monad.return" - | constant return \<rightharpoonup> (Scala) "CodeConst.Monad.Return" \<comment> \<open>syntax!\<close> - | constant return \<rightharpoonup> (SML) "CodeConst.Monad.return" - -text\<open>module Printf\<close> - -consts sprintf0 :: "ml_string \<Rightarrow> ml_string" -code_printing constant sprintf0 \<rightharpoonup> (Haskell) "CodeConst.Printf.sprintf0" - | constant sprintf0 \<rightharpoonup> (OCaml) "CodeConst.Printf.sprintf0" - | constant sprintf0 \<rightharpoonup> (Scala) "CodeConst.Printf.sprintf0" - | constant sprintf0 \<rightharpoonup> (SML) "CodeConst.Printf.sprintf0" - -consts sprintf1 :: "ml_string \<Rightarrow> '\<alpha>1 \<Rightarrow> ml_string" -code_printing constant sprintf1 \<rightharpoonup> (Haskell) "CodeConst.Printf.sprintf1" - | constant sprintf1 \<rightharpoonup> (OCaml) "CodeConst.Printf.sprintf1" - | constant sprintf1 \<rightharpoonup> (Scala) "CodeConst.Printf.sprintf1" - | constant sprintf1 \<rightharpoonup> (SML) "CodeConst.Printf.sprintf1" - -consts sprintf2 :: "ml_string \<Rightarrow> '\<alpha>1 \<Rightarrow> '\<alpha>2 \<Rightarrow> ml_string" -code_printing constant sprintf2 \<rightharpoonup> (Haskell) "CodeConst.Printf.sprintf2" - | constant sprintf2 \<rightharpoonup> (OCaml) "CodeConst.Printf.sprintf2" - | constant sprintf2 \<rightharpoonup> (Scala) "CodeConst.Printf.sprintf2" - | constant sprintf2 \<rightharpoonup> (SML) "CodeConst.Printf.sprintf2" - -consts sprintf3 :: "ml_string \<Rightarrow> '\<alpha>1 \<Rightarrow> '\<alpha>2 \<Rightarrow> '\<alpha>3 \<Rightarrow> ml_string" -code_printing constant sprintf3 \<rightharpoonup> (Haskell) "CodeConst.Printf.sprintf3" - | constant sprintf3 \<rightharpoonup> (OCaml) "CodeConst.Printf.sprintf3" - | constant sprintf3 \<rightharpoonup> (Scala) "CodeConst.Printf.sprintf3" - | constant sprintf3 \<rightharpoonup> (SML) "CodeConst.Printf.sprintf3" - -consts sprintf4 :: "ml_string \<Rightarrow> '\<alpha>1 \<Rightarrow> '\<alpha>2 \<Rightarrow> '\<alpha>3 \<Rightarrow> '\<alpha>4 \<Rightarrow> ml_string" -code_printing constant sprintf4 \<rightharpoonup> (Haskell) "CodeConst.Printf.sprintf4" - | constant sprintf4 \<rightharpoonup> (OCaml) "CodeConst.Printf.sprintf4" - | constant sprintf4 \<rightharpoonup> (Scala) "CodeConst.Printf.sprintf4" - | constant sprintf4 \<rightharpoonup> (SML) "CodeConst.Printf.sprintf4" - -consts sprintf5 :: "ml_string \<Rightarrow> '\<alpha>1 \<Rightarrow> '\<alpha>2 \<Rightarrow> '\<alpha>3 \<Rightarrow> '\<alpha>4 \<Rightarrow> '\<alpha>5 \<Rightarrow> ml_string" -code_printing constant sprintf5 \<rightharpoonup> (Haskell) "CodeConst.Printf.sprintf5" - | constant sprintf5 \<rightharpoonup> (OCaml) "CodeConst.Printf.sprintf5" - | constant sprintf5 \<rightharpoonup> (Scala) "CodeConst.Printf.sprintf5" - | constant sprintf5 \<rightharpoonup> (SML) "CodeConst.Printf.sprintf5" - -text\<open>module String\<close> - -consts String_concat :: "ml_string \<Rightarrow> ml_string list \<Rightarrow> ml_string" -code_printing constant String_concat \<rightharpoonup> (Haskell) "CodeConst.String.concat" - | constant String_concat \<rightharpoonup> (OCaml) "CodeConst.String.concat" - | constant String_concat \<rightharpoonup> (Scala) "CodeConst.String.concat" - | constant String_concat \<rightharpoonup> (SML) "CodeConst.String.concat" - -text\<open>module Sys\<close> - -consts Sys_is_directory2 :: "ml_string \<Rightarrow> bool ml_monad" -code_printing constant Sys_is_directory2 \<rightharpoonup> (Haskell) "CodeConst.Sys.isDirectory2" - | constant Sys_is_directory2 \<rightharpoonup> (OCaml) "CodeConst.Sys.isDirectory2" - | constant Sys_is_directory2 \<rightharpoonup> (Scala) "CodeConst.Sys.isDirectory2" - | constant Sys_is_directory2 \<rightharpoonup> (SML) "CodeConst.Sys.isDirectory2" - -text\<open>module To\<close> - -consts ToNat :: "(nat \<Rightarrow> integer) \<Rightarrow> nat \<Rightarrow> ml_int" -code_printing constant ToNat \<rightharpoonup> (Haskell) "CodeConst.To.nat" - | constant ToNat \<rightharpoonup> (OCaml) "CodeConst.To.nat" - | constant ToNat \<rightharpoonup> (Scala) "CodeConst.To.nat" - | constant ToNat \<rightharpoonup> (SML) "CodeConst.To.nat" - -subsection\<open>Some Notations (I): Raw Translations\<close> - -syntax "_sprint0" :: "_ \<Rightarrow> ml_string" ("sprint0 (_)\<acute>") -translations "sprint0 x\<acute>" \<rightleftharpoons> "CONST sprintf0 x" - -syntax "_sprint1" :: "_ \<Rightarrow> _ \<Rightarrow> ml_string" ("sprint1 (_)\<acute>") -translations "sprint1 x\<acute>" \<rightleftharpoons> "CONST sprintf1 x" - -syntax "_sprint2" :: "_ \<Rightarrow> _ \<Rightarrow> ml_string" ("sprint2 (_)\<acute>") -translations "sprint2 x\<acute>" \<rightleftharpoons> "CONST sprintf2 x" - -syntax "_sprint3" :: "_ \<Rightarrow> _ \<Rightarrow> ml_string" ("sprint3 (_)\<acute>") -translations "sprint3 x\<acute>" \<rightleftharpoons> "CONST sprintf3 x" - -syntax "_sprint4" :: "_ \<Rightarrow> _ \<Rightarrow> ml_string" ("sprint4 (_)\<acute>") -translations "sprint4 x\<acute>" \<rightleftharpoons> "CONST sprintf4 x" - -syntax "_sprint5" :: "_ \<Rightarrow> _ \<Rightarrow> ml_string" ("sprint5 (_)\<acute>") -translations "sprint5 x\<acute>" \<rightleftharpoons> "CONST sprintf5 x" - -subsection\<open>Some Notations (II): Polymorphic Cartouches\<close> - -syntax "_cartouche_string'" :: String.literal -translations "_cartouche_string" \<rightleftharpoons> "_cartouche_string'" - -parse_translation \<open> - [( @{syntax_const "_cartouche_string'"} - , parse_translation_cartouche - @{binding cartouche_type'} - (( "fun\<^sub>p\<^sub>r\<^sub>i\<^sub>n\<^sub>t\<^sub>f" - , ( Cartouche_Grammar.nil1 - , Cartouche_Grammar.cons1 - , let fun f c x = Syntax.const c $ x in - fn (0, x) => x - | (1, x) => f @{const_syntax sprintf1} x - | (2, x) => f @{const_syntax sprintf2} x - | (3, x) => f @{const_syntax sprintf3} x - | (4, x) => f @{const_syntax sprintf4} x - | (5, x) => f @{const_syntax sprintf5} x - end)) - :: Cartouche_Grammar.default) - (fn 37 \<comment> \<open>\<^verbatim>\<open>#"%"\<close>\<close> => (fn x => x + 1) - | _ => I) - 0)] -\<close> - -subsection\<open>Generic Locale for Printing\<close> - -locale Print = - fixes To_string :: "string \<Rightarrow> ml_string" - fixes To_nat :: "nat \<Rightarrow> ml_int" -begin - declare[[cartouche_type' = "fun\<^sub>p\<^sub>r\<^sub>i\<^sub>n\<^sub>t\<^sub>f"]] -end - -text\<open>As remark, printing functions (like @{term sprintf5}...) are currently -weakly typed in Isabelle, we will continue the typing using the type system of target languages.\<close> - -end diff --git a/Citadelle/src/compiler_generic/toy_example/Toy_Library.thy b/Citadelle/src/compiler_generic/toy_example/Toy_Library.thy deleted file mode 100644 index 8816e310e3f1d5b8b1f5a5c9dd73166e70b22496..0000000000000000000000000000000000000000 --- a/Citadelle/src/compiler_generic/toy_example/Toy_Library.thy +++ /dev/null @@ -1,64 +0,0 @@ -(****************************************************************************** - * HOL-TOY - * - * 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. - ******************************************************************************) - -section\<open>A Toy Library for Objects in a State\<close> - -theory Toy_Library -imports Main -begin - -type_notation option ("\<langle>_\<rangle>\<^sub>\<bottom>") (* NOTE: "_\<^sub>\<bottom>" also works *) -notation Some ("\<lfloor>(_)\<rfloor>") -notation the ("\<lceil>(_)\<rceil>") - - -type_synonym oid = nat - -type_synonym '\<alpha> val' = "unit \<Rightarrow> '\<alpha>" -type_notation val' ("\<cdot>(_)") - -record ('\<AA>)state = - heap :: "oid \<rightharpoonup> '\<AA> " - assocs :: "oid \<rightharpoonup> ((oid list) list) list" - -lemmas [simp,code_unfold] = state.defs - -end diff --git a/Citadelle/src/compiler_generic/toy_example/Toy_Library_Static.thy b/Citadelle/src/compiler_generic/toy_example/Toy_Library_Static.thy deleted file mode 100644 index d0e662a3ef23affae6c64b343d9e83dda083e18d..0000000000000000000000000000000000000000 --- a/Citadelle/src/compiler_generic/toy_example/Toy_Library_Static.thy +++ /dev/null @@ -1,62 +0,0 @@ -(****************************************************************************** - * Citadelle - * - * 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\<open>Toy Libraries Static\<close> -section\<open>Main Common Static Libraries\<close> - -theory Toy_Library_Static -imports Main -begin - -text\<open>In case there are functions planned to be at the same time used by the compiler -(by the translating step) and -also used by generated files, then these functions can be defined in this file.\<close> - -definition "map_of_list = (foldl ((\<lambda>map. (\<lambda>(x , l1). (case (map (x)) of None \<Rightarrow> (map (x \<mapsto> l1)) - | Some l0 \<Rightarrow> (map (x \<mapsto> (concat ([l0 , l1])))))))) (Map.empty))" - -definition "choose_0 = fst" -definition "choose_1 = snd" - -definition "deref_assocs_list to_from oid S = - concat (map (choose_1 o to_from) (filter (\<lambda>p. List.member (choose_0 (to_from p)) oid) S))" - -end diff --git a/Citadelle/src/compiler_generic/toy_example/document_generated/Design_generated.thy b/Citadelle/src/compiler_generic/toy_example/document_generated/Design_generated.thy deleted file mode 100644 index 786e1edf4fb8178e31ebe557d90493a1ba6f45be..0000000000000000000000000000000000000000 --- a/Citadelle/src/compiler_generic/toy_example/document_generated/Design_generated.thy +++ /dev/null @@ -1,142 +0,0 @@ -theory Design_generated imports "../Toy_Library" "../Toy_Library_Static" "../embedding/Generator_dynamic_sequential" begin - -(* 1 ************************************ 0 + 1 *) -section \<open>Class Model: Introduction\<close> - -(* 2 ************************************ 1 + 1 *) -text \<open> - For certain concepts like classes and class-types, only a generic - definition for its resulting semantics can be given. Generic means, - there is a function outside HOL that ``compiles'' a concrete, - closed-world class diagram into a ``theory'' of this data model, - consisting of a bunch of definitions for classes, accessors, method, - casts, and tests for actual types, as well as proofs for the - fundamental properties of these operations in this concrete data - model. \<close> - -(* 3 ************************************ 2 + 1 *) -section \<open>Class Model: The Construction of the Object Universe\<close> - -(* 4 ************************************ 3 + 1 *) -text \<open> - Our data universe consists in the concrete class diagram just of node's, -and implicitly of the class object. Each class implies the existence of a class -type defined for the corresponding object representations as follows: \<close> - -(* 5 ************************************ 4 + 10 *) -datatype ty\<E>\<X>\<T>\<^sub>A\<^sub>t\<^sub>o\<^sub>m = mk\<E>\<X>\<T>\<^sub>A\<^sub>t\<^sub>o\<^sub>m "oid" "oid list option" "int option" "bool option" "nat option" "unit option" -datatype ty\<^sub>A\<^sub>t\<^sub>o\<^sub>m = mk\<^sub>A\<^sub>t\<^sub>o\<^sub>m "ty\<E>\<X>\<T>\<^sub>A\<^sub>t\<^sub>o\<^sub>m" "int option" -datatype ty\<E>\<X>\<T>\<^sub>M\<^sub>o\<^sub>l\<^sub>e\<^sub>c\<^sub>u\<^sub>l\<^sub>e = mk\<E>\<X>\<T>\<^sub>M\<^sub>o\<^sub>l\<^sub>e\<^sub>c\<^sub>u\<^sub>l\<^sub>e_\<^sub>A\<^sub>t\<^sub>o\<^sub>m "ty\<^sub>A\<^sub>t\<^sub>o\<^sub>m" - | mk\<E>\<X>\<T>\<^sub>M\<^sub>o\<^sub>l\<^sub>e\<^sub>c\<^sub>u\<^sub>l\<^sub>e "oid" "oid list option" "int option" "bool option" "nat option" "unit option" -datatype ty\<^sub>M\<^sub>o\<^sub>l\<^sub>e\<^sub>c\<^sub>u\<^sub>l\<^sub>e = mk\<^sub>M\<^sub>o\<^sub>l\<^sub>e\<^sub>c\<^sub>u\<^sub>l\<^sub>e "ty\<E>\<X>\<T>\<^sub>M\<^sub>o\<^sub>l\<^sub>e\<^sub>c\<^sub>u\<^sub>l\<^sub>e" -datatype ty\<E>\<X>\<T>\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n = mk\<E>\<X>\<T>\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_\<^sub>M\<^sub>o\<^sub>l\<^sub>e\<^sub>c\<^sub>u\<^sub>l\<^sub>e "ty\<^sub>M\<^sub>o\<^sub>l\<^sub>e\<^sub>c\<^sub>u\<^sub>l\<^sub>e" - | mk\<E>\<X>\<T>\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_\<^sub>A\<^sub>t\<^sub>o\<^sub>m "ty\<^sub>A\<^sub>t\<^sub>o\<^sub>m" - | mk\<E>\<X>\<T>\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n "oid" "nat option" "unit option" -datatype ty\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n = mk\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n "ty\<E>\<X>\<T>\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n" "oid list option" "int option" "bool option" -datatype ty\<E>\<X>\<T>\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y = mk\<E>\<X>\<T>\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n "ty\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n" - | mk\<E>\<X>\<T>\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_\<^sub>M\<^sub>o\<^sub>l\<^sub>e\<^sub>c\<^sub>u\<^sub>l\<^sub>e "ty\<^sub>M\<^sub>o\<^sub>l\<^sub>e\<^sub>c\<^sub>u\<^sub>l\<^sub>e" - | mk\<E>\<X>\<T>\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_\<^sub>A\<^sub>t\<^sub>o\<^sub>m "ty\<^sub>A\<^sub>t\<^sub>o\<^sub>m" - | mk\<E>\<X>\<T>\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y "oid" -datatype ty\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y = mk\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y "ty\<E>\<X>\<T>\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y" "nat option" "unit option" -datatype ty\<E>\<X>\<T>\<^sub>T\<^sub>o\<^sub>y\<^sub>A\<^sub>n\<^sub>y = mk\<E>\<X>\<T>\<^sub>T\<^sub>o\<^sub>y\<^sub>A\<^sub>n\<^sub>y_\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y "ty\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y" - | mk\<E>\<X>\<T>\<^sub>T\<^sub>o\<^sub>y\<^sub>A\<^sub>n\<^sub>y_\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n "ty\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n" - | mk\<E>\<X>\<T>\<^sub>T\<^sub>o\<^sub>y\<^sub>A\<^sub>n\<^sub>y_\<^sub>M\<^sub>o\<^sub>l\<^sub>e\<^sub>c\<^sub>u\<^sub>l\<^sub>e "ty\<^sub>M\<^sub>o\<^sub>l\<^sub>e\<^sub>c\<^sub>u\<^sub>l\<^sub>e" - | mk\<E>\<X>\<T>\<^sub>T\<^sub>o\<^sub>y\<^sub>A\<^sub>n\<^sub>y_\<^sub>A\<^sub>t\<^sub>o\<^sub>m "ty\<^sub>A\<^sub>t\<^sub>o\<^sub>m" - | mk\<E>\<X>\<T>\<^sub>T\<^sub>o\<^sub>y\<^sub>A\<^sub>n\<^sub>y "oid" -datatype ty\<^sub>T\<^sub>o\<^sub>y\<^sub>A\<^sub>n\<^sub>y = mk\<^sub>T\<^sub>o\<^sub>y\<^sub>A\<^sub>n\<^sub>y "ty\<E>\<X>\<T>\<^sub>T\<^sub>o\<^sub>y\<^sub>A\<^sub>n\<^sub>y" - -(* 6 ************************************ 14 + 1 *) -text \<open> - Now, we construct a concrete ``universe of ToyAny types'' by injection into a -sum type containing the class types. This type of ToyAny will be used as instance -for all respective type-variables. \<close> - -(* 7 ************************************ 15 + 1 *) -datatype \<AA> = in\<^sub>A\<^sub>t\<^sub>o\<^sub>m "ty\<^sub>A\<^sub>t\<^sub>o\<^sub>m" - | in\<^sub>M\<^sub>o\<^sub>l\<^sub>e\<^sub>c\<^sub>u\<^sub>l\<^sub>e "ty\<^sub>M\<^sub>o\<^sub>l\<^sub>e\<^sub>c\<^sub>u\<^sub>l\<^sub>e" - | in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n "ty\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n" - | in\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y "ty\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y" - | in\<^sub>T\<^sub>o\<^sub>y\<^sub>A\<^sub>n\<^sub>y "ty\<^sub>T\<^sub>o\<^sub>y\<^sub>A\<^sub>n\<^sub>y" - -(* 8 ************************************ 16 + 1 *) -text \<open> - Having fixed the object universe, we can introduce type synonyms that exactly correspond -to Toy types. Again, we exploit that our representation of Toy is a ``shallow embedding'' with a -one-to-one correspondance of Toy-types to types of the meta-language HOL. \<close> - -(* 9 ************************************ 17 + 5 *) -type_synonym Atom = "\<langle>\<langle>ty\<^sub>A\<^sub>t\<^sub>o\<^sub>m\<rangle>\<^sub>\<bottom>\<rangle>\<^sub>\<bottom>" -type_synonym Molecule = "\<langle>\<langle>ty\<^sub>M\<^sub>o\<^sub>l\<^sub>e\<^sub>c\<^sub>u\<^sub>l\<^sub>e\<rangle>\<^sub>\<bottom>\<rangle>\<^sub>\<bottom>" -type_synonym Person = "\<langle>\<langle>ty\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rangle>\<^sub>\<bottom>\<rangle>\<^sub>\<bottom>" -type_synonym Galaxy = "\<langle>\<langle>ty\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y\<rangle>\<^sub>\<bottom>\<rangle>\<^sub>\<bottom>" -type_synonym ToyAny = "\<langle>\<langle>ty\<^sub>T\<^sub>o\<^sub>y\<^sub>A\<^sub>n\<^sub>y\<rangle>\<^sub>\<bottom>\<rangle>\<^sub>\<bottom>" - -(* 10 ************************************ 22 + 1 *) -section \<open>Class Model: The Accessors\<close> - -(* 11 ************************************ 23 + 3 *) -definition "oid\<^sub>A\<^sub>t\<^sub>o\<^sub>m_0___boss = 0" -definition "oid\<^sub>M\<^sub>o\<^sub>l\<^sub>e\<^sub>c\<^sub>u\<^sub>l\<^sub>e_0___boss = 0" -definition "oid\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_0___boss = 0" - -(* 12 ************************************ 26 + 2 *) -definition "switch\<^sub>2_01 = (\<lambda> [x0 , x1] \<Rightarrow> (x0 , x1))" -definition "switch\<^sub>2_10 = (\<lambda> [x0 , x1] \<Rightarrow> (x1 , x0))" - -(* 13 ************************************ 28 + 1 *) -section \<open>Instance\<close> - -(* 14 ************************************ 29 + 3 *) -definition "oid1 = 1" -definition "oid2 = 2" -definition "inst_assoc1 = (\<lambda>oid_class to_from oid. ((case (deref_assocs_list ((to_from::oid list list \<Rightarrow> oid list \<times> oid list)) ((oid::oid)) ((the ((((map_of_list ([(oid\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_0___boss , (List.map ((\<lambda>(x , y). [x , y]) o switch\<^sub>2_01) ([[[oid1] , [oid2]]])))]))) ((oid_class::oid))))))) of Nil \<Rightarrow> None - | l \<Rightarrow> (Some (l)))::oid list option))" - -(* 15 ************************************ 32 + 0 *) - -(* 16 ************************************ 32 + 1 *) -section \<open>Instance\<close> - -(* 17 ************************************ 33 + 2 *) -definition "oid3 = 3" -definition "inst_assoc3 = (\<lambda>oid_class to_from oid. ((case (deref_assocs_list ((to_from::oid list list \<Rightarrow> oid list \<times> oid list)) ((oid::oid)) ((the ((((map_of_list ([]))) ((oid_class::oid))))))) of Nil \<Rightarrow> None - | l \<Rightarrow> (Some (l)))::oid list option))" - -(* 18 ************************************ 35 + 0 *) - -(* 19 ************************************ 35 + 1 *) -section \<open>State (Floor 1)\<close> - -(* 20 ************************************ 36 + 4 *) -generation_syntax [ shallow (generation_semantics [ design ]) ] -setup \<open>(Generation_mode.update_compiler_config ((K (let open META in Compiler_env_config_ext (true, NONE, Oids ((Code_Numeral.natural_of_integer 0), (Code_Numeral.natural_of_integer 1), (Code_Numeral.natural_of_integer 4)), I ((Code_Numeral.natural_of_integer 0), (Code_Numeral.natural_of_integer 0)), Gen_only_design, SOME (ToyClass ((META.SS_base (META.ST "ToyAny")), nil, uncurry cons (ToyClass ((META.SS_base (META.ST "Galaxy")), uncurry cons (I ((META.SS_base (META.ST "wormhole")), ToyTy_base_unlimitednatural), uncurry cons (I ((META.SS_base (META.ST "is_sound")), ToyTy_base_void), nil)), uncurry cons (ToyClass ((META.SS_base (META.ST "Person")), uncurry cons (I ((META.SS_base (META.ST "boss")), ToyTy_object (ToyTyObj (ToyTyCore (Toy_ty_class_ext ((META.SS_base (META.ST "oid")), (Code_Numeral.natural_of_integer 0), (Code_Numeral.natural_of_integer 2), Toy_ty_class_node_ext ((Code_Numeral.natural_of_integer 0), Toy_multiplicity_ext (uncurry cons (I (Mult_star, NONE), nil), NONE, uncurry cons (Set, nil), ()), (META.SS_base (META.ST "Person")), ()), Toy_ty_class_node_ext ((Code_Numeral.natural_of_integer 1), Toy_multiplicity_ext (uncurry cons (I (Mult_nat ((Code_Numeral.natural_of_integer 0)), SOME (Mult_nat ((Code_Numeral.natural_of_integer 1)))), nil), SOME ((META.SS_base (META.ST "boss"))), uncurry cons (Set, nil), ()), (META.SS_base (META.ST "Person")), ()), ())), nil))), uncurry cons (I ((META.SS_base (META.ST "salary")), ToyTy_base_integer), uncurry cons (I ((META.SS_base (META.ST "is_meta_thinking")), ToyTy_base_boolean), nil))), uncurry cons (ToyClass ((META.SS_base (META.ST "Molecule")), nil, uncurry cons (ToyClass ((META.SS_base (META.ST "Atom")), uncurry cons (I ((META.SS_base (META.ST "size")), ToyTy_base_integer), nil), nil), nil)), nil)), nil)), nil))), uncurry cons (META_instance (ToyInstance (uncurry cons (Toy_instance_single_ext (SOME ((META.SS_base (META.ST "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3"))), SOME ((META.SS_base (META.ST "Person"))), NONE, ToyAttrNoCast (uncurry cons (I (NONE, I ((META.SS_base (META.ST "salary")), ShallB_term (ToyDefInteger ((META.SS_base (META.ST "1")))))), nil)), ()), nil))), uncurry cons (META_instance (ToyInstance (uncurry cons (Toy_instance_single_ext (SOME ((META.SS_base (META.ST "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1"))), SOME ((META.SS_base (META.ST "Person"))), NONE, ToyAttrNoCast (uncurry cons (I (NONE, I ((META.SS_base (META.ST "salary")), ShallB_term (ToyDefInteger ((META.SS_base (META.ST "1300")))))), uncurry cons (I (NONE, I ((META.SS_base (META.ST "boss")), ShallB_str ((META.SS_base (META.ST "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2"))))), nil))), ()), uncurry cons (Toy_instance_single_ext (SOME ((META.SS_base (META.ST "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2"))), SOME ((META.SS_base (META.ST "Person"))), NONE, ToyAttrNoCast (uncurry cons (I (NONE, I ((META.SS_base (META.ST "salary")), ShallB_term (ToyDefInteger ((META.SS_base (META.ST "1800")))))), nil)), ()), nil)))), uncurry cons (META_class_raw (Floor1, Toy_class_raw_ext (ToyTyObj (ToyTyCore_pre ((META.SS_base (META.ST "Person"))), uncurry cons (uncurry cons (ToyTyCore_pre ((META.SS_base (META.ST "Galaxy"))), nil), nil)), uncurry cons (I ((META.SS_base (META.ST "salary")), ToyTy_base_integer), uncurry cons (I ((META.SS_base (META.ST "boss")), ToyTy_object (ToyTyObj (ToyTyCore_pre ((META.SS_base (META.ST "Person"))), nil))), uncurry cons (I ((META.SS_base (META.ST "is_meta_thinking")), ToyTy_base_boolean), nil))), nil, false, ())), uncurry cons (META_class_raw (Floor1, Toy_class_raw_ext (ToyTyObj (ToyTyCore_pre ((META.SS_base (META.ST "Galaxy"))), nil), uncurry cons (I ((META.SS_base (META.ST "wormhole")), ToyTy_base_unlimitednatural), uncurry cons (I ((META.SS_base (META.ST "is_sound")), ToyTy_base_void), nil)), nil, false, ())), uncurry cons (META_class_raw (Floor1, Toy_class_raw_ext (ToyTyObj (ToyTyCore_pre ((META.SS_base (META.ST "Molecule"))), uncurry cons (uncurry cons (ToyTyCore_pre ((META.SS_base (META.ST "Person"))), nil), nil)), nil, nil, false, ())), uncurry cons (META_class_raw (Floor1, Toy_class_raw_ext (ToyTyObj (ToyTyCore_pre ((META.SS_base (META.ST "Atom"))), uncurry cons (uncurry cons (ToyTyCore_pre ((META.SS_base (META.ST "Molecule"))), nil), nil)), uncurry cons (I ((META.SS_base (META.ST "size")), ToyTy_base_integer), nil), nil, false, ())), nil)))))), uncurry cons (I ((META.ST "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3"), I (Toy_instance_single_ext (SOME ((META.SS_base (META.ST "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3"))), SOME ((META.SS_base (META.ST "Person"))), NONE, ToyAttrNoCast (uncurry cons (I (NONE, I ((META.SS_base (META.ST "salary")), ShallB_term (ToyDefInteger ((META.SS_base (META.ST "1")))))), nil)), ()), Oids ((Code_Numeral.natural_of_integer 0), (Code_Numeral.natural_of_integer 1), (Code_Numeral.natural_of_integer 3)))), uncurry cons (I ((META.ST "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2"), I (Toy_instance_single_ext (SOME ((META.SS_base (META.ST "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2"))), SOME ((META.SS_base (META.ST "Person"))), NONE, ToyAttrNoCast (uncurry cons (I (NONE, I ((META.SS_base (META.ST "salary")), ShallB_term (ToyDefInteger ((META.SS_base (META.ST "1800")))))), nil)), ()), Oids ((Code_Numeral.natural_of_integer 0), (Code_Numeral.natural_of_integer 1), (Code_Numeral.natural_of_integer 2)))), uncurry cons (I ((META.ST "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1"), I (Toy_instance_single_ext (SOME ((META.SS_base (META.ST "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1"))), SOME ((META.SS_base (META.ST "Person"))), NONE, ToyAttrNoCast (uncurry cons (I (NONE, I ((META.SS_base (META.ST "salary")), ShallB_term (ToyDefInteger ((META.SS_base (META.ST "1300")))))), uncurry cons (I (NONE, I ((META.SS_base (META.ST "boss")), ShallB_str ((META.SS_base (META.ST "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2"))))), nil))), ()), Oids ((Code_Numeral.natural_of_integer 0), (Code_Numeral.natural_of_integer 1), (Code_Numeral.natural_of_integer 1)))), nil))), nil, false, false, I (nil, nil), nil, I (NONE, false), ()) end))))\<close> -Instance \<sigma>\<^sub>1_object0 :: Person = [ "salary" = 1000, "boss" = self 1 ] - and \<sigma>\<^sub>1_object1 :: Person = [ "salary" = 1200 ] - and \<sigma>\<^sub>1_object2 :: Person = [ "salary" = 2600, "boss" = X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1 ] - and \<sigma>\<^sub>1_object4 :: Person = [ "salary" = 2300, "boss" = self 2 ] -State[shallow] \<sigma>\<^sub>1 = [ \<sigma>\<^sub>1_object0, \<sigma>\<^sub>1_object1, \<sigma>\<^sub>1_object2, X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1, \<sigma>\<^sub>1_object4, X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2 ] - -(* 21 ************************************ 40 + 1 *) -section \<open>Instance\<close> - -(* 22 ************************************ 41 + 2 *) -definition "oid8 = 8" -definition "inst_assoc8 = (\<lambda>oid_class to_from oid. ((case (deref_assocs_list ((to_from::oid list list \<Rightarrow> oid list \<times> oid list)) ((oid::oid)) ((the ((((map_of_list ([]))) ((oid_class::oid))))))) of Nil \<Rightarrow> None - | l \<Rightarrow> (Some (l)))::oid list option))" - -(* 23 ************************************ 43 + 0 *) - -(* 24 ************************************ 43 + 1 *) -section \<open>State (Floor 1)\<close> - -(* 25 ************************************ 44 + 2 *) -setup \<open>(Generation_mode.update_compiler_config ((K (let open META in Compiler_env_config_ext (true, NONE, Oids ((Code_Numeral.natural_of_integer 0), (Code_Numeral.natural_of_integer 0), (Code_Numeral.natural_of_integer 0)), I ((Code_Numeral.natural_of_integer 0), (Code_Numeral.natural_of_integer 0)), Gen_only_design, NONE, uncurry cons (META_instance (ToyInstance (uncurry cons (Toy_instance_single_ext (SOME ((META.SS_base (META.ST "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4"))), SOME ((META.SS_base (META.ST "Person"))), NONE, ToyAttrNoCast (nil), ()), nil))), nil), nil, nil, false, false, I (nil, nil), nil, I (NONE, false), ()) end))))\<close> -State[shallow] \<sigma>\<^sub>1' = [ X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1, X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2, X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3, X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4 ] - -(* 26 ************************************ 46 + 1 *) -section \<open>Transition (Floor 1)\<close> - -(* 27 ************************************ 47 + 1 *) -Transition[shallow] \<sigma>\<^sub>1 \<sigma>\<^sub>1' - -end diff --git a/Citadelle/src/compiler_generic/toy_example/document_generated/Design_generated_generated.thy b/Citadelle/src/compiler_generic/toy_example/document_generated/Design_generated_generated.thy deleted file mode 100644 index 14032fd6c6c41ee0b7606f57f88e351925acc9bc..0000000000000000000000000000000000000000 --- a/Citadelle/src/compiler_generic/toy_example/document_generated/Design_generated_generated.thy +++ /dev/null @@ -1,269 +0,0 @@ -theory Design_generated_generated imports "../Toy_Library" "../Toy_Library_Static" begin - -(* 1 ************************************ 0 + 1 *) -section \<open>Class Model: Introduction\<close> - -(* 2 ************************************ 1 + 1 *) -text \<open> - For certain concepts like classes and class-types, only a generic - definition for its resulting semantics can be given. Generic means, - there is a function outside HOL that ``compiles'' a concrete, - closed-world class diagram into a ``theory'' of this data model, - consisting of a bunch of definitions for classes, accessors, method, - casts, and tests for actual types, as well as proofs for the - fundamental properties of these operations in this concrete data - model. \<close> - -(* 3 ************************************ 2 + 1 *) -section \<open>Class Model: The Construction of the Object Universe\<close> - -(* 4 ************************************ 3 + 1 *) -text \<open> - Our data universe consists in the concrete class diagram just of node's, -and implicitly of the class object. Each class implies the existence of a class -type defined for the corresponding object representations as follows: \<close> - -(* 5 ************************************ 4 + 10 *) -datatype ty\<E>\<X>\<T>\<^sub>A\<^sub>t\<^sub>o\<^sub>m = mk\<E>\<X>\<T>\<^sub>A\<^sub>t\<^sub>o\<^sub>m "oid" "oid list option" "int option" "bool option" "nat option" "unit option" -datatype ty\<^sub>A\<^sub>t\<^sub>o\<^sub>m = mk\<^sub>A\<^sub>t\<^sub>o\<^sub>m "ty\<E>\<X>\<T>\<^sub>A\<^sub>t\<^sub>o\<^sub>m" "int option" -datatype ty\<E>\<X>\<T>\<^sub>M\<^sub>o\<^sub>l\<^sub>e\<^sub>c\<^sub>u\<^sub>l\<^sub>e = mk\<E>\<X>\<T>\<^sub>M\<^sub>o\<^sub>l\<^sub>e\<^sub>c\<^sub>u\<^sub>l\<^sub>e_\<^sub>A\<^sub>t\<^sub>o\<^sub>m "ty\<^sub>A\<^sub>t\<^sub>o\<^sub>m" - | mk\<E>\<X>\<T>\<^sub>M\<^sub>o\<^sub>l\<^sub>e\<^sub>c\<^sub>u\<^sub>l\<^sub>e "oid" "oid list option" "int option" "bool option" "nat option" "unit option" -datatype ty\<^sub>M\<^sub>o\<^sub>l\<^sub>e\<^sub>c\<^sub>u\<^sub>l\<^sub>e = mk\<^sub>M\<^sub>o\<^sub>l\<^sub>e\<^sub>c\<^sub>u\<^sub>l\<^sub>e "ty\<E>\<X>\<T>\<^sub>M\<^sub>o\<^sub>l\<^sub>e\<^sub>c\<^sub>u\<^sub>l\<^sub>e" -datatype ty\<E>\<X>\<T>\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n = mk\<E>\<X>\<T>\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_\<^sub>M\<^sub>o\<^sub>l\<^sub>e\<^sub>c\<^sub>u\<^sub>l\<^sub>e "ty\<^sub>M\<^sub>o\<^sub>l\<^sub>e\<^sub>c\<^sub>u\<^sub>l\<^sub>e" - | mk\<E>\<X>\<T>\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_\<^sub>A\<^sub>t\<^sub>o\<^sub>m "ty\<^sub>A\<^sub>t\<^sub>o\<^sub>m" - | mk\<E>\<X>\<T>\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n "oid" "nat option" "unit option" -datatype ty\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n = mk\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n "ty\<E>\<X>\<T>\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n" "oid list option" "int option" "bool option" -datatype ty\<E>\<X>\<T>\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y = mk\<E>\<X>\<T>\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n "ty\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n" - | mk\<E>\<X>\<T>\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_\<^sub>M\<^sub>o\<^sub>l\<^sub>e\<^sub>c\<^sub>u\<^sub>l\<^sub>e "ty\<^sub>M\<^sub>o\<^sub>l\<^sub>e\<^sub>c\<^sub>u\<^sub>l\<^sub>e" - | mk\<E>\<X>\<T>\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_\<^sub>A\<^sub>t\<^sub>o\<^sub>m "ty\<^sub>A\<^sub>t\<^sub>o\<^sub>m" - | mk\<E>\<X>\<T>\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y "oid" -datatype ty\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y = mk\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y "ty\<E>\<X>\<T>\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y" "nat option" "unit option" -datatype ty\<E>\<X>\<T>\<^sub>T\<^sub>o\<^sub>y\<^sub>A\<^sub>n\<^sub>y = mk\<E>\<X>\<T>\<^sub>T\<^sub>o\<^sub>y\<^sub>A\<^sub>n\<^sub>y_\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y "ty\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y" - | mk\<E>\<X>\<T>\<^sub>T\<^sub>o\<^sub>y\<^sub>A\<^sub>n\<^sub>y_\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n "ty\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n" - | mk\<E>\<X>\<T>\<^sub>T\<^sub>o\<^sub>y\<^sub>A\<^sub>n\<^sub>y_\<^sub>M\<^sub>o\<^sub>l\<^sub>e\<^sub>c\<^sub>u\<^sub>l\<^sub>e "ty\<^sub>M\<^sub>o\<^sub>l\<^sub>e\<^sub>c\<^sub>u\<^sub>l\<^sub>e" - | mk\<E>\<X>\<T>\<^sub>T\<^sub>o\<^sub>y\<^sub>A\<^sub>n\<^sub>y_\<^sub>A\<^sub>t\<^sub>o\<^sub>m "ty\<^sub>A\<^sub>t\<^sub>o\<^sub>m" - | mk\<E>\<X>\<T>\<^sub>T\<^sub>o\<^sub>y\<^sub>A\<^sub>n\<^sub>y "oid" -datatype ty\<^sub>T\<^sub>o\<^sub>y\<^sub>A\<^sub>n\<^sub>y = mk\<^sub>T\<^sub>o\<^sub>y\<^sub>A\<^sub>n\<^sub>y "ty\<E>\<X>\<T>\<^sub>T\<^sub>o\<^sub>y\<^sub>A\<^sub>n\<^sub>y" - -(* 6 ************************************ 14 + 1 *) -text \<open> - Now, we construct a concrete ``universe of ToyAny types'' by injection into a -sum type containing the class types. This type of ToyAny will be used as instance -for all respective type-variables. \<close> - -(* 7 ************************************ 15 + 1 *) -datatype \<AA> = in\<^sub>A\<^sub>t\<^sub>o\<^sub>m "ty\<^sub>A\<^sub>t\<^sub>o\<^sub>m" - | in\<^sub>M\<^sub>o\<^sub>l\<^sub>e\<^sub>c\<^sub>u\<^sub>l\<^sub>e "ty\<^sub>M\<^sub>o\<^sub>l\<^sub>e\<^sub>c\<^sub>u\<^sub>l\<^sub>e" - | in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n "ty\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n" - | in\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y "ty\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y" - | in\<^sub>T\<^sub>o\<^sub>y\<^sub>A\<^sub>n\<^sub>y "ty\<^sub>T\<^sub>o\<^sub>y\<^sub>A\<^sub>n\<^sub>y" - -(* 8 ************************************ 16 + 1 *) -text \<open> - Having fixed the object universe, we can introduce type synonyms that exactly correspond -to Toy types. Again, we exploit that our representation of Toy is a ``shallow embedding'' with a -one-to-one correspondance of Toy-types to types of the meta-language HOL. \<close> - -(* 9 ************************************ 17 + 5 *) -type_synonym Atom = "\<langle>\<langle>ty\<^sub>A\<^sub>t\<^sub>o\<^sub>m\<rangle>\<^sub>\<bottom>\<rangle>\<^sub>\<bottom>" -type_synonym Molecule = "\<langle>\<langle>ty\<^sub>M\<^sub>o\<^sub>l\<^sub>e\<^sub>c\<^sub>u\<^sub>l\<^sub>e\<rangle>\<^sub>\<bottom>\<rangle>\<^sub>\<bottom>" -type_synonym Person = "\<langle>\<langle>ty\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rangle>\<^sub>\<bottom>\<rangle>\<^sub>\<bottom>" -type_synonym Galaxy = "\<langle>\<langle>ty\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y\<rangle>\<^sub>\<bottom>\<rangle>\<^sub>\<bottom>" -type_synonym ToyAny = "\<langle>\<langle>ty\<^sub>T\<^sub>o\<^sub>y\<^sub>A\<^sub>n\<^sub>y\<rangle>\<^sub>\<bottom>\<rangle>\<^sub>\<bottom>" - -(* 10 ************************************ 22 + 1 *) -section \<open>Class Model: The Accessors\<close> - -(* 11 ************************************ 23 + 3 *) -definition "oid\<^sub>A\<^sub>t\<^sub>o\<^sub>m_0___boss = 0" -definition "oid\<^sub>M\<^sub>o\<^sub>l\<^sub>e\<^sub>c\<^sub>u\<^sub>l\<^sub>e_0___boss = 0" -definition "oid\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_0___boss = 0" - -(* 12 ************************************ 26 + 2 *) -definition "switch\<^sub>2_01 = (\<lambda> [x0 , x1] \<Rightarrow> (x0 , x1))" -definition "switch\<^sub>2_10 = (\<lambda> [x0 , x1] \<Rightarrow> (x1 , x0))" - -(* 13 ************************************ 28 + 1 *) -section \<open>Instance\<close> - -(* 14 ************************************ 29 + 3 *) -definition "oid1 = 1" -definition "oid2 = 2" -definition "inst_assoc1 = (\<lambda>oid_class to_from oid. ((case (deref_assocs_list ((to_from::oid list list \<Rightarrow> oid list \<times> oid list)) ((oid::oid)) ((the ((((map_of_list ([(oid\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_0___boss , (List.map ((\<lambda>(x , y). [x , y]) o switch\<^sub>2_01) ([[[oid1] , [oid2]]])))]))) ((oid_class::oid))))))) of Nil \<Rightarrow> None - | l \<Rightarrow> (Some (l)))::oid list option))" - -(* 15 ************************************ 32 + 0 *) - -(* 16 ************************************ 32 + 1 *) -section \<open>Instance\<close> - -(* 17 ************************************ 33 + 2 *) -definition "oid3 = 3" -definition "inst_assoc3 = (\<lambda>oid_class to_from oid. ((case (deref_assocs_list ((to_from::oid list list \<Rightarrow> oid list \<times> oid list)) ((oid::oid)) ((the ((((map_of_list ([]))) ((oid_class::oid))))))) of Nil \<Rightarrow> None - | l \<Rightarrow> (Some (l)))::oid list option))" - -(* 18 ************************************ 35 + 0 *) - -(* 19 ************************************ 35 + 1 *) -section \<open>Instance\<close> - -(* 20 ************************************ 36 + 5 *) -definition "oid4 = 4" -definition "oid5 = 5" -definition "oid6 = 6" -definition "oid7 = 7" -definition "inst_assoc4 = (\<lambda>oid_class to_from oid. ((case (deref_assocs_list ((to_from::oid list list \<Rightarrow> oid list \<times> oid list)) ((oid::oid)) ((the ((((map_of_list ([(oid\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_0___boss , (List.map ((\<lambda>(x , y). [x , y]) o switch\<^sub>2_01) ([[[oid7] , [oid6]] , [[oid6] , [oid1]] , [[oid4] , [oid5]]])))]))) ((oid_class::oid))))))) of Nil \<Rightarrow> None - | l \<Rightarrow> (Some (l)))::oid list option))" - -(* 21 ************************************ 41 + 0 *) - -(* 22 ************************************ 41 + 1 *) -section \<open>State (Floor 2)\<close> - -(* 23 ************************************ 42 + 1 *) -locale state_\<sigma>\<^sub>1 = -fixes "oid1" :: "nat" -fixes "oid2" :: "nat" -fixes "oid4" :: "nat" -fixes "oid5" :: "nat" -fixes "oid6" :: "nat" -fixes "oid7" :: "nat" -assumes distinct_oid: "(distinct ([oid1 , oid2 , oid4 , oid5 , oid6 , oid7]))" -fixes "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n" :: "ty\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n" -fixes "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1" :: "\<cdot>Person" -assumes X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1_def: "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1 = (\<lambda>_. \<lfloor>\<lfloor>X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)" -fixes "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n" :: "ty\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n" -fixes "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2" :: "\<cdot>Person" -assumes X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2_def: "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2 = (\<lambda>_. \<lfloor>\<lfloor>X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)" -fixes "\<sigma>\<^sub>1_object0\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n" :: "ty\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n" -fixes "\<sigma>\<^sub>1_object0" :: "\<cdot>Person" -assumes \<sigma>\<^sub>1_object0_def: "\<sigma>\<^sub>1_object0 = (\<lambda>_. \<lfloor>\<lfloor>\<sigma>\<^sub>1_object0\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)" -fixes "\<sigma>\<^sub>1_object1\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n" :: "ty\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n" -fixes "\<sigma>\<^sub>1_object1" :: "\<cdot>Person" -assumes \<sigma>\<^sub>1_object1_def: "\<sigma>\<^sub>1_object1 = (\<lambda>_. \<lfloor>\<lfloor>\<sigma>\<^sub>1_object1\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)" -fixes "\<sigma>\<^sub>1_object2\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n" :: "ty\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n" -fixes "\<sigma>\<^sub>1_object2" :: "\<cdot>Person" -assumes \<sigma>\<^sub>1_object2_def: "\<sigma>\<^sub>1_object2 = (\<lambda>_. \<lfloor>\<lfloor>\<sigma>\<^sub>1_object2\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)" -fixes "\<sigma>\<^sub>1_object4\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n" :: "ty\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n" -fixes "\<sigma>\<^sub>1_object4" :: "\<cdot>Person" -assumes \<sigma>\<^sub>1_object4_def: "\<sigma>\<^sub>1_object4 = (\<lambda>_. \<lfloor>\<lfloor>\<sigma>\<^sub>1_object4\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)" -begin -definition "\<sigma>\<^sub>1 = (state.make ((Map.empty (oid4 \<mapsto> (in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (\<sigma>\<^sub>1_object0\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))) (oid5 \<mapsto> (in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (\<sigma>\<^sub>1_object1\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))) (oid6 \<mapsto> (in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (\<sigma>\<^sub>1_object2\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))) (oid1 \<mapsto> (in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))) (oid7 \<mapsto> (in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (\<sigma>\<^sub>1_object4\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))) (oid2 \<mapsto> (in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))))) ((map_of_list ([(oid\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_0___boss , (List.map ((\<lambda>(x , y). [x , y]) o switch\<^sub>2_01) ([[[oid4] , [oid5]] , [[oid6] , [oid1]] , [[oid1] , [oid2]] , [[oid7] , [oid6]]])))]))))" - -lemma perm_\<sigma>\<^sub>1 : "\<sigma>\<^sub>1 = (state.make ((Map.empty (oid2 \<mapsto> (in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))) (oid7 \<mapsto> (in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (\<sigma>\<^sub>1_object4\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))) (oid1 \<mapsto> (in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))) (oid6 \<mapsto> (in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (\<sigma>\<^sub>1_object2\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))) (oid5 \<mapsto> (in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (\<sigma>\<^sub>1_object1\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))) (oid4 \<mapsto> (in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (\<sigma>\<^sub>1_object0\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))))) ((assocs (\<sigma>\<^sub>1))))" - apply(simp add: \<sigma>\<^sub>1_def) - apply(subst (1) fun_upd_twist, metis distinct_oid distinct_length_2_or_more) - apply(subst (2) fun_upd_twist, metis distinct_oid distinct_length_2_or_more) - apply(subst (1) fun_upd_twist, metis distinct_oid distinct_length_2_or_more) - apply(subst (3) fun_upd_twist, metis distinct_oid distinct_length_2_or_more) - apply(subst (2) fun_upd_twist, metis distinct_oid distinct_length_2_or_more) - apply(subst (1) fun_upd_twist, metis distinct_oid distinct_length_2_or_more) - apply(subst (4) fun_upd_twist, metis distinct_oid distinct_length_2_or_more) - apply(subst (3) fun_upd_twist, metis distinct_oid distinct_length_2_or_more) - apply(subst (2) fun_upd_twist, metis distinct_oid distinct_length_2_or_more) - apply(subst (1) fun_upd_twist, metis distinct_oid distinct_length_2_or_more) - apply(subst (5) fun_upd_twist, metis distinct_oid distinct_length_2_or_more) - apply(subst (4) fun_upd_twist, metis distinct_oid distinct_length_2_or_more) - apply(subst (3) fun_upd_twist, metis distinct_oid distinct_length_2_or_more) - apply(subst (2) fun_upd_twist, metis distinct_oid distinct_length_2_or_more) - apply(subst (1) fun_upd_twist, metis distinct_oid distinct_length_2_or_more) -by(simp) -end - -(* 24 ************************************ 43 + 1 *) -section \<open>Instance\<close> - -(* 25 ************************************ 44 + 2 *) -definition "oid8 = 8" -definition "inst_assoc8 = (\<lambda>oid_class to_from oid. ((case (deref_assocs_list ((to_from::oid list list \<Rightarrow> oid list \<times> oid list)) ((oid::oid)) ((the ((((map_of_list ([]))) ((oid_class::oid))))))) of Nil \<Rightarrow> None - | l \<Rightarrow> (Some (l)))::oid list option))" - -(* 26 ************************************ 46 + 0 *) - -(* 27 ************************************ 46 + 1 *) -section \<open>State (Floor 2)\<close> - -(* 28 ************************************ 47 + 1 *) -locale state_\<sigma>\<^sub>1' = -fixes "oid1" :: "nat" -fixes "oid2" :: "nat" -fixes "oid3" :: "nat" -fixes "oid8" :: "nat" -assumes distinct_oid: "(distinct ([oid1 , oid2 , oid3 , oid8]))" -fixes "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n" :: "ty\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n" -fixes "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1" :: "\<cdot>Person" -assumes X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1_def: "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1 = (\<lambda>_. \<lfloor>\<lfloor>X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)" -fixes "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n" :: "ty\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n" -fixes "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2" :: "\<cdot>Person" -assumes X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2_def: "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2 = (\<lambda>_. \<lfloor>\<lfloor>X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)" -fixes "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n" :: "ty\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n" -fixes "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3" :: "\<cdot>Person" -assumes X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3_def: "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3 = (\<lambda>_. \<lfloor>\<lfloor>X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)" -fixes "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n" :: "ty\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n" -fixes "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4" :: "\<cdot>Person" -assumes X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4_def: "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4 = (\<lambda>_. \<lfloor>\<lfloor>X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)" -begin -definition "\<sigma>\<^sub>1' = (state.make ((Map.empty (oid1 \<mapsto> (in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))) (oid2 \<mapsto> (in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))) (oid3 \<mapsto> (in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))) (oid8 \<mapsto> (in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))))) ((map_of_list ([(oid\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_0___boss , (List.map ((\<lambda>(x , y). [x , y]) o switch\<^sub>2_01) ([[[oid1] , [oid2]]])))]))))" - -lemma perm_\<sigma>\<^sub>1' : "\<sigma>\<^sub>1' = (state.make ((Map.empty (oid8 \<mapsto> (in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))) (oid3 \<mapsto> (in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))) (oid2 \<mapsto> (in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))) (oid1 \<mapsto> (in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))))) ((assocs (\<sigma>\<^sub>1'))))" - apply(simp add: \<sigma>\<^sub>1'_def) - apply(subst (1) fun_upd_twist, metis distinct_oid distinct_length_2_or_more) - apply(subst (2) fun_upd_twist, metis distinct_oid distinct_length_2_or_more) - apply(subst (1) fun_upd_twist, metis distinct_oid distinct_length_2_or_more) - apply(subst (3) fun_upd_twist, metis distinct_oid distinct_length_2_or_more) - apply(subst (2) fun_upd_twist, metis distinct_oid distinct_length_2_or_more) - apply(subst (1) fun_upd_twist, metis distinct_oid distinct_length_2_or_more) -by(simp) -end - -(* 29 ************************************ 48 + 1 *) -section \<open>Transition (Floor 2)\<close> - -(* 30 ************************************ 49 + 1 *) -locale transition_\<sigma>\<^sub>1_\<sigma>\<^sub>1' = -fixes "oid1" :: "nat" -fixes "oid2" :: "nat" -fixes "oid3" :: "nat" -fixes "oid4" :: "nat" -fixes "oid5" :: "nat" -fixes "oid6" :: "nat" -fixes "oid7" :: "nat" -fixes "oid8" :: "nat" -assumes distinct_oid: "(distinct ([oid1 , oid2 , oid3 , oid4 , oid5 , oid6 , oid7 , oid8]))" -fixes "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n" :: "ty\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n" -fixes "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1" :: "\<cdot>Person" -assumes X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1_def: "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1 = (\<lambda>_. \<lfloor>\<lfloor>X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)" -fixes "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n" :: "ty\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n" -fixes "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2" :: "\<cdot>Person" -assumes X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2_def: "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2 = (\<lambda>_. \<lfloor>\<lfloor>X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)" -fixes "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n" :: "ty\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n" -fixes "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3" :: "\<cdot>Person" -assumes X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3_def: "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3 = (\<lambda>_. \<lfloor>\<lfloor>X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)" -fixes "\<sigma>\<^sub>1_object0\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n" :: "ty\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n" -fixes "\<sigma>\<^sub>1_object0" :: "\<cdot>Person" -assumes \<sigma>\<^sub>1_object0_def: "\<sigma>\<^sub>1_object0 = (\<lambda>_. \<lfloor>\<lfloor>\<sigma>\<^sub>1_object0\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)" -fixes "\<sigma>\<^sub>1_object1\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n" :: "ty\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n" -fixes "\<sigma>\<^sub>1_object1" :: "\<cdot>Person" -assumes \<sigma>\<^sub>1_object1_def: "\<sigma>\<^sub>1_object1 = (\<lambda>_. \<lfloor>\<lfloor>\<sigma>\<^sub>1_object1\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)" -fixes "\<sigma>\<^sub>1_object2\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n" :: "ty\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n" -fixes "\<sigma>\<^sub>1_object2" :: "\<cdot>Person" -assumes \<sigma>\<^sub>1_object2_def: "\<sigma>\<^sub>1_object2 = (\<lambda>_. \<lfloor>\<lfloor>\<sigma>\<^sub>1_object2\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)" -fixes "\<sigma>\<^sub>1_object4\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n" :: "ty\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n" -fixes "\<sigma>\<^sub>1_object4" :: "\<cdot>Person" -assumes \<sigma>\<^sub>1_object4_def: "\<sigma>\<^sub>1_object4 = (\<lambda>_. \<lfloor>\<lfloor>\<sigma>\<^sub>1_object4\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)" -fixes "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n" :: "ty\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n" -fixes "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4" :: "\<cdot>Person" -assumes X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4_def: "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4 = (\<lambda>_. \<lfloor>\<lfloor>X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)" - -assumes \<sigma>\<^sub>1: "(state_\<sigma>\<^sub>1 (oid1) (oid2) (oid4) (oid5) (oid6) (oid7) (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n) (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1) (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n) (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2) (\<sigma>\<^sub>1_object0\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n) (\<sigma>\<^sub>1_object0) (\<sigma>\<^sub>1_object1\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n) (\<sigma>\<^sub>1_object1) (\<sigma>\<^sub>1_object2\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n) (\<sigma>\<^sub>1_object2) (\<sigma>\<^sub>1_object4\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n) (\<sigma>\<^sub>1_object4))" - -assumes \<sigma>\<^sub>1': "(state_\<sigma>\<^sub>1' (oid1) (oid2) (oid3) (oid8) (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n) (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1) (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n) (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2) (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n) (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3) (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n) (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4))" -begin -interpretation state_\<sigma>\<^sub>1: state_\<sigma>\<^sub>1 "oid1" "oid2" "oid4" "oid5" "oid6" "oid7" "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n" "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1" "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n" "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2" "\<sigma>\<^sub>1_object0\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n" "\<sigma>\<^sub>1_object0" "\<sigma>\<^sub>1_object1\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n" "\<sigma>\<^sub>1_object1" "\<sigma>\<^sub>1_object2\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n" "\<sigma>\<^sub>1_object2" "\<sigma>\<^sub>1_object4\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n" "\<sigma>\<^sub>1_object4" -by(rule \<sigma>\<^sub>1) - -interpretation state_\<sigma>\<^sub>1': state_\<sigma>\<^sub>1' "oid1" "oid2" "oid3" "oid8" "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n" "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1" "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n" "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2" "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n" "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3" "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n" "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4" -by(rule \<sigma>\<^sub>1') -end - -end diff --git a/Citadelle/src/compiler_generic/toy_example/embedding/Core.thy b/Citadelle/src/compiler_generic/toy_example/embedding/Core.thy deleted file mode 100644 index 0739bd668bf3c16a46cf12c22589112b4a344b28..0000000000000000000000000000000000000000 --- a/Citadelle/src/compiler_generic/toy_example/embedding/Core.thy +++ /dev/null @@ -1,352 +0,0 @@ -(****************************************************************************** - * Citadelle - * - * 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. - ******************************************************************************) - -section\<open>General Environment for the Translation: Conclusion\<close> - -theory Core -imports "core/Floor1_infra" - "core/Floor1_access" - "core/Floor1_examp" - "core/Floor2_examp" - "core/Floor1_ctxt" -begin - -subsection\<open>Preliminaries\<close> - -datatype 'a embedding_fun = Embedding_fun_info string 'a - | Embedding_fun_simple 'a - -datatype ('a, 'b) embedding = Embed_theories "('a \<Rightarrow> 'b \<Rightarrow> all_meta list \<times> 'b) embedding_fun list" - | Embed_locale "('a \<Rightarrow> 'b \<Rightarrow> all_meta list \<times> 'b) embedding_fun list" - "'a \<Rightarrow> 'b \<Rightarrow> semi__locale \<times> 'b" - "('a \<Rightarrow> 'b \<Rightarrow> semi__theory list \<times> 'b) list" - -type_synonym 'a embedding' = "('a, compiler_env_config) embedding" \<comment> \<open>polymorphism weakening needed by \<^theory_text>\<open>code_reflect\<close>\<close> - -definition "L_fold f = - (\<lambda> Embed_theories l \<Rightarrow> List.fold f l - | Embed_locale l_th1 loc_data l \<Rightarrow> - f (Embedding_fun_simple (\<lambda>a b. - let (loc_data, b) = loc_data a b - ; (l, b) = List.fold (\<lambda>f0. \<lambda>(l, b) \<Rightarrow> let (x, b) = f0 a b in (x # l, b)) l ([], b) in - ([META_semi__theories (Theories_locale loc_data (rev l))], b))) o List.fold f l_th1)" - -subsection\<open>Preliminaries: Setting Up Aliases Names\<close> - -ML\<open> -local -fun definition s = (#2 oo Specification.definition_cmd NONE [] [] (Binding.empty_atts, s)) true -fun def_info lhs rhs = definition (lhs ^ " = " ^ - @{const_name Embedding_fun_info} ^ - " (\<open>" ^ rhs ^ "\<close>) " ^ - rhs) -fun name_print x = String.implode (case String.explode (Long_Name.base_name x) of - #"p" :: #"r" :: #"i" :: #"n" :: #"t" :: #"_" :: l => l - | _ => error "'print' expected") -fun name x = "PRINT_" ^ name_print x -fun name1 x = "floor1_PRINT_" ^ name_print x -fun name2 x = "floor2_PRINT_" ^ name_print x -in -fun embedding_fun_info rhs = def_info (name rhs) rhs -fun embedding_fun_simple rhs = definition (name rhs ^ " = " ^ - @{const_name Embedding_fun_simple} ^ " (" ^ rhs ^ ")") -fun embedding_fun_info_f1 rhs = def_info (name1 rhs) rhs -fun embedding_fun_simple_f1 rhs = definition (name1 rhs ^ " = " ^ - @{const_name Embedding_fun_simple} ^ " (" ^ rhs ^ ")") -fun embedding_fun_info_f2 rhs = def_info (name2 rhs) rhs -fun embedding_fun_simple_f2 rhs = definition (name2 rhs ^ " = " ^ - @{const_name Embedding_fun_simple} ^ " (" ^ rhs ^ ")") -fun emb_info rhs = def_info (Long_Name.base_name rhs ^ "\<^sub>i\<^sub>n\<^sub>f\<^sub>o") rhs -fun emb_simple rhs = definition (Long_Name.base_name rhs ^ "\<^sub>s\<^sub>i\<^sub>m\<^sub>p\<^sub>l\<^sub>e" ^ " = " ^ - @{const_name Embedding_fun_simple} ^ " (" ^ rhs ^ ")") -end -\<close> - -(* TODO use antiquotations in cartouches *) -local_setup \<open>embedding_fun_info @{const_name print_infra_datatype_class}\<close> -local_setup \<open>embedding_fun_info @{const_name print_infra_datatype_universe}\<close> -local_setup \<open>embedding_fun_info @{const_name print_infra_type_synonym_class_higher}\<close> -local_setup \<open>embedding_fun_info @{const_name print_access_oid_uniq}\<close> -local_setup \<open>embedding_fun_info @{const_name print_access_choose}\<close> -local_setup \<open>embedding_fun_info @{const_name print_examp_instance_defassoc}\<close> -local_setup \<open>embedding_fun_info @{const_name print_examp_instance}\<close> -local_setup \<open>embedding_fun_info_f1 @{const_name Floor1_examp.print_examp_def_st1}\<close> -local_setup \<open>embedding_fun_info_f2 @{const_name Floor2_examp.print_examp_def_st_locale}\<close> -local_setup \<open>embedding_fun_info_f2 @{const_name Floor2_examp.print_examp_def_st2}\<close> -local_setup \<open>embedding_fun_info_f2 @{const_name Floor2_examp.print_examp_def_st_perm}\<close> -local_setup \<open>embedding_fun_info_f1 @{const_name Floor1_examp.print_transition}\<close> -local_setup \<open>embedding_fun_info_f2 @{const_name Floor2_examp.print_transition_locale}\<close> -local_setup \<open>embedding_fun_info_f2 @{const_name Floor2_examp.print_transition_interp}\<close> -local_setup \<open>embedding_fun_info_f1 @{const_name Floor1_ctxt.print_ctxt}\<close> -local_setup \<open>embedding_fun_info @{const_name print_meta_setup_def_state}\<close> -local_setup \<open>embedding_fun_info @{const_name print_meta_setup_def_transition}\<close> - -subsection\<open>Assembling Translations\<close> - -definition "section_aux n s = start_map' (\<lambda>_. [ O.section (Section n s) ])" -definition "section = section_aux 0" -definition "section' = Embedding_fun_simple o section" -definition "txt f = Embedding_fun_simple (start_map'''' O.text o (\<lambda>_ design_analysis. [Text (f design_analysis)]))" -definition "txt' s = txt (\<lambda>_. s)" -definition "txt'' = txt' o S.flatten" - -definition thy_class :: - \<comment> \<open>polymorphism weakening needed by \<^theory_text>\<open>code_reflect\<close>\<close> - "_ embedding'" where \<open>thy_class = - (let section = section' o (\<lambda>s. \<open>Class Model: \<close> @@ s) in - Embed_theories - [ section \<open>Introduction\<close> - , txt'' [ \<open> - For certain concepts like classes and class-types, only a generic - definition for its resulting semantics can be given. Generic means, - there is a function outside HOL that ``compiles'' a concrete, - closed-world class diagram into a ``theory'' of this data model, - consisting of a bunch of definitions for classes, accessors, method, - casts, and tests for actual types, as well as proofs for the - fundamental properties of these operations in this concrete data - model. \<close> ] - , section \<open>The Construction of the Object Universe\<close> - , txt'' [ \<open> - Our data universe consists in the concrete class diagram just of node's, -and implicitly of the class object. Each class implies the existence of a class -type defined for the corresponding object representations as follows: \<close> ] - , PRINT_infra_datatype_class - , txt'' [ \<open> - Now, we construct a concrete ``universe of ToyAny types'' by injection into a -sum type containing the class types. This type of ToyAny will be used as instance -for all respective type-variables. \<close> ] - , PRINT_infra_datatype_universe - , txt'' [ \<open> - Having fixed the object universe, we can introduce type synonyms that exactly correspond -to Toy types. Again, we exploit that our representation of Toy is a ``shallow embedding'' with a -one-to-one correspondance of Toy-types to types of the meta-language HOL. \<close> ] - , PRINT_infra_type_synonym_class_higher - , section \<open>The Accessors\<close> - , PRINT_access_oid_uniq - , PRINT_access_choose ])\<close> - -definition "thy_enum_flat = Embed_theories []" -definition "thy_enum = Embed_theories []" -definition "thy_class_synonym = Embed_theories []" -definition "thy_class_tree = Embed_theories []" -definition "thy_class_flat = Embed_theories []" -definition "thy_association = Embed_theories []" -definition thy_instance :: \<comment> \<open>polymorphism weakening needed by \<^theory_text>\<open>code_reflect\<close>\<close> "_ embedding'" where - "thy_instance = Embed_theories - [ section' \<open>Instance\<close> - , PRINT_examp_instance_defassoc - , PRINT_examp_instance ]" -definition "thy_def_base_l = Embed_theories []" -definition "thy_def_state = (\<lambda> Floor1 \<Rightarrow> Embed_theories - [ section' \<open>State (Floor 1)\<close> - , floor1_PRINT_examp_def_st1 ] - | Floor2 \<Rightarrow> Embed_locale - [ section' \<open>State (Floor 2)\<close> ] - Floor2_examp.print_examp_def_st_locale - [ Floor2_examp.print_examp_def_st2 - , Floor2_examp.print_examp_def_st_perm ])" -definition "thy_def_transition = (\<lambda> Floor1 \<Rightarrow> Embed_theories - [ section' \<open>Transition (Floor 1)\<close> - , floor1_PRINT_transition ] - | Floor2 \<Rightarrow> Embed_locale - [ section' \<open>Transition (Floor 2)\<close> ] - Floor2_examp.print_transition_locale - [ Floor2_examp.print_transition_interp ])" -definition "thy_ctxt = (\<lambda> Floor1 \<Rightarrow> Embed_theories - [ section' \<open>Context (Floor 1)\<close> - , floor1_PRINT_ctxt ] - | Floor2 \<Rightarrow> Embed_theories - [])" -definition "thy_flush_all = Embed_theories []" -definition "thy_generic = Embed_theories []" -(* NOTE typechecking functions can be put at the end, however checking already defined constants can be done earlier *) - -subsection\<open>Combinators Folding the Compiling Environment\<close> - -definition "compiler_env_config_reset_all env = - (let env = compiler_env_config_reset_no_env env in - ( env \<lparr> D_input_meta := [] \<rparr> - , let (l_class, l_env) = find_class_ass env in - L.flatten - [ l_class - , List.filter (\<lambda> META_flush_all _ \<Rightarrow> False | _ \<Rightarrow> True) l_env - , [META_flush_all ToyFlushAll] ] ))" - -definition "fold_thy0 meta thy_object0 f = - L_fold (\<lambda>x (acc1, acc2). - let (sorry, dirty) = D_output_sorry_dirty acc1 - ; (msg, x) = case x of Embedding_fun_info msg x \<Rightarrow> (Some msg, x) - | Embedding_fun_simple x \<Rightarrow> (None, x) - ; (l, acc1) = x meta acc1 in - (f msg - (if sorry = Some Gen_sorry | sorry = None & dirty then - L.map (map_semi__theory (map_lemma (\<lambda> Lemma n spec _ _ \<Rightarrow> Lemma n spec [] C.sorry - | Lemma_assumes n spec1 spec2 _ _ \<Rightarrow> Lemma_assumes n spec1 spec2 [] C.sorry))) l - else - l) acc1 acc2)) thy_object0" - -definition "comp_env_input_class_rm f_fold f env_accu = - (let (env, accu) = f_fold f env_accu in - (env \<lparr> D_input_class := None \<rparr>, accu))" - -definition "comp_env_save ast f_fold f env_accu = - (let (env, accu) = f_fold f env_accu in - (env \<lparr> D_input_meta := ast # D_input_meta env \<rparr>, accu))" - -definition "comp_env_save_deep ast f_fold = - comp_env_save ast (\<lambda>f. map_prod - (case ast of META_def_state Floor1 meta \<Rightarrow> Floor1_examp.print_meta_setup_def_state meta - | META_def_transition Floor1 meta \<Rightarrow> Floor1_examp.print_meta_setup_def_transition meta - | _ \<Rightarrow> id) - id o - f_fold f)" - -definition "comp_env_input_class_mk f_try f_accu_reset f_fold f = - (\<lambda> (env, accu). - f_fold f - (case D_input_class env of Some _ \<Rightarrow> (env, accu) | None \<Rightarrow> - let (l_class, l_env) = find_class_ass env - ; (l_enum, l_env) = partition (\<lambda>META_enum _ \<Rightarrow> True | _ \<Rightarrow> False) l_env in - (f_try (\<lambda> () \<Rightarrow> - let D_input_meta0 = D_input_meta env - ; (env, accu) = - let meta = class_unflat' (arrange_ass True (D_toy_semantics env \<noteq> Gen_default) l_class (L.map (\<lambda> META_enum e \<Rightarrow> e) l_enum)) - ; (env, accu) = List.fold (\<lambda> ast. comp_env_save ast (case ast of META_enum meta \<Rightarrow> fold_thy0 meta thy_enum) f) - l_enum - (let env = compiler_env_config_reset_no_env env in - (env \<lparr> D_input_meta := List.filter (\<lambda> META_enum _ \<Rightarrow> False | _ \<Rightarrow> True) (D_input_meta env) \<rparr>, f_accu_reset env accu)) - ; (env, accu) = fold_thy0 meta thy_class f (env, accu) in - (env \<lparr> D_input_class := Some meta \<rparr>, accu) - ; (env, accu) = - List.fold - (\<lambda>ast. comp_env_save ast (case ast of - META_instance meta \<Rightarrow> fold_thy0 meta thy_instance - | META_def_base_l meta \<Rightarrow> fold_thy0 meta thy_def_base_l - | META_def_state floor meta \<Rightarrow> fold_thy0 meta (thy_def_state floor) - | META_def_transition floor meta \<Rightarrow> fold_thy0 meta (thy_def_transition floor) - | META_ctxt floor meta \<Rightarrow> fold_thy0 meta (thy_ctxt floor) - | META_flush_all meta \<Rightarrow> fold_thy0 meta thy_flush_all) - f) - l_env - (env \<lparr> D_input_meta := L.flatten [l_class, l_enum] \<rparr>, accu) in - (env \<lparr> D_input_meta := D_input_meta0 \<rparr>, accu)))))" - -definition "comp_env_input_class_bind l f = - List.fold (\<lambda>x. x f) l" - -definition "fold_thy' f_env_save f_try f_accu_reset = - (let comp_env_input_class_mk = comp_env_input_class_mk f_try f_accu_reset in - (\<lambda> f. - let fold_m = \<lambda>ast. - f_env_save ast (case ast of - META_enum meta \<Rightarrow> comp_env_input_class_rm (fold_thy0 meta thy_enum_flat) - | META_class_raw Floor1 meta \<Rightarrow> comp_env_input_class_rm (fold_thy0 meta thy_class_flat) - | META_association meta \<Rightarrow> comp_env_input_class_rm (fold_thy0 meta thy_association) - | META_ass_class Floor1 (ToyAssClass meta_ass meta_class) \<Rightarrow> - comp_env_input_class_rm (comp_env_input_class_bind [ fold_thy0 meta_ass thy_association - , fold_thy0 meta_class thy_class_flat ]) - | META_class_synonym meta \<Rightarrow> comp_env_input_class_rm (fold_thy0 meta thy_class_synonym) - | META_class_tree meta \<Rightarrow> comp_env_input_class_rm (fold_thy0 meta thy_class_tree) - | META_instance meta \<Rightarrow> comp_env_input_class_mk (fold_thy0 meta thy_instance) - | META_def_base_l meta \<Rightarrow> fold_thy0 meta thy_def_base_l - | META_def_state floor meta \<Rightarrow> comp_env_input_class_mk (fold_thy0 meta (thy_def_state floor)) - | META_def_transition floor meta \<Rightarrow> fold_thy0 meta (thy_def_transition floor) - | META_ctxt floor meta \<Rightarrow> comp_env_input_class_mk (fold_thy0 meta (thy_ctxt floor)) - | META_flush_all meta \<Rightarrow> comp_env_input_class_mk (fold_thy0 meta thy_flush_all) - | META_generic meta \<Rightarrow> fold_thy0 meta thy_generic) f in - \<lambda> Fold_meta ast \<Rightarrow> fold_m ast - | Fold_custom l_meta \<Rightarrow> - List.fold (\<lambda> META_all_meta_embedding ast \<Rightarrow> fold_m ast - | meta \<Rightarrow> fold_thy0 () (Embed_theories [Embedding_fun_simple (\<lambda>_. Pair [meta])]) f) - l_meta))" - -definition "fold_thy'' f_env_save f_try f_accu_reset f = - List.fold (fold_thy' f_env_save f_try f_accu_reset f) o map Fold_meta" - -definition "compiler_env_config_update f env = - \<comment> \<open>WARNING The semantics of the meta-embedded language is not intended to be reset here (like \<open>oid_start\<close>), only syntactic configurations of the compiler (path, etc...)\<close> - (let env' = f env in - if D_input_meta env = [] then - env' - \<lparr> D_output_disable_thy := D_output_disable_thy env - , D_output_header_thy := D_output_header_thy env - (*D_toy_oid_start*) - (*D_output_position*) - , D_toy_semantics := D_toy_semantics env - (*D_input_class*) - (*D_input_meta*) - (*D_input_instance*) - (*D_input_state*) - (*D_output_header_force*) - (*D_output_auto_bootstrap*) - (*D_toy_accessor*) - (*D_toy_HO_type*) - , D_output_sorry_dirty := D_output_sorry_dirty env \<rparr> - else - fst (fold_thy'' - comp_env_save_deep - (\<lambda>f. f ()) - (\<lambda>_. id) - (\<lambda>_ _. Pair) - (D_input_meta env') - (env, ())))" - -definition "fold_thy_shallow f_try f_accu_reset x = - fold_thy' - comp_env_save - f_try - f_accu_reset - (\<lambda>name l acc1. - map_prod (\<lambda> env. env \<lparr> D_input_meta := D_input_meta acc1 \<rparr>) id - o x name l - o Pair acc1)" - -definition "fold_thy_deep obj env = - (case fold_thy' - comp_env_save_deep - (\<lambda>f. f ()) - (\<lambda>env _. D_output_position env) - (\<lambda>_ l acc1 (i, cpt). (acc1, (Succ i, natural_of_nat (List.length l) + cpt))) - obj - (env, D_output_position env) of - (env, output_position) \<Rightarrow> env \<lparr> D_output_position := output_position \<rparr>)" - -end diff --git a/Citadelle/src/compiler_generic/toy_example/embedding/Generator_dynamic_sequential.thy b/Citadelle/src/compiler_generic/toy_example/embedding/Generator_dynamic_sequential.thy deleted file mode 100644 index dfd7cd4abdc56d89ab0f7dbbc72f0dd342dbf12b..0000000000000000000000000000000000000000 --- a/Citadelle/src/compiler_generic/toy_example/embedding/Generator_dynamic_sequential.thy +++ /dev/null @@ -1,2089 +0,0 @@ -(****************************************************************************** - * Citadelle - * - * 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. - ******************************************************************************) - -section\<open>Dynamic Meta Embedding with Reflection\<close> - -theory Generator_dynamic_sequential -imports Printer - "../../isabelle_home/src/HOL/Isabelle_Main2" - "~~/src/HOL/Library/Old_Datatype" -(*<*) - keywords (* Toy language *) - "Between" - "Attributes" "Operations" "Constraints" - "Role" - "Ordered" "Subsets" "Union" "Redefines" "Derived" "Qualifier" - "Existential" "Inv" "Pre" "Post" - "self" - "Nonunique" "Sequence_" - "with_only" - - (* Isabelle syntax *) - "output_directory" - "THEORY" "IMPORTS" "SECTION" "SORRY" "no_dirty" - "deep" "shallow" "syntax_print" "skip_export" - "generation_semantics" - "flush_all" - - (* Isabelle semantics (parameterizing the semantics of Toy language) *) - "design" "analysis" "oid_start" - - and (* Toy language *) - "Enum" - "Abstract_class" "Class" - "Association" "Composition" "Aggregation" - "Abstract_associationclass" "Associationclass" - "Context" - "End" "Instance" "BaseType" "State" "Transition" "Tree" - "meta_command" "meta_command'" - - (* Isabelle syntax *) - "generation_syntax" - - :: thy_decl -(*>*) -begin - -text\<open>In the ``dynamic'' solution: the exportation is automatically handled inside Isabelle/jEdit. -Inputs are provided using the syntax of the Toy Language, and in output -we basically have two options: -\begin{itemize} -\item The first is to generate an Isabelle file for inspection or debugging. -The generated file can interactively be loaded in Isabelle/jEdit, or saved to the hard disk. -This mode is called the ``deep exportation'' mode or shortly the ``deep'' mode. -The aim is to maximally automate the process one is manually performing in -\<^file>\<open>Generator_static.thy\<close>. -\item On the other hand, it is also possible to directly execute -in Isabelle/jEdit the generated file from the random access memory. -This mode corresponds to the ``shallow reflection'' mode or shortly ``shallow'' mode. -\end{itemize} -In both modes, the reflection is necessary since the main part used by both -was defined at Isabelle side. -As a consequence, experimentations in ``deep'' and ``shallow'' are performed -without leaving the editing session, in the same as the one the meta-compiler is actually running.\<close> - -apply_code_printing_reflect \<open> - val stdout_file = Unsynchronized.ref "" -\<close> text\<open>This variable is not used in this theory (only in \<^file>\<open>Generator_static.thy\<close>), - but needed for well typechecking the reflected SML code.\<close> - -code_reflect' open META - functions (* executing the compiler as monadic combinators for deep and shallow *) - fold_thy_deep fold_thy_shallow - - (* printing the HOL AST to (shallow Isabelle) string *) - write_file0 write_file - - (* manipulating the compiling environment *) - compiler_env_config_reset_all - compiler_env_config_update - oidInit - D_output_header_thy_update - map2_ctxt_term - check_export_code - - (* printing the input AST to (deep Isabelle) string *) - isabelle_apply isabelle_of_compiler_env_config - -subsection\<open>Interface Between the Reflected and the Native\<close> - -ML\<open> -val To_string0 = META.meta_of_logic -val To_nat = Code_Numeral.integer_of_natural - -exception THY_REQUIRED of Position.T -fun get_thy pos f = fn NONE => raise (THY_REQUIRED pos) | SOME thy => f thy - -infix 1 #~> |>:: -fun f #~> g = uncurry g oo f -fun x |>:: f = cons f x -\<close> - -ML\<open> -structure From = struct - val string = META.SS_base o META.ST - val binding = string o Binding.name_of - (*fun term ctxt s = string (YXML.content_of (Syntax.string_of_term ctxt s))*) - val nat = Code_Numeral.natural_of_integer - val internal_oid = META.Oid o nat - val option = Option.map - val list = List.map - fun pair f1 f2 (x, y) = (f1 x, f2 y) - fun pair3 f1 f2 f3 (x, y, z) = (f1 x, f2 y, f3 z) - - structure Pure = struct - val indexname = pair string nat - val class = string - val sort = list class - fun typ e = (fn - Type (s, l) => (META.Type o pair string (list typ)) (s, l) - | TFree (s, s0) => (META.TFree o pair string sort) (s, s0) - | TVar (i, s0) => (META.TVar o pair indexname sort) (i, s0) - ) e - fun term e = (fn - Const (s, t) => (META.Const o pair string typ) (s, t) - | Free (s, t) => (META.Free o pair string typ) (s, t) - | Var (i, t) => (META.Var o pair indexname typ) (i, t) - | Bound i => (META.Bound o nat) i - | Abs (s, ty, t) => (META.Abs o pair3 string typ term) (s, ty, t) - | op $ (term1, term2) => (META.App o pair term term) (term1, term2) - ) e - end - - fun read_term thy expr = - META.T_pure (Pure.term (Syntax.read_term (get_thy \<^here> Proof_Context.init_global thy) expr), SOME (string expr)) -end -\<close> - -ML\<open> -fun List_mapi f = META.mapi (f o To_nat) -fun out_intensify s1 s2 = Output.state ((s1 |> Markup.markup Markup.intensify) ^ s2) -fun out_intensify' tps fmt = out_intensify (Timing.message (Timing.result tps) |> Markup.markup fmt) - -structure Toplevel' = struct - datatype state_read = Load_backup | Load_previous - datatype state_write = Store_backup | Store_default - - datatype toplevel = Theory of theory -> theory - | Keep of theory -> unit - | Read_Write of state_read * state_write - - structure T = struct - val theory = cons o Theory - val keep = cons o Keep - val read_write = cons o Read_Write - end - - val keep_theory = T.keep - fun keep f tr = (\<^command_keyword>\<open>print_syntax\<close>, T.keep f) :: tr - fun read_write_keep rw = (\<^command_keyword>\<open>setup\<close>, fn tr => tr |> T.read_write rw |> T.keep (K ())) - fun setup_theory (res, tr) f = rev ((\<^command_keyword>\<open>setup\<close>, T.theory (f res)) :: tr) - fun keep_output tps fmt msg = cons (\<^command_keyword>\<open>print_syntax\<close>, T.keep (fn _ => out_intensify' tps fmt msg)) -end - -structure Outer_Syntax' = struct - fun command name_pos comment parse = - Outer_Syntax.command name_pos comment - (parse >> (fn f => - Toplevel.theory (fn thy => - fold snd (f thy NONE) [] |> rev - |> (fn tr => fold (fn Toplevel'.Theory f => f - | Toplevel'.Keep f => tap f - | Toplevel'.Read_Write _ => I) tr thy)))) -end - -structure Old_Datatype_Aux' = struct - fun default_config' n = - if n = 0 then - Old_Datatype_Aux.default_config - else - let val _ = warning "Type of datatype not available in this running version of Isabelle" - in Old_Datatype_Aux.default_config end -end -\<close> - -ML\<open> -structure Ty' = struct -fun check l_oid l = - let val Mp = META.map_prod - val Me = String.explode - val Mi = String.implode - val Ml = map in - META.check_export_code - (writeln o Mi) - (warning o Mi) - (fn s => writeln (Markup.markup (Markup.bad ()) (Mi s))) - (error o To_string0) - (Ml (Mp I Me) l_oid) - ((META.SS_base o META.ST) l) - end -end -\<close> - -subsection\<open>Binding of the Reflected API to the Native API\<close> - -ML\<open> -structure META_overload = struct - val of_semi__typ = META.of_semi_typ To_string0 - val of_semi__term = META.of_semi_terma To_string0 - val of_semi__term' = META.of_semi_term To_string0 - val fold = fold -end -\<close> - -ML\<open> -type ('a, 'b) toplevel_dual = { par: 'a, seq: 'b } -type ('transitionM, 'Proof_stateM, 'state) toplevel = - { context_of: 'state -> local_theory - - , keep: ('state -> unit) -> 'transitionM - , generic_theory: (generic_theory -> generic_theory) -> 'transitionM - , theory: (theory -> theory) -> 'transitionM - , begin_local_theory: bool -> (theory -> local_theory) -> 'transitionM - , local_theory': (bool * Position.T) option -> (xstring * Position.T) option -> - (bool -> local_theory -> local_theory) -> 'transitionM - , local_theory: (bool * Position.T) option -> (xstring * Position.T) option -> - (local_theory -> local_theory) -> 'transitionM - , local_theory_to_proof': (bool * Position.T) option -> (xstring * Position.T) option -> - (bool -> local_theory -> Proof.state) -> 'transitionM - , local_theory_to_proof: (bool * Position.T) option -> (xstring * Position.T) option -> - (local_theory -> Proof.state) -> 'transitionM - , proof': (bool -> Proof.state -> Proof.state) -> 'Proof_stateM - , proofs: (Proof.state -> Proof.state Seq.result Seq.seq) -> 'Proof_stateM - , proof: (Proof.state -> Proof.state) -> 'Proof_stateM - (* *) - , tr_report: Method.text_range -> 'transitionM -> 'transitionM - , tr_report_o: Method.text_range option -> 'transitionM -> 'transitionM - , tr_raw: (Toplevel.transition -> Toplevel.transition) -> 'transitionM - , pr_report: Method.text_range -> 'Proof_stateM -> 'Proof_stateM - , pr_report_o: Method.text_range option -> 'Proof_stateM -> 'Proof_stateM - , dual: (Toplevel.transition -> Toplevel.transition, Proof.state -> Proof.state) toplevel_dual -> 'Proof_stateM } - -structure Bind_Isabelle = struct -fun To_binding s = Binding.make (s, Position.none) -val To_sbinding = To_binding o To_string0 - -fun semi__method_simp g f = Method.Basic (fn ctxt => SIMPLE_METHOD (g (asm_full_simp_tac (f ctxt)))) -val semi__method_simp_one = semi__method_simp (fn f => f 1) -val semi__method_simp_all = semi__method_simp (CHANGED_PROP o PARALLEL_GOALS o ALLGOALS) - -datatype semi__thm' = Thms_single' of thm - | Thms_mult' of thm list - -fun semi__thm_attribute ctxt = let open META open META_overload val S = fn Thms_single' t => t in - fn Thm_thm s => Thms_single' (Proof_Context.get_thm ctxt (To_string0 s)) - | Thm_thms s => Thms_mult' (Proof_Context.get_thms ctxt (To_string0 s)) - | Thm_THEN (e1, e2) => - (case (semi__thm_attribute ctxt e1, semi__thm_attribute ctxt e2) of - (Thms_single' e1, Thms_single' e2) => Thms_single' (e1 RSN (1, e2)) - | (Thms_mult' e1, Thms_mult' e2) => Thms_mult' (e1 RLN (1, e2))) - | Thm_simplified (e1, e2) => - Thms_single' (asm_full_simplify (clear_simpset ctxt addsimps [S (semi__thm_attribute ctxt e2)]) - (S (semi__thm_attribute ctxt e1))) - | Thm_OF (e1, e2) => - Thms_single' ([S (semi__thm_attribute ctxt e2)] MRS (S (semi__thm_attribute ctxt e1))) - | Thm_where (nth, l) => - Thms_single' (Rule_Insts.where_rule - ctxt - (List.map (fn (var, expr) => - (((To_string0 var, 0), Position.none), of_semi__term expr)) l) - [] - (S (semi__thm_attribute ctxt nth))) - | Thm_symmetric e1 => - let val e2 = S (semi__thm_attribute ctxt (Thm_thm (From.string "sym"))) in - case semi__thm_attribute ctxt e1 of - Thms_single' e1 => Thms_single' (e1 RSN (1, e2)) - | Thms_mult' e1 => Thms_mult' (e1 RLN (1, [e2])) - end - | Thm_of (nth, l) => - Thms_single' (Rule_Insts.of_rule - ctxt - (List.map (SOME o of_semi__term) l, []) - [] - (S (semi__thm_attribute ctxt nth))) -end - -fun semi__thm_attribute_single ctxt s = case (semi__thm_attribute ctxt s) of Thms_single' t => t - -fun semi__thm_mult ctxt = - let fun f thy = case (semi__thm_attribute ctxt thy) of Thms_mult' t => t - | Thms_single' t => [t] in - fn META.Thms_single thy => f thy - | META.Thms_mult thy => f thy - end - -fun semi__thm_mult_l ctxt l = List.concat (map (semi__thm_mult ctxt) l) - -fun semi__method_simp_only l ctxt = clear_simpset ctxt addsimps (semi__thm_mult_l ctxt l) -fun semi__method_simp_add_del_split (l_add, l_del, l_split) ctxt = - fold Splitter.add_split (semi__thm_mult_l ctxt l_split) - (ctxt addsimps (semi__thm_mult_l ctxt l_add) - delsimps (semi__thm_mult_l ctxt l_del)) - -fun semi__method expr = let open META open Method open META_overload in case expr of - Method_rule o_s => Basic (fn ctxt => - METHOD (HEADGOAL o Classical.rule_tac - ctxt - (case o_s of NONE => [] - | SOME s => [semi__thm_attribute_single ctxt s]))) - | Method_drule s => Basic (fn ctxt => drule ctxt 0 [semi__thm_attribute_single ctxt s]) - | Method_erule s => Basic (fn ctxt => erule ctxt 0 [semi__thm_attribute_single ctxt s]) - | Method_elim s => Basic (fn ctxt => elim ctxt [semi__thm_attribute_single ctxt s]) - | Method_intro l => Basic (fn ctxt => intro ctxt (map (semi__thm_attribute_single ctxt) l)) - | Method_subst (asm, l, s) => Basic (fn ctxt => - SIMPLE_METHOD' ((if asm then EqSubst.eqsubst_asm_tac else EqSubst.eqsubst_tac) - ctxt - (map (the o Int.fromString o To_string0) l) - [semi__thm_attribute_single ctxt s])) - | Method_insert l => Basic (fn ctxt => insert (semi__thm_mult_l ctxt l)) - | Method_plus t => Combinator ( no_combinator_info - , Repeat1 - , [Combinator (no_combinator_info, Then, List.map semi__method t)]) - | Method_option t => Combinator ( no_combinator_info - , Try - , [Combinator (no_combinator_info, Then, List.map semi__method t)]) - | Method_or t => Combinator (no_combinator_info, Orelse, List.map semi__method t) - | Method_one (Method_simp_only l) => semi__method_simp_one (semi__method_simp_only l) - | Method_one (Method_simp_add_del_split l) => semi__method_simp_one (semi__method_simp_add_del_split l) - | Method_all (Method_simp_only l) => semi__method_simp_all (semi__method_simp_only l) - | Method_all (Method_simp_add_del_split l) => semi__method_simp_all (semi__method_simp_add_del_split l) - | Method_auto_simp_add_split (l_simp, l_split) => - Basic (fn ctxt => SIMPLE_METHOD (auto_tac (fold (fn (f, l) => fold f l) - [(Simplifier.add_simp, semi__thm_mult_l ctxt l_simp) - ,(Splitter.add_split, List.map (Proof_Context.get_thm ctxt o To_string0) l_split)] - ctxt))) - | Method_rename_tac l => Basic (K (SIMPLE_METHOD' (Tactic.rename_tac (List.map To_string0 l)))) - | Method_case_tac e => - Basic (fn ctxt => SIMPLE_METHOD' (Induct_Tacs.case_tac ctxt (of_semi__term e) [] NONE)) - | Method_blast n => - Basic (case n of NONE => SIMPLE_METHOD' o blast_tac - | SOME lim => fn ctxt => SIMPLE_METHOD' (depth_tac ctxt (To_nat lim))) - | Method_clarify => Basic (fn ctxt => (SIMPLE_METHOD' (fn i => CHANGED_PROP (clarify_tac ctxt i)))) - | Method_metis (l_opt, l) => - Basic (fn ctxt => (METHOD oo Metis_Tactic.metis_method) - ( (if l_opt = [] then NONE else SOME (map To_string0 l_opt), NONE) - , map (semi__thm_attribute_single ctxt) l) - ctxt) -end - -fun then_tactic l = let open Method in - (Combinator (no_combinator_info, Then, map semi__method l), (Position.none, Position.none)) -end - -fun terminal_proof0 f1 f2 f3 top o_by = let open META in case o_by of - Command_done => (\<^command_keyword>\<open>done\<close>, #dual top { par = Isar_Cmd.done_proof - , seq = f1 }) - | Command_sorry => (\<^command_keyword>\<open>sorry\<close>, #dual top { par = Isar_Cmd.skip_proof - , seq = f2 true }) - | Command_by l_apply => (\<^command_keyword>\<open>by\<close>, let val (m1, m2) = (then_tactic l_apply, NONE) in - #pr_report top m1 - (#pr_report_o top m2 - (#dual top { par = Isar_Cmd.terminal_proof (m1, m2) - , seq = f3 (m1, m2) })) end) -end - -fun terminal_proof_dual top = - terminal_proof0 Proof.local_done_proof Proof.local_skip_proof Proof.local_terminal_proof top - -fun proof_show_gen top f (thes, thes_when) st = st - |>:: (\<^command_keyword>\<open>proof\<close>, - let val m = SOME ( Method.Source [Token.make_string ("-", Position.none)] - , (Position.none, Position.none)) in - (#pr_report_o top m (#proofs top (Proof.proof m))) end) - |> f - |>:: (\<^command_keyword>\<open>show\<close>, #proof' top (fn int => Proof.show_cmd - (thes_when = []) - NONE - (K I) - [] - (if thes_when = [] then [] else [(Binding.empty_atts, map (fn t => (t, [])) thes_when)]) - [(Binding.empty_atts, [(thes, [])])] - int #> #2)) - -fun semi__command_state top (META.Command_apply_end l) = let open META_overload in - cons (\<^command_keyword>\<open>apply_end\<close>, let val m = then_tactic l in - #pr_report top m (#proofs top (Proof.apply_end m)) end) -end - -fun semi__command_proof top = let open META_overload - val thesis = "?thesis" - fun cons_proof_show f = proof_show_gen top f (thesis, []) - fun cons_let (e1, e2) = - cons (\<^command_keyword>\<open>let\<close>, #proof top - (Proof.let_bind_cmd [([of_semi__term e1], of_semi__term e2)])) in - fn META.Command_apply l => - cons (\<^command_keyword>\<open>apply\<close>, let val m = then_tactic l in - #pr_report top m (#proofs top (Proof.apply m)) end) - | META.Command_using l => - cons (\<^command_keyword>\<open>using\<close>, #proof top (fn st => - Proof.using [map (fn s => ([s], [])) (semi__thm_mult_l (Proof.context_of st) l)] st)) - | META.Command_unfolding l => - cons (\<^command_keyword>\<open>unfolding\<close>, #proof top (fn st => - Proof.unfolding [map (fn s => ([s], [])) (semi__thm_mult_l (Proof.context_of st) l)] st)) - | META.Command_let e => - cons_proof_show (cons_let e) - | META.Command_have (n, b, e, e_pr) => (fn st => st - |> cons_proof_show (fn st => st - |>:: (\<^command_keyword>\<open>have\<close>, #proof' top (fn int => - Proof.have_cmd true NONE (K I) [] [] - [( (To_sbinding n, if b then [[Token.make_string ("simp", Position.none)]] else []) - , [(of_semi__term e, [])])] int #> #2)) - |>:: terminal_proof_dual top e_pr)) - | META.Command_fix_let (l, l_let, o_exp, _) => (fn st => st - |> proof_show_gen top (fn st => st - |>:: (\<^command_keyword>\<open>fix\<close>, #proof top - (Proof.fix_cmd (List.map (fn i => (To_sbinding i, NONE, NoSyn)) l))) - |> fold cons_let l_let) - ( case o_exp of NONE => thesis | SOME (l_spec, _) => - (String.concatWith (" \<Longrightarrow> ") - (List.map of_semi__term l_spec)) - , case o_exp of NONE => [] | SOME (_, l_when) => List.map of_semi__term l_when)) -end - -fun end' top = - (\<^command_keyword>\<open>end\<close>, #tr_raw top (Toplevel.exit o Toplevel.end_local_theory o Toplevel.close_target o - Toplevel.end_proof (K Proof.end_notepad))) - -structure Cmd = struct open META open META_overload -fun input_source ml = Input.source false (of_semi__term' ml) (Position.none, Position.none) - -fun datatype' top (Datatype (version, l)) = - case version of Datatype_new => #local_theory top NONE NONE - (BNF_FP_Def_Sugar.co_datatype_cmd - BNF_Util.Least_FP - BNF_LFP.construct_lfp - (Ctr_Sugar.default_ctr_options_cmd, - (map (fn ((n, v), l) => - ( ( ( ((map (fn v => (SOME (To_binding ""), (To_string0 v, NONE))) v, To_sbinding n), NoSyn) - , List.map (fn (n, l) => ( ( (To_binding "", To_sbinding n) - , List.map (fn s => (To_binding "", of_semi__typ s)) l) - , NoSyn)) l) - , (To_binding "", To_binding "", To_binding "")) - , [])) l))) - | _ => #theory top - ((snd oo Old_Datatype.add_datatype_cmd - (Old_Datatype_Aux'.default_config' - (case version of Datatype_old => 0 | Datatype_old_atomic => 1 | _ => 2))) - (map (fn ((n, v), l) => - ( (To_sbinding n, map (fn v => (To_string0 v, NONE)) v, NoSyn) - , List.map (fn (n, l) => (To_sbinding n, List.map of_semi__typ l, NoSyn)) l)) - l)) - -fun type_synonym top (Type_synonym ((n, v), l)) = #theory top (fn thy => let val s_bind = To_sbinding n in - (snd o Typedecl.abbrev_global - (s_bind, map To_string0 v, NoSyn) - (Isabelle_Typedecl.abbrev_cmd0 (SOME s_bind) thy (of_semi__typ l))) thy end) - -fun type_notation top (Type_notation (n, e)) = #local_theory top NONE NONE - (Specification.type_notation_cmd true ("", true) [(To_string0 n, Mixfix (Input.string (To_string0 e), [], 1000, Position.no_range))]) - -fun instantiation1 name thy = thy - |> Class.instantiation ([ let val Term.Type (s, _) = Isabelle_Typedecl.abbrev_cmd0 NONE thy name in s end ], - [], - Syntax.read_sort (Proof_Context.init_global thy) "object") - -fun instantiation2 name n_def expr = - Specification.definition_cmd NONE [] [] ( (To_binding (To_string0 n_def ^ "_" ^ name ^ "_def"), []) - , of_semi__term expr) - -fun overloading1 n_c e_c = Overloading.overloading_cmd [(To_string0 n_c, of_semi__term e_c, true)] - -fun overloading2 n e = - #2 oo Specification.definition_cmd NONE [] [] ((To_sbinding n, []), of_semi__term e) - -fun consts top (Consts (n, ty, symb)) = #theory top - (Sign.add_consts_cmd [( To_sbinding n - , of_semi__typ ty - , Mixfix (Input.string ("(_) " ^ To_string0 symb), [], 1000, Position.no_range))]) - -fun definition top def = #local_theory' top NONE NONE - let val (def, e) = case def of - Definition e => (NONE, e) - | Definition_where1 (name, (abbrev, prio), e) => - (SOME ( To_sbinding name - , NONE - , Mixfix (Input.string ("(1" ^ of_semi__term abbrev ^ ")"), [], To_nat prio, Position.no_range)), e) - | Definition_where2 (name, abbrev, e) => - (SOME ( To_sbinding name - , NONE - , Mixfix (Input.string ("(" ^ of_semi__term abbrev ^ ")"), [], 1000, Position.no_range)), e) in fn ctxt => ctxt - |> #2 oo Specification.definition_cmd def [] [] (Binding.empty_atts, of_semi__term e) end - -fun lemmas top lemmas = #local_theory' top NONE NONE (fn disp => fn lthy => - let val (simp, s, l) = - case lemmas of Lemmas_simp_thm (simp, s, l) => - (simp, s, map (fn x => ([semi__thm_attribute_single lthy x], [])) l) - | Lemmas_simp_thms (s, l) => - (true, s, map (fn x => (Proof_Context.get_thms lthy (To_string0 x), [])) l) in - (#2 o Specification.theorems Thm.theoremK - [((To_sbinding s, List.map (fn s => Attrib.check_src lthy [Token.make_string (s, Position.none)]) - (if simp then ["simp", "code_unfold"] else [])), - l)] - [] - disp) lthy end) - -fun lemma1 n l_spec = Specification.theorem_cmd true Thm.theoremK NONE (K I) - Binding.empty_atts [] [] (Element.Shows [((To_sbinding n, []) - ,[((String.concatWith (" \<Longrightarrow> ") - (List.map of_semi__term l_spec)), [])])]) - -fun lemma1' n l_spec concl = Specification.theorem_cmd true Thm.theoremK NONE (K I) - (To_sbinding n, []) - [] - (List.map (fn (n, (b, e)) => - Element.Assumes [( ( To_sbinding n - , if b then [[Token.make_string ("simp", Position.none)]] else []) - , [(of_semi__term e, [])])]) - l_spec) - (Element.Shows [(Binding.empty_atts,[(of_semi__term concl, [])])]) - -fun lemma3 l_apply = map_filter (fn META.Command_let _ => SOME [] - | META.Command_have _ => SOME [] - | META.Command_fix_let (_, _, _, l) => SOME l - | _ => NONE) - (rev l_apply) - -fun axiomatization top (Axiomatization (n, e)) = #theory top - (#2 o Specification.axiomatization_cmd [] [] [] [((To_sbinding n, []), of_semi__term e)]) - -fun section n s _ = - let fun mk s n = if n <= 0 then s else mk (" " ^ s) (n - 1) in - out_intensify (mk (Markup.markup Markup.keyword3 (To_string0 s)) n) "" - end - -fun ml top (SML ml) = #generic_theory top - (ML_Context.exec let val source = input_source ml in - fn () => ML_Context.eval_source (ML_Compiler.verbose true ML_Compiler.flags) source - end #> - Local_Theory.propagate_ml_env) - -fun setup top (Setup ml) = #theory top (Isar_Cmd.setup (input_source ml)) - -fun thm top (Thm thm) = #keep top (fn state => - let val lthy = #context_of top state in - Print_Mode.with_modes [] (fn () => writeln - (Pretty.string_of - (Proof_Context.pretty_fact lthy ("", List.map (semi__thm_attribute_single lthy) thm)))) () - end) - -fun interpretation1 n loc_n loc_param = - Interpretation.interpretation_cmd ( [ ( (To_string0 loc_n, Position.none) - , ( (To_string0 n, true) - , ( if loc_param = [] then - Expression.Named [] - else - Expression.Positional (map (SOME o of_semi__term) - loc_param) - , [])))] - , []) - -fun hide_const top (Hide_const (fully, args)) = #theory top (fn thy => - fold (Sign.hide_const (not fully) o ((#1 o dest_Const) oo Proof_Context.read_const {proper = true, strict = false}) - (Proof_Context.init_global thy)) - (map To_string0 args) - thy) - -fun abbreviation top (Abbreviation e) = #local_theory' top NONE NONE - (Specification.abbreviation_cmd ("", true) NONE [] (of_semi__term e)) - -fun code_reflect' top (Code_reflect (all_public, module_name, raw_functions)) = #theory top - (Code_Runtime'.code_reflect_cmd all_public [] (map To_string0 raw_functions) (To_string0 module_name) NONE) - -end - -structure Command_Transition = struct - -fun semi__theory (top : ('transitionM, 'transitionM, 'state) toplevel) = let open META open META_overload - in (*let val f = *)fn - Theory_datatype datatype' => - cons (\<^command_keyword>\<open>datatype\<close>, Cmd.datatype' top datatype') -| Theory_type_synonym type_synonym => (*Toplevel.local_theory*) - cons (\<^command_keyword>\<open>type_synonym\<close>, Cmd.type_synonym top type_synonym) -| Theory_type_notation type_notation => - cons (\<^command_keyword>\<open>type_notation\<close>, Cmd.type_notation top type_notation) -| Theory_instantiation (Instantiation (n, n_def, expr)) => let val name = To_string0 n in fn acc => acc - |>:: (\<^command_keyword>\<open>instantiation\<close>, #begin_local_theory top true (Cmd.instantiation1 name)) - |>:: (\<^command_keyword>\<open>definition\<close>, #local_theory' top NONE NONE (#2 oo Cmd.instantiation2 name n_def expr)) - |>:: (\<^command_keyword>\<open>instance\<close>, #local_theory_to_proof top NONE NONE (Class.instantiation_instance I)) - |>:: (\<^command_keyword>\<open>..\<close>, #tr_raw top Isar_Cmd.default_proof) - |>:: end' top end -| Theory_overloading (Overloading (n_c, e_c, n, e)) => (fn acc => acc - |>:: (\<^command_keyword>\<open>overloading\<close>, #begin_local_theory top true (Cmd.overloading1 n_c e_c)) - |>:: (\<^command_keyword>\<open>definition\<close>, #local_theory' top NONE NONE (Cmd.overloading2 n e)) - |>:: end' top) -| Theory_consts consts => - cons (\<^command_keyword>\<open>consts\<close>, Cmd.consts top consts) -| Theory_definition definition => - cons (\<^command_keyword>\<open>definition\<close>, Cmd.definition top definition) -| Theory_lemmas lemmas => - cons (\<^command_keyword>\<open>lemmas\<close>, Cmd.lemmas top lemmas) -| Theory_lemma (Lemma (n, l_spec, l_apply, o_by)) => (fn acc => acc - |>:: (\<^command_keyword>\<open>lemma\<close>, #local_theory_to_proof' top NONE NONE (Cmd.lemma1 n l_spec)) - |> fold (semi__command_proof top o META.Command_apply) l_apply - |>:: terminal_proof_dual top o_by) -| Theory_lemma (Lemma_assumes (n, l_spec, concl, l_apply, o_by)) => (fn acc => acc - |>:: (\<^command_keyword>\<open>lemma\<close>, #local_theory_to_proof' top NONE NONE (Cmd.lemma1' n l_spec concl)) - |> fold (semi__command_proof top) l_apply - |> (fn st => st - |>:: terminal_proof_dual top o_by - |> (case Cmd.lemma3 l_apply of - [] => I - | _ :: l => - let fun cons_qed m = - cons (\<^command_keyword>\<open>qed\<close>, #tr_report_o top m (#tr_raw top (Isar_Cmd.qed m))) in fn st => st - |> fold (fn l => fold (semi__command_state top) l o cons_qed NONE) l - |> cons_qed NONE end))) -| Theory_axiomatization axiomatization => - cons (\<^command_keyword>\<open>axiomatization\<close>, Cmd.axiomatization top axiomatization) -| Theory_section (Section (n, s)) => let val n = To_nat n in fn st => st - |>:: (case n of 0 => - \<^command_keyword>\<open>section\<close> | 1 => - \<^command_keyword>\<open>subsection\<close> | _ => - \<^command_keyword>\<open>subsubsection\<close>, - #tr_raw top (Pure_Syn.document_command {markdown = false} (NONE, Input.string (To_string0 s)))) - |>:: (\<^command_keyword>\<open>print_syntax\<close>, #keep top (Cmd.section n s)) end -| Theory_text (Text s) => - cons (\<^command_keyword>\<open>text\<close>, - #tr_raw top (Pure_Syn.document_command {markdown = true} (NONE, Input.string (To_string0 s)))) -| Theory_text_raw (Text_raw s) => - cons (\<^command_keyword>\<open>text_raw\<close>, - #tr_raw top (Pure_Syn.document_command {markdown = true} (NONE, Input.string (To_string0 s)))) -| Theory_ML ml => - cons (\<^command_keyword>\<open>ML\<close>, Cmd.ml top ml) -| Theory_setup setup => - cons (\<^command_keyword>\<open>setup\<close>, Cmd.setup top setup) -| Theory_thm thm => - cons (\<^command_keyword>\<open>thm\<close>, Cmd.thm top thm) -| Theory_interpretation (Interpretation (n, loc_n, loc_param, o_by)) => (fn st => st - |>:: (\<^command_keyword>\<open>interpretation\<close>, #local_theory_to_proof top NONE NONE - (Cmd.interpretation1 n loc_n loc_param)) - |>:: terminal_proof_dual top o_by) -| Theory_hide_const hide_const => - cons (\<^command_keyword>\<open>hide_const\<close>, Cmd.hide_const top hide_const) -| Theory_abbreviation abbreviation => - cons (\<^command_keyword>\<open>abbreviation\<close>, Cmd.abbreviation top abbreviation) -| Theory_code_reflect code_reflect' => - cons (\<^command_keyword>\<open>code_reflect'\<close>, Cmd.code_reflect' top code_reflect') -(*in fn t => fn thy => f t thy handle ERROR s => (warning s; thy) - end*) -end -end - -structure Command_Theory = struct - -fun local_terminal_proof o_by = let open META in case o_by of - Command_done => Proof.local_done_proof - | Command_sorry => Proof.local_skip_proof true - | Command_by l_apply => Proof.local_terminal_proof (then_tactic l_apply, NONE) -end - -fun global_terminal_proof o_by = let open META in case o_by of - Command_done => Proof.global_done_proof - | Command_sorry => Proof.global_skip_proof true - | Command_by l_apply => Proof.global_terminal_proof (then_tactic l_apply, NONE) -end - -fun semi__command_state' top pr = fold snd (rev (semi__command_state top pr [])) -fun semi__command_proof' top pr = fold snd (rev (semi__command_proof top pr [])) - -fun semi__theory top = let open META open META_overload in (*let val f = *)fn - Theory_datatype datatype' => Cmd.datatype' top datatype' -| Theory_type_synonym type_synonym => Cmd.type_synonym top type_synonym -| Theory_type_notation type_notation => Cmd.type_notation top type_notation -| Theory_instantiation (Instantiation (n, n_def, expr)) => #theory top (fn thy => let val name = To_string0 n in thy - |> Cmd.instantiation1 name - |> (fn thy => let val ((_, (_, ty)), thy) = Cmd.instantiation2 name n_def expr false thy in ([ty], thy) end) - |-> Class.prove_instantiation_exit_result (map o Morphism.thm) (fn ctxt => fn thms => - Class.intro_classes_tac ctxt [] THEN ALLGOALS (Proof_Context.fact_tac ctxt thms)) - |-> K I end) -| Theory_overloading (Overloading (n_c, e_c, n, e)) => #theory top (fn thy => thy - |> Cmd.overloading1 n_c e_c - |> Cmd.overloading2 n e false - |> Local_Theory.exit_global) -| Theory_consts consts => Cmd.consts top consts -| Theory_definition definition => Cmd.definition top definition -| Theory_lemmas lemmas => Cmd.lemmas top lemmas -| Theory_lemma (Lemma (n, l_spec, l_apply, o_by)) => #local_theory top NONE NONE (fn lthy => lthy - |> Cmd.lemma1 n l_spec false - |> fold (semi__command_proof' top o META.Command_apply) l_apply - |> global_terminal_proof o_by) -| Theory_lemma (Lemma_assumes (n, l_spec, concl, l_apply, o_by)) => #local_theory top NONE NONE (fn lthy => lthy - |> Cmd.lemma1' n l_spec concl false - |> fold (semi__command_proof' top) l_apply - |> (case Cmd.lemma3 l_apply of - [] => global_terminal_proof o_by - | _ :: l => let val arg = (NONE, true) in fn st => st - |> local_terminal_proof o_by - |> fold (fn l => fold (semi__command_state' top) l o Proof.local_qed arg) l - |> Proof.global_qed arg end)) -| Theory_axiomatization axiomatization => Cmd.axiomatization top axiomatization -| Theory_section (Section (n, s)) => #keep top (Cmd.section (To_nat n) s) -| Theory_text _ => #keep top (K ()) -| Theory_text_raw _ => #keep top (K ()) -| Theory_ML ml => Cmd.ml top ml -| Theory_setup setup => Cmd.setup top setup -| Theory_thm thm => Cmd.thm top thm -| Theory_interpretation (Interpretation (n, loc_n, loc_param, o_by)) => #local_theory top NONE NONE (fn lthy => lthy - |> Cmd.interpretation1 n loc_n loc_param - |> global_terminal_proof o_by) -| Theory_hide_const hide_const => Cmd.hide_const top hide_const -| Theory_abbreviation abbreviation => Cmd.abbreviation top abbreviation -| Theory_code_reflect code_reflect' => Cmd.code_reflect' top code_reflect' -(*in fn t => fn thy => f t thy handle ERROR s => (warning s; thy) - end*) -end -end - -end - -structure Bind_META = struct open Bind_Isabelle - -structure Meta_Cmd_Data = Theory_Data - (open META - type T = META.all_meta list - val empty = [] - val extend = I - val merge = #2) - -fun ML_context_exec source = - ML_Context.exec (fn () => - ML_Context.eval_source (ML_Compiler.verbose false ML_Compiler.flags) source) #> - Local_Theory.propagate_ml_env - -fun meta_command0 s_put f_get source = - Context.Theory - #> ML_context_exec (Input.string ("let open META val ML = META.SML in Context.>> (Context.map_theory (" ^ s_put ^ " (" ^ source ^ "))) end")) - #> Context.map_theory_result (fn thy => (f_get thy, thy)) - #> fst - -val meta_command = meta_command0 "Bind_META.Meta_Cmd_Data.put" Meta_Cmd_Data.get - -local - open META - open META_overload - open Library - - fun semi__locale data thy = thy - |> ( Expression.add_locale_cmd - (To_sbinding (META.holThyLocale_name data)) - Binding.empty - ([], []) - (List.concat - (map - (fn (fixes, assumes) => List.concat - [ map (fn (e,ty) => Element.Fixes [( To_binding (of_semi__term e) - , SOME (of_semi__typ ty) - , NoSyn)]) fixes - , case assumes of NONE => [] - | SOME (n, e) => [Element.Assumes [( (To_sbinding n, []) - , [(of_semi__term e, [])])]]]) - (META.holThyLocale_header data))) - #> #2) - - fun semi__aux thy = - map2_ctxt_term - (fn T_pure x => T_pure x - | e => - let fun aux e = case e of - T_to_be_parsed (s, _) => SOME let val t = Syntax.read_term (get_thy \<^here> Proof_Context.init_global thy) - (To_string0 s) in - (t, s, Term.add_frees t []) - end - | T_lambda (a, e) => - Option.map - (fn (e, s, l_free) => - let val a0 = To_string0 a - val (t, l_free) = case List.partition (fn (x, _) => x = a0) l_free of - ([], l_free) => (Term.TFree ("'a", ["HOL.type"]), l_free) - | ([(_, t)], l_free) => (t, l_free) in - (lambda ( Term.Free (a0, t)) e - , META.String_concatWith (From.string "", [From.string "(% ", a, From.string ". ", s, From.string ")"]) - , l_free) - end) - (aux e) - | _ => NONE in - case aux e of - NONE => error "nested pure expression not expected" - | SOME (e, s, _) => META.T_pure (From.Pure.term e, SOME s) - end) -in - -fun all_meta_tr aux top thy_o = fn - META_semi_theories theo => apsnd - (case theo of - Theories_one theo => Command_Transition.semi__theory top theo - | Theories_locale (data, l) => fn acc => acc - |>:: (\<^command_keyword>\<open>locale\<close>, #begin_local_theory top true (semi__locale data)) - |> fold (fold (Command_Transition.semi__theory top)) l - |>:: end' top) -| META_boot_generation_syntax _ => I -| META_boot_setup_env _ => I -| META_all_meta_embedding (META_generic (ToyGeneric source)) => - (fn (env, tr) => - all_meta_trs - aux - top - thy_o - (get_thy \<^here> - (fn thy => - get_thy \<^here> - (meta_command (To_string0 source)) - (if forall (fn ((key, _), _) => - Keyword.is_vacuous (Thy_Header.get_keywords thy) key) - tr - then SOME thy else NONE)) - thy_o) - (env, tr)) -| META_all_meta_embedding meta => aux (semi__aux NONE meta) - -and all_meta_trs aux = fold oo all_meta_tr aux - -fun all_meta_thy aux top_theory top_local_theory = fn - META_semi_theories theo => apsnd - (case theo of - Theories_one theo => Command_Theory.semi__theory top_theory theo - | Theories_locale (data, l) => (*Toplevel.begin_local_theory*) fn thy => thy - |> semi__locale data - |> fold (fold (Command_Theory.semi__theory top_local_theory)) l - |> Local_Theory.exit_global) -| META_boot_generation_syntax _ => I -| META_boot_setup_env _ => I -| META_all_meta_embedding (META_generic (ToyGeneric source)) => - (fn (env, thy) => - all_meta_thys aux top_theory top_local_theory (meta_command (To_string0 source) thy) (env, thy)) -| META_all_meta_embedding meta => fn (env, thy) => aux (semi__aux (SOME thy) meta) (env, thy) - -and all_meta_thys aux = fold oo all_meta_thy aux - -end -end -\<close> -(*<*) -subsection\<open>Directives of Compilation for Target Languages\<close> - -ML\<open> -structure Deep0 = struct - -fun apply_hs_code_identifiers ml_module thy = - let fun mod_hs (fic, ml_module) = Code_Symbol.Module (fic, [("Haskell", SOME ml_module)]) in - fold (Code_Target.set_identifiers o mod_hs) - (map (fn x => (Context.theory_name x, ml_module)) - (* list of .hs files that will be merged together in "ml_module" *) - ( thy - :: (* we over-approximate the set of compiler files *) - Context.ancestors_of thy)) thy end - -structure Export_code_env = struct - structure Isabelle = struct - val function = "write_file" - val argument_main = "main" - end - - structure Haskell = struct - val function = "Function" - val argument = "Argument" - val main = "Main" - structure Filename = struct - fun hs_function ext = function ^ "." ^ ext - fun hs_argument ext = argument ^ "." ^ ext - fun hs_main ext = main ^ "." ^ ext - end - end - - structure OCaml = struct - val make = "write" - structure Filename = struct - fun function ext = "function." ^ ext - fun argument ext = "argument." ^ ext - fun main_fic ext = "main." ^ ext - fun makefile ext = make ^ "." ^ ext - end - end - - structure Scala = struct - structure Filename = struct - fun function ext = "Function." ^ ext - fun argument ext = "Argument." ^ ext - end - end - - structure SML = struct - val main = "Run" - structure Filename = struct - fun function ext = "Function." ^ ext - fun argument ext = "Argument." ^ ext - fun stdout ext = "Stdout." ^ ext - fun main_fic ext = main ^ "." ^ ext - end - end - - datatype file_input = File - | Directory -end - -fun compile l cmd = - let val (l, rc) = fold (fn cmd => (fn (l, 0) => - let val {out, err, rc, ...} = Bash.process cmd in - ((out, err) :: l, rc) end - | x => x)) l ([], 0) - val l = rev l in - if rc = 0 then - (l, Isabelle_System.bash_output cmd) - else - let val () = fold (fn (out, err) => K (warning err; writeln out)) l () in - error "Compilation failed" - end - end - -val check = - fold (fn (cmd, msg) => fn () => - let val (out, rc) = Isabelle_System.bash_output cmd in - if rc = 0 then - () - else - ( writeln out - ; error msg) - end) - -val compiler = [] - -structure Find = struct - -fun find ml_compiler = - case List.find (fn (ml_compiler0, _, _, _, _, _, _) => ml_compiler0 = ml_compiler) compiler of - SOME v => v - | NONE => error ("Not registered compiler: " ^ ml_compiler) - -fun ext ml_compiler = case find ml_compiler of (_, ext, _, _, _, _, _) => ext - -fun export_mode ml_compiler = case find ml_compiler of (_, _, mode, _, _, _, _) => mode - -fun function ml_compiler = case find ml_compiler of (_, _, _, f, _, _, _) => f - -fun check_compil ml_compiler = case find ml_compiler of (_, _, _, _, build, _, _) => build - -fun init ml_compiler = case find ml_compiler of (_, _, _, _, _, build, _) => build - -fun build ml_compiler = case find ml_compiler of (_, _, _, _, _, _, build) => build -end - -end -\<close> - -ML\<open> -structure Deep = struct - -fun absolute_path thy filename = - Path.implode (Path.append (Resources.master_directory thy) (Path.explode filename)) - -fun export_code_tmp_file seris g = - fold - (fn ((ml_compiler, ml_module), export_arg) => fn f => fn g => - f (fn accu => - let val tmp_name = Context.theory_name \<^theory> in - (if Deep0.Find.export_mode ml_compiler = Deep0.Export_code_env.Directory then - Isabelle_System.with_tmp_dir tmp_name - else - Isabelle_System.with_tmp_file tmp_name (Deep0.Find.ext ml_compiler)) - (fn filename => - g (((((ml_compiler, ml_module), (Path.implode filename, Position.none)), export_arg) :: accu))) - end)) - seris - (fn f => f []) - (g o rev) - -fun mk_path_export_code tmp_export_code ml_compiler i = - Path.append tmp_export_code (Path.make [ml_compiler ^ Int.toString i]) - -fun export_code_cmd' seris tmp_export_code f_err raw_cs thy = - export_code_tmp_file seris - (fn seris => - let val mem_scala = List.exists (fn ((("Scala", _), _), _) => true | _ => false) seris - val _ = Isabelle_Code_Target.export_code_cmd - false - (if mem_scala then Deep0.Export_code_env.Isabelle.function :: raw_cs else raw_cs) - seris - (Proof_Context.init_global - let val v = Deep0.apply_hs_code_identifiers Deep0.Export_code_env.Haskell.argument thy in - if mem_scala then Code_printing.apply_code_printing v else v end) in - List_mapi - (fn i => fn seri => case seri of (((ml_compiler, _), (filename, _)), _) => - let val (l, (out, err)) = - Deep0.Find.build - ml_compiler - (mk_path_export_code tmp_export_code ml_compiler i) - filename - val _ = f_err seri err in - (l, out) - end) seris - end) - -fun mk_term ctxt s = - fst (Scan.pass (Context.Proof ctxt) Args.term (Token.explode0 (Thy_Header.get_keywords' ctxt) s)) - -fun mk_free ctxt s l = - let val t_s = mk_term ctxt s in - if Term.is_Free t_s then s else - let val l = (s, "") :: l in - mk_free ctxt (fst (hd (Term.variant_frees t_s l))) l - end - end - -val list_all_eq = fn x0 :: xs => - List.all (fn x1 => x0 = x1) xs - -end -\<close> - -subsection\<open>Saving the History of Meta Commands\<close> - -ML\<open> -fun p_gen f g = f "[" "]" g - (*|| f "{" "}" g*) - || f "(" ")" g -fun paren f = p_gen (fn s1 => fn s2 => fn f => Parse.$$$ s1 |-- f --| Parse.$$$ s2) f -fun parse_l f = Parse.$$$ "[" |-- Parse.!!! (Parse.list f --| Parse.$$$ "]") -fun parse_l_with f = Parse.$$$ "[" |-- Scan.optional (Parse.binding --| \<^keyword>\<open>with_only\<close> >> SOME) NONE - -- Parse.!!! (Parse.list f --| Parse.$$$ "]") -fun parse_l' f = Parse.$$$ "[" |-- Parse.list f --| Parse.$$$ "]" -fun parse_l1' f = Parse.$$$ "[" |-- Parse.list1 f --| Parse.$$$ "]" -fun annot_ty f = Parse.$$$ "(" |-- f --| Parse.$$$ "::" -- Parse.binding --| Parse.$$$ ")" -\<close> - -ML\<open> -structure Generation_mode = struct - -type internal_deep = - { output_header_thy : (string * (string list (* imports *) * string (* import optional (bootstrap) *))) option - , seri_args : ((bstring (* compiler *) * bstring (* main module *) ) * Token.T list) list - , filename_thy : bstring option - , tmp_export_code : Path.T (* dir *) - , skip_exportation : bool (* true: skip preview of code exportation *) } - -datatype ('a, 'b, 'c) generation_mode0 = Gen_deep of 'a | Gen_shallow of 'b | Gen_syntax_print of 'c - -type ('compiler_env_config_ext, 'a) generation_mode = - { deep : ('compiler_env_config_ext * internal_deep) list - , shallow : ('compiler_env_config_ext * 'a (* theory init *)) list - , syntax_print : int option list } - -fun mapM_syntax_print f (mode : ('compiler_env_config_ext, 'a) generation_mode) tr = tr - |> f (#syntax_print mode) - |> apfst (fn syntax_print => { syntax_print = syntax_print - , deep = #deep mode - , shallow = #shallow mode }) - -fun mapM_shallow f (mode : ('compiler_env_config_ext, 'a) generation_mode) tr = tr - |> f (#shallow mode) - |> apfst (fn shallow => { syntax_print = #syntax_print mode - , deep = #deep mode - , shallow = shallow }) - -fun mapM_deep f (mode : ('compiler_env_config_ext, 'a) generation_mode) tr = tr - |> f (#deep mode) - |> apfst (fn deep => { syntax_print = #syntax_print mode - , deep = deep - , shallow = #shallow mode }) - -structure Data_gen = Theory_Data - (type T = (unit META.compiler_env_config_ext, theory) generation_mode - val empty = {deep = [], shallow = [], syntax_print = [NONE]} - val extend = I - fun merge (e1, e2) = { deep = #deep e1 @ #deep e2 - , shallow = #shallow e1 @ #shallow e2 - , syntax_print = #syntax_print e1 @ #syntax_print e2 }) - -val code_expr_argsP = Scan.optional (\<^keyword>\<open>(\<close> |-- Parse.args --| \<^keyword>\<open>)\<close>) [] - -val parse_scheme = - \<^keyword>\<open>design\<close> >> K META.Gen_only_design || \<^keyword>\<open>analysis\<close> >> K META.Gen_only_analysis - -val parse_sorry_mode = - Scan.optional ( \<^keyword>\<open>SORRY\<close> >> K (SOME META.Gen_sorry) - || \<^keyword>\<open>no_dirty\<close> >> K (SOME META.Gen_no_dirty)) NONE - -val parse_deep = - Scan.optional (\<^keyword>\<open>skip_export\<close> >> K true) false - -- Scan.optional (((Parse.$$$ "(" -- \<^keyword>\<open>THEORY\<close>) |-- Parse.name -- ((Parse.$$$ ")" - -- Parse.$$$ "(" -- \<^keyword>\<open>IMPORTS\<close>) |-- parse_l' Parse.name -- Parse.name) - --| Parse.$$$ ")") >> SOME) NONE - -- Scan.optional (\<^keyword>\<open>SECTION\<close> >> K true) false - -- parse_sorry_mode - -- (* code_expr_inP *) parse_l1' (\<^keyword>\<open>in\<close> |-- ((\<^keyword>\<open>self\<close> || Parse.name) - -- Scan.optional (\<^keyword>\<open>module_name\<close> |-- Parse.name) "" - -- code_expr_argsP)) - -- Scan.optional - ((Parse.$$$ "(" -- \<^keyword>\<open>output_directory\<close>) |-- Parse.name --| Parse.$$$ ")" >> SOME) - NONE - -val parse_semantics = - let val z = 0 in - Scan.optional - (paren (\<^keyword>\<open>generation_semantics\<close> - |-- paren (parse_scheme - -- Scan.optional ((Parse.$$$ "," -- \<^keyword>\<open>oid_start\<close>) |-- Parse.nat) - z))) - (META.Gen_default, z) - end - -val mode = - let fun mk_env output_disable_thy output_header_thy oid_start design_analysis sorry_mode ctxt = - META.compiler_env_config_empty - output_disable_thy - (From.option (From.pair From.string (From.pair (From.list From.string) From.string)) - output_header_thy) - (META.oidInit (From.internal_oid oid_start)) - design_analysis - (sorry_mode, Config.get ctxt quick_and_dirty) in - - \<^keyword>\<open>deep\<close> |-- parse_semantics -- parse_deep >> - (fn ( (design_analysis, oid_start) - , ( ((((skip_exportation, output_header_thy), output_disable_thy), sorry_mode), seri_args) - , filename_thy)) => - Gen_deep ( mk_env (not output_disable_thy) - output_header_thy - oid_start - design_analysis - sorry_mode - , { output_header_thy = output_header_thy - , seri_args = seri_args - , filename_thy = filename_thy - , tmp_export_code = Isabelle_System.create_tmp_path "deep_export_code" "" - , skip_exportation = skip_exportation })) - || \<^keyword>\<open>shallow\<close> |-- parse_semantics -- parse_sorry_mode >> - (fn ((design_analysis, oid_start), sorry_mode) => - Gen_shallow (mk_env true - NONE - oid_start - design_analysis - sorry_mode)) - || (\<^keyword>\<open>syntax_print\<close> |-- Scan.optional (Parse.number >> SOME) NONE) >> - (fn n => Gen_syntax_print (case n of NONE => NONE | SOME n => Int.fromString n)) - end - -fun f_command l_mode = - Toplevel'.setup_theory - (META.mapM - (fn Gen_shallow env => - pair (fn thy => Gen_shallow (env (Proof_Context.init_global thy), thy)) - o cons (Toplevel'.read_write_keep (Toplevel'.Load_previous, Toplevel'.Store_backup)) - | Gen_syntax_print n => pair (K (Gen_syntax_print n)) - | Gen_deep (env, i_deep) => - pair (fn thy => Gen_deep (env (Proof_Context.init_global thy), i_deep)) - o cons - (\<^command_keyword>\<open>export_code\<close>, Toplevel'.keep_theory (fn thy => - let val seri_args' = - List_mapi - (fn i => fn ((ml_compiler, ml_module), export_arg) => - let val tmp_export_code = Deep.mk_path_export_code (#tmp_export_code i_deep) ml_compiler i - fun mk_fic s = Path.append tmp_export_code (Path.make [s]) - val () = Deep0.Find.check_compil ml_compiler () - val () = Isabelle_System.mkdirs tmp_export_code in - (( ( (ml_compiler, ml_module) - , ( Path.implode (if Deep0.Find.export_mode ml_compiler = Deep0.Export_code_env.Directory then - tmp_export_code - else - mk_fic (Deep0.Find.function ml_compiler (Deep0.Find.ext ml_compiler))) - , Position.none)) - , export_arg), mk_fic) - end) - (List.filter (fn (("self", _), _) => false | _ => true) (#seri_args i_deep)) - val _ = - case seri_args' of [] => () | _ => - let val _ = - warning ("After closing Isabelle/jEdit, we may still need to remove this directory (by hand): " ^ - Path.implode (Path.expand (#tmp_export_code i_deep))) in - thy - |> Deep0.apply_hs_code_identifiers Deep0.Export_code_env.Haskell.function - |> Code_printing.apply_code_printing - |> Proof_Context.init_global - |> - Isabelle_Code_Target.export_code_cmd - (List.exists (fn (((("SML", _), _), _), _) => true | _ => false) seri_args') - [Deep0.Export_code_env.Isabelle.function] - (List.map fst seri_args') - end in - List.app (fn ((((ml_compiler, ml_module), _), _), mk_fic) => - Deep0.Find.init ml_compiler mk_fic ml_module Deep.mk_free thy) seri_args' end))) - l_mode - []) - (fn l_mode => fn thy => - let val l_mode = map (fn f => f thy) l_mode - in Data_gen.put { deep = map_filter (fn Gen_deep x => SOME x | _ => NONE) l_mode - , shallow = map_filter (fn Gen_shallow x => SOME x | _ => NONE) l_mode - , syntax_print = map_filter (fn Gen_syntax_print x => SOME x | _ => NONE) l_mode } thy end) - -fun update_compiler_config f = - Data_gen.map - (fn mode => { deep = map (apfst (META.compiler_env_config_update f)) (#deep mode) - , shallow = map (apfst (META.compiler_env_config_update f)) (#shallow mode) - , syntax_print = #syntax_print mode }) - -fun meta_command0 s_put f_get f_get0 source = - Context.Theory - #> Bind_META.ML_context_exec (Input.string ("let open META val ML = META.SML in Context.>> (Context.map_theory (fn thy => " ^ s_put ^ " ((" ^ source ^ ") (" ^ f_get0 ^ " thy)) thy)) end")) - #> Context.map_theory_result (fn thy => (f_get thy, thy)) - #> fst - -val meta_command = meta_command0 "Bind_META.Meta_Cmd_Data.put" - Bind_META.Meta_Cmd_Data.get - "Generation_mode.Data_gen.get" -end -\<close> - -subsection\<open>Factoring All Meta Commands Together\<close> - -setup\<open>ML_Antiquotation.inline \<^binding>\<open>mk_string\<close> (Scan.succeed -"(fn ctxt => fn x => ML_Pretty.string_of_polyml (ML_system_pretty (x, FixedInt.fromInt (Config.get ctxt ML_Print_Depth.print_depth))))") -\<close> - -ML\<open> - -local - val partition_self = List.partition (fn ((s,_),_) => s = "self") -in - -fun exec_deep0 {output_header_thy, seri_args, filename_thy, tmp_export_code, ...} (env, l_obj) = -let open Generation_mode - val of_arg = META.isabelle_of_compiler_env_config META.isabelle_apply I - fun def s = Named_Target.theory_map (snd o Specification.definition_cmd NONE [] [] (Binding.empty_atts, s) false) - val (seri_args0, seri_args) = partition_self seri_args - in - fn thy0 => - let - val env = META.compiler_env_config_more_map - (fn () => (l_obj, From.option - From.string - (Option.map (Deep.absolute_path thy0) filename_thy))) - env - val l = case seri_args of [] => [] | _ => - let val name_main = Deep.mk_free (Proof_Context.init_global thy0) - Deep0.Export_code_env.Isabelle.argument_main [] - in thy0 - |> def (String.concatWith " " - ( "(" (* polymorphism weakening needed by export_code *) - ^ name_main ^ " :: (_ \<times> abr_string option) compiler_env_config_scheme)" - :: "=" - :: To_string0 (of_arg env) - :: [])) - |> Deep.export_code_cmd' seri_args - tmp_export_code - (fn (((_, _), (msg, _)), _) => fn err => if err <> 0 then error msg else ()) - [name_main] - end - in - case seri_args0 of [] => l - | _ => ([], case (output_header_thy, filename_thy) of - (SOME _, SOME _) => let val _ = META.write_file env in "" end - | _ => String.concat (map (fn s => s ^ "\n") (snd (META.write_file0 env))) - (* TODO: further optimize "string" as "string list" *)) - :: l - end - |> (fn l => let val (l_warn, l) = (map fst l, map snd l) in - if Deep.list_all_eq l then - (List.concat l_warn, hd l) - else - error "There is an extracted language which does not produce a similar Isabelle content as the others" - end) - |> (fn (l_warn, s) => - let val () = writeln - (case (output_header_thy, filename_thy) of - (SOME _, SOME _) => s - | _ => String.concat (map ( (fn s => s ^ "\n") - o Active.sendback_markup_command - o trim_line) - (String.tokens (fn c => Char.ord c = META.integer_escape) s))) - in List.app (fn (out, err) => ( writeln (Markup.markup Markup.keyword2 err) - ; case trim_line out of "" => () - | out => writeln (Markup.markup Markup.keyword1 out))) - l_warn end) -end - -fun exec_deep i_deep e = - let val (seri_args0, seri_args) = partition_self (#seri_args i_deep) - in cons - ( case (seri_args0, seri_args) of ([_], []) => \<^command_keyword>\<open>print_syntax\<close> - | _ => \<^command_keyword>\<open>export_code\<close> - , Toplevel'.keep_theory (exec_deep0 i_deep e)) - end -end - -local - -fun fold_thy_shallow f = - META.fold_thy_shallow - (fn f => f () handle ERROR e => - ( warning "Shallow Backtracking: (true) Isabelle declarations occurring among the META-simulated ones are ignored (if any)" - (* TODO automatically determine if there is such Isabelle declarations, - for raising earlier a specific error message *) - ; error e)) - f - -fun disp_time toplevel_keep_output = - let - val tps = Timing.start () - val disp_time = fn NONE => I | SOME msg => - toplevel_keep_output tps Markup.antiquote - let val msg = To_string0 msg - in " " ^ Pretty.string_of - (Pretty.mark (Name_Space.markup (Proof_Context.const_space \<^context>) msg) - (Pretty.str msg)) end - in (tps, disp_time) end - -fun thy_deep exec_deep exec_info l_obj = - Generation_mode.mapM_deep - (META.mapM (fn (env, i_deep) => - pair (META.fold_thy_deep l_obj env, i_deep) - o (if #skip_exportation i_deep then - I - else - let fun exec l_obj = - exec_deep { output_header_thy = #output_header_thy i_deep - , seri_args = #seri_args i_deep - , filename_thy = NONE - , tmp_export_code = #tmp_export_code i_deep - , skip_exportation = #skip_exportation i_deep } - ( META.d_output_header_thy_update (K NONE) env, l_obj) - in - case l_obj of - META.Fold_meta obj => exec [obj] - | META.Fold_custom l_obj => - let val l_obj' = map_filter (fn META.META_all_meta_embedding x => SOME x - | _ => NONE) - l_obj - in if length l_obj' = length l_obj - then exec l_obj' - else - exec_info - (fn _ => - app ( writeln - o Active.sendback_markup_command - o META.print META.of_all_meta (META.d_output_header_thy_update (K NONE) env)) - l_obj) - end - end))) - -fun report m f = (Method.report m; f) -fun report_o o' f = (Option.map Method.report o'; f) - -fun thy_shallow l_obj get_all_meta_embed = - Generation_mode.mapM_shallow - (fn l_shallow => fn thy => META.mapM - (fn (env, thy0) => fn (thy, l_obj) => - let val (_, disp_time) = disp_time (tap o K ooo out_intensify') - fun aux x = - fold_thy_shallow - (K o K thy0) - (fn msg => - let val () = disp_time msg () - fun in_self f lthy = lthy - |> Local_Theory.new_group - |> f - |> Local_Theory.reset_group - |> Local_Theory.reset - fun not_used p _ = error ("not used " ^ Position.here p) - val context_of = I - fun proof' f = f true - fun proofs f s = s |> f |> Seq.the_result "" - val proof = I - val dual = #seq in - Bind_META.all_meta_thys (aux o META.Fold_meta) - - { (* specialized part *) - theory = I - , local_theory = K o K Named_Target.theory_map - , local_theory' = K o K (fn f => Named_Target.theory_map (f false)) - , keep = fn f => Named_Target.theory_map (fn lthy => (f lthy ; lthy)) - , generic_theory = Context.theory_map - (* generic part *) - , context_of = context_of, dual = dual - , proof' = proof', proofs = proofs, proof = proof - , tr_report = report, tr_report_o = report_o - , pr_report = report, pr_report_o = report_o - (* irrelevant part *) - , begin_local_theory = K o not_used \<^here> - , local_theory_to_proof' = K o K not_used \<^here> - , local_theory_to_proof = K o K not_used \<^here> - , tr_raw = not_used \<^here> } - - { (* specialized part *) - theory = Local_Theory.background_theory - , local_theory = K o K in_self - , local_theory' = K o K (fn f => in_self (f false)) - , keep = fn f => in_self (fn lthy => (f lthy ; lthy)) - , generic_theory = Context.proof_map - (* generic part *) - , context_of = context_of, dual = dual - , proof' = proof', proofs = proofs, proof = proof - , tr_report = report, tr_report_o = report_o - , pr_report = report, pr_report_o = report_o - (* irrelevant part *) - , begin_local_theory = K o not_used \<^here> - , local_theory_to_proof' = K o K not_used \<^here> - , local_theory_to_proof = K o K not_used \<^here> - , tr_raw = not_used \<^here> } - end) - x - val (env, thy) = - let - fun disp_time f x = - let val (s, r) = Timing.timing f x - val () = out_intensify (Timing.message s |> Markup.markup Markup.operator) "" in - r - end - in disp_time (fn x => aux x (env, thy)) (l_obj ()) end - in ((env, thy0), (thy, fn _ => get_all_meta_embed (SOME thy))) end) - l_shallow - (thy, case l_obj of SOME f => f | NONE => fn _ => get_all_meta_embed (SOME thy)) - |> META.map_prod I fst) - -fun thy_switch \<^cancel>\<open>pos1 pos2\<close> f mode tr = - ( ( mode - , \<^cancel>\<open>Toplevel'.keep - (fn _ => Output.information ( "Theory required while transitions were being built" - ^ Position.here pos1 - ^ ": Commands will not be concurrently considered. " - ^ Markup.markup - (Markup.properties (Position.properties_of pos2) Markup.position) - "(Handled here\092<^here>)"))\<close> tr) - , f #~> Generation_mode.Data_gen.put) - -in - -fun outer_syntax_commands''' is_safe mk_string cmd_spec cmd_descr parser get_all_meta_embed = - let open Generation_mode in - Outer_Syntax'.command cmd_spec cmd_descr - (parser >> (fn name => fn thy => fn _ => - (* WARNING: Whenever there would be errors raised by functions taking "thy" as input, - they will not be shown. - So the use of this "thy" can be considered as safe, as long as errors do not happen. *) - let - val get_all_m = get_all_meta_embed name - val m_tr = (Data_gen.get thy, []) - |-> mapM_syntax_print (META.mapM (fn n => - pair n - o cons (\<^command_keyword>\<open>print_syntax\<close>, - Toplevel'.keep_theory (fn thy => - writeln (mk_string - (Proof_Context.init_global - (case n of NONE => thy - | SOME n => Config.put_global ML_Print_Depth.print_depth n thy)) - name))))) - in \<^cancel>\<open>let - val thy_o = is_safe thy - val l_obj = get_all_m thy_o - (* In principle, it is fine if (SOME thy) is provided to - get_all_m. However, because certain types of errors are most of the - time happening whenever certain specific operations depending on thy - are explicitly performed, and because get_all_m was intentionally set - to not interactively manage such errors, then these errors (whenever - they are happening) could possibly not appear in the output - window. Although the computation would be in any case interrupted as - usual (but with only minimal debugging information, such as a simple - red underlining color). - - Generally, whenever get_all_m is called during the evaluating commands - coming from generated files (which is not the case here, but will be - later), this restriction can normally be removed (i.e., by writing - (SOME thy)), as for the case of generated files, we are taking the - assumption that errors (if they are happening) are as hard to detect - as if an error was raised somewhere else by the generator itself. - Another assumption nevertheless related with the generator is that it - is supposed to explicitly not raise errors, however here this - get_all_m is not situated below a generating part. This is why we are - tempted to mostly give NONE to get_all_m, unless the calling command - is explicitly taking the responsibility of a potential failure. *) - val m_tr = m_tr - |-> thy_deep exec_deep Toplevel'.keep l_obj - in ( m_tr - |-> mapM_shallow (META.mapM (fn (env, thy_init) => fn acc => - let val (tps, disp_time) = disp_time Toplevel'.keep_output - fun aux thy_o = - fold_thy_shallow - (K (cons (Toplevel'.read_write_keep (Toplevel.Load_backup, Toplevel.Store_default)))) - (fn msg => fn l => - apsnd (disp_time msg) - #> Bind_META.all_meta_trs (aux thy_o o META.Fold_meta) - { context_of = Toplevel.context_of - , keep = Toplevel.keep - , generic_theory = Toplevel.generic_theory - , theory = Toplevel.theory - , begin_local_theory = Toplevel.begin_local_theory - , local_theory' = Toplevel.local_theory' - , local_theory = Toplevel.local_theory - , local_theory_to_proof' = Toplevel.local_theory_to_proof' - , local_theory_to_proof = Toplevel.local_theory_to_proof - , proof' = Toplevel.proof' - , proofs = Toplevel.proofs - , proof = Toplevel.proof - (* *) - , dual = #par, tr_raw = I - , tr_report = report, tr_report_o = report_o - , pr_report = report, pr_report_o = report_o } - thy_o - l) - in aux thy_o l_obj (env, acc) - |> META.map_prod - (fn env => (env, thy_init)) - (Toplevel'.keep_output tps Markup.operator "") end)) - , Data_gen.put) - handle THY_REQUIRED pos => - m_tr |-> thy_switch pos \<^here> (thy_shallow NONE get_all_m) - end - handle THY_REQUIRED pos => - \<close>m_tr |-> thy_switch \<^cancel>\<open>pos \<^here>\<close> (fn mode => fn thy => - let val l_obj = get_all_m (SOME thy) in - (thy_deep (tap oo exec_deep0) tap l_obj - #~> thy_shallow (SOME (K l_obj)) get_all_m) mode thy - end) - end - |> uncurry Toplevel'.setup_theory)) - end -end - -fun outer_syntax_commands'' mk_string = outer_syntax_commands''' (K NONE) mk_string - -fun outer_syntax_commands' mk_string cmd_spec cmd_descr parser get_all_meta_embed = - outer_syntax_commands'' mk_string cmd_spec cmd_descr parser (META.Fold_meta oo get_all_meta_embed) - -fun outer_syntax_commands'2 mk_string cmd_spec cmd_descr parser get_all_meta_embed = - outer_syntax_commands''' SOME mk_string cmd_spec cmd_descr parser (META.Fold_meta oo get_all_meta_embed) -\<close> - -subsection\<open>Parameterizing the Semantics of Embedded Languages\<close> - -ML\<open> -val () = let open Generation_mode in - Outer_Syntax'.command \<^command_keyword>\<open>generation_syntax\<close> "set the generating list" - (( mode >> (fn x => SOME [x]) - || parse_l' mode >> SOME - || \<^keyword>\<open>deep\<close> -- \<^keyword>\<open>flush_all\<close> >> K NONE) >> - (fn SOME x => K (K (f_command x)) - | NONE => fn thy => fn _ => [] - |> fold (fn (env, i_deep) => exec_deep i_deep (META.compiler_env_config_reset_all env)) - (#deep (Data_gen.get thy)) - |> (fn [] => Toplevel'.keep (fn _ => warning "Nothing performed.") [] - | l => l))) -end -\<close> - -subsection\<open>Common Parser for Toy\<close> - -ML\<open> -structure TOY_parse = struct - datatype ('a, 'b) use_context = TOY_context_invariant of 'a - | TOY_context_pre_post of 'b - - fun optional f = Scan.optional (f >> SOME) NONE - val colon = Parse.$$$ ":" - fun repeat2 scan = scan ::: Scan.repeat1 scan - - fun xml_unescape s = YXML.content_of s |> Symbol_Pos.explode0 |> Symbol_Pos.implode |> From.string - - fun outer_syntax_commands2 mk_string cmd_spec cmd_descr parser v_true v_false get_all_meta_embed = - outer_syntax_commands' mk_string cmd_spec cmd_descr - (optional (paren \<^keyword>\<open>shallow\<close>) -- parser) - (fn (is_shallow, use) => fn thy => - get_all_meta_embed - (if is_shallow = NONE then - ( fn s => - META.T_to_be_parsed ( From.string s - , xml_unescape s) - , v_true) - else - (From.read_term thy, v_false)) - use) - - (* *) - - val ident_dot_dot = let val f = Parse.sym_ident >> (fn "\<bullet>" => "\<bullet>" | _ => Scan.fail "Syntax error") in - f -- f end - val ident_star = Parse.sym_ident (* "*" *) - - (* *) - - fun natural0 s = case Int.fromString s of SOME i => From.nat i - | NONE => Scan.fail "Syntax error" - - val natural = Parse.number >> natural0 - - val unlimited_natural = ident_star >> (fn "*" => META.Mult_star - | "\<infinity>" => META.Mult_infinity - | _ => Scan.fail "Syntax error") - || Parse.number >> (META.Mult_nat o natural0) - - val term_base = - Parse.number >> (META.ToyDefInteger o From.string) - || Parse.float_number >> (META.ToyDefReal o (From.pair From.string From.string o - (fn s => case String.tokens (fn #"." => true - | _ => false) s of [l1,l2] => (l1,l2) - | _ => Scan.fail "Syntax error"))) - || Parse.string >> (META.ToyDefString o From.string) - - val multiplicity = parse_l' (unlimited_natural -- optional (ident_dot_dot |-- unlimited_natural)) - - fun toy_term x = - ( term_base >> META.ShallB_term - || Parse.binding >> (META.ShallB_str o From.binding) - || \<^keyword>\<open>self\<close> |-- Parse.nat >> (fn n => META.ShallB_self (From.internal_oid n)) - || paren (Parse.list toy_term) >> (* untyped, corresponds to Set, Sequence or Pair *) - (* WARNING for Set: we are describing a finite set *) - META.ShallB_list) x - - val name_object = optional (Parse.list1 Parse.binding --| colon) -- Parse.binding - - val type_object_weak = - let val name_object = Parse.binding >> (fn s => (NONE, s)) in - name_object -- Scan.repeat (Parse.$$$ "<" |-- Parse.list1 name_object) >> - let val f = fn (_, s) => META.ToyTyCore_pre (From.binding s) in - fn (s, l) => META.ToyTyObj (f s, map (map f) l) - end - end - - val type_object = name_object -- Scan.repeat (Parse.$$$ "<" |-- Parse.list1 name_object) >> - let val f = fn (_, s) => META.ToyTyCore_pre (From.binding s) in - fn (s, l) => META.ToyTyObj (f s, map (map f) l) - end - - val category = - multiplicity - -- optional (\<^keyword>\<open>Role\<close> |-- Parse.binding) - -- Scan.repeat ( \<^keyword>\<open>Ordered\<close> >> K META.Ordered0 - || \<^keyword>\<open>Subsets\<close> |-- Parse.binding >> K META.Subsets0 - || \<^keyword>\<open>Union\<close> >> K META.Union0 - || \<^keyword>\<open>Redefines\<close> |-- Parse.binding >> K META.Redefines0 - || \<^keyword>\<open>Derived\<close> -- Parse.$$$ "=" |-- Parse.term >> K META.Derived0 - || \<^keyword>\<open>Qualifier\<close> |-- Parse.term >> K META.Qualifier0 - || \<^keyword>\<open>Nonunique\<close> >> K META.Nonunique0 - || \<^keyword>\<open>Sequence_\<close> >> K META.Sequence) >> - (fn ((l_mult, role), l) => - META.Toy_multiplicity_ext (l_mult, From.option From.binding role, l, ())) - - val type_base = Parse.reserved "Void" >> K META.ToyTy_base_void - || Parse.reserved "Boolean" >> K META.ToyTy_base_boolean - || Parse.reserved "Integer" >> K META.ToyTy_base_integer - || Parse.reserved "UnlimitedNatural" >> K META.ToyTy_base_unlimitednatural - || Parse.reserved "Real" >> K META.ToyTy_base_real - || Parse.reserved "String" >> K META.ToyTy_base_string - - fun use_type_gen type_object v = - ((* collection *) - Parse.reserved "Set" |-- use_type >> - (fn l => META.ToyTy_collection (META.Toy_multiplicity_ext ([], NONE, [META.Set], ()), l)) - || Parse.reserved "Sequence" |-- use_type >> - (fn l => META.ToyTy_collection (META.Toy_multiplicity_ext ([], NONE, [META.Sequence], ()), l)) - || category -- use_type >> META.ToyTy_collection - - (* pair *) - || Parse.reserved "Pair" |-- - ( use_type -- use_type - || Parse.$$$ "(" |-- use_type --| Parse.$$$ "," -- use_type --| Parse.$$$ ")") >> META.ToyTy_pair - - (* base *) - || type_base - - (* raw HOL *) - || Parse.sym_ident (* "\<acute>" *) |-- Parse.typ --| Parse.sym_ident (* "\<acute>" *) >> - (META.ToyTy_raw o xml_unescape) - - (* object type *) - || type_object >> META.ToyTy_object - - || ((Parse.$$$ "(" |-- Parse.list ( (Parse.binding --| colon >> (From.option From.binding o SOME)) - -- ( Parse.$$$ "(" |-- use_type --| Parse.$$$ ")" - || use_type_gen type_object_weak) >> META.ToyTy_binding - ) --| Parse.$$$ ")" - >> (fn ty_arg => case rev ty_arg of - [] => META.ToyTy_base_void - | ty_arg => fold (fn x => fn acc => META.ToyTy_pair (x, acc)) - (tl ty_arg) - (hd ty_arg))) - -- optional (colon |-- use_type)) - >> (fn (ty_arg, ty_out) => case ty_out of NONE => ty_arg - | SOME ty_out => META.ToyTy_arrow (ty_arg, ty_out)) - || (Parse.$$$ "(" |-- use_type --| Parse.$$$ ")" >> (fn s => META.ToyTy_binding (NONE, s)))) v - and use_type x = use_type_gen type_object x - - val use_prop = - (optional (optional (Parse.binding >> From.binding) --| Parse.$$$ ":") >> (fn NONE => NONE - | SOME x => x)) - -- Parse.term --| optional (Parse.$$$ ";") >> (fn (n, e) => fn from_expr => - META.ToyProp_ctxt (n, from_expr e)) - - (* *) - - val association_end = - type_object - -- category - --| optional (Parse.$$$ ";") - - val association = optional \<^keyword>\<open>Between\<close> |-- Scan.optional (repeat2 association_end) [] - - val invariant = - optional \<^keyword>\<open>Constraints\<close> - |-- Scan.optional (\<^keyword>\<open>Existential\<close> >> K true) false - --| \<^keyword>\<open>Inv\<close> - -- use_prop - - structure Outer_syntax_Association = struct - fun make ass_ty l = META.Toy_association_ext (ass_ty, META.ToyAssRel l, ()) - end - - (* *) - - val context = - Scan.repeat - (( optional (\<^keyword>\<open>Operations\<close> || Parse.$$$ "::") - |-- Parse.binding - -- use_type - --| optional (Parse.$$$ "=" |-- Parse.term || Parse.term) - -- Scan.repeat - ( (\<^keyword>\<open>Pre\<close> || \<^keyword>\<open>Post\<close>) - -- use_prop >> TOY_context_pre_post - || invariant >> TOY_context_invariant) - --| optional (Parse.$$$ ";")) >> - (fn ((name_fun, ty), expr) => fn from_expr => - META.Ctxt_pp - (META.Toy_ctxt_pre_post_ext - ( From.binding name_fun - , ty - , From.list (fn TOY_context_pre_post (pp, expr) => - META.T_pp (if pp = "Pre" then - META.ToyCtxtPre - else - META.ToyCtxtPost, expr from_expr) - | TOY_context_invariant (b, expr) => - META.T_invariant (META.T_inv (b, expr from_expr))) expr - , ()))) - || - invariant >> (fn (b, expr) => fn from_expr => META.Ctxt_inv (META.T_inv (b, expr from_expr)))) - - val class = - optional \<^keyword>\<open>Attributes\<close> - |-- Scan.repeat (Parse.binding --| colon -- use_type - --| optional (Parse.$$$ ";")) - -- context - - datatype use_classDefinition = TOY_class | TOY_class_abstract - datatype ('a, 'b) use_classDefinition_content = TOY_class_content of 'a | TOY_class_synonym of 'b - - structure Outer_syntax_Class = struct - fun make from_expr abstract ty_object attribute oper = - META.Toy_class_raw_ext - ( ty_object - , From.list (From.pair From.binding I) attribute - , From.list (fn f => f from_expr) oper - , abstract - , ()) - end - - (* *) - - val term_object = parse_l_with ( optional ( Parse.$$$ "(" - |-- Parse.binding - --| Parse.$$$ "," - -- Parse.binding - --| Parse.$$$ ")" - --| (Parse.sym_ident >> (fn "|=" => Scan.succeed - | _ => Scan.fail ""))) - -- Parse.binding - -- ( Parse.$$$ "=" - |-- toy_term)) - - val list_attr' = term_object >> (fn res => (res, [] : binding list)) - fun object_cast e = - ( annot_ty term_object - -- Scan.repeat ( (Parse.sym_ident >> (fn "->" => Scan.succeed - | "\<leadsto>" => Scan.succeed - | "\<rightarrow>" => Scan.succeed - | _ => Scan.fail "")) - |-- ( Parse.reserved "toyAsType" - |-- Parse.$$$ "(" - |-- Parse.binding - --| Parse.$$$ ")" - || Parse.binding)) >> (fn ((res, x), l) => (res, rev (x :: l)))) e - val object_cast' = object_cast >> (fn (res, l) => (res, rev l)) - - fun get_toyinst l = - META.ToyInstance (map (fn ((name,typ), ((l_attr_with, l_attr), is_cast)) => - let val f = map (fn ((pre_post, attr), data) => - ( From.option (From.pair From.binding From.binding) pre_post - , ( From.binding attr - , data))) - val l_attr = - fold - (fn b => fn acc => META.ToyAttrCast (From.binding b, acc, [])) - is_cast - (META.ToyAttrNoCast (f l_attr)) in - META.Toy_instance_single_ext - ( From.option From.binding name - , From.option From.binding typ - , From.option From.binding l_attr_with - , l_attr - , ()) end) l) - - val parse_instance = (Parse.binding >> SOME) - -- optional (\<^keyword>\<open>::\<close> |-- Parse.binding) --| \<^keyword>\<open>=\<close> - -- (list_attr' || object_cast') - - (* *) - - datatype state_content = - ST_l_attr of (binding option * (((binding * binding) option * binding) * META.toy_data_shallow) list) * binding list - | ST_binding of binding - - val state_parse = parse_l' ( object_cast >> ST_l_attr - || Parse.binding >> ST_binding) - - val mk_state = - map (fn ST_l_attr l => - META.ToyDefCoreAdd - (case get_toyinst (map (fn (l_i, l_ty) => - ((NONE, SOME (hd l_ty)), (l_i, rev (tl l_ty)))) [l]) of - META.ToyInstance [x] => x) - | ST_binding b => META.ToyDefCoreBinding (From.binding b)) - - (* *) - - datatype state_pp_content = ST_PP_l_attr of state_content list - | ST_PP_binding of binding - - val state_pp_parse = state_parse >> ST_PP_l_attr - || Parse.binding >> ST_PP_binding - - val mk_pp_state = fn ST_PP_l_attr l => META.ToyDefPPCoreAdd (mk_state l) - | ST_PP_binding s => META.ToyDefPPCoreBinding (From.binding s) -end -\<close> - -subsection\<open>Setup of Meta Commands for a Generic Usage: @{command meta_command}, @{command meta_command'}\<close> - -ML\<open> -local - fun outer_syntax_commands'''2 command_keyword meta_command = - outer_syntax_commands''' SOME \<^mk_string> command_keyword "" - Parse.ML_source - (fn source => - get_thy \<^here> (meta_command (Input.source_content source) #> META.Fold_custom)) -in -val () = outer_syntax_commands'''2 \<^command_keyword>\<open>meta_command\<close> Bind_META.meta_command -val () = outer_syntax_commands'''2 \<^command_keyword>\<open>meta_command'\<close> Generation_mode.meta_command -end -\<close> - -subsection\<open>Setup of Meta Commands for Toy: @{command Enum}\<close> - -ML\<open> -val () = - outer_syntax_commands' \<^mk_string> \<^command_keyword>\<open>Enum\<close> "" - (Parse.binding -- parse_l1' Parse.binding) - (fn (n1, n2) => - K (META.META_enum (META.ToyEnum (From.binding n1, From.list From.binding n2)))) -\<close> - -subsection\<open>Setup of Meta Commands for Toy: (abstract) @{command Class}\<close> - -ML\<open> -local - open TOY_parse - - fun mk_classDefinition abstract cmd_spec = - outer_syntax_commands2 \<^mk_string> cmd_spec "Class generation" - ( Parse.binding --| Parse.$$$ "=" -- TOY_parse.type_base >> TOY_class_synonym - || type_object - -- class >> TOY_class_content) - (curry META.META_class_raw META.Floor1) - (curry META.META_class_raw META.Floor2) - (fn (from_expr, META_class_raw) => - fn TOY_class_content (ty_object, (attribute, oper)) => - META_class_raw (Outer_syntax_Class.make - from_expr - (abstract = TOY_class_abstract) - ty_object - attribute - oper) - | TOY_class_synonym (n1, n2) => - META.META_class_synonym (META.ToyClassSynonym (From.binding n1, n2))) -in -val () = mk_classDefinition TOY_class \<^command_keyword>\<open>Class\<close> -val () = mk_classDefinition TOY_class_abstract \<^command_keyword>\<open>Abstract_class\<close> -end -\<close> - -subsection\<open>Setup of Meta Commands for Toy: @{command Association}, @{command Composition}, @{command Aggregation}\<close> - -ML\<open> -local - open TOY_parse - - fun mk_associationDefinition ass_ty cmd_spec = - outer_syntax_commands' \<^mk_string> cmd_spec "" - ( repeat2 association_end - || optional Parse.binding - |-- association) - (K o META.META_association o Outer_syntax_Association.make ass_ty) -in -val () = mk_associationDefinition META.ToyAssTy_association \<^command_keyword>\<open>Association\<close> -val () = mk_associationDefinition META.ToyAssTy_composition \<^command_keyword>\<open>Composition\<close> -val () = mk_associationDefinition META.ToyAssTy_aggregation \<^command_keyword>\<open>Aggregation\<close> -end -\<close> - -subsection\<open>Setup of Meta Commands for Toy: (abstract) @{command Associationclass}\<close> - -ML\<open> - -local - open TOY_parse - - datatype use_associationClassDefinition = TOY_associationclass | TOY_associationclass_abstract - - fun mk_associationClassDefinition abstract cmd_spec = - outer_syntax_commands2 \<^mk_string> cmd_spec "" - ( type_object - -- association - -- class - -- optional (Parse.reserved "aggregation" || Parse.reserved "composition")) - (curry META.META_ass_class META.Floor1) - (curry META.META_ass_class META.Floor2) - (fn (from_expr, META_ass_class) => - fn (((ty_object, l_ass), (attribute, oper)), assty) => - META_ass_class - (META.ToyAssClass - ( Outer_syntax_Association.make - (case assty of SOME "aggregation" => META.ToyAssTy_aggregation - | SOME "composition" => META.ToyAssTy_composition - | _ => META.ToyAssTy_association) - l_ass - , Outer_syntax_Class.make - from_expr - (abstract = TOY_associationclass_abstract) - ty_object - attribute - oper))) -in -val () = mk_associationClassDefinition TOY_associationclass \<^command_keyword>\<open>Associationclass\<close> -val () = mk_associationClassDefinition TOY_associationclass_abstract \<^command_keyword>\<open>Abstract_associationclass\<close> -end -\<close> - -subsection\<open>Setup of Meta Commands for Toy: @{command Context}\<close> - -ML\<open> -local - open TOY_parse -in -val () = - outer_syntax_commands2 \<^mk_string> \<^command_keyword>\<open>Context\<close> "" - (optional (Parse.list1 Parse.binding --| colon) - -- Parse.binding - -- context) - (curry META.META_ctxt META.Floor1) - (curry META.META_ctxt META.Floor2) - (fn (from_expr, META_ctxt) => - (fn ((l_param, name), l) => - META_ctxt - (META.Toy_ctxt_ext - ( case l_param of NONE => [] | SOME l => From.list From.binding l - , META.ToyTyObj (META.ToyTyCore_pre (From.binding name), []) - , From.list (fn f => f from_expr) l - , ())))) -end -\<close> - -subsection\<open>Setup of Meta Commands for Toy: @{command End}\<close> - -ML\<open> -val () = - outer_syntax_commands'' \<^mk_string> \<^command_keyword>\<open>End\<close> "Class generation" - (Scan.optional ( Parse.$$$ "[" -- Parse.reserved "forced" -- Parse.$$$ "]" >> K true - || Parse.$$$ "!" >> K true) false) - (fn b => - K (if b then - META.Fold_meta (META.META_flush_all META.ToyFlushAll) - else - META.Fold_custom [])) -\<close> - -subsection\<open>Setup of Meta Commands for Toy: @{command BaseType}, @{command Instance}, @{command State}\<close> - -ML\<open> -val () = - outer_syntax_commands' \<^mk_string> \<^command_keyword>\<open>BaseType\<close> "" - (parse_l' TOY_parse.term_base) - (K o META.META_def_base_l o META.ToyDefBase) - -local - open TOY_parse -in -val () = - outer_syntax_commands' \<^mk_string> \<^command_keyword>\<open>Instance\<close> "" - (Scan.optional (parse_instance -- Scan.repeat (optional \<^keyword>\<open>and\<close> |-- parse_instance) >> - (fn (x, xs) => x :: xs)) []) - (K o META.META_instance o get_toyinst) - -val () = - outer_syntax_commands' \<^mk_string> \<^command_keyword>\<open>State\<close> "" - (TOY_parse.optional (paren \<^keyword>\<open>shallow\<close>) -- Parse.binding --| \<^keyword>\<open>=\<close> - -- state_parse) - (fn ((is_shallow, name), l) => - (K o META.META_def_state) - ( if is_shallow = NONE then META.Floor1 else META.Floor2 - , META.ToyDefSt (From.binding name, mk_state l))) -end -\<close> - -subsection\<open>Setup of Meta Commands for Toy: @{command Transition}\<close> - -ML\<open> -local - open TOY_parse -in -val () = - outer_syntax_commands' \<^mk_string> \<^command_keyword>\<open>Transition\<close> "" - (TOY_parse.optional (paren \<^keyword>\<open>shallow\<close>) - -- TOY_parse.optional (Parse.binding --| \<^keyword>\<open>=\<close>) - -- state_pp_parse - -- TOY_parse.optional state_pp_parse) - (fn (((is_shallow, n), s_pre), s_post) => - (K o META.META_def_transition) - ( if is_shallow = NONE then META.Floor1 else META.Floor2 - , META.ToyDefPP ( From.option From.binding n - , mk_pp_state s_pre - , From.option mk_pp_state s_post))) -end -\<close> - -subsection\<open>Setup of Meta Commands for Toy: @{command Tree}\<close> - -ML\<open> -local - open TOY_parse -in -val () = - outer_syntax_commands' \<^mk_string> \<^command_keyword>\<open>Tree\<close> "" - (natural -- natural) - (K o META.META_class_tree o META.ToyClassTree) -end -(*val _ = print_depth 100*) -\<close> -(*>*) -end diff --git a/Citadelle/src/compiler_generic/toy_example/embedding/Generator_static.thy b/Citadelle/src/compiler_generic/toy_example/embedding/Generator_static.thy deleted file mode 100644 index a7d6d78d0fca379375c6b4d743762fc1fa03856a..0000000000000000000000000000000000000000 --- a/Citadelle/src/compiler_generic/toy_example/embedding/Generator_static.thy +++ /dev/null @@ -1,107 +0,0 @@ -(****************************************************************************** - * Citadelle - * - * 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. - ******************************************************************************) - -text\<open>We present two solutions for obtaining an Isabelle file.\<close> - -section\<open>Static Meta Embedding with Exportation\<close> - -theory Generator_static -imports Printer -begin -(*<*) -ML_file "~~/src/Doc/antiquote_setup.ML" - -declare[[cartouche_type' = "abr_string"]] -(*>*) - -text \<open>In the ``static'' solution: the user manually generates -the Isabelle file after writing by hand a Toy input to translate. -The input is not written with the syntax of the Toy Language, -but with raw Isabelle constructors.\<close> - -subsection\<open>Giving an Input to Translate\<close> - -definition "Design = - (let n = \<lambda>n1 n2. ToyTyObj (ToyTyCore_pre n1) (case n2 of None \<Rightarrow> [] | Some n2 \<Rightarrow> [[ToyTyCore_pre n2]]) - ; mk = \<lambda>n l. toy_class_raw.make n l [] False in - [ mk (n \<open>Galaxy\<close> None) [(\<open>sound\<close>, ToyTy_raw \<open>unit\<close>), (\<open>moving\<close>, ToyTy_raw \<open>bool\<close>)] - , mk (n \<open>Planet\<close> (Some \<open>Galaxy\<close>)) [(\<open>weight\<close>, ToyTy_raw \<open>nat\<close>)] - , mk (n \<open>Person\<close> (Some \<open>Planet\<close>)) [(\<open>salary\<close>, ToyTy_raw \<open>int\<close>)] ])" - -text \<open>Since we are in a Isabelle session, at this time, it becomes possible to inspect with -the command @{command value} the result of the translations applied with @{term Design}. -A suitable environment should nevertheless be provided, -one can typically experiment this by copying-pasting the following environment -initialized below in @{text main}:\<close> - -definition "main = - (let n = \<lambda>n1. ToyTyObj (ToyTyCore_pre n1) [] - ; ToyMult = \<lambda>m r. toy_multiplicity.make [m] r [Set] in - write_file - (compiler_env_config.extend - (compiler_env_config_empty True None (oidInit (Oid 0)) Gen_only_design (None, False) - \<lparr> D_output_disable_thy := False - , D_output_header_thy := Some (\<open>Design_generated\<close> - ,[\<open>../Toy_Library\<close>] - ,\<open>../embedding/Generator_dynamic_sequential\<close>) \<rparr>) - ( L.map (META_class_raw Floor1) Design - @@@@ [ META_association (toy_association.make - ToyAssTy_association - (ToyAssRel [ (n \<open>Person\<close>, ToyMult (Mult_star, None) None) - , (n \<open>Person\<close>, ToyMult (Mult_nat 0, Some (Mult_nat 1)) (Some \<open>boss\<close>))])) - , META_flush_all ToyFlushAll] - , None)))" - -subsection\<open>Statically Executing the Exportation\<close> - -text\<open> -@{verbatim "apply_code_printing ()"} \\ -@{verbatim "export_code main"} \\ -@{verbatim " (* in Haskell *)"} \\ -@{verbatim " (* in OCaml module_name M *)"} \\ -@{verbatim " (* in Scala module_name M *)"} \\ -@{verbatim " (* in SML module_name M *)"} -\<close> - -text\<open>After the exportation and executing the exported, we obtain an Isabelle \verb|.thy| file -containing the generated code associated to the above input.\<close> - -end diff --git a/Citadelle/src/compiler_generic/toy_example/embedding/Init_rbt.thy b/Citadelle/src/compiler_generic/toy_example/embedding/Init_rbt.thy deleted file mode 100644 index 28de11e8bc1314e9a904476d696dc603991850bf..0000000000000000000000000000000000000000 --- a/Citadelle/src/compiler_generic/toy_example/embedding/Init_rbt.thy +++ /dev/null @@ -1,83 +0,0 @@ -(****************************************************************************** - * Citadelle - * - * 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. - ******************************************************************************) - -section\<open>Basic Extension of the Standard Library (Depending on RBT)\<close> - -theory Init_rbt -imports "../../Init" - "HOL-Library.RBT" - "HOL-Library.Char_ord" - "HOL-Library.List_Lexorder" - "HOL-Library.Product_Lexorder" -begin - -locale RBT -begin -definition "modify_def v k f rbt = - (case RBT.lookup rbt k of None \<Rightarrow> RBT.insert k (f v) rbt - | Some _ \<Rightarrow> RBT.map_entry k f rbt)" -definition "lookup2 rbt = (\<lambda>(x1, x2). Option.bind (RBT.lookup rbt x1) (\<lambda>rbt. RBT.lookup rbt x2))" -definition "insert2 = (\<lambda>(x1, x2) v. RBT.modify_def RBT.empty x1 (RBT.insert x2 v))" -end -lemmas [code] = - \<comment> \<open>def\<close> - RBT.modify_def_def - RBT.lookup2_def - RBT.insert2_def - -context L -begin -definition "unique f l = List.map_filter id (fst - (mapM - (\<lambda> (cpt, v) rbt. - let f_cpt = f cpt in - if RBT.lookup rbt f_cpt = None then - (Some (cpt, v), RBT.insert f_cpt () rbt) - else - (None, rbt)) - l - RBT.empty))" -end -lemmas [code] = - \<comment> \<open>def\<close> - L.unique_def - -end diff --git a/Citadelle/src/compiler_generic/toy_example/embedding/Printer.thy b/Citadelle/src/compiler_generic/toy_example/embedding/Printer.thy deleted file mode 100644 index 120431d92e552b7d69dad826824ce043dd076f13..0000000000000000000000000000000000000000 --- a/Citadelle/src/compiler_generic/toy_example/embedding/Printer.thy +++ /dev/null @@ -1,100 +0,0 @@ -(****************************************************************************** - * Citadelle - * - * 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. - ******************************************************************************) - -section\<open>Finalizing the Printer\<close> - -theory Printer -imports Core - "meta_toy/Printer_META" -begin - -definition "List_iterM f l = - List.fold (\<lambda>x m. bind m (\<lambda> () \<Rightarrow> f x)) l (return ())" - -context Print -begin - -declare[[cartouche_type' = "String.literal"]] - -definition "(write_file0 :: _ \<Rightarrow> (((_ \<Rightarrow> String.literal \<Rightarrow> _) \<Rightarrow> _) \<Rightarrow> _) \<times> _) env = - (let (l_thy, Sys_argv) = compiler_env_config.more env - ; (is_file, f_output) = case (D_output_header_thy env, Sys_argv) - of (Some (file_out, _), Some dir) \<Rightarrow> - let dir = To_string dir in - (True, \<lambda>f. bind (Sys_is_directory2 dir) (\<lambda> Sys_is_directory2_dir. - out_file1 f (if Sys_is_directory2_dir then sprint2 \<open>%s/%s.thy\<close>\<acute> dir (To_string file_out) else dir))) - | _ \<Rightarrow> (False, out_stand1) - ; (env, l) = - fold_thy'' - comp_env_save_deep - (\<lambda>f. f ()) - (\<lambda>_ _. []) - (\<lambda>_ x acc1 acc2. (acc1, Cons x acc2)) - (fst (compiler_env_config.more env)) - (compiler_env_config.truncate env, []) in - (f_output, of_all_meta_lists (compiler_env_config_more_map (\<lambda>_. is_file) env) (rev l)))" - -definition "write_file env = - (let (f_output, l) = write_file0 env in - f_output - (\<lambda>fprintf1. - List_iterM (fprintf1 \<open>%s -\<close> ) - l))" -end - -definition "print f = f String.meta_of_logic (ToNat integer_of_natural)" -definition "write_file0 = print Print.write_file0" -definition "write_file = print Print.write_file" - -lemmas [code] = - \<comment> \<open>def\<close> - Print.write_file0_def - Print.write_file_def - - \<comment> \<open>fun\<close> - -section\<open>Miscellaneous: Garbage Collection of Notations\<close> - -no_type_notation natural ("nat") -no_type_notation abr_string ("string") - -end diff --git a/Citadelle/src/compiler_generic/toy_example/embedding/core/Core_init.thy b/Citadelle/src/compiler_generic/toy_example/embedding/core/Core_init.thy deleted file mode 100644 index 0d1e25e500873770618d44e778c2b004e48780d5..0000000000000000000000000000000000000000 --- a/Citadelle/src/compiler_generic/toy_example/embedding/core/Core_init.thy +++ /dev/null @@ -1,333 +0,0 @@ -(****************************************************************************** - * Citadelle - * - * 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\<open>Translating Meta-Models\<close> -section\<open>General Environment for the Translation: Introduction\<close> - -theory Core_init -imports "../../Toy_Library_Static" - "../meta_toy/Meta_META" -begin - -text\<open>This file regroups common utilities used by the embedding functions of Toy in Isabelle.\<close> - -datatype opt_attr_type = OptInh | OptOwn -datatype opt_ident = OptIdent nat - -instantiation internal_oid :: linorder -begin - definition "n_of_internal_oid = (\<lambda> Oid n \<Rightarrow> n)" - definition "n \<le> m \<longleftrightarrow> n_of_internal_oid n \<le> n_of_internal_oid m" - definition "n < m \<longleftrightarrow> n_of_internal_oid n < n_of_internal_oid m" - instance - apply standard - apply (metis less_eq_internal_oid_def less_imp_le less_internal_oid_def not_less) - apply (metis less_eq_internal_oid_def order_refl) - apply (metis less_eq_internal_oid_def order.trans) - apply (simp add: less_eq_internal_oid_def n_of_internal_oid_def, case_tac x, case_tac y, simp) - by (metis le_cases less_eq_internal_oid_def) -end - - - -definition "var_oid_uniq = \<open>oid\<close>" -definition "var_deref_assocs_list = \<open>deref_assocs_list\<close>" -definition "var_inst_assoc = \<open>inst_assoc\<close>" -definition "var_choose = \<open>choose\<close>" -definition "var_switch = \<open>switch\<close>" -definition "var_assocs = \<open>assocs\<close>" -definition "var_map_of_list = \<open>map_of_list\<close>" -definition "var_self = \<open>self\<close>" -definition "var_result = \<open>result\<close>" - -datatype 'a tree = Tree 'a "'a tree list" - -fun make_tree -and make_tree' where - "make_tree l_pos nb_child deep = - Tree l_pos (case deep of 0 \<Rightarrow> [] - | Suc deep \<Rightarrow> make_tree' l_pos nb_child nb_child deep [])" - - | "make_tree' l_pos nb_child i deep l = - (case i of 0 \<Rightarrow> l - | Suc i \<Rightarrow> make_tree' l_pos nb_child i deep (make_tree (i # l_pos) nb_child deep # l))" - -definition "ident_fresh = (\<lambda>l (map, ident). - case RBT.lookup map l of None \<Rightarrow> (ident, (RBT.insert l ident map, Suc ident)) - | Some i \<Rightarrow> (i, (map, ident)))" - -definition "ident_empty = (RBT.empty, 0)" - -definition "ident_current = snd" - -fun fold_tree where - "fold_tree f t accu = - (case t of Tree _ [] \<Rightarrow> accu - | Tree x l \<Rightarrow> - List.fold - (fold_tree f) - l - (List.fold - (\<lambda>t accu. case t of Tree x' _ \<Rightarrow> f x x' accu) - l - accu))" - -datatype 'a class_output = C_out_ToyAny | C_out_simple 'a - -definition "mk_tree nb_child deep n_init = - (let (l, map) = - fold_tree - (\<lambda> l1 l2 (l, map). - let (n1, map) = ident_fresh l1 map - ; (n2, map) = ident_fresh l2 map in - ((if n1 = 0 then - C_out_ToyAny - else - C_out_simple (String.nat_to_digit26 (n1 + n_init)), String.nat_to_digit26 (n2 + n_init)) # l, map)) - (make_tree [] nb_child deep) - ([], ident_empty) in - (rev l, n_init + ident_current map - 1))" - -definition "find_class_ass env = - (let (l_tree, l_all_meta) = - partition (\<lambda> META_class_tree _ \<Rightarrow> True - | _ \<Rightarrow> False) (rev (D_input_meta env)) - ; (l_class, l_all_meta) = - partition (let f = \<lambda>class. ClassRaw_clause class = [] in - \<lambda> META_class_raw Floor1 class \<Rightarrow> f class - | META_association _ \<Rightarrow> True - | META_ass_class Floor1 (ToyAssClass _ class) \<Rightarrow> f class - | META_class_synonym _ \<Rightarrow> True - | _ \<Rightarrow> False) (l_all_meta) in - ( L.flatten [ \<comment> \<open>generate a set of \<open>Class\<close> from \<open>Tree _ _\<close>\<close> - L.map (let mk = \<lambda>n1 n2. - META_class_raw Floor1 (toy_class_raw.make - (ToyTyObj (ToyTyCore_pre n1) - (case n2 of None \<Rightarrow> [] - | Some n2 \<Rightarrow> [[ToyTyCore_pre n2]])) - [] - [] - False) in - \<lambda> (C_out_ToyAny, s) \<Rightarrow> mk s None - | (C_out_simple s1, s2) \<Rightarrow> mk s2 (Some s1)) - (concat (fst (L.mapM (\<lambda> META_class_tree (ToyClassTree n1 n2) \<Rightarrow> - mk_tree (nat_of_natural n1) (nat_of_natural n2)) - l_tree - 0))) - , l_class - , List.map_filter (let f = \<lambda>class. class \<lparr> ClassRaw_clause := [] \<rparr> in - \<lambda> META_class_raw Floor1 c \<Rightarrow> Some (META_class_raw Floor1 (f c)) - | META_ass_class Floor1 (ToyAssClass ass class) \<Rightarrow> Some (META_ass_class Floor1 (ToyAssClass ass (f class))) - | _ \<Rightarrow> None) l_all_meta ] - , L.flatten (L.map - (let f = \<lambda>class. [ META_ctxt Floor1 (toy_ctxt_ext [] (ClassRaw_name class) (ClassRaw_clause class) ()) ] in - \<lambda> META_class_raw Floor1 class \<Rightarrow> f class - | META_ass_class Floor1 (ToyAssClass _ class) \<Rightarrow> f class - | x \<Rightarrow> [x]) l_all_meta)))" - -definition "map_enum_syn l_enum l_syn = - (\<lambda> ToyTy_object (ToyTyObj (ToyTyCore_pre s) []) \<Rightarrow> - if list_ex (\<lambda>syn. s \<triangleq> (case syn of ToyClassSynonym n _ \<Rightarrow> n)) l_syn then - ToyTy_class_syn s - else if list_ex (\<lambda>enum. s \<triangleq> (case enum of ToyEnum n _ \<Rightarrow> n)) l_enum then - ToyTy_enum s - else - ToyTy_object (ToyTyObj (ToyTyCore_pre s) []) - | x \<Rightarrow> x)" - -definition "arrange_ass with_aggreg with_optim_ass l_c l_enum = - (let l_syn = List.map_filter (\<lambda> META_class_synonym e \<Rightarrow> Some e - | _ \<Rightarrow> None) l_c - ; l_class = List.map_filter (\<lambda> META_class_raw Floor1 cflat \<Rightarrow> Some cflat - | META_ass_class Floor1 (ToyAssClass _ cflat) \<Rightarrow> Some cflat - | _ \<Rightarrow> None) l_c - ; l_class = \<comment> \<open>map classes: change the (enumeration) type of every attributes to \<open>raw\<close>\<close> - \<comment> \<open>instead of the default \<open>object\<close> type\<close> - L.map - (\<lambda> cflat \<Rightarrow> - cflat \<lparr> ClassRaw_own := - L.map (map_prod id (map_enum_syn l_enum l_syn)) - (ClassRaw_own cflat) \<rparr>) l_class - ; l_ass = List.map_filter (\<lambda> META_association ass \<Rightarrow> Some ass - | META_ass_class Floor1 (ToyAssClass ass _) \<Rightarrow> Some ass - | _ \<Rightarrow> None) l_c - ; ToyMult = \<lambda>l set. toy_multiplicity_ext l None set () - ; (l_class, l_ass0) = - if with_optim_ass then - \<comment> \<open>move from classes to associations:\<close> - \<comment> \<open>attributes of object types\<close> - \<comment> \<open>+ those constructed with at most 1 recursive call to \<open>ToyTy_collection\<close>\<close> - map_prod rev rev (List.fold - (\<lambda>c (l_class, l_ass). - let default = [Set] - ; f = \<lambda>role t mult_out. \<lparr> ToyAss_type = ToyAssTy_native_attribute - , ToyAss_relation = ToyAssRel [(ClassRaw_name c, ToyMult [(Mult_star, None)] default) - ,(t, mult_out \<lparr> TyRole := Some role \<rparr>)] \<rparr> - ; (l_own, l_ass) = - List.fold (\<lambda> (role, ToyTy_object t) \<Rightarrow> - \<lambda> (l_own, l). (l_own, f role t (ToyMult [(Mult_nat 0, Some (Mult_nat 1))] default) # l) - | (role, ToyTy_collection mult (ToyTy_object t)) \<Rightarrow> - \<lambda> (l_own, l). (l_own, f role t mult # l) - | x \<Rightarrow> \<lambda> (l_own, l). (x # l_own, l)) - (ClassRaw_own c) - ([], l_ass) in - (c \<lparr> ClassRaw_own := rev l_own \<rparr> # l_class, l_ass)) - l_class - ([], [])) - else - (l_class, []) - ; (l_class, l_ass) = - if with_aggreg then - \<comment> \<open>move from associations to classes:\<close> - \<comment> \<open>attributes of aggregation form\<close> - map_prod rev rev (List.fold - (\<lambda>ass (l_class, l_ass). - if ToyAss_type ass = ToyAssTy_aggregation then - ( fold_max - (\<lambda> (cpt_to, (name_to, category_to)). - case TyRole category_to of - Some role_to \<Rightarrow> - List.fold (\<lambda> (cpt_from, (name_from, multip_from)). - L.map_find (\<lambda>cflat. - if cl_name_to_string cflat \<triangleq> ty_obj_to_string name_from then - Some (cflat \<lparr> ClassRaw_own := - L.flatten [ ClassRaw_own cflat - , [(role_to, let ty = ToyTy_object name_to in - if single_multip category_to then - ty - else - ToyTy_collection category_to ty)]] \<rparr>) - else None)) - | _ \<Rightarrow> \<lambda>_. id) - (ToyAss_relation' ass) - l_class - , l_ass) - else - (l_class, ass # l_ass)) l_ass (l_class, [])) - else - (l_class, l_ass) in - ( l_class - , L.flatten [l_ass, l_ass0]))" - -definition "datatype_name = \<open>ty\<close>" -definition "datatype_ext_name = datatype_name @@ \<open>\<E>\<X>\<T>\<close>" -definition "datatype_constr_name = \<open>mk\<close>" -definition "datatype_ext_constr_name = datatype_constr_name @@ \<open>\<E>\<X>\<T>\<close>" -definition "datatype_in = \<open>in\<close>" - -subsection\<open>Main Combinators for the Translation\<close> - -text\<open> -As general remark, all the future translating steps -(e.g., that will occur in @{file "Floor1_access.thy"}) -will extensively use Isabelle expressions, -represented by its Meta-Model, for example lots of functions will use @{term "Term_app"}... -So the overall can be simplified by the use of polymorphic cartouches. -It looks feasible to add a new front-end for cartouches in @{theory "Isabelle_Meta_Model.Init"} -supporting the use of Isabelle syntax in cartouches, -then we could obtain at the end a parsed Isabelle Meta-Model in Isabelle.\<close> - -definition "start_map f = L.mapM (\<lambda>x acc. (f x, acc))" -definition "start_map' f x accu = (f x, accu)" -definition "start_map''' f fl = (\<lambda> env. - let design_analysis = D_toy_semantics env - ; base_attr = (if design_analysis = Gen_only_design then id else L.filter (\<lambda> (_, ToyTy_object (ToyTyObj (ToyTyCore _) _)) \<Rightarrow> False | _ \<Rightarrow> True)) - ; base_attr' = (\<lambda> (l_attr, l_inh). (base_attr l_attr, L.map base_attr l_inh)) - ; base_attr'' = (\<lambda> (l_attr, l_inh). (base_attr l_attr, base_attr l_inh)) in - start_map f (fl design_analysis base_attr base_attr' base_attr'') env)" -definition "start_map'' f fl e = start_map''' f (\<lambda>_. fl) e" -definition "start_map'''' f fl = (\<lambda> env. start_map f (fl (D_toy_semantics env)) env)" - -definition "prev_was_stop = (\<lambda> [] \<Rightarrow> True | x # _ \<Rightarrow> ignore_meta_header x)" - -fun collect_meta_embed where - "collect_meta_embed accu e = - (\<lambda> (True, _) \<Rightarrow> rev accu - | (_, []) \<Rightarrow> rev accu - | (_, x # l_meta) \<Rightarrow> collect_meta_embed (x # accu) (prev_was_stop l_meta, l_meta)) e" - -definition "bootstrap_floor l env = - (let l_setup = \<lambda>f. META_boot_setup_env (Boot_setup_env (f env \<lparr> D_output_disable_thy := True - , D_output_header_thy := None \<rparr>)) - # l in - ( if D_output_auto_bootstrap env then - if prev_was_stop (D_input_meta env) then - l - else - l_setup (\<lambda>env. compiler_env_config_reset_no_env env - \<lparr> D_input_meta := collect_meta_embed [] (False, D_input_meta env) \<rparr>) - else - META_boot_generation_syntax (Boot_generation_syntax (D_toy_semantics env)) - # l_setup id - , env \<lparr> D_output_auto_bootstrap := True \<rparr> ))" - -definition "wrap_toyty x = \<open>\<cdot>\<close> @@ x" -definition "Term_annot_toy e s = Term_annot' e (wrap_toyty s)" -definition "Term_toyset l = (case l of [] \<Rightarrow> Term_basic [\<open>Set{}\<close>] | _ \<Rightarrow> Term_paren \<open>Set{\<close> \<open>}\<close> (term_binop \<open>,\<close> l))" -definition "Term_oid s = (\<lambda>Oid n \<Rightarrow> Term_basic [s @@ String.natural_to_digit10 n])" - -subsection\<open>Preliminaries on: Enumeration\<close> - -subsection\<open>Preliminaries on: Infrastructure\<close> - -subsection\<open>Preliminaries on: Accessor\<close> - -definition "print_access_oid_uniq_name' name_from_nat isub_name attr = S.flatten [ isub_name var_oid_uniq, \<open>_\<close>, String.natural_to_digit10 name_from_nat, \<open>_\<close>, attr ]" -definition "print_access_oid_uniq_name name_from_nat isub_name attr = print_access_oid_uniq_name' name_from_nat isub_name (String.isup attr)" - -definition "print_access_choose_name n i j = - S.flatten [var_switch, String.isub (String.natural_to_digit10 n), \<open>_\<close>, String.natural_to_digit10 i, String.natural_to_digit10 j]" - -subsection\<open>Preliminaries on: Example (Floor 1)\<close> - -datatype reporting = Warning - | Error - | Writeln - -subsection\<open>Preliminaries on: Example (Floor 2)\<close> - -subsection\<open>Preliminaries on: Context\<close> - -definition "make_ctxt_free_var pref ctxt = - (var_self # L.flatten [ L.map fst (Ctxt_fun_ty_arg ctxt) - , if pref = ToyCtxtPre then [] else [var_result] ])" - -end diff --git a/Citadelle/src/compiler_generic/toy_example/embedding/core/Floor1_access.thy b/Citadelle/src/compiler_generic/toy_example/embedding/core/Floor1_access.thy deleted file mode 100644 index 6a2364fc560e2a329b14ce113ac7d527ec6fea41..0000000000000000000000000000000000000000 --- a/Citadelle/src/compiler_generic/toy_example/embedding/core/Floor1_access.thy +++ /dev/null @@ -1,127 +0,0 @@ -(****************************************************************************** - * HOL-TOY - * - * 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. - ******************************************************************************) - -section\<open>Main Translation for: Accessor\<close> - -theory Floor1_access -imports Core_init -begin - -definition "print_access_oid_uniq_gen Thy_def D_toy_oid_start_upd def_rewrite = - (\<lambda>expr env. - (\<lambda>(l, oid_start). (L.map Thy_def l, D_toy_oid_start_upd env oid_start)) - (let (l, (acc, _)) = fold_class (\<lambda>isub_name name l_attr l_inh _ _ cpt. - let l_inh = L.map (\<lambda> ToyClass _ l _ \<Rightarrow> l) (of_inh l_inh) in - let (l, cpt) = L.mapM (L.mapM - (\<lambda> (attr, ToyTy_object (ToyTyObj (ToyTyCore ty_obj) _)) \<Rightarrow> - (let obj_oid = TyObj_ass_id ty_obj - ; obj_name_from_nat = TyObjN_ass_switch (TyObj_from ty_obj) in \<lambda>(cpt, rbt) \<Rightarrow> - let (cpt_obj, cpt_rbt) = - case RBT.lookup rbt obj_oid of - None \<Rightarrow> (cpt, oidSucAssoc cpt, RBT.insert obj_oid cpt rbt) - | Some cpt_obj \<Rightarrow> (cpt_obj, cpt, rbt) in - ( [def_rewrite obj_name_from_nat name isub_name attr (oidGetAssoc cpt_obj)] - , cpt_rbt)) - | _ \<Rightarrow> \<lambda>cpt. ([], cpt))) - (l_attr # l_inh) cpt in - (L.flatten (L.flatten l), cpt)) (D_toy_oid_start env, RBT.empty) expr in - (L.flatten l, acc)))" -definition "print_access_oid_uniq = - print_access_oid_uniq_gen - O.definition - (\<lambda>env oid_start. env \<lparr> D_toy_oid_start := oid_start \<rparr>) - (\<lambda>obj_name_from_nat _ isub_name attr cpt_obj. - Definition (Term_rewrite - (Term_basic [print_access_oid_uniq_name obj_name_from_nat isub_name attr]) - \<open>=\<close> - (Term_oid \<open>\<close> cpt_obj)))" - -definition "print_access_choose_switch - lets mk_var expr - print_access_choose_n - sexpr_list sexpr_function sexpr_pair = - L.flatten - (L.map - (\<lambda>n. - let l = L.upto 0 (n - 1) in - L.map (let l = sexpr_list (L.map mk_var l) in (\<lambda>(i,j). - (lets - (print_access_choose_n n i j) - (sexpr_function [(l, (sexpr_pair (mk_var i) (mk_var j)))])))) - ((L.flatten o L.flatten) (L.map (\<lambda>i. L.map (\<lambda>j. if i = j then [] else [(i, j)]) l) l))) - (class_arity expr))" -definition "print_access_choose = start_map'''' O.definition o (\<lambda>expr _. - (let a = \<lambda>f x. Term_app f [x] - ; b = \<lambda>s. Term_basic [s] - ; lets = \<lambda>var exp. Definition (Term_rewrite (Term_basic [var]) \<open>=\<close> exp) - ; lets' = \<lambda>var exp. Definition (Term_rewrite (Term_basic [var]) \<open>=\<close> (b exp)) - ; lets'' = \<lambda>var exp. Definition (Term_rewrite (Term_basic [var]) \<open>=\<close> (Term_lam \<open>l\<close> (\<lambda>var_l. Term_binop (b var_l) \<open>!\<close> (b exp)))) - ; _\<comment> \<open>(ignored)\<close> = - let l_flatten = \<open>L.flatten\<close> in - [ lets l_flatten (let fun_foldl = \<lambda>f base. - Term_lam \<open>l\<close> (\<lambda>var_l. Term_app \<open>foldl\<close> [Term_lam \<open>acc\<close> f, base, a \<open>rev\<close> (b var_l)]) in - fun_foldl (\<lambda>var_acc. - fun_foldl (\<lambda>var_acc. - Term_lam \<open>l\<close> (\<lambda>var_l. Term_app \<open>Cons\<close> (L.map b [var_l, var_acc]))) (b var_acc)) (b \<open>Nil\<close>)) - , lets var_map_of_list (Term_app \<open>foldl\<close> - [ Term_lam \<open>map\<close> (\<lambda>var_map. - let var_x = \<open>x\<close> - ; var_l0 = \<open>l0\<close> - ; var_l1 = \<open>l1\<close> - ; f_map = a var_map in - Term_lambdas0 (Term_pair (b var_x) (b var_l1)) - (Term_case (f_map (b var_x)) - (L.map (\<lambda>(pat, e). (pat, f_map (Term_binop (b var_x) \<open>\<mapsto>\<close> e))) - [ (b \<open>None\<close>, b var_l1) - , (Term_some (b var_l0), a l_flatten (Term_list (L.map b [var_l0, var_l1])))]))) - , b \<open>Map.empty\<close>])] in - L.flatten - [ let a = \<lambda>f x. Term_app f [x] - ; b = \<lambda>s. Term_basic [s] - ; lets = \<lambda>var exp. Definition (Term_rewrite (Term_basic [var]) \<open>=\<close> exp) - ; mk_var = \<lambda>i. b (S.flatten [\<open>x\<close>, String.natural_to_digit10 i]) in - print_access_choose_switch - lets mk_var expr - print_access_choose_name - Term_list Term_function Term_pair - , []] ))" - -end diff --git a/Citadelle/src/compiler_generic/toy_example/embedding/core/Floor1_ctxt.thy b/Citadelle/src/compiler_generic/toy_example/embedding/core/Floor1_ctxt.thy deleted file mode 100644 index 4b4965160899ac8abf039762325bd2d1f1d38908..0000000000000000000000000000000000000000 --- a/Citadelle/src/compiler_generic/toy_example/embedding/core/Floor1_ctxt.thy +++ /dev/null @@ -1,62 +0,0 @@ -(****************************************************************************** - * HOL-TOY - * - * 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. - ******************************************************************************) - -section\<open>Main Translation for: Context\<close> - -theory Floor1_ctxt -imports Core_init -begin - -definition "print_ctxt_const _ env = - (map_prod (map_prod id (rev o L.map O.type_synonym)) (rev o L.map O.consts) - ((env, []), []))" - -definition "print_ctxt = (\<lambda>ctxt. (\<lambda>f x e. let (l, e) = f x e in bootstrap_floor l e) - (\<lambda>l env. - let ((env, l_isab_ty), l_isab) = print_ctxt_const ctxt env in - (L.flatten [l_isab_ty, l_isab, l], env)) - [ META_all_meta_embedding (META_ctxt Floor2 - (map_invariant (\<lambda>T_inv b (ToyProp_ctxt n p) \<Rightarrow> - T_inv b (ToyProp_ctxt n (T_lambdas (Ctxt_param ctxt @@@@ [var_self]) p))) - (map_pre_post (\<lambda>pref ctxt. T_lambdas (make_ctxt_free_var pref ctxt)) - ctxt))) ])" - -end diff --git a/Citadelle/src/compiler_generic/toy_example/embedding/core/Floor1_examp.thy b/Citadelle/src/compiler_generic/toy_example/embedding/core/Floor1_examp.thy deleted file mode 100644 index 98f503e51833dda0c9d1b3cafdbc419fde56bf08..0000000000000000000000000000000000000000 --- a/Citadelle/src/compiler_generic/toy_example/embedding/core/Floor1_examp.thy +++ /dev/null @@ -1,332 +0,0 @@ -(****************************************************************************** - * HOL-TOY - * - * 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. - ******************************************************************************) - -section\<open>Main Translation for: Example (Floor 1)\<close> - -theory Floor1_examp -imports Core_init -begin - -definition "rbt_of_class env = - (let rbt = (snd o fold_class_gen (\<lambda>_ name l_attr l_inh _ _ rbt. - ( [()] - , modify_def (RBT.empty, []) name - (let f_fold = \<lambda>tag l rbt. - let (rbt, _, n) = List.fold - (\<lambda> (name_attr, ty) \<Rightarrow> \<lambda>(rbt, cpt, l_obj). - (insert name_attr (ty, tag, OptIdent cpt) rbt, Succ cpt, (case ty of ToyTy_object (ToyTyObj (ToyTyCore ty_obj) _) \<Rightarrow> Some ty_obj | _ \<Rightarrow> None) # l_obj)) - l - (rbt, 0, []) in - (rbt, (tag, n)) in - (\<lambda>(rbt, _). - let (rbt, info_own) = f_fold OptOwn l_attr rbt in - let (rbt, info_inh) = f_fold OptInh (L.flatten (map_class_inh l_inh)) rbt in - (rbt, [info_own, info_inh]))) - rbt)) RBT.empty) (case D_input_class env of Some c \<Rightarrow> c) in - (\<lambda>name. - let rbt = lookup rbt name in - ( rbt = None - , \<lambda> name_attr. - Option.bind rbt (\<lambda>(rbt, _). lookup rbt name_attr) - , \<lambda> v. Option.bind rbt (\<lambda>(_, l). - map_option (\<lambda>l f accu. - let (_, accu) = - List.fold - (let f_fold = \<lambda>b (n, accu). (Succ n, f b n accu) in - if D_toy_semantics env = Gen_only_design then - f_fold - else - \<lambda> Some _ \<Rightarrow> (\<lambda>(n, accu). (Succ n, accu)) - | None \<Rightarrow> f_fold None) (rev l) (0, accu) in - accu) (L.assoc v l)))))" - -definition "inst_name toyi = (case Inst_name toyi of Some n \<Rightarrow> n)" - -definition "init_map_class env l = - (let (rbt_nat, rbt_str, _, _) = - List.fold - (\<lambda> toyi (rbt_nat, rbt_str, oid_start, accu). - let f = \<lambda>_. - ( RBT.insert (Oid accu) oid_start rbt_nat - , insert (inst_name toyi) oid_start rbt_str - , oidSucInh oid_start - , Succ accu) in - case Inst_attr_with toyi of - None \<Rightarrow> f () - | Some s \<Rightarrow> - (case lookup rbt_str s of None \<Rightarrow> f () - | Some oid_start' \<Rightarrow> - ( RBT.insert (Oid accu) oid_start' rbt_nat - , insert (inst_name toyi) oid_start' rbt_str - , oid_start - , Succ accu))) - l - ( RBT.empty - , RBT.bulkload (L.map (\<lambda>(k, _, v). (String\<^sub>b\<^sub>a\<^sub>s\<^sub>e.to_list k, v)) (D_input_instance env)) - , D_toy_oid_start env - , 0) in - (rbt_of_class env, RBT.lookup rbt_nat, lookup rbt_str))" - -definition "print_examp_def_st_assoc_build_rbt_gen f rbt map_self map_username l_assoc = - List.fold - (\<lambda> (toyi, cpt). fold_instance_single - (\<lambda> ty l_attr. - let (f_attr_ty, _) = rbt ty in - f ty - (List.fold (\<lambda>(_, name_attr, shall). - case f_attr_ty name_attr of - Some (ToyTy_object (ToyTyObj (ToyTyCore ty_obj) _), _, _) \<Rightarrow> - modify_def ([], ty_obj) name_attr - (\<lambda>(l, accu). case let find_map = \<lambda> ShallB_str s \<Rightarrow> map_username s | ShallB_self s \<Rightarrow> map_self s | _ \<Rightarrow> None in - case shall of - ShallB_list l \<Rightarrow> if list_ex (\<lambda>x. find_map x = None) l then - None - else - Some (List.map_filter find_map l) - | _ \<Rightarrow> map_option (\<lambda>x. [x]) (find_map shall) of - None \<Rightarrow> (l, accu) - | Some oid \<Rightarrow> (L.map (L.map oidGetInh) [[cpt], oid] # l, accu)) - | _ \<Rightarrow> id) l_attr)) toyi) l_assoc RBT.empty" - -definition "print_examp_def_st_assoc_build_rbt = print_examp_def_st_assoc_build_rbt_gen (modify_def RBT.empty)" - -definition "print_examp_def_st_assoc rbt map_self map_username l_assoc = - (let b = \<lambda>s. Term_basic [s] - ; rbt = print_examp_def_st_assoc_build_rbt rbt map_self map_username l_assoc in - Term_app var_map_of_list [Term_list (fold (\<lambda>name. fold (\<lambda>name_attr (l_attr, ty_obj) l_cons. - let cpt_from = TyObjN_ass_switch (TyObj_from ty_obj) in - Term_pair - (Term_basic [print_access_oid_uniq_name cpt_from (\<lambda>s. s @@ String.isub name) name_attr]) - (Term_app \<open>List.map\<close> - [ Term_binop (let var_x = \<open>x\<close> - ; var_y = \<open>y\<close> in - Term_lambdas0 - (Term_pair (b var_x) (b var_y)) - (Term_list [b var_x, b var_y])) - \<open>o\<close> - (b (print_access_choose_name - (TyObj_ass_arity ty_obj) - cpt_from - (TyObjN_ass_switch (TyObj_to ty_obj)))) - , Term_list' (Term_list' (Term_list' (Term_oid var_oid_uniq))) l_attr ]) - # l_cons)) rbt [])])" - -definition "print_examp_instance_oid thy_definition_hol l env = (L.map thy_definition_hol o L.flatten) - (let (f1, f2) = (\<lambda> var_oid _ _. var_oid, \<lambda> _ _ cpt. Term_oid \<open>\<close> (oidGetInh cpt)) in - L.map (\<lambda> (toyi, cpt). - if List.fold (\<lambda>(_, _, cpt0) b. b | oidGetInh cpt0 = oidGetInh cpt) (D_input_instance env) False then - [] - else - let var_oid = Term_oid var_oid_uniq (oidGetInh cpt) - ; isub_name = \<lambda>s. s @@ String.isub (inst_ty toyi) in - [Definition (Term_rewrite (f1 var_oid isub_name toyi) \<open>=\<close> (f2 toyi isub_name cpt))]) l)" - -definition "check_export_code f_writeln f_warning f_error f_raise l_report msg_last = - (let l_err = - List.fold - (\<lambda> (Writeln, s) \<Rightarrow> \<lambda>acc. case f_writeln s of () \<Rightarrow> acc - | (Warning, s) \<Rightarrow> \<lambda>acc. case f_warning s of () \<Rightarrow> acc - | (Error, s) \<Rightarrow> \<lambda>acc. case f_error s of () \<Rightarrow> s # acc) - l_report - [] in - if l_err = [] then - () - else - f_raise (String.nat_to_digit10 (length l_err) @@ msg_last))" - -definition "print_examp_instance_defassoc_gen name l_toyi env = - (case D_toy_semantics env of Gen_only_analysis \<Rightarrow> \<lambda>_. [] | Gen_default \<Rightarrow> \<lambda>_. [] | Gen_only_design \<Rightarrow> - \<lambda>(rbt, (map_self, map_username)). - let a = \<lambda>f x. Term_app f [x] - ; b = \<lambda>s. Term_basic [s] - ; l_toyi = if list_ex (\<lambda>(toyi, _). inst_ty0 toyi = None) l_toyi then [] else l_toyi in - [Definition - (Term_rewrite name - \<open>=\<close> - (let var_oid_class = \<open>oid_class\<close> - ; var_to_from = \<open>to_from\<close> - ; var_oid = \<open>oid\<close> - ; a_l = \<lambda>s. Typ_apply (Typ_base var_ty_list) [s] in - Term_lambdas - [var_oid_class, var_to_from, var_oid] - (Term_annot (Term_case - (Term_app var_deref_assocs_list - [ Term_annot (b var_to_from) (Ty_arrow - (a_l (a_l (Typ_base const_oid))) - (let t = a_l (Typ_base const_oid) in - Ty_times t t)) - , Term_annot' (b var_oid) const_oid - , a \<open>the\<close> - (Term_applys (print_examp_def_st_assoc (snd o rbt) map_self map_username l_toyi) - [Term_annot' (b var_oid_class) const_oid])]) - [ (b \<open>Nil\<close>, b \<open>None\<close>) - , let b_l = b \<open>l\<close> in - (b_l, a \<open>Some\<close> b_l)] ) (Typ_apply (Typ_base \<open>option\<close>) [a_l (Typ_base const_oid)]))))])" - -definition "mk_instance_single_cpt0 map_username l env = - (let (l, cpt) = - L.mapM (\<lambda>toyi cpt. case Inst_attr_with toyi of - None \<Rightarrow> ([(toyi, cpt)], oidSucInh cpt) - | Some n \<Rightarrow> - (case map_username n of None \<Rightarrow> ([(toyi, cpt)], oidSucInh cpt) - | Some cpt' \<Rightarrow> ([(toyi, cpt')], cpt))) - l - (D_toy_oid_start env) in - (L.flatten l, cpt))" - -definition "mk_instance_single_cpt map_username l = - fst o mk_instance_single_cpt0 map_username l" - -definition "print_examp_instance_defassoc = (\<lambda> ToyInstance l \<Rightarrow> \<lambda> env. - let (rbt :: _ \<Rightarrow> _ \<times> _ \<times> (_ \<Rightarrow> ((_ \<Rightarrow> natural \<Rightarrow> _ \<Rightarrow> (toy_ty \<times> toy_data_shallow) option list) \<Rightarrow> _ \<Rightarrow> _) option) - , (map_self, map_username)) = init_map_class env l - ; l = mk_instance_single_cpt map_username l env in - (\<lambda>l_res. - ( print_examp_instance_oid O.definition l env - @@@@ L.map O.definition l_res - , env)) - (print_examp_instance_defassoc_gen - (Term_oid var_inst_assoc (oidGetInh (D_toy_oid_start env))) - l - env - (rbt, (map_self, map_username))))" - -definition "print_examp_instance_name = id" -definition "print_examp_instance = (\<lambda> ToyInstance l \<Rightarrow> \<lambda> env. - (\<lambda> ((l_res, oid_start), instance_rbt). - ((L.map O.definition o L.flatten) l_res, env \<lparr> D_toy_oid_start := oid_start, D_input_instance := instance_rbt \<rparr>)) - (let ( rbt :: _ \<Rightarrow> _ \<times> _ \<times> (_ \<Rightarrow> ((_ \<Rightarrow> nat \<Rightarrow> _ \<Rightarrow> _) \<Rightarrow> _ \<Rightarrow> - (toy_ty_class option \<times> - (toy_ty \<times> (string \<times> string) option \<times> toy_data_shallow) option) list) option) - , (map_self, map_username)) = init_map_class env l - ; a = \<lambda>f x. Term_app f [x] - ; b = \<lambda>s. Term_basic [s] in - ( let var_inst_ass = \<open>inst_assoc\<close> in - map_prod - (L.map (\<lambda> _. [])) - id - (mk_instance_single_cpt0 map_username l env) - , let l_id = L.mapi (\<lambda>i toyi. (i, inst_name toyi)) l in - List.fold - (\<lambda>toyi instance_rbt. - let n = inst_name toyi in - ( String.to_String\<^sub>b\<^sub>a\<^sub>s\<^sub>e n - , map_inst_single_self (\<lambda>Oid self \<Rightarrow> - case L.assoc self l_id of - Some name \<Rightarrow> ShallB_str name - | _ \<Rightarrow> ShallB_list []) - toyi - , case map_username n of Some oid \<Rightarrow> oid) - # instance_rbt) - l - (D_input_instance env))))" - -definition "print_examp_def_st0 name l = - (let (l, _) = List.fold (\<lambda> (pos, core) (l, n). - ((pos, pos - n, core) # l, - case core of ToyDefCoreAdd _ \<Rightarrow> n - | ToyDefCoreBinding _ \<Rightarrow> Succ n)) - (L.mapi Pair l) - ([], 0) in - List.fold (\<lambda> (pos, _, ToyDefCoreAdd toyi) \<Rightarrow> \<lambda>(l_inst, l_defst). - let i_name = case Inst_name toyi of Some x \<Rightarrow> x | None \<Rightarrow> S.flatten [name, \<open>_object\<close>, String.natural_to_digit10 pos] in - ( map_inst_single_self (\<lambda>Oid self \<Rightarrow> - (case L.assoc self l of - Some (_, ToyDefCoreBinding name) \<Rightarrow> ShallB_str name - | Some (p, _) \<Rightarrow> ShallB_self (Oid p) - | _ \<Rightarrow> ShallB_list [])) toyi - \<lparr> Inst_name := Some i_name \<rparr> - # l_inst - , ToyDefCoreBinding i_name # l_defst) - | (_, _, ToyDefCoreBinding name) \<Rightarrow> \<lambda>(l_inst, l_defst). - ( l_inst - , ToyDefCoreBinding name # l_defst)) - l - ([], []))" - -definition "print_examp_increase_oid l_inst = - snd o print_examp_instance (ToyInstance l_inst)" - -definition "bootstrap_floor' f_x l env = - (let (l, accu :: compiler_env_config \<Rightarrow> _) = f_x l env in - (bootstrap_floor l env, accu))" - -definition "print_examp_def_st1_gen = (\<lambda> ToyDefSt name l \<Rightarrow> bootstrap_floor' - (\<lambda>(l, accu) _. (L.flatten [L.map META_all_meta_embedding l], accu)) - (let (l_inst, l_defst) = print_examp_def_st0 name l - ; l = [ META_def_state Floor2 (ToyDefSt name l_defst) ] in - if l_inst = [] then - (l, id) - else - (META_instance (ToyInstance l_inst) # l, print_examp_increase_oid l_inst)))" - -definition "print_examp_def_st1 s = fst o print_examp_def_st1_gen s" -definition "print_meta_setup_def_state s env = snd (print_examp_def_st1_gen s env) env" - -definition "print_transition_gen = (\<lambda> ToyDefPP name s_pre s_post \<Rightarrow> bootstrap_floor' - (\<lambda>f env. - let (l, accu) = f env in - (L.flatten [ L.map META_all_meta_embedding l ], accu)) - (\<lambda>env. - let pref_name = case name of Some n \<Rightarrow> n - | None \<Rightarrow> \<open>WFF_\<close> @@ String.nat_to_digit10 (length (D_input_meta env)) - ; f_comp = \<lambda>None \<Rightarrow> id | Some (_, f, _) \<Rightarrow> f - ; f_comp_env = \<lambda>None \<Rightarrow> id | Some (_, _, f) \<Rightarrow> f - ; f_conv = \<lambda>msg. - \<lambda> ToyDefPPCoreAdd toy_def_state \<Rightarrow> - let n = pref_name @@ msg in - ( ToyDefPPCoreBinding n - , Cons (META_def_state Floor1 (ToyDefSt n toy_def_state)) - , let l_inst = fst (print_examp_def_st0 n toy_def_state) in - if l_inst = [] then id else print_examp_increase_oid l_inst ) - | s \<Rightarrow> (s, id, id) - ; o_pre = Some (f_conv \<open>_pre\<close> s_pre) - ; o_post = map_option (f_conv \<open>_post\<close>) s_post in - ( (f_comp o_pre o f_comp o_post) - [ META_def_transition Floor2 (ToyDefPP name - (case o_pre of Some (n, _) \<Rightarrow> n) - (map_option fst o_post)) ] - , f_comp_env o_pre o f_comp_env o_post )))" - -definition "print_transition s = fst o print_transition_gen s" -definition "print_meta_setup_def_transition s env = snd (print_transition_gen s env) env" - -end diff --git a/Citadelle/src/compiler_generic/toy_example/embedding/core/Floor1_infra.thy b/Citadelle/src/compiler_generic/toy_example/embedding/core/Floor1_infra.thy deleted file mode 100644 index d50293e5fbc20bfe9afc568411745e6508728034..0000000000000000000000000000000000000000 --- a/Citadelle/src/compiler_generic/toy_example/embedding/core/Floor1_infra.thy +++ /dev/null @@ -1,75 +0,0 @@ -(****************************************************************************** - * HOL-TOY - * - * 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. - ******************************************************************************) - -section\<open>Main Translation for: Infrastructure\<close> - -theory Floor1_infra -imports Core_init -begin - -definition "print_infra_datatype_class = start_map'' O.datatype o (\<lambda>expr _ base_attr' _. map_class_gen_h'''' - (\<lambda>isub_name name _ l_attr l_inherited l_cons. - let (l_attr, l_inherited) = base_attr' (l_attr, of_inh l_inherited) - ; map_ty = L.map ((\<lambda>x. Typ_apply (Typ_base \<open>option\<close>) [str_hol_of_ty_all Typ_apply Typ_base x]) o snd) in - [ Datatype' - (isub_name datatype_ext_name) - ( (L.rev_map (\<lambda>x. ( datatype_ext_constr_name @@ mk_constr_name name x - , [Raw (datatype_name @@ String.isub x)])) (of_sub l_cons)) - @@@@ [(isub_name datatype_ext_constr_name, Raw const_oid # L.maps map_ty l_inherited)]) - , Datatype' - (isub_name datatype_name) - [ (isub_name datatype_constr_name, Raw (isub_name datatype_ext_name) # map_ty l_attr ) ] ]) expr)" - -definition "print_infra_datatype_universe expr = start_map O.datatype - [ Datatype' \<open>\<AA>\<close> - (map_class (\<lambda>isub_name _ _ _ _ _. (isub_name datatype_in, [Raw (isub_name datatype_name)])) expr) ]" - -definition "print_infra_type_synonym_class_higher expr = start_map O.type_synonym - (let option = Typ_apply_paren \<open>\<langle>\<close> \<open>\<rangle>\<^sub>\<bottom>\<close> in - L.flatten - (map_class - (\<lambda>isub_name name _ _ _ _. - [ Type_synonym' name - (option (option (Typ_base (isub_name datatype_name)))) - \<^cancel>\<open>, Type_synonym' name (Typ_apply_paren \<open>\<cdot>\<close> \<open>\<close> (Typ_base (name @@ \<open>'\<close>)))\<close>]) - expr))" - -end diff --git a/Citadelle/src/compiler_generic/toy_example/embedding/core/Floor2_examp.thy b/Citadelle/src/compiler_generic/toy_example/embedding/core/Floor2_examp.thy deleted file mode 100644 index 0bcac7c5a6ae448120c8ff739151601760362336..0000000000000000000000000000000000000000 --- a/Citadelle/src/compiler_generic/toy_example/embedding/core/Floor2_examp.thy +++ /dev/null @@ -1,239 +0,0 @@ -(****************************************************************************** - * HOL-TOY - * - * 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. - ******************************************************************************) - -section\<open>Main Translation for: Example (Floor 2)\<close> - -theory Floor2_examp -imports Floor1_examp -begin - -definition "init_map_class2 env l = - (let rbt_str = RBT.bulkload (L.map (\<lambda>(k, _, v). (String\<^sub>b\<^sub>a\<^sub>s\<^sub>e.to_list k, v)) (D_input_instance env)) in - ( rbt_of_class env - , RBT.lookup (fst (List.fold - (\<lambda> toyi (rbt_nat, accu). - ( case lookup rbt_str (case Inst_attr_with toyi of - None \<Rightarrow> inst_name toyi - | Some s \<Rightarrow> s) of - None \<Rightarrow> rbt_nat - | Some oid_start' \<Rightarrow> RBT.insert (Oid accu) oid_start' rbt_nat - , Succ accu)) - l - ( RBT.empty - , 0))) - , lookup rbt_str))" - -definition "merge_unique_gen f l = List.fold (List.fold (\<lambda>x. case f x of Some (x, v) \<Rightarrow> RBT.insert x v | None \<Rightarrow> id)) l RBT.empty" -definition "merge_unique f l = RBT.entries (merge_unique_gen f l)" -definition "merge_unique' f = - L.map snd - o RBT.entries - o (\<lambda>l. - List.fold - (\<lambda>((k, _), e) rbt. - RBT.insert k - (case RBT.lookup rbt k of - None \<Rightarrow> [e] - | Some l \<Rightarrow> e # l) - rbt) - l - RBT.empty) - o merge_unique (\<lambda> ((a, n), b). Some ((oidGetInh a, n), (a, b))) - o L.map (L.map (\<lambda>(oid, e) \<Rightarrow> ((oid, f e), e)))" -definition "merge_unique'' l = - L.map (L.map (map_prod id (\<lambda> ToyDefCoreBinding (_, toyi) \<Rightarrow> toyi))) - (merge_unique' (\<lambda> ToyDefCoreBinding (s, _) \<Rightarrow> String.to_list s) l)" - -definition "map_tail f = - (let f = map_prod (Term_oid var_oid_uniq o oidGetInh) f in - L.map (\<lambda> x # xs \<Rightarrow> - map_prod id - (\<lambda>x. L.flatten (x # L.map (snd o f) xs)) - (f x)))" - -definition "print_examp_def_st_locale_distinct = \<open>distinct_oid\<close>" -definition "print_examp_def_st_locale_metis = M.metis (L.map T.thm [print_examp_def_st_locale_distinct, \<open>distinct_length_2_or_more\<close>])" -definition "print_examp_def_st_locale_aux l = - (let b = \<lambda>s. Term_basic [s] in - map_prod - id - L.flatten - (L.split - (map_tail - (\<lambda> toyi. - let n = inst_name toyi - ; ty = inst_ty toyi - ; f = \<lambda>s. s @@ String.isub ty - ; name_pers = print_examp_instance_name f n in - [ ( [(b name_pers, Typ_base (f datatype_name))], None) - , ( [(b n, Typ_base (wrap_toyty ty))] - , Some (hol_definition n, Term_rewrite (b n) \<open>=\<close> (Term_lambda wildcard (Term_some (Term_some (b name_pers)))))) ]) - l)))" - -definition "print_examp_def_st_locale_make f_name f_spec l = - (let (oid, l_fix_assum) = print_examp_def_st_locale_aux l - ; ty_n = \<open>nat\<close> in - \<lparr> HolThyLocale_name = f_name - , HolThyLocale_header = L.flatten - [ [ ( L.map (\<lambda>x. (x, Typ_base ty_n)) oid - , Some ( print_examp_def_st_locale_distinct - , Term_app \<open>distinct\<close> [let e = Term_list oid in - if oid = [] then Term_annot' e (ty_n @@ \<open> list\<close>) else e])) ] - , l_fix_assum - , f_spec ] \<rparr>)" - -definition "print_examp_def_st_locale_sort env l = - merge_unique' (String.to_list o inst_name) - (L.map (\<lambda> ToyDefCoreBinding name \<Rightarrow> case String.assoc name (D_input_instance env) of - Some n \<Rightarrow> [flip n]) l)" - -definition "filter_locale_interp = - L.split - o map_tail - (let a = \<lambda>f x. Term_app f [x] - ; b = \<lambda>s. Term_basic [s] - ; c = Term_paren \<open>\<lceil>\<close> \<open>\<rceil>\<close> - ; var_tau = \<open>\<tau>\<close> in - \<lambda> toyi \<Rightarrow> - let n = inst_name toyi in - [ c (c (a n (b var_tau))) - , b n])" - -definition "print_examp_def_st_locale_name n = \<open>state_\<close> @@ n" -definition "print_examp_def_st_locale = (\<lambda> ToyDefSt n l \<Rightarrow> \<lambda>env. - (\<lambda>d. (d, env)) - (print_examp_def_st_locale_make - (print_examp_def_st_locale_name n) - [] - (print_examp_def_st_locale_sort env l)))" - -definition "print_examp_def_st_mapsto_gen f = - L.map - (\<lambda>(cpt, ocore). - let b = \<lambda>s. Term_basic [s] - ; (toyi, exp) = case ocore of - ToyDefCoreBinding (name, toyi) \<Rightarrow> - (toyi, Some (b (print_examp_instance_name (\<lambda>s. s @@ String.isub (inst_ty toyi)) name))) in - f (cpt, ocore) toyi exp)" - -definition "print_examp_def_st_mapsto l = L.bind id id - (print_examp_def_st_mapsto_gen - (\<lambda>(cpt, _) toyi. map_option (\<lambda>exp. - Term_binop (Term_oid var_oid_uniq (oidGetInh cpt)) \<open>\<mapsto>\<close> (Term_app (datatype_in @@ String.isub (inst_ty toyi)) [exp]))) - l)" - -definition "print_examp_def_st2 = (\<lambda> ToyDefSt name l \<Rightarrow> \<lambda>env. - (\<lambda>(l, l_st). (L.map O'.definition l, env \<lparr> D_input_state := (String.to_String\<^sub>b\<^sub>a\<^sub>s\<^sub>e name, l_st) # D_input_state env \<rparr>)) - (let b = \<lambda>s. Term_basic [s] - ; l = L.map (\<lambda> ToyDefCoreBinding name \<Rightarrow> map_option (Pair name) (String.assoc name (D_input_instance env))) l - ; (rbt, (map_self, map_username)) = - (init_map_class2 - env - (L.map (\<lambda> Some (_, toyi, _) \<Rightarrow> toyi | None \<Rightarrow> toy_instance_single_empty) l) - :: (_ \<Rightarrow> _ \<times> _ \<times> (_ \<Rightarrow> ((_ \<Rightarrow> nat \<Rightarrow> _ \<Rightarrow> _) \<Rightarrow> _ - \<Rightarrow> (toy_ty_class option \<times> (toy_ty \<times> toy_data_shallow) option) list) option)) \<times> _ \<times> _) - ; (l_st, l_assoc) = L.mapM (\<lambda> o_n l_assoc. - case o_n of - Some (name, toyi, cpt) \<Rightarrow> ([(cpt, ToyDefCoreBinding (name, toyi))], (toyi, cpt) # l_assoc) - | None \<Rightarrow> ([], l_assoc)) l [] - ; l_st = L.unique oidGetInh (L.flatten l_st) in - - ( [ Definition (Term_rewrite (b name) \<open>=\<close> (Term_app \<open>state.make\<close> - ( Term_app \<open>Map.empty\<close> (case print_examp_def_st_mapsto l_st of None \<Rightarrow> [] | Some l \<Rightarrow> l) - # [ print_examp_def_st_assoc (snd o rbt) map_self map_username l_assoc ]))) ] - , l_st)))" - -definition "print_examp_def_st_perm_name name = S.flatten [\<open>perm_\<close>, name]" -definition "print_examp_def_st_perm = (\<lambda> _ env. - (\<lambda> l. (L.map O'.lemma l, env)) - (let (name, l_st) = map_prod String\<^sub>b\<^sub>a\<^sub>s\<^sub>e.to_String id (hd (D_input_state env)) - ; expr_app = print_examp_def_st_mapsto (rev l_st) - ; b = \<lambda>s. Term_basic [s] - ; d = hol_definition - ; (l_app, l_last) = - case l_st of [] \<Rightarrow> ([], C.by [M.simp_add [d name]]) - | [_] \<Rightarrow> ([], C.by [M.simp_add [d name]]) - | _ \<Rightarrow> - ( [ M.simp_add [d name]] - # L.flatten (L.map (\<lambda>i_max. L.map (\<lambda>i. [M.subst_l (L.map String.nat_to_digit10 [i_max - i]) (T.thm \<open>fun_upd_twist\<close>), print_examp_def_st_locale_metis]) (List.upt 0 i_max)) (List.upt 1 (List.length l_st))) - , C.by [M.simp]) in - case expr_app of None \<Rightarrow> [] | Some expr_app \<Rightarrow> - [ Lemma - (print_examp_def_st_perm_name name) - [Term_rewrite (b name) \<open>=\<close> (Term_app \<open>state.make\<close> - (Term_app \<open>Map.empty\<close> expr_app # [Term_app var_assocs [b name]]))] - l_app - l_last ]))" - -definition "get_state f = (\<lambda> ToyDefPP _ s_pre s_post \<Rightarrow> \<lambda> env. - let get_state = let l_st = D_input_state env in \<lambda>ToyDefPPCoreBinding s \<Rightarrow> (s, case String.assoc s l_st of None \<Rightarrow> [] | Some l \<Rightarrow> l) - ; (s_pre, l_pre) = get_state s_pre - ; (s_post, l_post) = case s_post of None \<Rightarrow> (s_pre, l_pre) | Some s_post \<Rightarrow> get_state s_post in - f (s_pre, l_pre) - (s_post, l_post) - ((s_pre, l_pre) # (if s_pre \<triangleq> s_post then - [] - else - [ (s_post, l_post) ])) - env)" - -definition "print_transition_locale_aux l = - (let (oid, l_fix_assum) = print_examp_def_st_locale_aux (merge_unique'' [l]) in - L.flatten [oid, L.flatten (L.map (L.map fst o fst) l_fix_assum) ])" - -definition "print_transition_locale_name s_pre s_post = \<open>transition_\<close> @@ s_pre @@ \<open>_\<close> @@ s_post" -definition "print_transition_locale = get_state (\<lambda> (s_pre, l_pre) (s_post, l_post) l_pre_post. Pair - (print_examp_def_st_locale_make - (print_transition_locale_name s_pre s_post) - (L.map (\<lambda>(s, l). ([], Some (s, Term_app - (print_examp_def_st_locale_name s) - (print_transition_locale_aux l)))) - l_pre_post) - (merge_unique'' [l_pre, l_post])))" - -definition "print_transition_interp = get_state (\<lambda> _ _. - Pair o L.map O'.interpretation o L.map - (\<lambda>(s, l). - let n = print_examp_def_st_locale_name s in - Interpretation n n (print_transition_locale_aux l) - (C.by [M.rule (T.thm s)])))" - -end diff --git a/Citadelle/src/compiler_generic/toy_example/embedding/meta_toy/Meta_META.thy b/Citadelle/src/compiler_generic/toy_example/embedding/meta_toy/Meta_META.thy deleted file mode 100644 index 9745a1354dbb8ee659ef6bcd701779a4b55f42ac..0000000000000000000000000000000000000000 --- a/Citadelle/src/compiler_generic/toy_example/embedding/meta_toy/Meta_META.thy +++ /dev/null @@ -1,314 +0,0 @@ -(****************************************************************************** - * Citadelle - * - * 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. - ******************************************************************************) - -section\<open>Regrouping Together All Existing Meta-Models\<close> - -theory Meta_META -imports Meta_Toy - Meta_Toy_extended - "../../../meta_isabelle/Meta_Isabelle" -begin - -subsection\<open>A Basic Meta-Model\<close> - -text\<open>The following basic Meta-Model is an empty Meta-Model.\<close> - -text\<open>Most of the Meta-Model we have defined (in particular those defined in Toy) - can be used in exceptional situations - for requiring an eager or lazy interactive evaluation of already encountered Meta-Models. - This is also the case for this basic Meta-Model.\<close> - -datatype toy_flush_all = ToyFlushAll - -subsection\<open>The Generic Meta-Model\<close> - -text\<open>The generic Meta-Model can simulate any other Meta-Models \<open>M\<close> by taking a string representing - some ML code, which is supposed to express a parsed value inhabiting \<open>M\<close>.\<close> - -datatype toy_generic = ToyGeneric string - -subsection\<open>The META Meta-Model (I)\<close> - -datatype floor = Floor1 | Floor2 | Floor3 (* NOTE nat can be used *) - -text\<open> -Meta-Models can be seen as arranged in a semantic tower with several floors. -By default, @{term Floor1} corresponds to the first level we are situating by default, -then a subsequent meta-evaluation would jump to a deeper floor, -to @{term Floor2}, then @{term Floor3}...\<close> - -text\<open> -It is not mandatory to jump to a floor superior than the one we currently are. -The important point is to be sure that all jumps will ultimately terminate.\<close> - -(* *) - -text\<open> -Most of the following constructors are preceded by an additional -@{typ floor} field, which explicitly indicates the intended associated semantic to consider -during the meta-embedding to Isabelle. -In case no @{typ floor} is precised, we fix it to be @{term Floor1} by default.\<close> - -(* le meta-model de "tout le monde" - frederic. *) -datatype all_meta_embedding = META_enum toy_enum - | META_class_raw floor toy_class_raw - | META_association toy_association - | META_ass_class floor toy_ass_class - | META_ctxt floor toy_ctxt - | META_class_synonym toy_class_synonym - | META_instance toy_instance - | META_def_base_l toy_def_base_l - | META_def_state floor toy_def_state - | META_def_transition floor toy_def_transition - | META_class_tree toy_class_tree - | META_flush_all toy_flush_all - | META_generic toy_generic - -subsection\<open>Main Compiling Environment\<close> - -text\<open>The environment constitutes the main data-structure carried by all monadic translations.\<close> - -datatype generation_semantics_toy = Gen_only_design | Gen_only_analysis | Gen_default -datatype generation_lemma_mode = Gen_sorry | Gen_no_dirty - -record compiler_env_config = D_output_disable_thy :: bool - D_output_header_thy :: "(string \<comment> \<open>theory\<close> - \<times> string list \<comment> \<open>imports\<close> - \<times> string \<comment> \<open>import optional (compiler bootstrap)\<close>) option" - D_toy_oid_start :: internal_oids - D_output_position :: "nat \<times> nat" - D_toy_semantics :: generation_semantics_toy - D_input_class :: "toy_class option" - \<comment> \<open>last class considered for the generation\<close> - D_input_meta :: "all_meta_embedding list" - D_input_instance :: "(string\<^sub>b\<^sub>a\<^sub>s\<^sub>e \<comment> \<open>name (as key for rbt)\<close> - \<times> toy_instance_single - \<times> internal_oids) list" - \<comment> \<open>instance namespace environment\<close> - D_input_state :: "(string\<^sub>b\<^sub>a\<^sub>s\<^sub>e \<comment> \<open>name (as key for rbt)\<close> - \<times> (internal_oids - \<times> (string \<comment> \<open>name\<close> - \<times> toy_instance_single \<comment> \<open>alias\<close>) - toy_def_state_core) list) list" - \<comment> \<open>state namespace environment\<close> - D_output_header_force :: bool \<comment> \<open>true : the header should import the compiler for bootstrapping\<close> - D_output_auto_bootstrap :: bool \<comment> \<open>true : add the generation_syntax command\<close> - D_toy_accessor :: " string\<^sub>b\<^sub>a\<^sub>s\<^sub>e \<comment> \<open>name of the constant added\<close> list \<comment> \<open>pre\<close> - \<times> string\<^sub>b\<^sub>a\<^sub>s\<^sub>e \<comment> \<open>name of the constant added\<close> list \<comment> \<open>post\<close>" - D_toy_HO_type :: "(string\<^sub>b\<^sub>a\<^sub>s\<^sub>e \<comment> \<open>raw HOL name (as key for rbt)\<close>) list" - D_output_sorry_dirty :: "generation_lemma_mode option \<times> bool \<comment> \<open>dirty\<close>" \<comment> \<open>\<open>Some Gen_sorry\<close> or \<open>None\<close> and \<open>{dirty}\<close>: activate sorry mode for skipping proofs\<close> - -subsection\<open>Operations of Fold, Map, ..., on the Meta-Model\<close> - -definition "ignore_meta_header = (\<lambda> META_ctxt Floor1 _ \<Rightarrow> True - | META_def_state Floor1 _ \<Rightarrow> True - | META_def_transition Floor1 _ \<Rightarrow> True - | _ \<Rightarrow> False)" - -text\<open> -As remark in @{term ignore_meta_header}, @{term META_class_raw} and @{term META_ass_class} do not occur, -even if the associated meta-commands will be put at the beginning when generating files during the reordering step. -This is because some values for which @{term ignore_meta_header} returns @{term False} can exist just before -meta-commands associated to @{term META_class_raw} or @{term META_ass_class}. -\<close> - -definition "map2_ctxt_term f = - (let f_prop = \<lambda> ToyProp_ctxt n prop \<Rightarrow> ToyProp_ctxt n (f prop) - ; f_inva = \<lambda> T_inv b prop \<Rightarrow> T_inv b (f_prop prop) in - \<lambda> META_ctxt Floor2 c \<Rightarrow> - META_ctxt Floor2 - (Ctxt_clause_update - (L.map (\<lambda> Ctxt_pp pp \<Rightarrow> Ctxt_pp (Ctxt_expr_update (L.map (\<lambda> T_pp pref prop \<Rightarrow> T_pp pref (f_prop prop) - | T_invariant inva \<Rightarrow> T_invariant (f_inva inva))) pp) - | Ctxt_inv l_inv \<Rightarrow> Ctxt_inv (f_inva l_inv))) c) - | x \<Rightarrow> x)" - -definition "compiler_env_config_more_map f toy = - compiler_env_config.extend (compiler_env_config.truncate toy) (f (compiler_env_config.more toy))" - -definition "compiler_env_config_empty output_disable_thy output_header_thy oid_start design_analysis sorry_dirty = - compiler_env_config.make - output_disable_thy - output_header_thy - oid_start - (0, 0) - design_analysis - None [] [] [] False False ([], []) [] - sorry_dirty" - -definition "compiler_env_config_reset_no_env env = - compiler_env_config_empty - (D_output_disable_thy env) - (D_output_header_thy env) - (oidReinitAll (D_toy_oid_start env)) - (D_toy_semantics env) - (D_output_sorry_dirty env) - \<lparr> D_input_meta := D_input_meta env \<rparr>" - -subsection\<open>The META Meta-Model (II)\<close> -subsubsection\<open>Type Definition\<close> - -text\<open> -For bootstrapping the environment through the jumps to another semantic floor, we additionally -consider the environment as a Meta-Model.\<close> - -datatype boot_generation_syntax = Boot_generation_syntax generation_semantics_toy -datatype boot_setup_env = Boot_setup_env compiler_env_config - -datatype all_meta = \<comment> \<open>pure Isabelle\<close> - META_semi__theories semi__theories - - \<comment> \<open>bootstrapping embedded languages\<close> - | META_boot_generation_syntax boot_generation_syntax - | META_boot_setup_env boot_setup_env - | META_all_meta_embedding all_meta_embedding - -text\<open>As remark, the Isabelle Meta-Model represented by @{typ semi__theories} can be merged -with the previous META Meta-Model @{typ all_meta_embedding}. -However a corresponding parser and printer would then be required, instead we can just regroup them -in a temporary type:\<close> - -datatype fold_all_input = Fold_meta all_meta_embedding - | Fold_custom "all_meta list" - -subsubsection\<open>Extending the Meta-Model\<close> - -locale O \<comment> \<open>outer syntax\<close> -begin -definition "i x = META_semi__theories o Theories_one o x" -definition "datatype = i Theory_datatype" -definition "type_synonym = i Theory_type_synonym" -definition "type_notation = i Theory_type_notation" -definition "instantiation = i Theory_instantiation" -definition "overloading = i Theory_overloading" -definition "consts = i Theory_consts" -definition "definition = i Theory_definition" -definition "lemmas = i Theory_lemmas" -definition "lemma = i Theory_lemma" -definition "axiomatization = i Theory_axiomatization" -definition "section = i Theory_section" -definition "text = i Theory_text" -definition "text_raw = i Theory_text_raw" -definition "ML = i Theory_ML" -definition "setup = i Theory_setup" -definition "thm = i Theory_thm" -definition "interpretation = i Theory_interpretation" -definition "hide_const = i Theory_hide_const" -definition "abbreviation = i Theory_abbreviation" -definition "code_reflect' = i Theory_code_reflect'" -end - -lemmas [code] = - \<comment> \<open>def\<close> - O.i_def - O.datatype_def - O.type_synonym_def - O.type_notation_def - O.instantiation_def - O.overloading_def - O.consts_def - O.definition_def - O.lemmas_def - O.lemma_def - O.axiomatization_def - O.section_def - O.text_def - O.text_raw_def - O.ML_def - O.setup_def - O.thm_def - O.interpretation_def - O.hide_const_def - O.abbreviation_def - O.code_reflect'_def - -locale O' -begin -definition "datatype = Theory_datatype" -definition "type_synonym = Theory_type_synonym" -definition "type_notation = Theory_type_notation" -definition "instantiation = Theory_instantiation" -definition "overloading = Theory_overloading" -definition "consts = Theory_consts" -definition "definition = Theory_definition" -definition "lemmas = Theory_lemmas" -definition "lemma = Theory_lemma" -definition "axiomatization = Theory_axiomatization" -definition "section = Theory_section" -definition "text = Theory_text" -definition "ML = Theory_ML" -definition "setup = Theory_setup" -definition "thm = Theory_thm" -definition "interpretation = Theory_interpretation" -definition "hide_const = Theory_hide_const" -definition "abbreviation = Theory_abbreviation" -definition "code_reflect' = Theory_code_reflect'" -end - -lemmas [code] = - \<comment> \<open>def\<close> - O'.datatype_def - O'.type_synonym_def - O'.type_notation_def - O'.instantiation_def - O'.overloading_def - O'.consts_def - O'.definition_def - O'.lemmas_def - O'.lemma_def - O'.axiomatization_def - O'.section_def - O'.text_def - O'.ML_def - O'.setup_def - O'.thm_def - O'.interpretation_def - O'.hide_const_def - O'.abbreviation_def - O'.code_reflect'_def - -subsubsection\<open>Operations of Fold, Map, ..., on the Meta-Model\<close> - -definition "map_semi__theory f = (\<lambda> META_semi__theories (Theories_one x) \<Rightarrow> META_semi__theories (Theories_one (f x)) - | META_semi__theories (Theories_locale data l) \<Rightarrow> META_semi__theories (Theories_locale data (L.map (L.map f) l)) - | x \<Rightarrow> x)" - -end diff --git a/Citadelle/src/compiler_generic/toy_example/embedding/meta_toy/Meta_Toy.thy b/Citadelle/src/compiler_generic/toy_example/embedding/meta_toy/Meta_Toy.thy deleted file mode 100644 index 84b61de6bf6fd4ec1641181de0d749b3319331ec..0000000000000000000000000000000000000000 --- a/Citadelle/src/compiler_generic/toy_example/embedding/meta_toy/Meta_Toy.thy +++ /dev/null @@ -1,599 +0,0 @@ -(****************************************************************************** - * HOL-TOY - * - * 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. - ******************************************************************************) - -section\<open>Toy Meta-Model aka. AST definition of Toy (I)\<close> - -theory Meta_Toy -imports "../../../meta_isabelle/Meta_Pure" - "../Init_rbt" -begin - -subsection\<open>Type Definition\<close> - -datatype toy_collection = Set - | Sequence - | Ordered0 \<comment> \<open>ordered set\<close> - | Subsets0 \<^cancel>\<open>binding\<close> - | Union0 - | Redefines0 \<^cancel>\<open>binding\<close> - | Derived0 \<^cancel>\<open>string\<close> - | Qualifier0 \<^cancel>\<open>binding \<times> use_toyty\<close> - | Nonunique0 \<^cancel>\<open>bag\<close> - -datatype toy_multiplicity_single = Mult_nat nat - | Mult_star - | Mult_infinity - -record toy_multiplicity = TyMult :: "(toy_multiplicity_single \<times> toy_multiplicity_single option) list" - TyRole :: "string option" - TyCollect :: "toy_collection list" \<comment> \<open>return type of the accessor (constrained by the above multiplicity)\<close> - -record toy_ty_class_node = TyObjN_ass_switch :: nat - TyObjN_role_multip :: toy_multiplicity - TyObjN_role_ty :: string -record toy_ty_class = TyObj_name :: string - TyObj_ass_id :: nat - TyObj_ass_arity :: nat - TyObj_from :: toy_ty_class_node - TyObj_to :: toy_ty_class_node -datatype toy_ty_obj_core = ToyTyCore_pre string \<comment> \<open>class name, untyped\<close> (* FIXME perform the typing separately *) - | ToyTyCore toy_ty_class \<comment> \<open>class name, typed\<close> -datatype toy_ty_obj = ToyTyObj toy_ty_obj_core - "toy_ty_obj_core list \<comment> \<open>the \<^theory_text>\<open>and\<close> semantics\<close> - list \<comment> \<open>\<open>x # \<dots>\<close> means \<open>x < \<dots>\<close>\<close>" \<comment> \<open>superclass\<close> -datatype toy_ty = ToyTy_base_void (* NOTE can be merged in a generic tuple *) - | ToyTy_base_boolean - | ToyTy_base_integer - | ToyTy_base_unlimitednatural - | ToyTy_base_real - | ToyTy_base_string - | ToyTy_object toy_ty_obj - | ToyTy_collection toy_multiplicity toy_ty - | ToyTy_pair toy_ty toy_ty (* NOTE can be merged in a generic tuple *) - | ToyTy_binding "string option \<comment> \<open>name\<close> \<times> toy_ty" (* NOTE can be merged in a generic tuple *) - | ToyTy_arrow toy_ty toy_ty - | ToyTy_class_syn string - | ToyTy_enum string - | ToyTy_raw string \<comment> \<open>denoting raw HOL-type\<close> (* FIXME to be removed *) - - -datatype toy_association_type = ToyAssTy_native_attribute - | ToyAssTy_association - | ToyAssTy_composition - | ToyAssTy_aggregation -datatype toy_association_relation = ToyAssRel "(toy_ty_obj \<times> toy_multiplicity) list" -record toy_association = ToyAss_type :: toy_association_type - ToyAss_relation :: toy_association_relation - -datatype toy_ctxt_prefix = ToyCtxtPre | ToyCtxtPost - -datatype toy_ctxt_term = T_pure "term" - "string option" \<comment> \<open>represents the unparsed version of the term\<close> - | T_to_be_parsed string \<comment> \<open>raw, it includes extra quoting characters like DEL (char 127)\<close> - string \<comment> \<open>same string but escaped without those quoting characters\<close> - | T_lambda string toy_ctxt_term -datatype toy_prop = ToyProp_ctxt "string option" \<comment> \<open>name\<close> toy_ctxt_term - \<^cancel>\<open>| ToyProp_rel toy_ty_obj \<comment> \<open>states that the constraint should be true\<close> - | ToyProp_ass toy_association_relation \<comment> \<open>states the relation as true\<close>\<close> -datatype toy_ctxt_term_inv = T_inv bool \<comment> \<open>True: existential\<close> toy_prop -datatype toy_ctxt_term_pp = T_pp toy_ctxt_prefix toy_prop - | T_invariant toy_ctxt_term_inv - -record toy_ctxt_pre_post = Ctxt_fun_name :: string \<comment> \<open>function name\<close> - Ctxt_fun_ty :: toy_ty - Ctxt_expr :: "toy_ctxt_term_pp list" - -datatype toy_ctxt_clause = Ctxt_pp toy_ctxt_pre_post - | Ctxt_inv toy_ctxt_term_inv -record toy_ctxt = Ctxt_param :: "string list" \<comment> \<open>param\<close> - Ctxt_ty :: toy_ty_obj - Ctxt_clause :: "toy_ctxt_clause list" - -datatype toy_class = ToyClass - string \<comment> \<open>name of the class\<close> - "(string \<comment> \<open>name\<close> \<times> toy_ty) list" \<comment> \<open>attribute\<close> - "toy_class list" \<comment> \<open>link to subclasses\<close> - -record toy_class_raw = ClassRaw_name :: toy_ty_obj - ClassRaw_own :: "(string \<comment> \<open>name\<close> \<times> toy_ty) list" \<comment> \<open>attribute\<close> - ClassRaw_clause :: "toy_ctxt_clause list" - ClassRaw_abstract :: bool \<comment> \<open>True: abstract\<close> - -datatype toy_ass_class = ToyAssClass toy_association - toy_class_raw - -datatype toy_class_synonym = ToyClassSynonym string \<comment> \<open>name alias\<close> toy_ty - -datatype toy_enum = ToyEnum string \<comment> \<open>name\<close> "string \<comment> \<open>constructor name\<close> list" - -subsection\<open>Extending the Meta-Model\<close> - -definition "T_lambdas = List.fold T_lambda" -definition "TyObjN_role_name = TyRole o TyObjN_role_multip" -definition "ToyTy_class c = ToyTy_object (ToyTyObj (ToyTyCore c) [])" -definition "ToyTy_class_pre c = ToyTy_object (ToyTyObj (ToyTyCore_pre c) [])" -definition "ToyAss_relation' l = (case ToyAss_relation l of ToyAssRel l \<Rightarrow> l)" - -fun fold_pair_var where - "fold_pair_var f t accu = (case t of - ToyTy_pair t1 t2 \<Rightarrow> Option.bind (fold_pair_var f t1 accu) (fold_pair_var f t2) - | ToyTy_binding (Some v, t) \<Rightarrow> fold_pair_var f t (f (v, t) accu) - | ToyTy_binding (None, t) \<Rightarrow> fold_pair_var f t accu - | ToyTy_collection _ t \<Rightarrow> fold_pair_var f t accu - | ToyTy_arrow _ _ \<Rightarrow> None - | _ \<Rightarrow> Some accu)" - -definition "Ctxt_fun_ty_arg ctxt = - (case - fold_pair_var - Cons - (case Ctxt_fun_ty ctxt of ToyTy_arrow t _ \<Rightarrow> t - | t \<Rightarrow> t) - [] - of Some l \<Rightarrow> rev l)" - -definition "Ctxt_fun_ty_out ctxt = - (case Ctxt_fun_ty ctxt of ToyTy_arrow _ t \<Rightarrow> Some t - | _ \<Rightarrow> None)" - -definition "map_pre_post f = - Ctxt_clause_update - (L.map - (\<lambda> Ctxt_pp ctxt \<Rightarrow> - Ctxt_pp (Ctxt_expr_update - (L.map - (\<lambda> T_pp pref (ToyProp_ctxt n e) \<Rightarrow> - T_pp pref (ToyProp_ctxt n (f pref ctxt e)) - | x \<Rightarrow> x)) - ctxt) - | x \<Rightarrow> x))" - -definition "map_invariant f_inv = - Ctxt_clause_update - (L.map - (\<lambda> Ctxt_pp ctxt \<Rightarrow> - Ctxt_pp (Ctxt_expr_update - (L.map - (\<lambda> T_invariant ctxt \<Rightarrow> T_invariant (f_inv ctxt) - | x \<Rightarrow> x)) - ctxt) - | Ctxt_inv ctxt \<Rightarrow> Ctxt_inv (f_inv ctxt)))" - -fun remove_binding where - "remove_binding e = (\<lambda> ToyTy_collection m ty \<Rightarrow> ToyTy_collection m (remove_binding ty) - | ToyTy_pair ty1 ty2 \<Rightarrow> ToyTy_pair (remove_binding ty1) (remove_binding ty2) - | ToyTy_binding (_, ty) \<Rightarrow> remove_binding ty - | ToyTy_arrow ty1 ty2 \<Rightarrow> ToyTy_arrow (remove_binding ty1) (remove_binding ty2) - | x \<Rightarrow> x) e" - -subsection\<open>Class Translation Preliminaries\<close> - -definition "const_oid = \<open>oid\<close>" -definition "var_ty_list = \<open>list\<close>" -definition "var_ty_prod = \<open>prod\<close>" -definition "const_toyany = \<open>ToyAny\<close>" - -definition "single_multip = - List.list_all (\<lambda> (_, Some (Mult_nat n)) \<Rightarrow> n \<le> 1 - | (Mult_nat n, None) \<Rightarrow> n \<le> 1 - | _ \<Rightarrow> False) o TyMult" - -fun fold_max_aux where - "fold_max_aux f l l_acc accu = (case l of - [] \<Rightarrow> accu - | x # xs \<Rightarrow> fold_max_aux f xs (x # l_acc) (f x (L.flatten [rev l_acc, xs]) accu))" - -definition "fold_max f l = fold_max_aux f (L.mapi Pair l) []" - -locale RBTS -begin -definition "lookup m k = RBT.lookup m (String.to_list k)" -definition insert where "insert k = RBT.insert (String.to_list k)" -definition "map_entry k = RBT.map_entry (String.to_list k)" -definition "modify_def v k = RBT.modify_def v (String.to_list k)" -definition "keys m = L.map (\<lambda>s. \<lless>s\<ggreater>) (RBT.keys m)" -definition "lookup2 m = (\<lambda>(k1, k2). RBT.lookup2 m (String.to_list k1, String.to_list k2))" -definition "insert2 = (\<lambda>(k1, k2). RBT.insert2 (String.to_list k1, String.to_list k2))" -definition fold where "fold f = RBT.fold (\<lambda>c. f \<lless>c\<ggreater>)" -definition "entries m = L.map (map_prod (\<lambda>c. \<lless>c\<ggreater>) id) (RBT.entries m)" -end -lemmas [code] = - \<comment> \<open>def\<close> - RBTS.lookup_def - RBTS.insert_def - RBTS.map_entry_def - RBTS.modify_def_def - RBTS.keys_def - RBTS.lookup2_def - RBTS.insert2_def - RBTS.fold_def - RBTS.entries_def - -syntax "_rbt_lookup" :: "_ \<Rightarrow> _" ("lookup") translations "lookup" \<rightleftharpoons> "CONST RBTS.lookup" -syntax "_rbt_insert" :: "_ \<Rightarrow> _" ("insert") translations "insert" \<rightleftharpoons> "CONST RBTS.insert" -syntax "_rbt_map_entry" :: "_ \<Rightarrow> _" ("map'_entry") translations "map_entry" \<rightleftharpoons> "CONST RBTS.map_entry" -syntax "_rbt_modify_def" :: "_ \<Rightarrow> _" ("modify'_def") translations "modify_def" \<rightleftharpoons> "CONST RBTS.modify_def" -syntax "_rbt_keys" :: "_ \<Rightarrow> _" ("keys") translations "keys" \<rightleftharpoons> "CONST RBTS.keys" -syntax "_rbt_lookup2" :: "_ \<Rightarrow> _" ("lookup2") translations "lookup2" \<rightleftharpoons> "CONST RBTS.lookup2" -syntax "_rbt_insert2" :: "_ \<Rightarrow> _" ("insert2") translations "insert2" \<rightleftharpoons> "CONST RBTS.insert2" -syntax "_rbt_fold" :: "_ \<Rightarrow> _" ("fold") translations "fold" \<rightleftharpoons> "CONST RBTS.fold" -syntax "_rbt_entries" :: "_ \<Rightarrow> _" ("entries") translations "entries" \<rightleftharpoons> "CONST RBTS.entries" - -function (sequential) class_unflat_aux where -(* FIXME replace with this simplified form *) \<^cancel>\<open> - "class_unflat_aux rbt rbt_inv rbt_cycle r = - (case lookup rbt_cycle r of None \<comment> \<open>cycle detection\<close> \<Rightarrow> - map_option - (ToyClass - r - (case lookup rbt r of Some l \<Rightarrow> l)) - (L.bind (class_unflat_aux rbt rbt_inv (insert r () rbt_cycle)) - id - (case lookup rbt_inv r of None \<Rightarrow> [] | Some l \<Rightarrow> l)) - | _ \<Rightarrow> None)" -\<close> - "class_unflat_aux rbt rbt_inv rbt_cycle r = - (case lookup rbt_inv r of None \<Rightarrow> - (case lookup rbt_cycle r of None \<comment> \<open>cycle detection\<close> \<Rightarrow> - map_option - (ToyClass - r - (case lookup rbt r of Some l \<Rightarrow> l)) - ((\<lambda>f0 f l. - let l = List.map f0 l in - if list_ex (\<lambda> None \<Rightarrow> True | _ \<Rightarrow> False) l then - None - else - Some (f (List.map_filter id l))) (class_unflat_aux rbt rbt_inv (insert r () rbt_cycle)) - id - ([])) - | _ \<Rightarrow> None) - | Some l \<Rightarrow> - (case lookup rbt_cycle r of None \<comment> \<open>cycle detection\<close> \<Rightarrow> - map_option - (ToyClass - r - (case lookup rbt r of Some l \<Rightarrow> l)) - ((\<lambda>f0 f l. - let l = List.map f0 l in - if list_ex (\<lambda> None \<Rightarrow> True | _ \<Rightarrow> False) l then - None - else - Some (f (List.map_filter id l))) (class_unflat_aux rbt rbt_inv (insert r () rbt_cycle)) - id - (l)) - | _ \<Rightarrow> None))" -by pat_completeness auto - -termination -proof - - have arith_diff: "\<And>a1 a2 (b :: Nat.nat). a1 = a2 \<Longrightarrow> a1 > b \<Longrightarrow> a1 - (b + 1) < a2 - b" - by arith - - have arith_less: "\<And>(a:: Nat.nat) b c. b \<ge> max (a + 1) c \<Longrightarrow> a < b" - by arith - - have rbt_length: "\<And>rbt_cycle r v. RBT.lookup rbt_cycle r = None \<Longrightarrow> - length (RBT.keys (RBT.insert r v rbt_cycle)) = length (RBT.keys rbt_cycle) + 1" - apply(subst (1 2) distinct_card[symmetric], (rule distinct_keys)+) - apply(simp only: lookup_keys[symmetric], simp) - by (metis card_insert_if domIff finite_dom_lookup) - - have rbt_fold_union'': "\<And>ab a x k. dom (\<lambda>b. if b = ab then Some a else k b) = {ab} \<union> dom k" - by(auto) - - have rbt_fold_union': "\<And>l rbt_inv a. - dom (RBT.lookup (List.fold (\<lambda>(k, _). RBT.insert k a) l rbt_inv)) = - dom (map_of l) \<union> dom (RBT.lookup rbt_inv)" - apply(rule_tac P = "\<lambda>rbt_inv . dom (RBT.lookup (List.fold (\<lambda>(k, _). RBT.insert k a) l rbt_inv)) = - dom (map_of l) \<union> dom (RBT.lookup rbt_inv)" in allE, simp_all) - apply(induct_tac l, simp, rule allI) - apply(case_tac aa, simp) - apply(simp add: rbt_fold_union'') - done - - have rbt_fold_union: "\<And>rbt_cycle rbt_inv a. - dom (RBT.lookup (RBT.fold (\<lambda>k _. RBT.insert k a) rbt_cycle rbt_inv)) = - dom (RBT.lookup rbt_cycle) \<union> dom (RBT.lookup rbt_inv)" - apply(simp add: fold_fold) - apply(subst (2) map_of_entries[symmetric]) - apply(rule rbt_fold_union') - done - - have rbt_fold_eq: "\<And>rbt_cycle rbt_inv a b. - dom (RBT.lookup (RBT.fold (\<lambda>k _. RBT.insert k a) rbt_cycle rbt_inv)) = - dom (RBT.lookup (RBT.fold (\<lambda>k _. RBT.insert k b) rbt_inv rbt_cycle))" - by(simp add: rbt_fold_union Un_commute) - - let ?len = "\<lambda>x. length (RBT.keys x)" - let ?len_merge = "\<lambda>rbt_cycle rbt_inv. ?len (RBT.fold (\<lambda>k _. RBT.insert k []) rbt_cycle rbt_inv)" - - have rbt_fold_large: "\<And>rbt_cycle rbt_inv. ?len_merge rbt_cycle rbt_inv \<ge> max (?len rbt_cycle) (?len rbt_inv)" - apply(subst (1 2 3) distinct_card[symmetric], (rule distinct_keys)+) - apply(simp only: lookup_keys[symmetric], simp) - apply(subst (1 2) card_mono, simp_all) - apply(simp add: rbt_fold_union)+ - done - - have rbt_fold_eq: "\<And>rbt_cycle rbt_inv r a. - RBT.lookup rbt_inv r = Some a \<Longrightarrow> - ?len_merge (RBT.insert r () rbt_cycle) rbt_inv = ?len_merge rbt_cycle rbt_inv" - apply(subst (1 2) distinct_card[symmetric], (rule distinct_keys)+) - apply(simp only: lookup_keys[symmetric]) - apply(simp add: rbt_fold_union) - by (metis Un_insert_right insert_dom) - - show ?thesis - apply(relation "measure (\<lambda>(_, rbt_inv, rbt_cycle, _). - ?len_merge rbt_cycle rbt_inv - ?len rbt_cycle)" - , simp+) - unfolding RBTS.lookup_def RBTS.insert_def - apply(subst rbt_length, simp) - apply(rule arith_diff) - apply(rule rbt_fold_eq, simp) - apply(rule arith_less) - apply(subst rbt_length[symmetric], simp) - apply(rule rbt_fold_large) - done -qed -definition "ty_obj_to_string = (\<lambda>ToyTyObj (ToyTyCore_pre s) _ \<Rightarrow> s)" -definition "cl_name_to_string = ty_obj_to_string o ClassRaw_name" - -definition "normalize0 f l = - rev (snd (List.fold (\<lambda>x (rbt, l). - let x0 = f x in - case RBT.lookup rbt x0 of - None \<Rightarrow> (RBT.insert x0 () rbt, x # l) - | Some _ \<Rightarrow> (rbt, l)) - l - (RBT.empty, [])))" - -definition "class_unflat = (\<lambda> (l_class, l_ass). - let l = - let const_toyany' = ToyTyCore_pre const_toyany - ; rbt = \<comment> \<open>fold classes:\<close> - \<comment> \<open>set \<open>ToyAny\<close> as default inherited class (for all classes linking to zero inherited classes)\<close> - insert - const_toyany - (toy_class_raw.make (ToyTyObj const_toyany' []) [] [] False) - (List.fold - (\<lambda> cflat \<Rightarrow> - insert (cl_name_to_string cflat) (cflat \<lparr> ClassRaw_name := case ClassRaw_name cflat of ToyTyObj n [] \<Rightarrow> ToyTyObj n [[const_toyany']] | x \<Rightarrow> x \<rparr>)) - l_class - RBT.empty) in - \<comment> \<open>fold associations:\<close> - \<comment> \<open>add remaining 'object' attributes\<close> - L.map snd (entries (List.fold (\<lambda> (ass_oid, ass) \<Rightarrow> - case let (l_none, l_some) = List.partition (\<lambda>(_, m). TyRole m = None) (ToyAss_relation' ass ) in - L.flatten [l_none, normalize0 (\<lambda>(_, m). case TyRole m of Some s \<Rightarrow> String.to_list s) l_some] of - [] \<Rightarrow> id - | [_] \<Rightarrow> id - | l_rel \<Rightarrow> - fold_max - (let n_rel = natural_of_nat (List.length l_rel) in - (\<lambda> (cpt_to, (name_to, category_to)). - case TyRole category_to of - Some role_to \<Rightarrow> - List.fold (\<lambda> (cpt_from, (name_from, mult_from)). - let name_from = ty_obj_to_string name_from in - map_entry name_from (\<lambda>cflat. cflat \<lparr> ClassRaw_own := (role_to, - ToyTy_class (toy_ty_class_ext const_oid ass_oid n_rel - (toy_ty_class_node_ext cpt_from mult_from name_from ()) - (toy_ty_class_node_ext cpt_to category_to (ty_obj_to_string name_to) ()) - ())) # ClassRaw_own cflat \<rparr>)) - | _ \<Rightarrow> \<lambda>_. id)) - l_rel) (L.mapi Pair l_ass) rbt)) in - class_unflat_aux - (List.fold (\<lambda> cflat. insert (cl_name_to_string cflat) - (normalize0 (String.to_list o fst) (L.map (map_prod id remove_binding) (ClassRaw_own cflat)))) - l - RBT.empty) - (List.fold - (\<lambda> cflat. - case ClassRaw_name cflat of - ToyTyObj n [] \<Rightarrow> id - | ToyTyObj n l \<Rightarrow> case rev ([n] # l) of x0 # xs \<Rightarrow> \<lambda>rbt. - snd (List.fold - (\<lambda> x (x0, rbt). - (x, List.fold (\<lambda> ToyTyCore_pre k \<Rightarrow> modify_def [] k (\<lambda>l. L.flatten [L.map (\<lambda>ToyTyCore_pre s \<Rightarrow> s) x, l])) - x0 - rbt)) - xs - (x0, rbt))) - l - RBT.empty) - RBT.empty - const_toyany)" - -definition "class_unflat' x = - (case class_unflat x of None \<Rightarrow> ToyClass const_toyany [] [] - | Some tree \<Rightarrow> tree)" - -fun nb_class where - "nb_class e = (\<lambda> ToyClass _ _ l \<Rightarrow> Suc (List.fold ((+) o nb_class) l 0)) e" - -definition "apply_optim_ass_arity ty_obj v = - (if TyObj_ass_arity ty_obj \<le> 2 then None - else Some v)" - -definition "is_higher_order = (\<lambda> ToyTy_collection _ _ \<Rightarrow> True | ToyTy_pair _ _ \<Rightarrow> True | _ \<Rightarrow> False)" - -definition "parse_ty_raw = (\<lambda> ToyTy_raw s \<Rightarrow> if s = \<open>int\<close> then ToyTy_base_integer else ToyTy_raw s - | x \<Rightarrow> x)" - -definition "is_sequence = list_ex (\<lambda> Sequence \<Rightarrow> True | _ \<Rightarrow> False) o TyCollect" - -fun str_of_ty where "str_of_ty e = - (\<lambda> ToyTy_base_void \<Rightarrow> \<open>Void\<close> - | ToyTy_base_boolean \<Rightarrow> \<open>Boolean\<close> - | ToyTy_base_integer \<Rightarrow> \<open>Integer\<close> - | ToyTy_base_unlimitednatural \<Rightarrow> \<open>UnlimitedNatural\<close> - | ToyTy_base_real \<Rightarrow> \<open>Real\<close> - | ToyTy_base_string \<Rightarrow> \<open>String\<close> - | ToyTy_object (ToyTyObj (ToyTyCore_pre s) _) \<Rightarrow> s - \<^cancel>\<open>| ToyTy_object (ToyTyObj (ToyTyCore ty_obj) _)\<close> - | ToyTy_collection t toy_ty \<Rightarrow> (if is_sequence t then - S.flatten [\<open>Sequence(\<close>, str_of_ty toy_ty,\<open>)\<close>] - else - S.flatten [\<open>Set(\<close>, str_of_ty toy_ty,\<open>)\<close>]) - | ToyTy_pair toy_ty1 toy_ty2 \<Rightarrow> S.flatten [\<open>Pair(\<close>, str_of_ty toy_ty1, \<open>,\<close>, str_of_ty toy_ty2,\<open>)\<close>] - | ToyTy_binding (_, toy_ty) \<Rightarrow> str_of_ty toy_ty - | ToyTy_class_syn s \<Rightarrow> s - | ToyTy_enum s \<Rightarrow> s - | ToyTy_raw s \<Rightarrow> S.flatten [\<open>\<acute>\<close>, s, \<open>\<acute>\<close>]) e" - -definition "ty_void = str_of_ty ToyTy_base_void" -definition "ty_boolean = str_of_ty ToyTy_base_boolean" -definition "ty_integer = str_of_ty ToyTy_base_integer" -definition "ty_unlimitednatural = str_of_ty ToyTy_base_unlimitednatural" -definition "ty_real = str_of_ty ToyTy_base_real" -definition "ty_string = str_of_ty ToyTy_base_string" - -definition "pref_ty_enum s = \<open>ty_enum\<close> @@ String.isub s" -definition "pref_ty_syn s = \<open>ty_syn\<close> @@ String.isub s" -definition "pref_constr_enum s = \<open>constr\<close> @@ String.isub s" - -fun str_hol_of_ty_all where "str_hol_of_ty_all f b e = - (\<lambda> ToyTy_base_void \<Rightarrow> b \<open>unit\<close> - | ToyTy_base_boolean \<Rightarrow> b \<open>bool\<close> - | ToyTy_base_integer \<Rightarrow> b \<open>int\<close> - | ToyTy_base_unlimitednatural \<Rightarrow> b \<open>nat\<close> - | ToyTy_base_real \<Rightarrow> b \<open>real\<close> - | ToyTy_base_string \<Rightarrow> b \<open>string\<close> - | ToyTy_object (ToyTyObj (ToyTyCore_pre s) _) \<Rightarrow> b const_oid - | ToyTy_object (ToyTyObj (ToyTyCore ty_obj) _) \<Rightarrow> f (b var_ty_list) [b (TyObj_name ty_obj)] - | ToyTy_collection _ ty \<Rightarrow> f (b var_ty_list) [str_hol_of_ty_all f b ty] - | ToyTy_pair ty1 ty2 \<Rightarrow> f (b var_ty_prod) [str_hol_of_ty_all f b ty1, str_hol_of_ty_all f b ty2] - | ToyTy_binding (_, t) \<Rightarrow> str_hol_of_ty_all f b t - | ToyTy_class_syn s \<Rightarrow> b (pref_ty_syn s) - | ToyTy_enum s \<Rightarrow> b (pref_ty_enum s) - | ToyTy_raw s \<Rightarrow> b s) e" - -fun get_class_hierarchy_strict_aux where - "get_class_hierarchy_strict_aux dataty l_res = - (List.fold - (\<lambda> ToyClass name l_attr dataty \<Rightarrow> \<lambda> l_res. - get_class_hierarchy_strict_aux dataty (ToyClass name l_attr dataty # l_res)) - dataty - l_res)" -definition "get_class_hierarchy_strict d = get_class_hierarchy_strict_aux d []" - -fun get_class_hierarchy'_aux where - "get_class_hierarchy'_aux l_res (ToyClass name l_attr dataty) = - (let l_res = ToyClass name l_attr dataty # l_res in - case dataty of [] \<Rightarrow> rev l_res - | dataty \<Rightarrow> List.fold (\<lambda>x acc. get_class_hierarchy'_aux acc x) dataty l_res)" -definition "get_class_hierarchy' = get_class_hierarchy'_aux []" - -definition "get_class_hierarchy e = L.map (\<lambda> ToyClass n l _ \<Rightarrow> (n, l)) (get_class_hierarchy' e)" - -definition "var_in_pre_state = \<open>in_pre_state\<close>" -definition "var_in_post_state = \<open>in_post_state\<close>" -definition "var_at_when_hol_post = \<open>\<close>" -definition "var_at_when_hol_pre = \<open>at_pre\<close>" -definition "var_at_when_toy_post = \<open>\<close>" -definition "var_at_when_toy_pre = \<open>@pre\<close>" - -datatype 'a tmp_sub = Tsub 'a -record 'a inheritance = - Inh :: 'a - Inh_sib :: "('a \<times> 'a list \<comment> \<open>flat version of the 1st component\<close>) list" \<comment> \<open>sibling\<close> - Inh_sib_unflat :: "'a list" \<comment> \<open>sibling\<close> -datatype 'a tmp_inh = Tinh 'a -datatype 'a tmp_univ = Tuniv 'a -definition "of_inh = (\<lambda>Tinh l \<Rightarrow> l)" -definition "of_linh = L.map Inh" -definition "of_sub = (\<lambda>Tsub l \<Rightarrow> l)" -definition "of_univ = (\<lambda>Tuniv l \<Rightarrow> l)" -definition "map_inh f = (\<lambda>Tinh l \<Rightarrow> Tinh (f l))" - -fun fold_class_gen_aux where - "fold_class_gen_aux l_inh f accu (ToyClass name l_attr dataty) = - (let accu = f (\<lambda>s. s @@ String.isub name) - name - l_attr - (Tinh l_inh) - (Tsub (get_class_hierarchy_strict dataty)) \<comment> \<open>order: bfs or dfs (modulo reversing)\<close> - dataty - accu in - case dataty of [] \<Rightarrow> accu - | _ \<Rightarrow> - fst (List.fold - (\<lambda> node (accu, l_inh_l, l_inh_r). - ( fold_class_gen_aux - ( \<lparr> Inh = ToyClass name l_attr dataty - , Inh_sib = L.flatten (L.map (L.map (\<lambda>l. (l, get_class_hierarchy' l))) [l_inh_l, tl l_inh_r]) - , Inh_sib_unflat = L.flatten [l_inh_l, tl l_inh_r] \<rparr> - # l_inh) - f accu node - , hd l_inh_r # l_inh_l - , tl l_inh_r)) - dataty - (accu, [], dataty)))" - -definition "fold_class_gen f accu expr = - (let (l_res, accu) = - fold_class_gen_aux - [] - (\<lambda> isub_name name l_attr l_inh l_subtree next_dataty (l_res, accu). - let (r, accu) = f isub_name name l_attr l_inh l_subtree next_dataty accu in - (r # l_res, accu)) - ([], accu) - expr in - (L.flatten l_res, accu))" - -definition "map_class_gen f = fst o fold_class_gen - (\<lambda> isub_name name l_attr l_inh l_subtree last_d. \<lambda> () \<Rightarrow> - (f isub_name name l_attr l_inh l_subtree last_d, ())) ()" - -definition "add_hierarchy'''' f x = (\<lambda>isub_name name l_attr l_inh l_subtree _. f isub_name name (Tuniv (get_class_hierarchy x)) l_attr (map_inh (L.map (\<lambda> ToyClass _ l _ \<Rightarrow> l) o of_linh) l_inh) l_subtree)" -definition "map_class f = map_class_gen (\<lambda>isub_name name l_attr l_inh l_subtree next_dataty. [f isub_name name l_attr l_inh (Tsub (L.map (\<lambda> ToyClass n _ _ \<Rightarrow> n) (of_sub l_subtree))) next_dataty])" -definition "fold_class f = fold_class_gen (\<lambda>isub_name name l_attr l_inh l_subtree next_dataty accu. let (x, accu) = f isub_name name l_attr (map_inh of_linh l_inh) (Tsub (L.map (\<lambda> ToyClass n _ _ \<Rightarrow> n) (of_sub l_subtree))) next_dataty accu in ([x], accu))" -definition "map_class_gen_h'''' f x = map_class_gen (add_hierarchy'''' (\<lambda>isub_name name l_inherited l_attr l_inh l_subtree. f isub_name name l_inherited l_attr l_inh (Tsub (L.map (\<lambda> ToyClass n _ _ \<Rightarrow> n) (of_sub l_subtree)))) x) x" - -definition "class_arity = RBT.keys o (\<lambda>l. List.fold (\<lambda>x. RBT.insert x ()) l RBT.empty) o - L.flatten o L.flatten o map_class (\<lambda> _ _ l_attr _ _ _. - L.map (\<lambda> (_, ToyTy_object (ToyTyObj (ToyTyCore ty_obj) _)) \<Rightarrow> [TyObj_ass_arity ty_obj] - | _ \<Rightarrow> []) l_attr)" - -definition "map_class_inh l_inherited = L.map (\<lambda> ToyClass _ l _ \<Rightarrow> l) (of_inh (map_inh of_linh l_inherited))" - -end diff --git a/Citadelle/src/compiler_generic/toy_example/embedding/meta_toy/Meta_Toy_extended.thy b/Citadelle/src/compiler_generic/toy_example/embedding/meta_toy/Meta_Toy_extended.thy deleted file mode 100644 index 10f799196f34fa9f9d6598c7b82a7c0d15a3814a..0000000000000000000000000000000000000000 --- a/Citadelle/src/compiler_generic/toy_example/embedding/meta_toy/Meta_Toy_extended.thy +++ /dev/null @@ -1,148 +0,0 @@ -(****************************************************************************** - * HOL-TOY - * - * 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. - ******************************************************************************) - -section\<open>Toy Meta-Model aka. AST definition of Toy (II)\<close> - -theory Meta_Toy_extended -imports "../../../Init" -begin - -subsection\<open>Type Definition\<close> - -datatype internal_oid = Oid nat -datatype internal_oids = Oids nat \<comment> \<open>start\<close> - nat \<comment> \<open>oid for assoc (incremented from start)\<close> - nat \<comment> \<open>oid for inh (incremented from start)\<close> - -datatype toy_def_base = ToyDefInteger "string" \<comment> \<open>integer digit\<close> - | ToyDefReal "string \<comment> \<open>integer digit (left)\<close> \<times> string \<comment> \<open>integer digit (right)\<close>" - | ToyDefString "string" - -datatype toy_data_shallow = ShallB_term toy_def_base - | ShallB_str string \<comment> \<open>binding\<close> - | ShallB_self internal_oid - | ShallB_list "toy_data_shallow list" - -datatype 'a toy_list_attr = ToyAttrNoCast 'a \<comment> \<open>inh, own\<close> - | ToyAttrCast - string \<comment> \<open>cast from\<close> - "'a toy_list_attr" \<comment> \<open>cast entity\<close> - 'a \<comment> \<open>inh, own\<close> - -record toy_instance_single = Inst_name :: "string option" \<comment> \<open>None: fresh name to be generated\<close> - Inst_ty :: "string option" \<comment> \<open>type\<close> - Inst_attr_with :: "string \<comment> \<open>name\<close> option" - Inst_attr :: "(( (string \<comment> \<open>pre state\<close> \<times> string \<comment> \<open>post state\<close>) option - \<comment> \<open>state used when \<open>toy_data_shallow\<close> is an object variable (for retrieving its oid)\<close> - \<times> string \<comment> \<open>name\<close> - \<times> toy_data_shallow) list) \<comment> \<open>inh and own\<close> - toy_list_attr" - -datatype toy_instance = ToyInstance "toy_instance_single list" \<comment> \<open>mutual recursive\<close> - -datatype toy_def_base_l = ToyDefBase "toy_def_base list" - -datatype 'a toy_def_state_core = ToyDefCoreAdd toy_instance_single - | ToyDefCoreBinding 'a - -datatype toy_def_state = ToyDefSt string \<comment> \<open>name\<close> - "string \<comment> \<open>name\<close> toy_def_state_core list" - -datatype toy_def_pp_core = ToyDefPPCoreAdd "string \<comment> \<open>name\<close> toy_def_state_core list" - | ToyDefPPCoreBinding string \<comment> \<open>name\<close> - -datatype toy_def_transition = ToyDefPP - "string option" \<comment> \<open>None: fresh name to be generated\<close> - toy_def_pp_core \<comment> \<open>pre\<close> - "toy_def_pp_core option" \<comment> \<open>post\<close> \<comment> \<open>None: same as pre\<close> - -datatype toy_class_tree = ToyClassTree nat \<comment> \<open>nb child\<close> - nat \<comment> \<open>depth\<close> - -subsection\<open>Object ID Management\<close> - -definition "oidInit = (\<lambda> Oid n \<Rightarrow> Oids n n n)" - -definition "oidSucAssoc = (\<lambda> Oids n1 n2 n3 \<Rightarrow> Oids n1 (Succ n2) (Succ n3))" -definition "oidSucInh = (\<lambda> Oids n1 n2 n3 \<Rightarrow> Oids n1 n2 (Succ n3))" -definition "oidGetAssoc = (\<lambda> Oids _ n _ \<Rightarrow> Oid n)" -definition "oidGetInh = (\<lambda> Oids _ _ n \<Rightarrow> Oid n)" - -definition "oidReinitAll = (\<lambda>Oids n1 _ _ \<Rightarrow> Oids n1 n1 n1)" -definition "oidReinitInh = (\<lambda>Oids n1 n2 _ \<Rightarrow> Oids n1 n2 n2)" - -subsection\<open>Operations of Fold, Map, ..., on the Meta-Model\<close> - -definition "toy_instance_single_empty = - \<lparr> Inst_name = None, Inst_ty = None, Inst_attr_with = None, Inst_attr = ToyAttrNoCast [] \<rparr>" - -fun map_data_shallow_self where - "map_data_shallow_self f e = (\<lambda> ShallB_self s \<Rightarrow> f s - | ShallB_list l \<Rightarrow> ShallB_list (List.map (map_data_shallow_self f) l) - | x \<Rightarrow> x) e" - -fun map_list_attr where - "map_list_attr f e = - (\<lambda> ToyAttrNoCast x \<Rightarrow> ToyAttrNoCast (f x) - | ToyAttrCast c_from l_attr x \<Rightarrow> ToyAttrCast c_from (map_list_attr f l_attr) (f x)) e" - -definition "map_instance_single f toyi = toyi \<lparr> Inst_attr := map_list_attr (L.map f) (Inst_attr toyi) \<rparr>" - -fun fold_list_attr where - "fold_list_attr cast_from f l_attr accu = (case l_attr of - ToyAttrNoCast x \<Rightarrow> f cast_from x accu - | ToyAttrCast c_from l_attr x \<Rightarrow> fold_list_attr (Some c_from) f l_attr (f cast_from x accu))" - -definition "inst_ty0 toyi = (case Inst_ty toyi of Some ty \<Rightarrow> Some ty - | None \<Rightarrow> (case Inst_attr toyi of ToyAttrCast ty _ _ \<Rightarrow> Some ty - | _ \<Rightarrow> None))" -definition "inst_ty toyi = (case inst_ty0 toyi of Some ty \<Rightarrow> ty)" - -definition "fold_instance_single f toyi = fold_list_attr (inst_ty0 toyi) (\<lambda> Some x \<Rightarrow> f x) (Inst_attr toyi)" -definition "fold_instance_single' f toyi = fold_list_attr (Inst_ty toyi) f (Inst_attr toyi)" - -definition "map_inst_single_self f = - map_instance_single - (map_prod id - (map_prod id - (map_data_shallow_self f)))" - -end diff --git a/Citadelle/src/compiler_generic/toy_example/embedding/meta_toy/Parser_META.thy b/Citadelle/src/compiler_generic/toy_example/embedding/meta_toy/Parser_META.thy deleted file mode 100644 index ae6bc1253e507dec6137aefb549995b3390e2407..0000000000000000000000000000000000000000 --- a/Citadelle/src/compiler_generic/toy_example/embedding/meta_toy/Parser_META.thy +++ /dev/null @@ -1,363 +0,0 @@ -(****************************************************************************** - * Citadelle - * - * 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. - ******************************************************************************) - -section\<open>Instantiating the Parser of META\<close> - -theory Parser_META -imports Meta_META - Parser_Toy - Parser_Toy_extended -begin - -subsection\<open>Building Recursors for Records\<close> (* NOTE part to be automated *) - -definition "compiler_env_config_rec0 f env = f - (D_output_disable_thy env) - (D_output_header_thy env) - (D_toy_oid_start env) - (D_output_position env) - (D_toy_semantics env) - (D_input_class env) - (D_input_meta env) - (D_input_instance env) - (D_input_state env) - (D_output_header_force env) - (D_output_auto_bootstrap env) - (D_toy_accessor env) - (D_toy_HO_type env) - (D_output_sorry_dirty env)" - -definition "compiler_env_config_rec f env = compiler_env_config_rec0 f env - (compiler_env_config.more env)" - -(* *) - -lemma [code]: "compiler_env_config.extend = (\<lambda>env v. compiler_env_config_rec0 (co14 (\<lambda>f. f v) compiler_env_config_ext) env)" -by(intro ext, simp add: compiler_env_config_rec0_def - compiler_env_config.extend_def - co14_def K_def) -lemma [code]: "compiler_env_config.make = co14 (\<lambda>f. f ()) compiler_env_config_ext" -by(intro ext, simp add: compiler_env_config.make_def - co14_def) -lemma [code]: "compiler_env_config.truncate = compiler_env_config_rec (co14 K compiler_env_config.make)" -by(intro ext, simp add: compiler_env_config_rec0_def - compiler_env_config_rec_def - compiler_env_config.truncate_def - compiler_env_config.make_def - co14_def K_def) - -subsection\<open>Main\<close> - -context Parse -begin - -definition "of_toy_flush_all a b = rec_toy_flush_all - (b \<open>ToyFlushAll\<close>)" - -definition "of_toy_generic a b = rec_toy_generic - (ap1 a (b \<open>ToyGeneric\<close>) (of_string a b))" - -definition "of_floor a b = rec_floor - (b \<open>Floor1\<close>) - (b \<open>Floor2\<close>) - (b \<open>Floor3\<close>)" - -definition "of_all_meta_embedding a b = rec_all_meta_embedding - (ap1 a (b \<open>META_enum\<close>) (of_toy_enum a b)) - (ap2 a (b \<open>META_class_raw\<close>) (of_floor a b) (of_toy_class_raw a b (K of_unit))) - (ap1 a (b \<open>META_association\<close>) (of_toy_association a b (K of_unit))) - (ap2 a (b \<open>META_ass_class\<close>) (of_floor a b) (of_toy_ass_class a b)) - (ap2 a (b \<open>META_ctxt\<close>) (of_floor a b) (of_toy_ctxt a b (K of_unit))) - - (ap1 a (b \<open>META_class_synonym\<close>) (of_toy_class_synonym a b)) - (ap1 a (b \<open>META_instance\<close>) (of_toy_instance a b)) - (ap1 a (b \<open>META_def_base_l\<close>) (of_toy_def_base_l a b)) - (ap2 a (b \<open>META_def_state\<close>) (of_floor a b) (of_toy_def_state a b)) - (ap2 a (b \<open>META_def_transition\<close>) (of_floor a b) (of_toy_def_transition a b)) - (ap1 a (b \<open>META_class_tree\<close>) (of_toy_class_tree a b)) - (ap1 a (b \<open>META_flush_all\<close>) (of_toy_flush_all a b)) - (ap1 a (b \<open>META_generic\<close>) (of_toy_generic a b))" - -definition "of_generation_semantics_toy a b = rec_generation_semantics_toy - (b \<open>Gen_only_design\<close>) - (b \<open>Gen_only_analysis\<close>) - (b \<open>Gen_default\<close>)" - -definition "of_generation_lemma_mode a b = rec_generation_lemma_mode - (b \<open>Gen_sorry\<close>) - (b \<open>Gen_no_dirty\<close>)" - -definition "of_compiler_env_config a b f = compiler_env_config_rec - (ap15 a (b (ext \<open>compiler_env_config_ext\<close>)) - (of_bool b) - (of_option a b (of_pair a b (of_string a b) (of_pair a b (of_list a b (of_string a b)) (of_string a b)))) - (of_internal_oids a b) - (of_pair a b (of_nat a b) (of_nat a b)) - (of_generation_semantics_toy a b) - (of_option a b (of_toy_class a b)) - (of_list a b (of_all_meta_embedding a b)) - (of_list a b (of_pair a b (of_string\<^sub>b\<^sub>a\<^sub>s\<^sub>e a b) (of_pair a b (of_toy_instance_single a b (K of_unit)) (of_internal_oids a b)))) - (of_list a b (of_pair a b (of_string\<^sub>b\<^sub>a\<^sub>s\<^sub>e a b) (of_list a b (of_pair a b (of_internal_oids a b) (of_toy_def_state_core a b (of_pair a b (of_string a b) (of_toy_instance_single a b (K of_unit)))))))) - (of_bool b) - (of_bool b) - (of_pair a b (of_list a b (of_string\<^sub>b\<^sub>a\<^sub>s\<^sub>e a b)) (of_list a b (of_string\<^sub>b\<^sub>a\<^sub>s\<^sub>e a b))) - (of_list a b (of_string\<^sub>b\<^sub>a\<^sub>s\<^sub>e a b)) - (of_pair a b (of_option a b (of_generation_lemma_mode a b)) (of_bool b)) - (f a b))" - -end - -lemmas [code] = - Parse.of_toy_flush_all_def - Parse.of_toy_generic_def - Parse.of_floor_def - Parse.of_all_meta_embedding_def - Parse.of_generation_semantics_toy_def - Parse.of_generation_lemma_mode_def - Parse.of_compiler_env_config_def - -section\<open>Finalizing the Parser\<close> - -text\<open>It should be feasible to invent a meta-command (e.g., @{text "datatype'"}) -to automatically generate the previous recursors in @{text Parse}. - -Otherwise as an extra check, one can also overload polymorphic cartouches in @{theory Isabelle_Meta_Model.Init} -to really check that all the given constructor exists at the time of editing -(similarly as writing @{verbatim "@{term ...}"}, -when it is embedded in a @{verbatim "text"} command).\<close> - -subsection\<open>Isabelle Syntax\<close> - -locale Parse_Isabelle -begin - -definition "Of_Pair = \<open>Pair\<close>" -definition "Of_Nil = \<open>Nil\<close>" -definition "Of_Cons = \<open>Cons\<close>" -definition "Of_None = \<open>None\<close>" -definition "Of_Some = \<open>Some\<close>" - -\<comment> \<open>recursor types\<close> - -definition "of_pair a b f1 f2 = (\<lambda>f. \<lambda>(c, d) \<Rightarrow> f c d) - (ap2 a (b Of_Pair) f1 f2)" - -definition "of_list a b f = (\<lambda>f0. rec_list f0 o co1 K) - (b Of_Nil) - (ar2 a (b Of_Cons) f)" - -definition "of_option a b f = rec_option - (b Of_None) - (ap1 a (b Of_Some) f)" - -\<comment> \<open>ground types\<close> - -definition "of_unit b = case_unit - (b \<open>()\<close>)" - -definition of_bool where "of_bool b = case_bool - (b \<open>True\<close>) - (b \<open>False\<close>)" - -definition "of_string_gen s_flatten s_st0 s_st a b s = - b (let s = textstr_of_str (\<lambda>c. \<open>(\<close> @@ s_flatten @@ \<open> \<close> @@ c @@ \<open>)\<close>) - (\<lambda>c \<Rightarrow> s_st0 (S.flatten [\<open> 0x\<close>, String.integer_to_digit16 c])) - (\<lambda>c. s_st (S.flatten [\<open> (\<close>, c, \<open>)\<close>])) - s in - S.flatten [ \<open>(\<close>, s, \<open>)\<close> ])" - -definition "of_string = of_string_gen \<open>Init.S.flatten\<close> - (\<lambda>s. S.flatten [\<open>(Init.ST0\<close>, s, \<open>)\<close>]) - (\<lambda>s. S.flatten [\<open>(Init.abr_string.SS_base (Init.string\<^sub>b\<^sub>a\<^sub>s\<^sub>e.ST\<close>, s, \<open>))\<close>])" -definition "of_string\<^sub>b\<^sub>a\<^sub>s\<^sub>e a b s = of_string_gen \<open>Init.String\<^sub>b\<^sub>a\<^sub>s\<^sub>e.flatten\<close> - (\<lambda>s. S.flatten [\<open>(Init.ST0_base\<close>, s, \<open>)\<close>]) - (\<lambda>s. S.flatten [\<open>(Init.string\<^sub>b\<^sub>a\<^sub>s\<^sub>e.ST\<close>, s, \<open>)\<close>]) - a - b - (String\<^sub>b\<^sub>a\<^sub>s\<^sub>e.to_String s)" - -definition of_nat where "of_nat a b = b o String.natural_to_digit10" - -end - -sublocale Parse_Isabelle < Parse "id" - Parse_Isabelle.of_string - Parse_Isabelle.of_string\<^sub>b\<^sub>a\<^sub>s\<^sub>e - Parse_Isabelle.of_nat - Parse_Isabelle.of_unit - Parse_Isabelle.of_bool - Parse_Isabelle.Of_Pair - Parse_Isabelle.Of_Nil - Parse_Isabelle.Of_Cons - Parse_Isabelle.Of_None - Parse_Isabelle.Of_Some -done - -context Parse_Isabelle begin - definition "compiler_env_config a b = - of_compiler_env_config a b (\<lambda> a b. - of_pair a b - (of_list a b (of_all_meta_embedding a b)) - (of_option a b (of_string a b)))" -end - -definition "isabelle_of_compiler_env_config = Parse_Isabelle.compiler_env_config" - -lemmas [code] = - Parse_Isabelle.Of_Pair_def - Parse_Isabelle.Of_Nil_def - Parse_Isabelle.Of_Cons_def - Parse_Isabelle.Of_None_def - Parse_Isabelle.Of_Some_def - - Parse_Isabelle.of_pair_def - Parse_Isabelle.of_list_def - Parse_Isabelle.of_option_def - Parse_Isabelle.of_unit_def - Parse_Isabelle.of_bool_def - Parse_Isabelle.of_string_gen_def - Parse_Isabelle.of_string_def - Parse_Isabelle.of_string\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def - Parse_Isabelle.of_nat_def - - Parse_Isabelle.compiler_env_config_def - -(* *) - -definition "isabelle_apply s l = S.flatten [s, S.flatten (L.map (\<lambda> s. S.flatten [\<open> (\<close>, s, \<open>)\<close>]) l)]" - -subsection\<open>SML Syntax\<close> - -locale Parse_SML -begin - -definition "Of_Pair = \<open>I\<close>" -definition "Of_Nil = \<open>nil\<close>" -definition "Of_Cons = \<open>uncurry cons\<close>" (* val cons2 = uncurry cons *) -definition "Of_None = \<open>NONE\<close>" -definition "Of_Some = \<open>SOME\<close>" - -(* *) - -definition "of_pair a b f1 f2 = (\<lambda>f. \<lambda>(c, d) \<Rightarrow> f c d) - (ap2 a (b Of_Pair) f1 f2)" - -definition "of_list a b f = (\<lambda>f0. rec_list f0 o co1 K) - (b Of_Nil) - (ar2 a (b Of_Cons) f)" - -definition "of_option a b f = rec_option - (b Of_None) - (ap1 a (b Of_Some) f)" - -(* *) - -definition "of_unit b = case_unit - (b \<open>()\<close>)" - -definition of_bool where "of_bool b = case_bool - (b \<open>true\<close>) - (b \<open>false\<close>)" - -definition \<open>sml_escape = - String.replace_integers (\<lambda>x. if x = 0x0A then \<open>\n\<close> - else if x = 0x05 then \<open>\005\<close> - else if x = 0x06 then \<open>\006\<close> - else if x = 0x7F then \<open>\127\<close> - else \<degree>x\<degree>)\<close> - -definition \<open>of_string a b = - (\<lambda>x. b (S.flatten [ \<open>(META.SS_base (META.ST "\<close> - , sml_escape x - , \<open>"))\<close>]))\<close> - -definition \<open>of_string\<^sub>b\<^sub>a\<^sub>s\<^sub>e a b = - (\<lambda>x. b (S.flatten [ \<open>(META.ST "\<close> - , sml_escape (String\<^sub>b\<^sub>a\<^sub>s\<^sub>e.to_String x) - , \<open>")\<close>]))\<close> - -definition of_nat where "of_nat a b = (\<lambda>x. b (S.flatten [\<open>(Code_Numeral.natural_of_integer \<close>, String.natural_to_digit10 x, \<open>)\<close>]))" - -end - -sublocale Parse_SML < Parse "\<lambda>c. case String.to_list c of x # xs \<Rightarrow> S.flatten [String.uppercase \<lless>[x]\<ggreater>, \<lless>xs\<ggreater>]" - Parse_SML.of_string - Parse_SML.of_string\<^sub>b\<^sub>a\<^sub>s\<^sub>e - Parse_SML.of_nat - Parse_SML.of_unit - Parse_SML.of_bool - Parse_SML.Of_Pair - Parse_SML.Of_Nil - Parse_SML.Of_Cons - Parse_SML.Of_None - Parse_SML.Of_Some -done - -context Parse_SML begin - definition "compiler_env_config a b = of_compiler_env_config a b (\<lambda> _. of_unit)" -end - -definition "sml_of_compiler_env_config = Parse_SML.compiler_env_config" - -lemmas [code] = - Parse_SML.Of_Pair_def - Parse_SML.Of_Nil_def - Parse_SML.Of_Cons_def - Parse_SML.Of_None_def - Parse_SML.Of_Some_def - - Parse_SML.of_pair_def - Parse_SML.of_list_def - Parse_SML.of_option_def - Parse_SML.of_unit_def - Parse_SML.of_bool_def - Parse_SML.of_string_def - Parse_SML.of_string\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def - Parse_SML.of_nat_def - - Parse_SML.sml_escape_def - Parse_SML.compiler_env_config_def - -(* *) - -definition "sml_apply s l = S.flatten [s, \<open> (\<close>, case l of x # xs \<Rightarrow> S.flatten [x, S.flatten (L.map (\<lambda>s. S.flatten [\<open>, \<close>, s]) xs)], \<open>)\<close> ]" - -end diff --git a/Citadelle/src/compiler_generic/toy_example/embedding/meta_toy/Parser_Toy.thy b/Citadelle/src/compiler_generic/toy_example/embedding/meta_toy/Parser_Toy.thy deleted file mode 100644 index 5c13943ee56ddabc8f07af32918c90dddaf75172..0000000000000000000000000000000000000000 --- a/Citadelle/src/compiler_generic/toy_example/embedding/meta_toy/Parser_Toy.thy +++ /dev/null @@ -1,318 +0,0 @@ -(****************************************************************************** - * HOL-TOY - * - * 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. - ******************************************************************************) - -section\<open>Instantiating the Parser of Toy (I)\<close> - -theory Parser_Toy -imports Meta_Toy - "../../../meta_isabelle/Parser_Pure" -begin - -subsection\<open>Building Recursors for Records\<close> (* NOTE part to be automated *) - -definition "toy_multiplicity_rec0 f toy = f - (TyMult toy) - (TyRole toy) - (TyCollect toy)" - -definition "toy_multiplicity_rec f toy = toy_multiplicity_rec0 f toy - (toy_multiplicity.more toy)" - -definition "toy_ty_class_node_rec0 f toy = f - (TyObjN_ass_switch toy) - (TyObjN_role_multip toy) - (TyObjN_role_ty toy)" - -definition "toy_ty_class_node_rec f toy = toy_ty_class_node_rec0 f toy - (toy_ty_class_node.more toy)" - -definition "toy_ty_class_rec0 f toy = f - (TyObj_name toy) - (TyObj_ass_id toy) - (TyObj_ass_arity toy) - (TyObj_from toy) - (TyObj_to toy)" - -definition "toy_ty_class_rec f toy = toy_ty_class_rec0 f toy - (toy_ty_class.more toy)" - -definition "toy_class_raw_rec0 f toy = f - (ClassRaw_name toy) - (ClassRaw_own toy) - (ClassRaw_clause toy) - (ClassRaw_abstract toy)" - -definition "toy_class_raw_rec f toy = toy_class_raw_rec0 f toy - (toy_class_raw.more toy)" - -definition "toy_association_rec0 f toy = f - (ToyAss_type toy) - (ToyAss_relation toy)" - -definition "toy_association_rec f toy = toy_association_rec0 f toy - (toy_association.more toy)" - -definition "toy_ctxt_pre_post_rec0 f toy = f - (Ctxt_fun_name toy) - (Ctxt_fun_ty toy) - (Ctxt_expr toy)" - -definition "toy_ctxt_pre_post_rec f toy = toy_ctxt_pre_post_rec0 f toy - (toy_ctxt_pre_post.more toy)" - -definition "toy_ctxt_rec0 f toy = f - (Ctxt_param toy) - (Ctxt_ty toy) - (Ctxt_clause toy)" - -definition "toy_ctxt_rec f toy = toy_ctxt_rec0 f toy - (toy_ctxt.more toy)" - -(* *) - -lemma [code]: "toy_class_raw.extend = (\<lambda>toy v. toy_class_raw_rec0 (co4 (\<lambda>f. f v) toy_class_raw_ext) toy)" -by(intro ext, simp add: toy_class_raw_rec0_def - toy_class_raw.extend_def - co4_def K_def) -lemma [code]: "toy_class_raw.make = co4 (\<lambda>f. f ()) toy_class_raw_ext" -by(intro ext, simp add: toy_class_raw.make_def - co4_def) -lemma [code]: "toy_class_raw.truncate = toy_class_raw_rec (co4 K toy_class_raw.make)" -by(intro ext, simp add: toy_class_raw_rec0_def - toy_class_raw_rec_def - toy_class_raw.truncate_def - toy_class_raw.make_def - co4_def K_def) - -lemma [code]: "toy_association.extend = (\<lambda>toy v. toy_association_rec0 (co2 (\<lambda>f. f v) toy_association_ext) toy)" -by(intro ext, simp add: toy_association_rec0_def - toy_association.extend_def - co2_def K_def) -lemma [code]: "toy_association.make = co2 (\<lambda>f. f ()) toy_association_ext" -by(intro ext, simp add: toy_association.make_def - co2_def) -lemma [code]: "toy_association.truncate = toy_association_rec (co2 K toy_association.make)" -by(intro ext, simp add: toy_association_rec0_def - toy_association_rec_def - toy_association.truncate_def - toy_association.make_def - co2_def K_def) - -subsection\<open>Main\<close> - -context Parse -begin - -definition "of_toy_collection b = rec_toy_collection - (b \<open>Set\<close>) - (b \<open>Sequence\<close>) - (b \<open>Ordered0\<close>) - (b \<open>Subsets0\<close>) - (b \<open>Union0\<close>) - (b \<open>Redefines0\<close>) - (b \<open>Derived0\<close>) - (b \<open>Qualifier0\<close>) - (b \<open>Nonunique0\<close>)" - -definition "of_toy_multiplicity_single a b = rec_toy_multiplicity_single - (ap1 a (b \<open>Mult_nat\<close>) (of_nat a b)) - (b \<open>Mult_star\<close>) - (b \<open>Mult_infinity\<close>)" - -definition "of_toy_multiplicity a b f = toy_multiplicity_rec - (ap4 a (b (ext \<open>toy_multiplicity_ext\<close>)) - (of_list a b (of_pair a b (of_toy_multiplicity_single a b) (of_option a b (of_toy_multiplicity_single a b)))) - (of_option a b (of_string a b)) - (of_list a b (of_toy_collection b)) - (f a b))" - -definition "of_toy_ty_class_node a b f = toy_ty_class_node_rec - (ap4 a (b (ext \<open>toy_ty_class_node_ext\<close>)) - (of_nat a b) - (of_toy_multiplicity a b (K of_unit)) - (of_string a b) - (f a b))" - -definition "of_toy_ty_class a b f = toy_ty_class_rec - (ap6 a (b (ext \<open>toy_ty_class_ext\<close>)) - (of_string a b) - (of_nat a b) - (of_nat a b) - (of_toy_ty_class_node a b (K of_unit)) - (of_toy_ty_class_node a b (K of_unit)) - (f a b))" - -definition "of_toy_ty_obj_core a b = rec_toy_ty_obj_core - (ap1 a (b \<open>ToyTyCore_pre\<close>) (of_string a b)) - (ap1 a (b \<open>ToyTyCore\<close>) (of_toy_ty_class a b (K of_unit)))" - -definition "of_toy_ty_obj a b = rec_toy_ty_obj - (ap2 a (b \<open>ToyTyObj\<close>) (of_toy_ty_obj_core a b) (of_list a b (of_list a b (of_toy_ty_obj_core a b))))" - -definition "of_toy_ty a b = (\<lambda>f1 f2 f3 f4 f5 f6 f7 f8 f9 f10 f11 f12 f13 f14 f15. - rec_toy_ty f1 f2 f3 f4 f5 f6 - f7 (K o f8) (\<lambda>_ _. f9) (f10 o map_prod id snd) (\<lambda>_ _. f11) f12 f13 f14 f15) - (b \<open>ToyTy_base_void\<close>) - (b \<open>ToyTy_base_boolean\<close>) - (b \<open>ToyTy_base_integer\<close>) - (b \<open>ToyTy_base_unlimitednatural\<close>) - (b \<open>ToyTy_base_real\<close>) - (b \<open>ToyTy_base_string\<close>) - (ap1 a (b \<open>ToyTy_object\<close>) (of_toy_ty_obj a b)) - (ar2 a (b \<open>ToyTy_collection\<close>) (of_toy_multiplicity a b (K of_unit))) - (ar2 a (b \<open>ToyTy_pair\<close>) id) - (ap1 a (b \<open>ToyTy_binding\<close>) (of_pair a b (of_option a b (of_string a b)) id)) - (ar2 a (b \<open>ToyTy_arrow\<close>) id) - (ap1 a (b \<open>ToyTy_class_syn\<close>) (of_string a b)) - (ap1 a (b \<open>ToyTy_enum\<close>) (of_string a b)) - (ap1 a (b \<open>ToyTy_raw\<close>) (of_string a b))" - -definition "of_toy_association_type a b = rec_toy_association_type - (b \<open>ToyAssTy_native_attribute\<close>) - (b \<open>ToyAssTy_association\<close>) - (b \<open>ToyAssTy_composition\<close>) - (b \<open>ToyAssTy_aggregation\<close>)" - -definition "of_toy_association_relation a b = rec_toy_association_relation - (ap1 a (b \<open>ToyAssRel\<close>) - (of_list a b (of_pair a b (of_toy_ty_obj a b) (of_toy_multiplicity a b (K of_unit)))))" - -definition "of_toy_association a b f = toy_association_rec - (ap3 a (b (ext \<open>toy_association_ext\<close>)) - (of_toy_association_type a b) - (of_toy_association_relation a b) - (f a b))" - -definition "of_toy_ctxt_prefix a b = rec_toy_ctxt_prefix - (b \<open>ToyCtxtPre\<close>) - (b \<open>ToyCtxtPost\<close>)" - -definition "of_toy_ctxt_term a b = (\<lambda>f0 f1 f2. rec_toy_ctxt_term f0 f1 (co1 K f2)) - (ap2 a (b \<open>T_pure\<close>) (of_pure_term a b) (of_option a b (of_string a b))) - (ap2 a (b \<open>T_to_be_parsed\<close>) (of_string a b) (of_string a b)) - (ar2 a (b \<open>T_lambda\<close>) (of_string a b))" - -definition "of_toy_prop a b = rec_toy_prop - (ap2 a (b \<open>ToyProp_ctxt\<close>) (of_option a b (of_string a b)) (of_toy_ctxt_term a b))" - -definition "of_toy_ctxt_term_inv a b = rec_toy_ctxt_term_inv - (ap2 a (b \<open>T_inv\<close>) (of_bool b) (of_toy_prop a b))" - -definition "of_toy_ctxt_term_pp a b = rec_toy_ctxt_term_pp - (ap2 a (b \<open>T_pp\<close>) (of_toy_ctxt_prefix a b) (of_toy_prop a b)) - (ap1 a (b \<open>T_invariant\<close>) (of_toy_ctxt_term_inv a b))" - -definition "of_toy_ctxt_pre_post a b f = toy_ctxt_pre_post_rec - (ap4 a (b (ext \<open>toy_ctxt_pre_post_ext\<close>)) - (of_string a b) - (of_toy_ty a b) - (of_list a b (of_toy_ctxt_term_pp a b)) - (f a b))" - -definition "of_toy_ctxt_clause a b = rec_toy_ctxt_clause - (ap1 a (b \<open>Ctxt_pp\<close>) (of_toy_ctxt_pre_post a b (K of_unit))) - (ap1 a (b \<open>Ctxt_inv\<close>) (of_toy_ctxt_term_inv a b))" - -definition "of_toy_ctxt a b f = toy_ctxt_rec - (ap4 a (b (ext \<open>toy_ctxt_ext\<close>)) - (of_list a b (of_string a b)) - (of_toy_ty_obj a b) - (of_list a b (of_toy_ctxt_clause a b)) - (f a b))" - -definition "of_toy_class a b = (\<lambda>f0 f1 f2 f3. rec_toy_class (ap3 a f0 f1 f2 f3)) - (b \<open>ToyClass\<close>) - (of_string a b) - (of_list a b (of_pair a b (of_string a b) (of_toy_ty a b))) - (of_list a b snd)" - -definition "of_toy_class_raw a b f = toy_class_raw_rec - (ap5 a (b (ext \<open>toy_class_raw_ext\<close>)) - (of_toy_ty_obj a b) - (of_list a b (of_pair a b (of_string a b) (of_toy_ty a b))) - (of_list a b (of_toy_ctxt_clause a b)) - (of_bool b) - (f a b))" - -definition "of_toy_ass_class a b = rec_toy_ass_class - (ap2 a (b \<open>ToyAssClass\<close>) - (of_toy_association a b (K of_unit)) - (of_toy_class_raw a b (K of_unit)))" - -definition "of_toy_class_synonym a b = rec_toy_class_synonym - (ap2 a (b \<open>ToyClassSynonym\<close>) - (of_string a b) - (of_toy_ty a b))" - -definition "of_toy_enum a b = rec_toy_enum - (ap2 a (b \<open>ToyEnum\<close>) - (of_string a b) - (of_list a b (of_string a b)))" - -end - -lemmas [code] = - Parse.of_toy_collection_def - Parse.of_toy_multiplicity_single_def - Parse.of_toy_multiplicity_def - Parse.of_toy_ty_class_node_def - Parse.of_toy_ty_class_def - Parse.of_toy_ty_obj_core_def - Parse.of_toy_ty_obj_def - Parse.of_toy_ty_def - Parse.of_toy_association_type_def - Parse.of_toy_association_relation_def - Parse.of_toy_association_def - Parse.of_toy_ctxt_prefix_def - Parse.of_toy_ctxt_term_def - Parse.of_toy_prop_def - Parse.of_toy_ctxt_term_inv_def - Parse.of_toy_ctxt_term_pp_def - Parse.of_toy_ctxt_pre_post_def - Parse.of_toy_ctxt_clause_def - Parse.of_toy_ctxt_def - Parse.of_toy_class_def - Parse.of_toy_class_raw_def - Parse.of_toy_ass_class_def - Parse.of_toy_class_synonym_def - Parse.of_toy_enum_def - -end diff --git a/Citadelle/src/compiler_generic/toy_example/embedding/meta_toy/Parser_Toy_extended.thy b/Citadelle/src/compiler_generic/toy_example/embedding/meta_toy/Parser_Toy_extended.thy deleted file mode 100644 index 18f6f32786545d2bfbc2065ba46a44f4954bc44b..0000000000000000000000000000000000000000 --- a/Citadelle/src/compiler_generic/toy_example/embedding/meta_toy/Parser_Toy_extended.thy +++ /dev/null @@ -1,162 +0,0 @@ -(****************************************************************************** - * HOL-TOY - * - * 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. - ******************************************************************************) - -section\<open>Instantiating the Parser of Toy (II)\<close> - -theory Parser_Toy_extended -imports Meta_Toy_extended - "../../../meta_isabelle/Parser_init" -begin - -subsection\<open>Building Recursors for Records\<close> (* NOTE part to be automated *) - -definition "toy_instance_single_rec0 f toy = f - (Inst_name toy) - (Inst_ty toy) - (Inst_attr_with toy) - (Inst_attr toy)" - -definition "toy_instance_single_rec f toy = toy_instance_single_rec0 f toy - (toy_instance_single.more toy)" - -(* *) - -lemma [code]: "toy_instance_single.extend = (\<lambda>toy v. toy_instance_single_rec0 (co4 (\<lambda>f. f v) toy_instance_single_ext) toy)" -by(intro ext, simp add: toy_instance_single_rec0_def - toy_instance_single.extend_def - co4_def K_def) -lemma [code]: "toy_instance_single.make = co4 (\<lambda>f. f ()) toy_instance_single_ext" -by(intro ext, simp add: toy_instance_single.make_def - co4_def) -lemma [code]: "toy_instance_single.truncate = toy_instance_single_rec (co4 K toy_instance_single.make)" -by(intro ext, simp add: toy_instance_single_rec0_def - toy_instance_single_rec_def - toy_instance_single.truncate_def - toy_instance_single.make_def - co4_def K_def) - -subsection\<open>Main\<close> - -context Parse -begin - -definition "of_internal_oid a b = rec_internal_oid - (ap1 a (b \<open>Oid\<close>) (of_nat a b))" - -definition "of_internal_oids a b = rec_internal_oids - (ap3 a (b \<open>Oids\<close>) - (of_nat a b) - (of_nat a b) - (of_nat a b))" - -definition "of_toy_def_base a b = rec_toy_def_base - (ap1 a (b \<open>ToyDefInteger\<close>) (of_string a b)) - (ap1 a (b \<open>ToyDefReal\<close>) (of_pair a b (of_string a b) (of_string a b))) - (ap1 a (b \<open>ToyDefString\<close>) (of_string a b))" - -definition "of_toy_data_shallow a b = rec_toy_data_shallow - (ap1 a (b \<open>ShallB_term\<close>) (of_toy_def_base a b)) - (ap1 a (b \<open>ShallB_str\<close>) (of_string a b)) - (ap1 a (b \<open>ShallB_self\<close>) (of_internal_oid a b)) - (ap1 a (b \<open>ShallB_list\<close>) (of_list a b snd))" - -definition "of_toy_list_attr a b f = (\<lambda>f0. co4 (\<lambda>f1. rec_toy_list_attr f0 (\<lambda>s _ a rec. f1 s rec a)) (ap3 a)) - (ap1 a (b \<open>ToyAttrNoCast\<close>) f) - (b \<open>ToyAttrCast\<close>) - (of_string a b) - id - f" - -definition "of_toy_instance_single a b f = toy_instance_single_rec - (ap5 a (b (ext \<open>toy_instance_single_ext\<close>)) - (of_option a b (of_string a b)) - (of_option a b (of_string a b)) - (of_option a b (of_string a b)) - (of_toy_list_attr a b (of_list a b (of_pair a b (of_option a b (of_pair a b (of_string a b) (of_string a b))) (of_pair a b (of_string a b) (of_toy_data_shallow a b))))) - (f a b))" - -definition "of_toy_instance a b = rec_toy_instance - (ap1 a (b \<open>ToyInstance\<close>) - (of_list a b (of_toy_instance_single a b (K of_unit))))" - -definition "of_toy_def_base_l a b = rec_toy_def_base_l - (ap1 a (b \<open>ToyDefBase\<close>) (of_list a b (of_toy_def_base a b)))" - -definition "of_toy_def_state_core a b f = rec_toy_def_state_core - (ap1 a (b \<open>ToyDefCoreAdd\<close>) (of_toy_instance_single a b (K of_unit))) - (ap1 a (b \<open>ToyDefCoreBinding\<close>) f)" - -definition "of_toy_def_state a b = rec_toy_def_state - (ap2 a (b \<open>ToyDefSt\<close>) (of_string a b) (of_list a b (of_toy_def_state_core a b (of_string a b))))" - -definition "of_toy_def_pp_core a b = rec_toy_def_pp_core - (ap1 a (b \<open>ToyDefPPCoreAdd\<close>) (of_list a b (of_toy_def_state_core a b (of_string a b)))) - (ap1 a (b \<open>ToyDefPPCoreBinding\<close>) (of_string a b))" - -definition "of_toy_def_transition a b = rec_toy_def_transition - (ap3 a (b \<open>ToyDefPP\<close>) - (of_option a b (of_string a b)) - (of_toy_def_pp_core a b) - (of_option a b (of_toy_def_pp_core a b)))" - -definition "of_toy_class_tree a b = rec_toy_class_tree - (ap2 a (b \<open>ToyClassTree\<close>) - (of_nat a b) - (of_nat a b))" - -end - -lemmas [code] = - Parse.of_internal_oid_def - Parse.of_internal_oids_def - Parse.of_toy_def_base_def - Parse.of_toy_data_shallow_def - Parse.of_toy_list_attr_def - Parse.of_toy_instance_single_def - Parse.of_toy_instance_def - Parse.of_toy_def_base_l_def - Parse.of_toy_def_state_core_def - Parse.of_toy_def_state_def - Parse.of_toy_def_pp_core_def - Parse.of_toy_def_transition_def - Parse.of_toy_class_tree_def - -end diff --git a/Citadelle/src/compiler_generic/toy_example/embedding/meta_toy/Printer_META.thy b/Citadelle/src/compiler_generic/toy_example/embedding/meta_toy/Printer_META.thy deleted file mode 100644 index 8103d8d97d6ab0849a4f5da8c96796c028fd0ea6..0000000000000000000000000000000000000000 --- a/Citadelle/src/compiler_generic/toy_example/embedding/meta_toy/Printer_META.thy +++ /dev/null @@ -1,171 +0,0 @@ -(****************************************************************************** - * Citadelle - * - * 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. - ******************************************************************************) - -section\<open>Instantiating the Printer for META\<close> - -theory Printer_META -imports Parser_META - "../../../meta_isabelle/Printer_Isabelle" - Printer_Toy_extended -begin - -context Print -begin - -definition "of\<^sub>e\<^sub>n\<^sub>v_section env = - (if D_output_disable_thy env then - \<lambda>_. \<open>\<close> - else - of_section env)" - -definition "of\<^sub>e\<^sub>n\<^sub>v_semi__theory env = - (\<lambda> Theory_section section_title \<Rightarrow> of\<^sub>e\<^sub>n\<^sub>v_section env section_title - | x \<Rightarrow> of_semi__theory env x)" - -definition \<open>of\<^sub>e\<^sub>n\<^sub>v_semi__theories env = - (\<lambda> Theories_one t \<Rightarrow> of\<^sub>e\<^sub>n\<^sub>v_semi__theory env t - | Theories_locale data l \<Rightarrow> - \<open>locale %s = -%s -begin -%s -end\<close> (To_string (HolThyLocale_name data)) - (String_concat_map - \<open> -\<close> - (\<lambda> (l_fix, o_assum). - \<open>%s%s\<close> (String_concat_map \<open> -\<close> (\<lambda>(e, ty). \<open>fixes "%s" :: "%s"\<close> (of_semi__term e) (of_semi__typ ty)) l_fix) - (case o_assum of None \<Rightarrow> \<open>\<close> - | Some (name, e) \<Rightarrow> \<open> -assumes %s: "%s"\<close> (To_string name) (of_semi__term e))) - (HolThyLocale_header data)) - (String_concat_map \<open> - -\<close> (String_concat_map \<open> - -\<close> (of\<^sub>e\<^sub>n\<^sub>v_semi__theory env)) l))\<close> - -(* *) - -definition "of_toy_generic _ = (\<lambda> ToyGeneric s \<Rightarrow> \<open>meta_command \<open>%s\<close>\<close> (To_string s))" - -definition "of_floor = (\<lambda> Floor1 \<Rightarrow> \<open>\<close> | Floor2 \<Rightarrow> \<open>[shallow]\<close> | Floor3 \<Rightarrow> \<open>[shallow_shallow]\<close>)" - -definition "of_all_meta_embedding env = - (\<lambda> META_ctxt floor ctxt \<Rightarrow> of_toy_ctxt env (of_floor floor) ctxt - | META_instance i \<Rightarrow> of_toy_instance env i - | META_def_state floor s \<Rightarrow> of_toy_def_state env (of_floor floor) s - | META_def_transition floor p \<Rightarrow> of_toy_def_transition env (of_floor floor) p - | META_generic s \<Rightarrow> of_toy_generic env s)" - -definition "of_boot_generation_syntax _ = (\<lambda> Boot_generation_syntax mode \<Rightarrow> - \<open>generation_syntax [ shallow%s ]\<close> - (let f = \<open> (generation_semantics [ %s ])\<close> in - case mode of Gen_only_design \<Rightarrow> f \<open>design\<close> - | Gen_only_analysis \<Rightarrow> f \<open>analysis\<close> - | Gen_default \<Rightarrow> \<open>\<close>))" - -declare[[cartouche_type' = "abr_string"]] - -definition "of_boot_setup_env env = (\<lambda> Boot_setup_env e \<Rightarrow> - of_setup - env - (Setup - (SML.app0 - \<open>Generation_mode.update_compiler_config\<close> - [ SML.app - \<open>K\<close> - [ SML.let_open - \<open>META\<close> - (\<comment> \<open>Instead of using\<close> - \<comment> \<open>\<open>sml_of_compiler_env_config SML_apply (\<lambda>x. SML_basic [x]) e\<close>\<close> - \<comment> \<open>the following allows to 'automatically' return an uncurried expression:\<close> - SML_basic [sml_of_compiler_env_config sml_apply id e])]])))" - -declare[[cartouche_type' = "fun\<^sub>p\<^sub>r\<^sub>i\<^sub>n\<^sub>t\<^sub>f"]] - -definition "of_all_meta env = (\<lambda> - META_semi__theories thy \<Rightarrow> of\<^sub>e\<^sub>n\<^sub>v_semi__theories env thy - | META_boot_generation_syntax generation_syntax \<Rightarrow> of_boot_generation_syntax env generation_syntax - | META_boot_setup_env setup_env \<Rightarrow> of_boot_setup_env env setup_env - | META_all_meta_embedding all_meta_embedding \<Rightarrow> of_all_meta_embedding env all_meta_embedding)" - -definition "of_all_meta_lists env l_thy = - (let (th_beg, th_end) = case D_output_header_thy env of None \<Rightarrow> ([], []) - | Some (name, fic_import, fic_import_boot) \<Rightarrow> - ( [ \<open>theory %s imports %s begin\<close> - (To_string name) - (of_semi__term (term_binop \<langle>STR '' ''\<rangle> - (L.map Term_string - (fic_import @@@@ (if D_output_header_force env - | D_output_auto_bootstrap env then - [fic_import_boot] - else - []))))) ] - , [ \<open>\<close>, \<open>end\<close> ]) in - L.flatten - [ th_beg - , L.flatten (fst (L.mapM (\<lambda>l (i, cpt). - let (l_thy, lg) = L.mapM (\<lambda>l n. (of_all_meta env l, Succ n)) l 0 in - (( \<open>\<close> - # \<open>%s(* %d ************************************ %d + %d *)\<close> - (To_string (if compiler_env_config.more env then \<langle>STR ''''\<rangle> else \<degree>integer_escape\<degree>)) (To_nat (Succ i)) (To_nat cpt) (To_nat lg) - # l_thy), Succ i, cpt + lg)) l_thy (D_output_position env))) - , th_end ])" -end - -lemmas [code] = - \<comment> \<open>def\<close> - Print.of\<^sub>e\<^sub>n\<^sub>v_section_def - Print.of\<^sub>e\<^sub>n\<^sub>v_semi__theory_def - Print.of\<^sub>e\<^sub>n\<^sub>v_semi__theories_def - Print.of_toy_generic_def - Print.of_floor_def - Print.of_all_meta_embedding_def - Print.of_boot_generation_syntax_def - Print.of_boot_setup_env_def - Print.of_all_meta_def - Print.of_all_meta_lists_def - - \<comment> \<open>fun\<close> - -end diff --git a/Citadelle/src/compiler_generic/toy_example/embedding/meta_toy/Printer_Toy.thy b/Citadelle/src/compiler_generic/toy_example/embedding/meta_toy/Printer_Toy.thy deleted file mode 100644 index 3d05422ef6cbe6f5e297b187af8969cf086b9be5..0000000000000000000000000000000000000000 --- a/Citadelle/src/compiler_generic/toy_example/embedding/meta_toy/Printer_Toy.thy +++ /dev/null @@ -1,115 +0,0 @@ -(****************************************************************************** - * HOL-TOY - * - * 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. - ******************************************************************************) - -section\<open>Instantiating the Printer for Toy (I)\<close> - -theory Printer_Toy -imports Meta_Toy - "../../../meta_isabelle/Printer_Pure" -begin - -context Print -begin - -declare[[cartouche_type' = "abr_string"]] - -definition "concatWith l = - (if l = [] then - id - else - sprint2 STR ''(%s. (%s))''\<acute> (To_string (String_concatWith \<open> \<close> (\<open>\<lambda>\<close> # rev l))))" - -declare[[cartouche_type' = "fun\<^sub>p\<^sub>r\<^sub>i\<^sub>n\<^sub>t\<^sub>f"]] - -fun of_ctxt2_term_aux where "of_ctxt2_term_aux l e = - (\<lambda> T_pure pure o_s \<Rightarrow> (case o_s of None \<Rightarrow> concatWith l (of_pure_term True [] pure) - | Some s \<Rightarrow> To_string s) - | T_to_be_parsed _ s \<Rightarrow> concatWith l (To_string s) - | T_lambda s c \<Rightarrow> of_ctxt2_term_aux (s # l) c) e" -definition "of_ctxt2_term = of_ctxt2_term_aux []" - -definition \<open>of_toy_ctxt _ (floor :: \<comment> \<open>polymorphism weakening needed by \<^theory_text>\<open>code_reflect\<close>\<close> - String.literal) ctxt = - (let f_inv = \<lambda> T_inv b (ToyProp_ctxt n s) \<Rightarrow> \<open> %sInv %s : "%s"\<close> - (if b then \<open>Existential\<close> else \<open>\<close>) - (case n of None \<Rightarrow> \<open>\<close> | Some s \<Rightarrow> To_string s) - (of_ctxt2_term s) in - \<open>Context%s %s%s %s\<close> - floor - (case Ctxt_param ctxt of - [] \<Rightarrow> \<open>\<close> - | l \<Rightarrow> \<open>%s : \<close> (String_concat \<open>, \<close> (L.map To_string l))) - (To_string (ty_obj_to_string (Ctxt_ty ctxt))) - (String_concat \<open> -\<close> (L.map (\<lambda> Ctxt_pp ctxt \<Rightarrow> - \<open>:: %s (%s) %s -%s\<close> - (To_string (Ctxt_fun_name ctxt)) - (String_concat \<open>, \<close> - (L.map - (\<lambda> (s, ty). \<open>%s : %s\<close> (To_string s) (To_string (str_of_ty ty))) - (Ctxt_fun_ty_arg ctxt))) - (case Ctxt_fun_ty_out ctxt of None \<Rightarrow> \<open>\<close> - | Some ty \<Rightarrow> \<open>: %s\<close> (To_string (str_of_ty ty))) - (String_concat \<open> -\<close> - (L.map - (\<lambda> T_pp pref (ToyProp_ctxt n s) \<Rightarrow> \<open> %s %s: "%s"\<close> - (case pref of ToyCtxtPre \<Rightarrow> \<open>Pre\<close> - | ToyCtxtPost \<Rightarrow> \<open>Post\<close>) - (case n of None \<Rightarrow> \<open>\<close> | Some s \<Rightarrow> To_string s) - (of_ctxt2_term s) - | T_invariant inva \<Rightarrow> f_inv inva) - (Ctxt_expr ctxt))) - | Ctxt_inv inva \<Rightarrow> f_inv inva) - (Ctxt_clause ctxt))))\<close> - -end - -lemmas [code] = - \<comment> \<open>def\<close> - Print.concatWith_def - Print.of_ctxt2_term_def - Print.of_toy_ctxt_def - \<comment> \<open>fun\<close> - Print.of_ctxt2_term_aux.simps - -end diff --git a/Citadelle/src/compiler_generic/toy_example/embedding/meta_toy/Printer_Toy_extended.thy b/Citadelle/src/compiler_generic/toy_example/embedding/meta_toy/Printer_Toy_extended.thy deleted file mode 100644 index 66dfc6096447ca1a2027cfae29d2a43a877b26f6..0000000000000000000000000000000000000000 --- a/Citadelle/src/compiler_generic/toy_example/embedding/meta_toy/Printer_Toy_extended.thy +++ /dev/null @@ -1,136 +0,0 @@ -(****************************************************************************** - * HOL-TOY - * - * 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. - ******************************************************************************) - -section\<open>Instantiating the Printer for Toy (II)\<close> - -theory Printer_Toy_extended -imports Meta_Toy_extended - Printer_Toy -begin - -context Print -begin - -definition "To_oid = (\<lambda>Oid n \<Rightarrow> To_nat n)" - -definition \<open>of_toy_def_base = (\<lambda> ToyDefInteger i \<Rightarrow> To_string i - | ToyDefReal (i1, i2) \<Rightarrow> \<open>%s.%s\<close> (To_string i1) (To_string i2) - | ToyDefString s \<Rightarrow> \<open>"%s"\<close> (To_string s))\<close> - -fun of_toy_data_shallow where - "of_toy_data_shallow e = (\<lambda> ShallB_term b \<Rightarrow> of_toy_def_base b - | ShallB_str s \<Rightarrow> To_string s - | ShallB_self s \<Rightarrow> \<open>self %d\<close> (To_oid s) - | ShallB_list l \<Rightarrow> \<open>[ %s ]\<close> (String_concat \<open>, \<close> (List.map of_toy_data_shallow l))) e" - -fun of_toy_list_attr where - "of_toy_list_attr f e = (\<lambda> ToyAttrNoCast x \<Rightarrow> f x - | ToyAttrCast ty (ToyAttrNoCast x) _ \<Rightarrow> \<open>(%s :: %s)\<close> (f x) (To_string ty) - | ToyAttrCast ty l _ \<Rightarrow> \<open>%s \<rightarrow> toyAsType( %s )\<close> (of_toy_list_attr f l) (To_string ty)) e" - -definition \<open>of_toy_instance_single toyi = - (let (s_left, s_right) = - case Inst_name toyi of - None \<Rightarrow> (case Inst_ty toyi of Some ty \<Rightarrow> (\<open>(\<close>, \<open> :: %s)\<close> (To_string ty))) - | Some s \<Rightarrow> - ( \<open>%s%s = \<close> - (To_string s) - (case Inst_ty toyi of None \<Rightarrow> \<open>\<close> | Some ty \<Rightarrow> \<open> :: %s\<close> (To_string ty)) - , \<open>\<close>) in - \<open>%s%s%s\<close> - s_left - (of_toy_list_attr - (\<lambda>l. \<open>[ %s%s ]\<close> - (case Inst_attr_with toyi of None \<Rightarrow> \<open>\<close> | Some s \<Rightarrow> \<open>%s with_only \<close> (To_string s)) - (String_concat \<open>, \<close> - (L.map (\<lambda>(pre_post, attr, v). - \<open>%s"%s" = %s\<close> (case pre_post of None \<Rightarrow> \<open>\<close> - | Some (s1, s2) \<Rightarrow> \<open>("%s", "%s") |= \<close> (To_string s1) (To_string s2)) - (To_string attr) - (of_toy_data_shallow v)) - l))) - (Inst_attr toyi)) - s_right)\<close> - -definition "of_toy_instance _ = (\<lambda> ToyInstance l \<Rightarrow> - \<open>Instance %s\<close> (String_concat \<open> - and \<close> (L.map of_toy_instance_single l)))" - -definition "of_toy_def_state_core l = - String_concat \<open>, \<close> (L.map (\<lambda> ToyDefCoreBinding s \<Rightarrow> To_string s - | ToyDefCoreAdd toyi \<Rightarrow> of_toy_instance_single toyi) l)" - -definition "of_toy_def_state _ (floor :: \<comment> \<open>polymorphism weakening needed by \<^theory_text>\<open>code_reflect\<close>\<close> - String.literal) = (\<lambda> ToyDefSt n l \<Rightarrow> - \<open>State%s %s = [ %s ]\<close> - floor - (To_string n) - (of_toy_def_state_core l))" - -definition "of_toy_def_pp_core = (\<lambda> ToyDefPPCoreBinding s \<Rightarrow> To_string s - | ToyDefPPCoreAdd l \<Rightarrow> \<open>[ %s ]\<close> (of_toy_def_state_core l))" - -definition "of_toy_def_transition _ (floor :: \<comment> \<open>polymorphism weakening needed by \<^theory_text>\<open>code_reflect\<close>\<close> - String.literal) = (\<lambda> ToyDefPP n s_pre s_post \<Rightarrow> - \<open>Transition%s %s%s%s\<close> - floor - (case n of None \<Rightarrow> \<open>\<close> | Some n \<Rightarrow> \<open>%s = \<close> (To_string n)) - (of_toy_def_pp_core s_pre) - (case s_post of None \<Rightarrow> \<open>\<close> | Some s_post \<Rightarrow> \<open> %s\<close> (of_toy_def_pp_core s_post)))" - -end - -lemmas [code] = - \<comment> \<open>def\<close> - Print.To_oid_def - Print.of_toy_def_base_def - Print.of_toy_instance_single_def - Print.of_toy_instance_def - Print.of_toy_def_state_core_def - Print.of_toy_def_state_def - Print.of_toy_def_pp_core_def - Print.of_toy_def_transition_def - - \<comment> \<open>fun\<close> - Print.of_toy_list_attr.simps - Print.of_toy_data_shallow.simps - -end diff --git a/Citadelle/src/compiler_generic/toy_example/generator/Design_deep.thy b/Citadelle/src/compiler_generic/toy_example/generator/Design_deep.thy deleted file mode 100644 index c698a80163bb68a8fba3701ce07cd35d21a61e57..0000000000000000000000000000000000000000 --- a/Citadelle/src/compiler_generic/toy_example/generator/Design_deep.thy +++ /dev/null @@ -1,402 +0,0 @@ -(****************************************************************************** - * HOL-TOY - * - * 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. - ******************************************************************************) - -section\<open>Example: A Class Model Converted into a Theory File\<close> -subsection\<open>Introduction\<close> - -theory - Design_deep -imports - "../embedding/Generator_dynamic_sequential" -begin -ML_file "~~/src/Doc/antiquote_setup.ML" - -text\<open> -In this example, we configure our package to generate a \<^verbatim>\<open>.thy\<close> file, -without executing the associated generated code contained in this \<^verbatim>\<open>.thy\<close> file -(c.f. @{file "Design_shallow.thy"} for a direct evaluation). -This mode is particularly relevant for debugging purposes: -while by default no evaluation occurs, -the generated files (and their proofs!) can be executed on -a step by step basis, depending on how we interact with the output window -(by selectively clicking on what is generated). - -After clicking on the generated content, the newly inserted content could depend on some theories -which are not loaded by this current one. -In this case, it is necessary to manually add all the needed dependencies above after the -keyword @{keyword "imports"}. -One should compare this current theory with @{file "Design_shallow.thy"} -to see the differences of imported theories, and which ones to manually import -(whenever an error happens). -\<close> - -generation_syntax [ (*deep - (generation_semantics [ design (*, oid_start 10*) ]) - (THEORY Design_generated) - (IMPORTS ["../Toy_Library", "../Toy_Library_Static"] - "../embedding/Generator_dynamic_sequential") - SECTION - (*SORRY*) (*no_dirty*) - [ (* in Haskell *) - (* in OCaml module_name M *) - (* in Scala module_name M *) - (* in SML module_name M *) - in self ] - (output_directory "../document_generated") - (*, syntax_print*)*) ] - -text\<open> -\<^verbatim>\<open> -generation_syntax - [ deep - (generation_semantics [ design ]) - (THEORY Design_generated) - (IMPORTS ["../Toy_Library", "../Toy_Library_Static"] - "../embedding/Generator_dynamic_sequential") - SECTION - (*SORRY*) (*no_dirty*) - [ (* in Haskell *) - (* in OCaml module_name M *) - (* in Scala module_name M *) - (* in SML module_name M *) - in self ] - (output_directory "../document_generated") - (*, syntax_print*) ] -\<close> -While in theory it is possible to set the @{keyword "deep"} mode -for generating in all target languages, i.e. by writing -\<^theory_text>\<open>[ in Haskell, in OCaml module_name M, in Scala module_name M, in SML module_name M, in self ]\<close>, -usually using only one target is enough, -since the task of all target is to generate the same Isabelle content. -However in case one language takes too much time to setup, -we recommend to try the generation with another target language, -because all optimizations are currently not (yet) seemingly implemented for all target languages, -or differently activated.\<close> - -subsection\<open>Designing Class Models (I): Basics\<close> - -text\<open> -The following example shows the definitions of a set of classes, -called the ``universe'' of classes. -Instead of providing a single command for building all the complete universe of classes -directly in one block, -we are constructing classes one by one. -So globally the universe describing all classes is partial, it -will only be fully constructed when all classes will be finished to be defined. - -This allows to define classes without having to follow a particular order of definitions. -Here \<open>Atom\<close> is defined before the one of \<open>Molecule\<close> -(\<open>Molecule\<close> will come after): -\<close> - -Class Atom < Molecule - Attributes size : Integer -End - -text\<open>The ``blue'' color of @{command End} indicates that -@{command End} is not a ``green'' keyword. -@{command End} and @{command Class} are in fact similar, they belong to the group of meta-commands -(all meta-commands are defined in @{theory Isabelle_Meta_Model.Generator_dynamic_sequential}). -At run-time and in @{keyword "deep"} mode, all meta-commands have -approximately the same semantics: they only display some quantity of Isabelle code -in the output window (as long as meta-commands are syntactically correctly formed). -However each meta-command is unique because what is displayed -in the output window depends on the sequence of all meta-commands already encountered before -(and also depends on arguments given to the meta-commands).\<close> - -text\<open> -One particularity of @{command End} is to behave as the identity function when -@{command End} is called without arguments. -As example, here we are calling lots of @{command End} without arguments, -and no Isabelle code is generated.\<close> - End End End -text\<open> -We remark that, like any meta-commands, @{command End} could have been written anywhere -in this theory, for example before @{command Class} or even before @{command generation_syntax}... -Something does not have to be specially opened before using an @{command End}. -\<close> - -Class Molecule < Person -text\<open>As example, here no @{command End} is written.\<close> - -text\<open> -The semantics of @{command End} is further made precise here. -We earlier mentioned that the universe of classes is partially constructed, but one can still -examine what is partially constructed, and one possibility is to use @{command End} for doing so. - -@{command End} can be seen as a lazy meta-command: - \<^item> without parameters, no code is generated, - \<^item> with some parameters (e.g., the symbol \<^verbatim>\<open>!\<close>), it forces the generation of the computation -of the universe, by considering all already encountered classes. -Then a partial representation of the universe can be interactively inspected. -\<close> - -Class Galaxy - Attributes wormhole : UnlimitedNatural - is_sound : Void -End! - -text\<open>At this position, in the output window, -we can observe for the first time some generated Isabelle code, -corresponding to the partial universe of classes being constructed. - -Note: By default, \<open>Atom\<close> and \<open>Molecule\<close> are not (yet) present in the shown universe -because \<open>Person\<close> has not been defined in a separate line (unlike \<open>Galaxy\<close> above).\<close> - -Class Person < Galaxy - Attributes salary : Integer - boss : Person - is_meta_thinking: Boolean - -text\<open> -There is not only @{command End} which forces the computation of the universe, for example -@{command Instance} declares a set of objects belonging to the classes earlier defined, -but the entire universe is needed as knowledge, so there is no choice than forcing -the generation of the universe. -\<close> - -Instance X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1 :: Person = [ salary = 1300 , boss = X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2 ] - and X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2 :: Person = [ salary = 1800 ] - -text\<open> -Here we will call @{command Instance} again to show that the universe will not be computed again -since it was already computed in the previous @{command Instance}. -\<close> - -Instance X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3 :: Person = [ salary = 1 ] - -text\<open>However at any time, the universe can (or will) automatically be recomputed, -whenever we are adding meanwhile another class: - -\<^verbatim>\<open>(*\<close>~\<^theory_text>\<open>Class Big_Bang < Atom\<close>~\<^verbatim>\<open>(* This will force the creation of a new universe. *) *)\<close> - -As remark, not only the universe is recomputed, but -the recomputation takes also into account all meta-commands already encountered. -So in the new setting, \<open>X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1\<close>, \<open>X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2\<close> and \<open>X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3\<close> -will be resurrected... after the \<open>Big_Bang\<close>. -\<close> - -subsection\<open>Designing Class Models (II): Jumping to Another Semantic Floor\<close> - -text\<open> -Until now, meta-commands was used to generate lines of code, and -these lines belong to the Isabelle language. -One particularity of meta-commands is to generate pieces of code containing not only Isabelle code -but also arbitrary meta-commands. -In @{keyword "deep"} mode, this is particularly not a danger -for meta-commands to generate themselves -(whereas for @{keyword "shallow"} the recursion might not terminate). - -In this case, such meta-commands must automatically generate the appropriate call to -@{command generation_syntax} beforehand. -However this is not enough, the compiling environment (comprising the -history of meta-commands) are changing throughout the interactive evaluations, -so the environment must also be taken into account and propagated when meta-commands -are generating themselves. -For example, the environment is needed for consultation whenever resurrecting objects, -recomputing the universe or accessing the hierarchy of classes being -defined. - -As a consequence, in the next example a line @{command setup} is added -after @{command generation_syntax} for bootstrapping the state of the compiling environment. -\<close> - -State \<sigma>\<^sub>1 = - [ ([ salary = 1000 , boss = self 1 ] :: Person) - , ([ salary = 1200 ] :: Person) - (* *) - , ([ salary = 2600 , boss = self 3 ] :: Person) - , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1 - , ([ salary = 2300 , boss = self 2 ] :: Person) - (* *) - (* *) - , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2 ] - -text \<open> -In certain circumstances, the command @{command setup} -must be added again between some particular interleaving of two meta-commands, -especially when the first meta-command only generates Isabelle code, -i.e. when it does not generate meta-commands, like this one: -\<close> - -Instance X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4 :: Person = [] - -text \<open> -After this point, the code generated by the next meta-command @{command State} -has no way to detect that some Isabelle code was generated or not -(precisely between this @{command State} and the previous command @{command State}), -i.e. @{command State} can not know if @{term X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4} is a free or a bound variable. -Consequently, one solution is to use again @{command setup} to state that -@{term X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4} has just been bound by the previous @{command Instance}. -\<close> - -State \<sigma>\<^sub>1' = - [ X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1 - , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2 - , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3 - , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4 ] - -text\<open> -Generally, generating meta-commands allows to perform various extensions -on the Toy language being embedded, without altering the semantics of a particular command:\<close> - -Transition \<sigma>\<^sub>1 \<sigma>\<^sub>1' - -text\<open> -@{command Transition} usually only takes ``bound variables'' as parameters -(not arbitrary \<open>\<lambda>\<close>-terms), however the semantics of @{command Transition} was extended -to mimic the support of some particular terms not restricted to variables. -This extension was implemented by executing some steps of ``\<open>\<zeta>\<close>-reductions rewriting rules'' -operating on the meta-level of commands. -First, it is at least needed to extend the syntax of expressions accepted by @{command Transition}, -we then modify the parsing so that a larger subset of \<open>\<lambda>\<close>-terms -can be given as parameters. -Starting from this expression: -\<^verbatim>\<open> -(*\<close>~\<^theory_text>\<open>Transition \<sigma>\<^sub>1 [ ([ salary = 1000 , boss = self 1 ] :: Person) ]\<close>~\<^verbatim>\<open>*)\<close> - -the rewriting begins with a first call to the next semantic floor, we obtain -the following meta-commands (where \<^theory_text>\<open>Transition [shallow]\<close> is an expression -in normal form): -\<^verbatim>\<open> -(*\<close>~\<^theory_text>\<open>State WFF_10_post = [ ([ "salary" = 1000, "boss" = self 1 ] :: Person) ]\<close>\<^verbatim>\<open> - \<close>~\<^theory_text>\<open>Transition[shallow] \<sigma>\<^sub>1 WFF_10_post\<close>~\<^verbatim>\<open>*)\<close> - -(\<open>WFF_10_post\<close> is an automatically generated name). - -The rewriting of the above @{command State} is performed in its turn. -Finally the overall ultimately terminates when reaching @{command Instance} being already -in normal form: -\<^verbatim>\<open> -(*\<close>~\<^theory_text>\<open>Instance WFF_10_post_object0 :: Person = [ "salary" = 1000, "boss" = [ ] ]\<close>\<^verbatim>\<open> - \<close>~\<^theory_text>\<open>State[shallow] WFF_10_post = [ WFF_10_post_object0 ]\<close>\<^verbatim>\<open> - \<close>~\<^theory_text>\<open>Transition[shallow] \<sigma>\<^sub>1 WFF_10_post\<close>~\<^verbatim>\<open>*)\<close> -\<close> - -subsection\<open>Designing Class Models (III): Interaction with (Pure) Term\<close> - -text\<open> -Meta-commands are obviously not restricted to manipulate expressions in the Outer Syntax level. -It is possible to build meta-commands so that Inner Syntax expressions are directly parsed. -However the dependencies of this theory have been minimized so that experimentations -and debugging can easily occur in @{keyword "deep"} mode -(this file only depends on @{theory Isabelle_Meta_Model.Generator_dynamic_sequential}). -Since the Inner Syntax expressions would perhaps manipulate expressions coming from other theories -than @{theory Isabelle_Meta_Model.Generator_dynamic_sequential}, -it can be desirable to consider the Inner Syntax container as a string and leave the parsing -for subsequent semantic floors. - -This is what is implemented here: -\<close> - -text{* -\<^verbatim>\<open>Context Person :: content () - Post "\<close>@{text "\<close>"}@{text "\<open>"}\<^verbatim>\<open>"\<close> -*} - -text{* -Here the expression ``@{text "\<close>"}@{text "\<open>"}'' is not well-typed in Isabelle, but an error is not raised -because the above expression is not (yet) parsed as an Inner Syntax element\footnote{ -In any case an error will not be raised, because the above code -is written in verbatim in the real \<^verbatim>\<open>.thy\<close> file, -however one can copy-paste this code out of the verbatim scope to see that -no errors are really raised. -For presentation purposes, it was embedded in verbatim because we will later discuss about -meta-commands generating Isabelle code, -and then what is generated by this meta-command is of course not well-typed!}. - -However, this is not the same for the resulting generated meta-command: -\<^verbatim>\<open> -(* Context [shallow] Person :: content () - Post : "(\<lambda> result self. (\<close>@{text "\<close>"}@{text "\<open>"}\<^verbatim>\<open>))" *)\<close> - -and an error is immediately raised because the parsing of Inner Syntax expressions -is activated in this case. -*} - -text\<open>For example, one can put the mouse, with the CTRL gesture, -over the variable @{term "a"}, @{term "b"} or @{term "c"} -to be convinced that they are free variables compared with above:\<close> - -Context[shallow] Person :: content () - Post : "a + b = c" - -subsection\<open>Designing Class Models (IV): Saving the Generated to File\<close> - -text\<open> -The experimentations usually finish by saving all the universe -and generated Isabelle theory to the hard disk: -\<^verbatim>\<open> -(*\<close>~\<^theory_text>\<open>generation_syntax deep flush_all\<close>~\<^verbatim>\<open>*)\<close> -\<close> - -text\<open> -Because meta-commands can force the recomputation of the universe of classes at any time, -the saving does not copy in output all generated code produced by meta-commands since the beginning, -but only all the code that was generated since the last recomputation. -\<close> - -subsection\<open>Designing Class Models (V): Inspection of Generated Files\<close> - -text\<open> -According to options given to the (first) command @{command generation_syntax} above, -we retrieve the first generated file in the mentioned directory: -@{file "../document_generated/Design_generated.thy"}. - -Because this file still contains meta-commands, we are here executing again -a new generating step inside this file, the new result becomes saved in -@{file "../document_generated/Design_generated_generated.thy"}. -As remark, in this last file, the dependency to @{theory Isabelle_Meta_Model.Generator_dynamic_sequential} was -automatically removed because the meta-compiler has detected the absence of meta-commands -in the generated content. - -Note: While the first generated file is intended to be always well-typed, -it can happen that subsequent generations will lead to a not well-typed file. -This is because the meta-compiler only saves the history of meta-commands. -In case some ``native'' Isabelle declarations -are generated among meta-commands, then these Isabelle declarations -are not saved by the meta-compiler, -so these declarations will not be again generated. -Anyway, we see potential solutions for solving this and -they would perhaps be implemented in a future version of the meta-compiler... -\<close> - -end diff --git a/Citadelle/src/compiler_generic/toy_example/generator/Design_shallow.thy b/Citadelle/src/compiler_generic/toy_example/generator/Design_shallow.thy deleted file mode 100644 index c55b6026d6921da5bd2a117a161c1c5baf327105..0000000000000000000000000000000000000000 --- a/Citadelle/src/compiler_generic/toy_example/generator/Design_shallow.thy +++ /dev/null @@ -1,140 +0,0 @@ -(****************************************************************************** - * HOL-TOY - * - * 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. - ******************************************************************************) - -section\<open>Example: A Class Model Interactively Executed\<close> -subsection\<open>Introduction\<close> - -theory - Design_shallow -imports - "../Toy_Library" - "../Toy_Library_Static" - "../embedding/Generator_dynamic_sequential" -begin -ML_file "~~/src/Doc/antiquote_setup.ML" - -text\<open> -In this example, we configure our package to execute tactic SML code -(corresponding to some generated \verb|.thy| file, @{file "Design_deep.thy"} -details how to obtain such generated \verb|.thy| file). -Since SML code are already compiled (or reflected) and bound with the native Isabelle API in -@{theory Isabelle_Meta_Model.Generator_dynamic_sequential}, nothing is generated in this theory. -The system only parses arguments given to meta-commands and immediately calls the corresponding -compiled functions. - -The execution time is comparatively similar as if tactics were written by hand, -except that the generated SML code potentially inherits all optimizations performed -by the raw code generation of Isabelle (if any). -\<close> - -generation_syntax [ shallow (generation_semantics [ design ]) - (*SORRY*) (*no_dirty*) - (*, syntax_print*) ] -text\<open> -The configuration in @{keyword "shallow"} mode is straightforward: -in this mode @{command generation_syntax} basically terminates in $O(1)$. -\<close> - -subsection\<open>Designing Class Models (I): Basics\<close> - -Class Atom < Molecule - Attributes size : Integer -End - - End End End - -Class Molecule < Person - -Class Galaxy - Attributes wormhole : UnlimitedNatural - is_sound : Void -End! - -Class Person < Galaxy - Attributes salary : Integer - boss : Person - is_meta_thinking: Boolean - -Instance X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1 :: Person = [ salary = 1300 , boss = X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2 ] - and X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2 :: Person = [ salary = 1800 ] - -Instance X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3 :: Person = [ salary = 1 ] - -(* Class Big_Bang < Atom (* This will force the creation of a new universe. *) *) - -subsection\<open>Designing Class Models (II): Jumping to Another Semantic Floor\<close> - -State \<sigma>\<^sub>1 = - [ ([ salary = 1000 , boss = self 1 ] :: Person) - , ([ salary = 1200 ] :: Person) - (* *) - , ([ salary = 2600 , boss = self 3 ] :: Person) - , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1 - , ([ salary = 2300 , boss = self 2 ] :: Person) - (* *) - (* *) - , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2 ] - -Instance X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4 :: Person = [] - -State \<sigma>\<^sub>1' = - [ X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1 - , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2 - , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3 - , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4 ] - -Transition \<sigma>\<^sub>1 \<sigma>\<^sub>1' - -(* Transition \<sigma>\<^sub>1 [ ([ salary = 1000 , boss = self 1 ] :: Person) ] *) - -subsection\<open>Designing Class Models (III): Interaction with (Pure) Term\<close> - -text{* -Here in @{keyword "shallow"} mode, the following expression is directly rejected: -\<^verbatim>\<open> -(* Context Person :: content () - Post "\<close>@{text "\<close>"}@{text "\<open>"}\<^verbatim>\<open>" *)\<close> -*} - -Context[shallow] Person :: content () - Post : "a + b = c" - -end diff --git a/Citadelle/src/document/FOCL_Syntax.tex b/Citadelle/src/document/FOCL_Syntax.tex deleted file mode 100644 index 346813089339b77dded4cc684f6cae350b53f575..0000000000000000000000000000000000000000 --- a/Citadelle/src/document/FOCL_Syntax.tex +++ /dev/null @@ -1,1085 +0,0 @@ -\isatagannexa -\part{The OCL And Featherweight OCL Syntax} -\endisatagannexa -\isatagafp -\chapter{The OCL And Featherweight OCL Syntax} -\endisatagafp -\newcommand{\simpleArgs}[1]{\_} -\newcommand{\hide}[1]{} -\newcommand{\hideT}[1]{} -\newcommand{\foclcolorbox}[2]{#2} -\newcommand{\isaFS}[1]{\isa{\footnotesize #1}} - -{ -\begin{longtable}[C] -{@{}% -c% -l% -l% -l% >{$}l<{$}% -@{}} - \caption{Comparison of different concrete syntax variants for OCL \label{tab:comp-diff-syntax}}\\ - \toprule -& OCL & Featherweight OCL & Logical Constant \\ - \midrule -\endfirsthead - \toprule -& OCL & Featherweight OCL & Logical Constant \\ - \midrule -\endhead - \midrule \multicolumn{3}{r}{\emph{Continued on next page}} -\endfoot - \bottomrule - \endlastfoot - %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - %%%% 11.3.1 OclAny - %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - \multirow{11}{*}{\rotatebox{90}{OclAny}} - &\footnotesize\inlineocl"_ = _" - & \hide{\color{Gray}($\text{\isaFS{logic}}^{\text{\color{GreenYellow}1000}}$)} \foclcolorbox{Apricot}{\isaFS{op}} \foclcolorbox{Apricot}{\isaFS{{\isasymtriangleq}}} & {{\isaFS{UML{\isacharunderscore}Logic{\isachardot}StrongEq}}\hideT{\text{\space\color{Black}\isaFS{const}}}}% - \\ -& \footnotesize\inlineocl"_ <> _" -& \hide{\color{Gray}($\text{\isaFS{logic}}^{\text{\color{GreenYellow}1000}}$)} \foclcolorbox{Apricot}{\isaFS{op}} \foclcolorbox{Apricot}{\isaFS{{\isacharless}{\isachargreater}}} & {{\color{Gray} \isaFS{notequal}}}% - \\ -&\footnotesize\inlineocl"_ ->oclAsSet( _ )"&&\\ -&\footnotesize\inlineocl"_ .oclIsNew()" -& \hide{\color{Gray}($\text{\isaFS{logic}}^{\text{\color{GreenYellow}1000}}$)}\simpleArgs{$\text{\isaFS{logic}}^{\text{\color{GreenYellow}0}}$} \foclcolorbox{Apricot}{\isaFS{{\isachardot}oclIsNew{\isacharparenleft}{\isacharparenright}}} & {{ \isaFS{UML{\isacharunderscore}State{\isachardot}OclIsNew}}\hideT{\text{\space\color{Black}\isaFS{const}}}}% -\\ - % -&\footnotesize\inlineocl"not ( _ ->oclIsUndefined() )" -& \hide{\color{Gray}($\text{\isaFS{logic}}^{\text{\color{GreenYellow}100}}$)} \foclcolorbox{Apricot}{\isaFS{{\isasymdelta}}}\simpleArgs{$\text{\isaFS{logic}}^{\text{\color{GreenYellow}100}}$} & {{ \isaFS{UML{\isacharunderscore}Logic{\isachardot}defined}}\hideT{\text{\space\color{Black}\isaFS{const}}}}% -\\ - -% - -&\footnotesize\inlineocl"not ( _ ->oclIsInvalid() )" -& \hide{\color{Gray}($\text{\isaFS{logic}}^{\text{\color{GreenYellow}100}}$)} \foclcolorbox{Apricot}{\isaFS{{\isasymupsilon}}}\simpleArgs{$\text{\isaFS{logic}}^{\text{\color{GreenYellow}100}}$} & {{ \isaFS{UML{\isacharunderscore}Logic{\isachardot}valid}}\hideT{\text{\space\color{Black}\isaFS{const}}}}% -\\ -&\footnotesize\inlineocl"_ ->oclAsType( _ )"&&\\ -&\footnotesize\inlineocl"_ ->oclIsTypeOf( _ )"&&\\ -&\footnotesize\inlineocl"_ ->oclIsKindOf( _ )"&&\\ -&\footnotesize\inlineocl"_ ->oclIsInState( _ )"&&\\ -&\footnotesize\inlineocl"_ ->oclType()"&&\\ -&\footnotesize\inlineocl"_ ->oclLocale()"&&\\ - - \cmidrule{1-4} - %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - %%%% 11.3.2 OclVoid - %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - \multirow{11}{*}{\rotatebox{90}{OclVoid}} - &\footnotesize\inlineocl"_ = _" - & \hide{\color{Gray}($\text{\isaFS{logic}}^{\text{\color{GreenYellow}1000}}$)} \foclcolorbox{Apricot}{\isaFS{op}} \foclcolorbox{Apricot}{\isaFS{{\isasymtriangleq}}} & {{\isaFS{UML{\isacharunderscore}Logic{\isachardot}StrongEq}}\hideT{\text{\space\color{Black}\isaFS{const}}}}% - \\ -& \footnotesize\inlineocl"_ <> _" -& \hide{\color{Gray}($\text{\isaFS{logic}}^{\text{\color{GreenYellow}1000}}$)} \foclcolorbox{Apricot}{\isaFS{op}} \foclcolorbox{Apricot}{\isaFS{{\isacharless}{\isachargreater}}} & {{\color{Gray} \isaFS{notequal}}}% - \\ -&\footnotesize\inlineocl"_ ->oclAsSet( _ )"&&\\ -&\footnotesize\inlineocl"_ .oclIsNew()" -& \hide{\color{Gray}($\text{\isaFS{logic}}^{\text{\color{GreenYellow}1000}}$)}\simpleArgs{$\text{\isaFS{logic}}^{\text{\color{GreenYellow}0}}$} \foclcolorbox{Apricot}{\isaFS{{\isachardot}oclIsNew{\isacharparenleft}{\isacharparenright}}} & {{ \isaFS{UML{\isacharunderscore}State{\isachardot}OclIsNew}}\hideT{\text{\space\color{Black}\isaFS{const}}}}% -\\ - % -&\footnotesize\inlineocl"not ( _ ->oclIsUndefined() )" -& \hide{\color{Gray}($\text{\isaFS{logic}}^{\text{\color{GreenYellow}100}}$)} \foclcolorbox{Apricot}{\isaFS{{\isasymdelta}}}\simpleArgs{$\text{\isaFS{logic}}^{\text{\color{GreenYellow}100}}$} & {{ \isaFS{UML{\isacharunderscore}Logic{\isachardot}defined}}\hideT{\text{\space\color{Black}\isaFS{const}}}}% -\\ - -% - -&\footnotesize\inlineocl"not ( _ ->oclIsInvalid() )" -& \hide{\color{Gray}($\text{\isaFS{logic}}^{\text{\color{GreenYellow}100}}$)} \foclcolorbox{Apricot}{\isaFS{{\isasymupsilon}}}\simpleArgs{$\text{\isaFS{logic}}^{\text{\color{GreenYellow}100}}$} & {{ \isaFS{UML{\isacharunderscore}Logic{\isachardot}valid}}\hideT{\text{\space\color{Black}\isaFS{const}}}}% -\\ -&\footnotesize\inlineocl"_ ->oclAsType( _ )"&&\\ -&\footnotesize\inlineocl"_ ->oclIsTypeOf( _ )"&&\\ -&\footnotesize\inlineocl"_ ->oclIsKindOf( _ )"&&\\ -&\footnotesize\inlineocl"_ ->oclIsInState( _ )"&&\\ -&\footnotesize\inlineocl"_ ->oclType()"&&\\ -&\footnotesize\inlineocl"_ ->oclLocale()"&&\\ - \cmidrule{1-4} - %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - %%%% 11.3.3 OclInvalid - %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - \multirow{11}{*}{\rotatebox{90}{OclInvalid}} - &\footnotesize\inlineocl"_ = _" - & \hide{\color{Gray}($\text{\isaFS{logic}}^{\text{\color{GreenYellow}1000}}$)} \foclcolorbox{Apricot}{\isaFS{op}} \foclcolorbox{Apricot}{\isaFS{{\isasymtriangleq}}} & {{\isaFS{UML{\isacharunderscore}Logic{\isachardot}StrongEq}}\hideT{\text{\space\color{Black}\isaFS{const}}}}% - \\ -& \footnotesize\inlineocl"_ <> _" -& \hide{\color{Gray}($\text{\isaFS{logic}}^{\text{\color{GreenYellow}1000}}$)} \foclcolorbox{Apricot}{\isaFS{op}} \foclcolorbox{Apricot}{\isaFS{{\isacharless}{\isachargreater}}} & {{\color{Gray} \isaFS{notequal}}}% - \\ -&\footnotesize\inlineocl"_ ->oclAsSet( _ )"&&\\ -&\footnotesize\inlineocl"_ .oclIsNew()" -& \hide{\color{Gray}($\text{\isaFS{logic}}^{\text{\color{GreenYellow}1000}}$)}\simpleArgs{$\text{\isaFS{logic}}^{\text{\color{GreenYellow}0}}$} \foclcolorbox{Apricot}{\isaFS{{\isachardot}oclIsNew{\isacharparenleft}{\isacharparenright}}} & {{ \isaFS{UML{\isacharunderscore}State{\isachardot}OclIsNew}}\hideT{\text{\space\color{Black}\isaFS{const}}}}% -\\ - % -&\footnotesize\inlineocl"not ( _ ->oclIsUndefined() )" -& \hide{\color{Gray}($\text{\isaFS{logic}}^{\text{\color{GreenYellow}100}}$)} \foclcolorbox{Apricot}{\isaFS{{\isasymdelta}}}\simpleArgs{$\text{\isaFS{logic}}^{\text{\color{GreenYellow}100}}$} & {{ \isaFS{UML{\isacharunderscore}Logic{\isachardot}defined}}\hideT{\text{\space\color{Black}\isaFS{const}}}}% -\\ - -% - -&\footnotesize\inlineocl"not ( _ ->oclIsInvalid() )" -& \hide{\color{Gray}($\text{\isaFS{logic}}^{\text{\color{GreenYellow}100}}$)} \foclcolorbox{Apricot}{\isaFS{{\isasymupsilon}}}\simpleArgs{$\text{\isaFS{logic}}^{\text{\color{GreenYellow}100}}$} & {{ \isaFS{UML{\isacharunderscore}Logic{\isachardot}valid}}\hideT{\text{\space\color{Black}\isaFS{const}}}}% -\\ -&\footnotesize\inlineocl"_ ->oclAsType( _ )"&&\\ -&\footnotesize\inlineocl"_ ->oclIsTypeOf( _ )"&&\\ -&\footnotesize\inlineocl"_ ->oclIsKindOf( _ )"&&\\ -&\footnotesize\inlineocl"_ ->oclIsInState( _ )"&&\\ -&\footnotesize\inlineocl"_ ->oclType()"&&\\ -&\footnotesize\inlineocl"_ ->oclLocale()"&&\\ - \cmidrule{1-4} - %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - %%%% 11.3.4 OclMessage - %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -% \multirow{4}{*}{\rotatebox{90}{OclMessage}} -%&\footnotesize\inlineocl"_ ->hasReturned()"&&\\ -%&\footnotesize\inlineocl"_ ->result()"&&\\ -%&\footnotesize\inlineocl"_ ->isSignalSent()"&&\\ -%&\footnotesize\inlineocl"_ ->isOperationCall()"&&\\ -% \cmidrule{1-4} - %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - %%%% 11.5.1 Real - %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -\multirow{7}{*}{\rotatebox{90}{Real}} -&\footnotesize\inlineocl"_ + _" -& \hide{\color{Gray}($\text{\isaFS{logic}}^{\text{\color{GreenYellow}1000}}$)} \foclcolorbox{Apricot}{\isaFS{op}} \foclcolorbox{Apricot}{\isaFS{{\isacharplus}\isactrlsub r\isactrlsub e\isactrlsub a\isactrlsub l}} & {{ \isaFS{UML{\isacharunderscore}Real{\isachardot}OclAdd\isactrlsub R\isactrlsub e\isactrlsub a\isactrlsub l}}\hideT{\text{\space\color{Black}\isaFS{const}}}}% -\\ -% -&\footnotesize\inlineocl"_ - _" -& \hide{\color{Gray}($\text{\isaFS{logic}}^{\text{\color{GreenYellow}1000}}$)} \foclcolorbox{Apricot}{\isaFS{op}} \foclcolorbox{Apricot}{\isaFS{{\isacharminus}\isactrlsub r\isactrlsub e\isactrlsub a\isactrlsub l}} & {{ \isaFS{UML{\isacharunderscore}Real{\isachardot}OclMinus\isactrlsub R\isactrlsub e\isactrlsub a\isactrlsub l}}\hideT{\text{\space\color{Black}\isaFS{const}}}}% -\\ -% -&\footnotesize\inlineocl"_ * _" -& \hide{\color{Gray}($\text{\isaFS{logic}}^{\text{\color{GreenYellow}1000}}$)} \foclcolorbox{Apricot}{\isaFS{op}} \foclcolorbox{Apricot}{\isaFS{{\isacharasterisk}\isactrlsub r\isactrlsub e\isactrlsub a\isactrlsub l}} & {{ \isaFS{UML{\isacharunderscore}Real{\isachardot}OclMult\isactrlsub R\isactrlsub e\isactrlsub a\isactrlsub l}}\hideT{\text{\space\color{Black}\isaFS{const}}}}% -\\ -& \footnotesize\inlineocl"- _" &&\\ -& \footnotesize\inlineocl"_ / _" &&\\ -& \footnotesize\inlineocl"_ .abs()" &&\\ -& \footnotesize\inlineocl"_ .floor()" &&\\ -& \footnotesize\inlineocl"_ .round()" &&\\ -& \footnotesize\inlineocl"_ .max()" &&\\ -& \footnotesize\inlineocl"_ .min()" &&\\ -% -&\footnotesize\inlineocl"_ < _" -& \hide{\color{Gray}($\text{\isaFS{logic}}^{\text{\color{GreenYellow}1000}}$)} \foclcolorbox{Apricot}{\isaFS{op}} \foclcolorbox{Apricot}{\isaFS{{\isacharless}\isactrlsub r\isactrlsub e\isactrlsub a\isactrlsub l}} & {{ \isaFS{UML{\isacharunderscore}Real{\isachardot}OclLess\isactrlsub R\isactrlsub e\isactrlsub a\isactrlsub l}}\hideT{\text{\space\color{Black}\isaFS{const}}}}% -\\ -& \footnotesize\inlineocl"_ > _" & &\\ -&\footnotesize\inlineocl"_ <= _" -& \hide{\color{Gray}($\text{\isaFS{logic}}^{\text{\color{GreenYellow}1000}}$)} \foclcolorbox{Apricot}{\isaFS{op}} \foclcolorbox{Apricot}{\isaFS{{\isasymle}\isactrlsub r\isactrlsub e\isactrlsub a\isactrlsub l}} & {{ \isaFS{UML{\isacharunderscore}Real{\isachardot}OclLe\isactrlsub R\isactrlsub e\isactrlsub a\isactrlsub l}}\hideT{\text{\space\color{Black}\isaFS{const}}}}% - \\ -& \footnotesize\inlineocl"_ >= _" & &\\ -& \footnotesize\inlineocl"_ .toString()" &&\\ -% -&\footnotesize\textcolor{Gray}{\inlineocl"_ .div(_)"} -& \hide{\color{Gray}($\text{\isaFS{logic}}^{\text{\color{GreenYellow}1000}}$)} \foclcolorbox{Apricot}{\isaFS{op}} \foclcolorbox{Apricot}{\isaFS{div\isactrlsub r\isactrlsub e\isactrlsub a\isactrlsub l}} & {{ \isaFS{UML{\isacharunderscore}Real{\isachardot}OclDivision\isactrlsub R\isactrlsub e\isactrlsub a\isactrlsub l}}\hideT{\text{\space\color{Black}\isaFS{const}}}}% -\\ -% -&\footnotesize\textcolor{Gray}{\inlineocl"_ .mod(_)"} -& \hide{\color{Gray}($\text{\isaFS{logic}}^{\text{\color{GreenYellow}1000}}$)} \foclcolorbox{Apricot}{\isaFS{op}} \foclcolorbox{Apricot}{\isaFS{mod\isactrlsub r\isactrlsub e\isactrlsub a\isactrlsub l}} & {{ \isaFS{UML{\isacharunderscore}Real{\isachardot}OclModulus\isactrlsub R\isactrlsub e\isactrlsub a\isactrlsub l}}\hideT{\text{\space\color{Black}\isaFS{const}}}}% -\\ -% - - % - -&\footnotesize\textcolor{Gray}{\footnotesize\inlineocl"_ ->oclAsType(Integer)"} -& \hide{\color{Gray}($\text{\isaFS{logic}}^{\text{\color{GreenYellow}1000}}$)}\simpleArgs{$\text{\isaFS{logic}}^{\text{\color{GreenYellow}0}}$} \foclcolorbox{Apricot}{\isaFS{{\isacharminus}{\isachargreater}oclAsType\isactrlsub R\isactrlsub e\isactrlsub a\isactrlsub l{\isacharparenleft}Integer{\isacharparenright}}} & {{ \isaFS{UML{\isacharunderscore}Library{\isachardot}OclAsInteger\isactrlsub R\isactrlsub e\isactrlsub a\isactrlsub l}}\hideT{\text{\space\color{Black}\isaFS{const}}}}% -\\ - -% - -&\footnotesize\textcolor{Gray}{\footnotesize\inlineocl"_ ->oclAsType(Boolean)"} -& \hide{\color{Gray}($\text{\isaFS{logic}}^{\text{\color{GreenYellow}1000}}$)}\simpleArgs{$\text{\isaFS{logic}}^{\text{\color{GreenYellow}0}}$} \foclcolorbox{Apricot}{\isaFS{{\isacharminus}{\isachargreater}oclAsType\isactrlsub R\isactrlsub e\isactrlsub a\isactrlsub l{\isacharparenleft}Boolean{\isacharparenright}}} & {{ \isaFS{UML{\isacharunderscore}Library{\isachardot}OclAsBoolean\isactrlsub R\isactrlsub e\isactrlsub a\isactrlsub l}}\hideT{\text{\space\color{Black}\isaFS{const}}}}% -\\ -\cmidrule{1-4} -%%%% -%%%% -%%%% -%%%% -\multirow{11}{*}{\rotatebox{90}{Real Literals}} -% -&\footnotesize\inlineocl"0.0" -& \hide{\color{Gray}($\text{\isaFS{logic}}^{\text{\color{GreenYellow}1000}}$)} \foclcolorbox{Apricot}{\isaFS{{\isasymzero}{\isachardot}{\isasymzero}}} & {{ \isaFS{UML{\isacharunderscore}Real{\isachardot}OclReal{\isadigit{0}}}}\hideT{\text{\space\color{Black}\isaFS{const}}}}% -\\ - -% -&\footnotesize\inlineocl"1.0" -& \hide{\color{Gray}($\text{\isaFS{logic}}^{\text{\color{GreenYellow}1000}}$)} \foclcolorbox{Apricot}{\isaFS{{\isasymone}{\isachardot}{\isasymzero}}} & {{ \isaFS{UML{\isacharunderscore}Real{\isachardot}OclReal{\isadigit{1}}}}\hideT{\text{\space\color{Black}\isaFS{const}}}}% -\\ - -% -&\footnotesize\inlineocl"2.0" -& \hide{\color{Gray}($\text{\isaFS{logic}}^{\text{\color{GreenYellow}1000}}$)} \foclcolorbox{Apricot}{\isaFS{{\isasymtwo}{\isachardot}{\isasymzero}}} & {{ \isaFS{UML{\isacharunderscore}Real{\isachardot}OclReal{\isadigit{2}}}}\hideT{\text{\space\color{Black}\isaFS{const}}}}% -\\ - -% -&\footnotesize\inlineocl"3.0" -& \hide{\color{Gray}($\text{\isaFS{logic}}^{\text{\color{GreenYellow}1000}}$)} \foclcolorbox{Apricot}{\isaFS{{\isasymthree}{\isachardot}{\isasymzero}}} & {{ \isaFS{UML{\isacharunderscore}Real{\isachardot}OclReal{\isadigit{3}}}}\hideT{\text{\space\color{Black}\isaFS{const}}}}% -\\ - -% -&\footnotesize\inlineocl"4.0" -& \hide{\color{Gray}($\text{\isaFS{logic}}^{\text{\color{GreenYellow}1000}}$)} \foclcolorbox{Apricot}{\isaFS{{\isasymfour}{\isachardot}{\isasymzero}}} & {{ \isaFS{UML{\isacharunderscore}Real{\isachardot}OclReal{\isadigit{4}}}}\hideT{\text{\space\color{Black}\isaFS{const}}}}% -\\ - -% -&\footnotesize\inlineocl"5.0" -& \hide{\color{Gray}($\text{\isaFS{logic}}^{\text{\color{GreenYellow}1000}}$)} \foclcolorbox{Apricot}{\isaFS{{\isasymfive}{\isachardot}{\isasymzero}}} & {{ \isaFS{UML{\isacharunderscore}Real{\isachardot}OclReal{\isadigit{5}}}}\hideT{\text{\space\color{Black}\isaFS{const}}}}% -\\ - -% - -&\footnotesize\inlineocl"6.0" -& \hide{\color{Gray}($\text{\isaFS{logic}}^{\text{\color{GreenYellow}1000}}$)} \foclcolorbox{Apricot}{\isaFS{{\isasymsix}{\isachardot}{\isasymzero}}} & {{ \isaFS{UML{\isacharunderscore}Real{\isachardot}OclReal{\isadigit{6}}}}\hideT{\text{\space\color{Black}\isaFS{const}}}}% -\\ - -% - -&\footnotesize\inlineocl"7.0" -& \hide{\color{Gray}($\text{\isaFS{logic}}^{\text{\color{GreenYellow}1000}}$)} \foclcolorbox{Apricot}{\isaFS{{\isasymseven}{\isachardot}{\isasymzero}}} & {{ \isaFS{UML{\isacharunderscore}Real{\isachardot}OclReal{\isadigit{7}}}}\hideT{\text{\space\color{Black}\isaFS{const}}}}% -\\ - -% - -&\footnotesize\inlineocl"8.0" -& \hide{\color{Gray}($\text{\isaFS{logic}}^{\text{\color{GreenYellow}1000}}$)} \foclcolorbox{Apricot}{\isaFS{{\isasymeight}{\isachardot}{\isasymzero}}} & {{ \isaFS{UML{\isacharunderscore}Real{\isachardot}OclReal{\isadigit{8}}}}\hideT{\text{\space\color{Black}\isaFS{const}}}}% -\\ - -% - -&\footnotesize\inlineocl"9.0" -& \hide{\color{Gray}($\text{\isaFS{logic}}^{\text{\color{GreenYellow}1000}}$)} \foclcolorbox{Apricot}{\isaFS{{\isasymnine}{\isachardot}{\isasymzero}}} & {{ \isaFS{UML{\isacharunderscore}Real{\isachardot}OclReal{\isadigit{9}}}}\hideT{\text{\space\color{Black}\isaFS{const}}}}% -\\ - -% -&\footnotesize\inlineocl"10.0" -& \hide{\color{Gray}($\text{\isaFS{logic}}^{\text{\color{GreenYellow}1000}}$)} \foclcolorbox{Apricot}{\isaFS{{\isasymone}{\isasymzero}{\isachardot}{\isasymzero}}} & {{ \isaFS{UML{\isacharunderscore}Real{\isachardot}OclReal{\isadigit{1}}{\isadigit{0}}}}\hideT{\text{\space\color{Black}\isaFS{const}}}}% - \\ -& -& \hide{\color{Gray}($\text{\isaFS{logic}}^{\text{\color{GreenYellow}1000}}$)} \foclcolorbox{Apricot}{\isaFS{{\isasympi}}} & {{ \isaFS{UML{\isacharunderscore}Real{\isachardot}OclRealpi}}\hideT{\text{\space\color{Black}\isaFS{const}}}}% -\\ -\cmidrule{1-4} - %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - %%%% 11.5.2 Integer - %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -\multirow{7}{*}{\rotatebox{90}{Integer}} -&\footnotesize\inlineocl"_ - _" -& \hide{\color{Gray}($\text{\isaFS{logic}}^{\text{\color{GreenYellow}1000}}$)} \foclcolorbox{Apricot}{\isaFS{op}} \foclcolorbox{Apricot}{\isaFS{{\isacharminus}\isactrlsub i\isactrlsub n\isactrlsub t}} & {{ \isaFS{UML{\isacharunderscore}Integer{\isachardot}OclMinus\isactrlsub I\isactrlsub n\isactrlsub t\isactrlsub e\isactrlsub g\isactrlsub e\isactrlsub r}}\hideT{\text{\space\color{Black}\isaFS{const}}}}% -\\ -&\footnotesize\inlineocl"_ + _" -& \hide{\color{Gray}($\text{\isaFS{logic}}^{\text{\color{GreenYellow}1000}}$)} \foclcolorbox{Apricot}{\isaFS{op}} \foclcolorbox{Apricot}{\isaFS{{\isacharplus}\isactrlsub i\isactrlsub n\isactrlsub t}} & {{ \isaFS{UML{\isacharunderscore}Integer{\isachardot}OclAdd\isactrlsub I\isactrlsub n\isactrlsub t\isactrlsub e\isactrlsub g\isactrlsub e\isactrlsub r}}\hideT{\text{\space\color{Black}\isaFS{const}}}}% -\\ -% - &\footnotesize\inlineocl"- _" && \\ -% -&\footnotesize\inlineocl"_ * _" -& \hide{\color{Gray}($\text{\isaFS{logic}}^{\text{\color{GreenYellow}1000}}$)} \foclcolorbox{Apricot}{\isaFS{op}} \foclcolorbox{Apricot}{\isaFS{{\isacharasterisk}\isactrlsub i\isactrlsub n\isactrlsub t}} & {{ \isaFS{UML{\isacharunderscore}Integer{\isachardot}OclMult\isactrlsub I\isactrlsub n\isactrlsub t\isactrlsub e\isactrlsub g\isactrlsub e\isactrlsub r}}\hideT{\text{\space\color{Black}\isaFS{const}}}}% -\\ - &\footnotesize\inlineocl"_ / _" && \\ - &\footnotesize\inlineocl"_ .abs()" && \\ - - % - -&\footnotesize\inlineocl"_ div ( _ )" -& \hide{\color{Gray}($\text{\isaFS{logic}}^{\text{\color{GreenYellow}1000}}$)} \foclcolorbox{Apricot}{\isaFS{op}} \foclcolorbox{Apricot}{\isaFS{div\isactrlsub i\isactrlsub n\isactrlsub t}} & {{ \isaFS{UML{\isacharunderscore}Integer{\isachardot}OclDivision\isactrlsub I\isactrlsub n\isactrlsub t\isactrlsub e\isactrlsub g\isactrlsub e\isactrlsub r}}\hideT{\text{\space\color{Black}\isaFS{const}}}}% -\\ -% -&\footnotesize\inlineocl"_ mod ( _ )" -& \hide{\color{Gray}($\text{\isaFS{logic}}^{\text{\color{GreenYellow}1000}}$)} \foclcolorbox{Apricot}{\isaFS{op}} \foclcolorbox{Apricot}{\isaFS{mod\isactrlsub i\isactrlsub n\isactrlsub t}} & {{ \isaFS{UML{\isacharunderscore}Integer{\isachardot}OclModulus\isactrlsub I\isactrlsub n\isactrlsub t\isactrlsub e\isactrlsub g\isactrlsub e\isactrlsub r}}\hideT{\text{\space\color{Black}\isaFS{const}}}}% -\\ -% -& \footnotesize\inlineocl"_ .max()" &&\\ -& \footnotesize\inlineocl"_ .min()" &&\\ -& \footnotesize\inlineocl"_ .toString()" &&\\ - - -&\textcolor{Gray}{\footnotesize\inlineocl"_ < _"} -& \hide{\color{Gray}($\text{\isaFS{logic}}^{\text{\color{GreenYellow}1000}}$)} \foclcolorbox{Apricot}{\isaFS{op}} \foclcolorbox{Apricot}{\isaFS{{\isacharless}\isactrlsub i\isactrlsub n\isactrlsub t}} & {{ \isaFS{UML{\isacharunderscore}Integer{\isachardot}OclLess\isactrlsub I\isactrlsub n\isactrlsub t\isactrlsub e\isactrlsub g\isactrlsub e\isactrlsub r}}\hideT{\text{\space\color{Black}\isaFS{const}}}}% -\\ -% -&\textcolor{Gray}{\footnotesize\inlineocl"_ <= _"} -& \hide{\color{Gray}($\text{\isaFS{logic}}^{\text{\color{GreenYellow}1000}}$)} \foclcolorbox{Apricot}{\isaFS{op}} \foclcolorbox{Apricot}{\isaFS{{\isasymle}\isactrlsub i\isactrlsub n\isactrlsub t}} & {{ \isaFS{UML{\isacharunderscore}Integer{\isachardot}OclLe\isactrlsub I\isactrlsub n\isactrlsub t\isactrlsub e\isactrlsub g\isactrlsub e\isactrlsub r}}\hideT{\text{\space\color{Black}\isaFS{const}}}}% - \\ - -&\textcolor{Gray}{\footnotesize\inlineocl"_ ->oclAsType(Real)"} -& \hide{\color{Gray}($\text{\isaFS{logic}}^{\text{\color{GreenYellow}1000}}$)}\simpleArgs{$\text{\isaFS{logic}}^{\text{\color{GreenYellow}0}}$} \foclcolorbox{Apricot}{\isaFS{{\isacharminus}{\isachargreater}oclAsType\isactrlsub I\isactrlsub n\isactrlsub t{\isacharparenleft}Real{\isacharparenright}}} & {{ \isaFS{UML{\isacharunderscore}Library{\isachardot}OclAsReal\isactrlsub I\isactrlsub n\isactrlsub t}}\hideT{\text{\space\color{Black}\isaFS{const}}}}% -\\ -% -&\textcolor{Gray}{\footnotesize\inlineocl"_ ->oclAsType(Boolean)"} -& \hide{\color{Gray}($\text{\isaFS{logic}}^{\text{\color{GreenYellow}1000}}$)}\simpleArgs{$\text{\isaFS{logic}}^{\text{\color{GreenYellow}0}}$} \foclcolorbox{Apricot}{\isaFS{{\isacharminus}{\isachargreater}oclAsType\isactrlsub I\isactrlsub n\isactrlsub t{\isacharparenleft}Boolean{\isacharparenright}}} & {{ \isaFS{UML{\isacharunderscore}Library{\isachardot}OclAsBoolean\isactrlsub I\isactrlsub n\isactrlsub t}}\hideT{\text{\space\color{Black}\isaFS{const}}}}% -\\ -\cmidrule{1-4} -%%%% -%%%% -%%%% -%%%% -\multirow{10}{*}{\rotatebox{90}{Integer Literals}} -&\footnotesize\inlineocl"0" -& \hide{\color{Gray}($\text{\isaFS{logic}}^{\text{\color{GreenYellow}1000}}$)} \foclcolorbox{Apricot}{\isaFS{{\isasymzero}}} & {{ \isaFS{UML{\isacharunderscore}Integer{\isachardot}OclInt{\isadigit{0}}}}\hideT{\text{\space\color{Black}\isaFS{const}}}}% -\\ - -% -&\footnotesize\inlineocl"1" -& \hide{\color{Gray}($\text{\isaFS{logic}}^{\text{\color{GreenYellow}1000}}$)} \foclcolorbox{Apricot}{\isaFS{{\isasymone}}} & {{ \isaFS{UML{\isacharunderscore}Integer{\isachardot}OclInt{\isadigit{1}}}}\hideT{\text{\space\color{Black}\isaFS{const}}}}% -\\ - -% -&\footnotesize\inlineocl"2" -& \hide{\color{Gray}($\text{\isaFS{logic}}^{\text{\color{GreenYellow}1000}}$)} \foclcolorbox{Apricot}{\isaFS{{\isasymtwo}}} & {{ \isaFS{UML{\isacharunderscore}Integer{\isachardot}OclInt{\isadigit{2}}}}\hideT{\text{\space\color{Black}\isaFS{const}}}}% -\\ - -% -&\footnotesize\inlineocl"3" -& \hide{\color{Gray}($\text{\isaFS{logic}}^{\text{\color{GreenYellow}1000}}$)} \foclcolorbox{Apricot}{\isaFS{{\isasymthree}}} & {{ \isaFS{UML{\isacharunderscore}Integer{\isachardot}OclInt{\isadigit{3}}}}\hideT{\text{\space\color{Black}\isaFS{const}}}}% -\\ - -% -&\footnotesize\inlineocl"4" -& \hide{\color{Gray}($\text{\isaFS{logic}}^{\text{\color{GreenYellow}1000}}$)} \foclcolorbox{Apricot}{\isaFS{{\isasymfour}}} & {{ \isaFS{UML{\isacharunderscore}Integer{\isachardot}OclInt{\isadigit{4}}}}\hideT{\text{\space\color{Black}\isaFS{const}}}}% -\\ - -% -&\footnotesize\inlineocl"5" -& \hide{\color{Gray}($\text{\isaFS{logic}}^{\text{\color{GreenYellow}1000}}$)} \foclcolorbox{Apricot}{\isaFS{{\isasymfive}}} & {{ \isaFS{UML{\isacharunderscore}Integer{\isachardot}OclInt{\isadigit{5}}}}\hideT{\text{\space\color{Black}\isaFS{const}}}}% -\\ - -% -&\footnotesize\inlineocl"6" -& \hide{\color{Gray}($\text{\isaFS{logic}}^{\text{\color{GreenYellow}1000}}$)} \foclcolorbox{Apricot}{\isaFS{{\isasymsix}}} & {{ \isaFS{UML{\isacharunderscore}Integer{\isachardot}OclInt{\isadigit{6}}}}\hideT{\text{\space\color{Black}\isaFS{const}}}}% -\\ - -% -&\footnotesize\inlineocl"7" -& \hide{\color{Gray}($\text{\isaFS{logic}}^{\text{\color{GreenYellow}1000}}$)} \foclcolorbox{Apricot}{\isaFS{{\isasymseven}}} & {{ \isaFS{UML{\isacharunderscore}Integer{\isachardot}OclInt{\isadigit{7}}}}\hideT{\text{\space\color{Black}\isaFS{const}}}}% -\\ - -% -&\footnotesize\inlineocl"8" -& \hide{\color{Gray}($\text{\isaFS{logic}}^{\text{\color{GreenYellow}1000}}$)} \foclcolorbox{Apricot}{\isaFS{{\isasymeight}}} & {{ \isaFS{UML{\isacharunderscore}Integer{\isachardot}OclInt{\isadigit{8}}}}\hideT{\text{\space\color{Black}\isaFS{const}}}}% -\\ - -% -&\footnotesize\inlineocl"9" -& \hide{\color{Gray}($\text{\isaFS{logic}}^{\text{\color{GreenYellow}1000}}$)} \foclcolorbox{Apricot}{\isaFS{{\isasymnine}}} & {{ \isaFS{UML{\isacharunderscore}Integer{\isachardot}OclInt{\isadigit{9}}}}\hideT{\text{\space\color{Black}\isaFS{const}}}}% -\\ - -% -&\footnotesize\inlineocl"10" -& \hide{\color{Gray}($\text{\isaFS{logic}}^{\text{\color{GreenYellow}1000}}$)} \foclcolorbox{Apricot}{\isaFS{{\isasymone}{\isasymzero}}} & {{ \isaFS{UML{\isacharunderscore}Integer{\isachardot}OclInt{\isadigit{1}}{\isadigit{0}}}}\hideT{\text{\space\color{Black}\isaFS{const}}}}% -\\ -\cmidrule{1-4} - %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - %%%% 11.5.3 String - %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -\multirow{20}{*}{\rotatebox{90}{String and String Literals}} -&\footnotesize\inlineocl"_ + _" -& \hide{\color{Gray}($\text{\isaFS{logic}}^{\text{\color{GreenYellow}1000}}$)} \foclcolorbox{Apricot}{\isaFS{op}} \foclcolorbox{Apricot}{\isaFS{{\isacharplus}\isactrlsub s\isactrlsub t\isactrlsub r\isactrlsub i\isactrlsub n\isactrlsub g}} & {{ \isaFS{UML{\isacharunderscore}String{\isachardot}OclAdd\isactrlsub S\isactrlsub t\isactrlsub r\isactrlsub i\isactrlsub n\isactrlsub g}}\hideT{\text{\space\color{Black}\isaFS{const}}}}% -\\ -&\footnotesize\inlineocl"_ .size()"&&\\ -&\footnotesize\inlineocl"_ .concat( _ )"&&\\ -&\footnotesize\inlineocl"_ .substring( _ , _ )"&&\\ -&\footnotesize\inlineocl"_ .toInteger()"&&\\ -&\footnotesize\inlineocl"_ .toReal()"&&\\ -&\footnotesize\inlineocl"_ .toUpperCase()"&&\\ -&\footnotesize\inlineocl"_ .toLowerCase()"&&\\ -&\footnotesize\inlineocl"_ .indexOf()"&&\\ -&\footnotesize\inlineocl"_ .equalsIgnoreCase( _ )"&&\\ -&\footnotesize\inlineocl"_ .at( _ )"&&\\ -&\footnotesize\inlineocl"_ .characters()"&&\\ -&\footnotesize\inlineocl"_ .toBoolean()"&&\\ -&\footnotesize\inlineocl"_ < _ "&&\\ -&\footnotesize\inlineocl"_ > _ "&&\\ -&\footnotesize\inlineocl"_ <= _ "&&\\ -&\footnotesize\inlineocl"_ >= _ "&&\\ -% -&\footnotesize\inlineocl"a" -& \hide{\color{Gray}($\text{\isaFS{logic}}^{\text{\color{GreenYellow}1000}}$)} \foclcolorbox{Apricot}{\isaFS{{\isasyma}}} & {{ \isaFS{UML{\isacharunderscore}String{\isachardot}OclStringa}}\hideT{\text{\space\color{Black}\isaFS{const}}}}% -\\ - -% -&\footnotesize\inlineocl"b" -& \hide{\color{Gray}($\text{\isaFS{logic}}^{\text{\color{GreenYellow}1000}}$)} \foclcolorbox{Apricot}{\isaFS{{\isasymb}}} & {{ \isaFS{UML{\isacharunderscore}String{\isachardot}OclStringb}}\hideT{\text{\space\color{Black}\isaFS{const}}}}% -\\ - -% -&\footnotesize\inlineocl"c" -& \hide{\color{Gray}($\text{\isaFS{logic}}^{\text{\color{GreenYellow}1000}}$)} \foclcolorbox{Apricot}{\isaFS{{\isasymc}}} & {{ \isaFS{UML{\isacharunderscore}String{\isachardot}OclStringc}}\hideT{\text{\space\color{Black}\isaFS{const}}}}% -\\ - - -\cmidrule{1-4} - %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - %%%% 11.5.4 Boolean - %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -\multirow{6}{*}{\rotatebox{90}{Boolean and Core Logic}} -% -& \footnotesize\inlineocl"_ or _" -& \hide{\color{Gray}($\text{\isaFS{logic}}^{\text{\color{GreenYellow}1000}}$)} \foclcolorbox{Apricot}{\isaFS{op}} \foclcolorbox{Apricot}{\isaFS{or}} & {{ \isaFS{UML{\isacharunderscore}Logic{\isachardot}OclOr}}\hideT{\text{\space\color{Black}\isaFS{const}}}}% -\\ -& \footnotesize\inlineocl"_ xor _"&&\\ -& \footnotesize\inlineocl"_ and _" -& \hide{\color{Gray}($\text{\isaFS{logic}}^{\text{\color{GreenYellow}1000}}$)} \foclcolorbox{Apricot}{\isaFS{op}} \foclcolorbox{Apricot}{\isaFS{and}} & {{ \isaFS{UML{\isacharunderscore}Logic{\isachardot}OclAnd}}\hideT{\text{\space\color{Black}\isaFS{const}}}}% -\\ -% -&\footnotesize\inlineocl"not _" -& \hide{\color{Gray}($\text{\isaFS{logic}}^{\text{\color{GreenYellow}1000}}$)} - \foclcolorbox{Apricot}{\isaFS{not}} & {{ - \isaFS{UML{\isacharunderscore}Logic{\isachardot}OclNot}}\hideT{\text{\space\color{Black}\isaFS{const}}}}% - \\ -&\footnotesize\inlineocl"_ implies _" -& \hide{\color{Gray}($\text{\isaFS{logic}}^{\text{\color{GreenYellow}1000}}$)} \foclcolorbox{Apricot}{\isaFS{op}} \foclcolorbox{Apricot}{\isaFS{implies}} & {{ \isaFS{UML{\isacharunderscore}Logic{\isachardot}OclImplies}}\hideT{\text{\space\color{Black}\isaFS{const}}}}% -\\ -&\footnotesize\inlineocl"_ .toString()"&&\\ - &\footnotesize\inlineocl"if _ then _ else _ endif" -& \hide{\color{Gray}($\text{\isaFS{logic}}^{\text{\color{GreenYellow}50}}$)} \foclcolorbox{Apricot}{\isaFS{if}}\simpleArgs{$\text{\isaFS{logic}}^{\text{\color{GreenYellow}10}}$} \foclcolorbox{Apricot}{\isaFS{then}} \simpleArgs{$\text{\isaFS{logic}}^{\text{\color{GreenYellow}10}}$} \foclcolorbox{Apricot}{\isaFS{else}} \simpleArgs{$\text{\isaFS{logic}}^{\text{\color{GreenYellow}10}}$} \foclcolorbox{Apricot}{\isaFS{endif}} & {{ \isaFS{UML{\isacharunderscore}Logic{\isachardot}OclIf}}\hideT{\text{\space\color{Black}\isaFS{const}}}}% -\\ -& \footnotesize\inlineocl"_ = _" -& \hide{\color{Gray}($\text{\isaFS{logic}}^{\text{\color{GreenYellow}1000}}$)} \foclcolorbox{Apricot}{\isaFS{op}} \foclcolorbox{Apricot}{\isaFS{{\isasymdoteq}}} & {{ \isaFS{UML{\isacharunderscore}Logic{\isachardot}StrictRefEq}}\hideT{\text{\space\color{Black}\isaFS{const}}}}% -\\ -% -& \footnotesize\inlineocl"_ <> _" -& \hide{\color{Gray}($\text{\isaFS{logic}}^{\text{\color{GreenYellow}1000}}$)} \foclcolorbox{Apricot}{\isaFS{op}} \foclcolorbox{Apricot}{\isaFS{{\isacharless}{\isachargreater}}} & {{\color{Gray} \isaFS{notequal}}}% - \\ -% - % -& -& \hide{\color{Gray}($\text{\isaFS{logic}}^{\text{\color{GreenYellow}50}}$)}\simpleArgs{$\text{\isaFS{logic}}^{\text{\color{GreenYellow}0}}$} \foclcolorbox{Apricot}{\isaFS{{\isacharbar}{\isasymnoteq}}} \simpleArgs{$\text{\isaFS{logic}}^{\text{\color{GreenYellow}0}}$} & {{\color{Gray} \isaFS{OclNonValid}}}% -\\ -% -& -& \hide{\color{Gray}($\text{\isaFS{logic}}^{\text{\color{GreenYellow}50}}$)}\simpleArgs{$\text{\isaFS{logic}}^{\text{\color{GreenYellow}0}}$} \foclcolorbox{Apricot}{\isaFS{{\isasymTurnstile}}} \simpleArgs{$\text{\isaFS{logic}}^{\text{\color{GreenYellow}0}}$} & {{ \isaFS{UML{\isacharunderscore}Logic{\isachardot}OclValid}}\hideT{\text{\space\color{Black}\isaFS{const}}}}% -\\ -&\footnotesize\textcolor{Gray}{\inlineocl"_ = _"} -& \hide{\color{Gray}($\text{\isaFS{logic}}^{\text{\color{GreenYellow}1000}}$)} \foclcolorbox{Apricot}{\isaFS{op}} \foclcolorbox{Apricot}{\isaFS{{\isasymtriangleq}}} & {{\isaFS{UML{\isacharunderscore}Logic{\isachardot}StrongEq}}\hideT{\text{\space\color{Black}\isaFS{const}}}}% -\\ -% - -\cmidrule{1-4} - %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - %%%% 11.5.5 UnlimitedNatural - %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - - %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - %%%% 11.7.1 Collection - %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - - %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - %%%% 11.7.2 Set - %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - \multirow{12}{*}{\rotatebox{90}{Set and Iterators on Set}} -&\footnotesize\inlineocl"Set ( _ )" -& \hide{\color{Gray}($\text{\isaFS{type}}^{\text{\color{GreenYellow}1000}}$)} \foclcolorbox{Apricot}{\isaFS{Set{\isacharparenleft}}} $\text{\isaFS{type}}^{\text{\color{GreenYellow}0}}$ \foclcolorbox{Apricot}{\isaFS{{\isacharparenright}}} & {{ \isaFS{UML{\isacharunderscore}Types{\isachardot}Set\isactrlsub b\isactrlsub a\isactrlsub s\isactrlsub e}}\text{\space\color{Black}\isaFS{type}}}% -\\ - -% - -&\footnotesize\inlineocl"Set{}" - & \hide{\color{Gray}($\text{\isaFS{logic}}^{\text{\color{GreenYellow}1000}}$)} \foclcolorbox{Apricot}{\isaFS{Set{\isacharbraceleft}{\isacharbraceright}}} & {{ \isaFS{UML{\isacharunderscore}Set{\isachardot}mtSet}}\hideT{\text{\space\color{Black}\isaFS{const}}}}% -\\ - -% -&\footnotesize\inlineocl"Set{ _ }" -& \hide{\color{Gray}($\text{\isaFS{logic}}^{\text{\color{GreenYellow}1000}}$)} \foclcolorbox{Apricot}{\isaFS{Set{\isacharbraceleft}}} $\text{\isaFS{args}}^{\text{\color{GreenYellow}0}}$ \foclcolorbox{Apricot}{\isaFS{{\isacharbraceright}}} & {{\color{Gray} \isaFS{OclFinset}}}% -\\ - &\footnotesize\inlineocl"_ ->union( _ )" -& \hide{\color{Gray}($\text{\isaFS{logic}}^{\text{\color{GreenYellow}1000}}$)}\simpleArgs{$\text{\isaFS{logic}}^{\text{\color{GreenYellow}0}}$} \foclcolorbox{Apricot}{\isaFS{{\isacharminus}{\isachargreater}union\isactrlsub S\isactrlsub e\isactrlsub t{\isacharparenleft}}} \simpleArgs{$\text{\isaFS{logic}}^{\text{\color{GreenYellow}0}}$} \foclcolorbox{Apricot}{\isaFS{{\isacharparenright}}} & {{ \isaFS{UML{\isacharunderscore}Set{\isachardot}OclUnion}}\hideT{\text{\space\color{Black}\isaFS{const}}}}% -\\ - &\footnotesize\inlineocl"_ = _" - & \hide{\color{Gray}($\text{\isaFS{logic}}^{\text{\color{GreenYellow}1000}}$)} \foclcolorbox{Apricot}{\isaFS{op}} \foclcolorbox{Apricot}{\isaFS{{\isasymtriangleq}}} & {{\isaFS{UML{\isacharunderscore}Logic{\isachardot}StrongEq}}\hideT{\text{\space\color{Black}\isaFS{const}}}}% - \\ -&\footnotesize\inlineocl"_ ->intersection( _ )" -& \hide{\color{Gray}($\text{\isaFS{logic}}^{\text{\color{GreenYellow}1000}}$)}\simpleArgs{$\text{\isaFS{logic}}^{\text{\color{GreenYellow}0}}$} \foclcolorbox{Apricot}{\isaFS{{\isacharminus}{\isachargreater}intersection\isactrlsub S\isactrlsub e\isactrlsub t{\isacharparenleft}}} \simpleArgs{$\text{\isaFS{logic}}^{\text{\color{GreenYellow}0}}$} \foclcolorbox{Apricot}{\isaFS{{\isacharparenright}}} & {{ \isaFS{UML{\isacharunderscore}Set{\isachardot}OclIntersection}}\hideT{\text{\space\color{Black}\isaFS{const}}}}% -\\ -&\footnotesize\inlineocl"_ - _"&&\\ - -&\footnotesize\inlineocl"_ ->including( _ )" -& \hide{\color{Gray}($\text{\isaFS{logic}}^{\text{\color{GreenYellow}1000}}$)}\simpleArgs{$\text{\isaFS{logic}}^{\text{\color{GreenYellow}0}}$} \foclcolorbox{Apricot}{\isaFS{{\isacharminus}{\isachargreater}including\isactrlsub S\isactrlsub e\isactrlsub t{\isacharparenleft}}} \simpleArgs{$\text{\isaFS{logic}}^{\text{\color{GreenYellow}0}}$} \foclcolorbox{Apricot}{\isaFS{{\isacharparenright}}} & {{ \isaFS{UML{\isacharunderscore}Set{\isachardot}OclIncluding}}\hideT{\text{\space\color{Black}\isaFS{const}}}}% -\\ - -&\footnotesize\inlineocl"_ ->excluding( _ )" -& \hide{\color{Gray}($\text{\isaFS{logic}}^{\text{\color{GreenYellow}1000}}$)}\simpleArgs{$\text{\isaFS{logic}}^{\text{\color{GreenYellow}0}}$} \foclcolorbox{Apricot}{\isaFS{{\isacharminus}{\isachargreater}excluding\isactrlsub S\isactrlsub e\isactrlsub t{\isacharparenleft}}} \simpleArgs{$\text{\isaFS{logic}}^{\text{\color{GreenYellow}0}}$} \foclcolorbox{Apricot}{\isaFS{{\isacharparenright}}} & {{ \isaFS{UML{\isacharunderscore}Set{\isachardot}OclExcluding}}\hideT{\text{\space\color{Black}\isaFS{const}}}}% -\\ - -&\footnotesize\inlineocl"_ ->symmetricDifference( _ )"&&\\ - -&\footnotesize\inlineocl"_ ->count( _ )" -& \hide{\color{Gray}($\text{\isaFS{logic}}^{\text{\color{GreenYellow}1000}}$)}\simpleArgs{$\text{\isaFS{logic}}^{\text{\color{GreenYellow}0}}$} \foclcolorbox{Apricot}{\isaFS{{\isacharminus}{\isachargreater}count\isactrlsub S\isactrlsub e\isactrlsub t{\isacharparenleft}}} \simpleArgs{$\text{\isaFS{logic}}^{\text{\color{GreenYellow}0}}$} \foclcolorbox{Apricot}{\isaFS{{\isacharparenright}}} & {{ \isaFS{UML{\isacharunderscore}Set{\isachardot}OclCount}}\hideT{\text{\space\color{Black}\isaFS{const}}}}% -\\ - -&\footnotesize\inlineocl"_ ->flatten()"&&\\ -&\footnotesize\inlineocl"_ ->selectByKind( _ )"&&\\ -&\footnotesize\inlineocl"_ ->selectByType( _ )"&&\\ - -&\footnotesize\inlineocl"_ ->reject( _ | _ )" -& \hide{\color{Gray}($\text{\isaFS{logic}}^{\text{\color{GreenYellow}1000}}$)}\simpleArgs{$\text{\isaFS{logic}}^{\text{\color{GreenYellow}0}}$} \foclcolorbox{Apricot}{\isaFS{{\isacharminus}{\isachargreater}reject\isactrlsub S\isactrlsub e\isactrlsub t{\isacharparenleft}}} \fbox{$\text{\isaFS{id}}$} \foclcolorbox{Apricot}{\isaFS{{\isacharbar}}} \simpleArgs{$\text{\isaFS{logic}}^{\text{\color{GreenYellow}0}}$} \foclcolorbox{Apricot}{\isaFS{{\isacharparenright}}} & {{\color{Gray} \isaFS{OclRejectSet}}}% -\\ - -% - -&\footnotesize\inlineocl"_ ->select( _ | _ )" -& \hide{\color{Gray}($\text{\isaFS{logic}}^{\text{\color{GreenYellow}1000}}$)}\simpleArgs{$\text{\isaFS{logic}}^{\text{\color{GreenYellow}0}}$} \foclcolorbox{Apricot}{\isaFS{{\isacharminus}{\isachargreater}select\isactrlsub S\isactrlsub e\isactrlsub t{\isacharparenleft}}} \fbox{$\text{\isaFS{id}}$} \foclcolorbox{Apricot}{\isaFS{{\isacharbar}}} \simpleArgs{$\text{\isaFS{logic}}^{\text{\color{GreenYellow}0}}$} \foclcolorbox{Apricot}{\isaFS{{\isacharparenright}}} & {{\color{Gray} \isaFS{OclSelectSet}}}% -\\ - -% - -&\footnotesize\inlineocl"_ ->iterate( _ ; _ = _ | _ )" -& \hide{\color{Gray}($\text{\isaFS{logic}}^{\text{\color{GreenYellow}1000}}$)}\simpleArgs{$\text{\isaFS{logic}}^{\text{\color{GreenYellow}0}}$} \foclcolorbox{Apricot}{\isaFS{{\isacharminus}{\isachargreater}iterate\isactrlsub S\isactrlsub e\isactrlsub t{\isacharparenleft}}} $\text{\isaFS{idt}}^{\text{\color{GreenYellow}0}}$ \foclcolorbox{Apricot}{\isaFS{{\isacharsemicolon}}} $\text{\isaFS{idt}}^{\text{\color{GreenYellow}0}}$ \foclcolorbox{Apricot}{\isaFS{{\isacharequal}}} $\text{\isaFS{any}}^{\text{\color{GreenYellow}0}}$ \foclcolorbox{Apricot}{\isaFS{{\isacharbar}}} $\text{\isaFS{any}}^{\text{\color{GreenYellow}0}}$ \foclcolorbox{Apricot}{\isaFS{{\isacharparenright}}} & {{\color{Gray} \isaFS{OclIterateSet}}}% -\\ - -% - -&\footnotesize\inlineocl"_ ->exists( _ | _ )" -& \hide{\color{Gray}($\text{\isaFS{logic}}^{\text{\color{GreenYellow}1000}}$)}\simpleArgs{$\text{\isaFS{logic}}^{\text{\color{GreenYellow}0}}$} \foclcolorbox{Apricot}{\isaFS{{\isacharminus}{\isachargreater}exists\isactrlsub S\isactrlsub e\isactrlsub t{\isacharparenleft}}} \fbox{$\text{\isaFS{id}}$} \foclcolorbox{Apricot}{\isaFS{{\isacharbar}}} \simpleArgs{$\text{\isaFS{logic}}^{\text{\color{GreenYellow}0}}$} \foclcolorbox{Apricot}{\isaFS{{\isacharparenright}}} & {{\color{Gray} \isaFS{OclExistSet}}}% -\\ - -% - -&\footnotesize\inlineocl"_ ->forAll( _ | _ )" -& \hide{\color{Gray}($\text{\isaFS{logic}}^{\text{\color{GreenYellow}1000}}$)}\simpleArgs{$\text{\isaFS{logic}}^{\text{\color{GreenYellow}0}}$} \foclcolorbox{Apricot}{\isaFS{{\isacharminus}{\isachargreater}forAll\isactrlsub S\isactrlsub e\isactrlsub t{\isacharparenleft}}} \fbox{$\text{\isaFS{id}}$} \foclcolorbox{Apricot}{\isaFS{{\isacharbar}}} \simpleArgs{$\text{\isaFS{logic}}^{\text{\color{GreenYellow}0}}$} \foclcolorbox{Apricot}{\isaFS{{\isacharparenright}}} & {{\color{Gray} \isaFS{OclForallSet}}}% -\\ - - - % -&\footnotesize\inlineocl"_ ->asSequence()" -& \hide{\color{Gray}($\text{\isaFS{logic}}^{\text{\color{GreenYellow}1000}}$)}\simpleArgs{$\text{\isaFS{logic}}^{\text{\color{GreenYellow}0}}$} \foclcolorbox{Apricot}{\isaFS{{\isacharminus}{\isachargreater}asSequence\isactrlsub S\isactrlsub e\isactrlsub t{\isacharparenleft}{\isacharparenright}}} & {{ \isaFS{UML{\isacharunderscore}Library{\isachardot}OclAsSeq\isactrlsub S\isactrlsub e\isactrlsub t}}\hideT{\text{\space\color{Black}\isaFS{const}}}}% -\\ -% -&\footnotesize\inlineocl"_ ->asBag()" -& \hide{\color{Gray}($\text{\isaFS{logic}}^{\text{\color{GreenYellow}1000}}$)}\simpleArgs{$\text{\isaFS{logic}}^{\text{\color{GreenYellow}0}}$} \foclcolorbox{Apricot}{\isaFS{{\isacharminus}{\isachargreater}asBag\isactrlsub S\isactrlsub e\isactrlsub t{\isacharparenleft}{\isacharparenright}}} & {{ \isaFS{UML{\isacharunderscore}Library{\isachardot}OclAsBag\isactrlsub S\isactrlsub e\isactrlsub t}}\hideT{\text{\space\color{Black}\isaFS{const}}}}% -\\ -% -&\footnotesize\inlineocl"_ ->asPair()" -& \hide{\color{Gray}($\text{\isaFS{logic}}^{\text{\color{GreenYellow}1000}}$)}\simpleArgs{$\text{\isaFS{logic}}^{\text{\color{GreenYellow}0}}$} \foclcolorbox{Apricot}{\isaFS{{\isacharminus}{\isachargreater}asPair\isactrlsub S\isactrlsub e\isactrlsub t{\isacharparenleft}{\isacharparenright}}} & {{ \isaFS{UML{\isacharunderscore}Library{\isachardot}OclAsPair\isactrlsub S\isactrlsub e\isactrlsub t}}\hideT{\text{\space\color{Black}\isaFS{const}}}}% -\\ - - -&\footnotesize\inlineocl"_ ->sum()" -& \hide{\color{Gray}($\text{\isaFS{logic}}^{\text{\color{GreenYellow}1000}}$)}\simpleArgs{$\text{\isaFS{logic}}^{\text{\color{GreenYellow}0}}$} \foclcolorbox{Apricot}{\isaFS{{\isacharminus}{\isachargreater}sum\isactrlsub S\isactrlsub e\isactrlsub t{\isacharparenleft}{\isacharparenright}}} & {{ \isaFS{UML{\isacharunderscore}Set{\isachardot}OclSum}}\hideT{\text{\space\color{Black}\isaFS{const}}}}% -\\ - -% - - -% - - -% - - -% - -&\footnotesize\inlineocl"_ ->excludesAll( _ )" -& \hide{\color{Gray}($\text{\isaFS{logic}}^{\text{\color{GreenYellow}1000}}$)}\simpleArgs{$\text{\isaFS{logic}}^{\text{\color{GreenYellow}0}}$} \foclcolorbox{Apricot}{\isaFS{{\isacharminus}{\isachargreater}excludesAll\isactrlsub S\isactrlsub e\isactrlsub t{\isacharparenleft}}} \simpleArgs{$\text{\isaFS{logic}}^{\text{\color{GreenYellow}0}}$} \foclcolorbox{Apricot}{\isaFS{{\isacharparenright}}} & {{ \isaFS{UML{\isacharunderscore}Set{\isachardot}OclExcludesAll}}\hideT{\text{\space\color{Black}\isaFS{const}}}}% -\\ - -% - -&\footnotesize\inlineocl"_ ->includesAll( _ )" -& \hide{\color{Gray}($\text{\isaFS{logic}}^{\text{\color{GreenYellow}1000}}$)}\simpleArgs{$\text{\isaFS{logic}}^{\text{\color{GreenYellow}0}}$} \foclcolorbox{Apricot}{\isaFS{{\isacharminus}{\isachargreater}includesAll\isactrlsub S\isactrlsub e\isactrlsub t{\isacharparenleft}}} \simpleArgs{$\text{\isaFS{logic}}^{\text{\color{GreenYellow}0}}$} \foclcolorbox{Apricot}{\isaFS{{\isacharparenright}}} & {{ \isaFS{UML{\isacharunderscore}Set{\isachardot}OclIncludesAll}}\hideT{\text{\space\color{Black}\isaFS{const}}}}% -\\ - -% - - -% - -&\footnotesize\inlineocl"_ ->any()" -& \hide{\color{Gray}($\text{\isaFS{logic}}^{\text{\color{GreenYellow}1000}}$)}\simpleArgs{$\text{\isaFS{logic}}^{\text{\color{GreenYellow}0}}$} \foclcolorbox{Apricot}{\isaFS{{\isacharminus}{\isachargreater}any\isactrlsub S\isactrlsub e\isactrlsub t{\isacharparenleft}{\isacharparenright}}} & {{ \isaFS{UML{\isacharunderscore}Set{\isachardot}OclANY}}\hideT{\text{\space\color{Black}\isaFS{const}}}}% -\\ - -% - -&\footnotesize\inlineocl"_ ->notEmpty()" -& \hide{\color{Gray}($\text{\isaFS{logic}}^{\text{\color{GreenYellow}1000}}$)}\simpleArgs{$\text{\isaFS{logic}}^{\text{\color{GreenYellow}0}}$} \foclcolorbox{Apricot}{\isaFS{{\isacharminus}{\isachargreater}notEmpty\isactrlsub S\isactrlsub e\isactrlsub t{\isacharparenleft}{\isacharparenright}}} & {{ \isaFS{UML{\isacharunderscore}Set{\isachardot}OclNotEmpty}}\hideT{\text{\space\color{Black}\isaFS{const}}}}% -\\ - -% - -&\footnotesize\inlineocl"_ ->isEmpty()" -& \hide{\color{Gray}($\text{\isaFS{logic}}^{\text{\color{GreenYellow}1000}}$)}\simpleArgs{$\text{\isaFS{logic}}^{\text{\color{GreenYellow}0}}$} \foclcolorbox{Apricot}{\isaFS{{\isacharminus}{\isachargreater}isEmpty\isactrlsub S\isactrlsub e\isactrlsub t{\isacharparenleft}{\isacharparenright}}} & {{ \isaFS{UML{\isacharunderscore}Set{\isachardot}OclIsEmpty}}\hideT{\text{\space\color{Black}\isaFS{const}}}}% -\\ - -% - -&\footnotesize\inlineocl"_ ->size()" -& \hide{\color{Gray}($\text{\isaFS{logic}}^{\text{\color{GreenYellow}1000}}$)}\simpleArgs{$\text{\isaFS{logic}}^{\text{\color{GreenYellow}0}}$} \foclcolorbox{Apricot}{\isaFS{{\isacharminus}{\isachargreater}size\isactrlsub S\isactrlsub e\isactrlsub t{\isacharparenleft}{\isacharparenright}}} & {{ \isaFS{UML{\isacharunderscore}Set{\isachardot}OclSize}}\hideT{\text{\space\color{Black}\isaFS{const}}}}% -\\ - -% - -&\footnotesize\inlineocl"_ ->excludes( _ )" -& \hide{\color{Gray}($\text{\isaFS{logic}}^{\text{\color{GreenYellow}1000}}$)}\simpleArgs{$\text{\isaFS{logic}}^{\text{\color{GreenYellow}0}}$} \foclcolorbox{Apricot}{\isaFS{{\isacharminus}{\isachargreater}excludes\isactrlsub S\isactrlsub e\isactrlsub t{\isacharparenleft}}} \simpleArgs{$\text{\isaFS{logic}}^{\text{\color{GreenYellow}0}}$} \foclcolorbox{Apricot}{\isaFS{{\isacharparenright}}} & {{ \isaFS{UML{\isacharunderscore}Set{\isachardot}OclExcludes}}\hideT{\text{\space\color{Black}\isaFS{const}}}}% -\\ - -% - -&\footnotesize\inlineocl"_ ->includes( _ )" -& \hide{\color{Gray}($\text{\isaFS{logic}}^{\text{\color{GreenYellow}1000}}$)}\simpleArgs{$\text{\isaFS{logic}}^{\text{\color{GreenYellow}0}}$} \foclcolorbox{Apricot}{\isaFS{{\isacharminus}{\isachargreater}includes\isactrlsub S\isactrlsub e\isactrlsub t{\isacharparenleft}}} \simpleArgs{$\text{\isaFS{logic}}^{\text{\color{GreenYellow}0}}$} \foclcolorbox{Apricot}{\isaFS{{\isacharparenright}}} & {{ \isaFS{UML{\isacharunderscore}Set{\isachardot}OclIncludes}}\hideT{\text{\space\color{Black}\isaFS{const}}}}% -\\ - -% - -% - -\cmidrule{1-4} - %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - %%%% 11.7.2 Sequence - %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -\multirow{15}{*}{\rotatebox{90}{Sequence and Iterators on Sequence}} - -&\footnotesize\inlineocl"Sequence ( _ )" -& \hide{\color{Gray}($\text{\isaFS{type}}^{\text{\color{GreenYellow}1000}}$)} \foclcolorbox{Apricot}{\isaFS{Sequence{\isacharparenleft}}} $\text{\isaFS{type}}^{\text{\color{GreenYellow}0}}$ \foclcolorbox{Apricot}{\isaFS{{\isacharparenright}}} & {{ \isaFS{UML{\isacharunderscore}Types{\isachardot}Sequence\isactrlsub b\isactrlsub a\isactrlsub s\isactrlsub e}}\text{\space\color{Black}\isaFS{type}}}% - \\ -&\footnotesize\inlineocl"Sequence{}" - & \hide{\color{Gray}($\text{\isaFS{logic}}^{\text{\color{GreenYellow}1000}}$)} \foclcolorbox{Apricot}{\isaFS{Sequence{\isacharbraceleft}{\isacharbraceright}}} & {{ \isaFS{UML{\isacharunderscore}Sequence{\isachardot}mtSequence}}\hideT{\text{\space\color{Black}\isaFS{const}}}}% -\\ - -% -&\footnotesize\inlineocl"Sequence{ _ }" -& \hide{\color{Gray}($\text{\isaFS{logic}}^{\text{\color{GreenYellow}1000}}$)} \foclcolorbox{Apricot}{\isaFS{Sequence{\isacharbraceleft}}} $\text{\isaFS{args}}^{\text{\color{GreenYellow}0}}$ \foclcolorbox{Apricot}{\isaFS{{\isacharbraceright}}} & {{\color{Gray} \isaFS{OclFinsequence}}}% -\\ - -&\footnotesize\inlineocl"_ ->any()" -& \hide{\color{Gray}($\text{\isaFS{logic}}^{\text{\color{GreenYellow}1000}}$)}\simpleArgs{$\text{\isaFS{logic}}^{\text{\color{GreenYellow}0}}$} \foclcolorbox{Apricot}{\isaFS{{\isacharminus}{\isachargreater}any\isactrlsub S\isactrlsub e\isactrlsub q{\isacharparenleft}{\isacharparenright}}} & {{ \isaFS{UML{\isacharunderscore}Sequence{\isachardot}OclANY}}\hideT{\text{\space\color{Black}\isaFS{const}}}}% -\\ - -% - -&\footnotesize\inlineocl"_ ->notEmpty()" -& \hide{\color{Gray}($\text{\isaFS{logic}}^{\text{\color{GreenYellow}1000}}$)}\simpleArgs{$\text{\isaFS{logic}}^{\text{\color{GreenYellow}0}}$} \foclcolorbox{Apricot}{\isaFS{{\isacharminus}{\isachargreater}notEmpty\isactrlsub S\isactrlsub e\isactrlsub q{\isacharparenleft}{\isacharparenright}}} & {{ \isaFS{UML{\isacharunderscore}Sequence{\isachardot}OclNotEmpty}}\hideT{\text{\space\color{Black}\isaFS{const}}}}% -\\ - -% - -&\footnotesize\inlineocl"_ ->isEmpty()" -& \hide{\color{Gray}($\text{\isaFS{logic}}^{\text{\color{GreenYellow}1000}}$)}\simpleArgs{$\text{\isaFS{logic}}^{\text{\color{GreenYellow}0}}$} \foclcolorbox{Apricot}{\isaFS{{\isacharminus}{\isachargreater}isEmpty\isactrlsub S\isactrlsub e\isactrlsub q{\isacharparenleft}{\isacharparenright}}} & {{ \isaFS{UML{\isacharunderscore}Sequence{\isachardot}OclIsEmpty}}\hideT{\text{\space\color{Black}\isaFS{const}}}}% -\\ - -% - -&\footnotesize\inlineocl"_ ->size()" -& \hide{\color{Gray}($\text{\isaFS{logic}}^{\text{\color{GreenYellow}1000}}$)}\simpleArgs{$\text{\isaFS{logic}}^{\text{\color{GreenYellow}0}}$} \foclcolorbox{Apricot}{\isaFS{{\isacharminus}{\isachargreater}size\isactrlsub S\isactrlsub e\isactrlsub q{\isacharparenleft}{\isacharparenright}}} & {{ \isaFS{UML{\isacharunderscore}Sequence{\isachardot}OclSize}}\hideT{\text{\space\color{Black}\isaFS{const}}}}% -\\ - -% - -&\footnotesize\inlineocl"_ ->select( _ | _ )" -& \hide{\color{Gray}($\text{\isaFS{logic}}^{\text{\color{GreenYellow}1000}}$)}\simpleArgs{$\text{\isaFS{logic}}^{\text{\color{GreenYellow}0}}$} \foclcolorbox{Apricot}{\isaFS{{\isacharminus}{\isachargreater}select\isactrlsub S\isactrlsub e\isactrlsub q{\isacharparenleft}}} \fbox{$\text{\isaFS{id}}$} \foclcolorbox{Apricot}{\isaFS{{\isacharbar}}} \simpleArgs{$\text{\isaFS{logic}}^{\text{\color{GreenYellow}0}}$} \foclcolorbox{Apricot}{\isaFS{{\isacharparenright}}} & {{\color{Gray} \isaFS{OclSelectSeq}}}% -\\ - -% -&\footnotesize\inlineocl"_ ->collect( _ | _ )" -& \hide{\color{Gray}($\text{\isaFS{logic}}^{\text{\color{GreenYellow}1000}}$)}\simpleArgs{$\text{\isaFS{logic}}^{\text{\color{GreenYellow}0}}$} \foclcolorbox{Apricot}{\isaFS{{\isacharminus}{\isachargreater}collect\isactrlsub S\isactrlsub e\isactrlsub q{\isacharparenleft}}} \fbox{$\text{\isaFS{id}}$} \foclcolorbox{Apricot}{\isaFS{{\isacharbar}}} \simpleArgs{$\text{\isaFS{logic}}^{\text{\color{GreenYellow}0}}$} \foclcolorbox{Apricot}{\isaFS{{\isacharparenright}}} & {{\color{Gray} \isaFS{OclCollectSeq}}}% -\\ - -% -&\footnotesize\inlineocl"_ ->exists( _ | _ )" -& \hide{\color{Gray}($\text{\isaFS{logic}}^{\text{\color{GreenYellow}1000}}$)}\simpleArgs{$\text{\isaFS{logic}}^{\text{\color{GreenYellow}0}}$} \foclcolorbox{Apricot}{\isaFS{{\isacharminus}{\isachargreater}exists\isactrlsub S\isactrlsub e\isactrlsub q{\isacharparenleft}}} \fbox{$\text{\isaFS{id}}$} \foclcolorbox{Apricot}{\isaFS{{\isacharbar}}} \simpleArgs{$\text{\isaFS{logic}}^{\text{\color{GreenYellow}0}}$} \foclcolorbox{Apricot}{\isaFS{{\isacharparenright}}} & {{\color{Gray} \isaFS{OclExistSeq}}}% -\\ - -% -&\footnotesize\inlineocl"_ ->forAll( _ | _ )" -& \hide{\color{Gray}($\text{\isaFS{logic}}^{\text{\color{GreenYellow}1000}}$)}\simpleArgs{$\text{\isaFS{logic}}^{\text{\color{GreenYellow}0}}$} \foclcolorbox{Apricot}{\isaFS{{\isacharminus}{\isachargreater}forAll\isactrlsub S\isactrlsub e\isactrlsub q{\isacharparenleft}}} \fbox{$\text{\isaFS{id}}$} \foclcolorbox{Apricot}{\isaFS{{\isacharbar}}} \simpleArgs{$\text{\isaFS{logic}}^{\text{\color{GreenYellow}0}}$} \foclcolorbox{Apricot}{\isaFS{{\isacharparenright}}} & {{\color{Gray} \isaFS{OclForallSeq}}}% -\\ - -% -&\footnotesize\inlineocl"_ ->iterate( _ ; _ : _ = _ | _ )" -& \hide{\color{Gray}($\text{\isaFS{logic}}^{\text{\color{GreenYellow}1000}}$)}\simpleArgs{$\text{\isaFS{logic}}^{\text{\color{GreenYellow}0}}$} \foclcolorbox{Apricot}{\isaFS{{\isacharminus}{\isachargreater}iterate\isactrlsub S\isactrlsub e\isactrlsub q{\isacharparenleft}}} $\text{\isaFS{idt}}^{\text{\color{GreenYellow}0}}$ \foclcolorbox{Apricot}{\isaFS{{\isacharsemicolon}}} $\text{\isaFS{idt}}^{\text{\color{GreenYellow}0}}$ \foclcolorbox{Apricot}{\isaFS{{\isacharequal}}} $\text{\isaFS{any}}^{\text{\color{GreenYellow}0}}$ \foclcolorbox{Apricot}{\isaFS{{\isacharbar}}} $\text{\isaFS{any}}^{\text{\color{GreenYellow}0}}$ \foclcolorbox{Apricot}{\isaFS{{\isacharparenright}}} & {{\color{Gray} \isaFS{OclIterateSeq}}}% -\\ - -% -&\footnotesize\inlineocl"_ ->last()" -& \hide{\color{Gray}($\text{\isaFS{logic}}^{\text{\color{GreenYellow}1000}}$)}\simpleArgs{$\text{\isaFS{logic}}^{\text{\color{GreenYellow}0}}$} \foclcolorbox{Apricot}{\isaFS{{\isacharminus}{\isachargreater}last\isactrlsub S\isactrlsub e\isactrlsub q{\isacharparenleft}}} \simpleArgs{$\text{\isaFS{logic}}^{\text{\color{GreenYellow}0}}$} \foclcolorbox{Apricot}{\isaFS{{\isacharparenright}}} & {{ \isaFS{UML{\isacharunderscore}Sequence{\isachardot}OclLast}}\hideT{\text{\space\color{Black}\isaFS{const}}}}% -\\ - -% - -&\footnotesize\inlineocl"_ ->first()" -& \hide{\color{Gray}($\text{\isaFS{logic}}^{\text{\color{GreenYellow}1000}}$)}\simpleArgs{$\text{\isaFS{logic}}^{\text{\color{GreenYellow}0}}$} \foclcolorbox{Apricot}{\isaFS{{\isacharminus}{\isachargreater}first\isactrlsub S\isactrlsub e\isactrlsub q{\isacharparenleft}}} \simpleArgs{$\text{\isaFS{logic}}^{\text{\color{GreenYellow}0}}$} \foclcolorbox{Apricot}{\isaFS{{\isacharparenright}}} & {{ \isaFS{UML{\isacharunderscore}Sequence{\isachardot}OclFirst}}\hideT{\text{\space\color{Black}\isaFS{const}}}}% -\\ - -% - -&\footnotesize\inlineocl"_ ->at( _ )" -& \hide{\color{Gray}($\text{\isaFS{logic}}^{\text{\color{GreenYellow}1000}}$)}\simpleArgs{$\text{\isaFS{logic}}^{\text{\color{GreenYellow}0}}$} \foclcolorbox{Apricot}{\isaFS{{\isacharminus}{\isachargreater}at\isactrlsub S\isactrlsub e\isactrlsub q{\isacharparenleft}}} \simpleArgs{$\text{\isaFS{logic}}^{\text{\color{GreenYellow}0}}$} \foclcolorbox{Apricot}{\isaFS{{\isacharparenright}}} & {{ \isaFS{UML{\isacharunderscore}Sequence{\isachardot}OclAt}}\hideT{\text{\space\color{Black}\isaFS{const}}}}% -\\ - -% -&\footnotesize\inlineocl"_ ->union( _ )" -& \hide{\color{Gray}($\text{\isaFS{logic}}^{\text{\color{GreenYellow}1000}}$)}\simpleArgs{$\text{\isaFS{logic}}^{\text{\color{GreenYellow}0}}$} \foclcolorbox{Apricot}{\isaFS{{\isacharminus}{\isachargreater}union\isactrlsub S\isactrlsub e\isactrlsub q{\isacharparenleft}}} \simpleArgs{$\text{\isaFS{logic}}^{\text{\color{GreenYellow}0}}$} \foclcolorbox{Apricot}{\isaFS{{\isacharparenright}}} & {{ \isaFS{UML{\isacharunderscore}Sequence{\isachardot}OclUnion}}\hideT{\text{\space\color{Black}\isaFS{const}}}}% -\\ - -% - -&\footnotesize\inlineocl"_ ->append( _ )" -& \hide{\color{Gray}($\text{\isaFS{logic}}^{\text{\color{GreenYellow}1000}}$)}\simpleArgs{$\text{\isaFS{logic}}^{\text{\color{GreenYellow}0}}$} \foclcolorbox{Apricot}{\isaFS{{\isacharminus}{\isachargreater}append\isactrlsub S\isactrlsub e\isactrlsub q{\isacharparenleft}}} \simpleArgs{$\text{\isaFS{logic}}^{\text{\color{GreenYellow}0}}$} \foclcolorbox{Apricot}{\isaFS{{\isacharparenright}}} & {{ \isaFS{UML{\isacharunderscore}Sequence{\isachardot}OclAppend}}\hideT{\text{\space\color{Black}\isaFS{const}}}}% -\\ - -% -&\footnotesize\inlineocl"_ ->excluding( _ )" -& \hide{\color{Gray}($\text{\isaFS{logic}}^{\text{\color{GreenYellow}1000}}$)}\simpleArgs{$\text{\isaFS{logic}}^{\text{\color{GreenYellow}0}}$} \foclcolorbox{Apricot}{\isaFS{{\isacharminus}{\isachargreater}excluding\isactrlsub S\isactrlsub e\isactrlsub q{\isacharparenleft}}} \simpleArgs{$\text{\isaFS{logic}}^{\text{\color{GreenYellow}0}}$} \foclcolorbox{Apricot}{\isaFS{{\isacharparenright}}} & {{ \isaFS{UML{\isacharunderscore}Sequence{\isachardot}OclExcluding}}\hideT{\text{\space\color{Black}\isaFS{const}}}}% -\\ - -% - -&\footnotesize\inlineocl"_ ->including( _ )" -& \hide{\color{Gray}($\text{\isaFS{logic}}^{\text{\color{GreenYellow}1000}}$)}\simpleArgs{$\text{\isaFS{logic}}^{\text{\color{GreenYellow}0}}$} \foclcolorbox{Apricot}{\isaFS{{\isacharminus}{\isachargreater}including\isactrlsub S\isactrlsub e\isactrlsub q{\isacharparenleft}}} \simpleArgs{$\text{\isaFS{logic}}^{\text{\color{GreenYellow}0}}$} \foclcolorbox{Apricot}{\isaFS{{\isacharparenright}}} & {{ \isaFS{UML{\isacharunderscore}Sequence{\isachardot}OclIncluding}}\hideT{\text{\space\color{Black}\isaFS{const}}}}% -\\ - -% - -&\footnotesize\inlineocl"_ ->prepend( _ )" -& \hide{\color{Gray}($\text{\isaFS{logic}}^{\text{\color{GreenYellow}1000}}$)}\simpleArgs{$\text{\isaFS{logic}}^{\text{\color{GreenYellow}0}}$} \foclcolorbox{Apricot}{\isaFS{{\isacharminus}{\isachargreater}prepend\isactrlsub S\isactrlsub e\isactrlsub q{\isacharparenleft}}} \simpleArgs{$\text{\isaFS{logic}}^{\text{\color{GreenYellow}0}}$} \foclcolorbox{Apricot}{\isaFS{{\isacharparenright}}} & {{ \isaFS{UML{\isacharunderscore}Sequence{\isachardot}OclPrepend}}\hideT{\text{\spae\color{Black}\isaFS{const}}}}% -\\ - - % -&\footnotesize\inlineocl"_ ->asSet()" -& \hide{\color{Gray}($\text{\isaFS{logic}}^{\text{\color{GreenYellow}1000}}$)}\simpleArgs{$\text{\isaFS{logic}}^{\text{\color{GreenYellow}0}}$} \foclcolorbox{Apricot}{\isaFS{{\isacharminus}{\isachargreater}asSet\isactrlsub S\isactrlsub e\isactrlsub q{\isacharparenleft}{\isacharparenright}}} & {{ \isaFS{UML{\isacharunderscore}Library{\isachardot}OclAsSet\isactrlsub S\isactrlsub e\isactrlsub q}}\hideT{\text{\space\color{Black}\isaFS{const}}}}% -\\ - - -% -&\footnotesize\inlineocl"_ ->asBag()" -& \hide{\color{Gray}($\text{\isaFS{logic}}^{\text{\color{GreenYellow}1000}}$)}\simpleArgs{$\text{\isaFS{logic}}^{\text{\color{GreenYellow}0}}$} \foclcolorbox{Apricot}{\isaFS{{\isacharminus}{\isachargreater}asBag\isactrlsub S\isactrlsub e\isactrlsub q{\isacharparenleft}{\isacharparenright}}} & {{ \isaFS{UML{\isacharunderscore}Library{\isachardot}OclAsBag\isactrlsub S\isactrlsub e\isactrlsub q}}\hideT{\text{\space\color{Black}\isaFS{const}}}}% -\\ - - -% - -&\footnotesize\inlineocl"_ ->asPair()" -& \hide{\color{Gray}($\text{\isaFS{logic}}^{\text{\color{GreenYellow}1000}}$)}\simpleArgs{$\text{\isaFS{logic}}^{\text{\color{GreenYellow}0}}$} \foclcolorbox{Apricot}{\isaFS{{\isacharminus}{\isachargreater}asPair\isactrlsub S\isactrlsub e\isactrlsub q{\isacharparenleft}{\isacharparenright}}} & {{ \isaFS{UML{\isacharunderscore}Library{\isachardot}OclAsPair\isactrlsub S\isactrlsub e\isactrlsub q}}\hideT{\text{\space\color{Black}\isaFS{const}}}}% -\\ - - - -% -% - -\cmidrule{1-4} - %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - %%%% 11.7.3 Bag - %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -\multirow{15}{*}{\rotatebox{90}{Bag and Iterators on Bag}} -% - -&\footnotesize\inlineocl"Bag ( _ )" -& \hide{\color{Gray}($\text{\isaFS{type}}^{\text{\color{GreenYellow}1000}}$)} \foclcolorbox{Apricot}{\isaFS{Bag{\isacharparenleft}}} $\text{\isaFS{type}}^{\text{\color{GreenYellow}0}}$ \foclcolorbox{Apricot}{\isaFS{{\isacharparenright}}} & {{ \isaFS{UML{\isacharunderscore}Types{\isachardot}Bag\isactrlsub b\isactrlsub a\isactrlsub s\isactrlsub e}}\text{\space\color{Black}\isaFS{type}}}% -\\ - -% -% -&\footnotesize\inlineocl"Bag{}" -& \hide{\color{Gray}($\text{\isaFS{logic}}^{\text{\color{GreenYellow}1000}}$)} \foclcolorbox{Apricot}{\isaFS{Bag{\isacharbraceleft}{\isacharbraceright}}} & {{ \isaFS{UML{\isacharunderscore}Bag{\isachardot}mtBag}}\hideT{\text{\space\color{Black}\isaFS{const}}}}% -\\ - -% -&\footnotesize\inlineocl"Bag{ _ }" -& \hide{\color{Gray}($\text{\isaFS{logic}}^{\text{\color{GreenYellow}1000}}$)} \foclcolorbox{Apricot}{\isaFS{Bag{\isacharbraceleft}}} $\text{\isaFS{args}}^{\text{\color{GreenYellow}0}}$ \foclcolorbox{Apricot}{\isaFS{{\isacharbraceright}}} & {{\color{Gray} \isaFS{OclFinbag}}}% -\\ - - -&\footnotesize\inlineocl"_ ->sum()" -& \hide{\color{Gray}($\text{\isaFS{logic}}^{\text{\color{GreenYellow}1000}}$)}\simpleArgs{$\text{\isaFS{logic}}^{\text{\color{GreenYellow}0}}$} \foclcolorbox{Apricot}{\isaFS{{\isacharminus}{\isachargreater}sum\isactrlsub B\isactrlsub a\isactrlsub g{\isacharparenleft}{\isacharparenright}}} & {{ \isaFS{UML{\isacharunderscore}Bag{\isachardot}OclSum}}\hideT{\text{\space\color{Black}\isaFS{const}}}}% -\\ - -% - -&\footnotesize\inlineocl"_ ->count( _ )" -& \hide{\color{Gray}($\text{\isaFS{logic}}^{\text{\color{GreenYellow}1000}}$)}\simpleArgs{$\text{\isaFS{logic}}^{\text{\color{GreenYellow}0}}$} \foclcolorbox{Apricot}{\isaFS{{\isacharminus}{\isachargreater}count\isactrlsub B\isactrlsub a\isactrlsub g{\isacharparenleft}}} \simpleArgs{$\text{\isaFS{logic}}^{\text{\color{GreenYellow}0}}$} \foclcolorbox{Apricot}{\isaFS{{\isacharparenright}}} & {{ \isaFS{UML{\isacharunderscore}Bag{\isachardot}OclCount}}\hideT{\text{\space\color{Black}\isaFS{const}}}}% -\\ - -% - -&\footnotesize\inlineocl"_ ->intersection( _ )" -& \hide{\color{Gray}($\text{\isaFS{logic}}^{\text{\color{GreenYellow}1000}}$)}\simpleArgs{$\text{\isaFS{logic}}^{\text{\color{GreenYellow}0}}$} \foclcolorbox{Apricot}{\isaFS{{\isacharminus}{\isachargreater}intersection\isactrlsub B\isactrlsub a\isactrlsub g{\isacharparenleft}}} \simpleArgs{$\text{\isaFS{logic}}^{\text{\color{GreenYellow}0}}$} \foclcolorbox{Apricot}{\isaFS{{\isacharparenright}}} & {{ \isaFS{UML{\isacharunderscore}Bag{\isachardot}OclIntersection}}\hideT{\text{\space\color{Black}\isaFS{const}}}}% -\\ - - -% - -&\footnotesize\inlineocl"_ ->union( _ )" -& \hide{\color{Gray}($\text{\isaFS{logic}}^{\text{\color{GreenYellow}1000}}$)}\simpleArgs{$\text{\isaFS{logic}}^{\text{\color{GreenYellow}0}}$} \foclcolorbox{Apricot}{\isaFS{{\isacharminus}{\isachargreater}union\isactrlsub B\isactrlsub a\isactrlsub g{\isacharparenleft}}} \simpleArgs{$\text{\isaFS{logic}}^{\text{\color{GreenYellow}0}}$} \foclcolorbox{Apricot}{\isaFS{{\isacharparenright}}} & {{ \isaFS{UML{\isacharunderscore}Bag{\isachardot}OclUnion}}\hideT{\text{\space\color{Black}\isaFS{const}}}}% -\\ - -% - -&\footnotesize\inlineocl"_ ->excludesAll( _ )" -& \hide{\color{Gray}($\text{\isaFS{logic}}^{\text{\color{GreenYellow}1000}}$)}\simpleArgs{$\text{\isaFS{logic}}^{\text{\color{GreenYellow}0}}$} \foclcolorbox{Apricot}{\isaFS{{\isacharminus}{\isachargreater}excludesAll\isactrlsub B\isactrlsub a\isactrlsub g{\isacharparenleft}}} \simpleArgs{$\text{\isaFS{logic}}^{\text{\color{GreenYellow}0}}$} \foclcolorbox{Apricot}{\isaFS{{\isacharparenright}}} & {{ \isaFS{UML{\isacharunderscore}Bag{\isachardot}OclExcludesAll}}\hideT{\text{\space\color{Black}\isaFS{const}}}}% -\\ - -% - -&\footnotesize\inlineocl"_ ->includesAll( _ )" -& \hide{\color{Gray}($\text{\isaFS{logic}}^{\text{\color{GreenYellow}1000}}$)}\simpleArgs{$\text{\isaFS{logic}}^{\text{\color{GreenYellow}0}}$} \foclcolorbox{Apricot}{\isaFS{{\isacharminus}{\isachargreater}includesAll\isactrlsub B\isactrlsub a\isactrlsub g{\isacharparenleft}}} \simpleArgs{$\text{\isaFS{logic}}^{\text{\color{GreenYellow}0}}$} \foclcolorbox{Apricot}{\isaFS{{\isacharparenright}}} & {{ \isaFS{UML{\isacharunderscore}Bag{\isachardot}OclIncludesAll}}\hideT{\text{\space\color{Black}\isaFS{const}}}}% -\\ - -% - -&\footnotesize\inlineocl"_ ->reject( _ | _ )" -& \hide{\color{Gray}($\text{\isaFS{logic}}^{\text{\color{GreenYellow}1000}}$)}\simpleArgs{$\text{\isaFS{logic}}^{\text{\color{GreenYellow}0}}$} \foclcolorbox{Apricot}{\isaFS{{\isacharminus}{\isachargreater}reject\isactrlsub B\isactrlsub a\isactrlsub g{\isacharparenleft}}} \fbox{$\text{\isaFS{id}}$} \foclcolorbox{Apricot}{\isaFS{{\isacharbar}}} \simpleArgs{$\text{\isaFS{logic}}^{\text{\color{GreenYellow}0}}$} \foclcolorbox{Apricot}{\isaFS{{\isacharparenright}}} & {{\color{Gray} \isaFS{OclRejectBag}}}% -\\ - -% - -&\footnotesize\inlineocl"_ ->select( _ | _ )" -& \hide{\color{Gray}($\text{\isaFS{logic}}^{\text{\color{GreenYellow}1000}}$)}\simpleArgs{$\text{\isaFS{logic}}^{\text{\color{GreenYellow}0}}$} \foclcolorbox{Apricot}{\isaFS{{\isacharminus}{\isachargreater}select\isactrlsub B\isactrlsub a\isactrlsub g{\isacharparenleft}}} \fbox{$\text{\isaFS{id}}$} \foclcolorbox{Apricot}{\isaFS{{\isacharbar}}} \simpleArgs{$\text{\isaFS{logic}}^{\text{\color{GreenYellow}0}}$} \foclcolorbox{Apricot}{\isaFS{{\isacharparenright}}} & {{\color{Gray} \isaFS{OclSelectBag}}}% -\\ - -% - -&\footnotesize\inlineocl"_ ->iterate( _ ; _ = _ | _ )" -& \hide{\color{Gray}($\text{\isaFS{logic}}^{\text{\color{GreenYellow}1000}}$)}\simpleArgs{$\text{\isaFS{logic}}^{\text{\color{GreenYellow}0}}$} \foclcolorbox{Apricot}{\isaFS{{\isacharminus}{\isachargreater}iterate\isactrlsub B\isactrlsub a\isactrlsub g{\isacharparenleft}}} $\text{\isaFS{idt}}^{\text{\color{GreenYellow}0}}$ \foclcolorbox{Apricot}{\isaFS{{\isacharsemicolon}}} $\text{\isaFS{idt}}^{\text{\color{GreenYellow}0}}$ \foclcolorbox{Apricot}{\isaFS{{\isacharequal}}} $\text{\isaFS{any}}^{\text{\color{GreenYellow}0}}$ \foclcolorbox{Apricot}{\isaFS{{\isacharbar}}} $\text{\isaFS{any}}^{\text{\color{GreenYellow}0}}$ \foclcolorbox{Apricot}{\isaFS{{\isacharparenright}}} & {{\color{Gray} \isaFS{OclIterateBag}}}% -\\ - -% - -&\footnotesize\inlineocl"_ ->exists( _ | _ )" -& \hide{\color{Gray}($\text{\isaFS{logic}}^{\text{\color{GreenYellow}1000}}$)}\simpleArgs{$\text{\isaFS{logic}}^{\text{\color{GreenYellow}0}}$} \foclcolorbox{Apricot}{\isaFS{{\isacharminus}{\isachargreater}exists\isactrlsub B\isactrlsub a\isactrlsub g{\isacharparenleft}}} \fbox{$\text{\isaFS{id}}$} \foclcolorbox{Apricot}{\isaFS{{\isacharbar}}} \simpleArgs{$\text{\isaFS{logic}}^{\text{\color{GreenYellow}0}}$} \foclcolorbox{Apricot}{\isaFS{{\isacharparenright}}} & {{\color{Gray} \isaFS{OclExistBag}}}% -\\ - -% - -&\footnotesize\inlineocl"_ ->forAll( _ | _ )" -& \hide{\color{Gray}($\text{\isaFS{logic}}^{\text{\color{GreenYellow}1000}}$)}\simpleArgs{$\text{\isaFS{logic}}^{\text{\color{GreenYellow}0}}$} \foclcolorbox{Apricot}{\isaFS{{\isacharminus}{\isachargreater}forAll\isactrlsub B\isactrlsub a\isactrlsub g{\isacharparenleft}}} \fbox{$\text{\isaFS{id}}$} \foclcolorbox{Apricot}{\isaFS{{\isacharbar}}} \simpleArgs{$\text{\isaFS{logic}}^{\text{\color{GreenYellow}0}}$} \foclcolorbox{Apricot}{\isaFS{{\isacharparenright}}} & {{\color{Gray} \isaFS{OclForallBag}}}% -\\ - -% - -&\footnotesize\inlineocl"_ ->any()" -& \hide{\color{Gray}($\text{\isaFS{logic}}^{\text{\color{GreenYellow}1000}}$)}\simpleArgs{$\text{\isaFS{logic}}^{\text{\color{GreenYellow}0}}$} \foclcolorbox{Apricot}{\isaFS{{\isacharminus}{\isachargreater}any\isactrlsub B\isactrlsub a\isactrlsub g{\isacharparenleft}{\isacharparenright}}} & {{ \isaFS{UML{\isacharunderscore}Bag{\isachardot}OclANY}}\hideT{\text{\space\color{Black}\isaFS{const}}}}% -\\ - -% - -&\footnotesize\inlineocl"_ ->notEmpty()" -& \hide{\color{Gray}($\text{\isaFS{logic}}^{\text{\color{GreenYellow}1000}}$)}\simpleArgs{$\text{\isaFS{logic}}^{\text{\color{GreenYellow}0}}$} \foclcolorbox{Apricot}{\isaFS{{\isacharminus}{\isachargreater}notEmpty\isactrlsub B\isactrlsub a\isactrlsub g{\isacharparenleft}{\isacharparenright}}} & {{ \isaFS{UML{\isacharunderscore}Bag{\isachardot}OclNotEmpty}}\hideT{\text{\space\color{Black}\isaFS{const}}}}% -\\ - -% - -&\footnotesize\inlineocl"_ ->isEmpty()" -& \hide{\color{Gray}($\text{\isaFS{logic}}^{\text{\color{GreenYellow}1000}}$)}\simpleArgs{$\text{\isaFS{logic}}^{\text{\color{GreenYellow}0}}$} \foclcolorbox{Apricot}{\isaFS{{\isacharminus}{\isachargreater}isEmpty\isactrlsub B\isactrlsub a\isactrlsub g{\isacharparenleft}{\isacharparenright}}} & {{ \isaFS{UML{\isacharunderscore}Bag{\isachardot}OclIsEmpty}}\hideT{\text{\space\color{Black}\isaFS{const}}}}% -\\ - -% - -&\footnotesize\inlineocl"_ ->size()" -& \hide{\color{Gray}($\text{\isaFS{logic}}^{\text{\color{GreenYellow}1000}}$)}\simpleArgs{$\text{\isaFS{logic}}^{\text{\color{GreenYellow}0}}$} \foclcolorbox{Apricot}{\isaFS{{\isacharminus}{\isachargreater}size\isactrlsub B\isactrlsub a\isactrlsub g{\isacharparenleft}{\isacharparenright}}} & {{ \isaFS{UML{\isacharunderscore}Bag{\isachardot}OclSize}}\hideT{\text{\space\color{Black}\isaFS{const}}}}% -\\ - -% - -&\footnotesize\inlineocl"_ ->excludes( _ )" -& \hide{\color{Gray}($\text{\isaFS{logic}}^{\text{\color{GreenYellow}1000}}$)}\simpleArgs{$\text{\isaFS{logic}}^{\text{\color{GreenYellow}0}}$} \foclcolorbox{Apricot}{\isaFS{{\isacharminus}{\isachargreater}excludes\isactrlsub B\isactrlsub a\isactrlsub g{\isacharparenleft}}} \simpleArgs{$\text{\isaFS{logic}}^{\text{\color{GreenYellow}0}}$} \foclcolorbox{Apricot}{\isaFS{{\isacharparenright}}} & {{ \isaFS{UML{\isacharunderscore}Bag{\isachardot}OclExcludes}}\hideT{\text{\space\color{Black}\isaFS{const}}}}% -\\ - -% - -&\footnotesize\inlineocl"_ ->includes( _ )" -& \hide{\color{Gray}($\text{\isaFS{logic}}^{\text{\color{GreenYellow}1000}}$)}\simpleArgs{$\text{\isaFS{logic}}^{\text{\color{GreenYellow}0}}$} \foclcolorbox{Apricot}{\isaFS{{\isacharminus}{\isachargreater}includes\isactrlsub B\isactrlsub a\isactrlsub g{\isacharparenleft}}} \simpleArgs{$\text{\isaFS{logic}}^{\text{\color{GreenYellow}0}}$} \foclcolorbox{Apricot}{\isaFS{{\isacharparenright}}} & {{ \isaFS{UML{\isacharunderscore}Bag{\isachardot}OclIncludes}}\hideT{\text{\space\color{Black}\isaFS{const}}}}% -\\ - -% - -&\footnotesize\inlineocl"_ ->excluding( _ )" -& \hide{\color{Gray}($\text{\isaFS{logic}}^{\text{\color{GreenYellow}1000}}$)}\simpleArgs{$\text{\isaFS{logic}}^{\text{\color{GreenYellow}0}}$} \foclcolorbox{Apricot}{\isaFS{{\isacharminus}{\isachargreater}excluding\isactrlsub B\isactrlsub a\isactrlsub g{\isacharparenleft}}} \simpleArgs{$\text{\isaFS{logic}}^{\text{\color{GreenYellow}0}}$} \foclcolorbox{Apricot}{\isaFS{{\isacharparenright}}} & {{ \isaFS{UML{\isacharunderscore}Bag{\isachardot}OclExcluding}}\hideT{\text{\space\color{Black}\isaFS{const}}}}% -\\ - -% - -&\footnotesize\inlineocl"_ ->including( _ )" -& \hide{\color{Gray}($\text{\isaFS{logic}}^{\text{\color{GreenYellow}1000}}$)}\simpleArgs{$\text{\isaFS{logic}}^{\text{\color{GreenYellow}0}}$} \foclcolorbox{Apricot}{\isaFS{{\isacharminus}{\isachargreater}including\isactrlsub B\isactrlsub a\isactrlsub g{\isacharparenleft}}} \simpleArgs{$\text{\isaFS{logic}}^{\text{\color{GreenYellow}0}}$} \foclcolorbox{Apricot}{\isaFS{{\isacharparenright}}} & {{ \isaFS{UML{\isacharunderscore}Bag{\isachardot}OclIncluding}}\hideT{\text{\space\color{Black}\isaFS{const}}}}% -\\ - - % -&\footnotesize\inlineocl"_ ->asSet()" -& \hide{\color{Gray}($\text{\isaFS{logic}}^{\text{\color{GreenYellow}1000}}$)}\simpleArgs{$\text{\isaFS{logic}}^{\text{\color{GreenYellow}0}}$} \foclcolorbox{Apricot}{\isaFS{{\isacharminus}{\isachargreater}asSet\isactrlsub B\isactrlsub a\isactrlsub g{\isacharparenleft}{\isacharparenright}}} & {{ \isaFS{UML{\isacharunderscore}Library{\isachardot}OclAsSet\isactrlsub B\isactrlsub a\isactrlsub g}}\hideT{\text{\space\color{Black}\isaFS{const}}}}% -\\ - % -&\footnotesize\inlineocl"_ ->asSeq()" -& \hide{\color{Gray}($\text{\isaFS{logic}}^{\text{\color{GreenYellow}1000}}$)}\simpleArgs{$\text{\isaFS{logic}}^{\text{\color{GreenYellow}0}}$} \foclcolorbox{Apricot}{\isaFS{{\isacharminus}{\isachargreater}asSeq\isactrlsub B\isactrlsub a\isactrlsub g{\isacharparenleft}{\isacharparenright}}} & {{ \isaFS{UML{\isacharunderscore}Library{\isachardot}OclAsSeq\isactrlsub B\isactrlsub a\isactrlsub g}}\hideT{\text{\space\color{Black}\isaFS{const}}}}% -\\ - % -&\footnotesize\inlineocl"_ ->asPair()" -& \hide{\color{Gray}($\text{\isaFS{logic}}^{\text{\color{GreenYellow}1000}}$)}\simpleArgs{$\text{\isaFS{logic}}^{\text{\color{GreenYellow}0}}$} \foclcolorbox{Apricot}{\isaFS{{\isacharminus}{\isachargreater}asPair\isactrlsub B\isactrlsub a\isactrlsub g{\isacharparenleft}{\isacharparenright}}} & {{ \isaFS{UML{\isacharunderscore}Library{\isachardot}OclAsPair\isactrlsub B\isactrlsub a\isactrlsub g}}\hideT{\text{\space\color{Black}\isaFS{const}}}}% -\\ - -\cmidrule{1-4} - %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - %%%% Pair - %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -\multirow{3}{*}{\rotatebox{90}{Pair}} - -&\footnotesize\inlineocl"" -& \hide{\color{Gray}($\text{\isaFS{type}}^{\text{\color{GreenYellow}1000}}$)} \foclcolorbox{Apricot}{\isaFS{Pair{\isacharparenleft}}} $\text{\isaFS{type}}^{\text{\color{GreenYellow}0}}$ \foclcolorbox{Apricot}{\isaFS{{\isacharcomma}}} $\text{\isaFS{type}}^{\text{\color{GreenYellow}0}}$ \foclcolorbox{Apricot}{\isaFS{{\isacharparenright}}} & {{ \isaFS{UML{\isacharunderscore}Types{\isachardot}Pair\isactrlsub b\isactrlsub a\isactrlsub s\isactrlsub e}}\text{\space\color{Black}\isaFS{type}}}% -\\ - - % -& -& \hide{\color{Gray}($\text{\isaFS{logic}}^{\text{\color{GreenYellow}1000}}$)} \foclcolorbox{Apricot}{\isaFS{Pair{\isacharbraceleft}}}\simpleArgs{$\text{\isaFS{logic}}^{\text{\color{GreenYellow}0}}$} \foclcolorbox{Apricot}{\isaFS{{\isacharcomma}}} \simpleArgs{$\text{\isaFS{logic}}^{\text{\color{GreenYellow}0}}$} \foclcolorbox{Apricot}{\isaFS{{\isacharbraceright}}} & {{ \isaFS{UML{\isacharunderscore}Pair{\isachardot}OclPair}}\hideT{\text{\space\color{Black}\isaFS{const}}}}% -\\ - -% -& -& \hide{\color{Gray}($\text{\isaFS{logic}}^{\text{\color{GreenYellow}1000}}$)}\simpleArgs{$\text{\isaFS{logic}}^{\text{\color{GreenYellow}0}}$} \foclcolorbox{Apricot}{\isaFS{{\isachardot}Second{\isacharparenleft}{\isacharparenright}}} & {{ \isaFS{UML{\isacharunderscore}Pair{\isachardot}OclSecond}}\hideT{\text{\space\color{Black}\isaFS{const}}}}% -\\ - -% -& -& \hide{\color{Gray}($\text{\isaFS{logic}}^{\text{\color{GreenYellow}1000}}$)}\simpleArgs{$\text{\isaFS{logic}}^{\text{\color{GreenYellow}0}}$} \foclcolorbox{Apricot}{\isaFS{{\isachardot}First{\isacharparenleft}{\isacharparenright}}} & {{ \isaFS{UML{\isacharunderscore}Pair{\isachardot}OclFirst}}\hideT{\text{\space\color{Black}\isaFS{const}}}}% -\\ - -% -% -&\footnotesize\inlineocl"_ ->asSequence()" -& \hide{\color{Gray}($\text{\isaFS{logic}}^{\text{\color{GreenYellow}1000}}$)}\simpleArgs{$\text{\isaFS{logic}}^{\text{\color{GreenYellow}0}}$} \foclcolorbox{Apricot}{\isaFS{{\isacharminus}{\isachargreater}asSequence\isactrlsub P\isactrlsub a\isactrlsub i\isactrlsub r{\isacharparenleft}{\isacharparenright}}} & {{ \isaFS{UML{\isacharunderscore}Library{\isachardot}OclAsSeq\isactrlsub P\isactrlsub a\isactrlsub i\isactrlsub r}}\hideT{\text{\space\color{Black}\isaFS{const}}}}% -\\ - - -% -&\footnotesize\inlineocl"_ ->asSet()" -& \hide{\color{Gray}($\text{\isaFS{logic}}^{\text{\color{GreenYellow}1000}}$)}\simpleArgs{$\text{\isaFS{logic}}^{\text{\color{GreenYellow}0}}$} \foclcolorbox{Apricot}{\isaFS{{\isacharminus}{\isachargreater}asSet\isactrlsub P\isactrlsub a\isactrlsub i\isactrlsub r{\isacharparenleft}{\isacharparenright}}} & {{ \isaFS{UML{\isacharunderscore}Library{\isachardot}OclAsSet\isactrlsub P\isactrlsub a\isactrlsub i\isactrlsub r}}\hideT{\text{\space\color{Black}\isaFS{const}}}}% -\\ - - - \cmidrule{1-4} - %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - %%%% Pair - %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -\multirow{3}{*}{\rotatebox{90}{State Access}} - -&\footnotesize\inlineocl"_ .allInstances()" -& \hide{\color{Gray}($\text{\isaFS{logic}}^{\text{\color{GreenYellow}1000}}$)}\simpleArgs{$\text{\isaFS{logic}}^{\text{\color{GreenYellow}0}}$} \foclcolorbox{Apricot}{\isaFS{{\isachardot}allInstances{\isacharparenleft}{\isacharparenright}}} & {{ \isaFS{UML{\isacharunderscore}State{\isachardot}OclAllInstances{\isacharunderscore}at{\isacharunderscore}post}}\hideT{\text{\space\color{Black}\isaFS{const}}}}% -\\ - -% -& -& \hide{\color{Gray}($\text{\isaFS{logic}}^{\text{\color{GreenYellow}1000}}$)}\simpleArgs{$\text{\isaFS{logic}}^{\text{\color{GreenYellow}0}}$} \foclcolorbox{Apricot}{\isaFS{{\isachardot}allInstances{\isacharat}pre{\isacharparenleft}{\isacharparenright}}} & {{ \isaFS{UML{\isacharunderscore}State{\isachardot}OclAllInstances{\isacharunderscore}at{\isacharunderscore}pre}}\hideT{\text{\space\color{Black}\isaFS{const}}}}% -\\ - -% - - -% - -& -& \hide{\color{Gray}($\text{\isaFS{logic}}^{\text{\color{GreenYellow}1000}}$)}\simpleArgs{$\text{\isaFS{logic}}^{\text{\color{GreenYellow}0}}$} \foclcolorbox{Apricot}{\isaFS{{\isachardot}oclIsDeleted{\isacharparenleft}{\isacharparenright}}} & {{ \isaFS{UML{\isacharunderscore}State{\isachardot}OclIsDeleted}}\hideT{\text{\space\color{Black}\isaFS{const}}}}% -\\ - -% - -& -& \hide{\color{Gray}($\text{\isaFS{logic}}^{\text{\color{GreenYellow}1000}}$)}\simpleArgs{$\text{\isaFS{logic}}^{\text{\color{GreenYellow}0}}$} \foclcolorbox{Apricot}{\isaFS{{\isachardot}oclIsMaintained{\isacharparenleft}{\isacharparenright}}} & {{ \isaFS{UML{\isacharunderscore}State{\isachardot}OclIsMaintained}}\hideT{\text{\space\color{Black}\isaFS{const}}}}% -\\ - -% - -& -& \hide{\color{Gray}($\text{\isaFS{logic}}^{\text{\color{GreenYellow}1000}}$)}\simpleArgs{$\text{\isaFS{logic}}^{\text{\color{GreenYellow}0}}$} \foclcolorbox{Apricot}{\isaFS{{\isachardot}oclIsAbsent{\isacharparenleft}{\isacharparenright}}} & {{ \isaFS{UML{\isacharunderscore}State{\isachardot}OclIsAbsent}}\hideT{\text{\space\color{Black}\isaFS{const}}}}% -\\ - -% -& -& \hide{\color{Gray}($\text{\isaFS{logic}}^{\text{\color{GreenYellow}1000}}$)}\simpleArgs{$\text{\isaFS{logic}}^{\text{\color{GreenYellow}0}}$} \foclcolorbox{Apricot}{\isaFS{{\isacharminus}{\isachargreater}oclIsModifiedOnly{\isacharparenleft}{\isacharparenright}}} & {{ \isaFS{UML{\isacharunderscore}State{\isachardot}OclIsModifiedOnly}}\hideT{\text{\space\color{Black}\isaFS{const}}}}% -\\ - -% - -&\footnotesize\inlineocl"_ @pre _" -& \hide{\color{Gray}($\text{\isaFS{logic}}^{\text{\color{GreenYellow}1000}}$)}\simpleArgs{$\text{\isaFS{logic}}^{\text{\color{GreenYellow}0}}$} \foclcolorbox{Apricot}{\isaFS{{\isacharat}pre}} \simpleArgs{$\text{\isaFS{logic}}^{\text{\color{GreenYellow}0}}$} & {{ \isaFS{UML{\isacharunderscore}State{\isachardot}OclSelf{\isacharunderscore}at{\isacharunderscore}pre}}\hideT{\text{\space\color{Black}\isaFS{const}}}}% -\\ - -% -& -& \hide{\color{Gray}($\text{\isaFS{logic}}^{\text{\color{GreenYellow}1000}}$)}\simpleArgs{$\text{\isaFS{logic}}^{\text{\color{GreenYellow}0}}$} \foclcolorbox{Apricot}{\isaFS{{\isacharat}post}} \simpleArgs{$\text{\isaFS{logic}}^{\text{\color{GreenYellow}0}}$} & {{ \isaFS{UML{\isacharunderscore}State{\isachardot}OclSelf{\isacharunderscore}at{\isacharunderscore}post}}\hideT{\text{\space\color{Black}\isaFS{const}}}}% -\\ - - - - \cmidrule{1-4} - -%%%% -%%%% -%%%% Other Stuff -%%%% - -% \multirow{7}{*}{\rotatebox{90}{Unsorted}} - -% -% & -% & \hide{\color{Gray}($\text{\isaFS{logic}}^{\text{\color{GreenYellow}1000}}$)} \foclcolorbox{Apricot}{\isaFS{{\isasymlceil}}}\simpleArgs{$\text{\isaFS{logic}}^{\text{\color{GreenYellow}0}}$} \foclcolorbox{Apricot}{\isaFS{{\isasymrceil}}} & {{ \isaFS{UML{\isacharunderscore}Types{\isachardot}drop}}\hideT{\text{\space\color{Black}\isaFS{const}}}}% -% \\ -% % -% & -% & \hide{\color{Gray}($\text{\isaFS{logic}}^{\text{\color{GreenYellow}1000}}$)} \foclcolorbox{Apricot}{\isaFS{I{\isasymlbrakk}}} $\text{\isaFS{any}}^{\text{\color{GreenYellow}0}}$ \foclcolorbox{Apricot}{\isaFS{{\isasymrbrakk}}} & {{ \isaFS{UML{\isacharunderscore}Types{\isachardot}Sem}}\hideT{\text{\space\color{Black}\isaFS{const}}}}% -% \\ - - -% % -% & -% & \hide{\color{Gray}($\text{\isaFS{logic}}^{\text{\color{GreenYellow}1000}}$)} \foclcolorbox{Apricot}{\isaFS{{\isasymbottom}}} & {{ \isaFS{UML{\isacharunderscore}Types{\isachardot}bot{\isacharunderscore}class{\isachardot}bot}}\hideT{\text{\space\color{Black}\isaFS{const}}}}% -% \\ - -% % - - -% % -% & -% & \hide{\color{Gray}($\text{\isaFS{logic}}^{\text{\color{GreenYellow}1000}}$)} \foclcolorbox{Apricot}{\isaFS{{\isasymbottom}}} & {{ \isaFS{Option{\isachardot}option{\isachardot}None}}\hideT{\text{\space\color{Black}\isaFS{const}}}}% -% \\ - - - - -% % - - -% % - - -% % - -% % -% % & \hide{\color{Gray}($\text{\isaFS{logic}}^{\text{\color{GreenYellow}1000}}$)} $\text{\isaFS{cartouche{\isacharunderscore}position}}^{\text{\color{GreenYellow}0}}$ & {{\color{Gray} \isaFS{cartouche{\isacharunderscore}oclstring}}}% -% % \\ - -% % -% & -% & \hide{\color{Gray}($\text{\isaFS{logic}}^{\text{\color{GreenYellow}1000}}$)} \foclcolorbox{Apricot}{\isaFS{{\isacharunderscore}{\isacharprime}}} & {{\color{Gray} \isaFS{ocl{\isacharunderscore}denotation}}}% -% \\ - - -% % -% % - -% % -% & -% & \hide{\color{Gray}($\text{\isaFS{type}}^{\text{\color{GreenYellow}1000}}$)} \foclcolorbox{Apricot}{\isaFS{{\isasymlangle}}} $\text{\isaFS{type}}^{\text{\color{GreenYellow}0}}$ \foclcolorbox{Apricot}{\isaFS{{\isasymrangle}\isactrlsub {\isasymbottom}}} & {{ \isaFS{Option{\isachardot}option}}\text{\space\color{Black}\isaFS{type}}}% -% \\ - -% - - - -% - - - - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - - -% - - - - - - - -\end{longtable} -} - -%%% Local Variables: -%%% fill-column:80 -%%% x-symbol-8bits:nil -%%% mode: latex -%%% TeX-master: "syntax_main" -%%% End: diff --git a/Citadelle/src/document/comment.sty b/Citadelle/src/document/comment.sty deleted file mode 100644 index 77703f88e477b4b33018767f18ad26ed7991e093..0000000000000000000000000000000000000000 --- a/Citadelle/src/document/comment.sty +++ /dev/null @@ -1,278 +0,0 @@ -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -% Comment.sty version 3.6, October 1999 -% -% Purpose: -% selectively in/exclude pieces of text: the user can define new -% comment versions, and each is controlled separately. -% Special comments can be defined where the user specifies the -% action that is to be taken with each comment line. -% -% Author -% Victor Eijkhout -% Department of Computer Science -% University of Tennessee -% 107 Ayres Hall -% Knoxville TN 37996 -% USA -% -% victor at eijkhout.net -% -% This program is free software; you can redistribute it and/or -% modify it under the terms of the GNU General Public License -% as published by the Free Software Foundation; either version 2 -% of the License, or (at your option) any later version. -% -% This program is distributed in the hope that it will be useful, -% but WITHOUT ANY WARRANTY; without even the implied warranty of -% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -% GNU General Public License for more details. -% -% For a copy of the GNU General Public License, write to the -% Free Software Foundation, Inc., -% 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA, -% or find it on the net, for instance at -% http://www.gnu.org/copyleft/gpl.html -% -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -% This style can be used with plain TeX or LaTeX, and probably -% most other packages too. -% -% Usage: all text included between -% \comment ... \endcomment -% or \begin{comment} ... \end{comment} -% is discarded. -% -% The opening and closing commands should appear on a line -% of their own. No starting spaces, nothing after it. -% This environment should work with arbitrary amounts -% of comment, and the comment can be arbitrary text. -% -% Other `comment' environments are defined by -% and are selected/deselected with -% \includecomment{versiona} -% \excludecoment{versionb} -% -% These environments are used as -% \versiona ... \endversiona -% or \begin{versiona} ... \end{versiona} -% with the opening and closing commands again on a line of -% their own. -% -% LaTeX users note: for an included comment, the -% \begin and \end lines act as if they don't exist. -% In particular, they don't imply grouping, so assignments -% &c are not local. -% -% Special comments are defined as -% \specialcomment{name}{before commands}{after commands} -% where the second and third arguments are executed before -% and after each comment block. You can use this for global -% formatting commands. -% To keep definitions &c local, you can include \begingroup -% in the `before commands' and \endgroup in the `after commands'. -% ex: -% \specialcomment{smalltt} -% {\begingroup\ttfamily\footnotesize}{\endgroup} -% You do *not* have to do an additional -% \includecomment{smalltt} -% To remove 'smalltt' blocks, give \excludecomment{smalltt} -% after the definition. -% -% Processing comments can apply processing to each line. -% \processcomment{name}{each-line commands}% -% {before commands}{after commands} -% By defining a control sequence -% \def\Thiscomment##1{...} in the before commands the user can -% specify what is to be done with each comment line. -% BUG this does not work quite yet BUG -% -% Trick for short in/exclude macros (such as \maybe{this snippet}): -%\includecomment{cond} -%\newcommand{\maybe}[1]{} -%\begin{cond} -%\renewcommand{\maybe}[1]{#1} -%\end{cond} -% -% Basic approach of the implementation: -% to comment something out, scoop up every line in verbatim mode -% as macro argument, then throw it away. -% For inclusions, in LaTeX the block is written out to -% a file \CommentCutFile (default "comment.cut"), which is -% then included. -% In plain TeX (and other formats) both the opening and -% closing comands are defined as noop. -% -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -% Changes in version 3.1 -% - updated author's address -% - cleaned up some code -% - trailing contents on \begin{env} line is always discarded -% even if you've done \includecomment{env} -% - comments no longer define grouping!! you can even -% \includecomment{env} -% \begin{env} -% \begin{itemize} -% \end{env} -% Isn't that something ... -% - included comments are written to file and input again. -% Changes in 3.2 -% - \specialcomment brought up to date (thanks to Ivo Welch). -% Changes in 3.3 -% - updated author's address again -% - parametrised \CommentCutFile -% Changes in 3.4 -% - added GNU public license -% - added \processcomment, because Ivo's fix (above) brought an -% inconsistency to light. -% Changes in 3.5 -% - corrected typo in header. -% - changed author email -% - corrected \specialcomment yet again. -% - fixed excludecomment of an earlier defined environment. -% Changes in 3.6 -% - The 'cut' file is now written more verbatim, using \meaning; -% some people reported having trouble with ISO latin 1, or umlaute.sty. -% - removed some \newif statements. -% Has this suddenly become \outer again? -% -% Known bugs: -% - excludecomment leads to one superfluous space -% - processcomment leads to a superfluous line break -% -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - -\def\makeinnocent#1{\catcode`#1=12 } -\def\csarg#1#2{\expandafter#1\csname#2\endcsname} -\def\latexname{lplain}\def\latexename{LaTeX2e} -\newwrite\CommentStream -\def\CommentCutFile{comment.cut} - -\def\ProcessComment#1% start it all of - {\begingroup - \def\CurrentComment{#1}% - \let\do\makeinnocent \dospecials - \makeinnocent\^^L% and whatever other special cases - \endlinechar`\^^M \catcode`\^^M=12 \xComment} -%\def\ProcessCommentWithArg#1#2% to be used in \leveledcomment -% {\begingroup -% \def\CurrentComment{#1}% -% \let\do\makeinnocent \dospecials -% \makeinnocent\^^L% and whatever other special cases -% \endlinechar`\^^M \catcode`\^^M=12 \xComment} -{\catcode`\^^M=12 \endlinechar=-1 % - \gdef\xComment#1^^M{% - \expandafter\ProcessCommentLine} - \gdef\ProcessCommentLine#1^^M{\def\test{#1} - \csarg\ifx{End\CurrentComment Test}\test - \edef\next{\noexpand\EndOfComment{\CurrentComment}}% - \else \ThisComment{#1}\let\next\ProcessCommentLine - \fi \next} -} - -\def\CSstringmeaning#1{\expandafter\CSgobblearrow\meaning#1} -\def\CSstringcsnoescape#1{\expandafter\CSgobbleescape\string#1} -{\escapechar-1 -\expandafter\expandafter\expandafter\gdef - \expandafter\expandafter\expandafter\CSgobblearrow - \expandafter\string\csname macro:->\endcsname{} -} -\def\CSgobbleescape#1{\ifnum`\\=`#1 \else #1\fi} -\def\WriteCommentLine#1{\def\CStmp{#1}% - \immediate\write\CommentStream{\CSstringmeaning\CStmp}} - -% 3.1 change: in LaTeX and LaTeX2e prevent grouping -\if 0% -\ifx\fmtname\latexename - 0% -\else \ifx\fmtname\latexname - 0% - \else - 1% -\fi \fi -%%%% -%%%% definitions for LaTeX -%%%% -\def\AfterIncludedComment - {\immediate\closeout\CommentStream - \input{\CommentCutFile}\relax - }% -\def\TossComment{\immediate\closeout\CommentStream} -\def\BeforeIncludedComment - {\immediate\openout\CommentStream=\CommentCutFile - \let\ThisComment\WriteCommentLine} -\def\includecomment - #1{\message{Include comment '#1'}% - \csarg\let{After#1Comment}\AfterIncludedComment - \csarg\def{#1}{\BeforeIncludedComment - \ProcessComment{#1}}% - \CommentEndDef{#1}} -\long\def\specialcomment - #1#2#3{\message{Special comment '#1'}% - % note: \AfterIncludedComment does \input, so #2 goes here! - \csarg\def{After#1Comment}{#2\AfterIncludedComment#3}% - \csarg\def{#1}{\BeforeIncludedComment\relax - \ProcessComment{#1}}% - \CommentEndDef{#1}} -\long\def\processcomment - #1#2#3#4{\message{Lines-Processing comment '#1'}% - \csarg\def{After#1Comment}{#3\AfterIncludedComment#4}% - \csarg\def{#1}{\BeforeIncludedComment#2\relax - \ProcessComment{#1}}% - \CommentEndDef{#1}} -\def\leveledcomment - #1#2{\message{Include comment '#1' up to level '#2'}% - %\csname #1IsLeveledCommenttrue\endcsname - \csarg\let{After#1Comment}\AfterIncludedComment - \csarg\def{#1}{\BeforeIncludedComment - \ProcessCommentWithArg{#1}}% - \CommentEndDef{#1}} -\else -%%%% -%%%%plain TeX and other formats -%%%% -\def\includecomment - #1{\message{Including comment '#1'}% - \csarg\def{#1}{}% - \csarg\def{end#1}{}} -\long\def\specialcomment - #1#2#3{\message{Special comment '#1'}% - \csarg\def{#1}{\def\ThisComment{}\def\AfterComment{#3}#2% - \ProcessComment{#1}}% - \CommentEndDef{#1}} -\fi - -%%%% -%%%% general definition of skipped comment -%%%% -\def\excludecomment - #1{\message{Excluding comment '#1'}% - \csarg\def{#1}{\let\AfterComment\relax - \def\ThisComment####1{}\ProcessComment{#1}}% - \csarg\let{After#1Comment}\TossComment - \CommentEndDef{#1}} - -\if 0% -\ifx\fmtname\latexename - 0% -\else \ifx\fmtname\latexname - 0% - \else - 1% -\fi \fi -% latex & latex2e: -\def\EndOfComment#1{\endgroup\end{#1}% - \csname After#1Comment\endcsname} -\def\CommentEndDef#1{{\escapechar=-1\relax - \csarg\xdef{End#1Test}{\string\\end\string\{#1\string\}}% - }} -\else -% plain & other -\def\EndOfComment#1{\endgroup\AfterComment} -\def\CommentEndDef#1{{\escapechar=-1\relax - \csarg\xdef{End#1Test}{\string\\end#1}% - }} -\fi - -\excludecomment{comment} - -\endinput diff --git a/Citadelle/src/document/conclusion.tex b/Citadelle/src/document/conclusion.tex deleted file mode 100644 index 35674b157d44252ec75220769dc391eeadb0a707..0000000000000000000000000000000000000000 --- a/Citadelle/src/document/conclusion.tex +++ /dev/null @@ -1,192 +0,0 @@ -\part{Conclusion} - -\chapter{Conclusion} - -\section{Lessons Learned and Contributions} -We provided a typed and type-safe shallow embedding of the core of -UML~\cite{omg:uml-infrastructure:2011,omg:uml-superstructure:2011} and -OCL~\cite{omg:ocl:2012}. Shallow embedding means that types of OCL -were mapped by the embedding one-to-one to types in -Isabelle/HOL~\cite{nipkow.ea:isabelle:2002}. We followed the usual -methodology to build up the theory uniquely by conservative extensions -of all operators in a denotational style and to derive logical and -algebraic (execution) rules from them; thus, we can guarantee the -logical consistency of the library and instances of the class model -construction. The class models were given a closed-world interpretation -as object-oriented datatype theories, as -long as it follows the described methodology.% -\isatagafp -\footnote{Our two - examples of \inlineisar+Employee_AnalysisModel+ and - \inlineisar+Employee_DesignModel+ (see - \autoref{ex:employee-analysis:uml} and - \autoref{ex:employee-analysis:ocl} as well as - \autoref{ex:employee-design:uml} and - \autoref{ex:employee-design:ocl}) sketch how this construction can - be captured by an automated process; its implementation is described - elsewhere.} -\endisatagafp -Moreover, all derived -execution rules are by construction type-safe (which would be an -issue, if we had chosen to use an object universe construction in -Zermelo-Fraenkel set theory as an alternative approach to subtyping.). -In more detail, our theory gives answers and concrete solutions to a -number of open major issues for the UML/OCL standardization: -\begin{enumerate} -\item the role of the two exception elements \inlineisar+invalid+ and - \inlineisar+null+, the former usually assuming strict evaluation - while the latter ruled by non-strict evaluation. -\item the functioning of the resulting four-valued logic, together - with safe rules (for example \inlineisar+foundation9+ -- - \inlineisar+foundation12+ in \autoref{sec:localVal}) that allow a - reduction to two-valued reasoning as required for many automated - provers. The resulting logic still enjoys the rules of a strong - Kleene Logic in the spirit of the Amsterdam - Manifesto~\cite{cook.ea::amsterdam:2002}. -\item the complicated life resulting from the two necessary - equalities: the standard's ``strict weak referential equality'' as - default (written \inlineisar+_ \<doteq> _+ throughout this document) and - the strong equality (written \inlineisar+_ \<triangleq> _+), which - follows the logical Leibniz principle that ``equals can be replaced - by equals.'' Which is not necessarily the case if - \inlineisar+invalid+ or objects of different states are involved. -\item a type-safe representation of objects and a clarification of the - old idea of a one-to-one correspondence between object - representations and object-id's, which became a state invariant. -\item a simple concept of state-framing via the novel operator - \inlineocl+_->oclIsModifiedOnly()+ and its consequences for strong - and weak equality. -\item a semantic view on subtyping clarifying the role of static and - dynamic type (aka \emph{apparent} and \emph{actual} type in Java - terminology), and its consequences for casts, dynamic type-tests, - and static types. -\item a semantic view on path expressions, that clarify the role of - \inlineisar+invalid+ and \inlineisar+null+ as well as the tricky - issues related to de-referentiation in pre- and post state. -\item an optional extension of the OCL semantics by \emph{infinite} - sets that provide means to represent ``the set of potential objects - or values'' to state properties over them (this will be an important - feature if OCL is intended to become a full-blown code annotation - language in the spirit of JML~\cite{levens.ea:jml:2007} for semi-automated code verification, - and has been considered desirable in the Aachen - Meeting~\cite{brucker.ea:summary-aachen:2013}). -\end{enumerate} -Moreover, we managed to make our theory in large parts executable, -which allowed us to include mechanically checked -\inlineisar+value+-statements that capture numerous corner-cases -relevant for OCL implementors. Among many minor issues, we thus -pin-pointed the behavior of \inlineocl+null+ in collections as well -as in casts and the desired \inlineocl+isKindOf+-semantics of -\inlineocl+allInstances()+. - - -\section{Lessons Learned} -While our paper and pencil arguments, given -in~\cite{brucker.ea:ocl-null:2009}, turned out to be essentially -correct, there had also been a lesson to be learned: If the logic is -not defined as a Kleene-Logic, having a structure similar to a -complete partial order (CPO), reasoning becomes complicated: several -important algebraic laws break down which makes reasoning in OCL -inherent messy and a semantically clean compilation of OCL formulae to -a two-valued presentation, that is amenable to animators like -KodKod~\cite{torlak.ea:kodkod:2007} or SMT-solvers like -Z3~\cite{moura.ea:z3:2008} completely impractical. Concretely, if the -expression \inlineocl{not(null)} is defined \inlineocl{invalid} (as was -the case in prior versions of the standard~\cite{omg:ocl:2012}), then standard -involution does not hold, \ie, \inlineocl{not(not(A))} = \inlineocl{A} -does not hold universally. Similarly, if \inlineocl{null and null} is -\inlineocl{invalid}, then not even idempotence \inlineocl{X and X} = -\inlineocl{X} holds. We strongly argue in favor of a lattice-like -organization, where \inlineocl{null} represents ``more information'' -than \inlineocl{invalid} and the logical operators are monotone with -respect to this semantical ``information ordering.'' - -A similar experience with prior paper and pencil arguments was our -investigation of the object-oriented data-models, in particular -path-expressions ~\cite{brucker.ea:path-expressions:2013}. The final -presentation is again essentially correct, but the technical details -concerning exception handling lead finally to a continuation-passing -style of the (in future generated) definitions for accessors, casts -and tests. Apparently, OCL semantics (as many other ``real'' -programming and specification languages) is meanwhile too complex to -be treated by informal arguments solely. - -Featherweight OCL makes several minor deviations from the standard and -showed how the previous constructions can be made correct and -consistent, and the DNF-normalization as well as $\delta$-closure laws -(necessary for a transition into a two-valued presentation of OCL -specifications ready for interpretation in SMT solvers -(see~\cite{brucker.ea:ocl-testing:2010} for details)) are valid in -Featherweight OCL. - -\section{Conclusion and Future Work} -Featherweight OCL concentrates on formalizing the semantics of a core -subset of OCL in general and in particular on formalizing the -consequences of a four-valued logic (\ie, OCL versions that support, -besides the truth values \inlineocl{true} and \inlineocl{false} also -the two exception values \inlineocl{invalid} and \inlineocl{null}). - -In the following, we outline the following future extensions to use -Featherweight OCL for a concrete fully fledged tool for OCL. There are -essentially five extensions necessary: -\begin{itemize} -\item development of a compiler that compiles a textual or CASE - tool representation (\eg, using XMI or the textual syntax of - the USE tool~\cite{richters:precise:2002}) of class - models into an object-oriented data type theory automatically. -\item Full support of OCL standard syntax in a front-end parser; - Such a parser could also generate the necessary casts as well as - converting standard OCL to Featherweight OCL as well as providing - ``normalizations'' such as converting multiplicities of class - attributes to into OCL class invariants. -\item a setup for translating Featherweight OCL into a two-valued - representation as described - in~\cite{brucker.ea:ocl-testing:2010}. As, in real-world scenarios, - large parts of {UML}/{OCL} specifications are defined (\eg, - from the default multiplicity \inlineocl{1} of an attributes - \inlineocl{x}, we can directly infer that for all valid states - \inlineocl{x} is neither \inlineocl{invalid} nor \inlineocl{null}), - such a translation enables both an integration of fast constraint solvers - such as Z3 as well as test-case generation scenarios as described in - \cite{brucker.ea:ocl-testing:2010}. -\item a setup in Featherweight OCL of the Nitpick - animator~\cite{blanchette.ea:nitpick:2010}. It remains to be shown - that the standard, Kodkod~\cite{torlak.ea:kodkod:2007} based - animator in Isabelle can give a similar quality of animation as the - OCLexec Tool~\cite{krieger.ea:generative:2010} -\item a code-generator setup for Featherweight OCL for Isabelle's - code generator. For example, the Isabelle code generator supports - the generation of F\#, which would allow to use {OCL} - specifications for testing arbitrary .net-based applications. -\end{itemize} -The first two extensions are sufficient to provide a formal proof -environment for OCL 2.5 similar to \holocl while the remaining -extensions are geared towards increasing the degree of proof -automation and usability as well as providing a tool-supported test -methodology for {UML}/{OCL}. - - -Our work shows that developing a machine-checked formal semantics of -recent {OCL} standards still reveals significant -inconsistencies---even though this type of research is not new. In -fact, we started our work already with the 1.x series of {OCL}. The -reasons for this ongoing consistency problems of {OCL} standard are -manifold. For example, the consequences of adding an additional -exception value to OCL 2.2 are widespread across the whole language -and many of them are also quite subtle. Here, a machine-checked formal -semantics is of great value, as one is forced to formalize all details -and subtleties. Moreover, the standardization process of the {OMG}, -in which standards (\eg, the {UML} infrastructure and the {OCL} -standard) that need to be aligned closely are developed quite -independently, are prone to ad-hoc changes that attempt to align these -standards. And, even worse, updating a standard document by voting on -the acceptance (or rejection) of isolated text changes does not help -either. Here, a tool for the editor of the standard that helps to -check the consistency of the whole standard after each and every -modifications can be of great value as well. - - -%%% Local Variables: -%%% mode: latex -%%% TeX-master: "root" - diff --git a/Citadelle/src/document/figures/AbstractSimpleChair.mp b/Citadelle/src/document/figures/AbstractSimpleChair.mp deleted file mode 100644 index 736ea3641b2ad16071f5ca4efc8258fbf3d0bc16..0000000000000000000000000000000000000000 --- a/Citadelle/src/document/figures/AbstractSimpleChair.mp +++ /dev/null @@ -1,83 +0,0 @@ -input metafun; -boolean cmykcolors; -cmykcolors := false; -input latexmp; -setupLaTeXMP( -% preamblefile="preamble" - class="scrbook" - ,options="10pt" - ,fontencoding="T1" - ,inputencoding="latin1" - ,packages=("babel[ngerman,USenglish]" - &",lmodern,hol-ocl-isar") - ,preamble=("\renewcommand\familydefault{\ttdefault}") - ,mode=normal -% ,multicolor=enable - ); -boolean metauml_defaultLaTeX; -metauml_defaultLaTeX := true; -input metauml; - -color MaroonFifty; -MaroonFifty := cmyk(0.00, 0.435, 0.34, 0.16); - - -beginfig(1) - - -%% Role Hierarchie -AbstractClass.Role("Role")()(); -Class.Hearer("Hearer")()(); -Class.Speaker("Speaker")()(); -Class.Chair("Chair")()(); -Class.CoChair("CoCair")()(); - -topToBottom(30)(Role, Hearer, Speaker); -topToBottom(30)(CoChair, Chair); -leftToRight(25)(Hearer, CoChair); -drawObjects(Role, Hearer, Speaker); -drawObjects(CoChair, Chair); - -link(inheritance)(Hearer.n -- Role.s); -link(inheritance)(Speaker.n -- Hearer.s); -link(inheritance)(CoChair.w -- Hearer.e); -link(inheritance)(Chair.n -- CoChair.s); - - -Class.Person("Person")("+name:String")(); -Class.Participant("Participant")()(); -Participant.n = Person.e + (Role.w - Person.e)/2 + (0,-30); -leftToRight(100)(Person, Role); - -topToBottom(47)(Person, Session); -Class.Session("Session")("+name:String") -( -%"+invite(p:Person):OclVoid", - "+findRole(p:Person):Role"); -drawObjects(Person, Session,Participant); - - -% AssocClass -link(association) (Person.e -- Role.w); -item(iAssoc)("person")(obj.sw = Person.e); -item(iAssoc)("0..*")(obj.nw = Person.e); -% -item(iAssoc)("role")(obj.se = Role.w); -item(iAssoc)("0..*")(obj.ne = Role.w); - -item(iAssoc)("0..*")(obj.ne = Participant.w); - -link(dashedLink)(Participant.n -- (Person.e+(Role.w-Person.e)/2)); -path p; -p = fullcircle scaled 6bp shifted (Person.e+(Role.w-Person.e)/2); -fill p withcolor white; -draw p; -%%% - -link(association) (pathManhattanX(Participant.w,(Session.n+(-10,0)))); -item(iAssoc)("session")(obj.sw = Session.n+(-10,0)); -item(iAssoc)("0..1")(obj.se = Session.n+(-10,0)); - -endfig; - -end diff --git a/Citadelle/src/document/figures/AbstractSimpleChair.pdf b/Citadelle/src/document/figures/AbstractSimpleChair.pdf deleted file mode 100644 index 005916bec09a60fc86c577daf03b391232a726b1..0000000000000000000000000000000000000000 Binary files a/Citadelle/src/document/figures/AbstractSimpleChair.pdf and /dev/null differ diff --git a/Citadelle/src/document/figures/jedit.png b/Citadelle/src/document/figures/jedit.png deleted file mode 100644 index b188889dc25efbbb16399f7404b9ecc1d6af6414..0000000000000000000000000000000000000000 Binary files a/Citadelle/src/document/figures/jedit.png and /dev/null differ diff --git a/Citadelle/src/document/figures/logo_focl.odg b/Citadelle/src/document/figures/logo_focl.odg deleted file mode 100644 index 9ea1faa224b84f5a8ca9516af7e76ff902eec7ba..0000000000000000000000000000000000000000 Binary files a/Citadelle/src/document/figures/logo_focl.odg and /dev/null differ diff --git a/Citadelle/src/document/figures/pdf.png b/Citadelle/src/document/figures/pdf.png deleted file mode 100644 index b5cc516eb4fcbc711a9051b4696fba39e9d14485..0000000000000000000000000000000000000000 Binary files a/Citadelle/src/document/figures/pdf.png and /dev/null differ diff --git a/Citadelle/src/document/figures/person.png b/Citadelle/src/document/figures/person.png deleted file mode 100644 index e4d358bf7ad35edde406f58fbce2ca6e99046066..0000000000000000000000000000000000000000 Binary files a/Citadelle/src/document/figures/person.png and /dev/null differ diff --git a/Citadelle/src/document/figures/pre-post.pdf b/Citadelle/src/document/figures/pre-post.pdf deleted file mode 100644 index bfea5d7e001e4f46426c2b0da3f96af7ab6906cd..0000000000000000000000000000000000000000 Binary files a/Citadelle/src/document/figures/pre-post.pdf and /dev/null differ diff --git a/Citadelle/src/document/fixme.sty b/Citadelle/src/document/fixme.sty deleted file mode 100644 index 71e735cc3339db08d8f9b6f3212085dc7939f5d2..0000000000000000000000000000000000000000 --- a/Citadelle/src/document/fixme.sty +++ /dev/null @@ -1,765 +0,0 @@ -%% -%% This is file `fixme.sty', -%% generated with the docstrip utility. -%% -%% The original source files were: -%% -%% fixme.dtx (with options: `header,fixme') -%% - - -%% Copyright (C) 1998-2002, 2004-2007, 2009, 2013 Didier Verna - -%% This file is part of FiXme. - -%% FiXme may be distributed and/or modified under the -%% conditions of the LaTeX Project Public License, either version 1.1 -%% of this license or (at your option) any later version. -%% The latest version of this license is in -%% http://www.latex-project.org/lppl.txt -%% and version 1.1 or later is part of all distributions of LaTeX -%% version 1999/06/01 or later. - -%% FiXme consists of the files listed in the file `README'. - -%% \CharacterTable -%% {Upper-case \A\B\C\D\E\F\G\H\I\J\K\L\M\N\O\P\Q\R\S\T\U\V\W\X\Y\Z -%% Lower-case \a\b\c\d\e\f\g\h\i\j\k\l\m\n\o\p\q\r\s\t\u\v\w\x\y\z -%% Digits \0\1\2\3\4\5\6\7\8\9 -%% Exclamation \! Double quote \" Hash (number) \# -%% Dollar \$ Percent \% Ampersand \& -%% Acute accent \' Left paren \( Right paren \) -%% Asterisk \* Plus \+ Comma \, -%% Minus \- Point \. Solidus \/ -%% Colon \: Semicolon \; Less than \< -%% Equals \= Greater than \> Question mark \? -%% Commercial at \@ Left bracket \[ Backslash \\ -%% Right bracket \] Circumflex \^ Underscore \_ -%% Grave accent \` Left brace \{ Vertical bar \| -%% Right brace \} Tilde \~} -\NeedsTeXFormat{LaTeX2e} -\ProvidesPackage{fixme}[2013/01/28 v4.2 Collaborative annotations for LaTeX2e] - -\RequirePackage{ifthen} -\RequirePackage{verbatim} -\RequirePackage{xkeyval}[2006/11/18] - -\newcommand\fixmelogo{\textsf{FiXme}} - -\newcommand\@fxpkginfo{\PackageInfo{FiXme}} -\newcommand\@fxpkgwarning{\PackageWarning{FiXme}} -\newcommand\@fxpkgerror{\PackageError{FiXme}} - -\newcommand*\@fxaddtolist[2]{% - \expandafter\ifx\csname #1\endcsname\relax% - \expandafter\def\csname #1\endcsname{#2}% - \else% - \expandafter\ifx\csname #1\endcsname\empty% - \expandafter\g@addto@macro\csname #1\endcsname{#2}% - \else% - \expandafter\g@addto@macro\csname #1\endcsname{,#2}% - \fi% - \fi} - -\newcommand\@fxkeyifundefined{\key@ifundefined[fx]} -\newcommand\@fxdefinekey{\define@key[fx]} -\newcommand*\@fxvoidkeyerror[2]{% - \@fxpkgerror{misuse of key '#1'}{% - You have given the key '#1' the argument '#2' but it takes - none.\MessageBreak - Type X to quit, fix that key and re-run LaTeX.\MessageBreak}} -\newcommand*\@fxdefinevoidkey[3]{% - \define@key[fx]{#1}{#2}[]{% - \ifthenelse{\equal{##1}{}}{% - #3}{% - \@fxvoidkeyerror{#2}{##1}}}} - -\newcommand*\@fxdefineboolkey[3][]{% - \define@boolkey[fx]{#2}{#3}[true]{#1} - \@fxdefinevoidkey{#2}{no#3}{\@nameuse{fx@#2@#3}{false}}} - -\newcommand\@fxdefinecmdkey{\define@cmdkey[fx]} - -\newcommand\@fxdefinechoicekey{\define@choicekey[fx]} - -\newcommand\@fxsetkeys{\setkeys[fx]} -%% Note: currently unused -%% \newcommand\@fxpresetkeys{\presetkeys[fx]} -\let\l@fixme\l@figure -\newcommand*\@fxdottedtocline[5]{% - \ifnum #1>\c@tocdepth \else - \vskip \z@ \@plus.2\p@ - {\leftskip #2\relax \rightskip \@tocrmarg \parfillskip -\rightskip - \parindent #2\relax\@afterindenttrue - \interlinepenalty\@M - \leavevmode - \@tempdima #3\relax - \advance\leftskip \@tempdima \null\nobreak\hskip -\leftskip - {#4}\nobreak - \leaders\hbox{$\m@th - \mkern \@dotsep mu\hbox{.}\mkern \@dotsep - mu$}\hfill - \nobreak - #5\par}% - \fi} -\newcommand*\fxcontentsline[2]{% - \begingroup% - \let\@dottedtocline\@fxdottedtocline% - \l@fixme{#1}{#2}% - \endgroup} - -\newcommand*\fxaddcontentsline[1]{% - \ifthenelse{\equal{\cmdfx@note@target}{thepage}}{% - \addcontentsline{lox}{fixme}{#1}}{% - \addtocontents{lox}{\protect\fxcontentsline{#1}{\cmdfx@note@target}}}} - -\newcommand\@lox@prtc@article{% - \section*{\@fxlistfixmename% - \@mkboth{\MakeUppercase\@fxlistfixmename}{\MakeUppercase\@fxlistfixmename}}} -\let\@lox@psttc@article\relax - -\newcommand\@lox@prtc@report{% - \if@twocolumn - \@restonecoltrue\onecolumn - \else - \@restonecolfalse - \fi - \chapter*{\@fxlistfixmename% - \@mkboth{\MakeUppercase\@fxlistfixmename}{\MakeUppercase\@fxlistfixmename}}} -\newcommand\@lox@psttc@report{\if@restonecol\twocolumn\fi} - -\newcommand\@lox@prtc@book{% - \if@twocolumn - \@restonecoltrue\onecolumn - \else - \@restonecolfalse - \fi - \chapter*{\@fxlistfixmename% - \@mkboth{\MakeUppercase\@fxlistfixmename}{\MakeUppercase\@fxlistfixmename}}} -\newcommand\@lox@psttc@book{\if@restonecol\twocolumn\fi} - -\newcommand\lox@heading{\float@listhead{\@fxlistfixmename}} - -\newcommand\@lox@prtc@scrartcl{% - \begingroup% - \lox@heading% - \setparsizes{0}{0}{\z@\@plus 1fil}\par@updaterelative} -\let\@lox@psttc@scrartcl\endgroup - -\newcommand\@lox@prtc@scrreprt{% - \begingroup% - \if@twocolumn - \@restonecoltrue\onecolumn - \else - \@restonecolfalse - \fi - \lox@heading% - \setparsizes{0}{0}{\z@\@plus 1fil}\par@updaterelative} -\newcommand\@lox@psttc@scrreprt{% - \if@restonecol\twocolumn\fi - \endgroup} - -\newcommand\@lox@prtc@scrbook{% - \begingroup% - \if@twocolumn - \@restonecoltrue\onecolumn - \else - \@restonecolfalse - \fi - \lox@heading% - \setparsizes{0}{0}{\z@\@plus 1fil}\par@updaterelative} -\newcommand\@lox@psttc@scrbook{% - \if@restonecol\twocolumn\fi - \endgroup} - -\let\lox@final\relax -\newcommand\lox@draft{% - \IfFileExists{\jobname .lox}{% - \@lox@prtc% - \@starttoc{lox}% - \@lox@psttc}{% - \@starttoc{lox}}} -\newcommand\lox@draft@ams{\@starttoc{lox}\@fxlistfixmename} - -\newcommand*\fxsetface[2]{\@fxsetkeys{face}{#1face=#2}} -\newcommand*\@fxnewface[2][]{% - \@fxdefinecmdkey{face}{#2face}{}% - \fxsetface{#2}{#1}} -\newcommand*\@fxuseface[1]{\@nameuse{cmdfx@face@#1face}} - -\@fxdefineboolkey[% - \ifthenelse{\equal{#1}{true}}{% - \fx@mode@singleuserfalse}{% - \fx@mode@singleusertrue}]{% - mode}{multiuser} -\@fxdefineboolkey[% - \ifthenelse{\equal{#1}{true}}{% - \fx@mode@multiuserfalse}{% - \fx@mode@multiusertrue}]{% - mode}{singleuser} -\@fxdefinechoicekey{mode}{mode}{multiuser,singleuser}{\@fxsetkeys{mode}{#1}} - -\let\@fxearlylayouts\empty -\let\@fxlatelayouts\empty -\newcommand*\FXProvidesLayout[1]{\ProvidesPackage{fxlayout#1}} -\newcommand*\@fxrecordlayoutmutex[2]{% - \edef\@fxlts{\zap@space#2 \@empty}% - \def\@fxexpr{\@fxaddtolist{@fxlayout@#1@mutex}}% - \expandafter\@fxexpr\expandafter{\@fxlts}% - \@for\@fxlt:=\@fxlts\do{\@fxaddtolist{@fxlayout@\@fxlt @mutex}{#1}}} -\newcommand*\@fxhandlelayoutmutex[1]{% - \ifthenelse{\boolean{fx@layout@#1}}{% - \def\@fxexpr{\@for\@fxlt:=}% - \expandafter\@fxexpr\csname @fxlayout@#1@mutex\endcsname\do{% - \@ifundefined{iffx@layout@\@fxlt}{}{% - \ifthenelse{\boolean{fx@layout@\@fxlt}}{% - \@fxpkgwarning{% - #1 layout requested;\MessageBreak - turning \@fxlt\space layout off}% - \@nameuse{fx@layout@\@fxlt}{false}}{}}}}{}} - -\def\@FXRegisterLayout#1[#2]#3#4{% - \@fxkeyifundefined{layout}{#3}{% - \@fxrecordlayoutmutex{#3}{#2}% - \@fxdefineboolkey[\@fxhandlelayoutmutex{#3}]{layout}{#3}% - \expandafter\def\csname @fxlayout@#3\endcsname{#4}% - \@fxaddtolist{@fx#1layouts}{#3}}{% - \@fxpkgerror{layout '#3' already registered}{% - You have called \string\FXRegisterLayout\space with a name already - in use.\MessageBreak - If you want to modify an existing layout, renew its - command.\MessageBreak - Otherwise, you must choose a different name.}}} -\newcommand\FXRegisterLayout{% - \@ifstar{% - \@ifnextchar[%] - {\@FXRegisterLayout{early}}{\@FXRegisterLayout{early}[]}}{% - \@ifnextchar[%] - {\@FXRegisterLayout{late}}{\@FXRegisterLayout{late}[]}}} - -\@fxnewface{margin} -\newcommand*\FXLayoutMargin[3]{% - \marginpar[% - \raggedleft\@fxuseface{margin}\ignorespaces#3 \fxnotename{#1}: #2]{% - \raggedright\@fxuseface{margin}\ignorespaces#3 \fxnotename{#1}: #2}} -\FXRegisterLayout*{margin}{\FXLayoutMargin} -\newcommand*\FXLayoutMarginClue[3]{% - \marginpar[% - \raggedleft\@fxuseface{margin}\ignorespaces#3 \fxnotename{#1}!]{% - \raggedright\@fxuseface{margin}\ignorespaces#3 \fxnotename{#1}!}} -\FXRegisterLayout*[margin]{marginclue}{\FXLayoutMarginClue} -\newcommand*\FXLayoutFootnote[3]{% - \footnote{\ignorespaces#3 \fxnotename{#1}: #2}} -\FXRegisterLayout{footnote}{\FXLayoutFootnote} -\@fxnewface{inline} -\newcommand*\FXLayoutInline[3]{% - {\@fxuseface{inline}\ignorespaces#3 \fxnotename{#1}: #2}} -\FXRegisterLayout{inline}{\FXLayoutInline} -\newcommand\fixmeindexname{\fixmelogo} -\def\@wrindex#1{% - \ifthenelse{\equal{\cmdfx@note@target}{thepage}}{% - \protected@write\@indexfile{}{\string\indexentry{#1}{\thepage}}}{% - \protected@write\@indexfile{}{\string\indexentry{#1}{\cmdfx@note@target}}}% - \endgroup - \@esphack} -\newcommand\@fxnotekey{***a} -\newcommand\@fxwarningkey{***b} -\newcommand\@fxerrorkey{***c} -\newcommand\@fxfatalkey{***d} -\newcommand*\FXLayoutIndex[3]{% - \iffx@mode@multiuser% - \index{***@\fixmeindexname:% - !\@nameuse{@fx#1key}@\fxnotesname{#1}:% - !\@nameuse{thefx#1count}: #3: #2}% - \index{***#3@\fixmeindexname{} (#3):% - !\@nameuse{@fx#1key}@\fxnotesname{#1}:% - !\@nameuse{thefx#1count}: #2}% - \else% - \index{***@\fixmeindexname:% - !\@nameuse{@fx#1key}@\fxnotesname{#1}:% - !\@nameuse{thefx#1count}: #2}% - \fi} -\FXRegisterLayout{index}{\FXLayoutIndex} -\newcommand*\FXLayoutContentsLine[3]{% - \iffx@mode@multiuser% - \fxaddcontentsline{\ignorespaces#3 \fxnotename{#1}: #2}% - \else% - \fxaddcontentsline{\fxnotename{#1}: #2}% - \fi} - -\newcommand*\fxloadlayouts[1]{% - \edef\@fxlts{\zap@space#1 \@empty}% - \@for\@fxlt:=\@fxlts\do{\usepackage{fxlayout#1}}} - -\newcommand\@fxsetlayoutkeys{\@fxsetkeys{layout}} -\def\@fxparselayout#1#2#3\relax{\def\@fxltprefix{#1#2}\def\@fxltrest{#3}} -\newcommand*\fxuselayouts[1]{% - \edef\@fxlts{\zap@space#1 \@empty}% - \@for\@fxlt:=\@fxlts\do{% - \expandafter\@fxparselayout\@fxlt\relax% - \ifthenelse{\equal{\@fxltprefix}{no}}{% - \let\@fxltname\@fxltrest}{% - \let\@fxltname\@fxlt}% - \@fxkeyifundefined{layout}{\@fxltname}{\fxloadlayouts{\@fxltname}}{}}% - \@fxsetkeys{layout}{#1}} -\let\FXRequireLayouts\fxuselayouts - -\@fxdefinecmdkey{layout}{innerlayout}{} -\@fxdefinekey{layout}{morelayout}{\fxuselayouts{#1}} -\@fxdefinekey{layout}{layout}{% - \edef\@fxlayouts{\@fxearlylayouts,\@fxlatelayouts}% - \@for\@fxlt:=\@fxlayouts\do{% - \@nameuse{fx@layout@\@fxlt}{false}}% - \fxuselayouts{#1}} - -\newcommand*\FXProvidesEnvLayout[1]{\ProvidesPackage{fxenvlayout#1}} -\newcommand*\FXRegisterEnvLayout[3]{% - \@ifundefined{@fxenvlayout@#1@begin}{% - \expandafter\def\csname @fxenvlayout@#1@begin\endcsname{#2}% - \expandafter\def\csname @fxenvlayout@#1@end\endcsname{#3}}{% - \@fxpkgerror{environment layout '#2' already registered}{% - You have called \string\FXRegisterEnvLayout\space with a name already in - use.\MessageBreak - If you want to modify an existing environment layout, renew its - commands.\MessageBreak - Otherwise, you must choose a different name.}}} - -\@fxnewface{env} -\newcommand*\FXEnvLayoutPlainBegin[2]{% - \@fxuseface{env}\ignorespaces#2 \fxnotename{#1}: \ignorespaces} -\newcommand*\FXEnvLayoutPlainEnd[2]{} -\FXRegisterEnvLayout{plain}{\FXEnvLayoutPlainBegin}{\FXEnvLayoutPlainEnd} - -\@fxnewface[\itshape]{signature} -\newcommand*\@fxdosig[1]{% - \ifthenelse{\equal{#1}{}}{\def\@fxsignature{}}{% - \def\@fxsignature{ -- {\@fxuseface{signature}#1}}}} -\newcommand*\FXEnvLayoutSignatureBegin[2]{% - \@fxuseface{env}\fxnotename{#1}: \ignorespaces} -\newcommand*\FXEnvLayoutSignatureEnd[2]{\@fxdosig{#2}\@fxsignature} -\FXRegisterEnvLayout{signature}{% - \FXEnvLayoutSignatureBegin}{\FXEnvLayoutSignatureEnd} - -\newcommand*\@fxselectenvlayout[1]{% - \expandafter\let\expandafter\@fxenvlayout@begin% - \csname @fxenvlayout@#1@begin\endcsname% - \expandafter\let\expandafter\@fxenvlayout@end% - \csname @fxenvlayout@#1@end\endcsname} - -\newcommand*\fxloadenvlayouts[1]{% - \edef\@fxlts{\zap@space#1 \@empty}% - \@for\@fxlt:=\@fxlts\do{\usepackage{fxenvlayout#1}}} - -\newcommand*\fxuseenvlayout[1]{% - \@ifundefined{@fxenvlayout@#1@begin}{\fxloadenvlayouts{#1}}{}% - \@fxselectenvlayout{#1}} -\let\FXRequireEnvLayout\fxuseenvlayout -\@fxdefinekey{envlayout}{envlayout}{\fxuseenvlayout{#1}} - -\newcommand*\FXProvidesTargetLayout[1]{\ProvidesPackage{fxtargetlayout#1}} -\newcommand*\FXRegisterTargetLayout[2]{% - \@ifundefined{@fxtargetlayout@#1}{% - \expandafter\def\csname @fxtargetlayout@#1\endcsname{#2}}{% - \@fxpkgerror{target layout '#1' already registered}{% - You have called \string\FXRegisterTargetLayout\space with a name - already in use.\MessageBreak - If you want to modify an existing target layout, renew its - command.\MessageBreak - Otherwise, you must choose another name.}}} - -\@fxnewface{target} -\newcommand\FXTargetLayoutPlain[2]{\@fxuseface{target}#2} -\FXRegisterTargetLayout{plain}{\FXTargetLayoutPlain} - -\newcommand*\@fxselecttargetlayout[1]{% - \expandafter\let\expandafter\@@fxtargetlayout% - \csname @fxtargetlayout@#1\endcsname} - -\newcommand*\fxloadtargetlayouts[1]{% - \edef\@fxlts{\zap@space#1 \@empty}% - \@for\@fxlt:=\@fxlts\do{\usepackage{fxtargetlayout#1}}} - -\newcommand*\fxusetargetlayout[1]{% - \@ifundefined{@fxtargetlayout@#1}{\fxloadtargetlayouts{#1}}{}% - \@fxselecttargetlayout{#1}} -\let\FXRequireTargetLayout\fxusetargetlayout -\@fxdefinekey{targetlayout}{targetlayout}{\fxusetargetlayout{#1}} - -\newcommand\@fxtargetlayout@final[2]{#2} -\newcommand\@fxtargetlayout@draft[2]{% - \begingroup\@@fxtargetlayout{#1}{#2}\endgroup} - -\newcommand*\FXLogNote[1]{% - \GenericInfo{% - (FiXme)\@spaces\@spaces\@spaces\@spaces}{% - FiXme Note: '#1'}} -\newcommand*\FXLogWarning[1]{% - \GenericWarning{% - (FiXme)\@spaces\@spaces\@spaces\@spaces}{% - FiXme Warning: '#1'}} -\newcommand*\FXLogError[1]{% - \GenericWarning{% - (FiXme)\@spaces\@spaces\@spaces\@spaces}{% - FiXme Error: '#1'}} -\newcommand*\FXLogFatal[1]{% - \GenericWarning{% - (FiXme)\@spaces\@spaces\@spaces\@spaces}{% - FiXme Fatal Error: '#1'}} - -\def\@fxlog@note{\FXLogNote} -\def\@fxlog@warning{\FXLogWarning} -\def\@fxlog@error{\FXLogError} -\def\@fxlog@fatal{\FXLogFatal} - -\@fxdefineboolkey{log}{silent} - -\newcounter{fixmecount} -\newcounter{fxnotecount} -\newcounter{fxwarningcount} -\newcounter{fxerrorcount} -\newcounter{fxfatalcount} - -\@fxdefinecmdkey{note}{author}{} -\@fxdefinecmdkey{note}{target}{} -\newcommand\@fxhandleinnermode{% - \ifinner% - \ifthenelse{\boolean{fx@layout@margin}}{% - \@fxpkginfo{% - inner mode detected;\MessageBreak - turning margin layout form off}}{% - \ifthenelse{\boolean{fx@layout@marginclue}}{% - \@fxpkginfo{% - inner mode detected;\MessageBreak - turning marginclue layout form off}}{}}% - \expandafter\@fxsetlayoutkeys\expandafter{% - \cmdfx@layout@innerlayout,nomargin,nomarginclue}% - \fi} -\newcommand*\@fxissueearlydraftlayouts[2]{% - \@fxhandleinnermode% - \@for\@fxlt:=\@fxearlylayouts\do{% - \@nameuse{iffx@layout@\@fxlt}% - \@nameuse{@fxlayout@\@fxlt}{#1}{#2}{\cmdfx@note@author}% - \fi}} -\newcommand*\@fxissuelatedraftlayouts[2]{% - \@for\@fxlt:=\@fxlatelayouts\do{% - \@nameuse{iffx@layout@\@fxlt}% - \@nameuse{@fxlayout@\@fxlt}{#1}{#2}{\cmdfx@note@author}% - \fi}} -\newcommand*\@fxissuecommonlayouts[2]{% - \FXLayoutContentsLine{#1}{#2}{\cmdfx@note@author}% - \iffx@log@silent\else\@nameuse{@fxlog@#1}{#2}\fi} - -\newcommand*\@@@fxnote@early@final[2]{% - \ifthenelse{\equal{#1}{fatal}}{% - \@fxpkgerror{'#2' fatal error left in final version}{% - You are currently processing in final mode,\MessageBreak - but you still have some FiXme fatal errors left behind.\MessageBreak - Type X to quit, fix your document (or switch back to draft - mode),\MessageBreak - and rerun LaTeX.}}{}} -\newcommand*\@@@fxnote@late@final[2]{\@fxissuecommonlayouts{#1}{#2}} -\newcommand*\@@@fxnote@early@draft[2]{% - \@fxissueearlydraftlayouts{#1}{#2}} -\newcommand*\@@@fxnote@late@draft[2]{% - \@fxissuelatedraftlayouts{#1}{#2}% - \@fxissuecommonlayouts{#1}{#2}} - -\newcommand*\@fxpostconfigure{% - \ifthenelse{\equal{\cmdfx@note@author}{fixme}}{% - \@fxsetkeys{note}{author=\fixmelogo}}{}% - \iffx@lang@langtrack% - \@fxkeyifundefined{lang}{\languagename}{% - \@fxpkgwarning{unknown language '\languagename';\MessageBreak - falling back to \@fxdefaultlang}% - \@fxsetkeys{lang}{\@fxdefaultlang}}{% - \@fxsetkeys{lang}{\languagename}} - \fi} - -\let\@fxendgroup\endgroup -\def\@@fxnote@early#1#2{% - \@fxpostconfigure% - \stepcounter{fixmecount}% - \stepcounter{fx#1count}% - \@@@fxnote@early{#1}{#2}} -\def\@@fxnote@late#1#2{% - \@@@fxnote@late{#1}{#2}% - \@fxendgroup} -\def\@@fxnote#1#2{% - \@@fxnote@early{#1}{#2}% - \@@fxnote@late{#1}{#2}} -\def\@fxnote#1[#2]#3{% - \@fxsetkeys{mode,status,lang,log,note,face,layout}{#2}% - \@@fxnote{#1}{#3}} - -\long\def\@@fxsnote#1#2#3{% - \@fxpostconfigure\let\@fxpostconfigure\relax% - \@@fxnote@early{#1}{#2}\@fxtargetlayout{#1}{#3}\@@fxnote@late{#1}{#2}} -\long\def\@fxsnote#1[#2]#3#4{% - \@fxsetkeys{mode,status,lang,log,note,face,layout,targetlayout}{#2}% - \@@fxsnote{#1}{#3}{#4}} - -\newcommand*\@fxpreconfigure[1]{% - \ifthenelse{\equal{#1}{fixme}}{}{\@fxsetkeys{note}{author=#1}}} -\newcommand*\@fxnewnotemacro[3]{% - \expandafter\DeclareRobustCommand\csname #1#2\endcsname{% - \begingroup% - \@fxpreconfigure{#3}% - \@ifstar{% - \@ifnextchar[%] - {\@fxsnote{#2}}{\@@fxsnote{#2}}}{% - \@ifnextchar[%] - {\@fxnote{#2}}{\@@fxnote{#2}}}}} -\def\@@@@fxbeginenv@final#1{\comment} -\def\@@@@fxbeginenv@draft#1{\@fxenvlayout@begin{#1}{\cmdfx@note@author}} -\def\@fxendenv@final#1{\endcomment} -\def\@fxendenv@draft#1{\@fxenvlayout@end{#1}{\cmdfx@note@author}} - -\def\@@@fxbeginenv#1#2{% - \@fxpostconfigure\let\@fxpostconfigure\relax% - \@@fxnote{#1}{#2}% - \@@@@fxbeginenv{#1}} -\def\@@fxbeginenv#1#2{% - \@fxsetkeys{layout}{noinline}% - \@@@fxbeginenv{#1}{#2}} -\def\@fxbeginenv#1[#2]#3{% - \@fxsetkeys{mode,status,lang,log,note,face,layout,envlayout}{#2,noinline}% - \@@@fxbeginenv{#1}{#3}} - -\long\def\@@@fxbeginsenv#1#2#3{% - \@fxpostconfigure\let\@fxpostconfigure\relax% - \@@fxsnote{#1}{#2}{#3}% - \@@@@fxbeginenv{#1}} -\long\def\@@fxbeginsenv#1#2#3{% - \@fxsetkeys{layout}{noinline}% - \@@@fxbeginsenv{#1}{#2}{#3}} -\long\def\@fxbeginsenv#1[#2]#3#4{% - \@fxsetkeys{mode,status,lang,log,note,face,layout,envlayout,targetlayout}{% - #2,noinline}% - \@@@fxbeginsenv{#1}{#3}{#4}} - -\newcommand*\@fxnewnoteenvs[3]{% - \expandafter\def\csname #1#2\endcsname{% - \begingroup% - \let\@fxendgroup\relax% - \@fxpreconfigure{#3}% - \@ifnextchar[%] - {\@fxbeginenv{#2}}{\@@fxbeginenv{#2}}} - \expandafter\def\csname end#1#2\endcsname{% - \@fxendenv{#2}% - \endgroup}% - \expandafter\long\expandafter\def\csname #1#2*\endcsname{% - \begingroup% - \let\@fxendgroup\relax% - \@fxpreconfigure{#3}% - \@ifnextchar[%] - {\@fxbeginsenv{#2}}{\@@fxbeginsenv{#2}}} - \expandafter\def\csname end#1#2*\endcsname{% - \@fxendenv{#2}% - \endgroup}} - -\newcommand*\FXRegisterAuthor[3]{% - \@ifundefined{#1note}{}{% - \@fxpkgerror{command prefix '#1' already in use}{% - You have called \string\FXRegisterAuthor\space with a command prefix - already in use.\MessageBreak - Please choose another one.}}% - \@ifundefined{#2note}{}{% - \@fxpkgerror{environment prefix '#2' already in use}{% - You have called \string\FXRegisterAuthor\space with an environment - prefix already in use.\MessageBreak - Please choose another one.}}% - \@fxnewnotemacro{#1}{note}{#3}% - \@fxnewnotemacro{#1}{warning}{#3}% - \@fxnewnotemacro{#1}{error}{#3}% - \@fxnewnotemacro{#1}{fatal}{#3}% - \@fxnewnoteenvs{#2}{note}{#3}% - \@fxnewnoteenvs{#2}{warning}{#3}% - \@fxnewnoteenvs{#2}{error}{#3}% - \@fxnewnoteenvs{#2}{fatal}{#3}} - -\FXRegisterAuthor{fx}{anfx}{fixme} -\DeclareRobustCommand\fixme{% - \@fxpkgwarning{\string\fixme\space is deprecated;\MessageBreak - please use \string\fxfatal\space instead}% - \fxfatal} -\def\afixme{% - \@fxpkgwarning{The 'afixme' environment is deprecated;\MessageBreak - please use 'anfxfatal' instead}% - \anfxfatal} -\let\endafixme\endanfxfatal -\newcommand*\@fxlanguages{% - english,french,francais,spanish,italian,german,ngerman,danish,croatian} - -\newcommand\fxenglishnotename{Note} -\newcommand\fxenglishnotesname{Notes} -\newcommand\fxenglishwarningname{Warning} -\newcommand\fxenglishwarningsname{Warnings} -\newcommand\fxenglisherrorname{Error} -\newcommand\fxenglisherrorsname{Errors} -\newcommand\fxenglishfatalname{Fatal} -\newcommand\fxenglishfatalsname{Fatal errors} -\newcommand\englishlistfixmename{List of Corrections} - -\newcommand\fxfrenchnotename{Note} -\newcommand\fxfrenchnotesname{Notes} -\newcommand\fxfrenchwarningname{Attention} -\newcommand\fxfrenchwarningsname{Avertissements} -\newcommand\fxfrencherrorname{Erreur} -\newcommand\fxfrencherrorsname{Erreurs} -\newcommand\fxfrenchfatalname{Fatal} -\newcommand\fxfrenchfatalsname{Erreurs fatales} -\newcommand\frenchlistfixmename{Liste des Corrections} - -\newcommand\fxspanishnotename{Nota} -\newcommand\fxspanishnotesname{Notas} -\newcommand\fxspanishwarningname{Aviso} -\newcommand\fxspanishwarningsname{Avisos} -\newcommand\fxspanisherrorname{Error} -\newcommand\fxspanisherrorsname{Errores} -\newcommand\fxspanishfatalname{Fatal} -\newcommand\fxspanishfatalsname{Errores fatales} -\newcommand\spanishlistfixmename{Lista de Correcciones} - -\newcommand\fxitaliannotename{Nota} -\newcommand\fxitaliannotesname{Note} -\newcommand\fxitalianwarningname{Avviso} -\newcommand\fxitalianwarningsname{Avvisi} -\newcommand\fxitalianerrorname{Errore} -\newcommand\fxitalianerrorsname{Errori} -\newcommand\fxitalianfatalname{Fatale} -\newcommand\fxitalianfatalsname{Errori fatali} -\newcommand\italianlistfixmename{Corrigenda} - -\newcommand\fxgermannotename{Anm} -\newcommand\fxgermannotesname{Anmerkungen} -\newcommand\fxgermanwarningname{Warnung} -\newcommand\fxgermanwarningsname{Warnungen} -\newcommand\fxgermanerrorname{Fehler} -\newcommand\fxgermanerrorsname{Fehler} -\newcommand\fxgermanfatalname{Verh\"angnisvoll} -\newcommand\fxgermanfatalsname{Verh\"angnisvolle fehler} -\newcommand\germanlistfixmename{Verzeichnis der Korrekturen} - -\newcommand\fxdanishnotename{Note} -\newcommand\fxdanishnotesname{Noter} -\newcommand\fxdanishwarningname{Advarsel} -\newcommand\fxdanishwarningsname{Advarsler} -\newcommand\fxdanisherrorname{Fejl} -\newcommand\fxdanisherrorsname{Fejl} -\newcommand\fxdanishfatalname{Fatal} -\newcommand\fxdanishfatalsname{Fatale fejl} -\newcommand\danishlistfixmename{Rettelser} - -\newcommand\fxcroatiannotename{Poruka} -\newcommand\fxcroatiannotesname{Poruke} -\newcommand\fxcroatianwarningname{Upozorenja} -\newcommand\fxcroatianwarningsname{Upozorenje} -\newcommand\fxcroatianerrorname{Gre\v ska} -\newcommand\fxcroatianerrorsname{Greske} -\newcommand\fxcroatianfatalname{Fatalan} -\newcommand\fxcroatianfatalsname{Kobne gre\v ske} -\newcommand\croatianlistfixmename{Popis korekcija} - -\@fxdefineboolkey{lang}{langtrack} -\def\@fxexpr{\@fxdefinechoicekey{lang}{defaultlang}[\@fxdefaultlang]} -\expandafter\@fxexpr\expandafter{\@fxlanguages}{} - -\def\@fxexpr{\@fxdefinechoicekey{lang}{lang}[\@fxlang]} -\expandafter\@fxexpr\expandafter{\@fxlanguages}{% - \ifthenelse{\equal{#1}{francais}}{\def\@fxlang{french}}{% - \ifthenelse{\equal{#1}{ngerman}}{\def\@fxlang{german}}{}}% - \@fxsetkeys{lang}{langtrack=false}} - -\@for\@fxlg:=\@fxlanguages\do{ - \def\@fxexprone{\@fxdefinevoidkey{lang}} - \edef\@fxexprtwo{{\@fxlg}{\noexpand\@fxsetkeys{lang}{lang=\@fxlg}}} - \expandafter\@fxexprone\@fxexprtwo} - -\newcommand*\@fxlistfixmename{\@nameuse{\@fxlang listfixmename}} -\newcommand*\fxnotename[1]{\@nameuse{fx\@fxlang#1name}} -\newcommand*\fxnotesname[1]{\@nameuse{fx\@fxlang#1sname}} - -\@fxdefinevoidkey{status}{final}{% - \let\@@@fxnote@early\@@@fxnote@early@final% - \let\@@@fxnote@late\@@@fxnote@late@final% - \let\@@@@fxbeginenv\@@@@fxbeginenv@final - \let\@fxendenv\@fxendenv@final% - \let\@fxtargetlayout\@fxtargetlayout@final% - \let\listoffixmes\lox@final} -\@fxdefinevoidkey{status}{draft}{% - \let\@@@fxnote@early\@@@fxnote@early@draft% - \let\@@@fxnote@late\@@@fxnote@late@draft% - \let\@@@@fxbeginenv\@@@@fxbeginenv@draft - \let\@fxendenv\@fxendenv@draft% - \let\@fxtargetlayout\@fxtargetlayout@draft% - \let\listoffixmes\lox@draft} -\@fxdefinechoicekey{status}{status}{final,draft}{\@fxsetkeys{status}{#1}} - -\newcommand*\FXProvidesTheme[1]{\ProvidesPackage{fxtheme#1}} -\newcommand*\fxusetheme[1]{\usepackage{fxtheme#1}} -\@fxdefinekey{theme}{theme}{\fxusetheme{#1}} -\@ifclassloaded{article}{% - \let\@lox@prtc\@lox@prtc@article% - \let\@lox@psttc\@lox@psttc@article}{% - \@ifclassloaded{report}{% - \let\@lox@prtc\@lox@prtc@report% - \let\@lox@psttc\@lox@psttc@report}{% - \@ifclassloaded{book}{% - \let\@lox@prtc\@lox@prtc@book% - \let\@lox@psttc\@lox@psttc@book}{% - \@ifclassloaded{scrartcl}{% - \let\@lox@prtc\@lox@prtc@scrartcl% - \let\@lox@psttc\@lox@psttc@scrartcl}{% - \@ifclassloaded{scrreprt}{% - \let\@lox@prtc\@lox@prtc@scrreprt% - \let\@lox@psttc\@lox@psttc@scrreprt}{% - \@ifclassloaded{scrbook}{% - \let\@lox@prtc\@lox@prtc@scrbook% - \let\@lox@psttc\@lox@psttc@scrbook}{% - \@ifclassloaded{amsbook}{% - \let\lox@draft\lox@draft@ams}{% - \@ifclassloaded{amsart}{% - \let\lox@draft\lox@draft@ams}{% - %% Use the article layout by default. - \let\@lox@prtc\@lox@prtc@article% - \let\@lox@psttc\@lox@psttc@article}}}}}}}} - -\ExecuteOptionsX[fx]<% - mode,status,lang,log,note,face,layout,envlayout,targetlayout>{% - mode=singleuser,% - status=final,% - lang=english,% - langtrack=false,% - defaultlang=english,% - nosilent,% - author=fixme,% - target=thepage,% - layout=margin,% - innerlayout={layout=inline},% - envlayout=plain,% - targetlayout=plain,% - inlineface=\bfseries,% - marginface=\footnotesize,% - envface=\bfseries,% - targetface=\itshape} -\ProcessOptionsX*[fx]<% - mode,status,lang,log,note,face,layout,envlayout,targetlayout> - -\newcommand*\fxsetup[1]{% - \@fxsetkeys{% - mode,status,lang,log,note,face,layout,envlayout,targetlayout,theme}{% - #1}} - -\AtEndDocument{% - \iffx@log@silent\else - \GenericWarning{% - (FiXme)\@spaces\@spaces}{% - FiXme Summary: Number of notes: \thefxnotecount,\MessageBreak% - Number of warnings: \thefxwarningcount,\MessageBreak% - Number of errors: \thefxerrorcount,\MessageBreak% - Number of fatal errors: \thefxfatalcount,\MessageBreak% - Total: \thefixmecount\@gobble}% - \fi} -\endinput -%% -%% End of file `fixme.sty'. diff --git a/Citadelle/src/document/hol-ocl-isar.sty b/Citadelle/src/document/hol-ocl-isar.sty deleted file mode 100644 index b8ffef7fb716d5b23c426365fd0753bc851268b8..0000000000000000000000000000000000000000 --- a/Citadelle/src/document/hol-ocl-isar.sty +++ /dev/null @@ -1,1009 +0,0 @@ -\NeedsTeXFormat{LaTeX2e}\relax -\ProvidesClass{hol-ocl-isar}[2007/05/24 Achim D. Brucker ($Rev: 9004 $)] - -\RequirePackage{ifthen} -% -\newboolean{holocl@nocolor} -\setboolean{holocl@nocolor}{false} -\DeclareOption{nocolor}{\setboolean{holocl@nocolor}{true}} -% -\newboolean{isar@mnsymbol} -\setboolean{isar@mnsymbol}{false} -\DeclareOption{mnsymbol}{\setboolean{isar@mnsymbol}{true}} - -\newboolean{isar@isasymonly} -\setboolean{isar@isasymonly}{false} -\DeclareOption{isasymonly}{\setboolean{isar@isasymonly}{true}} - -\newboolean{holocl@scf} -\DeclareOption{scf}{\setboolean{holocl@scf}{true}} - - -\newboolean{holocl@nocolortable} -\DeclareOption{nocolortable}{\setboolean{holocl@nocolortable}{true}} - -\newboolean{holocl@noaclist} -\DeclareOption{noaclist}{\setboolean{holocl@noaclist}{true}} - - -\ProcessOptions\relax - - -\ifthenelse{\boolean{isar@mnsymbol}}{% -}{% - \RequirePackage{amsmath} - \RequirePackage{amssymb} - \RequirePackage{stmaryrd} - \newcommand{\lsem}{\llbracket} - \newcommand{\rsem}{\rrbracket} -} - -\usepackage{isabellesym} - -\renewcommand{\isasymrbrakk}{\isamath{\mathclose{\rsem}}} -\renewcommand{\isasymlbrakk}{\isamath{\mathopen{\lsem}}} -\newcommand{\isasymhere}{\Hut} - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% begin: old hol-ocl-ng style -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -\usepackage{xspace} -%\usepackage{euscript} -\ifthenelse{\boolean{isar@mnsymbol}}{% -}{ - \usepackage{mathrsfs} -} -%\IfFileExists{marginnote.sty}{\usepackage{marginnote}}{} -\usepackage{marginnote} -\RequirePackage[final]{listings} -%% -\newcommand{\ap}{\:} -%% -%% 1.1) Define package options -%% ========================= -%% 2) Color Definitions -%% ====================== -%%%%%%%%%%%%%%%%% -% color setup -\ifthenelse{\boolean{holocl@nocolor}}{% - \ifthenelse{\boolean{holocl@nocolortable}}{% - \usepackage[gray,hyperref,dvipsnames]{xcolor} - }{% - \usepackage[gray,hyperref,table,dvipsnames]{xcolor} - } -}{% - \ifthenelse{\boolean{holocl@nocolortable}}{% - \usepackage[hyperref,dvipsnames,fixpdftex]{xcolor} - }{% - \usepackage[hyperref,table,dvipsnames,fixpdftex]{xcolor} - } -} - -\definecolor{IsaGreen}{HTML}{009966} - -\newcommand{\nc@colorlet}[2]{ -\ifthenelse{\boolean{holocl@nocolor}}{% - \colorlet{#1}{Black} -}{% - \colorlet{#1}{#2} -}} - -% -% MathOCl expressions -\nc@colorlet{MathOclColor} {Magenta} -\newcommand{\MathOclColorName}{\textcolor{MathOclColor}{magenta}\xspace} -% -% intermediate HOL-OCL expressions, e.g., lifting -\nc@colorlet{HolOclColor} {OliveGreen} %{ForestGreen} % {OliveGreen} -\newcommand{\HolOclColorName}{\textcolor{HolOclColor}{green}\xspace} -% -\nc@colorlet{OclColor} {Magenta} -\newcommand{\OclColorName}{\textcolor{OclColor}{magenta}\xspace} -% -% Color for stuff not yet supported (mainly used in the syntax table) -\nc@colorlet{UnsupportedColor}{gray!75} -\newcommand{\UnsupportedColorName}{\textcolor{UnsupportedColor}{gray}\xspace} -% Color for extension (mainly used in the syntax table) -\nc@colorlet{ExtensionColor}{ForestGreen} -\newcommand{\ExtensionColorName}{\textcolor{ExtensionColor}{green}\xspace} -% -% OCL Keywords in \inlineocl{...} and \begin{ocl} ... \end{ocl} -\nc@colorlet{OclKeywordColor} {MidnightBlue} -\newcommand{\OclKeywordColorName}{\textcolor{OclKeywordColor}{blue}\xspace} -% -% SML Keywords in \inlinesml{...} and \begin{sml}...\end{sml} -\nc@colorlet{SmlKeywordColor} {MidnightBlue} -\newcommand{\SmlKeywordColorName}{\textcolor{SmlKeywordColor}{blue}\xspace} -% -% Java Keywords in \inlinejava{...} and \begin{java}...\end{java} -\nc@colorlet{JavaKeywordColor} {MidnightBlue} -\newcommand{\JavaKeywordColorName}{\textcolor{JavaKeywordColor}{blue}\xspace} -% -% color for sections and boldface text -\nc@colorlet{SectionColor} {MidnightBlue} -\newcommand{\SectionColorName}{\textcolor{SectionColor}{blue}\xspace} -% -% color for HOL-OCL and Isabelle theories. To be consistent with the -% generated output, this should be the same as "SectionColor" -\nc@colorlet{HolOclThyColor} {SectionColor} -\newcommand{\HolOclThyColorName}{\SectionColorName} - -\nc@colorlet{HolOclGreenColor} {IsaGreen} - -%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% 3) Defining environments and commands -%% ===================================== -%% -%% 3.1) HOL-OCL contact information -%% -------------------------------- -\newcommand{\HolOclEmail}{\href{mailto:hol-ocl@brucker.ch}{hol-ocl@brucker.ch}} -\newcommand{\HolOclWebsite}{\url{http://www.brucker.ch/research/hol-ocl/}} -\newcommand{\HolOclLogo}{} -\newcommand{\holocl}{HOL-OCL\xspace} -%% -%% 3.2) Environments for plain SML and OCL code -%% -------------------------------------------- - -\ifthenelse{\boolean{isar@mnsymbol}}{% - \newcommand{\theory}[1]{\texttt{#1}}% - \newcommand{\tactic}[1]{\texttt{#1}}% - \newcommand{\simpset}[1]{\texttt{#1}}% -}{% - \newcommand{\theory}[1]{\textsf{#1}}% - \newcommand{\tactic}[1]{\textsf{#1}}% - \newcommand{\simpset}[1]{\textsf{#1}}% -} -\newcommand{\oclfont}{\ttfamily} -\newcommand{\mathocl}{\mathtt} -\newcommand{\smlfont}{\ttfamily} -\newcommand{\javafont}{\ttfamily} -\newcommand{\holoclthyfont}{\rmfamily} - -\ifthenelse{\boolean{holocl@nocolor}}{% - \newcommand{\oclkeywordstyle}{\bfseries} - \newcommand{\javakeywordstyle}{\bfseries} - \newcommand{\smlkeywordstyle}{\bfseries} - \newcommand{\holoclthykeywordstyle}{\bfseries} - \newcommand{\greenkeywordstyle}{\bfseries} -}{% - \newcommand{\oclkeywordstyle}{\color{OclKeywordColor}\relax} - \newcommand{\javakeywordstyle}{\color{JavaKeywordColor}\relax} - \newcommand{\smlkeywordstyle}{\color{SmlKeywordColor}\relax} - \newcommand{\holoclthykeywordstyle}{\color{HolOclThyColor}\relax} - \newcommand{\greenkeywordstyle}{\color{HolOclGreenColor}\relax} -} - -\lstloadlanguages{OCL,ML,Java} -\lstdefinestyle{sml}{basicstyle=\smlfont,% - commentstyle=\itshape,% - keywordstyle=\smlkeywordstyle,% - ndkeywordstyle=\smlkeywordstyle,% - language=ML}% - -\lstdefinestyle{displaysml}{style=sml,% - floatplacement={tbp},captionpos=b,style=sml,framexleftmargin=10pt,% - numbers=left,numberstyle=\tiny,stepnumber=5,basicstyle=\small\smlfont,% - backgroundcolor=\color{black!3},frame=lines,%xleftmargin=-8pt,xrightmargin=-8pt% -} - -\lstdefinestyle{ocl}{basicstyle=\oclfont,% - commentstyle=\itshape,% - keywordstyle=\oclkeywordstyle,% - ndkeywordstyle=\oclkeywordstyle,% - morekeywords={package,endpackage,% - context,pre,inv,post,init,def,body,derive,% - measurement},% - mathescape=true, - sensitive=t,% - morecomment=[l]--,% - morestring=[d]'% - }% - -\lstdefinestyle{java}{language=Java, - basicstyle=\javafont,% - commentstyle=\itshape,% - keywordstyle=\javakeywordstyle,% - ndkeywordstyle=\javakeywordstyle,% - }% - - -\lstdefinestyle{displayjava}{style=java, - floatplacement={tbp},captionpos=b,framexleftmargin=10pt, - basicstyle=\small\javafont,backgroundcolor=\color{black!3},frame=lines}% - - -\lstdefinestyle{displayocl}{style=ocl, - %floatplacement={tbp},captionpos=b,framexleftmargin=10pt, - floatplacement={tbp},captionpos=b, - basicstyle=\small\oclfont,backgroundcolor=\color{black!3},frame=lines}% - - -\lstdefinestyle{holocl}{basicstyle=\holoclthyfont,% - commentstyle=\itshape,% - keywordstyle=\holoclthykeywordstyle,% - ndkeywordstyle=\holoclthykeywordstyle,% - language=, - mathescape=true, - classoffset=0,% - morekeywords={shows,assumes,proof,next,qed,case,po,lemma,apply,discharged,analyze_consistency,done,theory,end,imports,begin,refine,generate_po_liskov,import_model,load_xmi},% -}% - -\lstdefinestyle{displayholocl}{style=holocl, - floatplacement={tbp},captionpos=b, - basicstyle=\small\holoclthyfont,backgroundcolor=\color{black!3},frame=lines}% - - -\lstnewenvironment{ocl}[1][]{\lstset{style=displayocl,#1}}{}% -\lstnewenvironment{xuse}[1][]{\lstset{style=displayocl,morekeywords={method,class,end,begin,var,attributes,constraints},#1}}{}% -\lstnewenvironment{java}[1][]{\lstset{style=displayjava,#1}}{}% -\lstnewenvironment{sml}[1][]{\lstset{style=displaysml,#1}}{} -\lstnewenvironment{lstholocl}[1][]{\lstset{style=displayholocl,columns=fullflexible,#1}}{}% -\def\inlinejava{\lstinline[style=java,columns=fullflexible]}% -\def\inlinesml{\lstinline[style=sml,columns=fullflexible]}% -\def\inlineocl{\lstinline[style=ocl,columns=fullflexible]}% -\def\inlineholocl{\lstinline[style=holocl,columns=fullflexible]}% -%% -%% 3.3) Environments for citing ``the'' standard -%% ------------------------------------------ -% \newsavebox{\oclpage}% -% \newenvironment{oclspecification}[1]% -% {\savebox{\oclpage}{\small #1}\begin{quote}}% -% {{\small\mbox{}\\\mbox{}\hfill (Object Constraint Language -% Specification~\cite{omg:ocl:2003}, % -% page \usebox{\oclpage})}\end{quote}} - -\newsavebox{\oclpage}% -\newenvironment{oclspecification}[2][omg:ocl:2003] -{\sbox\oclpage{\emph{\small(\OCL Specification~\cite{#1}, % - page #2)}}% - % \begin{quote}} - \begin{addmargin}[2em]{0pt}% - \begin{minipage}{\linewidth}% - \vspace{.6\baselineskip} - \rule{\linewidth}{.5pt}} -{\hspace*{\fill}\nolinebreak[1]% - \quad\hspace*{\fill}% - \finalhyphendemerits=0% - \usebox{\oclpage}\\%a - \rule[.25\baselineskip]{\linewidth}{.5pt}% - \vspace{.6\baselineskip} - \end{minipage}% -\end{addmargin} -} - %\end{quote}} -%% -%% 3.4) V, Val, and VAL -%% -------------------- -\newcommand{\V}[2]{\ensuremath{V_{#1}({#2})}} -\newcommand{\Val}[2]{\ensuremath{V_{#1}({#2})}} -\newcommand{\VAL}[2]{\ensuremath{\mathit{{Val}}_{#1}({#2})}} -%% -%% 3.5) Models -%% ----------- -%\newcommand{\modelsT}{\mathop{\vDash_{\mathsf{t}}}} -%\newcommand{\modelsF}{\mathop{\vDash_{\mathsf{f}}}} -%\newcommand{\modelsU}{\mathop{\vDash_{\mathsf{u}}}} -\newcommand{\modelsT}{\mathop{\isasymMathOclValid_{\isasymMathOclTrue}}} -\newcommand{\modelsF}{\mathop{\isasymMathOclValid_{\isasymMathOclFalse}}} -\newcommand{\modelsU}{\mathop{\isasymMathOclValid_{\isasymMathOclUndefined}}} -%% -%% 3.6) Class Diagrams, Universes, etc -%% ----------------------------------- -\ifthenelse{\boolean{isar@mnsymbol}}{% - \newcommand{\universe}[1]{\ensuremath{\text{\textsw{#1}}}} % for universes - \newcommand{\domain}[1]{\ensuremath{\text{\textsw{#1}}}} % for domain -}{% - \newcommand{\universe}[1]{\ensuremath{\mathscr{#1}}} % for universes - \newcommand{\domain}[1]{\ensuremath{\mathscr{#1}}} % for domain -} -\newcommand{\cdiagram}[1]{\ensuremath{\EuScript{#1}}} % for class diagram -\newcommand{\typeset}[1]{\mathfrak{#1}} -\newcommand{\AT}{\typeset{A}} -\newcommand{\VT}{\typeset{V}} -\newcommand{\tagTypes}{\typeset{T}} -\newcommand{\Tref}{\typeset{T}_\text{ref}} -\newcommand{\Tnonref}{\typeset{T}_\text{nonref}} -\newcommand{\UTref}{\typeset{U}_\text{ref}} -\newcommand{\UTnonref}{\typeset{U}_\text{nonref}} -\newcommand{\UTx}{\typeset{U}_\text{x}} -\newcommand{\CTref}{\typeset{U}_\text{ref}} -\newcommand{\CTnonref}{\typeset{U}_\text{nonref}} -\newcommand{\CTx}{\typeset{U}_\text{x}} -%% -%% 3.6) Type Lifting -%% ----------------- -\newcommand{\tconvR}[1]{\ensuremath{\widehat{#1}}} -\newcommand{\tconvU}[1]{\ensuremath{\widetilde{#1}}} -\newcommand{\tconvE}[1]{\ensuremath{\overline{#1}}} -%% -%% 3.7) Isabelle specific stuff -%% ---------------------------- -\newcommand{\Forall}{\isasymAnd} -\newcommand{\Exists}{\isasymOr} -\ifthenelse{\boolean{isar@mnsymbol}}{% - \newcommand{\meta}[1]{\ensuremath{?\mkern-2mu#1}}% -}{% - \newcommand{\meta}[1]{\ensuremath{?\!#1}}% -} -\newcommand{\Implies}{\isasymLongrightarrow} -\renewcommand{\implies}{\isasymrightarrow} -\newcommand{\hilbert}{\isasymsome} -\newcommand{\thm}[1]{``$\mathrm{#1}$''} -%% -%% 3.8) HOL-OCL shortcuts -%% ---------------------- -%\newcommand{\up}[1]{\ensuremath{#1_{\!\bot}}} -\newcommand{\up}[1]{\ensuremath{#1_{\mkern-5mu\lower.2ex\hbox{$\bot$}}}} -\newcommand{\lift}[1]{\ensuremath{\isasymHolOclLiftLeft #1\isasymHolOclLiftRight}} -\newcommand{\drop}[1]{\ensuremath{\isasymHolOclDropLeft #1\isasymHolOclDropRight}} -\DeclareMathOperator{\liftOp}{lift} -%% -%% 3.9) semantics -%% -------------- -\newcommand{\lsemantics}{\lsem} -\newcommand{\rsemantics}{\rsem} -\newcommand{\biglsemantics}{\bigl\lsem} -\newcommand{\bigrsemantics}{\bigr\rsem} -\newcommand{\bigglsemantics}{\biggl\lsem} -\newcommand{\biggrsemantics}{\biggr\rsem} -\newcommand{\semantics}[1]{\lsem #1 \rsem} - -%% -%% 3.10) Index generation and references -%% ---------------------- -\newcommand{\emphI}[1]{\emph{#1}\index{#1}} -\newcommand{\autonameref}[1]{\autoref{#1} ``\nameref{#1}''} -\newcommand{\vautoref}[1]{\autoref{#1}\vpageref{#1}} -\newcommand{\vautonameref}[1]{\autoref{#1} ``\nameref{#1}''} -\newcommand{\definitionautrefname}{definition} -% \newcommand{\vautonameref}[1]{\autonameref{#1}\vpageref{#1}} -%% -%% 3.11) Syntax diagrams and tables -%% -------------------------------- -\newcommand{\literal}{\mathtt} -\newcommand{\unsupported}[1]{\textcolor{UnsupportedColor}{#1}} -\newcommand{\extension}[1]{\textcolor{ExtensionColor}{#1}} -%% -%% 3.12) Typographic styles for Datatypes, etc -%% ------------------------------------------- -%% 3.12.1 HOL Type Constructors -%% ---------------------------- -\newcommand{\HolBin}[0]{\ensuremath{\mathrm{bin}}} -\newcommand{\HolNum}[0]{\ensuremath{\mathrm{num}}} -\newcommand{\HolBoolean}[0]{\ensuremath{\mathrm{bool}}} -\newcommand{\HolString}[0]{\ensuremath{\mathrm{string}}} -\newcommand{\HolInteger}[0]{\ensuremath{\mathrm{int}}} -\newcommand{\HolNat}[0]{\ensuremath{\mathrm{nat}}} -\newcommand{\HolReal}[0]{\ensuremath{\mathrm{real}}} -\newcommand{\HolSet}[1]{#1\ap\ensuremath{\mathrm{set}}} -\newcommand{\HolList}[1]{#1\ap\ensuremath{\mathrm{list}}} -%\newcommand{\HolOrderedSet}[1]{#1~\ensuremath{\mathrm{orderedset}}} -\newcommand{\HolMultiset}[1]{#1\ap\ensuremath{\mathrm{multiset}}} -\newcommand{\classType}[2]{#1\ap\ensuremath{\mathrm{#2}}} - -\newcommand{\HolMkSet}[1]{\operatorname{set} #1} - - - -%% 3.12.2 Lifted HOL Type Constructors -%% ---------------------------- -\newcommand{\HolBooleanUp}[0]{\ensuremath{\up{\mathrm{bool}}}} -\newcommand{\HolStringUp}[0]{\ensuremath{up{\mathrm{string}}}} -\newcommand{\HolIntegerUp}[0]{\ensuremath{\up{\mathrm{int}}}} -\newcommand{\HolRealUp}[0]{\ensuremath{\up{\mathrm{real}}}} -\newcommand{\HolSetUp}[1]{#1\ap\ensuremath{\up{\mathrm{set}}}} -\newcommand{\HolListUp}[1]{#1\ap\ensuremath{\up{\mathrm{list}}}} -%\newcommand{\HolOrderedSetUp}[1]{#1\ap\ensuremath{\up{\mathrm{OrderedSet}}}} -\newcommand{\HolMultisetUp}[1]{#1\ap\ensuremath{\up{\mathrm{multiset}}}} -%% 3.12.3 HOL-OCL Type Constructors -%% -------------------------------- -\newcommand{\HolOclBoolean}{\ensuremath{\mathtt{Boolean}}} -\newcommand{\HolOclString}{\ensuremath{\mathtt{String}}} -\newcommand{\HolOclInteger}{\ensuremath{\mathtt{Integer}}} -\newcommand{\HolOclReal}{\ensuremath{\mathtt{Real}}} -\newcommand{\HolOclSet}[1]{#1\ap\ensuremath{\mathtt{Set}}} -\newcommand{\HolOclOclAny}[1]{#1\ap\ensuremath{\mathtt{OclAny}}} - -\newcommand{\HolOclSequence}[1]{#1\ap\ensuremath{\mathtt{Sequence}}} -\newcommand{\HolOclOrderedSet}[1]{#1\ap\ensuremath{\mathtt{OrderedSet}}} -\newcommand{\HolOclBag}[1]{#1\ap\ensuremath{\mathtt{Bag}}} - -\newcommand{\OclBoolean}[1][\tau]{\ensuremath{\mathtt{Boolean}_{#1}}} -\newcommand{\OclString}[1][\tau]{\ensuremath{\mathtt{String}_{#1}}} -\newcommand{\OclInteger}[1][\tau]{\ensuremath{\mathtt{Integer}_{#1}}} -\newcommand{\OclReal}[1][\tau]{\ensuremath{\mathtt{Real}_{#1}}} -\newcommand{\OclSet}[2][\tau]{#2\ap\ensuremath{\mathtt{Set}_{#1}}} -\newcommand{\OclSequence}[2][\tau]{#2\ap\ensuremath{\mathtt{Sequence}_{#1}}} -\newcommand{\OclOrderedSet}[2][\tau]{#2\ap\ensuremath{\mathtt{OrderedSet}_{#1}}} -\newcommand{\OclBag}[2][\tau]{#2\ap\ensuremath{\mathtt{Bag}_{#1}}} -\newcommand{\OclOclAny}[2][\tau]{#2\ap\ensuremath{\mathtt{OclAny}_{#1}}} - - -\newcommand{\HolTrue}{\mathrm{true}} -\newcommand{\HolFalse}{\mathrm{false}} -\newcommand{\HolUnit}{\mathrm{unit}} -\newcommand{\HolUndef}{\isasymbottom} -\newcommand{\HolWfrec}{\operatorname{wfrec}} -\newcommand{\OclTrue}{\isasymMathOclTrue} -\newcommand{\OclFalse}{\isasymMathOclFalse} -\newcommand{\OclUndef}{\isasymMathOclUndefined} - - -%% 3.12.x misc stuff -%% ----------------- -\newcommand{\oid}{\mathrm{oid}} -\newcommand{\ofType}{\mathbin{\isasymColon}} -\newcommand{\defeq}{\mathrel{\mathop:}=} -\DeclareMathOperator{\HolInl}{Inl} -\DeclareMathOperator{\HolNumberOf}{numberOf} -\newcommand{\self}{\mathit{self}} -\newcommand{\result}{\mathit{result}} -\newcommand{\op}{\mathit{op}} - -\newcommand{\SemCom}{\mathit{SemCom}} - -\DeclareMathOperator{\HolInr}{Inr} -\DeclareMathOperator{\HolFst}{fst} -\DeclareMathOperator{\HolSnd}{snd} -\DeclareMathOperator{\HolOptionCase}{OptionCase} -\DeclareMathOperator{\HolUpCase}{upCase} -\DeclareMathOperator{\HolSumCase}{sumCase} -\DeclareMathOperator{\HolOf}{of} -\DeclareMathOperator{\HolCase}{case} -\DeclareMathOperator{\HolIf}{if} -\DeclareMathOperator{\HolLet}{let} -\DeclareMathOperator{\HolIn}{in} -\DeclareMathOperator{\HolThen}{then} -\DeclareMathOperator{\HolElse}{else} - -\DeclareMathOperator{\HolHilbert}{\mathop{\varepsilon}} - -\DeclareMathOperator{\HolSome}{Some} -\DeclareMathOperator{\HolNone}{None} -\DeclareMathOperator{\HolArbitrary}{arbitrary} - - -\DeclareMathOperator{\HolOclStrictify}{\HolOcl{strictify}} -\DeclareMathOperator{\HolOclIsStrict}{isStrict} -\DeclareMathOperator{\HolOclCp}{\HolOcl{cp}} -\DeclareMathOperator{\HolOclDEF}{def} % DEF -\DeclareMathOperator{\HolOclSem}{Sem} -\DeclareMathOperator{\HolOclSmash}{\HolOcl{smash}} -\DeclareMathOperator{\HolOclInvoke}{\HolOcl{invoke}} -\DeclareMathOperator{\HolOclInvokeS}{\HolOcl{invokeS}} -\DeclareMathOperator{\HolOclUnion}{\HolOcl{union}} -\DeclareMathOperator{\HolOclLeast}{Least} -\DeclareMathOperator{\HolOclChoose}{\HolOcl{Choose}} -\DeclareMathOperator{\HolOclCall}{\HolOcl{Call}} - -\DeclareMathOperator{\HolOclOidOf}{\HolOcl{oid\_of}} -\DeclareMathOperator{\HolOclIsModifiedOnly}{\HolOcl{oclIsModifiedOnly}} - - -\DeclareMathOperator{\HolOclPre}{pre} -\DeclareMathOperator{\HolOclPost}{post} -\DeclareMathOperator{\HolOclTab}{OpTab} -\DeclareMathOperator{\HolDom}{dom} -\DeclareMathOperator{\HolRan}{ran} - -\newcommand{\Abs}[1]{\operatorname{\HolOcl{Abs_{#1}}}} -\newcommand{\Rep}[1]{\operatorname{\HolOcl{Rep_{#1}}}} - -\DeclareMathOperator{\HolAbsSet}{\HolOcl{Abs_{Set}}} -\DeclareMathOperator{\HolRepSet}{\HolOcl{Rep_{Set}}} - -\DeclareMathOperator{\HolAbsSequence}{\HolOcl{Abs_{Sequence}}} -\DeclareMathOperator{\HolRepSequence}{\HolOcl{Rep_{Sequence}}} - - -\DeclareMathOperator{\HolUp}{up} - -\newcommand{\HolIfThen}[3]{\HolIf #1 \HolThen #2 \HolElse #3} -\newcommand{\OclIfThen}[3]{\isasymMathOclIf #1 \isasymMathOclThen #2 \isasymMathOclElse #3 \isasymMathOclEndif} -%%%% -\newcommand{\Lam}[2]{\mathop{\lambda} #1\spot #2} -\let\llambda\lambda% -\renewcommand{\lambda}{\mathop{\llambda}} -\newcommand{\img}{\mathrel{^\backprime}} -\DeclareMathOperator{\base}{base} -\DeclareMathOperator{\HolOclBase}{\base} -\newcommand{\down}{\mathrm{down}} -\newcommand{\BT}{\typeset{B}} -\newcommand{\HolOclSt}[1]{#1\ap\ensuremath{\mathrm{St}}} - - - -%% -%% -%% -\newcommand{\OCLglitch}[2][]{% -\ifthenelse{\equal{#1}{noentry}}% -{}{% -\ifthenelse{\equal{#1}{}}% -{% -\addcontentsline{gli}{glitch}{#2}% -}{% -\addcontentsline{gli}{glitch}{#1}% -}}% -\mbox{}\marginnote[\small\slshape\raggedleft\hspace{0pt}\mbox{}% - \scalebox{.2}{\includegraphics{figures/warning}}\mbox{}\\#2]% - {\small\raggedright\slshape\hspace{0pt}\mbox{}\scalebox{.2}{\includegraphics{figures/warning}}\mbox{}\\#2}} - -\newcommand\listofglitches - {\chapter*{List of Glitches}% - \addcontentsline{toc}{chapter}{List of Glitches}\@starttoc{gli}} -\newcommand\l@glitch[2]{\par\noindent#1,~\textit{#2}\par} - -%%% -\newcommand{\OCLextension}[2][]{% -\ifthenelse{\equal{#1}{noentry}}% -{}{% -\ifthenelse{\equal{#1}{}}% -{% -\addcontentsline{ext}{extension}{#2}% -}{% -\addcontentsline{ext}{extension}{#1}% -}}% -\mbox{}\marginnote[\small\slshape\raggedleft\hspace{0pt}\mbox{}% - \scalebox{.2}{\includegraphics{figures/danger}}\mbox{}\\#2]% - {\small\slshape\raggedright\hspace{0pt}\mbox{}\scalebox{.2}{\includegraphics{figures/danger}}\mbox{}\\#2}} - -\newcommand\listofextensions - {\chapter*{List of Extensions}% - \addcontentsline{toc}{chapter}{List of Extensions}\@starttoc{ext}} -\newcommand\l@extension[2]{\par\noindent#1,~\textit{#2}\par} - - - -%% -%%% -%%% - -\newcommand{\spot}{.\;} -\newcommand{\DevelopmentSpot}{\textcolor{black!95}{\bullet}\;} -\newcommand{\template}[1]{\langle #1\rangle} -\DeclareMathOperator{\Bot}{\mathrm{bot}} -\newcommand{\bottom}{\bot} -\newcommand{\getT}{\operatorname{\mathit{getT}}} - -\newcommand{\mkType}[2][]{% - \ifthenelse{\equal{#1}{}}% - {\operatorname{mk_\text{#2}}}% - {\operatorname{mk_\text{#2}^{(#1)}}}% -} -\newcommand{\isType}[2][]{% - \ifthenelse{\equal{#1}{}}% - {\operatorname{isType_\text{#2}}}% - {\operatorname{isType_\text{#2}^{(#1)}}}% -} -\newcommand{\isKind}[2][]{% - \ifthenelse{\equal{#1}{}}% - {\operatorname{isKind_\text{#2}}}% - {\operatorname{isKind_\text{#2}^{(#1)}}}% -} -\newcommand{\isUnivType}[2][]{% - \ifthenelse{\equal{#1}{}}% - {\operatorname{isUniv_\text{#2}}}% - {\operatorname{isUniv_\text{#2}^{(#1)}}}% -} -\newcommand{\getType}[2][]{% - \ifthenelse{\equal{#1}{}}% - {\operatorname{get_\text{#2}}}% - {\operatorname{get_\text{#2}^{(#1)}}}% -} - -% \newcommand{\typeCast}[2]{\operatorname{#1\_2\_#2}} -\newcommand{\typeCast}[3][]{% - \ifthenelse{\equal{#1}{}}% - {\operatorname{#2_\text{[#3]}}}% - {\operatorname{#2_\text{[#3]}^{(#1)}}}% -} - -\newcommand{\getAttrib}[3][]{% - \ifthenelse{\equal{#1}{}}% - {#2\operatorname{\!.#3}}% - {#2\operatorname{\!.#3}^{(#1)}}% -} - -\newcommand{\getRole}[3][]{% - \ifthenelse{\equal{#1}{}}% - {#2\operatorname{\!.#3}}% - {#2\operatorname{\!.#3}^{(#1)}}% -} - -\newcommand{\setAttrib}[4][]{% - \ifthenelse{\equal{#1}{}}% - {#2\operatorname{\!.set_{#3}}\ap \mathit{#4}}% - {#2\operatorname{\!.set_{#3}^{(#1)}}\ap \mathit{#4}}% -} - -\newcommand{\newAttrib}[4][]{% - \ifthenelse{\equal{#1}{}}% - {#2\operatorname{.new_{#3}}\ap \mathit{#4}}% - {#2\operatorname{.new_{#3}^{(#1)}}\ap \mathit{#4}}% -} - - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% end: old hol-ocl-ng style -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - - - - - - - - - -\newcommand{\MathOclStyle}[1]{\color{MathOclColor}#1} -\newcommand{\HolOclStyle}[1]{\color{HolOclColor} #1} -\newcommand{\OclStyle}[1]{\upshape\ttfamily\color{OclColor} #1} - - -\newcommand{\MathOcl}[1]{{\MathOclStyle{#1}}} -\newcommand{\HolOcl}[1]{{\HolOclStyle #1}} -\newcommand{\Ocl}[1]{\text{\OclStyle{#1}}} -\newcommand{\newMathOcl}[3]{\expandafter\def\csname isasymMathOcl#1\endcsname{\ensuremath{#2{\MathOcl{#3}}}}} -\newcommand{\newOcl}[3]{\expandafter\def\csname isasymOcl#1\endcsname{\ensuremath{\operatorname{\Ocl{#3}}}}} -\newcommand{\newHolOcl}[3]{\expandafter\def\csname isasymHolOcl#1\endcsname{\ensuremath{#2{\HolOcl{#3}}}}} -\newcommand{\aarrow}{\!-\!>} -\newcommand{\oP}{\mathopen\MathOcl{\mathtt{(}}} -\newcommand{\cP}{\mathopen\MathOcl{\mathtt{)}}} -\newcommand{\OclArg}[1]{\oP #1\cP} -\newcommand{\OclSpot}{\mathopen\MathOcl{\spot}} -\newcommand{\OclMid}{\mathop\MathOcl{\mid}} -\renewcommand{\isasymbullet}{\ensuremath{\OclSpot}} - -% ; ****************************** - %; * Lifting * - %; ****************************** - - \ifthenelse{\boolean{isar@mnsymbol}}{% - \newHolOcl{LiftLeft}{\mathopen}{\llcorner} - \newHolOcl{LiftRight}{\mathclose}{\lrcorner} - \newHolOcl{DropLeft}{\mathopen}{\ulcorner} - \newHolOcl{DropRight}{\mathclose}{\urcorner} - }{ - \newHolOcl{LiftLeft}{\mathopen} - {\leavevmode\lower.6ex\hbox{$\llcorner$}\kern-.20em} - \newHolOcl{LiftRight}{\mathclose} - {\leavevmode\kern-.20em\lower.6ex\hbox{$\lrcorner$}} - \newHolOcl{DropLeft}{\mathopen} - {\leavevmode\lower-.2ex\hbox{$\ulcorner$}\kern-.18em} - \newHolOcl{DropRight}{\mathclose} - {\leavevmode\kern-.18em\lower-.2ex\hbox{$\urcorner$}} -} - % \newHolOcl{DropLeft}{\mathopen}{\ulcorner} - % \newHolOcl{DropRight}{\mathclose}{\urcorner} - %; ****************************** - %; * OclAny * - %; ****************************** - % \newcommand{\isasymMathOclAny}{} - \newOcl{IsNew}{\mathbin}{.oclIsNew()} - \newMathOcl{IsNew}{\mathbin}{\isasymOclIsNew} - \newOcl{AsType}{\mathbin}{.oclAsType} - \newMathOcl{AsType}{\mathbin}{\isasymOclAsType} - \newOcl{IsTypeOf}{\mathbin}{.oclIsTypeOf} - \newMathOcl{IsTypeOf}{\mathbin}{\isasymOclIsTypeOf} - \newOcl{IsType}{\mathbin}{.oclIsTypeOf} - \newMathOcl{IsType}{\mathbin}{\isasymOclIsType} - \newOcl{IsKindOf}{\mathbin}{.oclIsKindOf} - \newMathOcl{IsKindOf}{\mathbin}{\isasymOclIsKindOf} -% \newOcl{AllInstances}{\mathbin}{.AllInstances()} -% \newMathOcl{AllInstances}{\mathbin}{\isasymOclAllInstances} - %; ****************************** - %; * OCL Boolean * - %; ****************************** - \newMathOcl{Valid}{\mathrel}{\vDash} - \newOcl{Valid}{\mathrel}{Valid} - \newOcl{LocalValid}{\mathrel}{OclValid} - \ifthenelse{\boolean{isar@mnsymbol}}{% - \newMathOcl{True}{\mathord}{\mathocl{t}} - \newOcl{True}{\mathord}{true} - \newMathOcl{False}{\mathord}{\mathocl{f}} - \newOcl{False}{\mathord}{false} - } - {% - \newMathOcl{True}{\mathord}{\mathocl{T}} - \newOcl{True}{\mathord}{true} - \newMathOcl{False}{\mathord}{\mathocl{F}} - \newOcl{False}{\mathord}{false} - } - \newMathOcl{Not}{\mathop}{\lnot} - \newOcl{Not}{\mathop}{not\ap} - - \newMathOcl{And}{\mathbin}{\wedge} - \newOcl{And}{\mathbin}{\ap and} - \newMathOcl{Or}{\mathbin}{\vee} - \newOcl{Or}{\mathbini}{\ap or \ap} - \newMathOcl{Xor}{\mathbin}{\oplus} - \newOcl{Xor}{\mathbin}{\ap xor\ap} - - \newMathOcl{Sand}{\mathbin}{\dot{\wedge}} - \newOcl{Sand}{\mathbin}{\ap sand\ap} - \newMathOcl{Sor}{\mathbin}{\dot{\vee}} - \newOcl{Sor}{\mathbini}{\ap sor\ap} - \newMathOcl{Sxor}{\mathbin}{\dot{\oplus}} - \newOcl{Sxor}{\mathbin}{\ap sxor\ap} - - \newMathOcl{If}{\mathop}{\mathocl{if}} - \newOcl{If}{\mathopen}{if} - \newMathOcl{Then}{\mathop}{\mathocl{then}} - \newOcl{Then}{\mathbin}{then} - \newMathOcl{Else}{\mathop}{\mathocl{else}} - \newOcl{Else}{\mathbin}{else} - \newMathOcl{Endif}{\mathop}{\mathocl{endif}} - \newOcl{Endif}{\mathclose}{endif} - \newMathOcl{Let}{\mathop}{\mathocl{let}} - \newOcl{Let}{\mathopen}{let} - \newMathOcl{In}{\mathop}{\mathocl{in}} - \newOcl{In}{\mathopen}{in} - \newMathOcl{End}{\mathop}{\mathocl{end}} - \newOcl{End}{\mathopen}{end} - - \newMathOcl{Implies}{\mathbin}{\longrightarrow} - \newOcl{Implies}{\mathbin}{\ap implies\ap} - - \newMathOcl{Simplies}{\mathbin}{\dot{\longrightarrow}} - \newOcl{Simplies}{\mathbin}{\ap simplies\ap} - - \newMathOcl{VImplies}{\mathbin}{\stackrel{1}{\longrightarrow}} - \newOcl{VImplies}{\mathbin}{\ap implies1\ap} - \newMathOcl{VVImplies}{\mathbin}{\stackrel{2}{\longrightarrow}} - \newOcl{VVImplies}{\mathbin}{\ap implies2\ap} - \newMathOcl{IsDefined}{\mathop}{\partial} - \newOcl{IsDefined}{\mathop}{.IsDefined()} -\ifthenelse{\boolean{isar@mnsymbol}}{% - \newMathOcl{IsUndefined}{\mathop}{\not\partial}% -}{% - \newMathOcl{IsUndefined}{\mathop}{\not\!\partial}% -} -\newOcl{IsUndefined}{\mathop}{.oclIsUndefined()} - %; ****************************** - %; * OCL Real and Integer * - %; ****************************** - \newOcl{Less}{\mathrel}{\ensuremath{<}} - \newMathOcl{Less}{\mathrel}{\isasymOclLess} - \newOcl{Le}{\mathrel}{\ensuremath{<=}} - \newMathOcl{Le}{\mathrel}{\leq} - \newOcl{Greater}{\mathrel}{\ensuremath{>}} - \newMathOcl{Greater}{\mathrel}{\isasymOclGreater} - \newOcl{Ge}{\mathrel}{\ensuremath{>=}} - \newMathOcl{Ge}{\mathrel}{\geq} - \newOcl{Abs}{\mathbin}{.abs()} - \newMathOcl{AbsLeft}{\mathopen}{\lvert} - \newMathOcl{AbsRight}{\mathclose}{\rvert} - \newMathOcl{Min}{\mathop}{\mathrm{min}} - \newOcl{Min}{\mathrel}{.min} - \newMathOcl{Max}{\mathop}{\mathrm{max}} - \newOcl{Max}{\mathrel}{.max} - \newMathOcl{Mod}{\mathop}{\mathrm{mod}} - \newOcl{Mod}{\mathrel}{.mod} - \newMathOcl{Div}{\mathop}{\mathrm{div}} - \newOcl{Div}{\mathrel}{.div} - \newOcl{Floor}{\mathbin}{.floor()} - \newMathOcl{FloorLeft}{\mathopen}{\lfloor} - \newMathOcl{FloorRight}{\mathclose}{\rfloor} - \newOcl{Round}{\mathbin}{.round()} - \newMathOcl{RoundLeft}{\mathopen}{\lceil} - \newMathOcl{RoundRight}{\mathclose}{\rceil} - %; ****************************** - %; * OclUndefined * - %; ****************************** - \newMathOcl{Undefined}{\mathord}{\bot} - \newOcl{Undefined}{\mathord}{OclUndefined} - %; ****************************** - %; * OCL String * - %; ****************************** - \newMathOcl{Concat}{\mathbin}{^\frown} - \newOcl{Concat}{\mathbin}{.concat} - \newOcl{Substring}{\mathop}{.substring} - \newMathOcl{Substring}{\mathop}{\isasymOclSubstring} - \newOcl{ToInteger}{\mathop}{.toInteger()} - \newMathOcl{ToInteger}{\mathop}{\isasymOclToInteger} - \newOcl{ToReal}{\mathop}{.toReal()} - \newMathOcl{ToReal}{\mathop}{\isasymOclToReal} - \newOcl{ToUpper}{\mathop}{.toUpper()} - \newMathOcl{ToUpper}{\mathop}{\isasymOclToUpper} - \newOcl{ToLower}{\mathop}{.toLowert()} - \newMathOcl{ToLower}{\mathop}{\isasymOclToLower} - - %; ****************************** - %; * OCL Collection * - %; ****************************** - \newMathOcl{MtSet}{\mathord}{\emptyset} - \newOcl{MtSet}{\mathord}{\{\}} - \newMathOcl{MtSequence}{\mathord}{[]} - \newOcl{MtSequence}{\mathord}{[]} - \newMathOcl{MtBag}{\mathord}{\Lbag\Rbag} - \newOcl{MtBag}{\mathord}{Bag\{\}} - \newMathOcl{MtOrderedSet}{\mathord}{\langle\rangle} - \newOcl{MtOrderedSet}{\mathord}{OrderedSet\{\}} - \newOcl{Size}{\mathbin}{\aarrow size()} - \newMathOcl{SizeLeft}{\mathopen}{\lVert} - \newMathOcl{SizeRight}{\mathclose}{\rVert} - \newMathOcl{Includes}{\mathbin}{\in} - \newOcl{Includes}{\mathbin}{\aarrow includes} - \newMathOcl{Excludes}{\mathbin}{\not\in}%\nin} - \newOcl{Excludes}{\mathbin}{\aarrow excludes} - \newOcl{Flatten}{\mathbin}{\aarrow flatten} - \newMathOcl{FlattenLeft}{\mathbin}{\llceil} - \newMathOcl{FlattenRight}{\mathbin}{\rrceil} - \newOcl{Sum}{\mathbin}{\aarrow sum} - \newMathOcl{Sum}{\mathbin}{\isasymOclSum} - \newOcl{AsSet}{\mathop}{\aarrow asSet()} - \newMathOcl{AsSet}{\mathop}{\isasymOclAsSet} - \newOcl{AsSequence}{\mathop}{\aarrow asSequence()} - \newMathOcl{AsSequence}{\mathop}{\isasymOclAsSequence} - \newOcl{AsBag}{\mathbin}{\aarrow asBag()} - \newMathOcl{AsBag}{\mathop}{\isasymOclAsBag} - \newOcl{AsOrderedSet}{\mathbin}{\aarrow asOrderedSet()} - \newMathOcl{AsOrderedSet}{\mathbin}{\isasymOclAsOrderedSet} - \newMathOcl{ForAll}{\mathop}{\forall} - \newOcl{ForAll}{\mathbin}{\aarrow forall} - \newMathOcl{Exists}{\mathop}{\exists} - \newOcl{Exists}{\mathbin}{\aarrow exists} - \newOcl{Select}{\mathop}{\aarrow select} - \newcommand{\isasymMathOclSelectRight}{\ensuremath{\mathopen{\MathOcl{\rrparenthesis}}}} - \newcommand{\isasymMathOclSelectLeft}{\ensuremath{\mathclose{\MathOcl{\llparenthesis}}}} - \newOcl{Reject}{\mathop}{\aarrow reject} - \newcommand{\isasymMathOclRejectRight}{\ensuremath{\mathopen{\MathOcl{\llparenthesis}}}} - \newcommand{\isasymMathOclRejectLeft}{\ensuremath{\mathclose{\MathOcl{\rrparenthesis}}}} - \newOcl{Collect}{\mathbin}{\aarrow collect} - % \newMathOcl{Collect}{\mathop}{\isasymOclCollect} - \newcommand{\isasymMathOclCollectRight}{\ensuremath{\mathopen{\MathOcl{|\!\}}}}} - \newcommand{\isasymMathOclCollectLeft}{\ensuremath{\mathclose{\MathOcl{\{\!|}}}} - \newOcl{CollectNested}{\mathbin}{\aarrow collectNested} - \newcommand{\isasymMathOclCollectNestedRight}{\ensuremath{\mathopen{\MathOcl{|\!\}\!\}}}}} - \newcommand{\isasymMathOclCollectNestedLeft}{\ensuremath{\mathclose{\MathOcl{\{\!\{\!|}}}} - \newOcl{Iterate}{\mathbin}{\aarrow iterate} - \newMathOcl{Iterate}{\mathop}{\isasymOclIterate} - \newOcl{IsUnique}{\mathbin}{\aarrow isUnique} - \newMathOcl{IsUnique}{\mathbin}{\isasymOclIsUnique} - \newOcl{One}{\mathbin}{\aarrow one} - \newMathOcl{One}{\mathop}{\isasymOclOne} - \newOcl{Any}{\mathbin}{\aarrow any} - \newMathOcl{Any}{\mathop}{\isasymOclAny} - \newOcl{Count}{\mathbin}{\aarrow count} - \newMathOcl{Count}{\mathop}{\isasymOclCount} - \newOcl{IncludesAll}{\mathbin}{\aarrow includesAll} - \newMathOcl{IncludesAll}{\mathop}{\subseteq} - \newOcl{ExcludesAll}{\mathbin}{\aarrow excludesAll} - \newMathOcl{ExcludesAll}{\mathop}{\supset\kern-0.5em\subset} - \newOcl{IsEmpty}{\mathbin}{\aarrow isEmpty()} - \newMathOcl{IsEmpty}{\mathop}{\emptyset \isasymMathOclStrictEq} - \newOcl{NotEmpty}{\mathbin}{\aarrow notEmpty()} - \newMathOcl{NotEmpty}{\mathop}{\emptyset \isasymMathOclStrictNotEq} - - \newOcl{SortedBy}{\mathbin}{\aarrow sortedBy} - \newMathOcl{SortedBy}{\mathbin}{\isasymOclSortedBy} - - - \newOcl{Sum}{\mathbin}{\aarrow sum()} - \newMathOcl{Sum}{\mathop}{\isasymOclSum} - \newOcl{Product}{\mathbin}{\aarrow product} - \newMathOcl{Product}{\mathop}{\times} - - \newOcl{Including}{\mathbin}{\aarrow including} - \newMathOcl{Including}{\mathop}{\operatorname{insert}} - \newOcl{Excluding}{\mathbin}{\aarrow excluding} - \newMathOcl{Excluding}{\mathop}{\isasymOclExcluding} - \newMathOcl{SymmetricDifference}{\mathbin}{\ominus} - \newOcl{SymmetricDifference}{\mathbin}{\aarrow symmetricDiffernce} - \newMathOcl{Union}{\mathbin}{\cup} - \newOcl{Union}{\mathbin}{\aarrow union} - - \newMathOcl{Intersection}{\mathbin}{\cap} - \newOcl{Intersection}{\mathbin}{\aarrow intersection} - \newMathOcl{Complement}{\mathop}{^{-1}} - \newOcl{Complement}{\mathop}{\aarrow complement()} - - \newMathOcl{At}{\mathop}{\natural} - \newOcl{At}{\mathop}{\aarrow at} - \newMathOcl{First}{\mathop}{\natural 1} - \newOcl{First}{\mathop}{\aarrow first()} - \newMathOcl{Last}{\mathop}{\natural \$} - \newOcl{Last}{\mathop}{\aarrow last()} - - - \newOcl{IndexOf}{\mathbin}{\aarrow indexOf} - \newMathOcl{IndexOf}{\mathop}{\natural ?} - - \newOcl{InsertAt}{\mathbin}{\aarrow insertAt} - \newMathOcl{InsertAt}{\mathop}{\isasymOclInsertAt} - - \newOcl{SubOrderedSet}{\mathbin}{\aarrow subOrderedSet} - \newMathOcl{SubOrderedSet}{\mathop}{\isasymOclSubOrderedSet} - \newOcl{SubSequence}{\mathbin}{\aarrow subSequence} - \newMathOcl{SubSequence}{\mathop}{\isasymOclSubSequence} - - - - %; ****************************** - %; * OCL Set * - %; ****************************** - %; ****************************** - %; * OCL OrderedSet * - %; ****************************** - \newMathOcl{Prepend}{\mathop}{\#} - \newOcl{Prepend}{\mathop}{\aarrow prepend} - \newMathOcl{Append}{\mathop}{@} - \newOcl{Append}{\mathop}{\aarrow append} - - - %; ****************************** - %; * OCL Bag * - %; ****************************** - %; ****************************** - %; * OCL Sequence * - %; ****************************** - %; ****************************** - %; * OCL Logic * - %; ****************************** - \newOcl{StrictEq}{\mathrel}{==} - \newMathOcl{StrictEq}{\mathrel}{\doteq} - \newOcl{StrongEq}{\mathrel}{=} - \newMathOcl{StrongEq}{\mathrel}{\triangleq} - - \newOcl{StrongNotEq}{\mathrel}{\not=} - \newMathOcl{StrongNotEq}{\mathrel}{\not\triangleq} - - \newOcl{StrictNotEq}{\mathrel}{<>} - \newMathOcl{StrictNotEq}{\mathrel}{\not\doteq} - - - \newOcl{StrictValueEq}{\mathrel}{\ensuremath{\sim==}} - \newMathOcl{StrictValueEq}{\mathrel}{\dot{\simeq}} - \newOcl{StrongValueEq}{\mathrel}{\ensuremath{\sim=}} - \ifthenelse{\boolean{isar@mnsymbol}}{% - \newMathOcl{StrongValueEq}{\mathrel}{\stackrel{\smalltriangleup}{\simeq}}% - }{% - \newMathOcl{StrongValueEq}{\mathrel}{\stackrel{\vartriangle}{\simeq}}% - } - \newOcl{StrictDeepValueEq}{\mathrel}{\ensuremath{\sim==\sim}} - \newMathOcl{StrictDeepValueEq}{\mathrel}{\dot{\approxeq}} - \newOcl{StrongDeepValueEq}{\mathrel}{\ensuremath{\sim=\sim}} - \ifthenelse{\boolean{isar@mnsymbol}}{% - \newMathOcl{StrongDeepValueEq}{\mathrel}{\stackrel{\smalltriangleup}{\approxeq}}% - }{% - \newMathOcl{StrongDeepValueEq}{\mathrel}{\stackrel{\vartriangle}{\approxeq}}% - } - %\newOcl{RefEq}{\mathrel}{~=} - % \newMathOcl{RefEq}{\mathrel}{\simeq} - %; ****************************** - %; * OCL State * - %; ****************************** - % \newMathOcl{IsTypeOf}{} - % \newMathOcl{Iny/sNew}{} - % \newMathOcl{IsKind}{} - % \newMathOcl{AsType}{} - % \newMathOcl{InState}{} - % \newMathOcl{AllInstances}{} - % \newMathOcl{MethodCall}{} - % \newMathOcl{FeatureCall}{} - - \newOcl{IsModifiedOnly}{\mathbin}{\aarrow oclIsModifiedOnly()} - \newMathOcl{IsModifiedOnly}{\mathbin}{\isasymOclIsModifiedOnly} - - \newOcl{AllInstances}{\mathbin}{.allInstances()} - \newMathOcl{AllInstances}{\mathbin}{\isasymOclAllInstances} - - \newOcl{KindSetOf}{\mathbin}{::kindSetOf()} - \newMathOcl{KindSetOf}{\mathbin}{\isasymOclKindSetOf} - - \newOcl{TypeSetOf}{\mathbin}{::typeSetOf()} - \newMathOcl{TypeSetOf}{\mathbin}{\isasymOclTypeSetOf} - - \newOcl{AllInstancesATpre}{\mathbin}{.allInstances@pre()} - \newMathOcl{AllInstancesATpre}{\mathbin}{\isasymOclAllInstancesATpre} - - \newOcl{ATpre}{\mathbin}{@pre} - \newMathOcl{ATpre}{\mathbin}{\isasymOclATpre} - -%%% undefining commands that should never be used directly: -%\let\llcorner\@undefined -%%% -\newcommand{\HolOclWfrec}{\mathop\MathOcl{\operatorname{Wfrec}}} -\endinput diff --git a/Citadelle/src/document/introduction.tex b/Citadelle/src/document/introduction.tex deleted file mode 100644 index 5d017bf47974ecfe9febe661c6f4f0d9ec87a95e..0000000000000000000000000000000000000000 --- a/Citadelle/src/document/introduction.tex +++ /dev/null @@ -1,2351 +0,0 @@ -\section{Introduction} -\isatagafp% -The Unified Modeling Language -(UML)~\cite{omg:uml-infrastructure:2011,omg:uml-superstructure:2011} -is one of the few modeling languages that is widely used in -industry. \UML is defined in an open process by the Object Management -Group (OMG), \ie, an industry consortium. While \UML is mostly known -as diagrammatic modelling language (\eg, visualizing class models), it -also comprises a textual language, called Object Constraint Language -(\OCL)~\cite{omg:ocl:2012}. \OCL is a textual annotation language, -originally conceived as a three-valued logic, that turns substantial -parts of \UML into a formal language. Unfortunately the semantics of -this specification language, captured in the ``Annex A'' (originally, -based on the work of \citet{richters:precise:2002}) of the \OCL -standard leads to different interpretations of corner cases. Many of -these corner cases had been subject to formal analysis since more than -nearly fifteen years (see, -\eg,~\cite{brucker.ea:semantic:2006-b,brucker.ea:proposal:2002,mandel.ea:ocl:1999, - hamie.ea:reflections:1998,cook.ea::amsterdam:2002}). - -At its origins~\cite{richters:precise:2002,omg:ocl:1997}, \OCL was -conceived as a strict semantics for undefinedness (\eg, denoted by the -element \inlineocl{invalid}\footnote{In earlier versions of the \OCL - standard, this element was called \inlineocl{OclUndefined}.}), with -the exception of the logical connectives of type \inlineocl{Boolean} -that constitute a three-valued propositional logic. At its core, \OCL -comprises four layers: -\begin{enumerate} -\item Operators (\eg, \inlineocl{_ and _}, \inlineocl{_ + _}) on - built-in data structures such as \inlineocl{Boolean}, - \inlineocl{Integer}, or typed sets (\inlineocl{Set(_)}). -\item Operators on the user-defined data model (\eg, defined as part - of a \UML class model) such as accessors, type casts and tests. -\item Arbitrary, user-defined, side-effect-free methods called \emph{queries}, -\item Specification for invariants on states and contracts for - operations to be specified via pre- and post-conditions. -\end{enumerate} - -Motivated by the need for aligning \OCL closer with \UML, recent -versions of the \OCL standard~\cite{omg:ocl:2006,omg:ocl:2012} added a -second exception element. While the first exception element -\inlineocl{invalid} has a strict semantics, \inlineocl{null} has a non -strict semantic interpretation. Unfortunately, this extension results -in several inconsistencies and contradictions. These problems are -reflected in difficulties to define interpreters, code-generators, -specification animators or theorem provers for \OCL in a uniform manner -and resulting incompatibilities of various tools. - -For the \OCL community, the semantics of \inlineocl{invalid} and -\inlineocl{null} as well as many related issues resulted in the -challenge to define a consistent version of the \OCL standard that is -well aligned with the recent developments of the \UML\@. A syntactical -and semantical consistent standard requires a major revision of both -the informal and formal parts of the standard. To discuss the future -directions of the standard, several \OCL experts met in November 2013 -in Aachen to discuss possible mid-term improvements of \OCL, strategies -of standardization of \OCL within the OMG, and a vision for possible -long-term developments of the -language~\cite{brucker.ea:summary-aachen:2013}. During this meeting, a -Request for Proposals (RFP) for \OCL 2.5 was finalized and meanwhile -proposed. In particular, this RFP requires that the future \OCL 2.5 -standard document shall be generated from a machine-checked -source. This will ensure -\begin{itemize} -\item the absence of syntax errors, -\item the consistency of the formal semantics, -\item a suite of corner-cases relevant for \OCL tool implementors. -\end{itemize} - -In this document, we present a formalization using -Isabelle/HOL~\cite{nipkow.ea:isabelle:2002} of a core language of -\OCL\@. The semantic theory, based on a ``shallow embedding'', is -called \emph{Featherweight OCL}, since it focuses on a formal -treatment of the key-elements of the language (rather than a full -treatment of all operators and thus, a ``complete'' -implementation). In contrast to full \OCL, it comprises just the logic -captured in \verb+Boolean+, the basic data types \verb+Void+, -\verb+Integer+, \verb+Real+ and \verb+String+, the collection types -\verb+Set+, \verb+Pair+, \verb+Sequence+ and \verb+Bag+. The generic -construction principle of class models is also -supported (its detailed presentation is out of the scope of this document, an -instantiation will be provided for two examples). -The formal semantics developed in \FOCL -is intended to be a proposal for the standardization -process of \OCL 2.5, which should ultimately replace parts of the -mandatory part of the standard document~\cite{omg:ocl:2012} as well as -replace completely its informative ``Annex A.'' -\endisatagafp -%% -\isatagannexa -This annex chapter formally defines the semantics of \OCL\@. This -chapter is a, to a large extend automatically generated, summary of a -formal semantics of the core of OCL, called \FOCL\footnote{An updated, - machine-checked version and formally complete version of the - complete formalization is maintained by the Isabelle Archive of - Formal Proofs (AFP), see - \url{http://afp.sourceforge.net/entries/Featherweight_OCL.shtml}}. \FOCL -has a formal semantics in Isabelle/\HOL~\cite{nipkow.ea:isabelle:2002}. -\endisatagannexa - -The semantic definitions are in large parts executable, namely the -essence of \verb+Set+, \verb+Pair+, \verb+Sequence+ and \verb+Bag+ -constructions (as remark, \HOL is a classical logic where some parts -could be not constructively defined). The first goal of its -construction is \emph{consistency}, \ie, it should be possible to -apply logical rules and/or evaluation rules for \OCL in an arbitrary -manner always yielding the same result. Moreover, except in -pathological cases, this result should be unambiguously defined, \ie, -represent a value. - -To motivate the need for logical consistency and also the magnitude of -the problem, we focus on one particular feature of the language as -example: \inlineocl{Tuples}. Recall that tuples (in other languages -known as \emph{records}) are $n$-ary Cartesian products with named -components, where the component names are used also as projection -functions: the special case \inlineocl+Pair{x:First, y:Second}+ stands -for the usual binary pairing operator \inlineocl+Pair{true, null}+ and -the two projection functions \inlineocl+x.First()+ and -\inlineocl+x.Second()+. For a developer of a compiler or proof-tool -(based on, say, a connection to an SMT solver designed to animate \OCL -contracts) it would be natural to add the rules $\mocl{Pair\{X, - Y\}.First()} = \mocl{X}$ and $\mocl{Pair\{X, Y\}.Second()} = -\mocl{Y}$ to give pairings the usual semantics. At some place, the -\OCL Standard requires the existence of a constant symbol -\inlineocl+invalid+ and requires all operators to be strict. To -implement this, the developer might be tempted to add a generator for -corresponding strictness axioms, producing among hundreds of other -rules $\mocl{Pair\{invalid, Y\}} = \mocl{invalid}$, $\mocl{Pair\{X, - invalid\}} = \mocl{invalid}$, $\mocl{invalid.First()} = -\mocl{invalid}$, $\mocl{invalid.Second()} = \mocl{invalid}$, etc. -Unfortunately, this ``natural'' axiomatization of pairing and -projection together with strictness is already inconsistent. One can -derive: -\begin{gather*} -\begin{array}{l@{}l@{}} - \mocl{Pair\{true, invalid\}.First()} \ap & = \mocl{invalid.First()} \\ - & = \mocl{invalid} -\end{array} -\end{gather*} -and: -\begin{gather*} -\begin{array}{l@{}l@{}} - \mocl{Pair\{true, invalid\}.First()} \ap & = \mocl{true} -\end{array} -\end{gather*} -which then results in the absurd logical consequence that -$\mocl{invalid} = \mocl{true}$. Obviously, we need to be more careful -on the side-conditions of our rules.\footnote{The solution to this little - riddle can be found in \autoref{sec:collection_pairs}.} -And obviously, only a mechanized check of these definitions, following -a rigorous methodology, can establish strong guarantees for logical -consistency of the \OCL language. - -\isatagafp - This leads us to our second goal of this document: -\endisatagafp -\isatagannexa - This leads us to our second goal of this annex: -\endisatagannexa -it should not only be -usable by logicians, but also by developers of compilers and -proof-tools. For this end, we \emph{derive} from the Isabelle -framework, many definitions and \emph{logical rules} for formal -interactive and automated proofs on \UML/\OCL specifications. These -logical rules are necessary for \emph{execution rules} and -\emph{test-cases} to reveal potential corner-cases related with the -semantics the implementors are defining. - -\OCL is an annotation language for \UML models, in particular class -models allowing for specifying data and operations on them. As such, -it is a \emph{typed} object-oriented language. This means that it -is---like Java or C++---based on the concept of a \emph{static type}, -that is the type that the type-checker infers from a \UML class model -and its \OCL annotation, as well as a \emph{dynamic type}, that is the -type at which an object is dynamically created\footnote{As side-effect - free language, \OCL has no object-constructors, but with - \inlineocl+OclIsNew()+, the effect of object creation can be - expressed in a declarative way.}. Types are not only a means for -efficient compilation and a support of separation of concerns in -programming, there are of fundamental importance for our goal of -logical consistency: it is impossible to have sets that contain -themselves, \ie, to state Russell's paradox in \OCL typed set-theory. -Moreover, object-oriented typing means that types can be in sub-typing -relation; technically speaking, this means that any object $X$ can be -\emph{cast} with the operator $(\_ :: -C_i)\mocl{.oclAsType(}C_j\mocl{)}$ from one class types $C_i$ to -another class types $C_j$, and under particular conditions (to be -later described), these casts are semantically \emph{lossless}: -\begin{gather*} -(X :: C_i)\mocl{.oclAsType(}C_j\mocl{).oclAsType(}C_i\mocl{)} = X -\end{gather*} -Furthermore, object-oriented means that operations and object-types -can be grouped to \emph{classes} on which an inheritance relation can -be established; the latter induces a sub-type relation between the -corresponding types. - -Here is a feature-list of \FOCL: -\begin{itemize} - \item it specifies key built-in types such as \inlineocl+Boolean+, - \inlineocl+Void+, \inlineocl+Integer+, \inlineocl+Real+ and - \inlineocl+String+ as well as generic types such as - \inlineocl+Pair(T,T')+, \inlineocl+Sequence(T)+, \inlineocl+Bag(T)+ and \inlineocl+Set(T)+. - \item it defines the semantics of the operations of these types in - \emph{denotational form} (to be explained in \autoref{sec:focl-semantics}), - and thus in an unambiguous (and in Isabelle/\HOL executable or - animatable) way. - \item it develops the \emph{theory} of these definitions, \ie, the collection - of lemmas and theorems that can be proven from these definitions. - \item all types in \FOCL contain the elements \inlineocl{null} and \inlineocl{invalid}; - including in particular the \inlineocl+Boolean+ type, - so we obtain a four-valued logic. Consequently, \FOCL contains - the derivation of the \emph{logic} of \OCL. - \item collection types may contain - \inlineocl{null} (so \inlineocl|Set{null}| is a defined set) but not - \inlineocl{invalid} (\inlineocl|Set{invalid}| is just - \inlineocl{invalid}). - \item With respect to the static types, \FOCL is a strongly typed language in - the Hindley-Milner tradition. - So the explicit usage of casts are needed whenever for - example one attempts to apply an attribute $a$ to an object - $X :: C_i$, and where $a$ has been defined in $C_j$ (so not - in $C_i$). On the other hand, one can also assume there is a - pre-processing to automatically introduce these explicit - conversions (\ie, to remove the need to write - $\mocl{.oclAsType(}\_\mocl{)}$).\footnote{The details of such - a pre-processing are present in - \HOLOCL~\cite{brucker:interactive:2007} and can be - similarly adapted for \FOCL.} - \item \FOCL types may be arbitrarily nested. For example, - the expression - $\mocl{Set\{Set\{1,2\}\}} = \mocl{Set\{Set\{2,1\}\}}$ - is legal and true. - \item \FOCL types may be higher-order nested. For example, - the expression $\lambda X. \ap \mocl{Set\{}X\mocl{\}} = \mocl{Set\{Set\{2,1\}\}}$ is legal. - Higher-order pattern-matching can be easily extended following - the principles in the \HOL library, which can be applied also to \FOCL types. - \item All object types are represented in an object universe\footnote{following - the tradition of \HOL-\OCL~\cite{brucker.ea:extensible:2008-b}}. - The universe construction also gives semantics to type casts, dynamic type - tests, as well as functions such as \inlineocl{allInstances()}, - or \inlineocl{oclIsNew()}. The object universe construction is - conceptually described and demonstrated at an example. - \item As part of the \OCL logic, \FOCL develops the theory of - equality in \UML/\OCL. This includes the standard equality, which is a - computable strict equality using the object references for comparison, - and the not necessarily computable logical equality, which expresses - the Leibniz principle that ``equals may be replaced by equals'' in - \OCL terms. - \item Technically, \FOCL is a \emph{semantic embedding} into a - powerful semantic meta-language and - environment, namely Isabelle/\HOL~\cite{nipkow.ea:isabelle:2002}. - It is a so-called \emph{shallow embedding} in \HOL; this means that types - in \OCL are mapped one-to-one to types in Isabelle/\HOL. - Ill-typed \OCL specifications can therefore not be represented in - \FOCL and a type in \FOCL contains exactly - the values that are possible in \OCL\@. -% \item It supports equational reasoning and congruence reasoning, but -% this requires a differentiation of the different equalities like -% strict equality, strong equality, meta-equality (\HOL). Strict -% equality and strong equality require a subcalculus, ``cp'' (a -% detailed discussion of the different equalities as well as the -% subcalculus ``cp''---for three-valued \OCL 2.0---is given -% in~\cite{brucker.ea:semantics:2009}), which is nasty but can be -% hidden from the user inside tools. -\end{itemize} - -\paragraph*{Context.} This document stands in a more than fifteen years -tradition of giving a formal semantics to the core of \UML and its -annotation language \OCL, starting from \citet{richters:precise:2002} -and~\cite{hamie.ea:reflections:1998,mandel.ea:ocl:1999,cook.ea::amsterdam:2002}, -leading to a number of formal, machine-checked versions, most notably -\HOL-\OCL~\cite{brucker.ea:semantic:2006-b,brucker:interactive:2007,brucker.ea:hol-ocl-book:2006,brucker.ea:extensible:2008-b} -and more recent approaches~\cite{brucker.ea:path-expressions:2013}. All -of them have in common the attempt to reconcile the conflicting -demands of an industrially used specification language and its various -stakeholders, the needs of OMG standardization process and the desire -for sufficient logical precision for tool-implementors, in particular -from the Formal Methods research community. To discuss the future -directions of the standard, several \OCL experts met in November 2013 -in Aachen to discuss possible mid-term improvements of \OCL, -strategies of standardization of \OCL within the OMG, and a vision for -possible long-term developments of the -language~\cite{brucker.ea:summary-aachen:2013}. The participants -agreed that future proposals for a formal semantics should be -machine-check, to ensure the absence of syntax errors, the consistency -of the formal semantics, as well as provide a a suite of corner-cases -relevant for \OCL tool implementors. - -\paragraph*{Organization of this document.} -This document is organized as follows. After a brief background section -introducing a running example and basic knowledge on Isabelle/\HOL and its formal -notations, we present the formal semantics of \FOCL introducing: -\begin{enumerate} -\item A conceptual description of the formal semantics, highlighting the essentials - and avoiding the definitions in detail. -\item A detailed formal description. This covers: -\begin{enumerate} -\item \OCL Types and their presentation in Isabelle/\HOL, -\item \OCL Terms, \ie, the semantics of library operators, - together with definitions, lemmas, and test cases for the implementor, -\item \UML/\OCL Constructs, \ie, a core of \UML class models plus user-defined - constructions on them such as class-invariants and operation contracts. -\end{enumerate} -\item Since the latter, \ie, the construction of \UML class models, has to be done on the meta-level -(so not \emph{inside} \HOL, rather on the level of a pre-compiler), we will describe this process -with two larger examples, namely formalizations of our running example. -\end{enumerate} - - -%A.1 Object Models -%In this sub clause, the notion of an object model is formally defined. -%An object model provides the context for \OCL expressions and constraints. -%A precise understanding of object models is required before a formal -%definition of \OCL expressions can be given. Sub clause A.1.1 proceeds with a -%formal definition of the syntax of object models. The semantics of object -%models is defined in sub clause A.1.2. This sub clause also defines the -%notion of system states as snapshots of a running system. - -\section{Background} -\isatagafp -\subsection{A Running Example for UML/OCL}\label{sec:guidedtour} -The Unified Modelling Language -(\UML)~\cite{omg:uml-infrastructure:2011,omg:uml-superstructure:2011} -comprises a variety of model types for describing static (\eg, class -models, object models) and dynamic (\eg, state-machines, activity -graphs) system properties. -\begin{figure*} - \centering\scalebox{1}{\includegraphics{figures/AbstractSimpleChair}}% - \caption{A simple \UML class model representing a conference - system for organizing conference sessions: persons can - participate, in different roles, in a session. \label{fig:uml}} -\end{figure*} -One of the more prominent model types of the \UML is the -\emph{class model} (visualized as \emph{class diagram}) for modelling -the underlying data model of a system in an object-oriented manner. As -a running example, we model a part of a conference management -system. Such a system usually supports the conference organizing -process, \eg, creating a conference Website, reviewing submissions, -registering attendees, organizing the different sessions and tracks, -and indexing and producing the resulting proceedings. In this example, -we constrain ourselves to the process of organizing conference -sessions; \autoref{fig:uml} shows the class model. We model the -hierarchy of roles of our system as a hierarchy of classes (\eg, -\inlineocl{Hearer}, \inlineocl{Speaker}, or \inlineocl{Chair}) using -an \emph{inheritance} relation (also called \emph{generalization}). In -particular, \emph{inheritance} establishes a \emph{subtyping} -relationship, \ie, every \inlineocl{Speaker} (\emph{subclass}) is also -a \inlineocl{Hearer} (\emph{superclass}). - -A class does not only describe a set of \emph{instances} (called -\emph{objects}), \ie, record-like data consisting of \emph{attributes} -such as \inlineocl{name} of class \inlineocl{Session}, but also -\emph{operations} defined over them. For example, for the class -\inlineocl{Session}, representing a conference session, we model an -operation \inlineocl{findRole(p:Person):Role} that should return the -role of a \inlineocl{Person} in the context of a specific session; -later, we will describe the behavior of this operation in more detail -using \UML\@. In the following, the term object describes a -(run-time) instance of a class or one of its subclasses. - -Relations between classes (called \emph{associations} in \UML) -can be represented in a class diagram by connecting lines, \eg, -\inlineocl{Participant} and \inlineocl{Session} or \inlineocl{Person} -and \inlineocl{Role}. Associations may be labeled by a particular -constraint called \emph{multiplicity}, \eg, \inlineocl+0..*+ or -\inlineocl+0..1+, which means that in a relation between participants -and sessions, each \inlineocl{Participant} object is associated to at -most one \inlineocl{Session} object, while each \inlineocl{Session} -object may be associated to arbitrarily many \inlineocl{Participant} -objects. Furthermore, associations may be labeled by projection -functions like \inlineocl{person} and \inlineocl{role}; these implicit -function definitions allow for \OCL-expressions like -\inlineocl+self.person+, where \inlineocl+self+ is a variable of the -class \inlineocl{Role}. The expression \inlineocl+self.person+ denotes -persons being related to the specific object \inlineocl{self} of -type role. A particular feature of the \UML are \emph{association - classes} (\inlineocl{Participant} in our example) which represent a -concrete tuple of the relation within a system state as an object; -\ie, associations classes allow also for defining attributes and -operations for such tuples. In a class diagram, association classes -are represented by a dotted line connecting the class with the -association. Associations classes can take part in other associations. -Moreover, \UML supports also $n$-ary associations (not shown in -our example). - -We refine this data model using the Object Constraint Language (\OCL) -for specifying additional invariants, preconditions and postconditions -of operations. For example, we specify that objects of the class -\inlineocl{Person} are uniquely determined by the value of the -\inlineocl{name} attribute and that the attribute \inlineocl{name} is -not equal to the empty string (denoted by \inlineocl{''}): -\begin{ocl} -context Person - inv: name <> '' and - Person::allInstances()->isUnique(p:Person | p.name) -\end{ocl} -Moreover, we specify that every session has exactly one chair by the -following invariant (called \inlineocl{onlyOneChair}) of the class -\inlineocl{Session}: -\begin{ocl} -context Session - inv onlyOneChair: self.participants->one( p:Participant | - p.role.oclIsTypeOf(Chair)) -\end{ocl} -where \inlineocl{p.role.oclIsTypeOf(Chair)} evaluates to true, if -\inlineocl{p.role} is of \emph{dynamic type} -\inlineocl{Chair}. Besides the usual \emph{static types} (\ie, the -types inferred by a static type inference), objects in \UML and other -object-oriented languages have a second \emph{dynamic} type concept. -This is a consequence of a family of \emph{casting functions} (written -$\typeCast{o}{C}$ for an object $o$ into another class type $C$) that -allows for converting the static type of objects along the class -hierarchy. The dynamic type of an object can be understood as its -``initial static type'' and is unchanged by casts. We complete our -example by describing the behavior of the operation -\inlineocl{findRole} as follows: -\begin{ocl} -context Session::findRole(person:Person):Role - pre: self.participates.person->includes(person) - post: result=self.participants->one(p:Participant | - p.person = person ).role - and self.participants = self.participants@pre - and self.name = self.name@pre -\end{ocl} -where in post-conditions, the operator \inlineocl{@pre} allows for -accessing the previous state. Note that: -\begin{ocl} - pre: self.participates.person->includes(person) -\end{ocl} -is actually a syntactic abbreviation for a contraint referring to -the previous state: -\begin{ocl} - self.participates@pre.person@pre->includes(person). -\end{ocl} -Note, further, that conventions for full-\OCL permit the suppression -of the \inlineocl$self$-parameter, following similar syntactic conventions -in other object-oriented languages such as Java: -\begin{ocl} -context Session::findRole(person:Person):Role - pre: participates.person->includes(person) - post: result=participants->one(p:Participant | - p.person = person ).role - and participants = participants@pre - and name = name@pre -\end{ocl} - - -In \UML, classes can contain attributes of the type of the -defining class. Thus, \UML can represent (mutually) recursive -datatypes. Moreover, \OCL introduces also recursively specified -operations. - -A key idea of defining the semantics of \UML and extensions like -SecureUML~\cite{brucker.ea:transformation:2006} is to translate the -diagrammatic \UML features into a combination of more elementary -features of \UML and \OCL -expressions~\cite{gogolla.ea:expressing:2001}. For example, -associations (\ie, relations on objects) can be implemented in -specifications at the design level by aggregations, \ie, collection-valued -class attributes together with \OCL constraints expressing the -multiplicity. Thus, having a semantics for a subset of \UML and \OCL is -tantamount for the foundation of the entire method. -\endisatagafp - - - -\subsection{Formal Foundation} - -\subsubsection{A Gentle Introduction to Isabelle} -Isabelle~\cite{nipkow.ea:isabelle:2002} is a \emph{generic} theorem -prover. New object-logics can be introduced by specifying their syntax -and natural deduction inference rules. Among many logics, Isabelle -supports First-Order Logic (\FOL), Zermelo-Fraenkel set theory, and for -instance Church's Higher-Order Logic (\HOL). - -The core language of Isabelle is a typed $\lambda$-calculus providing -a uniform term language $T$ in which all logical entities are -represented:\footnote{In the Isabelle implementation, there are - actually two further variants, they are irrelevant for this - presentation and can be therefore omitted.} -\begin{gather*} - T \ap\ap \defeq \ap\ap C \ap\ap|\ap\ap V \ap\ap|\ap\ap \lambda V\spot\ap T \ap\ap|\ap\ap T~T -\end{gather*} -where: -\begin{itemize} -\item $C$ is the set of \emph{constant symbols} like operators on - pairs ``$\operatorname{fst}$'' or - ``$\operatorname{snd}$''. Isabelle's syntax engine supports mixfix - notation for terms. ``$(\_ \Longrightarrow \_)~A~B$'' or ``$(\_ + - \_)~A~B$'' can be parsed and respectively printed as ``$A - \Longrightarrow B$'' or ``$A + B$''. -\item $V$ is the set of \emph{variable symbols} like $x$, $y$, - $z$\ldots Variables standing in the scope of a $\lambda$-operator - are called \emph{bound} variables, all others are \emph{free} - variables. -\item $\lambda~V\spot \ap T$ is called a \emph{$\lambda$-abstraction}, like as - example the identity function $\lambda~x. \ap x$. A - $\lambda$-abstraction forms a scope for the variable $V$. -\item $T~T'$ is called an \emph{application}. -\end{itemize} -These concepts are not at all Isabelle specific and can be found in many modern programming -languages ranging from Haskell over Python to Java. - -Terms are associated to \emph{types} by a set of \emph{type - inference rules}\footnote{Similar to -\url{https://en.wikipedia.org/w/index.php?title=Hindley\%E2\%80\%93Milner_type_system&oldid=668548458}}. Only -terms for which a type can be inferred are considered as legal input -to the Isabelle system, such terms are \emph{typed terms}. The type -$\tau$ of typed terms can be inductively defined:\footnote{Our - presentation is again slightly different than the Isabelle - implementation to improve readability.} -\begin{gather*} -\tau \ap\ap \defeq \ap\ap TV \ap\ap|\ap\ap TV :: \Xi \ap\ap|\ap\ap \tau~\Rightarrow~\tau \ap\ap|\ap\ap (\tau, \ldots, \tau)\ap TC -\end{gather*} -\begin{itemize} -\item $TV$ is the set of \emph{type variables} like $'\alpha$, - $'\beta$, \ldots The syntactic categories $V$ and $TV$ are disjoint, - thus $'x$ is a possible type variable. -\item $\Xi$ is a set of - \emph{type-classes} like - ``$\operatorname{ord}$'', ``$\operatorname{order}$'', - ``$\operatorname{linorder}$''\ldots This feature in the Isabelle - type system is inspired by Haskell type classes.\footnote{See \url{https://en.wikipedia.org/w/index.php?title=Type_class&oldid=672053941}.} A \emph{type class - constraint} such as $'\alpha::\operatorname{order}$ expresses that - the type variable $'\alpha$ may range over any type that has the - algebraic structure of a partial ordering (as it is configured in - the Isabelle/\HOL library). -\item The type $\tau_1$ $\Rightarrow$ $\tau_2$ denotes the total - function space from $\tau_1$ to $\tau_2$. -\item $TC$ is a set of \emph{type constructors} like - ``$('\alpha)\operatorname{list}$'' or - ``$('\alpha)\operatorname{tree}$''. Again, Isabelle's syntax engine - supports mixfix notation for type terms: \eg cartesian products - $'\alpha$ $\times$ $'\beta$ are understood as $('\alpha,'\beta) - \operatorname{prod}$. Also null-ary type-constructors like - ``$()\operatorname{bool}$'', ``$()\operatorname{nat}$'' and - ``$()\operatorname{int}$'' are possible, although the parentheses of - nullary type constructors are usually omitted. -\end{itemize} -In the following, to designate elements in $TV$, we will usually omit -the quote ``$'$'' symbol in front of lowercase Greek letters. - -Isabelle accepts also the notation $t :: \tau$ as type assertion in -the term language, where $t :: \tau$ means ``$t$ is required to have -the type $\tau$''. The type of typed terms \emph{can} contain free -type variables, like in the types of $x$ and $y$ when the system is -automatically inferring this term $x + y = y + x$. By convention, free -type variables are implicitly universally quantified.\footnote{Here, we assume that $\_ + \_$ and $\_ = \_$ are - declared constant symbols having type - $\operatorname{int} \Rightarrow \operatorname{int} \Rightarrow - \operatorname{int}$ - and $'\alpha \Rightarrow '\alpha \Rightarrow \operatorname{bool}$, - respectively.} - -An environment providing $\Xi$, $TC$ and a map from constant symbols -$C$ to types (built over these $\Xi$ and $TC$) is called a -\emph{global context}. It provides a kind of signature or a mechanism -to construct the syntactic material of a logical theory. - -The most basic (built-in) global context of Isabelle provides just a -language to construct logical rules. More concretely, it provides a -constant declaration for the (built-in) \emph{meta-level implication} -$\_ \ap\Implies\ap \_$ allowing to form constructs like $A_1 -\ap\Implies\ap \cdots \ap\Implies\ap A_n \ap\Implies\ap A_{n+1}$, -which are viewed as a \emph{rule} of the form ``from assumptions $A_1$ -to $A_n$, infer conclusion $A_{n+1}$'' and which is written in -Isabelle syntax as: -\begin{gather*} - \semantics{A_1 ; \ldots; A_n}\ap\Implies\ap A_{n+1} - \quad - \text{or also usually seen as:} - \quad - \begin{prooftree} - A_1 \quad \cdots \quad A_n - \justifies - A_{n+1} - \end{prooftree} -\end{gather*} -Moreover, the built-in meta-level quantification -$\operatorname{Forall} (\lambda x. \ap E \ap x)$, pretty-printed and -parsed as $\Forall x\spot E~x$, captures the usual side-constraints -``$x$ must not occur free in the assumptions'' for quantifier rules. -Meta-quantified variables can be considered as ``fresh'' free -variables. Meta-level quantification leads to a generalization of -Horn-clauses of the form: -\begin{gather*} -\Forall x_1, \ldots, x_m\spot \semantics{A_1 ; \ldots; A_n} \ap\Implies\ap -A_{n+1} -\end{gather*} - -Isabelle supports forward and backward reasoning on rules. For -backward-reasoning, a \emph{proof-state} can be initialized in a given -global context and further transformed during the proof. For example, -a proof of $\phi$, using the -Isabelle/Isar~\cite{wenzel:isabelleisar:2002} language, will look as -follows in Isabelle: -\begin{gather*} - \begin{array}{l} - \Lemma{label} \phi\\ - \quad\apply{case\_tac}\\ - \quad\apply{simp\_all}\\ - \done - \end{array} -\end{gather*} -This proof script instructs the Isabelle system to prove -$\phi$ by case distinction followed by a simplification of all -resulting proof states. Such a proof state is a -sequence of generalized Horn-clauses (called \emph{subgoals}) -$\phi_1$, \ldots, $\phi_n$ with a \emph{goal} $\phi$. Proof states are -usually represented in mathematical textbooks as: -\begin{gather*} -\begin{array}{rl} -\pglabel{label}:& \phi \\ - 1.& \phi_1 \\ - &\vdots \\ - n.& \phi_n\\ -\end{array} -\end{gather*} -Subgoals and goals may be extracted from the proof state into theorems -of the form $\semantics{\phi_1 ; \ldots; \phi_n} \ap\Implies\ap \phi$ -at any time. -% ; this mechanism helps to generate test theorems. -% Further, Isabelle supports meta-variables (written $\meta{x}, \meta{y}, -% \ldots$), which can be seen as ``holes in a term'' that can still be -% substituted. Meta-variables are instantiated by Isabelle's built-in -% higher-order unification. - -By extending global contexts with theorems, axioms and proofs, we get -at the end a \emph{theory} which has been constructed step by -step. Beyond the basic mechanism of extending a global context with -raw types (with type constructors, type class, constant definitions, -or axioms), Isabelle offers a number of \emph{commands} that allow for -more complex extensions of theories in a logically safe way, \ie, by -directly avoiding the use of axioms. - -\subsubsection{Higher-Order Logic (HOL)} -\emph{Higher-Order Logic} -(\HOL)~\cite{church:types:1940,andrews:introduction:2002} is a -classical logic based on a simple type system. Isabelle/\HOL is a -theory extension of the basic Isabelle core language with operators -and the seven axioms of \HOL. Together with large libraries, the -overall constitutes an implementation of \HOL. -Isabelle/\HOL provides the usual logical connectives like $\_ \land -\_$, $\_ \implies\_$, $\lnot \_ $ as well as the object logical -quantifiers $\forall x\spot P\ap x$ and $\exists x\spot P\ap x$. In -contrast to \FOL, quantifiers may range over arbitrary types, including -total functions $f \ap\ofType\ap \tau_1 \Rightarrow \tau_2$. \HOL is -centered around extensional equality $\_ = \_ \ap\ofType\ap \alpha -\Rightarrow \alpha \Rightarrow \text{bool}$. Extensional equality -means that two functions $f$ and $g$ are equal if and only if they are -point-wise equal. This is captured by the rule: $(\Forall~x\spot f~x = -g~x) \Longrightarrow f = g$. \HOL is more expressive than \FOL, since -among many other things, induction schemes can be expressed inside the -logic. For example, the standard induction rule on natural numbers in -\HOL: -\begin{gather*} - P~0 \Longrightarrow (\Forall~x\spot P~x \Longrightarrow P~(x+1)) \Longrightarrow P~x -\end{gather*} -is just an ordinary rule in Isabelle which is in fact a proven theorem -in the theory of natural numbers. This example exemplifies an -important design principle of Isabelle: theorems and rules are -technically the same, paving the way to \emph{derived rules} and -automated decision procedures based on them. This has the consequence -that these procedures are consequently sound by construction with -respect to their logical aspects (they may be incomplete or failing, -though). - -On the one hand, Isabelle/\HOL can be viewed as a functional -programming language like SML or -Haskell, by reading Isabelle/\HOL definitions as one is reading any -declarations in a functional \textbf{programming} language, \ie by -omitting the reading of Isar proof scripts. Conversely, type -definitions in a functional programming language can be viewed as -formulae part of the \textbf{specification} language of -Isabelle/\HOL. - -%Isabelle/HOL is a logical embedding of HOL into Isabelle. The -%(original) simple-type system underlying HOL has been extended by -%Hindley-Milner style polymorphism with type-classes similar to -%Haskell. -%While Isabelle/HOL is usually seen as proof assistant, we -%use it as symbolic computation environment. Implementations on top of -%Isabelle/HOL can re-use existing powerful deduction mechanisms such as -%higher-order resolution, tableaux-based reasoners, rewriting -%procedures, Presburger arithmetic, and via various integration -%mechanisms, also external provers such as -%Vampire~\cite{riazanov.ea:vampire:1999} and the SMT-solver -%Z3~\cite{moura.ea:z3:2008}. - -Isabelle/\HOL offers support for a particular methodology to extend -given theories in a logically safe way: a theory extension is -\emph{conservative} if the provability of a formula in the extended -theory is the same as in the original theory. Then the consistency of -an extended theory depends on the consistency of the original -one. Conservative extensions apply to different families of -definitions: \emph{constant definitions}, \emph{type definitions}, -\emph{datatype definitions}, \emph{primitive recursive definitions} -and \emph{well founded recursive definitions}. - -Isabelle/\HOL provides a large collection of theories like sets, -lists, orderings, and various arithmetic theories. Theories only -contain rules derived from conservative definitions. As an example of -conservative extension, the library includes the type -constructor $\up{\tau} \defeq \isasymbottom | \lift{\_ \ap\ofType\ap - \alpha}$ that assigns to each type $\tau$ a type $\up{\tau}$ -\emph{disjointly extended} by the exceptional element -$\isasymbottom$. The function $\drop{\_} \ap\ofType\ap \up{\alpha} \to -\alpha$ is the inverse of $\lift{\_}$ (it is unspecified for -$\isasymbottom$). Partial functions $\alpha \ap \isasymrightharpoonup -\ap \beta$ are defined as functions $\alpha \ap \isasymRightarrow \ap -\up{\beta}$ supporting the usual concepts of domain ``$\dom\ap\_$'' -and range ``$\ran\ap\_$''. - -As another example, typed sets are conservatively built in the -Isabelle libraries on top of the kernel of \HOL as functions to -$\HolBoolean$. Consequently, the constant definitions for membership -is as follows:\footnote{To increase readability, we use a slightly - simplified presentation. The complete details can be inspected in - \texttt{\$ISABELLE\_HOME/src/HOL/Set.thy} (in Isabelle version - 2016).} -\begin{gather*} - \begin{array}{lr@{}l@{}ll} - \typesynonym& \HolSet{\alpha} &&= \alpha \Rightarrow \HolBoolean\\[.5ex] - \isardef &\operatorname{Collect}&&\ofType \ap (\alpha \Rightarrow \HolBoolean) \Rightarrow \HolSet{\alpha} &\text{--- set comprehension}\\ - \where &\operatorname{Collect} & \ap S & \ap \equiv S\\[.5ex] - \isardef &\operatorname{member} &&\ofType \ap \alpha \Rightarrow \HolSet{\alpha} \Rightarrow \HolBoolean &\text{--- membership test}\\ - \where &\operatorname{member} & \ap s\ap S &\ap \equiv S s - \end{array} -\end{gather*} -Isabelle's syntax engine is instructed to accept the notation $\{x -\mid P\}$ for $\operatorname{Collect}\ap(\lambda x\spot P)$ and the -notation $s \in S$ for $\operatorname{member}\ap s\ap S$. As it can be -inferred from the example, constant definitions are axioms that -introduce a fresh constant symbol (which must not be based on a -recursive expression, or having free variables). This type of axiom is -logically safe since it works like an abbreviation. The syntactic side -conditions of so-introduced axioms are mechanically checked. Then it -becomes straightforward to express the usual operations on sets as -conservative extensions too, like for example $\_ \cup \_$, -$\_\cap\_\ofType\HolSet{\alpha} \Rightarrow \HolSet{\alpha} -\Rightarrow \HolSet{\alpha}$. - -Similarly, a set of logical rules are ``compiled'' from the following -statements, which introduce the types $\operatorname{option}$ and -$\operatorname{list}$: -\begin{gather*} - \begin{array}{lrlll} - \datatype & \alpha \ap \operatorname{option} &= \operatorname{None} &&\mid \operatorname{Some} \ap \alpha\\[.5ex] - \datatype & \alpha \ap \operatorname{list} &= \operatorname{Nil} & (\text{``[]''}) &\mid \operatorname{Cons}\ap \alpha \ap \text{``$\alpha \operatorname{list}$''} \quad ({\greenkeywordstyle\operatorname{infixr}} \ap \text{``\#''} \ap 65) - \end{array} -\end{gather*} -Here ``$[]$'' or ``$\_ \# \_$'' are an alternative syntax for -$\operatorname{Nil}$ or $\operatorname{Cons}\ap a ~l$. Moreover, the -commands $\holoclthykeywordstyle\operatorname{syntax}$ and -$\holoclthykeywordstyle\operatorname{translations}$ -can additionally (recursively) define $[a, b, c]$ as an alternative -syntax for $a\#b\#c\#[]$. Besides the \emph{constructors} $\HolNone$, -$\HolSome$, $[]$ and $\operatorname{Cons}$, there is the matching -operation to conditionally return a term by case analysis provided a -general term $x$, whose type has been defined with $\datatype$, as -example: -\begin{gather*} -\HolCase\ap x\ap\HolOf \ap \operatorname{None} \ap \isasymRightarrow \ap F\ap \mid \ap -\operatorname{Some} \ap a \ap \isasymRightarrow \ap G\ap a -\end{gather*} -The $\datatype$ package automatically derives a set of properties in -front of each command -$\datatype$. One -way to understand this command is to view it as a kind of macro -(albeit its syntax is inspired by functional programming languages), -which generates a number of constant definitions and theorems from the -type declaration $\operatorname{option}$ or $\operatorname{list}$. So -the generated lemmas are also implicitly proved in the background, -this command constructs a model of the constructors and derive its -properties: -\begin{gather*} - \begin{array}{ll} - (\HolCase\ap[]\ap\HolOf\ap[] \Rightarrow F \ap | \ap (a\#r) \Rightarrow - G\ap a\ap r) = F &\\ - (\HolCase \ap b\#t \ap \HolOf \ap [] \Rightarrow F \ap | \ap - (a\#r) \Rightarrow G\ap a\ap r) = G~b~t &\\ % - \mbox{}[] \neq a\#t &\text{-- distinctness} \\ - (a = [] \Longrightarrow P) \Longrightarrow - (\Forall x \ap t\spot a = x\#t \Longrightarrow P) \Longrightarrow - P &\text{-- exhaust} \\ - P \ap [] \Longrightarrow ( \Forall \ap a \ap t\spot P \ap t \Longrightarrow P (a\#t) ) \Longrightarrow P \ap x &\text{-- induct} - \end{array} -\end{gather*} -Besides $\datatype$, other packages are natively present when starting -Isabelle. For example the $\fun$ command serves to define well-founded -recursive -functions. Thus, we -may define the $\operatorname{sort}$ operation on linearly ordered -lists as follows: -\begin{gather*} - \begin{array}{lll} - \fun - &\enspace\operatorname{ins} & \ofType - [\alpha\ofType\mathrm{linorder}, \HolList{\alpha}] - \Rightarrow - \HolList{\alpha}\\ - \where - &\enspace \operatorname{ins}\ap x \ap [\;] &= [x]\\ - &\enspace \operatorname{ins}\ap x \ap (y\# ys)&= - \HolIf x < y \ap - \HolThen \ap x\# y \# ys \ap - \HolElse \ap y\#(\operatorname{ins} \ap x \ap ys) - \end{array}\\ - \begin{array}{lll} - \fun - &\enspace\operatorname{sort} & \ofType - \HolList{(\alpha\ofType\mathrm{linorder})} - \Rightarrow - \HolList{\alpha}\\ - \where - &\enspace \operatorname{sort}\ap [\;] &= [\;]\\ - &\enspace \operatorname{sort} (x\# xs)&= - \operatorname{ins}\ap x\ap (\operatorname{sort}\ap xs) - \end{array} -\end{gather*} -Similar as $\datatype$, the $\fun$ command can again be seen as a kind -of macro: a conservative construction is implied; the derivation of -the equations $\operatorname{ins}\ap x \ap [\;] = [x]$ and -$\operatorname{ins}\ap x \ap (y\# ys) = \HolIf x < y \ap \HolThen \ap -x\# y \# ys \ap \HolElse \ap y\#(\operatorname{ins} \ap x \ap ys)$ is -done automatically involving a termination proof (most of the time -automatically proved for basic functions). This involved construction -assures logical safeness: in general, just adding axioms for recursive -equations causes inconsistency for non-terminating functions. The -resulting equations can now be used in the Isabelle simplifier. - -The library of Isabelle/\HOL constitutes a comfortable basis for -defining the \OCL library or embed a specification language. In -particular, Isabelle manages a set of \emph{executable types and - operators}, \ie, types and operators for which a compilation to -external languages is possible, using -\emph{code-generation}. The -supported external languages in Isabelle for code-generation are -currently Haskell, OCaml, Scala and -SML. As one example, arithmetic types such as $\text{int}$ are -appropriately optimized to be executed fast depending on the chosen -external language. Datatypes and recursive functions are as well -supported to be executed in these external languages (assuming their -definitions contain only executable operators). - -Another mean to do executions in Isabelle is to use the -$\holoclthykeywordstyle\operatorname{value}$ command (whose -functioning resembles to how code-generation -works). Then, after typing -$\holoclthykeywordstyle\operatorname{value}$ ``$3 + 7$'' in -Isabelle/jEdit, we -will get $10$ as result. Generally -$\holoclthykeywordstyle\operatorname{value}$ can work with many ground -expressions (with no free variables). So most of \OCL ground terms are -in fact executable in Isabelle, due to prior special setups in the -\FOCL library. - -% Similarly, Isabelle -%manages a large set of (higher-order) rewrite rules into which -%recursive function definitions were included. Provided that this -%rule set represents a terminating and confluent rewrite system, the -%Isabelle simplifier provides also a highly potent decision procedure -%for many fragments of theories underlying the constraints to be -% processed when constructing test theorems. - -\isatagafp -\subsection{How this Document was Generated from Isabelle/HOL Theories} -\endisatagafp -\isatagannexa -\subsection{How this Annex A was Generated from Isabelle/HOL Theories} -\endisatagannexa -\begin{figure*}[tb] - \mbox{}\hfill - \subfloat% - [The Isabelle jEdit environment. ]% - {\label{fig:jedit} \includegraphics[height=6.2cm]{jedit}}% - \hfill% - \hfill% - \subfloat[The generated formal document.]% - {\label{fig:pdf} \includegraphics[height=6.2cm]{pdf}} - \hfill\mbox{} - \caption{Generating documents with guaranteed syntactical and - semantical consistency.} - \label{fig:gener-docum-where} -\end{figure*} -Isabelle, as a framework for building formal -tools~\cite{wenzel.ea:building:2007}, -provides the means for generating \emph{formal documents}. With formal -documents (such as the one the reader is reading) we refer to -documents that are machine generated with a process ensuring certain -formal guarantees. In particular, all the textual content manipulating -definitions, formulae, \ldots, types are checked for consistency -during the document generation. - -For writing documents, Isabelle supports the embedding of informal -texts using a \LaTeX{} based markup language within the theory -files. One other alternative to embed informal documents is to -directly write \LaTeX{} code in usual ``$\_$\verb|.tex|'' files, and -then link them with the formal content generated by -Isabelle. Generally, by manually inspecting the source code of -Isabelle theory files, one can have a clear estimation of the size of -informal texts versus formal texts of a given project. - -Still, to ensure consistencies of certain informal parts, Isabelle -supports the use of \emph{antiquotations} within informal texts, that -refer to the formal parts and that are checked while generating the -actual document as PDF\@. For example, in an informal text, the -antiquotation ``\verb|@{|$\holoclthykeywordstyle\operatorname{thm}$ $OclNot\_not$\verb|}|'' will instruct -Isabelle to abort the generation with an error in case no \OCL -theorems with the name $OclNot\_not$ were found, otherwise the system -will replace the antiquotation with the actual theorem, \ie -``$\mocl{not} \ap (\mocl{not} \ap X) = X$''. - -\autoref{fig:gener-docum-where} -illustrates this approach: \autoref{fig:jedit} shows the jEdit-based -development environment of Isabelle with an excerpt of one of the core -theories of \FOCL\@. \autoref{fig:pdf} shows the generated -PDF document where all antiquotations are replaced. Moreover, -the document generation tools allows for defining syntactic sugar as -well as skipping technical details of the formalization. - -\isatagannexa -Thus, applying the \FOCL approach to writing an updated -Annex A that provides a formal semantics of the most fundamental -concepts of \OCL ensures -\begin{enumerate} -\item that all formal context is syntactically correct and well-typed, - and -\item all formal definitions and the derived logical rules are - semantically consistent. -\end{enumerate} -% Overall, this would contribute to one of the main goals of the \OCL 2.5 -% RFP, as discussed at the \OCL meeting in -% Aachen~\cite{brucker.ea:summary-aachen:2013}. -\endisatagannexa -\isatagafp -Featherweight OCL is a formalization of the core of OCL -aiming at formally investigating the relationship between the -various concepts. At present, it does not attempt to define the complete -OCL library. Instead, it concentrates on the core concepts of -OCL as well as the types \inlineocl{Boolean}, -\inlineocl{Integer}, and typed sets (\inlineocl|Set(T)|). Following -the tradition of -HOL-OCL~\cite{brucker.ea:hol-ocl:2008,brucker.ea:hol-ocl-book:2006}, -Featherweight OCL is based on the following principles: -\begin{enumerate} -\item It is an embedding into a powerful semantic meta-language and - environment, namely - Isabelle/HOL~\cite{nipkow.ea:isabelle:2002}. -\item It is a \emph{shallow embedding} in HOL; types - in OCL were injectively mapped to types in Featherweight - OCL\@. Ill-typed OCL specifications cannot be represented in - Featherweight OCL and a type in Featherweight OCL contains exactly - the values that are possible in OCL\@. Thus, sets may contain - \inlineocl{null} (\inlineocl|Set{null}| is a defined set) but not - \inlineocl{invalid} (\inlineocl|Set{invalid}| is just - \inlineocl{invalid}). -\item Any Featherweight OCL type contains at least - \inlineocl{invalid} and \inlineocl{null} (the type \inlineocl{Void} - contains only these instances). The logic is consequently - four-valued, and there is a \inlineocl{null}-element in the type - \inlineocl{Set(A)}. -\item It is a strongly typed language in the Hindley-Milner tradition. - We assume that a pre-process eliminates all implicit conversions due - to sub-typing by introducing explicit casts (\eg, - \inlineocl{oclAsType()}). The details of such a pre-processing are - described in~\cite{brucker:interactive:2007}. Casts are semantic - functions, typically injections, that may convert data between the - different Featherweight OCL types. -\item All objects are represented in an object universe in the HOL-OCL - tradition~\cite{brucker.ea:extensible:2008-b}. The universe - construction also gives semantics to type casts, dynamic type - tests, as well as functions such as \inlineocl{oclAllInstances()}, - or \inlineocl{oclIsNew()}. -\item Featherweight OCL types may be arbitrarily nested. For example, - the expression - \inlineocl|Set{Set{1,2}} = Set{Set{2,1}}| is legal and true. -\item For demonstration purposes, the set type in Featherweight OCL - may be infinite, allowing infinite quantification and a constant - that contains the set of all Integers. Arithmetic laws like - commutativity may therefore be expressed in OCL itself. The - iterator is only defined on finite sets. -\item It supports equational reasoning and congruence reasoning, but - this requires a differentiation of the different equalities like - strict equality, strong equality, meta-equality (HOL). Strict - equality and strong equality require a sub-calculus, ``cp'' (a - detailed discussion of the different equalities as well as the - sub-calculus ``cp''---for three-valued OCL 2.0---is given - in~\cite{brucker.ea:semantics:2009}), which is nasty but can be - hidden from the user inside tools. -\end{enumerate} -Overall, this would contribute to one of the main goals of the \OCL 2.5 -RFP, as discussed at the \OCL meeting in -Aachen~\cite{brucker.ea:summary-aachen:2013}. -\endisatagafp - - -\section{The Essence of UML/OCL Semantics}\label{sec:focl-semantics} -\subsection{The Theory Organization} -The semantic theory is organized in several -\emph{semantic layers}. The following three layers will provide a -``minimal'' core semantics of built-in data-structures, so to support -in particular the \OCL type \inlineocl+Boolean+. -\begin{itemize} -\item The first layer, called the \emph{denotational semantics} - comprises a set of definitions of the operators of the language. - Presented as \emph{definitional axioms} inside Isabelle/\HOL, this - part assures the logically consistency of the overall - construction. The denotational definitions of types, constants and - operations, and \OCL contracts represent the ``gold standard'' of - the semantics. -\item The second layer, called \emph{logical layer}, is derived from - the former and centered around the notion of validity of an \OCL - formula $P$. For a state-transition from pre-state $\sigma$ to - post-state $\sigma'$, a validity statement is written $(\sigma, - \sigma') \isasymMathOclValid P$. Its major purpose is to logically - establish facts (lemmas and theorems) about the denotational - definitions. -\item The third layer, called \emph{algebraic layer}, also derived - from the former layers, tries to establish algebraic laws of the - form $P = P'$; such laws are amenable to equational reasoning and - also help for automated reasoning and code-generation. For an - implementor of an \OCL compiler, these consequences are of most - interest. -\end{itemize} - -Then come the next semantic layers covering construction of \UML class -models, composed of: -\begin{itemize} -\item the \emph{state layer} describing state-related operations like - \mocl{allInstances()}, and -\item the \emph{object-oriented datatype layers} giving semantics to - \UML class models over this, comprising the theory of accessors, - type casts and tests. -\end{itemize} - -For space reasons, we will restrict ourselves in this document to a -few operators and make a traversal through all five layers to give a -high-level description of our formalization. Especially, the details -of the semantic construction for sets, sequences, bags are excluded -from a presentation here. - - -\subsection{Denotational Semantics of Types} -\begin{defholsimple}[\UML/\OCL types] -The syntactic material for type expressions, called -$\operatorname{TYPES}(C,E)$, is inductively defined as follows: -\begin{itemize} -\item $C \subseteq \operatorname{TYPES}(C,E)$ are object types. - -\item $E \subseteq \operatorname{TYPES}(C,E)$ are enumerate - types. Enumerate types are basically sum types: a form of Isabelle - $\datatype$ without polymorphic parameters. - -\item \inlineocl+Void+, \inlineocl+Boolean+, \inlineocl+Integer+, - \inlineocl+Real+, \inlineocl+String+ are base types $\text{T}_{base} - \subseteq \operatorname{TYPES}(C,E)$. - -\item $\tysequence_m\mocl{(}X\mocl{)}$, - $\mocl{Set}_m\mocl{(}X\mocl{)}$, and - $\mocl{Pair(}X\mocl{,}Y\mocl{)}$ are collection - types in $\operatorname{TYPES}(C,E)$ if $X, Y \in - \operatorname{TYPES}(C,E)$. - - These collection types are particular dependent - types: the multiplicity $m$ is a list of - intervals constraining the size of the corresponding sequence or - set. An interval $\mocl{[}i_{min} \mocl{..} i_{max}\mocl{]}$ is - composed of two lifted naturals $\operatorname{nat}$ of the form - $(\up{\operatorname{nat}} \times \up{\operatorname{nat}})$ where the - bottom element is conventionally represented as a star - ``$\mocl{*}$'', this additional element means an arbitrary allowed - number. For a sequence or set to be classified as well-typed, it - must exist one interval in the list $m$ such that $i_{min} \le s \le - i_{max}$, with $s$ the size of the sequence or set. - - Whenever $m$ evaluates to the interval $\mocl{*}$\footnotemark, the - multiplicity information can be omitted and in this case we will - just write $\tysequence\mocl{(}X\mocl{)}$ and - $\mocl{Set(}X\mocl{)}$. - - A syntactic sugar is provided for building arbitrary - tuples: $\mocl{(}X_1\mocl{,}\cdots\mocl{,}X_n\mocl{)}$ is a - shorthand for $\mocl{Pair(}X_1\mocl{,}\cdots - \mocl{Pair(}X_{n-2}\mocl{,Pair(}X_{n-1}\mocl{,}X_n\mocl{))} \cdots - \mocl{)}$ for $n \ge 2$. - Types in tuples can be preceded with additional labelling variables - $\mocl{(}x_1\mocl{:}X_1\mocl{,}\cdots\mocl{,}x_n\mocl{:}X_n\mocl{)}$ - where $x_1, \cdots, x_n$ are labels for naming individuals of the - respective types $X_1, \cdots, X_n$. These labels are typically used - when defining \UML/\OCL contracts. - -\item - $X\mocl{:}Y$ are functional types in $\operatorname{TYPES}(C,E)$ if - $X, Y \in \operatorname{TYPES}(C,E)$. - - Like tuples, $\mocl{(}x\mocl{:}X\mocl{)}\mocl{:}Y$ is an additional - syntax for describing functional types, where $x$ is a stamped - label. - Functional types mainly appear together with tuples when writing - \UML/\OCL contracts. - Depending on the context, in positions where no ambiguities with - tuples occur, functional types can be shorten to - $\mocl{(}x_1\mocl{:}X_1\mocl{,}\cdots\mocl{,}x_n\mocl{:}X_n\mocl{)}$ - (where $n \ge 1$), in this case the absent type $Y$ has - the same semantics as $\mocl{Void}$. - - As another notation, we can use $X\mocl{->}Y$ to represent - functional types. Thus - $\mocl{(}X_1\mocl{,}\cdots\mocl{,}X_n\mocl{)}\mocl{->}Y$ can be used - without labelling names (as this does not conflict with tuples). -\end{itemize} -We define $\operatorname{TYPES}_0(C,E)$ as the smallest subset of -$\operatorname{TYPES}(C,E)$ built without using functional types in all -recursive calls. -In the following, $\operatorname{TYPES}_0(C,E)$ and $\operatorname{TYPES}(C,E)$ will be respectively shorten to $\operatorname{TYPES}_0$ and $\operatorname{TYPES}$. -\end{defholsimple}\footnotetext{The - interval $\mocl{*}$ is a shortcut for $\mocl{[*..*]}$. We will - abbreviate intervals $\mocl{[}i_{min} \mocl{..} i_{max}\mocl{]}$ - by a single $i_{min}$ if we have $i_{min} = i_{max}$.} - -Types were directly represented in \FOCL by types in \HOL; consequently, -any \FOCL type must provide elements for a bottom element (also denoted $\bot$) -and a null element; this is enforced in Isabelle by a type-class $\TCnull$ that -contains two distinguishable elements $\HolBot$ and $\HolNull$ -(see \autoref{sec:focl-types} for the details of the construction). - -Moreover, the representation mapping from \OCL types to \FOCL is -one-to-one (\ie, injective), and the corresponding \FOCL types were -constructed to represent \emph{exactly} the elements (``no junk, no confusion - elements'') of their \OCL counterparts. The corresponding \FOCL types were -constructed in two stages: First, a \emph{base type} is constructed whose -carrier set contains exactly the elements of the \OCL type. Secondly, this -base type is lifted to a \emph{valuation} type that we use for type-checking -\FOCL constants, operations, and expressions. The valuation type takes into account -that some \UML-\OCL functions of its \OCL type (namely: accessors in path-expressions) -depend on a pre- and a post-state. - -For most base types like $\text{Boolean}_{\text{base}}$ or -$\text{Integer}_{\text{base}}$, it suffices to double-lift a \HOL library type: -\begin{gather*} -\typesynonym \qquad \text{Boolean}_{\text{base}} = \up{{\up{bool}}} -\end{gather*} -As a consequence of this definition of the type, we have the elements -$\isasymbottom, \lift{\isasymbottom}, \lift{\lift{\HolTrue}}, -\lift{\lift{\HolFalse}}$ in the carrier-set of $\text{Boolean}_{\text{base}}$. -We can therefore use the element$\isasymbottom$ to define the generic type -class element $\bot$ and $\lift{\bot}$ for the generic type class $\HolNull$. -For collection types and object types this definition -is more evolved (see \autoref{sec:focl-types}). - -For object base types, we assume a typed universe $\isaAA$ of objects to be -discussed later, for the moment we will refer it by its polymorphic variable. - -With respect the valuation types for \OCL expression in general and Boolean -expressions in particular, they depend on the pair $(\sigma, \sigma')$ of -pre-and post-state. Thus, we define valuation types by the synonym: -\begin{gather*} -\typesynonym \qquad \V{\isaAA}{\alpha} = (\state{\isaAA} \times - \state{\isaAA} \to \alpha \ofType \TCnull) \mi{.} -\end{gather*} -The valuation type for boolean,integer, etc. \OCL terms is therefore defined as: -\begin{gather*} -\typesynonym \qquad \text{Boolean}_{\isaAA} = \V{\isaAA}{\text{Boolean}_{\text{base}}} \\ -\typesynonym \qquad \text{Integer}_{\isaAA} = \V{\isaAA}{\text{Integer}_{\text{base}}} \\ -\ldots -\end{gather*} -the other cases are analogous. In the subsequent subsections, we will drop the -index $\isaAA$ since it is constant in all formulas and expressions except for -operations related to the object universe construction in \autoref{sec:universe} - -The rules of the logical layer (there are no algebraic rules related to the -semantics of types), and more details can be found in \autoref{sec:focl-types}. - -\subsection{Denotational Semantics of Constants and Operations} -We use the notation $I\semantics{E}\tau$ for the semantic interpretation -function as commonly used in mathematical textbooks and the variable $\tau$ -standing for pairs of pre- and post state $(\sigma, \sigma')$. Note that we will -also use $\tau$ to denote the \emph{type} of a state-pair; since both syntactic -categories are independent, we can do so without arising confusion. \OCL -provides for all \OCL types the constants \mocl{invalid} for the exceptional -computation result and \mocl{null} for the non-existing value. Thus we define: -\begin{gather*} -\begin{alignedat}{3} -I\semantics{\mocl{invalid}\ofType V(\alpha)} \tau &\equiv \HolBot & -\qquad I\semantics{\mocl{null}\ofType V(\alpha)} \tau &\equiv \HolNull\\ -\end{alignedat} -\end{gather*} -For the concrete \mocl{Boolean}-type, we define similarly the boolean constants -$\mocl{true}$ and $\mocl{false}$ as well as the fundamental tests for definedness -and validity (generically defined for all types): -\begin{gather*} -\begin{alignedat}{3} -I\semantics{\mocl{true}\ofType\mocl{Boolean}} \tau &= \lift{\lift{\HolTrue}} & -\qquad I\semantics{\mocl{false}} \tau &= \lift{\lift{\HolFalse}}\\ -\end{alignedat}\\ -I\semantics{X\mocl{.oclIsUndefined()}} \tau = - (\HolIf I\semantics{X}\tau \in \{\HolBot, \HolNull\} \HolThen I\semantics{\mocl{true}}\tau \HolElse I\semantics{\mocl{false}}\tau)\\ - I\semantics{X\mocl{.oclIsInvalid()}} \tau = - (\HolIf I\semantics{X}\tau = \HolBot \HolThen I\semantics{\mocl{true}}\tau \HolElse I\semantics{\mocl{false}}\tau) -\end{gather*} - -Due to the used style of semantic representation (a shallow embedding) $I$ is -in fact superfluous and defined semantically as the identity $\lambda x.~x$; -instead of: -\begin{gather*} -I\semantics{\mocl{true}\ofType\mocl{Boolean}} \tau = \lift{\lift{\HolTrue}} -\shortintertext{we can therefore write:} -\mocl{true}\ofType\mocl{Boolean} = \lambda \tau. \lift{\lift{\HolTrue}} -\end{gather*} -In Isabelle theories, this particular presentation of definitions -paves the way for an automatic check that the underlying equation -has the form of an \emph{axiomatic definition} and is therefore logically safe. - -\isatagannexa -Since all operators of the assertion language depend on the context -$\tau$ = $(\sigma, \sigma')$ and result in values that can be $\isasymbottom$, -all expressions can be viewed as \emph{evaluations} from $(\sigma, \sigma')$ to -a type $\alpha$ which must posses a $\bottom$ and a $\text{null}$-element. Given -that such constraints can be expressed in Isabelle/HOL via \emph{type classes} -(written: $\alpha::\kappa$), all types for OCL-expressions are of a form captured -by -\begin{gather*} -\V{\isaAA}{\alpha} = (\state{\isaAA} \times - \state{\isaAA} \to \alpha \ofType \TCnull) \mi{,} -\end{gather*} -where $\state{\isaAA}$ stands for the system state and $\state{\isaAA} \times -\state{\isaAA}$ describes the pair of pre-state and post-state. - -Previous versions of the OCL semantics~\cite[Annex A]{omg:ocl:2003} used different -interpretation functions for invariants and pre-conditions; we achieve -their semantic effect by a syntactic transformation $\__\text{pre}$ -which replaces, for example, all accessor functions -$\getAttrib{\_}{a}$ by their counterparts -$\getAttrib{\_}{a\isasymOclATpre}$ (see \autoref{sec:invlogic}). For example, -$(\getAttrib{\self}{a} > 5)_\text{pre}$ is just -$(\getAttrib{\self}{a\isasymOclATpre} > 5)$. This way, also invariants -and pre-conditions can be interpreted by the same interpretation -function and have the same type of an evaluation $\V{}{\alpha}$. -\endisatagannexa - -On this basis, one can define the core logical operators $\mocl{not}$ -and $\mocl{and}$ as follows: -\begin{gather*} - \begin{array}{ll} - I\semantics{\mocl{not}\; X} \tau - &= (\HolCase I\semantics{X} \tau \HolOf\\ - &\quad\begin{array}{ll} - ~ \bottom &\Rightarrow \bottom \\ - | \lfloor \bottom \rfloor &\Rightarrow \lfloor \bottom \rfloor \\ - | \lfloor \lfloor x \rfloor \rfloor &\Rightarrow \lfloor \lfloor \lnot x \rfloor \rfloor ) - \end{array} - \end{array} -\end{gather*} -\begin{gather*} - \begin{array}{ll} - I\semantics{X\;\mocl{and}\; Y} \tau - &= (\HolCase I\semantics{X} \tau \HolOf\\ - &\quad\begin{array}{ll} - ~ \bottom &\Rightarrow - (\HolCase I\semantics{Y} \tau \HolOf\\ - &\quad\begin{array}{ll} - ~ \bottom &\Rightarrow \bottom \\ - | \lfloor \bottom \rfloor &\Rightarrow \bottom \\ - | \lfloor \lfloor \HolTrue \rfloor \rfloor - &\Rightarrow \bottom\\ - | \lfloor \lfloor \HolFalse \rfloor \rfloor - &\Rightarrow \lfloor \lfloor \HolFalse \rfloor \rfloor )\\ - \end{array} - \\ - | \lfloor \bottom \rfloor &\Rightarrow - (\HolCase I\semantics{Y} \tau \HolOf\\ - &\quad\begin{array}{ll} - ~ \bottom &\Rightarrow - \bottom \\ - | \lfloor \bottom \rfloor &\Rightarrow \lfloor - \bottom \rfloor \\ - | \lfloor \lfloor \HolTrue \rfloor \rfloor - &\Rightarrow \lfloor \bottom\rfloor\\ - | \lfloor \lfloor \HolFalse \rfloor \rfloor - &\Rightarrow \lfloor \lfloor \HolFalse \rfloor \rfloor )\\ - \end{array} - \\ - | \lfloor \lfloor \HolTrue \rfloor \rfloor &\Rightarrow - (\HolCase I\semantics{Y} \tau \HolOf\\ - &\quad\begin{array}{ll} - ~ \bottom &\Rightarrow - \bottom \\ - | \lfloor \bottom \rfloor &\Rightarrow \lfloor - \bottom \rfloor \\ - | \lfloor \lfloor y \rfloor \rfloor - &\Rightarrow \lfloor \lfloor y \rfloor \rfloor )\\ - \end{array} - \\ - | \lfloor \lfloor \HolFalse \rfloor \rfloor - &\Rightarrow \lfloor \lfloor \HolFalse \rfloor - \rfloor )\\ - \end{array}\\ -\end{array} -\end{gather*} -These non-strict operations are used to define the other logical connectives in -the usual classical way: -\begin{gather*} -\begin{array}{l} -X\; \mocl{or}\; Y \equiv \mocl{not} \; ((\mocl{not}\; X)\; \mocl{and}\; (\mocl{not}\; Y))\\ -X\;\mocl{implies}\;Y \equiv (\mocl{not}\; X)\;\mocl{or}\; Y -\end{array} -\end{gather*} -For reasons of conciseness, we will write $\delta~X$ for -$\mocl{not} \ap (X\mocl{.oclIsUndefined()})$ and $\upsilon~X$ for -$\mocl{not} \ap (X\mocl{.oclIsInvalid()})$ throughout this document. - -The default semantics for an \OCL library operator is strict -semantics; this means that the result of an operation $f$ is -$\mocl{invalid}$ if one of its arguments is $\mocl{invalid}$ or $\mocl{null}$. -The definition of the addition for integers as default variant reads as follows: -\begin{gather*} - \begin{array}{rl} - I\semantics{X \;\mocl{+}\; Y}\tau = &\HolIf I\semantics{\delta ~ X}\tau =I\semantics{\mocl{true}}\tau - \land I\semantics{\delta ~ Y}\tau =I\semantics{\mocl{true}}\tau \\ - &\HolThen \; \lfloor \lfloor \lceil \lceil I\semantics{X}\tau \rceil \rceil + \lceil \lceil I\semantics{Y}\tau \rceil \rceil \rfloor \rfloor\\ - &\HolElse \; \bottom - \end{array} -\end{gather*} -where the operator ``\mocl{+}'' on the left-hand -side of the equation denotes the \OCL addition of type -$\mocl{(Integer,Integer)->Integer}$ while -the ``$+$'' on the right-hand side of the equation of type -$[\HolInteger,\HolInteger]\Rightarrow \HolInteger$ denotes the integer-addition -from the \HOL library. - -\subsection{Logical Layer} -The topmost goal of the logic for \OCL is to define the \emph{validity statement}: -\begin{gather*} - (\sigma, \sigma') \isasymMathOclValid P -\end{gather*} -where $\sigma$ is the pre-state and $\sigma'$ the post-state of the -underlying system and $P$ is a formula, \ie, an \OCL expression of type \mocl{Boolean}. -Informally, a formula $P$ is valid if and only if its evaluation in -$(\sigma, \sigma')$ (\ie, $\tau$ for short) yields $\mocl{true}$. Formally this means: -\begin{gather*} -\tau \models P \equiv (I\semantics{P}\tau = I\semantics{\mocl{true}}\tau) -\end{gather*} -On this basis, classical, two-valued inference rules can be established for -reasoning over the logical connectives, the different notions of equality, -definedness and validity. Generally speaking, rules over logical validity can -relate bits and pieces in various \OCL terms and allow---via strong -logical equality discussed below---the replacement -of semantically equivalent sub-expressions. -The core inference rules are: -\begin{itemize} - -\item $\mocl{Boolean}$: -\begin{gather*} - \tau \isasymMathOclValid \mocl{true} \quad - \lnot(\tau \isasymMathOclValid \mocl{false}) \quad - \lnot(\tau \isasymMathOclValid \mocl{invalid}) \quad - \lnot(\tau \isasymMathOclValid \mocl{null}) -\end{gather*} - -\item $\mocl{not}$: -\begin{gather*} - \tau \isasymMathOclValid \mocl{not}\; P \Longrightarrow \lnot (\tau \isasymMathOclValid P) -\end{gather*} - -\item $\mocl{and}$: -\begin{gather*} - \tau \isasymMathOclValid P \;\mocl{and}\; Q \Longrightarrow \tau \isasymMathOclValid P \qquad - \tau \isasymMathOclValid P \;\mocl{and}\; Q \Longrightarrow \tau \isasymMathOclValid Q -\end{gather*} - -\item $\mocl{or}$: -\begin{gather*} - \tau \isasymMathOclValid P \Longrightarrow \tau \isasymMathOclValid P \;\mocl{or}\; Q \phantom{\mocl{r}}\qquad - \tau \isasymMathOclValid Q \Longrightarrow \tau \isasymMathOclValid P \;\mocl{or}\; Q -\end{gather*} - -\item $\mocl{if} \ldots \mocl{then} \ldots \mocl{else} \ldots \mocl{endif}$: -\begin{gather*} -\begin{array}{l@{\ap}l} - \tau \isasymMathOclValid & P \Longrightarrow - I\semantics{\mocl{if}\; P \;\mocl{then}\; B_1 \;\mocl{else}\; B_2 \;\mocl{endif}} \tau = I\semantics{B_1}\tau \\ - \tau \isasymMathOclValid \mocl{not} & P \Longrightarrow - I\semantics{\mocl{if}\; P \;\mocl{then}\; B_1 \;\mocl{else}\; B_2 \;\mocl{endif}} \tau = I\semantics{B_2}\tau -\end{array} -\end{gather*} - -or equivalently: -\begin{gather*} -\begin{array}{l@{\ap}l} - \tau \isasymMathOclValid & P \Longrightarrow - (\mocl{if}\; P \;\mocl{then}\; B_1 \;\mocl{else}\; B_2 \;\mocl{endif}) \ap \tau = B_1\ap \tau \\ - \tau \isasymMathOclValid \mocl{not} & P \Longrightarrow - (\mocl{if}\; P \;\mocl{then}\; B_1 \;\mocl{else}\; B_2 \;\mocl{endif}) \ap \tau = B_2\ap \tau -\end{array} -\end{gather*} - -\item $\delta \ap \_$ and $\upsilon \ap \_$: -\begin{gather*} - \tau \isasymMathOclValid P \Longrightarrow \tau \isasymMathOclValid \delta \ap P \qquad - \tau \isasymMathOclValid \delta \ap X \Longrightarrow \tau \isasymMathOclValid \upsilon \ap X -\end{gather*} -\end{itemize} - -By the latter two properties, it can be inferred that any valid -property $P$ (so for example, a valid invariant) is defined, which -allows to infer for terms composed by strict operations that their -arguments and finally the variables occurring in it are valid or -defined. - -The mandatory part of the \OCL standard refers to an equality -(written $X \;\mocl{=}\; Y$ or $X \;\mocl{<>}\; Y$ for its negation), which is -intended to be a strict operation (thus: $\mocl{invalid} \;\mocl{=}\; Y$ evaluates - to \mocl{invalid}) and which uses the references of objects in a state -when comparing objects, similarly to C++ or Java. In order to avoid -confusions, we will use the following notations for equality: -\begin{enumerate} -\item The symbol $\_ = \_$ remains to be reserved to the \HOL equality, - \ie, the equality of our semantic meta-language, -\item The symbol $\_ \isasymMathOclStrongEq \_$ will be used for - the \emph{strong logical equality}, which follows the general - logical principle that ``equals can be replaced by equals,''\footnote{Strong logical equality is also referred as ``Leibniz''-equality.} - and is at the heart of the \OCL logic, -\item The symbol $\_ \isasymMathOclStrictEq \_$ is used for the - strict referential equality, \ie, the equality the mandatory part - of the \OCL standard refers to by the ``\_ \;\mocl{=}\; \_'' symbol. -\end{enumerate} - -The strong logical equality is a polymorphic -concept which is defined using polymorphism for all \OCL types by: -\begin{gather*} - I\semantics{X \triangleq Y} \tau \equiv - \lift {\lift{I\semantics{X} \tau = I\semantics{Y} \tau }} -\shortintertext{It enjoys nearly the laws of a congruence:} -\tau \isasymMathOclValid (X \triangleq X)\\ -\tau \isasymMathOclValid (X \triangleq Y) \Longrightarrow \tau \isasymMathOclValid (Y \triangleq X)\\ -\tau \isasymMathOclValid (X \triangleq Y) \Longrightarrow \tau \isasymMathOclValid (Y \triangleq Z) \Longrightarrow \tau \isasymMathOclValid (X \triangleq Z)\\ -\operatorname{cp} P \Longrightarrow \tau \isasymMathOclValid (X \triangleq Y) \Longrightarrow \tau \isasymMathOclValid (P\ap X) \Longrightarrow \tau \isasymMathOclValid (P\ap Y) -\end{gather*} -where the predicate $\operatorname{cp}$ stands for -\emph{context-passing}, a property that is true in \FOCL for all pure \OCL -expressions (but not arbitrary mixtures of \OCL and \HOL): -\begin{gather*} -\operatorname{cp} P \equiv \exists f. \; \forall X \; \tau. \; I\semantics{P \ap X}\tau = I\semantics{f \ap (I\semantics{X}\tau)}\tau -\end{gather*} -The necessary side-calculus for establishing $\operatorname{cp}$ can -be fully automated; the reader interested in the details is referred -to \autoref{sec:equality}. - -The strong logical equality of \FOCL gives rise to a number -of further rules and derived properties, that clarify the role of strong -logical equality and the $\mocl{Boolean}$ constants in \OCL specifications: -\begin{gather*} -\tau \isasymMathOclValid \delta \ap X \lor \tau \isasymMathOclValid X \triangleq \mocl{invalid} \lor \tau \isasymMathOclValid X \triangleq \mocl{null}\\ -\begin{array}{l@{}l@{\ap}l@{\ap}l@{}l} -(\tau \isasymMathOclValid A \triangleq \mocl{invalid} &) &= (& \tau \isasymMathOclValid \mocl{not} \; (\upsilon \; A) &)\\ -% (* foundation15 *) -(\tau \isasymMathOclValid A \triangleq \mocl{null} &) &= (& \tau \isasymMathOclValid \upsilon \; A \; \mocl{and} \; \mocl{not} \; (\delta \; A) &)\\ - (\tau \isasymMathOclValid A \triangleq \mocl{true} &) &= (& \tau \isasymMathOclValid A &) \\ - (\tau \isasymMathOclValid A \triangleq \mocl{false} &) &= (& \tau \isasymMathOclValid \mocl{not} \; A &) \\ - (\tau \isasymMathOclValid \mocl{not} \; (\delta \; X) &) &= (\lnot & \tau \isasymMathOclValid \delta \; X &) \\ - (\tau \isasymMathOclValid \mocl{not} \; (\upsilon \; X) &) &= (\lnot & \tau \isasymMathOclValid \upsilon \; X &) % (* UML_Logic.foundation7':*) -\end{array} -\end{gather*} -% (not A \<triangleq> not B) = (A \<triangleq> B) (*foundation21*) - -Thus with these rules, one can convert an \OCL formula represented in -its four-valued world into a representation that is classically -two-valued, and let the processing with standard SMT solvers such as -CVC3~\cite{barrett.ea:cvc3:2007} or -Z3~\cite{moura.ea:z3:2008}. $\delta$-closure rules for all logical -connectives have the following format (for example): -\begin{gather*} -\begin{array}{l@{\ap}c@{\ap}l@{\ap}c@{\ap}l} -\multicolumn{5}{l}{\tau \isasymMathOclValid \delta \ap X \Longrightarrow (\tau \isasymMathOclValid \ap\mocl{not}\ap X) = (\lnot (\tau \isasymMathOclValid X))} \\ -\tau \isasymMathOclValid \delta \ap X \Longrightarrow \tau \isasymMathOclValid \delta \ap Y \Longrightarrow (\tau \isasymMathOclValid X & \mocl{and} & Y) = ( (\tau \isasymMathOclValid X) & \land & (\tau \isasymMathOclValid Y)) \\ -\tau \isasymMathOclValid \delta \ap X \Longrightarrow \tau \isasymMathOclValid \delta \ap Y -\Longrightarrow (\tau \isasymMathOclValid X & \mocl{implies} & Y) = ( (\tau \isasymMathOclValid X) & \longrightarrow & (\tau \isasymMathOclValid Y)) -\end{array} -\end{gather*} -With the conjunction of these rules (comprising the above mentioned -case distinction: $\tau \isasymMathOclValid \delta \ap X \lor \tau -\isasymMathOclValid X \triangleq \mocl{invalid} \lor \tau -\isasymMathOclValid X \triangleq \mocl{null}$), we can automatically -proceed to the simplification of a formula by case analysis, in order -to quickly reach a contradiction, whenever we know that a variable $X$ -is $\mocl{invalid}$ or $\mocl{null}$. For example, we can infer from -an invariant $\tau \isasymMathOclValid X \isasymMathOclStrictEq Y -\;\mocl{-}\; \mocl{3}$ that we have $\tau \isasymMathOclValid X -\isasymMathOclStrictEq Y \;\mocl{-}\; \mocl{3} \land \tau -\isasymMathOclValid \delta \ap X \land \tau \isasymMathOclValid \delta -\ap Y$. We call the latter formula the $\delta$-closure of the -former. Now, we can convert a formula like $\tau \isasymMathOclValid -X \;\mocl{>}\; \mocl{0} \ap\mocl{or}\ap \mocl{3} \;\mocl{*}\; Y -\;\mocl{>}\; X \;\mocl{*}\; X$ into the equivalent formula $\tau -\isasymMathOclValid X \;\mocl{>}\; \mocl{0} \lor \tau -\isasymMathOclValid \mocl{3} \;\mocl{*}\; Y \;\mocl{>}\; X -\;\mocl{*}\; X$ and thus internalize the four-valued logic of \OCL, as -if we have a classical (and more tool-conform) logic. - -\subsection{Algebraic Layer} -Based on the logical layer, we build a system with simpler rules which -are amenable to automated reasoning. We restrict ourselves to pure -equations on \OCL expressions. - -Our denotational definitions on \inlineocl+not+ and \inlineocl+and+ -can be re-formulated in the following ground equations: -\begin{itemize} -\item $\upsilon \ap \_$: -\begin{gather*} - \begin{aligned} - \upsilon\; \mocl{invalid} &= \mocl{false}&\qquad - \upsilon\; \mocl{null} &= \mocl{true}\\ - \upsilon\; \mocl{true} &= \mocl{true}&\qquad - \upsilon\; \mocl{false} &= \mocl{true}\\ -\end{aligned} -\end{gather*} - -\item $\delta \ap \_$: -\begin{gather*} -\begin{aligned} - % - \delta\; \mocl{invalid} &= \mocl{false}&\qquad - \delta\; \mocl{null} &= \mocl{false}\\ - \delta\; \mocl{true} &= \mocl{true}&\qquad - \delta\; \mocl{false} &= \mocl{true}\\ -\end{aligned} -\end{gather*} - -\item $\mocl{not}$: -\begin{gather*} -\begin{aligned} - % - \mocl{not}\; \mocl{invalid} &= \mocl{invalid}&\qquad - \mocl{not}\; \mocl{null} &= \mocl{null}\\ - \mocl{not}\; \mocl{true} &= \mocl{false}&\qquad - \mocl{not}\; \mocl{false} &= \mocl{true}\\ -\end{aligned} -\end{gather*} - -\item $\mocl{and}$: -\begin{itemize} -\item $\mocl{invalid}$: -\begin{gather*} -\begin{aligned} - (\mocl{invalid} \;\mocl{and}\; \mocl{true}) &= \mocl{invalid}& - (\mocl{invalid} \;\mocl{and}\; \mocl{false}) &= \mocl{false}\\ - (\mocl{invalid} \;\mocl{and}\; \mocl{null}) &= \mocl{invalid}& - (\mocl{invalid} \;\mocl{and}\; \mocl{invalid}) &= \mocl{invalid}\\ -\end{aligned} -\end{gather*} - -\item $\mocl{null}$: -\begin{gather*} -\begin{aligned} - % - (\mocl{null} \;\mocl{and}\; \mocl{true}) &= \mocl{null}&\qquad - (\mocl{null} \;\mocl{and}\; \mocl{false}) &= \mocl{false}\\ - (\mocl{null} \;\mocl{and}\; \mocl{null}) &= \mocl{null}&\qquad - (\mocl{null} \;\mocl{and}\; \mocl{invalid}) &= \mocl{invalid}\\ -\end{aligned} -\end{gather*} - -\item $\mocl{true}$: -\begin{gather*} -\begin{aligned} - % - (\mocl{true} \;\mocl{and}\; \mocl{true}) &= \mocl{true}&\qquad - (\mocl{true} \;\mocl{and}\; \mocl{false}) &= \mocl{false}\\ - (\mocl{true} \;\mocl{and}\; \mocl{null}) &= \mocl{null}&\qquad - (\mocl{true} \;\mocl{and}\; \mocl{invalid}) &= \mocl{invalid} -\end{aligned} -\end{gather*} - -\item $\mocl{false}$: -\begin{gather*} -\begin{aligned} - % - (\mocl{false} \;\mocl{and}\; \mocl{true}) &= \mocl{false}&\qquad - (\mocl{false} \;\mocl{and}\; \mocl{false}) &= \mocl{false}\\ - (\mocl{false} \;\mocl{and}\; \mocl{null}) &= \mocl{false}&\qquad - (\mocl{false} \;\mocl{and}\; \mocl{invalid}) &= \mocl{false}\\ -\end{aligned} -\end{gather*} -\end{itemize} -\end{itemize} -On this core, the structure of a conventional lattice arises: -\begin{gather*} - \begin{aligned} - X \;\mocl{and}\; X &= X \\ - X \;\mocl{and}\; Y &= Y \;\mocl{and}\; X \\ - X \;\mocl{and}\; (Y \;\mocl{and}\; Z) &= X \;\mocl{and}\; Y \;\mocl{and}\; Z - \end{aligned}\\ - \begin{aligned} - \mocl{false} \;\mocl{and}\; X &= \mocl{false} &\qquad - X \;\mocl{and}\; \mocl{false} &= \mocl{false} \\ - \mocl{true} \;\mocl{and}\; X &= X &\qquad - X \;\mocl{and}\; \mocl{true} &= X - \end{aligned} -\end{gather*} -as well as the dual equalities for $\_ \;\mocl{or}\; \_$ and the De -Morgan rules. This wealth of algebraic properties makes the -understanding of the logic easier, and enables automated analysis: for -example, by computing the DNF of some invariant systems (by -term-rewriting techniques) which are a prerequisite for -$\delta$-closures. - -The above equations explain the behaviour for the most important -non-strict operations. The clarification of the exceptional behaviours -is of key importance for a semantic definition of the standard and the -major deviation point from -\HOLOCL~\cite{brucker.ea:hol-ocl:2008,brucker.ea:hol-ocl-book:2006} -to \FOCL as presented here. Expressed in algebraic equations, -``strictness-principles'' boil down to: -\begin{gather*} - \begin{aligned} - \mocl{invalid} \;\mocl{+}\; X &= \mocl{invalid} &\qquad - X \;\mocl{+}\; \mocl{invalid} &= \mocl{invalid}\\ - \mocl{invalid->including(}X\mocl{)} &= \mocl{invalid} &\qquad - \mocl{null->including(}X\mocl{)} &= \mocl{invalid}\\ - X \isasymMathOclStrictEq \mocl{invalid} &= \mocl{invalid}&\qquad - \mocl{invalid} \isasymMathOclStrictEq X &= \mocl{invalid} \\ - \end{aligned}\\ - \mocl{S->including(invalid)}=\mocl{invalid} \\ - X \isasymMathOclStrictEq X = (\mocl{if}\; \upsilon\; x\; \mocl{then true} - \;\mocl{else invalid endif}) \\ - \begin{aligned} - \mocl{1} \;\mocl{div}\; \mocl{0} &= \mocl{invalid} \quad &\quad - \mocl{1} \;\mocl{div}\; \mocl{null} &= \mocl{invalid} \\ - \mocl{invalid->isEmpty()}&=\mocl{invalid} \quad &\quad \mocl{null->isEmpty()}&=\mocl{null}\\ - \end{aligned}\\ -\end{gather*} - -Algebraic rules are also the key for execution and compilation -of \FOCL expressions. We derived, \eg: -\begin{gather*} -\delta\; \mocl{Set\{\}} = \mocl{true}\\ -\delta\; (X\mocl{->including(}x\mocl{)}) = \delta \ap X \;\mocl{and}\; - \upsilon \ap x\\ -\begin{aligned} -\mocl{Set\{\}->includes(}x\mocl{)} = (\mocl{if}\; \upsilon\; x\; &\mocl{then false}\\ -&\mocl{else invalid endif}) -\end{aligned}\\ -\begin{multlined} - {(X\mocl{->including(}x\mocl{)->includes(}y\mocl{)})=}\\ - \mbox{\hspace{3.2cm}}\qquad{\begin{aligned} - (&\mocl{if}\; \delta\; X\\ - &\mocl{then}\; -\begin{array}[t]{l} -\mocl{if}\; x \doteq y\\ -\mocl{then}\ap \mocl{true} \\ -\mocl{else}\ap X\mocl{->includes(}y\mocl{)}\\ -\mocl{endif} - \end{array}\\ -&\mocl{else invalid} \\ - &\mocl{endif}) - \end{aligned}} -\end{multlined} -\end{gather*} -As \inlineocl+Set{1,2}+ is only syntactic sugar for -\begin{ocl} - Set{}->including(1)->including(2) -\end{ocl} -an expression like \inlineocl+Set{1,2}->includes(null)+ becomes -decidable in \FOCL by applying these algebraic laws (which can give - rise to efficient compilations). The reader interested in the list of -``test-statements'' like: -\begin{isar}[mathescape] -value "\<tau> \<Turnstile> ($\mathtt{Set\{Set\{2,null\}\}}$ \<doteq> $\;\mathtt{Set\{Set\{null,2\}\}}$)" -\end{isar} -may consult \autoref{formal-set}; these test-statements - have been machine-checked and proven consistent with the denotational and logic - semantics of \FOCL. -% It fairly readable information for \OCL tool manufactures and users. - - -\subsection{Object-oriented Datatype Theories} -In the following, we will refine the concepts of a user-defined -data-model implied by a \emph{class-model} (\emph{visualized} by a class-\emph{diagram}) -as well as the notion of $\state{\isaAA}$ used in the -previous section to much more detail. \UML class models represent in a compact -and visual manner quite complex, object-oriented data-types with a surprisingly rich -theory. In this section, this theory is made explicit -and corner cases were pointed out. - -A \UML class model underlying a -given \OCL invariant or operation contract -produces several implicit operations which -become accessible via appropriate \OCL syntax. -A class model is a four-tuple $(C, \_ < \_, Attrib, Assoc)$ where: -\begin{enumerate} -\item $C$ is a set of class names (written as $\{C_1, \ldots, C_n\}$). To each class - name a type of data in \OCL is associated. Moreover, class names declare two projector - functions to the set of all objects in a state: - $C_i$\inlineocl{.allInstances()} and - $C_i$\inlineocl{.allInstances}$\isasymOclATpre$\inlineocl{()}, -\item $\_ < \_$ is an inheritance relation on classes, -\item $Attrib(C_i)$ is a collection of - attributes associated to classes $C_i$. It declares two families of accessors; for each attribute $a \in Attrib(C_i) $ in a - class definition $C_i$ (denoted - $\getAttrib{X}{\text{$a$}} :: C_i \rightarrow A $ and - $\getAttrib{X}{\text{$a$}\isasymOclATpre}:: C_i \rightarrow A $ for - $A\in TYPES$), -\item $Assoc(C_i,C_j)$ is a collection of associations\footnote{Given the fact that there is at present no consensus on the - semantics of n-ary associations, \FOCL{} restricts itself to binary associations. }. - An association $(n, rn_{from}, rn_{to})\in Assoc(C_i,C_j)$ between to classes - $C_i$ and $C_j$ is a triple consisting of a (unique) association name $n$, - and the role-names $rn_{to}$ and $rn_{from}$. To each role-name belong two - families of accessors denoted - $\getRole{X}{\text{$a$}} :: C_i \rightarrow A$ and - $\getRole{X}{\text{$a$}\isasymOclATpre}:: C_i \rightarrow A$ for - $A\in TYPES$), -\item for each pair $C_i < C_j$ ($C_i, C_j < C$), there is a - cast operation of type $C_j \rightarrow C_i$ that can change the static type - of an object of type $C_i$: - $\getAttrib{obj::C_i}{\mocl{oclAsType(}\text{$C_j$}\mocl{)}}$, -\item for each class $C_i\in C$, there are two dynamic type tests - ($\getAttrib{X}{\mocl{oclIsTypeOf(}\text{$C_i$}\mocl{)}}$ and - $\getAttrib{X}{\mocl{oclIsKindOf(}\text{$C_i$}\mocl{)}}$ ), -\item and last but not least, for each class name $C_i\in C$ there is an - instance of the overloaded referential equality (written $\_ - \isasymMathOclStrictEq \_$). -\end{enumerate} - - -Assuming a strong static type discipline in the sense of -Hindley-Milner types, \FOCL has no ``syntactic -subtyping.'' In contrast, sub-typing can be expressed -\emph{semantically} in \FOCL by adding suitable type-casts which do -have a formal semantics. Thus, sub-typing becomes an issue of the front-end -that can make implicit type-coercions explicit. Our perspective shifts the -emphasis on the semantic properties of casting, and the necessary universe of -object representations (induced by a class model) that allows to establish -them. - -As a pre-requisite of a denotational semantics for these operations induced -by a class-model, we need an \emph{object-universe} in which these operations can -be defined in a denotational manner and from which the necessary properties -for constructors, accessors, tests and casts -can be derived. A concrete universe constructed from a class model will be -used to instantiate the implicit type parameter $\isaAA$ of all \OCL operations -discussed so far. - -\subsubsection{A Denotational Space for Class-Models: Object Universes} - -It is natural to construct system states by a set of partial functions -$f$ that map object identifiers $\oid$ to some representations of -objects: -\begin{gather*} -\begin{array}{lll} - \record \ap \state{\isaAA} = & \operatorname{heap} & :: \oid \rightharpoonup {\isaAA} -\end{array} -\end{gather*} - -The key point is that we need a common type $\mathfrak{A}$ for the set of all -possible \emph{object representations}. Object representations model -``a piece of typed memory,'' \ie, a kind of record comprising -administration information and the information for all attributes of -an object; here, the primitive types as well as collections over them -are stored directly in the object representations, class types and -collections over them are represented by $\oid$'s (respectively lifted -collections over them). - -In a shallow embedding which must represent -\UML types one-to-one by HOL types, there are two fundamentally -different ways to construct such a set of object representations, -which we call an \emph{object universe} $\mathfrak{A}$: -\begin{enumerate} -\item an object universe can be constructed from a given class model, - leading to \emph{closed world semantics}, and -\item an object universe can be constructed for a given class model - \emph{and all its extensions by new classes added into the leaves of - the class hierarchy}, leading to an \emph{open world semantics}. -\end{enumerate} -For the sake of simplicity, the present semantics chose the first option for - \FOCL, while HOL-\OCL~\cite{brucker.ea:extensible:2008-b} -used an involved construction allowing the latter. - -A na\"ive attempt to construct $\mathfrak{A}$ would look like this: -the class type $C_i$ induced by a class will be the type of such an -object representation: $C_i \defeq (\oid \times \up{{a_{i_{1}}}} -\times \cdots \times \up{{a_{i_{n}}}} )$ where the types $a_{i_1}$, -\ldots, $a_{i_n}$ are the attribute types (including inherited -attributes) with class types substituted by $\oid$. The function -$\HolOclOidOf$ projects the first component, the $\oid$, out of an -object representation. Then the object universe will be constructed by -the type definition: -\begin{gather*} -\mathfrak{A} \defeq C_1 + \cdots + C_m\mi{.} -\end{gather*} -It is possible to define constructors, accessors, and the referential -equality on this object universe. However, the treatment of type casts -and type tests cannot be faithful with common object-oriented -semantics, be it in \UML or Java: casting up along the class hierarchy -can only be implemented by loosing information, such that casting up -and casting down will \emph{not} give the required identity, whenever $C_k < C_i$ and $X$ is valid: -\begin{gather*} - X.\mocl{oclIsTypeOf(}C_k\mocl{)} ~ ~ \mocl{implies} ~ ~ X\mocl{.oclAsType(}C_i\mocl{)}\mocl{.oclAsType(}C_k\mocl{)} \isasymMathOclStrictEq - X -\end{gather*} - -To overcome this limitation, we introduce an auxiliary type -$C_{i\text{ext}}$ for \emph{class type extension}; together, they were -inductively defined for a given class diagram: - -Let $C_i$ be a class with a possibly empty set of immediate subclasses -$C_{j_{1}}, \ldots, C_{j_{m}}$ ($C_{j_l} < C_i$). -\begin{itemize} -\item Then the \emph{class type extension} $C_{i\textup{ext}}$ - associated to $C_i$ is $\up{{a_{i_{1}}}} \times \cdots \times - \up{{a_{i_{h}}}} \times \up{(C_{j_{1}\textup{ext}} + \cdots + - C_{j_{m}\textup{ext}})}$ where $a_{i_{k}}$ ranges over the local - attribute types of $C_i$ (not inherited ones) and - $C_{j_{l}\textup{ext}}$ ranges over all class type extensions of - immediate subclasses $C_{j_{l}}$ of $C_i$. -\item Then the \emph{class type} $C_{i\textup{ty}}$ for $C_i$ is $\oid - \times \up{{a_{i_{1}}}} \times \cdots \times \up{{a_{i_{n}}}} \times - \up{(C_{j_{1}\textup{ext}} + \cdots + C_{j_{m}\textup{ext}})}$ where - $a_{i_{k}}$ ranges over the inherited \emph{and} local attribute - types of $C_i$ and $C_{j_{l}\textup{ext}}$ ranges over all class - type extensions of immediate subclasses $C_{j_{l}}$ of $C_i$. -\end{itemize} - -\isatagafp -Example instances of this scheme---outlining a compiler---can be found -in \autoref{ex:employee-analysis:uml} and \autoref{ex:employee-design:uml}. -\endisatagafp -\isatagannexa -Example instances of this scheme---outlining a compiler---can be found -in \autoref{ex:employee-analysis:uml}. -\endisatagannexa - -This construction can \emph{not} be done in HOL itself since it -involves quantifications and iterations over the ``set of class-types''; -rather, it is a meta-level construction. Technically, this means that -we need a compiler to be done in SML on the syntactic -``meta-model''-level of a class model. - -With respect to our semantic construction here, -which above all means is intended to be type-safe, this has the following consequences: -\begin{itemize} -\item there is a generic theory of states, which must be formulated independently - from a concrete object universe, -\item there is a principle of translation (captured by the inductive scheme for - class type extensions and class types above) that converts a given class model - into an concrete object universe, -\item there are fixed principles that allow to derive the semantic theory of any - concrete object universe, called the \emph{object-oriented datatype theory.} -\end{itemize} -\isatagafp -We will work out concrete examples for the construction of the -object-universes in \autoref{ex:employee-analysis:uml} and \autoref{ex:employee-design:uml} and the -derivation of the respective datatype theories. While an -automatization is clearly possible and desirable for concrete -applications of \FOCL, we consider this out of the scope -of this document which has a focus on the semantic construction and its -presentation. -\endisatagafp -\isatagannexa -We will work out concrete examples for the construction of the -object-universes in \autoref{ex:employee-analysis:uml} and the -derivation of the respective datatype theories. While an -automatization is clearly possible and desirable for concrete -applications of \FOCL, we consider this out of the scope -of this annex which has a focus on the semantic construction and its -presentation. -\endisatagannexa - - -\subsubsection{Denotational Semantics of Accessors on Objects and Associations} -Our choice to use a shallow embedding of \OCL in HOL and, thus having -an injective mapping from \OCL types to HOL types, results in -type-safety of \FOCL\@. Arguments and results of accessors -are based on type-safe object representations and \emph{not} $\oid$'s. -This implies the following scheme for an accessor: -\begin{itemize} -\item The \emph{evaluation and extraction} phase. If the argument - evaluation results in an object representation, the $\oid$ is - extracted, if not, exceptional cases like \inlineocl{invalid} are - reported. -\item The \emph{de-referentiation} phase. The $\oid$ is interpreted in - the pre- or post-state, %(depending on the suffix of accessor), - the resulting object is cast to the expected format. The - exceptional case of non-existence in this state must be treated. -\item The \emph{selection} phase. The corresponding attribute is - extracted from the object representation. -\item The \emph{re-construction} phase. The resulting value has to be - embedded in the adequate HOL type. If an attribute has the type of - an object (not value), it is represented by an optional (set of) - $\oid$, which must be converted via de-referentiation in one of the - states to produce an object representation again. The - exceptional case of non-existence in this state must be treated. -\end{itemize} - -The first phase directly translates into the following formalization: -\begin{gather*} - \begin{array}{r@{\ap}l@{\ap}l} - \isardef \ap \operatorname{eval\_extract} X\ap f = (\lambda \tau\spot \HolCase - X\ap \tau \HolOf & \bottom &\Rightarrow - \mocl{invalid}\ap\tau\\ - &\multicolumn{2}{r}{\text{propagating the exception}}\\ - |& \lift{\bottom} &\Rightarrow - \mocl{invalid}\ap\tau\\ - &\multicolumn{2}{r}{\text{dereferencing a null value}}\\ - |& \lift{\lift{\mathit{obj}}} &\Rightarrow f\ap (\HolOclOidOf \ap \mathit{obj})\ap\tau) - \end{array} -\end{gather*} - -For each class $C$, we introduce the de-referentiation phase of this -form: -\begin{multline*} - \isardef \ap - \operatorname{deref\_oid}_{C_i} \ap \mathit{fst\_snd}\ap f\ap \mathit{oid} = - (\lambda \tau\spot \HolCase\ap \operatorname{heap}\ap - (\mathit{fst\_snd}\ap \tau)\ap \mathit{oid}\ap - \HolOf\\ - \begin{array}{ll} - \phantom{|}\ap \lift{\operatorname{in}_{C_i} obj} &\Rightarrow f\ap - \mathit{obj} \ap \tau\\ - |\ap \_ &\Rightarrow \mocl{invalid}\ap \tau) - \end{array} - \end{multline*} -The operation yields undefined if $\mathit{oid}$ is not interpretable in the -state or referencing an object representation not conforming to the -expected type. - -We turn to the selection phase: for each class $C$ in the class model -with at least one attribute, -and each attribute $a$ in this class, -we introduce the selection phase of this form: -\begin{itemize} -\item for inherited attributes $a$ returning a base type: -\begin{gather*} - \begin{array}{r@{\ap}l@{\ap}c@{\ap}l} - \isardef \ap - \operatorname{select}_{C_i\_a} \ap f = (\lambda & - \operatorname{mk'}_{C_i} \ap oid & \cdots \bottom \cdots & \_ \Rightarrow \mocl{null}\\ - |& \operatorname{mk'}_{C_i} \ap oid & \cdots \lift{a} \cdots & \_ - \Rightarrow f\ap (\lambda \ap x \ap \_\spot - \lift{\lift{x}})\ap a) - \end{array} -\end{gather*} -\item for owned attributes $a$ returning a base type: -\begin{gather*} - \begin{array}{r@{\ap}l@{\ap}c@{\ap}l@{\quad\quad\ap\ap\ap}} - \isardef \ap - \operatorname{select}_{C_i\_a} \ap f = (\lambda & - \operatorname{mk'}_{C_i} \ap \_ \cdots (\operatorname{mk}_{C_i} & \cdots \bottom \cdots & ) \Rightarrow \mocl{null}\\ - |& \operatorname{mk'}_{C_i} \ap \_ \cdots (\operatorname{mk}_{C_i} & \cdots \lift{a} \cdots & ) - \Rightarrow \\ - & \multicolumn{3}{r}{f\ap (\lambda \ap x \ap \_\spot - \lift{\lift{x}})\ap a)} - \end{array} -\end{gather*} -\item for attributes $a$ returning a ``set'' of object type (for ``sequence'' it is similar): -\begin{multline*} - \isardef \ap - \operatorname{select}_{a}^{\operatorname{set}} \ap f = \\ - X_a \circ \ap \operatorname{foldl} \ap \operatorname{OclIncluding^{set}} \operatorname{mt^{set}} \circ \ap \operatorname{map} \ap (f \ap (\lambda \ap x \ap \_\spot - \lift{\lift{x}})) -\end{multline*} -\end{itemize} - -This works for definitions of basic values as well as for object -references in which the $a$ is of type $\oid$. To increase -readability, we introduce the functions: -\begin{gather*} -\begin{array}{llrlr} -\qquad\qquad&\isardef\enspace&\operatorname{in\_pre\_state} &= \operatorname{fst} & \qquad \text{first component}\\ -\qquad\qquad&\isardef\enspace&\operatorname{in\_post\_state} &= \operatorname{snd} & \qquad \text{second component} \\ -\qquad\qquad&\isardef\enspace&\operatorname{reconst\_basetype} &= \operatorname{id} & \qquad \text{identity function} -\end{array} -\end{gather*} - - -Let \_\inlineocl{.getB} be an owned accessor of class $C_j$ yielding a -value of base type $A\in \text{T}_{base}$. Then its definition for every class $C_i <^* C_j$ is of the form\footnote{We use an ad-hoc overloading mechanism for defining a family of functions, parameterised over $C_i$.}: -\begin{gather*} - \begin{array}{l@{\ap}l@{\ap}l} -\overloading&\_\mocl{.getB} &\ofType \ap C_i \Rightarrow A\\ -\IIbegin\\ -\isardef&X\mocl{.getB} &= \operatorname{eval\_extract}\ap X\ap - (\operatorname{deref\_oid}_{C_i}\ap \operatorname{in\_post\_state} \\ - & &\qquad\qquad (\operatorname{select}_{C_i\_\text{getB}}\ap \operatorname{reconst\_basetype}))\\ -\IIend - \end{array} -\end{gather*} - -Let \_\inlineocl{.getO} be an owned accessor of class $C_j$ yielding a -value of object type $C_k$ (or $\mocl{Set(}C_k\mocl{)}$ depending on the returned type of $\operatorname{select}_\text{getO}^{\operatorname{set}}$). Then its definition for every class $C_i <^* C_j$ is of the form: -\begin{gather*} - \begin{array}{l@{\ap}l@{\ap}l} -\overloading&\_\mocl{.getO} &\ofType \ap C_i \Rightarrow C_k \enskip \text{(or $\mocl{Set(}C_k\mocl{)}$ depending on $\operatorname{select}_\text{getO}^{\operatorname{set}}$)}\\ -\IIbegin\\ -\isardef&X\mocl{.getO} &= \operatorname{eval\_extract}\ap X\ap - (\operatorname{deref\_oid}_{C_i}\ap \operatorname{in\_post\_state} \\ - & &\qquad\qquad (\operatorname{deref\_assocs}_\text{getO} \ap \operatorname{in\_post\_state} \\ - & &\qquad\qquad (\operatorname{select}_\text{getO}^{\operatorname{set}}\ap - (\operatorname{deref\_oid}_{C_k}\ap\operatorname{in\_post\_state}))))\\ -\IIend - \end{array} -\end{gather*} -The variant for an accessor yielding a $\operatorname{TYPES}_0$ is -omitted here; its construction follows by the application of the -principles of the former two. The respective variants -$\getAttrib{\_}{\text{$a$}\isasymOclATpre}$ are produced when -\inlineisar+in_post_state+ is replaced by -$\operatorname{in\_pre\_state}$. - -\isatagafp -Examples for the construction of accessors via associations can be found in -\autoref{sec:eam-accessors}, the construction of accessors via attributes in -\autoref{sec:edm-accessors}. The construction of casts and type tests \inlineocl{->oclIsTypeOf()} and -\inlineocl{->oclIsKindOf()} is similarly. -\endisatagafp -\isatagannexa -Examples for the construction of accessors via associations can be found in -\autoref{sec:eam-accessors}. The construction of casts and type tests \inlineocl{->oclIsTypeOf()} and -\inlineocl{->oclIsKindOf()} is similarly. -\endisatagannexa - -In the following, we discuss the role of multiplicities on the types of the -accessors. -Depending on the specified multiplicity, the evaluation of an attribute can -yield just a value (multiplicity \inlineocl{0..1} or \inlineocl{1}) -or a collection type like Set or Sequence of values (otherwise). -A multiplicity defines a lower bound as well as a possibly infinite upper -bound on the cardinality of the attribute's values. - - -\paragraph{Single-Valued Attributes}\label{sec:single-valued-properties} -If the upper bound specified by the attribute's multiplicity is one, -then an evaluation of the attribute yields a single value. -Thus, the evaluation result is \emph{not} a collection. If the lower bound specified by the -multiplicity is zero, the evaluation is not required to yield a non-null value. In this case an -evaluation of the attribute can return $\isasymOclNull$ to indicate an -absence of value. - -To facilitate accessing attributes with multiplicity \inlineocl{0..1}, the \OCL -standard states that single values can be used as sets by calling collection -operations on them. This implicit conversion of a value to a -\inlineocl{Set} is not defined by the standard. We argue that the resulting set -cannot be constructed the same way as when evaluating a \inlineocl{Set} -literal. Otherwise, $\isasymOclNull$ would be mapped to the singleton set -containing $\isasymOclNull$, but the standard demands that -the resulting set is empty in this case. The conversion should instead -be defined as follows: -\begin{ocl} -context OclAny::asSet():T - post: if self = null then result = Set{} - else result = Set{self} endif -\end{ocl} -% Changed self.isTypeOf(\OCLVoid) to self = null to make it easier for the superficial reader - -\paragraph{Collection-Valued Attributes}\label{sec:collection-valued-properties} -If the upper bound specified by the attribute's multiplicity is larger than one, -then an evaluation of the attribute yields a collection of values. This raises -the question whether $\isasymOclNull$ can belong to this collection. The \OCL -standard states that $\isasymOclNull$ can be owned by collections. However, if -an attribute can evaluate to a collection containing $\isasymOclNull$, it is not -clear how multiplicity constraints should be interpreted for this attribute. The -question arises whether the $\isasymOclNull$ element should be counted or not -when determining the cardinality of the collection. Recall that $\isasymOclNull$ -denotes the absence of value in the case of a cardinality upper bound of one, so -we would assume that $\isasymOclNull$ is not counted. On the other hand, the -operation \inlineocl{size} defined for collections in \OCL does count -$\isasymOclNull$. - -We propose to resolve this dilemma by regarding multiplicities as optional. This -point of view complies with the \UML standard, that does not require lower and -upper bounds to be defined for multiplicities.\footnote{We are however aware - that a well-formedness rule of the \UML standard does define a default bound - of one in case a lower or upper bound is not specified.} In case a -multiplicity is specified for an attribute, \ie, a lower and an upper bound -are provided, we require for any collection the attribute evaluates to -a collection not containing $\isasymOclNull$. This allows for a straightforward -interpretation of -the multiplicity constraint. If bounds are not provided for an attribute, we -consider the attribute values to not be restricted in any way. Because in -particular the cardinality of the attribute's values is not bounded, the result -of an evaluation of the attribute is of collection type. As the range of values -that the attribute can assume is not restricted, the attribute can evaluate to a -collection containing $\isasymOclNull$. The attribute can also evaluate to -$\isasymOclInvalid$. Allowing multiplicities to be optional in this way gives -the modeler the freedom to define attributes that can assume the full ranges of -values provided by their types. However, we do not permit the omission of -multiplicities for association ends, since the values of association ends are -not only restricted by multiplicities, but also by other constraints enforcing -the semantics of associations. Hence, the values of association ends cannot be -completely unrestricted. - -\paragraph{The Precise Meaning of Multiplicity Constraints} -We are now ready to define the meaning of multiplicity constraints by giving -equivalent invariants written in \OCL\@. Let \inlineocl{a} be an attribute of a -class \inlineocl{C} with a multiplicity specifying a lower bound $m$ and an -upper bound $n$. Then we can define the multiplicity constraint on the values of -attribute \inlineocl{a} to be equivalent to the following invariants written in -\OCL: -\begin{ocl} -context C inv lowerBound: a->size() >= m - inv upperBound: a->size() <= n - inv notNull: not a->includes(null) -\end{ocl} -If the upper bound $n$ is infinite, the second invariant is omitted. For the -definition of these invariants we are making use of the conversion of single -values to sets described in \autoref{sec:single-valued-properties}. If $n -\leq 1$, the attribute \inlineocl{a} evaluates to a single value, which is then -converted to a \inlineocl{Set} on which the \inlineocl{size} operation is -called. - -If a value of the attribute \inlineocl{a} includes a reference to a non-existent -object, the attribute call evaluates to $\isasymOclInvalid$. As a result, the -entire expressions evaluate to $\isasymOclInvalid$, and the invariants are not -satisfied. Thus, references to non-existent objects are ruled out by these -invariants. We believe that this result is appropriate, since we argue that the -presence of such references in a system state is usually not intended and likely -to be the result of an error. If the modeler wishes to allow references to -non-existent objects, she can make use of the possibility described above to -omit the multiplicity. - -\subsubsection{Logic Properties of Class-Models}\label{sec:logicprop-datamodel} -In this section, we assume to have $C_z,C_i,C_j \in C$ and $C_i < C_j$. -Let $C_z$ be a smallest element with respect to the class hierarchy $\_ < \_$. -The operations induced from a class-model have the following properties: -\begin{gather*} - \tau \isasymMathOclValid (X :: C_i)\mocl{.oclAsType(}C_i\mocl{)} \isasymMathOclStrongEq X \\ - \tau \isasymMathOclValid \mocl{invalid .oclAsType(}C_i\mocl{)} \isasymMathOclStrongEq \mocl{invalid} \\ - \tau \isasymMathOclValid \mocl{null .oclAsType(}C_i\mocl{)} \isasymMathOclStrongEq \mocl{null} \\ - \tau \isasymMathOclValid (X::C_i)\mocl{.oclAsType(}C_j\mocl{) .oclAsType(}C_i\mocl{)} \isasymMathOclStrongEq X \\ - \tau \isasymMathOclValid (X::\mocl{OclAny})\mocl{.oclAsType(OclAny)} \isasymMathOclStrongEq X \\ - \tau \isasymMathOclValid \upsilon \ap (X :: C_i) \Longrightarrow - \tau \isasymMathOclValid X \mocl{.oclIsTypeOf(}C_i\mocl{)} \ap \mocl{implies} \ap (X \mocl{.oclAsType(}C_j\mocl{) .oclAsType(}C_i\mocl{)}) \isasymMathOclStrictEq X \\ - \tau \isasymMathOclValid \delta \ap X \Longrightarrow \tau \isasymMathOclValid (X::C_i)\mocl{.oclAsType(}C_j\mocl{) .oclAsType(}C_i\mocl{)} \isasymMathOclStrongEq X \\ - \tau \isasymMathOclValid (X::C_j)\mocl{.oclIsTypeOf(}C_j\mocl{)} \Longrightarrow \tau \isasymMathOclValid \delta \ap X \Longrightarrow \tau \isasymMathOclValid \mocl{not} \ap (\upsilon \ap X \mocl{.oclAsType(}C_i\mocl{)}) \\ - \tau \isasymMathOclValid \mocl{invalid .oclIsTypeOf(}C_i\mocl{)} \isasymMathOclStrongEq \mocl{invalid} \\ - \tau \isasymMathOclValid \mocl{null .oclIsTypeOf(}C_i\mocl{)} \isasymMathOclStrongEq \mocl{true} \\ - \tau \isasymMathOclValid C_z \mocl{.allInstances()->forAll(}X\mocl{|}X \mocl{.oclIsTypeOf(}C_z\mocl{))} \\ - \tau \isasymMathOclValid C_z \mocl{.allInstances@pre()->forAll(}X\mocl{|}X \mocl{.oclIsTypeOf(}C_z\mocl{))} \\ - \tau \isasymMathOclValid C_i \mocl{.allInstances()->forAll(}X\mocl{|}X \mocl{.oclIsKindOf(}C_j\mocl{))} \\ - \tau \isasymMathOclValid C_i \mocl{.allInstances@pre()->forAll(}X\mocl{|}X \mocl{.oclIsKindOf(}C_j\mocl{))} \\ - \tau \isasymMathOclValid (X::C_i)\mocl{.oclIsTypeOf(}C_j\mocl{)} \Longrightarrow \tau \isasymMathOclValid (X::C_i)\mocl{.oclIsKindOf(}C_j\mocl{)} \\ -(\tau \isasymMathOclValid (X::C_j) \isasymMathOclStrictEq X) = (\tau \isasymMathOclValid \mocl{if} \ap \upsilon \ap X \ap \mocl{then true else invalid endif}) \\ - \tau \isasymMathOclValid (X::C_j) \isasymMathOclStrictEq Y \Longrightarrow \tau \isasymMathOclValid Y \isasymMathOclStrictEq X \\ - \tau \isasymMathOclValid (X::C_j) \isasymMathOclStrictEq Y \Longrightarrow \tau \isasymMathOclValid Y \isasymMathOclStrictEq Z \Longrightarrow \tau \isasymMathOclValid X \isasymMathOclStrictEq Z \\ -\vdots -\end{gather*} - -\subsubsection{Algebraic Properties of the Class-Models}\label{sec:algprop-datamodel} -In this section, we assume to have $C_i,C_j \in C$ and $C_i < C_j$. -The operations induced from a class-model have the following properties: -\begin{gather*} -\begin{array}{ll} - \mocl{invalid .oclIsTypeOf(}C_i\mocl{)} = \mocl{invalid} \qquad - \mocl{null .oclIsTypeOf(}C_i\mocl{)} = \mocl{true} \\ - \mocl{invalid .oclIsKindOf(}C_i\mocl{)} = \mocl{invalid} \qquad - \mocl{null .oclIsKindOf(}C_i\mocl{)} = \mocl{true} \\ - \mocl{invalid .oclAsType(}C_i\mocl{)} = \mocl{invalid} \qquad - \mocl{null .oclAsType(}C_i\mocl{)} = \mocl{null} \\ - (X::C_i)\mocl{.oclAsType(}C_i\mocl{)} = X \qquad - (X::C_i)\mocl{.oclAsType(}C_j\mocl{).oclAsType(}C_i\mocl{)} = X -\end{array} \\ - ((X::C_i) \isasymMathOclStrictEq X) = (\mocl{if} \ap \upsilon ~ X \ap \mocl{then true else invalid endif}) \\ -\end{gather*} -With respect to attributes $\getAttrib{\_}{\text{a}}$ or $\getAttrib{\_}{\text{a}\isasymOclATpre}$ -and role-ends $\getAttrib{\_}{\text{r}}$ or $\getAttrib{\_}{\text{r}\isasymOclATpre}$ we have -\begin{gather*} - \getAttrib{\mocl{invalid}}{\text{a}} = \mocl{invalid} \qquad - \getAttrib{\mocl{null}}{\text{a}} = \mocl{invalid} \\ - \getAttrib{\mocl{invalid}}{\text{a}\isasymOclATpre} = \mocl{invalid} \qquad - \getAttrib{\mocl{null}}{\text{a}\isasymOclATpre} = \mocl{invalid} \\ - \getRole{\mocl{invalid}}{\text{r}} = \mocl{invalid} \qquad - \getRole{\mocl{null}}{\text{r}} = \mocl{invalid} \\ - \getRole{\mocl{invalid}}{\text{r}\isasymOclATpre} = \mocl{invalid} \qquad - \getRole{\mocl{null}}{\text{r}\isasymOclATpre} = \mocl{invalid} -\end{gather*} - -\subsubsection{Other Operations on States}\label{sec:otherStateOperations} -Defining $\_\isasymOclAllInstances$ -is straight-forward; the only difference is the property -$T\isasymOclAllInstances\isasymOclExcludes\mocl{(}\isasymOclNull\mocl{)}$ which is a -consequence of the fact that $\Null{}$'s are values and do not ``live'' in the -state. \OCL semantics admits states with ``dangling references,''; it is -the semantics of accessors or roles which maps these references to \mocl{invalid}, -which makes it possible to rule out these situations in invariants. - -%it is -%possible to define a counterpart to \inlineocl+_.oclIsNew()+ called -%\inlineocl+_.oclIsDeleted()+ which asks if an object id (represented by an object -%representation) is contained in the pre-state, but not the post-state. - -\OCL does not guarantee that an operation only modifies the path-expressions -mentioned in the postcondition, \ie, it allows arbitrary relations from -pre-states to post-states. This framing problem is well-known (one of the -suggested solutions is~\cite{kosiuczenko:specification:2006}). We define -\begin{ocl} - (S:Set(OclAny))->oclIsModifiedOnly():Boolean -\end{ocl} -where \inlineocl|S| is a set of object representations, encoding -a set of $\oid$'s. The semantics of this operator is defined such that -for any object whose $\oid$ is \emph{not }represented in \inlineocl|S| -and that is defined in pre and post state, the corresponding object representation will not change -in the state transition. A simplified presentation is as follows: -\begin{gather*} -I\semantics{X\isasymMathOclIsModifiedOnly} (\sigma, \sigma') \equiv - \begin{cases} - \isasymbottom & \text{if $X' = \bottom \lor \mocl{null}\in X'$} \\ - \lift{\isasymforall i \isasymin M\spot - \sigma~i = \sigma'~i} & \text{otherwise}\mi{.} - \end{cases} -\end{gather*} -where $X' = I\semantics{X} (\sigma, \sigma')$ and $M= -(\dom~\sigma\cap\dom~\sigma') - \{ \HolOclOidOf x |~x \in\drop{X'}\}$. Thus, if -we require in a postcondition \inlineocl|Set{}->oclIsModifiedOnly()| and exclude via -\inlineocl+_.oclIsNew()+ and \inlineocl+_.oclIsDeleted()+ the existence of new -or deleted objects, the operation is a query in the sense of the \OCL standard, \ie, -the \inlineocl|isQuery| property is true. So, whenever we have $ \tau -\isasymMathOclValid X\isasymOclExcluding\mocl{(}s.a\mocl{)}\isasymMathOclIsModifiedOnly$ and $ \tau -\isasymMathOclValid X\mocl{->forAll(}x\mocl{|}\mocl{not}(x \doteq s.a) \mocl{)}$, we can infer that $\tau -\isasymMathOclValid s.a \triangleq s.a\isasymOclATpre$. - - -\subsection{Data Invariants}\label{sec:invlogic} -Since the present \OCL semantics uses one interpretation function\footnote{This has been handled -differently in previous versions of the Annex A.}, we express the effect of \OCL terms -occurring in preconditions and invariants by a syntactic transformation $\__\text{pre}$ which -replaces: -\begin{itemize} -\item all accessor functions $\getAttrib{\_}{a}$ from the class model $a \in Attrib(C)$ by their -counterparts $\getAttrib{\_}{i\isasymOclATpre}$. For example, $(\getAttrib{\self}{salary} > -500)_\text{pre}$ is transformed to $(\getAttrib{\self}{salary\isasymOclATpre} > 500)$. -\item all role accessor functions $\getRole{\_}{rn_{from}}$ or $\getRole{\_}{rn_{to}}$ - within the class model (\ie, $(id, rn_{from}, rn_{to}) \in Assoc(C_i, C_j)$) - were replaced by their counterparts $\getRole{\_}{rn\isasymOclATpre}$. - For example, $(\getAttrib{\self}{boss} = null)_\text{pre}$ is transformed to - $\getAttrib{\self}{boss\isasymOclATpre} = null$. -\item The operation $\_\isasymOclAllInstances$ is also substituted by its -$\isasymOclATpre$ counterpart. -\end{itemize} -Thus, we formulate the semantics of the invariant specification as follows: -\begin{gather*} -\begin{aligned} -& I\semantics{\mathtt{context}~c:C_i~\mathtt{inv}~n: \phi(c)} \tau \equiv \\ -&\qquad \tau \isasymMathOclValid (C_i\isasymOclAllInstances\isasymOclForAll(x -\text{|} \phi(x)))~\land \\ -&\qquad \tau \isasymMathOclValid (C_i\isasymOclAllInstances\isasymOclForAll(x -\text{|} \phi(x)))_\text{pre} -\end{aligned} -\end{gather*} -Recall that expressions containing $\isasymOclATpre$ constructs in -invariants or preconditions are syntactically forbidden; thus, mixed forms cannot arise. - -\subsection{Operation Contracts} -Since operations have strict semantics in \OCL, we have to distinguish for a specification of an -operation $\mathit{op}$ with the arguments $a_1$, \ldots, $a_n$ the -two cases where all arguments are valid and additionally, $\self$ is non-null (\ie, it must be defined), or not. -In former case, a method call can be replaced by a $\mathit{result}$ -that satisfies the contract, in the latter case the result is -\mocl{invalid}. This is reflected by the following definition of the contract semantics: -\begin{gather*} -\begin{aligned} - I\semantics{& \mathtt{context}~C~:: \mathit{op}(a_1, \ldots, a_n) : T \\ - & \qquad\mathtt{pre}~ \phi(\self, a_1, \ldots, a_n) \\ - & \qquad\mathtt{post}~\psi(\self, a_1, \ldots, a_n, \mathit{result})} \equiv \\ - & \qquad \quad \lambda s, x_1, \ldots, x_n, \tau. \\ - & \qquad\qquad \text{if} ~ ~ \tau -\isasymMathOclValid \isasymMathOclIsDefined s \land \tau \isasymMathOclValid -\isasymupsilon~x_1 \land \ldots \land \tau \isasymMathOclValid -\isasymupsilon~ x_n \\ - & \qquad\qquad \text{then} ~ \text{SOME}~ \mathit{result}. ~ ~ ~ ~\tau \isasymMathOclValid \phi(s, x_1, \ldots, x_n)_\text{pre} \\ - & \qquad\qquad\qquad\qquad\qquad\qquad ~ ~ \land \tau \isasymMathOclValid \psi(s, x_1, \ldots, x_n, \mathit{result}))\\ - &\qquad\qquad \text{else} ~ \isasymMathOclUndefined -\end{aligned} -\end{gather*} -where $\text{SOME}~ x. ~P(x)$ is the Hilbert-Choice Operator that -chooses an arbitrary element satisfying $P$; if such an element does not exist, it chooses -an arbitrary one\footnote{In \HOL, the Hilbert-Choice operator is a first-class element of -the logical language.}. Thus, using the Hilbert-Choice Operator, a contract can be associated -to a function definition: -\begin{gather*} - f_{op} \equiv I\semantics{ \mathtt{context}~C~:: \mathit{op}(a_1, \ldots, a_n) : T \ldots } -\end{gather*} -provided that neither $\phi$ nor $\psi$ contain recursive method calls of $\mathit{op}$. -In the case of a query operation (\ie, $\tau$ must have the form: $(\sigma,\sigma)$, which -means that query operations do not change the state; c.f. \mocl{oclIsModifiedOnly()} in -\autoref{sec:otherStateOperations}), this constraint can be relaxed: the above -equation is then stated as \emph{axiom}. Note however, that the consistency of the overall -theory is for recursive query contracts left to the user (it can be shown, for example, by a proof -of termination, \ie, by showing that all recursive calls were applied to argument vectors that are -smaller wrt. a well-founded ordering). Under this condition, an $f_{op}$ resulting from recursive -query operations can be used safely inside pre- and post-conditions of other contracts. - -For the general case of a user-defined contract, the following rule can be established -that reduces the proof of a property $E$ over a method call $f_{op}$ to a proof -of $E(res)$ (where $res$ must be one of the values that satisfy the post-condition $\psi$): -\begin{gather*} - \begin{prooftree} - \[ \big[ \tau \isasymMathOclValid \psi~self~a_1\ldots a_n~res \big]_{res} - \leadsto - \tau \isasymMathOclValid E(res) - \] - \justifies - \tau \isasymMathOclValid E(f_{op}~self~a_1 \ldots a_n) - \end{prooftree} -\end{gather*} -under the conditions: -\begin{itemize} -\item $E$ must be an \OCL term and -\item $\self$ must be defined, and the arguments valid in $\tau$: \\ - $\tau \isasymMathOclValid \isasymMathOclIsDefined~\self \land \tau \isasymMathOclValid \isasymupsilon~a_1 \land \ldots \land \tau \isasymMathOclValid \isasymupsilon~ a_n$ -\item the post-condition must be satisfiable (``the operation must be implementable''): - $\exists res.~ \tau \isasymMathOclValid \psi ~\self ~a_1 \ldots a_n~res $. -\end{itemize} -For the special case of a (recursive) query method, this rule can be specialized to the following -executable ``unfolding principle'': -\begin{gather*} - \begin{prooftree} - \tau \isasymMathOclValid \phi~self~a_1\ldots a_n - \justifies - (\tau \isasymMathOclValid E(f_{op}~self~a_1\ldots a_n)) = e - (\tau \isasymMathOclValid E (BODY~self~a_1 - \cdots a_n)) - \end{prooftree} -\end{gather*} -where -\begin{itemize} -\item $E$ must be an \OCL term. -\item $\self$ must be defined, and the arguments valid in $\tau$: \\ - $\tau \isasymMathOclValid \isasymMathOclIsDefined~\self \land \tau \isasymMathOclValid \isasymupsilon~a_1 \land \ldots \land \tau \isasymMathOclValid \isasymupsilon~ a_n$ -\item the postcondition $\psi~self~a_1~\ldots~a_n~result$ must be decomposable - into: \\ - $\psi'~self~a_1~\ldots a_n$ and $result \isasymMathOclStrongEq BODY~self~a_1~\ldots~a_n$. -\end{itemize} -Currently, \FOCL neither supports overloading nor overriding for -user-defined operations: the \FOCL compiler needs to be extended to -generate pre-conditions that constrain the classes on which an -overridden function can be called as well as the dispatch order. This -construction, overall, is similar to the virtual function table that, -e.g., is generated by C++ compilers. Moreover, to avoid logical -contradictions (inconsistencies) between different instances of an -overridden operation, the user has to prove Liskov's principle for -these situations: pre-conditions of the superclass must imply -pre-conditions of the subclass, and post-conditions of a subclass must -imply post-conditions of the superclass. - -%%% Local Variables: -%%% mode: latex -%%% TeX-master: "root" -%%% End: - -% LocalWords: \UML \OCL implementors RFP OMG provers invariants -% LocalWords: wellfounded Denotational equalities diff --git a/Citadelle/src/document/lstisar.sty b/Citadelle/src/document/lstisar.sty deleted file mode 100644 index aa1de3bfacd801271ce27f069cff564e29b8a975..0000000000000000000000000000000000000000 --- a/Citadelle/src/document/lstisar.sty +++ /dev/null @@ -1,423 +0,0 @@ - -\definecolor{OliveGreen} {cmyk}{0.64,0,0.95,0.40} -\definecolor{BrickRed} {cmyk}{0,0.89,0.94,0.28} -\definecolor{Blue} {cmyk}{1,1,0,0} -\definecolor{CornflowerBlue}{cmyk}{0.65,0.13,0,0} - -\newcommand{\subscr}[1]{\ensuremath{_{\mbox{#1}}}} -\newcommand{\supscr}[1]{\ensuremath{^{\mbox{#1}}}} -\lstdefinestyle{ISAR}{language=,% - basicstyle=\rmfamily,% - showspaces=false,% - showlines=false, - columns=flexible,% - morecomment=[s]{(*}{*)},% - morecomment=[s]{\{*}{*\}},% - morestring=*[b]",% - showstringspaces=false, - moredelim=*[is][\subscr]{\\<^bsub>}{\\<^esub>},% - moredelim=*[is][\supscr]{\\<^bsup>}{\\<^esup>},% - literate={% -%{\\<ZZ>}{\ensuremath{\mathfrak{Z}}}1%requires eufrak -%{\\<zz>}{\ensuremath{\mathfrak{z}}}1%requires eufrak -{\\<zeta>}{\ensuremath{\zeta}}1% -%{\\<z>}{\ensuremath{\mathrm{z}}}1% -%{\\<Z>}{\ensuremath{\mathcal{Z}}}1% -%{\\<YY>}{\ensuremath{\mathfrak{Y}}}1%requires eufrak -%{\\<yy>}{\ensuremath{\mathfrak{y}}}1%requires eufrak -%{\\<y>}{\ensuremath{\mathrm{y}}}1% -%{\\<Y>}{\ensuremath{\mathcal{Y}}}1% -%{\\<yen>}{\mbox{\yen}}1%requires amssymb,% -%{\\<XX>}{\ensuremath{\mathfrak{X}}}1%requires eufrak -%{\\<xx>}{\ensuremath{\mathfrak{x}}}1%requires eufrak -{\\<Xi>}{\ensuremath{\Xi}}1% -{\\<xi>}{\ensuremath{\xi}}1% -%{\\<x>}{\ensuremath{\mathrm{x}}}1% -%{\\<X>}{\ensuremath{\mathcal{X}}}1% -%{\\<WW>}{\ensuremath{\mathfrak{W}}}1%requires eufrak -%{\\<ww>}{\ensuremath{\mathfrak{w}}}1%requires eufrak -{\\<wrong>}{\ensuremath{\wr}}1% -{\\<wp>}{\ensuremath{\wp}}1% -%{\\<w>}{\ensuremath{\mathrm{w}}}1% -%{\\<W>}{\ensuremath{\mathcal{W}}}1% -%{\\<VV>}{\ensuremath{\mathfrak{V}}}1%requires eufrak -%{\\<vv>}{\ensuremath{\mathfrak{v}}}1%requires eufrak -%{\\<v>}{\ensuremath{\mathrm{v}}}1% -%{\\<V>}{\ensuremath{\mathcal{V}}}1% -%{\\<UU>}{\ensuremath{\mathfrak{U}}}1%requires eufrak -%{\\<uu>}{\ensuremath{\mathfrak{u}}}1%requires eufrak -{\\<Upsilon>}{\ensuremath{\Upsilon}}1% -{\\<upsilon>}{\ensuremath{\upsilon}}1% -{\\<uplus>}{\ensuremath{\uplus}}1% -{\\<Uplus>}{\ensuremath{\biguplus\,}}1% -{\\<Up>}{\ensuremath{\Uparrow}}1% -{\\<up>}{\ensuremath{\uparrow}}1% -{\\<Updown>}{\ensuremath{\Updownarrow}}1% -{\\<updown>}{\ensuremath{\updownarrow}}1% -{\\<unrhd>}{\ensuremath{\unrhd}}1% -{\\<^sub>}{\textsubscript}0% -{\\<unlhd>}{\ensuremath{\unlhd}}1% -{\\<union>}{\ensuremath{\cup}}1% -{\\<Union>}{\ensuremath{\bigcup\,}}1% -%{\\<u>}{\ensuremath{\mathrm{u}}}1% -%{\\<U>}{\ensuremath{\mathcal{U}}}1% -{\\<twosuperior>}{\ensuremath{\mathtwosuperior}}1%requires latin1,% -{\\<turnstile>}{\ensuremath{\vdash}}1% -{\\<Turnstile>}{\ensuremath{\models}}1% -{\\<models>}{\ensuremath{\models}}1% -{\\<tturnstile>}{\ensuremath{\vdash\!\!\!\vdash}}1% -{\\<TTurnstile>}{\ensuremath{\mid\!\models}}1% -%{\\<TT>}{\ensuremath{\mathfrak{T}}}1%requires eufrak -%{\\<tt>}{\ensuremath{\mathfrak{t}}}1%requires eufrak -{\\<triangleright>}{\ensuremath{\triangleright}}1% -{\\<triangleq>}{\ensuremath{\triangleq}}1%requires amssymb,% -{\\<triangleleft>}{\ensuremath{\triangleleft}}1% -{\\<triangle>}{\ensuremath{\triangle}}1% -{\\<top>}{\ensuremath{\top}}1% -{\\<times>}{\ensuremath{\times}}1% -{\\<threesuperior>}{\ensuremath{\maththreesuperior}}1%requires latin1,% -{\\<threequarters>}{\mbox{\rm\textthreequarters}}1%requires latin1,% -{\\<theta>}{\ensuremath{\vartheta}}1% -{\\<Theta>}{\ensuremath{\Theta}}1% -%{\\<t>}{\ensuremath{\mathrm{t}}}1% -%{\\<T>}{\ensuremath{\mathcal{T}}}1% -{\\<tau>}{\ensuremath{\tau}}1% -{\\<surd>}{\ensuremath{\surd}}1% -{\\<supseteq>}{\ensuremath{\supseteq}}1% -{\\<supset>}{\ensuremath{\supset}}1% -{\\<Sum>}{\ensuremath{\sum\,}}1% -{\\<succeq>}{\ensuremath{\succeq}}1% -{\\<succ>}{\ensuremath{\succ}}1% -{\\<subseteq>}{\ensuremath{\subseteq}}1% -{\\<subset>}{\ensuremath{\subset}}1% -{\\<struct>}{\ensuremath{\diamond}}1% -{\\<stileturn>}{\ensuremath{\dashv}}1% -{\\<star>}{\ensuremath{\star}}1% -%{\\<SS>}{\ensuremath{\mathfrak{S}}}1%requires eufrak -%{\\<ss>}{\ensuremath{\mathfrak{s}}}1%requires eufrak -%{\\<squnion>}{\ensuremath{\sqcup}}1% -%{\\<Squnion>}{\ensuremath{\bigsqcup\,}}1% -%{\\<sqsupseteq>}{\ensuremath{\sqsupseteq}}1% -%{\\<sqsupset>}{\ensuremath{\sqsupset}}1%requires amssym,% -%{\\<sqsubseteq>}{\ensuremath{\sqsubseteq}}1% -{\\<sqsubset>}{\ensuremath{\sqsubset}}1% -%{\\<sqinter>}{\ensuremath{\sqcap}}1% -%{\\<Sqinter>}{\ensuremath{\bigsqcap\,}}1%requires masmath,% -%{\\<spadesuit>}{\ensuremath{\spadesuit}}1% -%{\\<spacespace>}{\ensuremath{~~}}1% -%{\\<smile>}{\ensuremath{\smile}}1% -{\\<simeq>}{\ensuremath{\simeq}}1% -{\\<sim>}{\ensuremath{\sim}}1% -{\\<Sigma>}{\ensuremath{\Sigma}}1% -{\\<sigma>}{\ensuremath{\sigma}}1% -{\\<sharp>}{\ensuremath{\sharp}}1% -%{\\<s>}{\ensuremath{\mathrm{s}}}1% -%{\\<S>}{\ensuremath{\mathcal{S}}}1% -{\\<section>}{\mbox{\rm\S}}1% -%{\\<RR>}{\ensuremath{\mathfrak{R}}}1%requires eufrak -%{\\<rr>}{\ensuremath{\mathfrak{r}}}1%requires eufrak -{\\<rparr>}{\ensuremath{\mathclose{\mid\mkern-3mu)}}}1% -{\\<rightleftharpoons>}{\ensuremath{\rightleftharpoons}}2% -{\\<rightharpoonup>}{\ensuremath{\rightharpoonup}}2% -%{\\<rightharpoondown>}{\ensuremath{\rightharpoondown}}1% -{\\<Rightarrow>}{\ensuremath{\Rightarrow}}2% -{\\<rightarrow>}{\ensuremath{\rightarrow}}2% -{\\<restriction>}{\ensuremath{\restriction}}2% -{\\<rho>}{\ensuremath{\varrho}}1% -%{\\<rhd>}{\ensuremath{\rhd}}1% -{\\<rfloor>}{\ensuremath{\rfloor}}1% -%{\\<r>}{\ensuremath{\mathrm{r}}}1% -%{\\<R>}{\ensuremath{\mathcal{R}}}1% -%{\\<registered>}{\mbox{\rm\textregistered}}1% -%{\\<Re>}{\ensuremath{\Re}}1% -%{\\<real>}{\ensuremath{\mathrm{I}\mkern-3.8mu\mathrm{R}}}1% -{\\<rceil>}{\ensuremath{\rceil}}1% -{\\<rbrakk>}{\ensuremath{\mathclose{\rbrack\mkern-3mu\rbrack}}}1% -{\\<rbrace>}{\ensuremath{\mathclose{\mid\mkern-4.5mu\rbrace}}}1% -%{\\<rat>}{\ensuremath{\mathrm{Q}\mkern-16mu{\phantom{\mathrm{t}}\vrule}\mkern10mu}}1% -{\\<rangle>}{\ensuremath{\rangle}}1% -%{\\<questiondown>}{\mbox{\rm\textquestiondown}}1% -%{\\<QQ>}{\ensuremath{\mathfrak{Q}}}1%requires eufrak -%{\\<qq>}{\ensuremath{\mathfrak{q}}}1%requires eufrak -%{\\<q>}{\ensuremath{\mathrm{q}}}1% -%{\\<Q>}{\ensuremath{\mathcal{Q}}}1% -{\\<Psi>}{\ensuremath{\Psi}}1% -{\\<psi>}{\ensuremath{\psi}}1% -{\\<propto>}{\ensuremath{\propto}}1% -{\\<Prod>}{\ensuremath{\prod\,}}1% -{\\<preceq>}{\ensuremath{\preceq}}1% -{\\<prec>}{\ensuremath{\prec}}1% -%{\\<PP>}{\ensuremath{\mathfrak{P}}}1%requires eufrak -%{\\<pp>}{\ensuremath{\mathfrak{p}}}1%requires eufrak -%{\\<pounds>}{\ensuremath{\pounds}}1% -{\\<plusminus>}{\ensuremath{\pm}}1% -{\\<Pi>}{\ensuremath{\Pi}}1% -{\\<pi>}{\ensuremath{\pi}}1% -{\\<phi>}{\ensuremath{\varphi}}1% -{\\<Phi>}{\ensuremath{\Phi}}1% -%{\\<p>}{\ensuremath{\mathrm{p}}}1% -%{\\<P>}{\ensuremath{\mathcal{P}}}1% -{\\<partial>}{\ensuremath{\partial}}1% -{\\<parallel>}{\ensuremath{\parallel}}1% -{\\<paragraph>}{\mbox{\rm\P}}1% -{\\<otimes>}{\ensuremath{\otimes}}1% -{\\<Otimes>}{\ensuremath{\bigotimes\,}}1% -%{\\<oslash>}{\ensuremath{\oslash}}1% -{\\<or>}{\ensuremath{\vee}}1% -{\\<Or>}{\ensuremath{\bigvee}}1% -%{\\<ordmasculine>}{\mbox{\rm\textordmasculine}}1% -%{\\<ordfeminine>}{\mbox{\rm\textordfeminine}}1% -{\\<oplus>}{\ensuremath{\oplus}}1% -{\\<Oplus>}{\ensuremath{\bigoplus\,}}1% -%{\\<OO>}{\ensuremath{\mathfrak{O}}}1%requires eufrak -%{\\<oo>}{\ensuremath{\mathfrak{o}}}1%requires eufrak -%{\\<onesuperior>}{\ensuremath{\mathonesuperior}}1%requires latin1,% -%{\\<onequarter>}{\mbox{\rm\textonequarter}}1%requires latin1,% -%{\\<onehalf>}{\mbox{\rm\textonehalf}}1%requires latin1,% -{\\<ominus>}{\ensuremath{\ominus}}1% -%{\\<Omega>}{\ensuremath{\Omega}}1% -%{\\<omega>}{\ensuremath{\omega}}1% -%{\\<ointegral>}{\ensuremath{\oint\,}}1% -%{\\<o>}{\ensuremath{\mathrm{o}}}1% -%{\\<O>}{\ensuremath{\mathcal{O}}}1% -{\\<odot>}{\ensuremath{\odot}}1% -{\\<Odot>}{\ensuremath{\bigodot\,}}1% -{\\<nu>}{\ensuremath{\nu}}1% -{\\<notin>}{\ensuremath{\notin}}1% -{\\<noteq>}{\ensuremath{\neq}}1% -{\\<not>}{\ensuremath{\neg}}1% -%{\\<NN>}{\ensuremath{\mathfrak{N}}}1%requires eufrak -%{\\<nn>}{\ensuremath{\mathfrak{n}}}1%requires eufrak -%{\\<n>}{\ensuremath{\mathrm{n}}}1% -%{\\<N>}{\ensuremath{\mathcal{N}}}1% -%{\\<natural>}{\ensuremath{\natural}}1% -{\\<nat>}{\ensuremath{\mathrm{I}\mkern-3.8mu\mathrm{N}}}1% -{\\<nabla>}{\ensuremath{\nabla}}1% -{\\<mu>}{\ensuremath{\mu}}1% -%{\\<MM>}{\ensuremath{\mathfrak{M}}}1%requires eufrak -%{\\<mm>}{\ensuremath{\mathfrak{m}}}1%requires eufrak -{\\<minusplus>}{\ensuremath{\mp}}1% -{\\<Midarrow>}{\ensuremath{\Relbar}}1% -{\\<midarrow>}{\ensuremath{\relbar}}1% -{\\<mho>}{\ensuremath{\mho}}1%requires amssym,% -%{\\<m>}{\ensuremath{\mathrm{m}}}1% -%{\\<M>}{\ensuremath{\mathcal{M}}}1% -{\\<mapsto>}{\ensuremath{\mapsto}}1% -{\\<lparr>}{\ensuremath{\mathopen{(\mkern-3mu\mid}}}1% -%{\\<lozenge>}{\ensuremath{\lozenge}}1%requires amssym,% -{\\<Longrightarrow>}{\ensuremath{\Longrightarrow}}3% -{\\<longrightarrow>}{\ensuremath{\longrightarrow}}3% -{\\<implies>}{\ensuremath{\longrightarrow}}4% -{\\<longmapsto>}{\ensuremath{\longmapsto}}3% -{\\<Longleftrightarrow>}{\ensuremath{\Longleftrightarrow}}3% -{\\<longleftrightarrow>}{\ensuremath{\longleftrightarrow}}3% -{\\<Longleftarrow>}{\ensuremath{\Longleftarrow}}3% -{\\<longleftarrow>}{\ensuremath{\longleftarrow}}3% -{\\<lless>}{\ensuremath{\ll}}1% -%{\\<LL>}{\ensuremath{\mathfrak{L}}}1%requires eufrak -%{\\<ll>}{\ensuremath{\mathfrak{l}}}1%requires eufrak -%{\\<lhd>}{\ensuremath{\lhd}}1% -{\\<lfloor>}{\ensuremath{\lfloor}}1% -{\\<lesssim>}{\ensuremath{\lesssim}}1%requires amssymb,% -%{\\<lessapprox>}{\ensuremath{\lessapprox}}1%requires amssymb,% -%{\\<l>}{\ensuremath{\mathrm{l}}}1% -%{\\<L>}{\ensuremath{\mathcal{L}}}1% -{\\<Leftrightarrow>}{\ensuremath{\Leftrightarrow}}1% -{\\<leftrightarrow>}{\ensuremath{\leftrightarrow}}1% -%{\\<leftharpoonup>}{\ensuremath{\leftharpoonup}}1% -%{\\<leftharpoondown>}{\ensuremath{\leftharpoondown}}1% -{\\<Leftarrow>}{\ensuremath{\Leftarrow}}1% -{\\<leftarrow>}{\ensuremath{\leftarrow}}1% -{\\<le>}{\ensuremath{\le}}1% -{\\<leadsto>}{\ensuremath{\leadsto}}2%requires amssym,% -{\\<lceil>}{\ensuremath{\lceil}}1% -{\\<lbrakk>}{\ensuremath{\mathopen{\lbrack\mkern-3mu\lbrack}}}1% -{\\<lbrace>}{\ensuremath{\mathopen{\lbrace\mkern-4.5mu\mid}}}1% -{\\<langle>}{\ensuremath{\langle}}1% -{\\<Lambda>}{\ensuremath{\Lambda}}1% -{\\<lambda>}{\ensuremath{\lambda}}1% -%{\\<KK>}{\ensuremath{\mathfrak{K}}}1%requires eufrak -%{\\<kk>}{\ensuremath{\mathfrak{k}}}1%requires eufrak -%{\\<k>}{\ensuremath{\mathrm{k}}}1% -%{\\<K>}{\ensuremath{\mathcal{K}}}1% -{\\<kappa>}{\ensuremath{\kappa}}1% -{\\<Join>}{\ensuremath{\Join}}1%requires amssym,% -%{\\<JJ>}{\ensuremath{\mathfrak{J}}}1%requires eufrak -%{\\<jj>}{\ensuremath{\mathfrak{j}}}1%requires eufrak -%{\\<j>}{\ensuremath{\mathrm{j}}}1% -%{\\<J>}{\ensuremath{\mathcal{J}}}1% -{ISABELLE}{\$ISABELLE}8% -{\\<iota>}{\ensuremath{\iota}}1% -{\\<inverse>}{\ensuremath{{}^{-1}}}1% -{\\<inter>}{\ensuremath{\cap}}1% -{\\<Inter>}{\ensuremath{\bigcap\,}}1% -{\\<int>}{\ensuremath{\mathsf{Z}\mkern-7.5mu\mathsf{Z}}}1% -{\\<integral>}{\ensuremath{\int\,}}1% -{\\<infinity>}{\ensuremath{\infty}}1% -{\\<in>}{\ensuremath{\in}}1% -{\\<index>}{\mbox{\i}}1% -%{\\<Im>}{\ensuremath{\Im}}1% -%{\\<II>}{\ensuremath{\mathfrak{I}}}1%requires eufrak -%{\\<ii>}{\ensuremath{\mathfrak{i}}}1%requires eufrak -%{\\<i>}{\ensuremath{\mathrm{i}}}1% -%{\\<I>}{\ensuremath{\mathcal{I}}}1% -%{\\<hyphen>}{\mbox{\rm-}}1% -%{\\<hungarumlaut>}{\mbox{\H\relax}}1% -{\\<hookrightarrow>}{\ensuremath{\hookrightarrow}}1% -{\\<hookleftarrow>}{\ensuremath{\hookleftarrow}}1% -%{\\<HH>}{\ensuremath{\mathfrak{H}}}1%requires eufrak -%{\\<hh>}{\ensuremath{\mathfrak{h}}}1%requires eufrak -%{\\<h>}{\ensuremath{\mathrm{h}}}1% -%{\\<H>}{\ensuremath{\mathcal{H}}}1% -%{\\<heartsuit>}{\ensuremath{\heartsuit}}1% -%{\\<guillemotright>}{\mbox{\frqq}}1%requires babel ,% -%{\\<guillemotleft>}{\mbox{\flqq}}1%requires babel ,% -{\\<greatersim>}{\ensuremath{\gtrsim}}1%requires amssymb,% -{\\<greaterapprox>}{\ensuremath{\gtrapprox}}1%requires amssymb,% -{\\<ggreater>}{\ensuremath{\gg}}1% -%{\\<GG>}{\ensuremath{\mathfrak{G}}}1%requires eufrak -%{\\<gg>}{\ensuremath{\mathfrak{g}}}1%requires eufrak -%{\\<g>}{\ensuremath{\mathrm{g}}}1% -%{\\<G>}{\ensuremath{\mathcal{G}}}1% -{\\<ge>}{\ensuremath{\ge}}1% -{\\<Gamma>}{\ensuremath{\Gamma}}1% -{\\<gamma>}{\ensuremath{\gamma}}1% -{\\<frown>}{\ensuremath{\frown}}1% -{\\<forall>}{\ensuremath{\forall\,}}1% -{\\<Forall>}{\ensuremath{\bigwedge\,}}1% -{\\<flat>}{\ensuremath{\flat}}1% -%{\\<FF>}{\ensuremath{\mathfrak{F}}}1%requires eufrak -%{\\<ff>}{\ensuremath{\mathfrak{f}}}1%requires eufrak -%{\\<f>}{\ensuremath{\mathrm{f}}}1% -%{\\<F>}{\ensuremath{\mathcal{F}}}1% -{\\<exists>}{\ensuremath{\exists\,}}1% -%{\\<exclamdown>}{\mbox{\rm\textexclamdown}}1% -%{\\<euro>}{\mbox{\textgreek{\euro}}}1%requires greek babel,% -%{\\<eta>}{\ensuremath{\eta}}1% -{\\<equiv>}{\ensuremath{\equiv}}1% -{\\<epsilon>}{\ensuremath{\varepsilon}}1% -{\\<emptyset>}{\ensuremath{\emptyset}}1% -%{\\<e>}{\ensuremath{\mathrm{e}}}1% -%{\\<E>}{\ensuremath{\mathcal{E}}}1% -%{\\<EE>}{\ensuremath{\mathfrak{E}}}1%requires eufrak -%{\\<ee>}{\ensuremath{\mathfrak{e}}}1%requires eufrak -{\\<Down>}{\ensuremath{\Downarrow}}1% -{\\<down>}{\ensuremath{\downarrow}}1% -{\\<dots>}{\ensuremath{\dots}}1% -{\\<doteq>}{\ensuremath{\doteq}}1% -{\\<div>}{\ensuremath{\div}}1% -{\\<dieresis>}{\mbox{\"\relax}}1% -%{\\<diamondsuit>}{\ensuremath{\diamondsuit}}1% -{\\<diamond>}{\ensuremath{\Diamond}}1%requires amssym,% -%{\\<d>}{\ensuremath{\mathrm{d}}}1% -%{\\<D>}{\ensuremath{\mathcal{D}}}1% -%{\\<Delta>}{\ensuremath{\Delta}}1% -{\\<delta>}{\ensuremath{\delta}}1% -{\\<degree>}{\mbox{\rm\textdegree}}1%requires latin1,% -%{\\<DD>}{\ensuremath{\mathfrak{D}}}1%requires eufrak -%{\\<dd>}{\ensuremath{\mathfrak{d}}}1%requires eufrak -{\\<ddagger>}{\ensuremath{\ddagger}}1% -{\\<dagger>}{\ensuremath{\dagger}}1% -%{\\<currency>}{\mbox{\textcurrency}}1%requires textcomp,% -%{\\<copyright>}{\mbox{\rm\copyright}}1% -{\\<Coprod>}{\ensuremath{\coprod\,}}1% -{\\<cong>}{\ensuremath{\cong}}1% -%{\\<complex>}{\ensuremath{\mathrm{C}\mkern-15mu{\phantom{\mathrm{t}}\vrule}\mkern9mu}}1% -{\\<Colon>}{\ensuremath{\mathrel{::}}}1% -{\\<clubsuit>}{\ensuremath{\clubsuit}}1% -{\\<circ>}{\ensuremath{\circ}}1% -{\\<chi>}{\ensuremath{\chi}}1% -%{\\<cent>}{\mbox{\textcent}}1%requires textcomp,% -%{\\<c>}{\ensuremath{\mathrm{c}}}1% -%{\\<C>}{\ensuremath{\mathcal{C}}}1% -{\\<cedilla>}{\mbox{\c\relax}}1% -{\\<cdots>}{\ensuremath{\cdots}}1% -{\\<vdots>}{\ensuremath{\vdots}}1% -{\\<cdot>}{\ensuremath{\cdot}}1% -%{\\<CC>}{\ensuremath{\mathfrak{C}}}1%requires eufrak -%{\\<cc>}{\ensuremath{\mathfrak{c}}}1%requires eufrak -{\\<bullet}{\boldmath\ensuremath{\mathchoice{\displaystyle{\cdot}}{\textstyle{\cdot}}{\scriptstyle{\bullet}>}{\scriptscriptstyle{\bullet}}}}1% -{\\<box>}{\ensuremath{\Box}}1%requires amssym,% -%{\\<bowtie>}{\ensuremath{\bowtie}}1% -{\\<bottom>}{\ensuremath{\bot}}1% -%{\\<bool>}{\ensuremath{\mathrm{I}\mkern-3.8mu\mathrm{B}}}1% -{\\<beta>}{\ensuremath{\beta}}1% -%{\\<b>}{\ensuremath{\mathrm{b}}}1% -%{\\<B>}{\ensuremath{\mathcal{B}}}1% -%{\\<BB>}{\ensuremath{\mathfrak{B}}}1%requires eufrak -%{\\<bb>}{\ensuremath{\mathfrak{b}}}1%requires eufrak -{\\<bar>}{\ensuremath{\mid}}1% -%{\\<asymp>}{\ensuremath{\asymp}}1% -{\\<approx>}{\ensuremath{\approx}}1% -{\\<angle>}{\ensuremath{\angle}}1% -{\\<and>}{\ensuremath{\wedge}}1% -{\\<And>}{\ensuremath{\bigwedge}}1% -%{\\<amalg>}{\ensuremath{\amalg}}1% -{\\<alpha>}{\ensuremath{\alpha}}1% -{\\<aleph>}{\ensuremath{\aleph}}1% -%{\\<a>}{\ensuremath{\mathrm{a}}}1% -%{\\<A>}{\ensuremath{\mathcal{A}}}1% -%{\\<acute>}{\mbox{\'\relax}}1% -{\\<AA>}{\ensuremath{\mathfrak{A}}}1%requires eufrak -%{\\<aa>}{\ensuremath{\mathfrak{a}}}1%requires eufrak -{`}{$`$}1% -{``}{$``$}1% - % non-standard: - % {\\<evalc>}{$\underset{c}{\longrightarrow}$}1% - {\\<evalc>}{\raisebox{-.8ex}{$\overrightarrow{\enspace{\mbox{\scriptsize $c$}}\enspace}$}}3% - {<n>}{$n$}1% - {IF}{$\mathtt{IF}$}4% - {THEN}{$\mathtt{THEN}$}5% - {PUT}{$\mathtt{PUT}$}3% - {ELSE}{$\mathtt{ELSE}$}5% - {DO}{$\mathtt{DO}$}3% - {WHILE}{$\mathtt{WHILE}$}7% - {AWHILE}{$\mathtt{AWHILE}$}8% - {ASSERT}{$\mathtt{ASSERT}$}8% - {STOP}{$\mathtt{STOP}$}5% - {SKIP}{$\mathtt{SKIP}$}5% - {\\<subn>}{$_n$}1% - {<rel>}{$\mathit{rule}$}3% - {<rule>}{$\mathit{rule}$}4% - {<rules>}{$\mathit{rules}$}5% - {<term>}{$\mathit{term}$}4% - {<term1>}{$\mathit{term}_1$}4% - {<termn>}{$\mathit{term}_n$}4% - {<function>}{$\mathit{function}$}9% - {<name>}{$\mathit{name}$}4% - {<namen>}{$\mathit{name}_n$}4% - {<name1>}{$\mathit{name}_1$}4% - {<a1>}{$a_1$}1% - {<x1>}{$x_1$}1% - {<an>}{$a_n$}1% - {<xn>}{$x_n$}1% - {<C>}{$C$}1% - },% - classoffset=0,% - keywordstyle=\textbf,% - morekeywords={theory,end,imports,begin},% - classoffset=1,% - keywordstyle=\textbf,% - morekeywords={text,txt,finally,next,also,with,moreover,ultimately,thus,prefer,defer,declare,apply,of,OF,THEN,intros,in,fix,assume,from,this,show,have,and,note,let,hence,where,using},% then, and - classoffset=2,% - keywordstyle=\color{Blue}\textbf,% - morekeywords={axclass,class,instance,primrec,constdefs,consts_code,types_code,consts,axioms,syntax,typedecl,arities,types,translations,inductive,typedef,datatype,record,instance,defs,specification,proof,test_spec,lemmas,lemma,assumes,shows,definition,fun,function,theorem,case},% - classoffset=3,% - keywordstyle=\color{BrickRed}\textbf,% - morekeywords={oops,sorry},% - classoffset=4,% - keywordstyle=\color{OliveGreen}\textbf,% - morekeywords={store_test_thm,qed,done,by},% - classoffset=5,% - keywordstyle=\textsl,% - morekeywords={frule,subst,erule,drule,rule,rule_tac,case_tac,insert,rotate_tac,unfold,fold,assumption,drule_tac},% - classoffset=6,% - keywordstyle=\color{Blue}\textbf,% - morekeywords={binder,infixl},% - classoffset=6,% - keywordstyle=\color{CornflowerBlue}\textbf,% - morekeywords={thm,export_test_data,generate_test_script,generate_code,gen_test_script,gen_test_data,quickcheck,testgen_params,quickcheck_params},% -} -\lstnewenvironment{isar}[1][]{\lstset{style=ISAR,#1}}{} -\lstnewenvironment{smallisar}[1][]{\lstset{style=ISAR,basicstyle=\small\sffamily,#1}}{} -\def\inlineisar{\lstinline[style=ISAR,breaklines=true,mathescape,breakatwhitespace=true]} diff --git a/Citadelle/src/document/omg.sty b/Citadelle/src/document/omg.sty deleted file mode 100644 index 087d3608c2ae85ce0c0b3b4bc7a89a8e89bfc50e..0000000000000000000000000000000000000000 --- a/Citadelle/src/document/omg.sty +++ /dev/null @@ -1,28 +0,0 @@ -% $Id: omg.sty 3 2014-10-11 14:53:59Z brucker $ -% Contact: adbrucker@0x5f.org -\usepackage{fixltx2e} -\usepackage[T1]{fontenc} -\KOMAoptions{paper=8.28in:11in,fontsize=10pt,twoside=semi,headings=openany} -\areaset{6.7in}{8in} -\usepackage{mathptmx} % rm & math -\usepackage[scaled=0.90]{helvet} % ss -\usepackage{courier} % tt -\usepackage[fleqn]{amsmath} -\usepackage{mathastext} -\normalfont -\usepackage[document]{ragged2e} -% \usepackage[pdfpagelabels, pageanchor=false, bookmarksnumbered, plainpages=false]{hyperref} -\setcounter{secnumdepth}{4} -\newcommand{\oclHeadingOne}[1]{\chapter{#1}}% -\newcommand{\oclHeadingTwo}[1]{\section{#1}}% -\newcommand{\oclHeadingThree}[1]{\subsection{#1}}% -\newcommand{\oclHeadingFour}[1]{\subsubsection{#1}}% -\newcommand{\oclHeadingZero}[1]{\subsubsection*{#1}}% -\newcommand{\oclEmph}[1]{\emph{#1}} -% -\newenvironment{oclDefinition}{\csname gather*\endcsname}{\csname endgather*\endcsname} - -\addtokomafont{caption}{\sffamily\bfseries} -\addtokomafont{captionlabel}{\sffamily\bfseries} -\renewcommand*{\captionformat}{\ --\ \ } -\setcapwidth[l]{\textwidth} \ No newline at end of file diff --git a/Citadelle/src/document/prooftree.sty b/Citadelle/src/document/prooftree.sty deleted file mode 100644 index abb7d448642f28834d3cd08449b90e32bdf963db..0000000000000000000000000000000000000000 --- a/Citadelle/src/document/prooftree.sty +++ /dev/null @@ -1,347 +0,0 @@ -\message{<Paul Taylor's Proof Trees, 2 August 1996>} -%% Build proof tree for Natural Deduction, Sequent Calculus, etc. -%% WITH SHORTENING OF PROOF RULES! -%% Paul Taylor, begun 10 Oct 1989 -%% *** THIS IS ONLY A PRELIMINARY VERSION AND THINGS MAY CHANGE! *** -%% -%% 2 Aug 1996: fixed \mscount and \proofdotnumber -%% -%% \prooftree -%% hyp1 produces: -%% hyp2 -%% hyp3 hyp1 hyp2 hyp3 -%% \justifies -------------------- rulename -%% concl concl -%% \thickness=0.08em -%% \shiftright 2em -%% \using -%% rulename -%% \endprooftree -%% -%% where the hypotheses may be similar structures or just formulae. -%% -%% To get a vertical string of dots instead of the proof rule, do -%% -%% \prooftree which produces: -%% [hyp] -%% \using [hyp] -%% name . -%% \proofdotseparation=1.2ex .name -%% \proofdotnumber=4 . -%% \leadsto . -%% concl concl -%% \endprooftree -%% -%% Within a prooftree, \[ and \] may be used instead of \prooftree and -%% \endprooftree; this is not permitted at the outer level because it -%% conflicts with LaTeX. Also, -%% \Justifies -%% produces a double line. In LaTeX you can use \begin{prooftree} and -%% \end{prootree} at the outer level (however this will not work for the inner -%% levels, but in any case why would you want to be so verbose?). -%% -%% All of of the keywords except \prooftree and \endprooftree are optional -%% and may appear in any order. They may also be combined in \newcommand's -%% eg "\def\Cut{\using\sf cut\thickness.08em\justifies}" with the abbreviation -%% "\prooftree hyp1 hyp2 \Cut \concl \endprooftree". This is recommended and -%% some standard abbreviations will be found at the end of this file. -%% -%% \thickness specifies the breadth of the rule in any units, although -%% font-relative units such as "ex" or "em" are preferable. -%% It may optionally be followed by "=". -%% \proofrulebreadth=.08em or \setlength\proofrulebreadth{.08em} may also be -%% used either in place of \thickness or globally; the default is 0.04em. -%% \proofdotseparation and \proofdotnumber control the size of the -%% string of dots -%% -%% If proof trees and formulae are mixed, some explicit spacing is needed, -%% but don't put anything to the left of the left-most (or the right of -%% the right-most) hypothesis, or put it in braces, because this will cause -%% the indentation to be lost. -%% -%% By default the conclusion is centered wrt the left-most and right-most -%% immediate hypotheses (not their proofs); \shiftright or \shiftleft moves -%% it relative to this position. (Not sure about this specification or how -%% it should affect spreading of proof tree.) -% -% global assignments to dimensions seem to have the effect of stretching -% diagrams horizontally. -% -%%========================================================================== - -\def\introrule{{\cal I}}\def\elimrule{{\cal E}}%% -\def\andintro{\using{\land}\introrule\justifies}%% -\def\impelim{\using{\Rightarrow}\elimrule\justifies}%% -\def\allintro{\using{\forall}\introrule\justifies}%% -\def\allelim{\using{\forall}\elimrule\justifies}%% -\def\falseelim{\using{\bot}\elimrule\justifies}%% -\def\existsintro{\using{\exists}\introrule\justifies}%% - -%% #1 is meant to be 1 or 2 for the first or second formula -\def\andelim#1{\using{\land}#1\elimrule\justifies}%% -\def\orintro#1{\using{\lor}#1\introrule\justifies}%% - -%% #1 is meant to be a label corresponding to the discharged hypothesis/es -\def\impintro#1{\using{\Rightarrow}\introrule_{#1}\justifies}%% -\def\orelim#1{\using{\lor}\elimrule_{#1}\justifies}%% -\def\existselim#1{\using{\exists}\elimrule_{#1}\justifies} - -%%========================================================================== - -\newdimen\proofrulebreadth \proofrulebreadth=.05em -\newdimen\proofdotseparation \proofdotseparation=1.25ex -\newdimen\proofrulebaseline \proofrulebaseline=2ex -\newcount\proofdotnumber \proofdotnumber=3 -\let\then\relax -\def\hfi{\hskip0pt plus.0001fil} -\mathchardef\squigto="3A3B -% -% flag where we are -\newif\ifinsideprooftree\insideprooftreefalse -\newif\ifonleftofproofrule\onleftofproofrulefalse -\newif\ifproofdots\proofdotsfalse -\newif\ifdoubleproof\doubleprooffalse -\let\wereinproofbit\relax -% -% dimensions and boxes of bits -\newdimen\shortenproofleft -\newdimen\shortenproofright -\newdimen\proofbelowshift -\newbox\proofabove -\newbox\proofbelow -\newbox\proofrulename -% -% miscellaneous commands for setting values -\def\shiftproofbelow{\let\next\relax\afterassignment\setshiftproofbelow\dimen0 } -\def\shiftproofbelowneg{\def\next{\multiply\dimen0 by-1 }% -\afterassignment\setshiftproofbelow\dimen0 } -\def\setshiftproofbelow{\next\proofbelowshift=\dimen0 } -\def\setproofrulebreadth{\proofrulebreadth} - -%============================================================================= -\def\prooftree{% NESTED ZERO (\ifonleftofproofrule) -% -% first find out whether we're at the left-hand end of a proof rule -\ifnum \lastpenalty=1 -\then \unpenalty -\else \onleftofproofrulefalse -\fi -% -% some space on left (except if we're on left, and no infinity for outermost) -\ifonleftofproofrule -\else \ifinsideprooftree - \then \hskip.5em plus1fil - \fi -\fi -% -% begin our proof tree environment -\bgroup% NESTED ONE (\proofbelow, \proofrulename, \proofabove, -% \shortenproofleft, \shortenproofright, \proofrulebreadth) -\setbox\proofbelow=\hbox{}\setbox\proofrulename=\hbox{}% -\let\justifies\proofover\let\leadsto\proofoverdots\let\Justifies\proofoverdbl -\let\using\proofusing\let\[\prooftree -\ifinsideprooftree\let\]\endprooftree\fi -\proofdotsfalse\doubleprooffalse -\let\thickness\setproofrulebreadth -\let\shiftright\shiftproofbelow \let\shift\shiftproofbelow -\let\shiftleft\shiftproofbelowneg -\let\ifwasinsideprooftree\ifinsideprooftree -\insideprooftreetrue -% -% now begin to set the top of the rule (definitions local to it) -\setbox\proofabove=\hbox\bgroup$\displaystyle % NESTED TWO -\let\wereinproofbit\prooftree -% -% these local variables will be copied out: -\shortenproofleft=0pt \shortenproofright=0pt \proofbelowshift=0pt -% -% flags to enable inner proof tree to detect if on left: -\onleftofproofruletrue\penalty1 -} - -%============================================================================= -% end whatever box and copy crucial values out of it -\def\eproofbit{% NESTED TWO -% -% various hacks applicable to hypothesis list -\ifx \wereinproofbit\prooftree -\then \ifcase \lastpenalty - \then \shortenproofright=0pt % 0: some other object, no indentation - \or \unpenalty\hfil % 1: empty hypotheses, just glue - \or \unpenalty\unskip % 2: just had a tree, remove glue - \else \shortenproofright=0pt % eh? - \fi -\fi -% -% pass out crucial values from scope -\global\dimen0=\shortenproofleft -\global\dimen1=\shortenproofright -\global\dimen2=\proofrulebreadth -\global\dimen3=\proofbelowshift -\global\dimen4=\proofdotseparation -\global\count255=\proofdotnumber -% -% end the box -$\egroup % NESTED ONE -% -% restore the values -\shortenproofleft=\dimen0 -\shortenproofright=\dimen1 -\proofrulebreadth=\dimen2 -\proofbelowshift=\dimen3 -\proofdotseparation=\dimen4 -\proofdotnumber=\count255 -} - -%============================================================================= -\def\proofover{% NESTED TWO -\eproofbit % NESTED ONE -\setbox\proofbelow=\hbox\bgroup % NESTED TWO -\let\wereinproofbit\proofover -$\displaystyle -}% -% -%============================================================================= -\def\proofoverdbl{% NESTED TWO -\eproofbit % NESTED ONE -\doubleprooftrue -\setbox\proofbelow=\hbox\bgroup % NESTED TWO -\let\wereinproofbit\proofoverdbl -$\displaystyle -}% -% -%============================================================================= -\def\proofoverdots{% NESTED TWO -\eproofbit % NESTED ONE -\proofdotstrue -\setbox\proofbelow=\hbox\bgroup % NESTED TWO -\let\wereinproofbit\proofoverdots -$\displaystyle -}% -% -%============================================================================= -\def\proofusing{% NESTED TWO -\eproofbit % NESTED ONE -\setbox\proofrulename=\hbox\bgroup % NESTED TWO -\let\wereinproofbit\proofusing -\kern0.3em$ -} - -%============================================================================= -\def\endprooftree{% NESTED TWO -\eproofbit % NESTED ONE -% \dimen0 = length of proof rule -% \dimen1 = indentation of conclusion wrt rule -% \dimen2 = new \shortenproofleft, ie indentation of conclusion -% \dimen3 = new \shortenproofright, ie -% space on right of conclusion to end of tree -% \dimen4 = space on right of conclusion below rule - \dimen5 =0pt% spread of hypotheses -% \dimen6, \dimen7 = height & depth of rule -% -% length of rule needed by proof above -\dimen0=\wd\proofabove \advance\dimen0-\shortenproofleft -\advance\dimen0-\shortenproofright -% -% amount of spare space below -\dimen1=.5\dimen0 \advance\dimen1-.5\wd\proofbelow -\dimen4=\dimen1 -\advance\dimen1\proofbelowshift \advance\dimen4-\proofbelowshift -% -% conclusion sticks out to left of immediate hypotheses -\ifdim \dimen1<0pt -\then \advance\shortenproofleft\dimen1 - \advance\dimen0-\dimen1 - \dimen1=0pt -% now it sticks out to left of tree! - \ifdim \shortenproofleft<0pt - \then \setbox\proofabove=\hbox{% - \kern-\shortenproofleft\unhbox\proofabove}% - \shortenproofleft=0pt - \fi -\fi -% -% and to the right -\ifdim \dimen4<0pt -\then \advance\shortenproofright\dimen4 - \advance\dimen0-\dimen4 - \dimen4=0pt -\fi -% -% make sure enough space for label -\ifdim \shortenproofright<\wd\proofrulename -\then \shortenproofright=\wd\proofrulename -\fi -% -% calculate new indentations -\dimen2=\shortenproofleft \advance\dimen2 by\dimen1 -\dimen3=\shortenproofright\advance\dimen3 by\dimen4 -% -% make the rule or dots, with name attached -\ifproofdots -\then - \dimen6=\shortenproofleft \advance\dimen6 .5\dimen0 - \setbox1=\vbox to\proofdotseparation{\vss\hbox{$\cdot$}\vss}% - \setbox0=\hbox{% - \advance\dimen6-.5\wd1 - \kern\dimen6 - $\vcenter to\proofdotnumber\proofdotseparation - {\leaders\box1\vfill}$% - \unhbox\proofrulename}% -\else \dimen6=\fontdimen22\the\textfont2 % height of maths axis - \dimen7=\dimen6 - \advance\dimen6by.5\proofrulebreadth - \advance\dimen7by-.5\proofrulebreadth - \setbox0=\hbox{% - \kern\shortenproofleft - \ifdoubleproof - \then \hbox to\dimen0{% - $\mathsurround0pt\mathord=\mkern-6mu% - \cleaders\hbox{$\mkern-2mu=\mkern-2mu$}\hfill - \mkern-6mu\mathord=$}% - \else \vrule height\dimen6 depth-\dimen7 width\dimen0 - \fi - \unhbox\proofrulename}% - \ht0=\dimen6 \dp0=-\dimen7 -\fi -% -% set up to centre outermost tree only -\let\doll\relax -\ifwasinsideprooftree -\then \let\VBOX\vbox -\else \ifmmode\else$\let\doll=$\fi - \let\VBOX\vcenter -\fi -% this \vbox or \vcenter is the actual output: -\VBOX {\baselineskip\proofrulebaseline \lineskip.2ex - \expandafter\lineskiplimit\ifproofdots0ex\else-0.6ex\fi - \hbox spread\dimen5 {\hfi\unhbox\proofabove\hfi}% - \hbox{\box0}% - \hbox {\kern\dimen2 \box\proofbelow}}\doll% -% -% pass new indentations out of scope -\global\dimen2=\dimen2 -\global\dimen3=\dimen3 -\egroup % NESTED ZERO -\ifonleftofproofrule -\then \shortenproofleft=\dimen2 -\fi -\shortenproofright=\dimen3 -% -% some space on right and flag we've just made a tree -\onleftofproofrulefalse -\ifinsideprooftree -\then \hskip.5em plus 1fil \penalty2 -\fi -} - -%========================================================================== -% IDEAS -% 1. Specification of \shiftright and how to spread trees. -% 2. Spacing command \m which causes 1em+1fil spacing, over-riding -% exisiting space on sides of trees and not affecting the -% detection of being on the left or right. -% 3. Hack using \@currenvir to detect LaTeX environment; have to -% use \aftergroup to pass \shortenproofleft/right out. -% 4. (Pie in the sky) detect how much trees can be "tucked in" -% 5. Discharged hypotheses (diagonal lines). diff --git a/Citadelle/src/document/root.bib b/Citadelle/src/document/root.bib deleted file mode 100644 index 1d6fde65801e5abf102a6d5e3e80d875a951b992..0000000000000000000000000000000000000000 --- a/Citadelle/src/document/root.bib +++ /dev/null @@ -1,1447 +0,0 @@ -% $Id: adb-long.bib 7880 2012-01-06 17:38:24Z brucker $ -@PREAMBLE{ {\providecommand{\ac}[1]{\textsc{#1}} } - # {\providecommand{\acs}[1]{\textsc{#1}} } - # {\providecommand{\acf}[1]{\textsc{#1}} } - # {\providecommand{\TAP}{T\kern-.1em\lower-.5ex\hbox{A}\kern-.1em P} } - # {\providecommand{\leanTAP}{\mbox{\sf lean\it\TAP}} } - # {\providecommand{\holz}{\textsc{hol-z}} } - # {\providecommand{\holocl}{\textsc{hol-ocl}} } - # {\providecommand{\isbn}{\textsc{isbn}} } - # {\providecommand{\Cpp}{C++} } - # {\providecommand{\Specsharp}{Spec\#} } - # {\providecommand{\doi}[1]{\href{http://dx.doi.org/#1}{doi: - {\urlstyle{rm}\nolinkurl{#1}}}}} } -@STRING{conf-tphols="{TPHOLs}" } -@STRING{iso = {International Organization for Standardization} } -@STRING{j-ar = "Journal of Automated Reasoning" } -@STRING{j-cacm = "Communications of the {ACM}" } -@STRING{j-acta-informatica = "Acta Informatica" } -@STRING{j-sosym = "Software and Systems Modeling" } -@STRING{j-sttt = "International Journal on Software Tools for Technology (STTT)" } -@STRING{j-ist = "Information and Software Technology" } -@STRING{j-toplas= "{ACM} Transactions on Programming Languages and - Systems" } -@STRING{j-tosem = "{ACM} Transactions on Software Engineering and - Methodology" } -@STRING{j-eceasst="Electronic Communications of the {EASST}" } -@STRING{j-fac = "Formal Aspects of Computing (FAC)" } -@STRING{j-ucs = "Journal of Universal Computer Science" } -@STRING{j-sl = "Journal of Symbolic Logic" } -@STRING{j-fp = "Journal of Functional Programming" } -@STRING{j-tkde = {{IEEE} Transaction on Knowledge and Data Engineering} } -@STRING{j-tse = {{IEEE} Transaction on Software Engineering} } -@STRING{j-entcs = {Electronic Notes in Theoretical Computer Science} } -@STRING{s-lni = "Lecture Notes in Informatics" } -@STRING{s-lnai = "Lecture Notes in Computer Science" } -@STRING{s-lncs = "Lecture Notes in Computer Science" } -@STRING{s-lnbip = "Lecture Notes in Business Information Processing" } -@String{j-computer = "Computer"} -@String{j-tissec = "{ACM} Transactions on Information and System Security"} -@STRING{omg = {Object Management Group} } -@STRING{j-ipl = {Information Processing Letters} } -@STRING{j-login = ";login: the USENIX Association newsletter" } - -@STRING{PROC = "Proceedings of the " } -@String{j-nams = "Notices of the American Mathematical - Society"} -@String{j-jucs = "Journal of Universal Computer Science"} -@String{j-acm = "Journal of the ACM (JACM)"} - - -% Conferences -% ============ -@STRING{conf-sacmat = "ACM symposium on access control models and - technologies (SACMAT)"} -@STRING{conf-policy = "IEEE International Symposium on Policies for Distributed - Systems and Networks (POLICY)"} - -% Publisher: -% ========== -@STRING{pub-awl = {Addison-Wesley Longman, Inc.} } -@STRING{pub-awl:adr={Reading, MA, {USA}} } -@STRING{pub-springer={Springer-Verlag} } -@STRING{pub-springer:adr={Heidelberg} } -@STRING{pub-cup = {Cambridge University Press} } -@STRING{pub-cup:adr={New York, {NY}, {USA}} } -@STRING{pub-mit = {{MIT} Press} } -@STRING{pub-mit:adr={Cambridge, Massachusetts} } -@STRING{pub-springer-ny={Springer-Verlag} } -, -@STRING{pub-springer-netherlands={Springer Netherlands} } -@STRING{pub-springer-netherlands:adr={} } -@STRING{pub-springer-ny:adr={New York, {NY}, {USA}} } -@STRING{pub-springer-london={Springer-Verlag} } -@STRING{pub-springer-london:adr={London} } -@STRING{pub-ieee= {{IEEE} Computer Society} } -@STRING{pub-ieee:adr={Los Alamitos, {CA}, {USA}} } -@STRING{pub-prentice={Prentice Hall, Inc.} } -@STRING{pub-prentice:adr={Upper Saddle River, {NJ}, {USA}} } -@STRING{pub-acm = {{ACM} Press} } -@STRING{pub-acm:adr={New York, {NY} {USA}} } -@STRING{pub-oxford={Oxford University Press, Inc.} } -@STRING{pub-oxford:adr={New York, {NY}, {USA}} } -@STRING{pub-kluwer={Kluwer Academic Publishers} } -@STRING{pub-kluwer:adr={Dordrecht} } -@STRING{pub-elsevier={Elsevier Science Publishers} } -@STRING{pub-elsevier:adr={Amsterdam} } -@STRING{pub-north={North-Holland Publishing Co.} } -@STRING{pub-north:adr={Nijmegen, The Netherlands} } -@STRING{pub-ios = {\textsc{ios} Press} } -@STRING{pub-ios:adr={Amsterdam, The Netherlands} } -@STRING{pub-heise={Heise Zeitschriften Verlag} } -@STRING{pub-heise:adr={Hannover, Germany} } -@STRING{pub-wiley={John Wiley \& Sons} } -@STRING{pub-wiley:adr={} } - -@Book{ andrews:introduction:2002, - author = {Peter B. Andrews}, - title = {Introduction to Mathematical Logic and Type Theory: To - Truth through Proof}, - year = 2002, - isbn = {1-402-00763-9}, - edition = {2nd}, - publisher = pub-kluwer, - address = pub-kluwer:adr, - acknowledgement={brucker, 2007-04-23}, - bibkey = {andrews:introduction:2002} -} - -@InProceedings{ barnett.ea:spec:2004, - author = {Mike Barnett and K. Rustan M. Leino and Wolfram Schulte}, - abstract = "Spec# is the latest in a long line of work on programming - languages and systems aimed at improving the development of - correct software. This paper describes the goals and - architecture of the Spec# programming system, consisting of - the object-oriented Spec# programming language, the Spec# - compiler, and the Boogie static program verifier. The - language includes constructs for writing specifications - that capture programmer intentions about how methods and - data are to be used, the compiler emits run-time checks to - enforce these specifications, and the verifier can check - the consistency between a program and its specifications.", - language = {USenglish}, - title = {The {\Specsharp} programming system: An overview}, - pages = {49--69}, - crossref = {barthe.ea:construction:2005}, - bibkey = {barnett.ea:spec:2004}, - doi = {10.1007/b105030}, - acknowledgement={brucker, 2007-02-19}, - month = may # {~25} -} - -@InProceedings{ barrett.ea:cvc3:2007, - author = {Clark Barrett and Cesare Tinelli}, - title = {CVC3}, - booktitle = {CAV}, - year = 2007, - pages = {298--302}, - doi = {10.1007/978-3-540-73368-3_34}, - crossref = {damm.ea:computer:2007} -} - -@Proceedings{ barthe.ea:construction:2005, - editor = {Gilles Barthe and Lilian Burdy and Marieke Huisman and - Jean-Louis Lanet and Traian Muntean}, - title = {Construction and Analysis of Safe, Secure, and - Interoperable Smart Devices ({CASSIS})}, - booktitle = {Construction and Analysis of Safe, Secure, and - Interoperable Smart Devices ({CASSIS})}, - publisher = pub-springer, - address = pub-springer:adr, - series = s-lncs, - volume = 3362, - year = 2005, - isbn = {978-3-540-24287-1}, - acknowledgement={brucker, 2007-02-19}, - doi = {10.1007/b105030} -} - -@Proceedings{ bezivin.ea:unified:1999, - editor = {Jean B{\'e}zivin and Pierre-Alain Muller}, - doi = {10.1007/b72309}, - booktitle = {The Unified Modeling Language. \guillemotleft - {UML}\guillemotright'98: Beyond the Notation}, - title = {The Unified Modeling Language. \guillemotleft - {UML}\guillemotright'98: Beyond the Notation}, - publisher = pub-springer, - address = pub-springer:adr, - acknowledgement={brucker, 2007-04-23}, - series = s-lncs, - volume = 1618, - year = 1999, - isbn = {3-540-66252-9} -} - -@InProceedings{ blanchette.ea:nitpick:2010, - author = {Jasmin Christian Blanchette and Tobias Nipkow}, - title = {Nitpick: A Counterexample Generator for Higher-Order Logic - Based on a Relational Model Finder}, - booktitle = {ITP}, - year = 2010, - pages = {131--146}, - doi = {10.1007/978-3-642-14052-5_11}, - crossref = {kaufmann.ea:interactive:2010} -} - -@Article{ church:types:1940, - author = {Church, Alonzo}, - title = {A formulation of the simple theory of types}, - journal = j-sl, - year = 1940, - volume = 5, - number = 2, - month = jun, - pages = {56--68}, - acknowledgement={brucker, 2007-04-23}, - bibkey = {church:types:1940} -} - -@InProceedings{ cook.ea::amsterdam:2002, - abstract = {In November 1998 the authors participated in a two-day - workshop on the Object Constraint Language (OCL) in - Amsterdam. The focus was to clarify issues about the - semantics and the use of OCL, and to discuss useful and - necessary extensions of OCL. Various topics have been - raised and clarified. This manifesto contains the results - of that workshop and the following work on these topics. - Overview of OCL.}, - author = {Steve Cook and Anneke Kleppe and Richard Mitchell and - Bernhard Rumpe and Jos Warmer and Alan Wills}, - title = {The Amsterdam Manifesto on {OCL}}, - pages = {115--149}, - crossref = {clark.ea:object:2002}, - acknowledgement={brucker, 2007-02-19}, - tags = {MDE}, - clearance = {unclassified}, - timestap = {2008-05-26} -} - -@Proceedings{ damm.ea:computer:2007, - editor = {Werner Damm and Holger Hermanns}, - title = {Computer Aided Verification, 19th International - Conference, CAV 2007, Berlin, Germany, July 3-7, 2007, - Proceedings}, - booktitle = {CAV}, - publisher = pub-springer, - series = s-lncs, - volume = 4590, - year = 2007, - isbn = {978-3-540-73367-6} -} - -@InProceedings{ gogolla.ea:expressing:2001, - author = {Martin Gogolla and Mark Richters}, - bibkey = {gogolla.ea:expressing:2001}, - abstract = {The Unified Modeling Language {UML} is a complex - language offering many modeling features. Especially the - description of static structures with class diagrams is - supported by a rich set of primitives. This paper shows how - to transfrom {UML} class diagrams involving cardinality - constraints, qualifiers, association classes, aggregations, - compositions, and generalizations into equivalent {UML} - class diagrams employing only binary associations and - {OCL} constraints. Thus we provide a better - understanding of {UML} features. By reducing more - complex features in terms of basic ones, we suggest an easy - way users can gradually extend the set of {UML} - elements they commonly apply in the modeling process.}, - title = {Expressing {UML} Class Diagrams Properties with - {OCL}}, - pages = {85--114}, - crossref = {clark.ea:object:2002}, - acknowledgement={brucker, 2007-02-19}, - tags = {MDE}, - clearance = {unclassified}, - timestap = {2008-05-26} -} - -@Proceedings{ clark.ea:object:2002, - editor = {Tony Clark and Jos Warmer}, - booktitle = {Object Modeling with the {OCL}: The Rationale behind - the Object Constraint Language}, - title = {Object Modeling with the {OCL}: The Rationale behind - the Object Constraint Language}, - publisher = pub-springer, - address = pub-springer:adr, - series = s-lncs, - volume = 2263, - year = 2002, - isbn = {3-540-43169-1}, - acknowledgement={brucker, 2007-02-19}, - tags = {MDE}, - clearance = {unclassified}, - timestap = {2008-05-26} -} - -@Proceedings{ grumberg.ea:tools:2007, - editor = {Orna Grumberg and Michael Huth}, - title = {Tools and Algorithms for the Construction and Analysis of - Systems, 13th International Conference, TACAS 2007, Held as - Part of the Joint European Conferences on Theory and - Practice of Software, ETAPS 2007 Braga, Portugal, March 24 - - April 1, 2007, Proceedings}, - booktitle = {TACAS}, - publisher = pub-springer, - address = pub-springer:adr, - series = s-lncs, - volume = 4424, - year = 2007, - isbn = {978-3-540-71208-4} -} - -@InProceedings{ hamie.ea:reflections:1998, - bibkey = {hamie.ea:reflections:1998}, - author = {Ali Hamie and Franco Civello and John Howse and Stuart - Kent and Richard Mitchell}, - title = {{Reflections on the Object Constraint Language}}, - year = 1998, - doi = {10.1007/b72309}, - topic = {formalism}, - acknowledgement={brucker, 2007-04-23}, - pages = {162--172}, - crossref = {bezivin.ea:unified:1999}, - abstract = {The \acf{ocl}, which forms part of the {UML} set of - modelling notations, is a precise, textual language for - expressing constraints that cannot be shown - diagrammatically in {UML}. This paper reflects on a - number of aspects of the syntax and semantics of the - {OCL}, and makes proposals for clarification or - extension. Specifically, the paper suggests that: the - concept of flattening collections of collections is - unnecessary, state models should be connectable to class - models, defining object creation should be made more - convenient, {OCL} should be based on a 2-valued logic, - set subtraction should be covered more fully, and a "let" - feature should be introduced. } -} - -@Proceedings{ kaufmann.ea:interactive:2010, - editor = {Matt Kaufmann and Lawrence C. Paulson}, - title = {Interactive Theorem Proving, First International - Conference, ITP 2010, Edinburgh, UK, July 11-14, 2010. - Proceedings}, - booktitle = {ITP}, - publisher = pub-springer, - series = s-lncs, - volume = 6172, - year = 2010, - isbn = {978-3-642-14051-8}, - doi = {10.1007/978-3-642-14052-5} -} - -@InProceedings{ kosiuczenko:specification:2006, - author = {Piotr Kosiuczenko}, - title = {Specification of Invariability in {OCL}}, - pages = {676--691}, - doi = {10.1007/11880240_47}, - crossref = {nierstrasz.ea:model:2006}, - abstract = {The paradigm of contractual specification provides a - transparent way of specifying systems. It clearly - distinguishes between client and implementer obligations. - One of the best known languages used for this purpose is - OCL. Nevertheless, OCL does not provide primitives for a - compact specification of what remains unchanged when a - method is executed. In this paper, problems with specifying - invariability are listed and some weaknesses of existing - solutions are pointed out. The question of specifying - invariability in OCL is studied and a simple but expressive - and flexible extension is proposed. It is shown that this - extension has a simple OCL based semantics.} -} - -@InProceedings{ krieger.ea:generative:2010, - author = {Matthias P. Krieger and Alexander Knapp and Burkhart - Wolff}, - title = {Generative Programming and Component Engineering}, - booktitle = {International Conference on Generative Programming and - Component Engineering (GPCE 2010)}, - month = oct, - location = {Eindhoven, The Netherlands, October 10-13, 2010}, - year = 2010, - pages = {53--62}, - ee = {http://doi.acm.org/10.1145/1868294.1868303}, - editor = {Eelco Visser and Jaakko J{\"a}rvi}, - publisher = {ACM}, - isbn = {978-1-4503-0154-1}, - abstract = {Operation contracts consisting of pre- and postconditions - are a well-known means of specifying operations. In this - paper we deal with the problem of operation contract - simulation, i.e., determining operation results satisfying - the postconditions based on input data supplied by the - user; simulating operation contracts is an important - technique for requirements validation and prototyping. - Current approaches to operation contract simulation exhibit - poor performance for large sets of input data or require - additional guidance from the user. We show how these - problems can be alleviated and describe an efficient as - well as fully automatic approach. It is implemented in our - tool OCLexec that generates from UML/OCL operation - contracts corresponding Java implementations which call a - constraint solver at runtime. The generated code can serve - as a prototype. A case study demonstrates that our approach - can handle problem instances of considerable size.} -} - -@InProceedings{ mandel.ea:ocl:1999, - author = {Luis Mandel and Mar{\`i}a Victoria Cengarle}, - bibkey = {mandel.ea:ocl:1999}, - language = {USenglish}, - topic = {formalism}, - public = {yes}, - title = {On the expressive power of {{OCL}}}, - acknowledgement={brucker, 2007-04-23}, - timestamp = 962971498, - abstract = {This paper examines the expressive power of {OCL} in - terms of navigability and computability. First the - expressive power of {OCL} is compared with the - relational calculus; it is showed that {OCL} is not - equivalent to the relational calculus. Then an algorithm - computing the transitive closure of a binary relation - operation that cannot be encoded in the relational calculus - is expressed in {OCL}. Finally the equivalence of - {OCL} with a Turing machine is pondered.}, - pages = {854--874}, - crossref = {wing.ea:world:1999}, - ee = {http://link.springer.de/link/service/series/0558/bibs/1708/17080854.htm} - -} - -@InProceedings{ moura.ea:z3:2008, - author = {Leonardo Mendon\c{c}a de Moura and Nikolaj Bj{\o}rner}, - title = {Z3: An Efficient {SMT} Solver}, - booktitle = {TACAS}, - year = 2008, - pages = {337--340}, - doi = {10.1007/978-3-540-78800-3_24}, - abstract = {Satisfiability Modulo Theories (SMT) problem is a decision - problem for logical first order formulas with respect to - combinations of background theories such as: arithmetic, - bit-vectors, arrays, and uninterpreted functions. Z3 is a - new and efficient SMT Solver freely available from - Microsoft Research. It is used in various software - verification and analysis applications. }, - crossref = {ramakrishnan.ea:tools:2008} -} - -@Proceedings{ nierstrasz.ea:model:2006, - editor = {Oscar Nierstrasz and Jon Whittle and David Harel and - Gianna Reggio}, - title = {Model Driven Engineering Languages and Systems - ({MoDELS})}, - booktitle = {Model Driven Engineering Languages and Systems - ({MoDELS})}, - address = pub-springer:adr, - location = {Genova, Italy}, - publisher = pub-springer, - series = s-lncs, - acknowledgement={brucker, 2007-02-19}, - volume = 4199, - year = 2006, - doi = {10.1007/11880240}, - isbn = {978-3-540-45772-5} -} - -@Book{ nipkow.ea:isabelle:2002, - author = {Tobias Nipkow and Lawrence C. Paulson and Markus Wenzel}, - title = {Isabelle/{HOL}---A Proof Assistant for Higher-Order - Logic}, - publisher = pub-springer, - address = pub-springer:adr, - series = s-lncs, - volume = 2283, - doi = {10.1007/3-540-45949-9}, - abstract = {This book is a self-contained introduction to interactive - proof in higher-order logic ({HOL}), using the proof - assistant Isabelle2002. It is a tutorial for potential - users rather than a monograph for researchers. The book has - three parts. - - 1. Elementary Techniques shows how to model functional - programs in higher-order logic. Early examples involve - lists and the natural numbers. Most proofs are two steps - long, consisting of induction on a chosen variable followed - by the auto tactic. But even this elementary part covers - such advanced topics as nested and mutual recursion. 2. - Logic and Sets presents a collection of lower-level tactics - that you can use to apply rules selectively. It also - describes Isabelle/{HOL}'s treatment of sets, functions - and relations and explains how to define sets inductively. - One of the examples concerns the theory of model checking, - and another is drawn from a classic textbook on formal - languages. 3. Advanced Material describes a variety of - other topics. Among these are the real numbers, records and - overloading. Advanced techniques are described involving - induction and recursion. A whole chapter is devoted to an - extended example: the verification of a security protocol. }, - year = 2002, - acknowledgement={brucker, 2007-02-19}, - bibkey = {nipkow.ea:isabelle:2002}, - tags = {noTAG}, - clearance = {unclassified}, - timestap = {2008-05-26} -} - -@Booklet{ omg:ocl:1997, - bibkey = {omg:ocl:1997}, - key = omg, - abstract = {This document introduces and defines the Object Constraint - Language ({OCL}), a formal language to express side - effect-free constraints. Users of the Unified Modeling - Language and other languages can use {OCL} to specify - constraints and other expressions attached to their models. - {OCL} was used in the {UML} Semantics document to - specify the well-formedness rules of the {UML} - metamodel. Each well-formedness rule in the static - semantics sections in the {UML} Semantics document - contains an {OCL} expression, which is an invariant for - the involved class. The grammar for {OCL} is specified - at the end of this document. A parser generated from this - grammar has correctly parsed all the constraints in the - {UML} Semantics document, a process which improved the - correctness of the specifications for {OCL} and {UML}.}, - institution = omg, - language = {USenglish}, - month = sep, - note = {Available as {OMG} document - \href{http://www.omg.org/cgi-bin/doc?ad/97-08-08} - {ad/97-08-08}}, - keywords = {{UML}, OCL}, - topic = {formalism}, - public = {yes}, - title = {Object Constraint Language Specification (Version 1.1)}, - year = 1997, - acknowledgement={brucker, 2007-04-23} -} - -@Booklet{ omg:ocl:2003, - bibkey = {omg:ocl:2003}, - key = omg, - abstract = {This document introduces and defines the Object Constraint - Language (OCL), a formal language to express side - effect-free constraints. Users of the Unified Modeling - Language and other languages can use OCL to specify - constraints and other expressions attached to their models. - OCL was used in the {UML} Semantics document to specify - the well-formedness rules of the {UML} metamodel. Each - well-formedness rule in the static semantics sections in - the {UML} Semantics document contains an OCL - expression, which is an invariant for the involved class. - The grammar for OCL is specified at the end of this - document. A parser generated from this grammar has - correctly parsed all the constraints in the {UML} - Semantics document, a process which improved the - correctness of the specifications for OCL and {UML}.}, - publisher = omg, - language = {USenglish}, - month = oct, - keywords = {{UML}, OCL}, - topic = {formalism}, - public = {yes}, - note = {Available as {OMG} document - \href{http://www.omg.org/cgi-bin/doc?ptc/03-10-14} - {ptc/03-10-14}}, - title = {{UML} 2.0 {OCL} Specification}, - year = 2003, - acknowledgement={brucker, 2007-04-23} -} - -@Booklet{ omg:ocl:2006, - bibkey = {omg:ocl:2006}, - key = omg, - abstract = {This document introduces and defines the Object Constraint - Language (OCL), a formal language to express side - effect-free constraints. Users of the Unified Modeling - Language and other languages can use OCL to specify - constraints and other expressions attached to their models. - OCL was used in the {UML} Semantics document to specify - the well-formedness rules of the {UML} metamodel. Each - well-formedness rule in the static semantics sections in - the {UML} Semantics document contains an OCL - expression, which is an invariant for the involved class. - The grammar for OCL is specified at the end of this - document. A parser generated from this grammar has - correctly parsed all the constraints in the {UML} - Semantics document, a process which improved the - correctness of the specifications for OCL and {UML}.}, - publisher = omg, - language = {USenglish}, - month = apr, - keywords = {{UML}, OCL}, - topic = {formalism}, - note = {Available as {OMG} document - \href{http://www.omg.org/cgi-bin/doc?formal/06-05-01} - {formal/06-05-01}}, - public = {yes}, - title = {{UML} 2.0 {OCL} Specification}, - year = 2006, - acknowledgement={brucker, 2007-04-23} -} - -@Booklet{ omg:ocl:2012, - bibkey = {omg:ocl:2012}, - key = omg, - abstract = {This document introduces and defines the Object Constraint - Language (OCL), a formal language to express side - effect-free constraints. Users of the Unified Modeling - Language and other languages can use OCL to specify - constraints and other expressions attached to their models. - OCL was used in the {UML} Semantics document to specify - the well-formedness rules of the {UML} metamodel. Each - well-formedness rule in the static semantics sections in - the {UML} Semantics document contains an OCL - expression, which is an invariant for the involved class. - The grammar for OCL is specified at the end of this - document. A parser generated from this grammar has - correctly parsed all the constraints in the {UML} - Semantics document, a process which improved the - correctness of the specifications for OCL and {UML}.}, - publisher = omg, - language = {USenglish}, - month = feb, - keywords = {{UML}, OCL}, - topic = {formalism}, - note = {Available as {OMG} document - \href{http://www.omg.org/cgi-bin/doc?formal/2012-01-01} - {formal/2012-01-01}}, - public = {yes}, - title = {{UML} 2.3.1 {OCL} Specification}, - year = 2012, - acknowledgement={brucker, 2012-08-01} -} - -@Booklet{ omg:uml-infrastructure:2011, - key = omg, - abstract = {}, - publisher = omg, - language = {USenglish}, - month = aug, - year = 2011, - note = {Available as {OMG} document - \href{http://www.omg.org/cgi-bin/doc?formal/2011-08-05} - {formal/2011-08-05}}, - keywords = {}, - topic = {}, - public = {yes}, - title = {{UML} 2.4.1: Infrastructure Specification} -} - -@Booklet{ omg:uml-superstructure:2011, - key = omg, - abstract = {}, - publisher = omg, - language = {USenglish}, - month = aug, - year = 2011, - note = {Available as {OMG} document - \href{http://www.omg.org/cgi-bin/doc?formal/2011-08-06} - {formal/2011-08-06}}, - keywords = {}, - topic = {}, - public = {yes}, - title = {{UML} 2.4.1: Superstructure Specification} -} - -@Proceedings{ ramakrishnan.ea:tools:2008, - editor = {C. R. Ramakrishnan and Jakob Rehof}, - title = {Tools and Algorithms for the Construction and Analysis of - Systems, 14th International Conference, TACAS 2008, Held as - Part of the Joint European Conferences on Theory and - Practice of Software, ETAPS 2008, Budapest, Hungary, March - 29-April 6, 2008. Proceedings}, - booktitle = {TACAS}, - publisher = pub-springer, - address = pub-springer:adr, - series = s-lncs, - volume = 4963, - year = 2008, - isbn = {978-3-540-78799-0} -} - -@PhDThesis{ richters:precise:2002, - author = {Mark Richters}, - title = {A Precise Approach to Validating {{UML}} Models and - {{OCL}} Constraints}, - school = {Universit{\"a}t Bremen}, - year = 2002, - address = {Logos Verlag, Berlin, {BISS} Monographs, No. 14}, - isbn = {3-89722-842-4}, - abstract = {We present a precise approach that allows an analysis and - validation of {UML} models and OCL constraints. We - focus on models and constraints specified in the analysis - and early design stage of a software development process. - For this purpose, a suitable subset of {UML} - corresponding to information that is usually represented in - class diagrams is identified and formally defined. This - basic modeling language provides a context for all OCL - constraints. We define a formal syntax and semantics of OCL - types, operations, expressions, invariants, and - pre-/postconditions. We also give solutions for problems - with the current OCL definition and discuss possible - extensions. A metamodel for OCL is introduced that defines - the abstract syntax of OCL expressions and the structure of - types and values. The metamodel approach allows a seamless - integration with the {UML} metamodeling architecture - and makes the benefits of a precise OCL definition easier - accessible. The OCL metamodel also allows to define - context-sensitive conditions for well-formed OCL - expressions more precisely. These conditions can now be - specified with OCL whereas they previously were specified - only informally. In order to demonstrate the practical - applicability of our work, we have realized substantial - parts of it in a tool supporting the validation of models - and constraints. Design specifications can be ``executed'' - and animated thus providing early feedback in an iterative - development process. Our approach offers novel ways for - checking user data against specifications, for automating - test procedures, and for checking CASE tools for standards - conformance. Therefore, this work contributes to the goal - of improving the overall quality of software systems by - combining theoretical and practical techniques.}, - acknowledgement={brucker, 2007-04-23} -} - -@InProceedings{ torlak.ea:kodkod:2007, - author = {Emina Torlak and Daniel Jackson}, - title = {Kodkod: A Relational Model Finder}, - booktitle = {TACAS}, - year = 2007, - pages = {632--647}, - doi = {10.1007/978-3-540-71209-1_49}, - crossref = {grumberg.ea:tools:2007}, - abstract = {The key design challenges in the construction of a - SAT-based relational model finder are described, and novel - techniques are proposed to address them. An efficient model - finder must have a mechanism for specifying partial - solutions, an effective symmetry detection and breaking - scheme, and an economical translation from relational to - boolean logic. These desiderata are addressed with three - new techniques: a symmetry detection algorithm that works - in the presence of partial solutions, a sparse-matrix - representation of relations, and a compact representation - of boolean formulas inspired by boolean expression diagrams - and reduced boolean circuits. The presented techniques have - been implemented and evaluated, with promising results.} -} - -@InCollection{ wenzel.ea:building:2007, - abstract = {We present the generic system framework of - Isabelle/Isarunderlying recent versions of Isabelle. Among - other things, Isar provides an infrastructure for Isabelle - plug-ins, comprising extensible state components and - extensible syntax that can be bound to tactical ML - programs. Thus the Isabelle/Isar architecture may be - understood as an extension and refinement of the - traditional LCF approach, with explicit infrastructure for - building derivative systems. To demonstrate the technical - potential of the framework, we apply it to a concrete - formalmethods tool: the HOL-Z 3.0 environment, which is - geared towards the analysis of Z specifications and formal - proof of forward-refinements.}, - author = {Makarius Wenzel and Burkhart Wolff}, - booktitle = {{TPHOLs} 2007}, - editor = {Klaus Schneider and Jens Brandt}, - language = {USenglish}, - acknowledgement={none}, - pages = {352--367}, - publisher = pub-springer, - address = pub-springer:adr, - number = 4732, - series = s-lncs, - title = {Building Formal Method Tools in the {Isabelle}/{Isar} - Framework}, - doi = {10.1007/978-3-540-74591-4_26}, - year = 2007 -} - -@PhDThesis{ wenzel:isabelleisar:2002, - author = {Markus M. Wenzel}, - title = {Isabelle/Isar --- a versatile environment for - human-readable formal proof documents}, - school = {TU M{\"u}nchen}, - year = 2002, - url = {http://tumb1.biblio.tu-muenchen.de/publ/diss/in/2002/wenzel.html} - , - abstract = {The basic motivation of this work is to make formal theory - developments with machine-checked proofs accessible to a - broader audience. Our particular approach is centered - around the Isar formal proof language that is intended to - support adequate composition of proof documents that are - suitable for human consumption. Such primary proofs written - in Isar may be both checked by the machine and read by - human-beings; final presentation merely involves trivial - pretty printing of the sources. Sound logical foundations - of Isar are achieved by interpretation within the generic - Natural Deduction framework of Isabelle, reducing all - high-level reasoning steps to primitive inferences. - - The resulting Isabelle/Isar system is generic with respect - to object-logics and proof tools, just as pure Isabelle - itself. The full Isar language emerges from a small core by - means of several derived elements, which may be combined - freely with existing ones. This results in a very rich - space of expressions of formal reasoning, supporting many - viable proof techniques. The general paradigms of Natural - Deduction and Calculational Reasoning are both covered - particularly well. Concrete examples from logic, - mathematics, and computer-science demonstrate that the Isar - concepts are indeed sufficiently versatile to cover a broad - range of applications.}, - address = {M{\"u}nchen}, - month = feb, - acknowledgement={none}, - bibkey = {wenzel:isabelleisar:2002} -} - -@Proceedings{ wing.ea:world:1999, - editor = {Jeannette M. Wing and Jim Woodcock and Jim Davies}, - booktitle = {World Congress on Formal Methods in the Development of - Computing Systems (FM)}, - title = {World Congress on Formal Methods in the Development of - Computing Systems (FM)}, - publisher = pub-springer, - address = pub-springer:adr, - acknowledgement={brucker, 2007-04-23}, - series = s-lncs, - volume = 1708, - year = 1999, - isbn = {3-540-66587-0} -} -@Proceedings{ bezivin.ea:unified:1999, - editor = {Jean B{\'e}zivin and Pierre-Alain Muller}, - doi = {10.1007/b72309}, - booktitle = {The Unified Modeling Language. \guillemotleft - {UML}\guillemotright'98: Beyond the Notation}, - title = {The Unified Modeling Language. \guillemotleft - {UML}\guillemotright'98: Beyond the Notation}, - publisher = pub-springer, - address = pub-springer:adr, - acknowledgement={brucker, 2007-04-23}, - series = s-lncs, - volume = 1618, - year = 1999, - isbn = {3-540-66252-9} -} - -@Proceedings{ grumberg.ea:tools:2007, - editor = {Orna Grumberg and Michael Huth}, - title = {Tools and Algorithms for the Construction and Analysis of - Systems, 13th International Conference, TACAS 2007, Held as - Part of the Joint European Conferences on Theory and - Practice of Software, ETAPS 2007 Braga, Portugal, March 24 - - April 1, 2007, Proceedings}, - booktitle = {TACAS}, - publisher = pub-springer, - address = pub-springer:adr, - series = s-lncs, - volume = 4424, - year = 2007, - isbn = {978-3-540-71208-4} -} - - -@Article{ brucker.ea:semantic:2006-b, - abstract = {We report on the results of a long-term project to - formalize the semantics of OCL 2.0 in Higher-order Logic - (HOL). The ultimate goal of the project is to provide a - formalized, machine-checked semantic basis for a theorem - proving environment for OCL (as an example for an - object-oriented specification formalism) which is as - faithful as possible to the original informal semantics. We - report on various (minor) inconsistencies of the OCL - semantics, discuss the more recent attempt to align the OCL - semantics with UML 2.0 and suggest several extensions which - make, in our view, OCL semantics more fit for future - extensions towards programming-like verifications and - specification refinement, which are, in our view, necessary - to make OCL more fit for future extensions. }, - author = {Achim D. Brucker and J\"urgen Doser and Burkhart Wolff}, - language = {USenglish}, - public = {yes}, - categories = {holocl}, - classification= {workshop}, - areas = {formal methods, software}, - keywords = {HOL-OCL, UML/OCL, formal semantics}, - title = {Semantic Issues of {OCL}: Past, Present, and Future}, - editor = {Birgith Demuth and Dan Chiorean and Martin Gogolla and Jos - Warmer}, - issn = {1863-2122}, - volume = {5}, - year = {2006}, - journal = {Electronic Communications of the EASST}, - copyright = {ECEASST}, - copyrighturl = {http://eceasst.cs.tu-berlin.de/index.php/eceasst/article/view/46} - , - pdf = {http://www.brucker.ch/bibliography/download/2006/brucker.ea-semantic-2006-b.pdf}, - url = {http://www.brucker.ch/bibliography/abstract/brucker.ea-semantic-2006-b} - -} - -@InCollection{ brucker.ea:proposal:2002, - abstract = {We present a formal semantics as a conservative shallow - embedding of the Object Constraint Language (OCL). OCL is - currently under development within an open standardization - process within the OMG; our work is an attempt to accompany - this process by a proposal solving open questions in a - consistent way and exploring alternatives of the language - design. Moreover, our encoding gives the foundation for - tool supported reasoning over OCL specifications, for - example as basis for test case generation.}, - keywords = {Isabelle, OCL, UML, shallow embedding, testing}, - location = {Hampton, VA, USA}, - author = {Achim D. Brucker and Burkhart Wolff}, - booktitle = {Theorem Proving in Higher Order Logics (TPHOLs)}, - editor = {V{\'\i}ctor A. Carre{\~n}o and C{\'e}sar A. Mu{\~n}oz and - Sophi{\`e}ne Tahar}, - language = {USenglish}, - pdf = {http://www.brucker.ch/bibliography/download/2002/brucker.ea-proposal-2002.pdf}, - filelabel = {Extended Version}, - file = {http://www.brucker.ch/bibliography/download/2002/ocl_semantic_extended.pdf}, - publisher = {Springer-Verlag}, - address = {Heidelberg}, - series = {Lecture Notes in Computer Science}, - number = {2410}, - pages = {99--114}, - project = {CSFMDOS}, - doi = {10.1007/3-540-45685-6_8}, - title = {A Proposal for a Formal {OCL} Semantics in - {Isabelle/HOL}}, - categories = {holocl}, - classification= {conference}, - areas = {formal methods, software}, - isbn = {3-540-44039-9}, - issn = {0302-9743}, - year = {2002}, - public = {yes}, - url = {http://www.brucker.ch/bibliography/abstract/brucker.ea-proposal-2002} - -} - -@InProceedings{ brucker.ea:summary-aachen:2013, - author = {Achim D. Brucker and Dan Chiorean and Tony Clark and - Birgit Demuth and Martin Gogolla and Dimitri Plotnikov and - Bernhard Rumpe and Edward D. Willink and Burkhart Wolff}, - title = {Report on the {Aachen} {OCL} Meeting}, - booktitle = {Proceedings of the MODELS 2013 OCL Workshop (OCL 2013)}, - location = {Miami, USA}, - editor = {Jordi Cabot and Martin Gogolla and Istvan Rath and Edward - Willink}, - publisher = {CEUR-WS.org}, - series = {CEUR Workshop Proceedings}, - volume = {1092}, - ee = {http://ceur-ws.org/Vol-1092}, - pages = {103--111}, - year = {2013}, - abstract = {As a continuation of the OCL workshop during the MODELS - 2013 conference in October 2013, a number of OCL experts - decided to meet in November 2013 in Aachen for two days to - discuss possible short term improvements of OCL for an - upcoming OMG meeting and to envision possible future - long-term developments of the language. This paper is a - sort of ``minutes of the meeting'' and intended to quickly - inform the OCL community about the discussion topics.}, - classification= {invited}, - categories = {holocl}, - areas = {software}, - public = {yes}, - pdf = {http://www.brucker.ch/bibliography/download/2013/brucker.ea-ocl-aachen-2013.pdf}, - url = {http://www.brucker.ch/bibliography/abstract/brucker.ea-summary-aachen-2013} - -} - -@InCollection{ brucker.ea:transformation:2006, - abstract = {SecureUML is a security modeling language for formalizing - access control requirements in a declarative way. It is - equipped with a UML notation in terms of a UML profile, - and can be combined with arbitrary design modeling - languages. We present a semantics for SecureUML in terms of - a model transformation to standard UML/OCL. The - transformation scheme is used as part of an implementation - of a tool chain ranging from front-end visual modeling - tools over code-generators to the interactive theorem - proving environment \holocl. The methodological - consequences for an analysis of the generated OCL formulae - are discussed.}, - keywords = {security, SecureUML, UML, OCL, HOL-OCL, - model-transformation}, - location = {Genova}, - author = {Achim D. Brucker and J\"urgen Doser and Burkhart Wolff}, - booktitle = {{MoDELS} 2006: Model Driven Engineering Languages and - Systems}, - language = {USenglish}, - publisher = {Springer-Verlag}, - talk = {talk:brucker.ea:transformation:2006}, - address = {Heidelberg}, - series = {Lecture Notes in Computer Science}, - doi = {10.1007/11880240_22}, - number = {4199}, - pages = {306--320}, - editor = {Oscar Nierstrasz and Jon Whittle and David Harel and - Gianna Reggio}, - project = {CSFMDOS}, - title = {A Model Transformation Semantics and Analysis Methodology - for {SecureUML}}, - categories = {holocl}, - classification= {conference}, - areas = {security, formal methods, software}, - file = {http://www.brucker.ch/bibliography/download/2006/brucker.ea-transformation-2006-b.pdf}, - filelabel = {Extended Version}, - year = {2006}, - public = {yes}, - pdf = {http://www.brucker.ch/bibliography/download/2006/brucker.ea-transformation-2006.pdf}, - note = {An extended version of this paper is available as ETH - Technical Report, no. 524.}, - url = {http://www.brucker.ch/bibliography/abstract/brucker.ea-transformation-2006} - -} - -@TechReport{ brucker.ea:hol-ocl-book:2006, - author = {Achim D. Brucker and Burkhart Wolff}, - institution = {ETH Zurich}, - language = {USenglish}, - title = {The {HOL-OCL} Book}, - classification= {unrefereed}, - areas = {formal methods, software}, - categories = {holocl}, - year = {2006}, - number = {525}, - abstract = {HOL-OCL is an interactive proof environment for the Object - Constraint Language (OCL). It is implemented as a shallow - embedding of OCL into the Higher-order Logic (HOL) instance - of the interactive theorem prover Isabelle. HOL-OCL defines - a machine-checked formalization of the semantics as - described in the standard for OCL 2.0. This conservative, - shallow embedding of UML/OCL into Isabelle/HOL includes - support for typed, extensible UML data models supporting - inheritance and subtyping inside the typed lambda-calculus - with parametric polymorphism. As a consequence of - conservativity with respect to higher-order logic (HOL), we - can guarantee the consistency of the semantic model. - Moreover, HOL-OCL provides several derived calculi for - UML/OCL that allow for formal derivations establishing the - validity of UML/OCL formulae. Elementary automated support - for such proofs is also provided top }, - bibkey = {brucker.ea:hol-ocl-book:2006}, - pdf = {http://www.brucker.ch/bibliography/download/2006/brucker.ea-hol-ocl-book-2006.pdf}, - keywords = {security, SecureUML, UML, OCL, HOL-OCL, - model-transformation}, - public = {yes}, - url = {http://www.brucker.ch/bibliography/abstract/brucker.ea-hol-ocl-book-2006} - -} - -@InCollection{ brucker.ea:hol-ocl:2008, - abstract = {We present the theorem proving environment HOL-OCL that is - integrated in a MDE framework. HOL-OCL allows to reason - over UMLclass models annotated with OCL specifications. - Thus, HOL-OCL strengthens a crucial part of the UML to an - object-oriented formal method. HOL-OCL provides several - derived proof calculi that allow for formal derivations - establishing the validity of UML/OCL formulae. These - formulae arise naturally when checking the consistency of - class models, when formally refining abstract models to - more concrete ones or when discharging side-conditions from - model-transformations.}, - keywords = {HOL-OCL, UML, OCL, Formal Methods, Theorem Proving, - Refinement}, - location = {Budapest, Hungary}, - author = {Achim D. Brucker and Burkhart Wolff}, - booktitle = {Fundamental Approaches to Software Engineering - {(FASE08)}}, - talk = {brucker.ea:hol-ocl:2008}, - language = {USenglish}, - publisher = {Springer-Verlag}, - address = {Heidelberg}, - series = {Lecture Notes in Computer Science}, - number = {4961}, - doi = {10.1007/978-3-540-78743-3_8}, - pages = {97--100}, - editor = {Jos{\'e} Fiadeiro and Paola Inverardi}, - title = {{HOL-OCL} -- {A Formal Proof Environment for - {UML}/{OCL}}}, - categories = {holocl}, - classification= {conference}, - areas = {formal methods, software}, - year = {2008}, - pdf = {http://www.brucker.ch/bibliography/download/2008/brucker.ea-hol-ocl-2008.pdf}, - public = {yes}, - url = {http://www.brucker.ch/bibliography/abstract/brucker.ea-hol-ocl-2008} - -} - -@PhDThesis{ brucker:interactive:2007, - author = {Achim D. Brucker}, - title = {An Interactive Proof Environment for Object-oriented - Specifications}, - school = {ETH Zurich}, - year = {2007}, - public = {yes}, - month = mar, - classification= {thesis}, - areas = {formal methods, software}, - categories = {holocl}, - keywords = {OCL, UML, formal semantics, theorem proving, Isabelle, - HOL-OCL}, - note = {ETH Dissertation No. 17097.}, - abstract = {We present a semantic framework for object-oriented - specification languages. We develop this framework as a - conservative shallow embedding in Isabelle/HOL. Using only - conservative extensions guarantees by construction the - consistency of our formalization. Moreover, we show how our - framework can be used to build an interactive proof - environment, called HOL-OCL, for object-oriented - specifications in general and for UML/OCL in particular. - - Our main contributions are an extensible encoding of - object-oriented data structures in HOL, a datatype package - for object-oriented specifications, and the development of - several equational and tableaux calculi for object-oriented - specifications. Further, we show that our formal framework - can be the basis of a formal machine-checked semantics for - OCL that is compliant to the OCL 2.0 standard. }, - abstract_de = {In dieser Arbeit wird ein semantisches Rahmenwerk f{\"u}r - objektorientierte Spezifikationen vorgestellt. Das - Rahmenwerk ist als konservative, flache Einbettung in - Isabelle/HOL realisiert. Durch die Beschr{\"a}nkung auf - konservative Erweiterungen kann die logische Konsistenz der - Einbettung garantiert werden. Das semantische Rahmenwerk - wird verwendet, um das interaktives Beweissystem HOL-OCL - f{\"u}r objektorientierte Spezifikationen im Allgemeinen - und insbesondere f{\"u}r UML/OCL zu entwickeln. - - Die Hauptbeitr{\"a}ge dieser Arbeit sind die Entwicklung - einer erweiterbaren Kodierung objektorientierter - Datenstrukturen in HOL, ein Datentyp-Paket f{\"u}r - objektorientierte Spezifikationen und die Entwicklung - verschiedener Kalk{\"u}le f{\"u}r objektorientierte - Spezifikationen. Zudem zeigen wir, wie das formale - Rahmenwerk verwendet werden kann, um eine formale, - maschinell gepr{\"u}fte Semantik f{\"u}r OCL anzugeben, die - konform zum Standard f{\"u}r OCL 2.0 ist.}, - pdf = {http://www.brucker.ch/bibliography/download/2007/brucker-interactive-2007.pdf}, - url = {http://www.brucker.ch/bibliography/abstract/brucker-interactive-2007} - -} - - -@Article{ brucker.ea:extensible:2008-b, - abstract = {We present an extensible encoding of object-oriented data - models into HOL. Our encoding is supported by a datatype - package that leverages the use of the shallow embedding - technique to object-oriented specification and programming - languages. The package incrementally compiles an - object-oriented data model, i.e., a class model, to a - theory containing object-universes, constructors, accessor - functions, coercions (casts) between dynamic and static - types, characteristic sets, and co-inductive class - invariants. The package is conservative, i.e., all - properties are derived entirely from constant definitions, - including the constraints over object structures. As an - application, we use the package for an object-oriented - core-language called IMP++, for which we formally prove the - correctness of a Hoare-Logic with respect to a denotational - semantics.}, - author = {Achim D. Brucker and Burkhart Wolff}, - language = {USenglish}, - public = {yes}, - classification= {journal}, - areas = {formal methods, software}, - keywords = {object-oriented data models, HOL, theorem proving, - verification}, - title = {An Extensible Encoding of Object-oriented Data Models in - HOL}, - year = {2008}, - journal = {Journal of Automated Reasoning}, - volume = {41}, - issue = {3}, - pages = {219--249}, - issn = {0168-7433}, - doi = {10.1007/s10817-008-9108-3}, - categories = {holocl}, - publisher = {Springer-Verlag}, - address = {Heidelberg}, - pdf = {http://www.brucker.ch/bibliography/download/2008/brucker.ea-extensible-2008-b.pdf}, - url = {http://www.brucker.ch/bibliography/abstract/brucker.ea-extensible-2008-b} - -} - -@Article{ brucker.ea:semantics:2009, - author = {Achim D. Brucker and Burkhart Wolff}, - title = {Semantics, Calculi, and Analysis for Object-oriented - Specifications}, - journal = {Acta Informatica}, - classification= {journal}, - areas = {formal methods, software}, - keywords = {UML, OCL, object-oriented specification, refinement, - formal methods}, - abstract = {We present a formal semantics for an object-oriented - specification language. The formal semantics is presented - as a conservative shallow embedding in Isabelle/HOL and the - language is oriented towards OCL formulae in the context of - UML class diagrams. On this basis, we formally derive - several equational and tableaux calculi, which form the - basis of an integrated proof environment including - automatic proof support and support for the analysis of - this type of specifications. - - We show applications of our proof environment to data - refinement based on an adapted standard refinement notion. - Thus, we provide an integrated formal method for - refinement-based object-oriented development.}, - year = {2009}, - language = {USenglish}, - public = {yes}, - issn = {0001-5903}, - doi = {10.1007/s00236-009-0093-8}, - categories = {holocl}, - pages = {255--284}, - month = jul, - volume = {46}, - number = {4}, - publisher = {Springer-Verlag}, - address = {Heidelberg}, - pdf = {http://www.brucker.ch/bibliography/download/2009/brucker.ea-semantics-2009.pdf}, - url = {http://www.brucker.ch/bibliography/abstract/brucker.ea-semantics-2009} - -} -@InCollection{ brucker.ea:ocl-null:2009, - author = {Achim D. Brucker and Matthias P. Krieger and Burkhart - Wolff}, - wsbooktitle = {The Pragmatics of OCL and Other Textual Specification - Languages}, - note = {Selected best papers from all satellite events of the - MoDELS 2009 conference.}, - booktitle = {Models in Software Engineering}, - publisher = {Springer-Verlag}, - address = {Heidelberg}, - series = {Lecture Notes in Computer Science}, - number = {6002}, - editor = {Sudipto Gosh}, - pages = {261--275}, - doi = {10.1007/978-3-642-12261-3_25}, - language = {USenglish}, - title = {Extending {OCL} with Null-References}, - year = {2009}, - classification= {workshop}, - categories = {holocl}, - location = {Denver, Colorado, USA}, - areas = {formal methods, software}, - public = {yes}, - abstract = {From its beginnings, OCL is based on a strict semantics - for undefinedness, with the exception of the logical - connectives of type Boolean that constitute a three-valued - propositional logic. Recent versions of the OCL standard - added a second exception element, which, similar to the - null references in object-oriented programming languages, - is given a non-strict semantics. Unfortunately, this - extension has been done in an ad hoc manner, which results - in several inconsistencies and contradictions. - - In this paper, we present a consistent formal semantics - (based on our HOL-OCL approach) that includes such a - non-strict exception element. We discuss the possible - consequences concerning class diagram semantics as well as - deduction rules. The benefits of our approach for the - specification-pragmatics of design level operation - contracts are demonstrated with a small case-study.}, - bibkey = {brucker.ea:ocl-null:2009}, - pdf = {http://www.brucker.ch/bibliography/download/2009/brucker.ea-ocl-null-2009.pdf}, - keywords = {HOL-OCL, UML, OCL, null reference, formal semantics}, - url = {http://www.brucker.ch/bibliography/abstract/brucker.ea-ocl-null-2009} - -} - -@InCollection{ brucker.ea:ocl-testing:2010, - abstract = {Automated test data generation is an important method for - the verification and validation of UML/OCL specifications. - In this paper, we present an extension of DNF-based test - case generation methods to cyclic class-diagrams and - recursive query operations on them. A key feature of our - approach is a implicit representation of object graphs - avoiding a representation based on object-id's; thus, our - approach avoids the generation of isomorphic object graphs - by using a concise and still human-readable symbolic - representation.}, - author = {Achim D. Brucker and Matthias P. Krieger and Delphine - Longuet and Burkhart Wolff}, - booktitle = {MoDELS Workshops}, - language = {USenglish}, - public = {yes}, - publisher = {Springer-Verlag}, - address = {Heidelberg}, - series = {Lecture Notes in Computer Science}, - number = {6627}, - classification= workshop, - areas = {formal methods, software}, - year = {2010}, - note = {Selected best papers from all satellite events of the - MoDELS 2010 conference. Workshop on OCL and Textual - Modelling.}, - categories = {holocl,holtestgen}, - keywords = {OCL, UML, test case generation, specification-based - testing}, - pages = {334--348}, - title = {A Specification-based Test Case Generation Method for - {UML}/{OCL}}, - editor = {J{\"u}rgen Dingel and Arnor Solberg}, - isbn = {978-3-642-21209-3}, - pdf = {http://www.brucker.ch/bibliography/download/2010/brucker.ea-ocl-testing-2010.pdf}, - doi = {10.1007/978-3-642-21210-9_33}, - url = {http://www.brucker.ch/bibliography/abstract/brucker.ea-ocl-testing-2010} - -} - - - -@InCollection{ brucker.ea:hol-testgen:2009, - abstract = {We present HOL-TestGen, an extensible test environment for - specification-based testing build upon the proof assistant - Isabelle. HOL-TestGen leverages the semi-automated - generation of test theorems (a form of a partition), and - their refinement to concrete test data, as well as the - automatic generation of a test driver for the execution and - test result verification. - - HOL-TestGen can also be understood as a unifying technical - and conceptual framework for presenting and investigating - the variety of unit and sequence test techniques in a - logically consistent way. }, - keywords = {symbolic test case generations, black box testing, white - box testing, theorem proving, interactive testing}, - location = {York, UK}, - author = {Achim D. Brucker and Burkhart Wolff}, - booktitle = {Fundamental Approaches to Software Engineering - {(FASE09)}}, - talk = {talk:brucker.ea:hol-testgen:2009}, - language = {USenglish}, - publisher = {Springer-Verlag}, - address = {Heidelberg}, - series = {Lecture Notes in Computer Science}, - number = {5503}, - doi = {10.1007/978-3-642-00593-0_28}, - pages = {417--420}, - editor = {Marsha Chechik and Martin Wirsing}, - title = {{HOL-TestGen}: An Interactive Test-case Generation - Framework}, - categories = {holtestgen}, - classification= {conference}, - areas = {formal methods, software}, - year = {2009}, - pdf = {http://www.brucker.ch/bibliography/download/2009/brucker.ea-hol-testgen-2009.pdf}, - public = {yes}, - url = {http://www.brucker.ch/bibliography/abstract/brucker.ea-hol-testgen-2009} - -} - -@InProceedings{ brucker.ea:path-expressions:2013, - author = {Achim D. Brucker and Delphine Longuet and Fr{\'e}d{\'e}ric - Tuong and Burkhart Wolff}, - title = {On the Semantics of Object-oriented Data Structures and - Path Expressions}, - year = 2013, - booktitle = {Proceedings of the \acs{models} 2013 \acs{ocl} Workshop (\acs{ocl} 2013)}, - location = {Miami, \acs{usa}}, - editor = {Jordi Cabot and Martin Gogolla and Istv{\'a}n R{\'a}th and - Edward D. Willink}, - publisher = {\acs{ceur-ws}.org}, - series = {\acs{ceur} Workshop Proceedings}, - volume = 1092, - ee = {http://ceur-ws.org/Vol-1092}, - pages = {23--32}, - abstract = { \\acs{uml}/\\acs{ocl} is perceived as the de-facto standard for - specifying object-oriented models in general and data - models in particular. Since recently, all data types of - \\acs{uml}/\\acs{ocl} comprise two different exception elements: - \inlineocl{invalid} (``bottom'' in semantics terminology) - and \inlineocl{null} (for ``non-existing element''). This - has far-reaching consequences on both the logical and - algebraic properties of \\acs{ocl} expressions as well as the - path expressions over object-oriented data structures, \ie, - class models. - - In this paper, we present a formal semantics for - object-oriented data models in which all data types and, - thus, all class attributes and path expressions, support - \inlineocl{invalid} and \inlineocl{null}. Based on this - formal semantics, we present a set of \\acs{ocl} test cases that - can be used for evaluating the support of \inlineocl{null} - and \inlineocl{invalid} in \\acs{ocl} tools.}, - classification= {workshop}, - categories = {holocl}, - areas = {formal methods, software}, - keywords = {Object-oriented Data Structures, Path Expressions, - Featherweight \acs{ocl}, Null, Invalid, Formal Semantics}, - public = {yes}, - pdf = {http://www.brucker.ch/bibliography/download/2013/brucker.ea-path-expressions-2013.pdf}, - note = {An extended version of this paper is available as \acs{lri} - Technical Report 1565.}, - filelabel = {Extended Version}, - file = {http://www.brucker.ch/bibliography/download/2013/brucker.ea-path-expressions-2013-b.pdf}, - url = {http://www.brucker.ch/bibliography/abstract/brucker.ea-path-expressions-2013} - -} - - -@InProceedings{ riazanov.ea:vampire:1999, - author = {Alexandre Riazanov and Andrei Voronkov}, - title = {Vampire}, - booktitle = {CADE}, - year = 1999, - pages = {292--296}, - doi = {10.1007/3-540-48660-7_26}, - crossref = {ganzinger:automated:1999} -} - -@Proceedings{ ganzinger:automated:1999, - editor = {Harald Ganzinger}, - title = {Automated Deduction - CADE-16, 16th International - Conference on Automated Deduction, Trento, Italy, July - 7-10, 1999, Proceedings}, - booktitle = {CADE}, - publisher = pub-springer, - series = s-lncs, - volume = 1632, - year = 1999, - isbn = {3-540-66222-7} -} -@Booklet{ levens.ea:jml:2007, - bibkey = {levens.ea:jml:2007}, - author = {Gary T. Leavens and Erik Poll and Curtis Clifton and - Yoonsik Cheon and Clyde Ruby and David R. Cok and Peter - M\"{u}ller and Joseph Kiniry and Patrice Chalin}, - title = {{\acs{jml}} Reference Manual (Revision 1.2)}, - month = feb, - year = 2007, - organization = {Department of Computer Science, Iowa State University.}, - note = {Available from \url{http://www.jmlspecs.org}}, - acknowledgement={brucker, 2007-04-23} -} - -@InProceedings{ haftmann.ea:constructive:2006, - author = {Florian Haftmann and Makarius Wenzel}, - title = {Constructive Type Classes in Isabelle}, - booktitle = {Types for Proofs and Programs, International Workshop, - {TYPES} 2006, Nottingham, UK, April 18-21, 2006, Revised - Selected Papers}, - year = 2006, - pages = {160--174}, - crossref = {altenkirch.ea:types:2007}, - url = {http://dx.doi.org/10.1007/978-3-540-74464-1_11}, - doi = {10.1007/978-3-540-74464-1_11}, - timestamp = {Thu, 04 Sep 2014 22:14:34 +0200}, - biburl = {http://dblp.uni-trier.de/rec/bib/conf/types/HaftmannW06} -} - -@Proceedings{ altenkirch.ea:types:2007, - editor = {Thorsten Altenkirch and Conor McBride}, - title = {Types for Proofs and Programs, International Workshop, - {TYPES} 2006, Nottingham, UK, April 18-21, 2006, Revised - Selected Papers}, - series = {Lecture Notes in Computer Science}, - year = 2007, - volume = 4502, - publisher = {Springer}, - isbn = {978-3-540-74463-4}, - timestamp = {Thu, 04 Sep 2014 22:14:34 +0200}, - biburl = {http://dblp.uni-trier.de/rec/bib/conf/types/2006} -} - diff --git a/Citadelle/src/document/root.tex b/Citadelle/src/document/root.tex deleted file mode 100644 index d62ec842cfe317e6789a7ad0ac5eb87bac2e70e5..0000000000000000000000000000000000000000 --- a/Citadelle/src/document/root.tex +++ /dev/null @@ -1,348 +0,0 @@ -\documentclass[fontsize=10pt,DIV12,paper=a4,open=right,twoside,abstract=true]{scrreprt} -\usepackage{fixltx2e} -\usepackage[T1]{fontenc} -\usepackage[utf8]{inputenc} -\usepackage{lmodern} -\usepackage{textcomp} -\usepackage[english]{babel} -\usepackage{isabelle} -\isatagannexa - \usepackage{omg} - \usepackage{draftwatermark} - \SetWatermarkAngle{55} - \SetWatermarkLightness{.9} - \SetWatermarkFontSize{3cm} - \SetWatermarkScale{1.4} - \SetWatermarkText{\textbf{\textsf{Draft Proposal}}} -\endisatagannexa -\usepackage[alpine]{ifsym} -\usepackage[nocolortable, noaclist,isasymonly,nocolor]{hol-ocl-isar} -\renewcommand{\lfloor}{\isasymHolOclLiftLeft} -\renewcommand{\rfloor}{\isasymHolOclLiftRight} -\renewcommand{\lceil}{\isasymHolOclDropLeft} -\renewcommand{\rceil}{\isasymHolOclDropRight} -\renewcommand{\oclkeywordstyle}{\bfseries} -\renewcommand{\javakeywordstyle}{\bfseries} -\renewcommand{\smlkeywordstyle}{\bfseries} -\renewcommand{\holoclthykeywordstyle}{} -\renewcommand{\greenkeywordstyle}{} - -\usepackage{lstisar} -\usepackage{railsetup} -\usepackage[]{mathtools} -\usepackage{% - multirow, - paralist, - booktabs, % " " " - threeparttable, - longtable, % Mehrseitige Tabellen -} - - - -\usepackage{graphicx} -\usepackage[numbers, sort&compress, sectionbib]{natbib} -\usepackage{chapterbib} -\usepackage[caption=false]{subfig} -\usepackage{tabu} -\usepackage{prooftree} -\usepackage[draft]{fixme} -\usepackage[pdfpagelabels, pageanchor=false, bookmarksnumbered, plainpages=false]{hyperref} -\graphicspath{{data/},{figures/}} -\makeatletter -\renewcommand*\l@section{\bprot@dottedtocline{1}{1.5em}{2.8em}} -\renewcommand*\l@subsection{\bprot@dottedtocline{2}{3.8em}{3.7em}} -\renewcommand*\l@subsubsection{\bprot@dottedtocline{3}{7.0em}{5em}} -\renewcommand*\l@paragraph{\bprot@dottedtocline{4}{10em}{6.2em}} -%\renewcommand*\l@paragraph{\bprot@dottedtocline{4}{10em}{5.5em}} -\renewcommand*\l@subparagraph{\bprot@dottedtocline{5}{12em}{7.7em}} -%\renewcommand*\l@subparagraph{\bprot@dottedtocline{5}{12em}{6.5em}} -\makeatother -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%%% Overall the (rightfully issued) warning by Koma Script that \rm -%%% etc. should not be used (they are deprecated since more than a -%%% decade) - \DeclareOldFontCommand{\rm}{\normalfont\rmfamily}{\mathrm} - \DeclareOldFontCommand{\sf}{\normalfont\sffamily}{\mathsf} - \DeclareOldFontCommand{\tt}{\normalfont\ttfamily}{\mathtt} - \DeclareOldFontCommand{\bf}{\normalfont\bfseries}{\mathbf} - \DeclareOldFontCommand{\it}{\normalfont\itshape}{\mathit} -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - -\setcounter{tocdepth}{3} % printed TOC not too detailed -\hypersetup{bookmarksdepth=3} % more detailed digital TOC (aka bookmarks) -\sloppy -\allowdisplaybreaks[4] -\raggedbottom - -\newcommand{\FOL}{FOL\xspace} -\newcommand{\HOL}{HOL\xspace} -\newcommand{\OCL}{OCL\xspace} -\newcommand{\UML}{UML\xspace} -\newcommand{\HOLOCL}{HOL-OCL\xspace} -\newcommand{\FOCL}{Featherweight OCL\xspace} -\newcommand{\ML}{ML\xspace} -\newcommand{\HOCL}{HOL-OCL 2.0\xspace} -\renewcommand{\HolTrue}{\mathrm{True}} -\renewcommand{\HolFalse}{\mathrm{False}} -\newcommand{\ptmi}[1]{\using{\mi{#1}}} -\newcommand{\Lemma}[1]{{\color{BrickRed}% - \mathbf{\operatorname{lemma}}}~\text{#1:}\quad} -\newcommand{\done}{{\color{OliveGreen}\operatorname{done}}} -\newcommand{\apply}[1]{{\holoclthykeywordstyle% - \operatorname{apply}}(\text{#1})} -\newcommand{\IIbegin} {{\operatorname{begin}}} -\newcommand{\IIend} {{\operatorname{end}}} -\newcommand{\fun} {{\holoclthykeywordstyle\operatorname{fun}}} -\newcommand{\overloading} {{\holoclthykeywordstyle\operatorname{overloading}}} -\newcommand{\isardef} {{\holoclthykeywordstyle\operatorname{definition}}} -\newcommand{\where} {{\holoclthykeywordstyle\operatorname{where}}} -\newcommand{\datatype} {{\holoclthykeywordstyle\operatorname{datatype}}} -\newcommand{\types} {{\holoclthykeywordstyle\operatorname{types}}} -\newcommand{\Instance} {{\holoclthykeywordstyle\operatorname{Instance}}} -\newcommand{\State} {{\holoclthykeywordstyle\operatorname{State}}} -\newcommand{\Transition} {{\holoclthykeywordstyle\operatorname{Transition}}} -\newcommand{\record} {{\holoclthykeywordstyle\operatorname{record}}} -\newcommand{\tysequence} {\text{\ttfamily Sequence}} -\newcommand{\pglabel}[1]{\text{#1}} -\renewcommand{\isasymOclUndefined}{\ensuremath{\mathtt{invalid}}} -\newcommand{\isasymOclNull}{\ensuremath{\mathtt{null}}} -\newcommand{\isasymOclInvalid}{\isasymOclUndefined} -\DeclareMathOperator{\inv}{inv} -\newcommand{\Null}[1]{{\ensuremath{\mathtt{null}_\text{{#1}}}}} -\newcommand{\testgen}{HOL-TestGen\xspace} -\newcommand{\HolOption}{\mathrm{option}} -\renewcommand{\to}{\Rightarrow} -\newcommand{\ran}{\mathrm{ran}} -\newcommand{\dom}{\mathrm{dom}} -\newcommand{\typedef}{\mathrm{typedef}} -\newcommand{\typesynonym}{\mathrm{type\_synonym}} -\newcommand{\mi}[1]{\,\text{#1}} -\newcommand{\state}[1]{(#1) \operatorname{state}} -\newcommand{\mocl}[1]{\text{\inlineocl|#1|}} -\DeclareMathOperator{\TCnull}{null} -\DeclareMathOperator{\HolNull}{null} -\DeclareMathOperator{\HolBot}{bot} -\newcommand{\isaAA}{\mathfrak{A}} - -% urls in roman style, theory text in math-similar italics -\urlstyle{rm} -\isabellestyle{it} -\newcommand{\ie}{i.\,e.\xspace} -\newcommand{\eg}{e.\,g.\xspace} - -\newenvironment{isamarkuplazy_text}{\par \isacommand{lazy{\isacharunderscore}text}\isamarkupfalse\isacharverbatimopen\isastyletext\begin{isapar}}{\end{isapar}\isacharverbatimclose} -\newcommand{\isactrlmkUNDERSCOREstring}{\isakeywordcontrol{mk{\isacharunderscore}string}} -\renewcommand{\isasymguillemotleft}{\isatext{\textquotedblleft}} -\renewcommand{\isasymguillemotright}{\isatext{\textquotedblright}} -\begin{document} -\renewcommand{\subsubsectionautorefname}{Section} -\renewcommand{\subsectionautorefname}{Section} -\renewcommand{\sectionautorefname}{Section} -\renewcommand{\chapterautorefname}{Chapter} -\newcommand{\subtableautorefname}{\tableautorefname} -\newcommand{\subfigureautorefname}{\figureautorefname} -\isatagannexa -\renewcommand\thepart{\Alph{part}} -\renewcommand\partname{Annex} -\endisatagannexa - -\newenvironment{defholsimple}{\textbf{Definition}\xspace}{} - -\newenvironment{matharray}[1]{\[\begin{array}{#1}}{\end{array}\]} % from 'iman.sty' -\newcommand{\indexdef}[3]% -{\ifthenelse{\equal{}{#1}}{\index{#3 (#2)|bold}}{\index{#3 (#1\ #2)|bold}}} % from 'isar.sty' - - - -\isatagafp - \title{Featherweight OCL} - \subtitle{A Proposal for a Machine-Checked Formal Semantics for OCL 2.5 %\\ - %\includegraphics[scale=.5]{figures/logo_focl} - } -\endisatagafp -\isatagannexa - \title{A Formal Machine-Checked Semantics for OCL 2.5} - \subtitle{A Proposal for the "Annex A" of the OCL Standard} -\endisatagannexa -\isatagnoexample - \title{Featherweight OCL (without ``employee'' examples)} -\endisatagnoexample -\author{% - \href{http://www.brucker.ch/}{Achim D. Brucker}\footnotemark[1] - \and - \href{https://www.lri.fr/~tuong/}{Fr\'ed\'eric Tuong}\footnotemark[2]~\footnotemark[3] - \and - \href{https://www.lri.fr/~wolff/}{Burkhart Wolff}\footnotemark[2]~\footnotemark[3]} -\publishers{% - \footnotemark[1]~SAP SE\\ - Vincenz-Priessnitz-Str. 1, 76131 Karlsruhe, - Germany \texorpdfstring{\\}{} \href{mailto:"Achim D. Brucker" - <achim.brucker@sap.com>}{achim.brucker@sap.com}\\[2em] - % - \footnotemark[2]~LRI, Univ. Paris-Sud, CNRS, CentraleSup\'elec, Universit\'e Paris-Saclay \\ - b\^at. 650 Ada Lovelace, 91405 Orsay, France \texorpdfstring{\\}{} - \href{mailto:"Frederic Tuong" - <frederic.tuong@lri.fr>}{frederic.tuong@lri.fr} \hspace{4.5em} - \href{mailto:"Burkhart Wolff" - <burkhart.wolff@lri.fr>}{burkhart.wolff@lri.fr} \\[2em] - % - \footnotemark[3]~IRT SystemX\\ - 8 av.~de la Vauve, 91120 Palaiseau, France \texorpdfstring{\\}{} - \href{mailto:"Frederic Tuong" - <frederic.tuong@irt-systemx.fr>}{frederic.tuong@irt-systemx.fr} \quad - \href{mailto:"Burkhart Wolff" - <burkhart.wolff@irt-systemx.fr>}{burkhart.wolff@irt-systemx.fr} -} - - -\maketitle -\isatagannexa -\cleardoublepage -\endisatagannexa - -\isatagafp - \begin{abstract} - The Unified Modeling Language (UML) is one of the few modeling - languages that is widely used in industry. While UML is mostly known - as diagrammatic modeling language (\eg, visualizing class models), - it is complemented by a textual language, called Object Constraint - Language (OCL). OCL is a textual annotation language, originally based on a - three-valued logic, that turns UML into a formal language. - Unfortunately the semantics of this specification language, captured - in the ``Annex A'' of the OCL standard, leads to different - interpretations of corner cases. Many of these corner cases had - been subject to formal analysis since more than ten years. - - The situation complicated with the arrival of version 2.3 of the OCL - standard. OCL was aligned with the latest version of UML: this led to the - extension of the three-valued logic by a second exception element, called - \inlineocl{null}. While the first exception element - \inlineocl{invalid} has a strict semantics, \inlineocl{null} has a - non strict interpretation. The combination of these semantic features lead - to remarkable confusion for implementors of OCL compilers and - interpreters. - - In this paper, we provide a formalization of the core of OCL in - HOL\@. It provides denotational definitions, a logical calculus and - operational rules that allow for the execution of OCL expressions by - a mixture of term rewriting and code compilation. Moreover, we describe - a coding-scheme for UML class models that were annotated by - code-invariants and code contracts. An implementation of this coding-scheme - has been undertaken: it consists of a kind of compiler that takes a UML class - model and translates it into a family of definitions and derived - theorems over them capturing the properties of constructors and selectors, - tests and casts resulting from the class model. However, this compiler - is \emph{not} included in this document. - - Our formalization reveals several inconsistencies and contradictions - in the current version of the OCL standard. They reflect a challenge - to define and implement OCL tools in a uniform manner. Overall, this - document is intended to provide the basis for a machine-checked text - ``Annex A'' of the OCL standard targeting at tool implementors. - -%% Le Langage de Modélisation Unifié (UML) fait partie des quelques -%% langages de modélisation couramment utilisés dans l'industrie. Alors -%% qu'UML est bien souvent connu comme langage de modélisation de -%% diagrammes (par exemple, comme classes de modèles visuels), il est -%% plus précisément complémenté par un langage textuel, appelé Langage -%% Contraint d'Objet (OCL). OCL est un langage d'annotation textuel, -%% originellement basé sur une logique 3-valuée, et fait ainsi apparaître -%% UML comme un langage plutôt formel. Pourtant la sémantique de ce -%% langage de spécification, instinctivement décrit dans l'annexe A du -%% standard d'OCL, mène à différentes interprétations concernant le sens -%% précis des informations véhiculées. Ces différentes interprétations -%% sont encore en cours d'élucidation depuis plus de dix ans via -%% notamment l'emploi d'outils d'analyse formelle. -%% -%% La situation s'est compliquée avec la mise à jour vers la version 2.3 -%% du standard d'OCL. Étant donné qu'OCL dépends de la dernière version -%% d'UML, il a été nécessaire d'introduire comme extension à la logique -%% 3-valuée un second élément d'exception, qui est null. Ce qui le -%% différencie avec le premier élément d'exception invalid, c'est sa -%% sémantique non-stricte, alors qu'invalid a une sémantique stricte. La -%% combinaison de ces variétés sémantiques a finalement abouti à divers -%% confusions lors de l'implémentation de compilateurs OCL. -%% -%% Dans ce papier, nous apportons une formalisation du cœur d'OCL en -%% HOL. Il contient des définitions dénotationnelles, un système de -%% calcul logique et des règles opérationnelles permettant l'exécution -%% des expressions OCL à travers une mixture de règles de réécriture et -%% de compilation de code. De plus, nous décrivons un schéma de codage -%% pour les modèles de classes UML pour représenter les invariants et -%% contrats UML. Une implémentation de ce schéma de codage a été -%% effectuée : il s'agit d'un genre particulier de compilateur acceptant -%% en entrée des classes de modèles UML et générant en sortie une famille -%% de définitions, théorèmes associés sur les propriétés des -%% constructeurs et sélecteurs, fonctions de tests ainsi que des -%% mutations de types. Ce compilateur n'est cependant pas inclus dans ce -%% document. -%% -%% Nos formalisations ont finalement révélés des inconsistances et -%% contradictions concernant la version courante du standard d'OCL. Par -%% ailleurs cela représente un challenge de définir et implémenter des -%% outils pour OCL de manière uniformément cohérente. Ce document a pour -%% but de fournir des bases vérifiées mécaniquement, et servir comme -%% support sémantique à l'Annexe A du standard d'OCL ciblant -%% particulièrement les programmeurs d'outils et compilateurs. - \end{abstract} - \tableofcontents -\endisatagafp - -\part{Formal Semantics of OCL} -\input{introduction} -%\clearpage -\isatagafp -\input{session} -\endisatagafp -\isatagnoexample -\input{session} -\endisatagnoexample -\isatagannexa -\input{UML_Types.tex} -\input{UML_Logic.tex} -\input{UML_PropertyProfiles.tex} -\input{UML_Boolean.tex} -\input{UML_Void.tex} -\input{UML_Integer.tex} -\input{UML_Real.tex} -\input{UML_String.tex} -\input{UML_Pair.tex} -\input{UML_Bag.tex} -\input{UML_Set.tex} -\input{UML_Sequence.tex} -\input{UML_Library.tex} -\input{UML_State.tex} -\input{UML_Contracts.tex} -%\input{UML_Tools.tex} -%\input{UML_Main.tex} -% \input{Design_UML.tex} -% \input{Design_OCL.tex} -\input{Analysis_UML.tex} -\input{Analysis_OCL.tex} -\part{Bibliography} -\endisatagannexa -\isatagafp -\input{conclusion} %no conclusion for standard document -\endisatagafp -\bibliographystyle{abbrvnat} -\bibliography{root} - -\isatagafp -\appendix -\part{Appendix} -\endisatagafp -\input{FOCL_Syntax} - -\isatagannexa - \part{Table of Contents} - \clearpage {\small \tableofcontents } -\endisatagannexa -\end{document} - -%%% Local Variables: -%%% mode: latex -%%% TeX-master: t -%%% End: - -% LocalWords: implementors denotational OCL UML diff --git a/Citadelle/src/document/syntax_main.tex b/Citadelle/src/document/syntax_main.tex deleted file mode 100644 index 8962b769c5d796d8a0e12774eae031b8e0a9bfe2..0000000000000000000000000000000000000000 --- a/Citadelle/src/document/syntax_main.tex +++ /dev/null @@ -1,85 +0,0 @@ -\documentclass[10pt,DIV12,a4paper,openright,twoside,abstracton]{scrreprt} -\usepackage{fixltx2e} -\usepackage[T1]{fontenc} -\usepackage[utf8]{inputenc} -\usepackage{textcomp} -\usepackage{isabelle} -\usepackage{% - multirow, - paralist, - booktabs, % " " " - threeparttable, - longtable, % Mehrseitige Tabellen -} - - -\usepackage[nocolortable, noaclist,isasymonly]{hol-ocl-isar} - -\renewcommand{\lfloor}{\isasymHolOclLiftLeft} -\renewcommand{\rfloor}{\isasymHolOclLiftRight} -\renewcommand{\lceil}{\isasymHolOclDropLeft} -\renewcommand{\rceil}{\isasymHolOclDropRight} - -\usepackage[]{mathtools} - -\newcommand{\HOL}{HOL\xspace} -\newcommand{\OCL}{OCL\xspace} -\newcommand{\UML}{UML\xspace} -\newcommand{\HOLOCL}{HOL-OCL\xspace} -\newcommand{\FOCL}{Featherweight OCL\xspace} -\newcommand{\ptmi}[1]{\using{\mi{#1}}} -\newcommand{\Lemma}[1]{{\color{BrickRed}% - \mathbf{\operatorname{lemma}}}~\text{#1:}\quad} -\newcommand{\done}{{\color{OliveGreen}\operatorname{done}}} -\newcommand{\apply}[1]{{\holoclthykeywordstyle% - \operatorname{apply}}(\text{#1})} -\newcommand{\fun} {{\holoclthykeywordstyle\operatorname{fun}}} -\newcommand{\isardef} {{\holoclthykeywordstyle\operatorname{definition}}} -\newcommand{\where} {{\holoclthykeywordstyle\operatorname{where}}} -\newcommand{\datatype} {{\holoclthykeywordstyle\operatorname{datatype}}} -\newcommand{\types} {{\holoclthykeywordstyle\operatorname{types}}} -\newcommand{\pglabel}[1]{\text{#1}} -\renewcommand{\isasymOclUndefined}{\ensuremath{\mathtt{invalid}}} -\newcommand{\isasymOclNull}{\ensuremath{\mathtt{null}}} -\newcommand{\isasymOclInvalid}{\isasymOclUndefined} -\DeclareMathOperator{\inv}{inv} -\newcommand{\Null}[1]{{\ensuremath{\mathtt{null}_\text{{#1}}}}} -\newcommand{\testgen}{HOL-TestGen\xspace} -\newcommand{\HolOption}{\mathrm{option}} -\newcommand{\ran}{\mathrm{ran}} -\newcommand{\dom}{\mathrm{dom}} -\newcommand{\typedef}{\mathrm{typedef}} -\newcommand{\typesynonym}{\mathrm{type\_synonym}} -\newcommand{\mi}[1]{\,\text{#1}} -\newcommand{\state}[1]{\ifthenelse{\equal{}{#1}}% - {\operatorname{state}}% - {\operatorname{\mathit{state}}(#1)}% -} -\newcommand{\mocl}[1]{\text{\inlineocl|#1|}} -\DeclareMathOperator{\TCnull}{null} -\DeclareMathOperator{\HolNull}{null} -\DeclareMathOperator{\HolBot}{bot} -\newcommand{\isaAA}{\mathfrak{A}} - -% urls in roman style, theory text in math-similar italics -\newcommand{\ie}{i.\,e.\xspace} -\newcommand{\eg}{e.\,g.\xspace} - -\newenvironment{isamarkuplazy_text}{\par \isacommand{lazy{\isacharunderscore}text}\isamarkupfalse\isacharverbatimopen\isastyletext\begin{isapar}}{\end{isapar}\isacharverbatimclose} -\renewcommand{\isasymguillemotleft}{\isatext{\textquotedblleft}} -\renewcommand{\isasymguillemotright}{\isatext{\textquotedblright}} -\newcommand{\isactrlconst}{isactrlconst} -\newcommand{\isactrltype}{isactrltype} -\begin{document} - -\newenvironment{matharray}[1]{\[\begin{array}{#1}}{\end{array}\]} % from 'iman.sty' - -\input{FOCL_Syntax} -\end{document} - -%%% Local Variables: -%%% mode: latex -%%% TeX-master: t -%%% End: - -% LocalWords: implementors denotational OCL UML diff --git a/Citadelle/src/print_syntax/Doc.thy b/Citadelle/src/print_syntax/Doc.thy deleted file mode 100644 index fc56d92874ed2e01385ec9cec44a1ee58904c1c9..0000000000000000000000000000000000000000 --- a/Citadelle/src/print_syntax/Doc.thy +++ /dev/null @@ -1,128 +0,0 @@ -(****************************************************************************** - * 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 Doc -imports Gram -begin -ML_file "~~/src/Doc/antiquote_setup.ML" - -text\<open> -The command @{command print_syntax'} takes as input the format -generated by @{command print_syntax} (more precisely the section between ``\<^verbatim>\<open>prods\<close>'' -and ``\<^verbatim>\<open>print modes\<close>''), then it generates in the output window a text to be ``manually'' -included in other documents (the printing resembles to @{command sledgehammer}). - -There are various options for keeping specific lines or discarding them: -\<^item> @{keyword "init"}/@{keyword "remove"}: For example in @{file "Gram_Main.thy"}, we have copied the - native grammar of the object-logic HOL (from @{theory Main}). - The option \<^theory_text>\<open>init Main\<close> (in \<^theory_text>\<open>print_syntax' init Main\<close>) - defines at the position where it is written the name of this grammar to be \<open>Main\<close>. - Later, we can use this name to - discard all lines appearing in \<open>Main\<close>: this is what is done in - @{file "Gram_Generator_dynamic_sequential.thy"}, when we used the option - \<^theory_text>\<open>remove Main\<close>. - -\<^item> @{keyword "add"}: Unlike @{keyword "remove"}, it is possible to explicitly add specific - sections to keep. For instance, we could write: - @{theory_text [display] - \<open>print_syntax' remove Main add "Fun.updbinds", aprop - prods: - Fun.updbind = any[0] ":=" any[0] => "_updbind" (1000)\<close>} - \<^verbatim>\<open>(* [etc...]*)\<close> - -\<^item> Lines can also be discarded or added with these special symbols - ``\<^theory_text>\<open><<<\<close>'' or ``\<^theory_text>\<open>>>>\<close>'': - @{theory_text [display] \<open> - print_syntax' remove Main (*OCL_compiler_generator_dynamic*) add "Fun.updbinds", aprop - prods: - >>> - Fun.updbind = any[0] ":=" any[0] => "_updbind" (1000) - Fun.updbinds = Fun.updbind[0] "," Fun.updbinds[0] => "_updbinds" (1000) - Fun.updbinds = Fun.updbind[-1] (-1) - <<< - HOL.case_syn = any[0] "\<Rightarrow>" any[0] => "_case1" (10) - HOL.case_syn = any[0] "=>" any[0] => "_case1" (10) - >>> - HOL.cases_syn = HOL.case_syn[0] "|" HOL.cases_syn[0] => "_case2" (1000) - HOL.cases_syn = HOL.case_syn[-1] (-1)\<close>} - \<^verbatim>\<open>(* [etc...]*)\<close> - Instead of matching parentheses, this behaves as a stack (no need to - have the same number of ``\<^theory_text>\<open><<<\<close>'' exactly matching ``\<^theory_text>\<open>>>>\<close>''). - -\<^item> In order to keep a specific number of lines or dropping them, - there are also @{keyword "keep"} or @{keyword "drop"}: - @{theory_text [display] \<open> - print_syntax' init p - prods: - Fun.updbind = any[0] ":=" any[0] => "_updbind" (1000) - drop 2 Fun.updbinds = Fun.updbind[0] "," Fun.updbinds[0] => "_updbinds" (1000) - Fun.updbinds = Fun.updbind[-1] (-1) - HOL.case_syn = any[0] "\<Rightarrow>" any[0] => "_case1" (10) - drop HOL.case_syn = any[0] "=>" any[0] => "_case1" (10) - HOL.cases_syn = HOL.case_syn[0] "|" HOL.cases_syn[0] => "_case2" (1000) - >>> - keep 2 HOL.cases_syn = HOL.case_syn[-1] (-1) - HOL.letbind = pttrn[0] "=" any[0] => "_bind" (10)\<close>} - \<^verbatim>\<open>(* [etc...]*)\<close> -\<close> - -text\<open> -Finally after each line, it is possible to include some textual -cartouches with @{keyword "tex"}: - @{theory_text [display] \<open> - print_syntax' init a - prods: - Fun.updbind = any[0] ":=" any[0] => "_updbind" (1000) - tex \<open>this is a first line\<close> - Fun.updbinds = Fun.updbind[0] "," Fun.updbinds[0] => "_updbinds" (1000) - Fun.updbinds = Fun.updbind[-1] (-1) - tex \<open>this is another example\<close> - HOL.case_syn = any[0] "\<Rightarrow>" any[0] => "_case1" (10) - HOL.case_syn = any[0] "=>" any[0] => "_case1" (10)\<close>} - \<^verbatim>\<open>(* [etc...]*)\<close> - -Other options are also provided like @{keyword "no_tex"}, @{keyword "tex_raw"}. -\<close> -end diff --git a/Citadelle/src/print_syntax/Gram.thy b/Citadelle/src/print_syntax/Gram.thy deleted file mode 100644 index b1a40cfdc3fb01dc3e4e5b7ac6394b99d45fe8e5..0000000000000000000000000000000000000000 --- a/Citadelle/src/print_syntax/Gram.thy +++ /dev/null @@ -1,210 +0,0 @@ -(****************************************************************************** - * 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. - ******************************************************************************) - -chapter{* Part ... *} - -theory Gram -imports Main - keywords "tex" "no_tex" "tex_raw" "init" "remove" "add" "drop" "keep" "<<<" ">>>" - and "print_syntax'" :: thy_decl -begin - -ML{* - -datatype name = B of binding | S of string -datatype ('a, 'b, 'c) parse_term = Grammar of 'a * 'b - | Grammar_noprio of 'a - | HOL of 'c - -datatype 'a rewrite = NoRewrite | R_underscore of 'a | RConst of 'a | RType of 'a - -datatype 'a gen_mode = Gen_add of 'a | Gen_add_raw | Gen_remove - -datatype 'a filter = Filter_on of int option | Filter_off of int option | Filter_data of 'a - -structure Data_rule = Theory_Data - (type T = Symtab.set Symtab.table - val empty = Symtab.empty - val extend = I - val merge = Symtab.merge (K true)) - -val parse_name = Parse.long_ident >> S || Parse.binding >> B -val parse_int = Scan.optional (Parse.sym_ident >> (fn "-" => false | _ => Scan.fail "syntax error")) true -- Parse.number >> (fn (b, n) => case Int.fromString n of SOME s => if b then s else 0 - s | _ => Scan.fail "syntax error") - -val parse_grammar = - ( parse_name --| Parse.$$$ "=" - -- Scan.repeat ((parse_name -- Scan.option (Parse.$$$ "[" |-- parse_int --| Parse.$$$ "]") >> - (fn (t, prio) => case prio of NONE => HOL t | SOME prio => Grammar (t, prio)))) - -- (Scan.option (Parse.$$$ "=>" |-- Parse.string) >> - (fn NONE => NoRewrite - | SOME s => case Symbol.explode s of "\<^type>" :: s => RType (implode s) - | "\<^const>" :: s => RConst (implode s) - | "_" :: s => R_underscore (implode s) - | _ => Scan.fail "error syntax")) - --| Parse.$$$ "(" -- parse_int --| Parse.$$$ ")" - -- (Scan.option ( @{keyword "no_tex"} >> K Gen_remove - || @{keyword "tex_raw"} >> K Gen_add_raw - || @{keyword "tex"} |-- Parse.document_source >> Gen_add) - )) - -val s_of_name = fn B b => Binding.name_of b | S s => s -fun string_of_rule ((((gram_name, l), rew), prio), doc) = - s_of_name gram_name ^ String.concat (map (fn Grammar (n,_) => s_of_name n | Grammar_noprio n => s_of_name n | HOL n => s_of_name n) l) - -fun show_text l = - let val terminals = Symtab.make_set Lexicon.terminals - val tab = fold (fn ((((gram_name, l), rew), prio), doc) => - Symtab.insert (op =) (s_of_name gram_name, ())) - l - terminals - val s = String.concat (List.concat (map (fn ((((gram_name, l), rew), prio), doc) => - let val l = map (fn HOL s => if Symtab.lookup tab (s_of_name s) = NONE then - HOL s - else - Grammar_noprio s - | x => x) l - fun gram t prio = - let val s0 = s_of_name t - val s = "$\\text{@{text \"" ^ s0 ^ "\"}}" ^ (case prio of NONE => "" | SOME i => "^{\\text{\\color{GreenYellow}" ^ Int.toString i ^ "}}") ^ "$" in - (if Symtab.lookup terminals s0 = NONE then s else "\\fbox{" ^ s ^ "}") ^ " " - end - fun output_text f = - [ "text\<open>{\\color{Gray}($\\text{@{text \"" - ^ s_of_name gram_name ^ "\"}}^{\\text{\\color{GreenYellow}" ^ Int.toString prio ^ "}}$" - ^ ")} " - ^ String.concat (map (fn Grammar (t, p) => gram t (SOME p) - | Grammar_noprio t => gram t NONE - | HOL t => "\\colorbox{Apricot}{" ^ "" ^ f (s_of_name t) ^ "" ^ "} ") l) - ^ (case rew of NoRewrite => "\\hfill{\\small\\color{Gray} (none)}" - | _ => - let val (s, ty) = - case rew of R_underscore s => (s, NONE) - | RConst s => (s, SOME "const") - | RType s => (s, SOME "type") in - "\\hfill{\\color{SkyBlue}" - ^ (case ty of NONE => "\\fbox{\\small\\color{Gray} @{text \"" ^ s ^ "\"}}" - | SOME ty => "\\fbox{\\small @{text \"" ^ s ^ "\"}}\\text{\\space\\color{Black}@{text \"" ^ ty ^ "\"}}") - ^ "}" - end) - ^ "\<close>\n" ] in - case doc of SOME Gen_remove => [] - | SOME Gen_add_raw => output_text (fn "\<^bsub>" => "\\rotatebox[origin=c]{315}{$\\Rightarrow$}" - | "\<^esub>" => "\\rotatebox[origin=c]{45}{$\\Leftarrow$}" - | "op" => "\\isa{op}" - | "\<longlongrightarrow>" => "$\\xrightarrow{\\hphantom{AAA}}$" - | "\<longlonglongrightarrow>" => "$\\xrightarrow{\\hphantom{AAAA}}$") - | _ => List.concat [ output_text (fn s => "@{text \"" ^ s ^ "\"}") - , case doc of SOME (Gen_add s) => [ "(* *) text\<open>" ^ Input.source_content s ^ "\<close>\n" ] - | _ => []] - end) l)) in - writeln (Active.sendback_markup_command s) - end - -fun msg_err msg = "The previous counter is already " ^ msg ^ " (this particular overlapping is not yet implemented)." - -fun check_filter_on b = fn Filter_on (SOME n) => if n >= 1 then error (msg_err "on") else b - | _ => b - -fun check_filter_on_all b = fn Filter_on _ => error (msg_err "on") - | _ => b - -fun check_filter_off b = fn Filter_off (SOME n) => if n >= 1 then error (msg_err "off") else b - | _ => b - -fun check_filter_off_all b = fn Filter_off _ => error (msg_err "off") - | _ => b - -fun filter_drop l0 = - fold (fn Filter_on NONE => (fn (f, accu) => (check_filter_off (Filter_on NONE) f, accu)) - | Filter_off NONE => (fn (f, accu) => (check_filter_on (Filter_off NONE) f, accu)) - | Filter_on (SOME n) => (fn (f, accu) => (check_filter_on_all (check_filter_off (Filter_on (SOME (n - 1))) f) f, accu)) - | Filter_off (SOME n) => (fn (f, accu) => (check_filter_off_all (check_filter_on (Filter_off (SOME (n - 1))) f) f, accu)) - | Filter_data x => fn (b, accu) => ( case b of Filter_on (SOME n) => if n <= 0 then Filter_off NONE else Filter_on (SOME (n - 1)) - | Filter_off (SOME n) => if n <= 0 then Filter_on NONE else Filter_off (SOME (n - 1)) - | x => x - , case b of Filter_on _ => x :: accu - | Filter_off _ => accu)) - l0 - (Filter_on NONE, []) - |> snd - |> rev - -val _ = - Outer_Syntax.command @{command_keyword print_syntax'} - "print inner syntax of context" - ((@{keyword "init"} >> K true || @{keyword "remove"} >> K false) - -- Parse.name - -- Scan.optional (@{keyword "add"} |-- Parse.list1 Parse.name) [] - -- Parse.binding --| Parse.$$$ ":" - -- Scan.repeat (let val parse_n = Scan.option Parse.number >> (SOME o - (fn NONE => 1 - | SOME n => case Int.fromString n of NONE => error "Int.fromString" - | SOME n => if n <= 0 then error "semantics not yet implemented" else n)) in - @{keyword "<<<"} >> K (Filter_on NONE) - || @{keyword ">>>"} >> K (Filter_off NONE) - || (@{keyword "keep"} |-- parse_n) >> Filter_on - || (@{keyword "drop"} |-- parse_n) >> Filter_off - || parse_grammar >> Filter_data - end) >> (fn ((((init, name), l_add), _), l0) => - Toplevel.theory (fn thy => - if init then - let val _ = show_text (filter_drop l0) in - Data_rule.map (Symtab.map_default (name, Symtab.empty) - (fold (fn Filter_data rule => Symtab.insert (op =) (string_of_rule rule, ()) | _ => I) l0)) thy - end - else - let val _ = show_text (List.filter - (let val set = - case Symtab.lookup (Data_rule.get thy) name of SOME s => s | _ => Symtab.empty in - fn e => Symtab.lookup set (string_of_rule e) = NONE - orelse List.exists (case e of ((((gram_name, _), _), _), _) => fn n => s_of_name gram_name = n) l_add - end) - (filter_drop l0)) in - thy - end))) - -*} - -end diff --git a/Citadelle/src/print_syntax/Gram_Generator_dynamic_sequential.thy b/Citadelle/src/print_syntax/Gram_Generator_dynamic_sequential.thy deleted file mode 100644 index a6577471d6c2aa43bf4e38f1a91f90855a0d5428..0000000000000000000000000000000000000000 --- a/Citadelle/src/print_syntax/Gram_Generator_dynamic_sequential.thy +++ /dev/null @@ -1,549 +0,0 @@ -(****************************************************************************** - * 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. - ******************************************************************************) - -chapter{* Part ... *} - -theory Gram_Generator_dynamic_sequential -imports Gram_Main -begin - -print_syntax' remove Main (*Generator_dynamic_sequential*) -prods: - Fun.updbind = any[0] ":=" any[0] => "_updbind" (1000) - Fun.updbinds = Fun.updbind[0] "," Fun.updbinds[0] => "_updbinds" (1000) - Fun.updbinds = Fun.updbind[-1] (-1) - HOL.case_syn = any[0] "=>" any[0] => "_case1" (10) - HOL.case_syn = any[0] "\<Rightarrow>" any[0] => "_case1" (10) - HOL.cases_syn = HOL.case_syn[0] "|" HOL.cases_syn[0] => "_case2" (1000) - HOL.cases_syn = HOL.case_syn[-1] (-1) - HOL.letbind = pttrn[0] "=" any[0] => "_bind" (10) - HOL.letbinds = HOL.letbind[0] ";" HOL.letbinds[0] => "_binds" (1000) - HOL.letbinds = HOL.letbind[-1] (-1) - List.lc_qual = logic[0] => "_lc_test" (1000) - List.lc_qual = any[0] "<-" logic[0] => "_lc_gen" (1000) - List.lc_qual = any[0] "\<leftarrow>" logic[0] => "_lc_gen" (1000) - List.lc_quals = "," List.lc_qual[0] List.lc_quals[0] => "_lc_quals" (1000) - List.lc_quals = "]" => "_lc_end" (1000) - List.lupdbind = any[0] ":=" any[0] => "_lupdbind" (1000) - List.lupdbinds = List.lupdbind[0] "," List.lupdbinds[0] => "_lupdbinds" (1000) - List.lupdbinds = List.lupdbind[-1] (-1) - Map.maplet = any[0] "|->" any[0] => "_maplet" (1000) - Map.maplet = any[0] "[|->]" any[0] => "_maplets" (1000) - Map.maplet = any[0] "\<mapsto>" any[0] => "_maplet" (1000) - Map.maplet = any[0] "[\<mapsto>]" any[0] => "_maplets" (1000) - Map.maplets = Map.maplet[0] "," Map.maplets[0] => "_Maplets" (1000) - Map.maplets = Map.maplet[-1] (-1) - Product_Type.patterns = pttrn[0] "," Product_Type.patterns[0] => "_patterns" (1000) - Product_Type.patterns = pttrn[-1] (-1) - Product_Type.tuple_args = any[0] => "_tuple_arg" (1000) - Product_Type.tuple_args = any[0] "," Product_Type.tuple_args[0] => "_tuple_args" (1000) - Record.field = Record.ident[0] "=" any[0] => "_field" (1000) - Record.field_type = Record.ident[0] "::" type[0] => "_field_type" (1000) - Record.field_types = Record.field_type[0] "," Record.field_types[0] => "_field_types" (1000) - Record.field_types = Record.field_type[-1] (-1) - Record.field_update = Record.ident[0] ":=" any[0] => "_field_update" (1000) - Record.field_updates = Record.field_update[0] "," Record.field_updates[0] => "_field_updates" (1000) - Record.field_updates = Record.field_update[-1] (-1) - Record.fields = Record.field[0] "," Record.fields[0] => "_fields" (1000) - Record.fields = Record.field[-1] (-1) - Record.ident = longid => "_constify" (1000) - Record.ident = id => "_constify" (1000) - any = prop'[-1] (-1) - any = logic[-1] (-1) - aprop = "_" => "\<^const>Pure.dummy_pattern" (1000) - aprop = "XCONST" longid_position[0] => "_context_xconst" (1000) - aprop = "XCONST" id_position[0] => "_context_xconst" (1000) - aprop = "CONST" longid_position[0] => "_context_const" (1000) - aprop = "CONST" id_position[0] => "_context_const" (1000) - aprop = "\<dots>" => "_DDDOT" (1000) - aprop = "(" aprop[0] ")" (1000) - aprop = "..." => "_DDDOT" (1000) - aprop = logic[1000] cargs[1000] => "_applC" (999) - aprop = var_position[-1] (-1) - aprop = longid_position[-1] (-1) - aprop = id_position[-1] (-1) - args = any[0] "," args[0] => "_args" (1000) - args = any[-1] (-1) - asms = "prop"[0] ";" asms[0] => "_asms" (1000) - asms = "prop"[0] => "_asm" (1000) - cargs = any[1000] cargs[1000] => "_cargs" (1000) - cargs = any[-1] (-1) - cartouche_position = cartouche => "_position" (1000) - class_name = longid => "_class_name" (1000) - class_name = id => "_class_name" (1000) - classes = class_name[0] "," classes[0] => "_classes" (1000) - classes = class_name[-1] (-1) - float_const = float_position[0] => "_constify" (1000) - float_position = float_token => "_position" (1000) - id_position = id => "_position" (1000) - idt = "(" idt[0] ")" (1000) - idt = "_" "::" type[0] => "_idtypdummy" (0) - idt = "_" => "_idtdummy" (1000) - idt = id_position[0] "::" type[0] => "_idtyp" (0) - idt = id_position[-1] (-1) - idts = idt[1] idts[0] => "_idts" (0) - idts = idt[-1] (-1) - index = "\<index>" => "_indexvar" (1000) - index = => "_indexdefault" (1000) - index = "\<^bsub>" logic[0] "\<^esub>" => "_index" (1000) - logic = "op" "&&&" => "\<^const>Pure.conjunction" (1000) - logic = "op" "==>" => "\<^const>Pure.imp" (1000) - logic = "op" "==" => "\<^const>Pure.eq" (1000) - logic = "op" "\<Longrightarrow>" => "\<^const>Pure.imp" (1000) - logic = "op" "\<equiv>" => "\<^const>Pure.eq" (1000) - logic = "op" "\<longrightarrow>" => "\<^const>HOL.implies" (1000) - logic = "op" "=" => "\<^const>HOL.eq" (1000) - logic = "op" "\<and>" => "\<^const>HOL.conj" (1000) - logic = "op" "\<or>" => "\<^const>HOL.disj" (1000) - logic = "op" "\<noteq>" => "\<^const>HOL.not_equal" (1000) - logic = "op" "~=" => "\<^const>HOL.not_equal" (1000) - logic = "op" "-->" => "\<^const>HOL.implies" (1000) - logic = "op" "|" => "\<^const>HOL.disj" (1000) - logic = "op" "&" => "\<^const>HOL.conj" (1000) - logic = "op" "\<longleftrightarrow>" => "\<^const>HOL.iff" (1000) - logic = "op" "=simp=>" => "\<^const>HOL.simp_implies" (1000) - logic = "op" "<" => "\<^const>Orderings.ord_class.less" (1000) - logic = "op" "\<le>" => "\<^const>Orderings.ord_class.less_eq" (1000) - logic = "op" "\<ge>" => "\<^const>Orderings.ord_class.greater_eq" (1000) - logic = "op" ">" => "\<^const>Orderings.ord_class.greater" (1000) - logic = "op" "<=" => "\<^const>Orderings.ord_class.less_eq" (1000) - logic = "op" ">=" => "\<^const>Orderings.ord_class.greater_eq" (1000) - logic = "op" "+" => "\<^const>Groups.plus_class.plus" (1000) - logic = "op" "-" => "\<^const>Groups.minus_class.minus" (1000) - logic = "op" "*" => "\<^const>Groups.times_class.times" (1000) - logic = "op" "\<in>" => "\<^const>Set.member" (1000) - logic = "op" "\<notin>" => "\<^const>Set.not_member" (1000) - logic = "op" "~:" => "\<^const>Set.not_member" (1000) - logic = "op" ":" => "\<^const>Set.member" (1000) - logic = "op" "\<subseteq>" => "\<^const>Set.subset_eq" (1000) - logic = "op" "\<subset>" => "\<^const>Set.subset" (1000) - logic = "op" "\<supseteq>" => "\<^const>Set.supset_eq" (1000) - logic = "op" "\<supset>" => "\<^const>Set.supset" (1000) - logic = "op" "\<inter>" => "\<^const>Set.inter" (1000) - logic = "op" "Int" => "\<^const>Set.inter" (1000) - logic = "op" "\<union>" => "\<^const>Set.union" (1000) - logic = "op" "Un" => "\<^const>Set.union" (1000) - logic = "op" "`" => "\<^const>Set.image" (1000) - logic = "op" "-`" => "\<^const>Set.vimage" (1000) - logic = "op" "\<circ>" => "\<^const>Fun.comp" (1000) - logic = "op" "o" => "\<^const>Fun.comp" (1000) - logic = "op" "\<times>" => "\<^const>Product_Type.Times" (1000) - logic = "op" "<+>" => "\<^const>Sum_Type.Plus" (1000) - logic = "op" "dvd" => "\<^const>Rings.dvd_class.dvd" (1000) - logic = "op" "div" => "\<^const>Rings.divide_class.divide" (1000) - logic = "op" "/" => "\<^const>Fields.inverse_class.inverse_divide" (1000) - logic = "op" "^^" => "\<^const>Nat.compower" (1000) - logic = "op" "O" => "\<^const>Relation.relcomp" (1000) - logic = "op" "OO" => "\<^const>Relation.relcompp" (1000) - logic = "op" "``" => "\<^const>Relation.Image" (1000) - logic = "op" "<*lex*>" => "\<^const>Wellfounded.lex_prod" (1000) - logic = "op" "<*mlex*>" => "\<^const>Wellfounded.mlex_prod" (1000) - logic = "op" "initial_segment_of" => "\<^const>Zorn.initialSegmentOf" (1000) - logic = "op" "//" => "\<^const>Equiv_Relations.quotient" (1000) - logic = "op" "respects" => "\<^const>Equiv_Relations.RESPECTS" (1000) - logic = "op" "respects2" => "\<^const>Equiv_Relations.RESPECTS2" (1000) - logic = "op" "^" => "\<^const>Power.power_class.power" (1000) - logic = "op" "mod" => "\<^const>Divides.div_class.mod" (1000) - logic = "op" "#" => "\<^const>List.list.Cons" (1000) - logic = "op" "@" => "\<^const>List.append" (1000) - logic = "op" "!" => "\<^const>List.nth" (1000) - logic = "op" "\<circ>\<^sub>m" => "\<^const>Map.map_comp" (1000) - logic = "op" "++" => "\<^const>Map.map_add" (1000) - logic = "op" "|`" => "\<^const>Map.restrict_map" (1000) - logic = "op" "\<subseteq>\<^sub>m" => "\<^const>Map.map_le" (1000) - logic = "op" "\<times>\<^sub>F" => "\<^const>Filter.prod_filter" (1000) - logic = "op" "@@@@" => "\<^const>Init.L.append" (1000) - logic = "op" "@@" => "\<^const>Init.String.flatten" (1000) - logic = "op" "\<triangleq>" => "\<^const>Init.String.equal" (1000) - logic = "op" "$" => "\<^const>Meta_Pure.term.App" (1000) - logic = "op" "|\<guillemotleft>" => "\<^const>RBT_Impl.ord_class.rbt_less_symbol" (1000) - logic = "op" "\<guillemotleft>|" => "\<^const>RBT_Impl.ord_class.rbt_greater" (1000) - logic = "XCONST" longid_position[0] => "_context_xconst" (1000) - logic = "XCONST" id_position[0] => "_context_xconst" (1000) - logic = "CONST" longid_position[0] => "_context_const" (1000) - logic = "CONST" id_position[0] => "_context_const" (1000) - logic = "\<dots>" => "_DDDOT" (1000) - logic = "TYPE" "(" type[0] ")" => "_TYPE" (1000) - logic = "\<lambda>" pttrns[0] "." any[3] => "_lambda" (3) - logic = "\<lambda>" HOL.cases_syn[0] => "_lam_pats_syntax" (10) - logic = "(" logic[0] ")" (1000) - logic = "(" any[0] "," Product_Type.tuple_args[0] ")" => "_tuple" (1000) - logic = "..." => "_DDDOT" (1000) - logic = "%" pttrns[0] "." any[3] => "_lambda" (3) - logic = "%" HOL.cases_syn[0] => "_lam_pats_syntax" (10) - logic = "_" => "\<^const>Pure.dummy_pattern" (1000) - logic = "\<forall>" idts[0] "." logic[10] => "\<^const>HOL.All_binder" (10) - logic = "\<forall>" idt[0] "\<ge>" any[0] "." logic[10] => "_All_greater_eq" (10) - logic = "\<forall>" idt[0] ">" any[0] "." logic[10] => "_All_greater" (10) - logic = "\<forall>" idt[0] "\<le>" any[0] "." logic[10] => "_All_less_eq" (10) - logic = "\<forall>" idt[0] "<" any[0] "." logic[10] => "_All_less" (10) - logic = "\<forall>" pttrn[0] "\<in>" logic[0] "." logic[10] => "_Ball" (10) - logic = "\<forall>" idt[0] "\<subseteq>" any[0] "." logic[10] => "_setleAll" (10) - logic = "\<forall>" idt[0] "\<subset>" any[0] "." logic[10] => "_setlessAll" (10) - logic = "\<exists>" idts[0] "." logic[10] => "\<^const>HOL.Ex_binder" (10) - logic = "\<exists>" idt[0] "\<ge>" any[0] "." logic[10] => "_Ex_greater_eq" (10) - logic = "\<exists>" idt[0] ">" any[0] "." logic[10] => "_Ex_greater" (10) - logic = "\<exists>" idt[0] "\<le>" any[0] "." logic[10] => "_Ex_less_eq" (10) - logic = "\<exists>" idt[0] "<" any[0] "." logic[10] => "_Ex_less" (10) - logic = "\<exists>" pttrn[0] "\<in>" logic[0] "." logic[10] => "_Bex" (10) - logic = "\<exists>" idt[0] "\<subseteq>" any[0] "." logic[10] => "_setleEx" (10) - logic = "\<exists>" idt[0] "\<subset>" any[0] "." logic[10] => "_setlessEx" (10) - logic = "\<not>" logic[40] => "\<^const>HOL.Not" (40) - logic = "\<exists>!" idts[0] "." logic[10] => "\<^const>HOL.Ex1_binder" (10) - logic = "\<exists>!" pttrn[0] "\<in>" logic[0] "." logic[10] => "_Bex1" (10) - logic = "\<exists>!" idt[0] "\<subseteq>" any[0] "." logic[10] => "_setleEx1" (10) - logic = "~" logic[40] => "\<^const>HOL.Not" (40) - logic = "THE" pttrn[0] "." logic[10] => "_The" (10) - logic = "let" HOL.letbinds[0] "in" any[10] => "_Let" (10) - logic = "case" any[0] "of" HOL.cases_syn[0] => "_case_syntax" (10) - logic = "EX!" idts[0] "." logic[10] => "\<^const>HOL.Ex1_binder" (10) - logic = "EX!" pttrn[0] ":" logic[0] "." logic[10] => "_Bex1" (10) - logic = "EX" idts[0] "." logic[10] => "\<^const>HOL.Ex_binder" (10) - logic = "EX" idt[0] ">=" any[0] "." logic[10] => "_Ex_greater_eq" (10) - logic = "EX" idt[0] ">" any[0] "." logic[10] => "_Ex_greater" (10) - logic = "EX" idt[0] "<=" any[0] "." logic[10] => "_Ex_less_eq" (10) - logic = "EX" idt[0] "<" any[0] "." logic[10] => "_Ex_less" (10) - logic = "EX" pttrn[0] ":" logic[0] "." logic[10] => "_Bex" (10) - logic = "ALL" idts[0] "." logic[10] => "\<^const>HOL.All_binder" (10) - logic = "ALL" idt[0] ">=" any[0] "." logic[10] => "_All_greater_eq" (10) - logic = "ALL" idt[0] ">" any[0] "." logic[10] => "_All_greater" (10) - logic = "ALL" idt[0] "<=" any[0] "." logic[10] => "_All_less_eq" (10) - logic = "ALL" idt[0] "<" any[0] "." logic[10] => "_All_less" (10) - logic = "ALL" pttrn[0] ":" logic[0] "." logic[10] => "_Ball" (10) - logic = "?!" idts[0] "." logic[10] => "\<^const>HOL.Ex1_binder" (10) - logic = "?!" pttrn[0] ":" logic[0] "." logic[10] => "_Bex1" (10) - logic = "?" idts[0] "." logic[10] => "\<^const>HOL.Ex_binder" (10) - logic = "?" idt[0] "<=" any[0] "." logic[10] => "_Ex_less_eq" (10) - logic = "?" idt[0] "<" any[0] "." logic[10] => "_Ex_less" (10) - logic = "?" pttrn[0] ":" logic[0] "." logic[10] => "_Bex" (10) - logic = "!" idts[0] "." logic[10] => "\<^const>HOL.All_binder" (10) - logic = "!" idt[0] "<=" any[0] "." logic[10] => "_All_less_eq" (10) - logic = "!" idt[0] "<" any[0] "." logic[10] => "_All_less" (10) - logic = "!" pttrn[0] ":" logic[0] "." logic[10] => "_Ball" (10) - logic = "if" logic[0] "then" any[0] "else" any[10] => "\<^const>HOL.If" (10) - logic = "LEAST" idts[0] "." logic[10] => "\<^const>Orderings.ord_class.Least_binder" (10) - logic = "LEAST" id ":" logic[0] "." logic[10] => "_Bleast" (10) - logic = "LEAST" id "\<in>" logic[0] "." logic[10] => "_Bleast" (10) - logic = "LEAST" pttrn[0] "WRT" logic[4] "." logic[10] => "_LeastM" (10) - logic = "0" => "\<^const>Groups.zero_class.zero" (1000) - logic = "-" any[81] => "\<^const>Groups.uminus_class.uminus" (80) - logic = "\<bar>" any[0] "\<bar>" => "\<^const>Groups.abs_class.abs" (1000) - logic = "1" => "\<^const>Groups.one_class.one" (1000) - logic = "{" pttrn[0] "." logic[0] "}" => "_Coll" (1000) - logic = "{" pttrn[0] ":" logic[0] "." logic[0] "}" => "_Collect" (1000) - logic = "{" pttrn[0] "\<in>" logic[0] "." logic[0] "}" => "_Collect" (1000) - logic = "{" args[0] "}" => "_Finset" (1000) - logic = "{" any[0] "|" idts[0] "." logic[0] "}" => "_Setcompr" (1000) - logic = "{" any[0] "<..}" => "\<^const>Set_Interval.ord_class.greaterThan" (1000) - logic = "{" any[0] "..}" => "\<^const>Set_Interval.ord_class.atLeast" (1000) - logic = "{" any[0] "<..<" any[0] "}" => "\<^const>Set_Interval.ord_class.greaterThanLessThan" (1000) - logic = "{" any[0] "..<" any[0] "}" => "\<^const>Set_Interval.ord_class.atLeastLessThan" (1000) - logic = "{" any[0] "<.." any[0] "}" => "\<^const>Set_Interval.ord_class.greaterThanAtMost" (1000) - logic = "{" any[0] ".." any[0] "}" => "\<^const>Set_Interval.ord_class.atLeastAtMost" (1000) - logic = "{}" => "\<^const>Set.empty" (1000) - logic = "SUP" pttrn[0] ":" logic[0] "." any[10] => "_SUP" (10) - logic = "SUP" pttrns[0] "." any[10] => "_SUP1" (10) - logic = "INF" pttrn[0] ":" logic[0] "." any[10] => "_INF" (10) - logic = "INF" pttrns[0] "." any[10] => "_INF1" (10) - logic = "\<Inter>" logic[900] => "\<^const>Complete_Lattices.Inter" (900) - logic = "\<Inter>" pttrn[0] "\<in>" logic[0] "." logic[10] => "_INTER" (10) - logic = "\<Inter>" pttrns[0] "." logic[10] => "_INTER1" (10) - logic = "\<Inter>" any[0] "<" any[0] "." logic[10] => "_INTER_less" (10) - logic = "\<Inter>" any[0] "\<le>" any[0] "." logic[10] => "_INTER_le" (10) - logic = "INT" pttrn[0] ":" logic[0] "." logic[10] => "_INTER" (10) - logic = "INT" pttrns[0] "." logic[10] => "_INTER1" (10) - logic = "INT" any[0] "<" any[0] "." logic[10] => "_INTER_less" (10) - logic = "INT" any[0] "<=" any[0] "." logic[10] => "_INTER_le" (10) - logic = "\<Union>" logic[900] => "\<^const>Complete_Lattices.Union" (900) - logic = "\<Union>" pttrn[0] "\<in>" logic[0] "." logic[10] => "_UNION" (10) - logic = "\<Union>" pttrns[0] "." logic[10] => "_UNION1" (10) - logic = "\<Union>" any[0] "<" any[0] "." logic[10] => "_UNION_less" (10) - logic = "\<Union>" any[0] "\<le>" any[0] "." logic[10] => "_UNION_le" (10) - logic = "UN" pttrn[0] ":" logic[0] "." logic[10] => "_UNION" (10) - logic = "UN" pttrns[0] "." logic[10] => "_UNION1" (10) - logic = "UN" any[0] "<" any[0] "." logic[10] => "_UNION_less" (10) - logic = "UN" any[0] "<=" any[0] "." logic[10] => "_UNION_le" (10) - logic = "()" => "\<^const>Product_Type.Unity" (1000) - logic = "SIGMA" pttrn[0] ":" logic[0] "." logic[10] => "_Sigma" (10) - logic = "\<nat>" => "\<^const>Nat.semiring_1_class.Nats" (1000) - logic = "\<some>" pttrn[0] "." logic[10] => "_Eps" (10) - logic = "@" pttrn[0] "." logic[10] => "_Eps" (10) - logic = "SOME" pttrn[0] "." logic[10] => "_Eps" (10) - logic = "GREATEST" idts[0] "." logic[10] => "\<^const>Hilbert_Choice.Greatest_binder" (10) - logic = "GREATEST" pttrn[0] "WRT" logic[4] "." logic[10] => "_GreatestM" (10) - logic = "chain\<^sub>\<subseteq>" => "\<^const>Zorn.chain_subset" (1000) - logic = "CSUM" pttrn[0] ":" logic[51] "." logic[10] => "_Csum" (10) - logic = num_const[0] => "_Numeral" (1000) - logic = "\<Sum>" logic[1000] => "\<^const>Groups_Big.comm_monoid_add_class.Setsum" (999) - logic = "\<Sum>" pttrn[0] "\<in>" logic[51] "." any[10] => "_setsum" (10) - logic = "\<Sum>" pttrn[0] "|" logic[0] "." any[10] => "_qsetsum" (10) - logic = "\<Sum>" idt[0] "\<le>" any[0] "." any[10] => "_upto_setsum" (10) - logic = "\<Sum>" idt[0] "<" any[0] "." any[10] => "_upt_setsum" (10) - logic = "\<Sum>" idt[0] "=" any[0] "..<" any[0] "." any[10] => "_from_upto_setsum" (10) - logic = "\<Sum>" idt[0] "=" any[0] ".." any[0] "." any[10] => "_from_to_setsum" (10) - logic = "\<Sum>" pttrn[0] "\<leftarrow>" logic[51] "." any[10] => "_listsum" (10) - logic = "SUM" pttrn[0] ":" logic[51] "." any[10] => "_setsum" (10) - logic = "SUM" pttrn[0] "|" logic[0] "." any[10] => "_qsetsum" (10) - logic = "SUM" idt[0] "<=" any[0] "." any[10] => "_upto_setsum" (10) - logic = "SUM" idt[0] "<" any[0] "." any[10] => "_upt_setsum" (10) - logic = "SUM" idt[0] "=" any[0] "..<" any[0] "." any[10] => "_from_upto_setsum" (10) - logic = "SUM" idt[0] "=" any[0] ".." any[0] "." any[10] => "_from_to_setsum" (10) - logic = "SUM" pttrn[0] "<-" logic[51] "." any[10] => "_listsum" (10) - logic = "\<Prod>" logic[1000] => "\<^const>Groups_Big.comm_monoid_mult_class.Setprod" (999) - logic = "\<Prod>" pttrn[0] "\<in>" logic[51] "." any[10] => "_setprod" (10) - logic = "\<Prod>" pttrn[0] "|" logic[0] "." any[10] => "_qsetprod" (10) - logic = "\<Prod>" idt[0] "\<le>" any[0] "." any[10] => "_upto_setprod" (10) - logic = "\<Prod>" idt[0] "<" any[0] "." any[10] => "_upt_setprod" (10) - logic = "\<Prod>" idt[0] "=" any[0] "..<" any[0] "." any[10] => "_from_upto_setprod" (10) - logic = "\<Prod>" idt[0] "=" any[0] ".." any[0] "." any[10] => "_from_to_setprod" (10) - logic = "\<Prod>" pttrn[0] "\<leftarrow>" logic[51] "." any[10] => "_listprod" (10) - logic = "PROD" pttrn[0] ":" logic[51] "." any[10] => "_setprod" (10) - logic = "PROD" pttrn[0] "|" logic[0] "." any[10] => "_qsetprod" (10) - logic = "PROD" idt[0] "<=" any[0] "." any[10] => "_upto_setprod" (10) - logic = "PROD" idt[0] "<" any[0] "." any[10] => "_upt_setprod" (10) - logic = "PROD" idt[0] "=" any[0] "..<" any[0] "." any[10] => "_from_upto_setprod" (10) - logic = "PROD" idt[0] "=" any[0] ".." any[0] "." any[10] => "_from_to_setprod" (10) - logic = "PROD" pttrn[0] "<-" logic[51] "." any[10] => "_listprod" (10) - logic = "\<int>" => "\<^const>Int.ring_1_class.Ints" (1000) - logic = "\<Sqinter>\<^sub>f\<^sub>i\<^sub>n" logic[900] => "\<^const>Lattices_Big.semilattice_inf_class.Inf_fin" (900) - logic = "\<Squnion>\<^sub>f\<^sub>i\<^sub>n" logic[900] => "\<^const>Lattices_Big.semilattice_sup_class.Sup_fin" (900) - logic = "{..<" any[0] "}" => "\<^const>Set_Interval.ord_class.lessThan" (1000) - logic = "{.." any[0] "}" => "\<^const>Set_Interval.ord_class.atMost" (1000) - logic = "[]" => "\<^const>List.list.Nil" (1000) - logic = "[" args[0] "]" => "_list" (1000) - logic = "[" pttrn[0] "<-" logic[0] "." logic[0] "]" => "_filter" (1000) - logic = "[" pttrn[0] "\<leftarrow>" logic[0] "." logic[0] "]" => "_filter" (1000) - logic = "[" logic[0] "..<" logic[0] "]" => "\<^const>List.upt" (1000) - logic = "[" any[0] "." List.lc_qual[0] List.lc_quals[0] => "_listcompr" (1000) - logic = "[" logic[0] ".." logic[0] "]" => "\<^const>List.upto" (1000) - logic = "[" Map.maplets[0] "]" => "_Map" (1000) - logic = "CHR" str_position[0] => "_Char" (1000) - logic = str_position[0] => "_String" (1000) - logic = "TYPEREP" "(" type[0] ")" => "_TYPEREP" (1000) - logic = "\<lparr>" Record.fields[0] "," "\<dots>" "=" any[0] "\<rparr>" => "_record_scheme" (1000) - logic = "\<lparr>" Record.fields[0] "\<rparr>" => "_record" (1000) - logic = "(|" Record.fields[0] "," "..." "=" any[0] "|)" => "_record_scheme" (1000) - logic = "(|" Record.fields[0] "|)" => "_record" (1000) - logic = "\<forall>\<^sub>F" pttrn[0] "in" logic[0] "." logic[10] => "_eventually" (10) - logic = "\<exists>\<^sub>F" pttrn[0] "in" logic[0] "." logic[10] => "_frequently" (10) - logic = "\<exists>\<^sub>\<infinity>" idts[0] "." logic[10] => "\<^const>Filter.Inf_many_binder" (10) - logic = "\<forall>\<^sub>\<infinity>" idts[0] "." logic[10] => "\<^const>Filter.Alm_all_binder" (10) - logic = "MOST" idts[0] "." logic[10] => "\<^const>Filter.Alm_all_binder" (10) - logic = "INFM" idts[0] "." logic[10] => "\<^const>Filter.Inf_many_binder" (10) - logic = "LIM" pttrns[1000] any[10] "." any[0] ":>" any[10] => "_LIM" (10) - logic = cartouche_position[0] => "_cartouche_string" (1000) - logic = "\<langle>" logic[0] "\<rangle>" => "_string1" (1000) - logic = "\<prec>" logic[0] "\<succ>" => "_string2" (1000) - logic = "\<lless>" logic[0] "\<ggreater>" => "_string3" (1000) - logic = "\<degree>" logic[0] "\<degree>" => "_char1" (1000) - logic = "lookup" => "_rbt_lookup" (1000) - logic = "insert" => "_rbt_insert" (1000) - logic = "map_entry" => "_rbt_map_entry" (1000) - logic = "modify_def" => "_rbt_modify_def" (1000) - logic = "keys" => "_rbt_keys" (1000) - logic = "lookup2" => "_rbt_lookup2" (1000) - logic = "insert2" => "_rbt_insert2" (1000) - logic = "fold" => "_rbt_fold" (1000) - logic = "entries" => "_rbt_entries" (1000) - logic = "sprint0" logic[0] "\<acute>" => "_sprint0" (1000) - logic = "sprint1" logic[0] "\<acute>" => "_sprint1" (1000) - logic = "sprint2" logic[0] "\<acute>" => "_sprint2" (1000) - logic = "sprint3" logic[0] "\<acute>" => "_sprint3" (1000) - logic = "sprint4" logic[0] "\<acute>" => "_sprint4" (1000) - logic = "sprint5" logic[0] "\<acute>" => "_sprint5" (1000) - logic = logic[51] "|\<guillemotleft>" any[51] => "\<^const>RBT_Impl.ord_class.rbt_less_symbol" (50) - logic = logic[200] "$" logic[201] => "\<^const>Meta_Pure.term.App" (200) - logic = logic[50] "\<triangleq>" logic[51] => "\<^const>Init.String.equal" (50) - logic = logic[66] "@@" logic[65] => "\<^const>Init.String.flatten" (65) - logic = logic[66] "@@@@" logic[65] => "\<^const>Init.L.append" (65) - logic = logic[81] "\<times>\<^sub>F" logic[80] => "\<^const>Filter.prod_filter" (80) - logic = logic[900] "(" Map.maplets[0] ")" => "_MapUpd" (900) - logic = logic[51] "\<subseteq>\<^sub>m" logic[51] => "\<^const>Map.map_le" (50) - logic = logic[110] "|`" logic[111] => "\<^const>Map.restrict_map" (110) - logic = logic[100] "++" logic[101] => "\<^const>Map.map_add" (100) - logic = logic[55] "\<circ>\<^sub>m" logic[56] => "\<^const>Map.map_comp" (55) - logic = logic[100] "!" logic[101] => "\<^const>List.nth" (100) - logic = logic[66] "@" logic[65] => "\<^const>List.append" (65) - logic = logic[81] "respects2" logic[80] => "\<^const>Equiv_Relations.RESPECTS2" (80) - logic = logic[81] "respects" logic[80] => "\<^const>Equiv_Relations.RESPECTS" (80) - logic = logic[90] "//" logic[91] => "\<^const>Equiv_Relations.quotient" (90) - logic = logic[56] "initial_segment_of" logic[56] => "\<^const>Zorn.initialSegmentOf" (55) - logic = logic[81] "<*mlex*>" logic[80] => "\<^const>Wellfounded.mlex_prod" (80) - logic = logic[81] "<*lex*>" logic[80] => "\<^const>Wellfounded.lex_prod" (80) - logic = logic[1000] "^*" => "\<^const>Transitive_Closure.rtrancl" (999) - logic = logic[1000] "^+" => "\<^const>Transitive_Closure.trancl" (999) - logic = logic[1000] "^=" => "\<^const>Transitive_Closure.reflcl" (999) - logic = logic[1000] "^**" => "\<^const>Transitive_Closure.rtranclp" (1000) - logic = logic[1000] "^++" => "\<^const>Transitive_Closure.tranclp" (1000) - logic = logic[1000] "^==" => "\<^const>Transitive_Closure.reflclp" (1000) - logic = logic[1000] "\<^sup>=\<^sup>=" => "\<^const>Transitive_Closure.reflclp" (1000) - logic = logic[1000] "\<^sup>=" => "\<^const>Transitive_Closure.reflcl" (999) - logic = logic[1000] "\<^sup>*\<^sup>*" => "\<^const>Transitive_Closure.rtranclp" (1000) - logic = logic[1000] "\<^sup>+\<^sup>+" => "\<^const>Transitive_Closure.tranclp" (1000) - logic = logic[1000] "\<^sup>+" => "\<^const>Transitive_Closure.trancl" (999) - logic = logic[1000] "\<^sup>*" => "\<^const>Transitive_Closure.rtrancl" (999) - logic = logic[91] "``" logic[90] => "\<^const>Relation.Image" (90) - logic = logic[1000] "^-1" => "\<^const>Relation.converse" (999) - logic = logic[1000] "^--1" => "\<^const>Relation.conversep" (1000) - logic = logic[1000] "\<inverse>\<inverse>" => "\<^const>Relation.conversep" (1000) - logic = logic[1000] "\<inverse>" => "\<^const>Relation.converse" (999) - logic = logic[76] "OO" logic[75] => "\<^const>Relation.relcompp" (75) - logic = logic[76] "O" logic[75] => "\<^const>Relation.relcomp" (75) - logic = logic[66] "<+>" logic[65] => "\<^const>Sum_Type.Plus" (65) - logic = logic[81] "\<times>" logic[80] => "\<^const>Product_Type.Times" (80) - logic = logic[55] "o" logic[56] => "\<^const>Fun.comp" (55) - logic = logic[55] "\<circ>" logic[56] => "\<^const>Fun.comp" (55) - logic = logic[91] "-`" logic[90] => "\<^const>Set.vimage" (90) - logic = logic[91] "`" logic[90] => "\<^const>Set.image" (90) - logic = logic[65] "Un" logic[66] => "\<^const>Set.union" (65) - logic = logic[65] "\<union>" logic[66] => "\<^const>Set.union" (65) - logic = logic[70] "Int" logic[71] => "\<^const>Set.inter" (70) - logic = logic[70] "\<inter>" logic[71] => "\<^const>Set.inter" (70) - logic = logic[51] "\<supset>" logic[51] => "\<^const>Set.supset" (50) - logic = logic[51] "\<supseteq>" logic[51] => "\<^const>Set.supset_eq" (50) - logic = logic[51] "\<subset>" logic[51] => "\<^const>Set.subset" (50) - logic = logic[51] "\<subseteq>" logic[51] => "\<^const>Set.subset_eq" (50) - logic = logic[26] "\<longleftrightarrow>" logic[25] => "\<^const>HOL.iff" (25) - logic = logic[36] "&" logic[35] => "\<^const>HOL.conj" (35) - logic = logic[31] "|" logic[30] => "\<^const>HOL.disj" (30) - logic = logic[26] "-->" logic[25] => "\<^const>HOL.implies" (25) - logic = logic[31] "\<or>" logic[30] => "\<^const>HOL.disj" (30) - logic = logic[36] "\<and>" logic[35] => "\<^const>HOL.conj" (35) - logic = logic[26] "\<longrightarrow>" logic[25] => "\<^const>HOL.implies" (25) - logic = logic[1000] cargs[1000] => "_applC" (999) - logic = logic[4] "::" type[0] => "_constrain" (3) - logic = any[51] "\<guillemotleft>|" logic[51] => "\<^const>RBT_Impl.ord_class.rbt_greater" (50) - logic = any[900] "(|" Record.field_updates[0] "|)" => "_record_update" (900) - logic = any[900] "\<lparr>" Record.field_updates[0] "\<rparr>" => "_record_update" (900) - logic = any[900] "[" List.lupdbinds[0] "]" => "_LUpdate" (900) - logic = any[66] "#" logic[65] => "\<^const>List.list.Cons" (65) - logic = any[70] "mod" any[71] => "\<^const>Divides.div_class.mod" (70) - logic = any[1000] "\<^sup>2" => "\<^const>Power.power_class.power2" (999) - logic = any[81] "^" logic[80] => "\<^const>Power.power_class.power" (80) - logic = any[81] "^^" logic[80] => "\<^const>Nat.compower" (80) - logic = any[70] "/" any[71] => "\<^const>Fields.inverse_class.inverse_divide" (70) - logic = any[70] "div" any[71] => "\<^const>Rings.divide_class.divide" (70) - logic = any[51] "dvd" any[51] => "\<^const>Rings.dvd_class.dvd" (50) - logic = any[1000] "(" Fun.updbinds[0] ")" => "_Update" (900) - logic = any[51] ":" logic[51] => "\<^const>Set.member" (50) - logic = any[51] "~:" logic[51] => "\<^const>Set.not_member" (50) - logic = any[51] "\<notin>" logic[51] => "\<^const>Set.not_member" (50) - logic = any[51] "\<in>" logic[51] => "\<^const>Set.member" (50) - logic = any[70] "*" any[71] => "\<^const>Groups.times_class.times" (70) - logic = any[65] "-" any[66] => "\<^const>Groups.minus_class.minus" (65) - logic = any[65] "+" any[66] => "\<^const>Groups.plus_class.plus" (65) - logic = any[51] ">=" any[51] => "\<^const>Orderings.ord_class.greater_eq" (50) - logic = any[51] "<=" any[51] => "\<^const>Orderings.ord_class.less_eq" (50) - logic = any[51] ">" any[51] => "\<^const>Orderings.ord_class.greater" (50) - logic = any[51] "\<ge>" any[51] => "\<^const>Orderings.ord_class.greater_eq" (50) - logic = any[51] "\<le>" any[51] => "\<^const>Orderings.ord_class.less_eq" (50) - logic = any[51] "<" any[51] => "\<^const>Orderings.ord_class.less" (50) - logic = any[50] "~=" any[51] => "\<^const>HOL.not_equal" (50) - logic = any[50] "\<noteq>" any[51] => "\<^const>HOL.not_equal" (50) - logic = any[50] "=" any[51] => "\<^const>HOL.eq" (50) - logic = var_position[-1] (-1) - logic = longid_position[-1] (-1) - logic = id_position[-1] (-1) - longid_position = longid => "_position" (1000) - num_const = num_position[0] => "_constify" (1000) - num_position = num_token => "_position" (1000) - "prop" = logic[0] => "\<^const>HOL.Trueprop" (5) - "prop" = prop'[-1] (-1) - prop' = "TERM" logic[0] => "\<^const>Pure.term" (1000) - prop' = "SORT_CONSTRAINT" "(" type[0] ")" => "_sort_constraint" (1000) - prop' = "OFCLASS" "(" type[0] "," logic[0] ")" => "_ofclass" (1000) - prop' = "\<lbrakk>" asms[0] "\<rbrakk>" "\<Longrightarrow>" "prop"[1] => "_bigimpl" (1) - prop' = "PROP" aprop[0] => "_aprop" (1000) - prop' = "(" prop'[0] ")" (1000) - prop' = "[|" asms[0] "|]" "==>" "prop"[1] => "_bigimpl" (1) - prop' = "!!" idts[0] "." "prop"[0] => "\<^const>Pure.all_binder" (0) - prop' = "\<And>" idts[0] "." "prop"[0] => "\<^const>Pure.all_binder" (0) - prop' = any[3] "\<equiv>" any[3] => "\<^const>Pure.eq" (2) - prop' = any[3] "==" any[3] => "\<^const>Pure.eq" (2) - prop' = "prop"[2] "\<Longrightarrow>" "prop"[1] => "\<^const>Pure.imp" (1) - prop' = "prop"[2] "==>" "prop"[1] => "\<^const>Pure.imp" (1) - prop' = "prop"[3] "&&&" "prop"[2] => "\<^const>Pure.conjunction" (2) - prop' = "prop"[2] "=simp=>" "prop"[1] => "\<^const>HOL.simp_implies" (1) - prop' = prop'[4] "::" type[0] => "_constrain" (3) - pttrn = "(" pttrn[0] "," Product_Type.patterns[0] ")" => "_pattern" (1000) - pttrn = idt[-1] (-1) - pttrns = pttrn[1] pttrns[0] => "_pttrns" (0) - pttrns = pttrn[-1] (-1) - sort = "{" classes[0] "}" => "_sort" (1000) - sort = "{}" => "_topsort" (1000) - sort = class_name[-1] (-1) - str_position = str_token => "_position" (1000) - string_position = string_token => "_position" (1000) - tid_position = tid => "_position_sort" (1000) - tvar_position = tvar => "_position_sort" (1000) - type = "_" => "\<^type>dummy" (1000) - type = "_" "::" sort[0] => "_dummy_ofsort" (1000) - type = "(" type[0] ")" (1000) - type = "(" type[0] "," types[0] ")" type_name[0] => "_tappl" (1000) - type = "[" types[0] "]" "\<Rightarrow>" type[0] => "_bracket" (0) - type = "[" types[0] "]" "=>" type[0] => "_bracket" (0) - type = tvar_position[1000] "::" sort[0] => "_ofsort" (1000) - type = tid_position[1000] "::" sort[0] => "_ofsort" (1000) - type = "\<lparr>" Record.field_types[0] "," "\<dots>" "::" type[0] "\<rparr>" => "_record_type_scheme" (1000) - type = "\<lparr>" Record.field_types[0] "\<rparr>" => "_record_type" (1000) - type = "(|" Record.field_types[0] "," "..." "::" type[0] "|)" => "_record_type_scheme" (1000) - type = type[1] "\<rightharpoonup>" type[0] => "\<^type>Map.map" (0) - type = type[11] "+" type[10] => "\<^type>Sum_Type.sum" (10) - type = type[21] "*" type[20] => "\<^type>Product_Type.prod" (20) - type = type[21] "\<times>" type[20] => "\<^type>Product_Type.prod" (20) - type = type[1] "=>" type[0] => "\<^type>fun" (0) - type = type[1000] type_name[0] => "_tapp" (1000) - type = type[1] "\<Rightarrow>" type[0] => "\<^type>fun" (0) - type = "(|" Record.field_types[0] "|)" => "_record_type" (1000) - type = type_name[-1] (-1) - type = tvar_position[-1] (-1) - type = tid_position[-1] (-1) - type_name = longid => "_type_name" (1000) - type_name = id => "_type_name" (1000) - types = type[0] "," types[0] => "_types" (1000) - types = type[-1] (-1) - var_position = var => "_position" (1000) - -end diff --git a/Citadelle/src/print_syntax/Gram_Main.thy b/Citadelle/src/print_syntax/Gram_Main.thy deleted file mode 100644 index 09cd46e0d6274e277ec8bc25d73a35742efac76b..0000000000000000000000000000000000000000 --- a/Citadelle/src/print_syntax/Gram_Main.thy +++ /dev/null @@ -1,517 +0,0 @@ -(****************************************************************************** - * 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. - ******************************************************************************) - -chapter{* Part ... *} - -theory Gram_Main -imports Gram -begin - -print_syntax' init Main -prods: - Fun.updbind = any[0] ":=" any[0] => "_updbind" (1000) - Fun.updbinds = Fun.updbind[0] "," Fun.updbinds[0] => "_updbinds" (1000) - Fun.updbinds = Fun.updbind[-1] (-1) - HOL.case_syn = any[0] "=>" any[0] => "_case1" (10) - HOL.case_syn = any[0] "\<Rightarrow>" any[0] => "_case1" (10) - HOL.cases_syn = HOL.case_syn[0] "|" HOL.cases_syn[0] => "_case2" (1000) - HOL.cases_syn = HOL.case_syn[-1] (-1) - HOL.letbind = pttrn[0] "=" any[0] => "_bind" (10) - HOL.letbinds = HOL.letbind[0] ";" HOL.letbinds[0] => "_binds" (1000) - HOL.letbinds = HOL.letbind[-1] (-1) - List.lc_qual = logic[0] => "_lc_test" (1000) - List.lc_qual = any[0] "<-" logic[0] => "_lc_gen" (1000) - List.lc_qual = any[0] "\<leftarrow>" logic[0] => "_lc_gen" (1000) - List.lc_quals = "," List.lc_qual[0] List.lc_quals[0] => "_lc_quals" (1000) - List.lc_quals = "]" => "_lc_end" (1000) - List.lupdbind = any[0] ":=" any[0] => "_lupdbind" (1000) - List.lupdbinds = List.lupdbind[0] "," List.lupdbinds[0] => "_lupdbinds" (1000) - List.lupdbinds = List.lupdbind[-1] (-1) - Map.maplet = any[0] "|->" any[0] => "_maplet" (1000) - Map.maplet = any[0] "[|->]" any[0] => "_maplets" (1000) - Map.maplet = any[0] "\<mapsto>" any[0] => "_maplet" (1000) - Map.maplet = any[0] "[\<mapsto>]" any[0] => "_maplets" (1000) - Map.maplets = Map.maplet[0] "," Map.maplets[0] => "_Maplets" (1000) - Map.maplets = Map.maplet[-1] (-1) - Product_Type.patterns = pttrn[0] "," Product_Type.patterns[0] => "_patterns" (1000) - Product_Type.patterns = pttrn[-1] (-1) - Product_Type.tuple_args = any[0] => "_tuple_arg" (1000) - Product_Type.tuple_args = any[0] "," Product_Type.tuple_args[0] => "_tuple_args" (1000) - Record.field = Record.ident[0] "=" any[0] => "_field" (1000) - Record.field_type = Record.ident[0] "::" type[0] => "_field_type" (1000) - Record.field_types = Record.field_type[0] "," Record.field_types[0] => "_field_types" (1000) - Record.field_types = Record.field_type[-1] (-1) - Record.field_update = Record.ident[0] ":=" any[0] => "_field_update" (1000) - Record.field_updates = Record.field_update[0] "," Record.field_updates[0] => "_field_updates" (1000) - Record.field_updates = Record.field_update[-1] (-1) - Record.fields = Record.field[0] "," Record.fields[0] => "_fields" (1000) - Record.fields = Record.field[-1] (-1) - Record.ident = longid => "_constify" (1000) - Record.ident = id => "_constify" (1000) - any = prop'[-1] (-1) - any = logic[-1] (-1) - aprop = "_" => "\<^const>Pure.dummy_pattern" (1000) - aprop = "XCONST" longid_position[0] => "_context_xconst" (1000) - aprop = "XCONST" id_position[0] => "_context_xconst" (1000) - aprop = "CONST" longid_position[0] => "_context_const" (1000) - aprop = "CONST" id_position[0] => "_context_const" (1000) - aprop = "\<dots>" => "_DDDOT" (1000) - aprop = "(" aprop[0] ")" (1000) - aprop = "..." => "_DDDOT" (1000) - aprop = logic[1000] cargs[1000] => "_applC" (999) - aprop = var_position[-1] (-1) - aprop = longid_position[-1] (-1) - aprop = id_position[-1] (-1) - args = any[0] "," args[0] => "_args" (1000) - args = any[-1] (-1) - asms = "prop"[0] ";" asms[0] => "_asms" (1000) - asms = "prop"[0] => "_asm" (1000) - cargs = any[1000] cargs[1000] => "_cargs" (1000) - cargs = any[-1] (-1) - cartouche_position = cartouche => "_position" (1000) - class_name = longid => "_class_name" (1000) - class_name = id => "_class_name" (1000) - classes = class_name[0] "," classes[0] => "_classes" (1000) - classes = class_name[-1] (-1) - float_const = float_position[0] => "_constify" (1000) - float_position = float_token => "_position" (1000) - id_position = id => "_position" (1000) - idt = "(" idt[0] ")" (1000) - idt = "_" "::" type[0] => "_idtypdummy" (0) - idt = "_" => "_idtdummy" (1000) - idt = id_position[0] "::" type[0] => "_idtyp" (0) - idt = id_position[-1] (-1) - idts = idt[1] idts[0] => "_idts" (0) - idts = idt[-1] (-1) - index = "\<index>" => "_indexvar" (1000) - index = => "_indexdefault" (1000) - index = "\<^bsub>" logic[0] "\<^esub>" => "_index" (1000) tex_raw - logic = "op" "&&&" => "\<^const>Pure.conjunction" (1000) - logic = "op" "==>" => "\<^const>Pure.imp" (1000) - logic = "op" "==" => "\<^const>Pure.eq" (1000) - logic = "op" "\<Longrightarrow>" => "\<^const>Pure.imp" (1000) - logic = "op" "\<equiv>" => "\<^const>Pure.eq" (1000) - logic = "op" "\<longrightarrow>" => "\<^const>HOL.implies" (1000) - logic = "op" "=" => "\<^const>HOL.eq" (1000) - logic = "op" "\<and>" => "\<^const>HOL.conj" (1000) - logic = "op" "\<or>" => "\<^const>HOL.disj" (1000) - logic = "op" "\<noteq>" => "\<^const>HOL.not_equal" (1000) - logic = "op" "~=" => "\<^const>HOL.not_equal" (1000) - logic = "op" "-->" => "\<^const>HOL.implies" (1000) - logic = "op" "|" => "\<^const>HOL.disj" (1000) - logic = "op" "&" => "\<^const>HOL.conj" (1000) - logic = "op" "\<longleftrightarrow>" => "\<^const>HOL.iff" (1000) - logic = "op" "=simp=>" => "\<^const>HOL.simp_implies" (1000) - logic = "op" "<" => "\<^const>Orderings.ord_class.less" (1000) - logic = "op" "\<le>" => "\<^const>Orderings.ord_class.less_eq" (1000) - logic = "op" "\<ge>" => "\<^const>Orderings.ord_class.greater_eq" (1000) - logic = "op" ">" => "\<^const>Orderings.ord_class.greater" (1000) - logic = "op" "<=" => "\<^const>Orderings.ord_class.less_eq" (1000) - logic = "op" ">=" => "\<^const>Orderings.ord_class.greater_eq" (1000) - logic = "op" "+" => "\<^const>Groups.plus_class.plus" (1000) - logic = "op" "-" => "\<^const>Groups.minus_class.minus" (1000) - logic = "op" "*" => "\<^const>Groups.times_class.times" (1000) - logic = "op" "\<in>" => "\<^const>Set.member" (1000) - logic = "op" "\<notin>" => "\<^const>Set.not_member" (1000) - logic = "op" "~:" => "\<^const>Set.not_member" (1000) - logic = "op" ":" => "\<^const>Set.member" (1000) - logic = "op" "\<subseteq>" => "\<^const>Set.subset_eq" (1000) - logic = "op" "\<subset>" => "\<^const>Set.subset" (1000) - logic = "op" "\<supseteq>" => "\<^const>Set.supset_eq" (1000) - logic = "op" "\<supset>" => "\<^const>Set.supset" (1000) - logic = "op" "\<inter>" => "\<^const>Set.inter" (1000) - logic = "op" "Int" => "\<^const>Set.inter" (1000) - logic = "op" "\<union>" => "\<^const>Set.union" (1000) - logic = "op" "Un" => "\<^const>Set.union" (1000) - logic = "op" "`" => "\<^const>Set.image" (1000) - logic = "op" "-`" => "\<^const>Set.vimage" (1000) - logic = "op" "\<circ>" => "\<^const>Fun.comp" (1000) - logic = "op" "o" => "\<^const>Fun.comp" (1000) - logic = "op" "\<times>" => "\<^const>Product_Type.Times" (1000) - logic = "op" "<+>" => "\<^const>Sum_Type.Plus" (1000) - logic = "op" "dvd" => "\<^const>Rings.dvd_class.dvd" (1000) - logic = "op" "div" => "\<^const>Rings.divide_class.divide" (1000) - logic = "op" "/" => "\<^const>Fields.inverse_class.inverse_divide" (1000) - logic = "op" "^^" => "\<^const>Nat.compower" (1000) - logic = "op" "O" => "\<^const>Relation.relcomp" (1000) - logic = "op" "OO" => "\<^const>Relation.relcompp" (1000) - logic = "op" "``" => "\<^const>Relation.Image" (1000) - logic = "op" "<*lex*>" => "\<^const>Wellfounded.lex_prod" (1000) - logic = "op" "<*mlex*>" => "\<^const>Wellfounded.mlex_prod" (1000) - logic = "op" "initial_segment_of" => "\<^const>Zorn.initialSegmentOf" (1000) - logic = "op" "//" => "\<^const>Equiv_Relations.quotient" (1000) - logic = "op" "respects" => "\<^const>Equiv_Relations.RESPECTS" (1000) - logic = "op" "respects2" => "\<^const>Equiv_Relations.RESPECTS2" (1000) - logic = "op" "^" => "\<^const>Power.power_class.power" (1000) - logic = "op" "mod" => "\<^const>Divides.div_class.mod" (1000) - logic = "op" "#" => "\<^const>List.list.Cons" (1000) - logic = "op" "@" => "\<^const>List.append" (1000) - logic = "op" "!" => "\<^const>List.nth" (1000) - logic = "op" "\<circ>\<^sub>m" => "\<^const>Map.map_comp" (1000) - logic = "op" "++" => "\<^const>Map.map_add" (1000) - logic = "op" "|`" => "\<^const>Map.restrict_map" (1000) - logic = "op" "\<subseteq>\<^sub>m" => "\<^const>Map.map_le" (1000) - logic = "op" "\<times>\<^sub>F" => "\<^const>Filter.prod_filter" (1000) - logic = "XCONST" longid_position[0] => "_context_xconst" (1000) - logic = "XCONST" id_position[0] => "_context_xconst" (1000) - logic = "CONST" longid_position[0] => "_context_const" (1000) - logic = "CONST" id_position[0] => "_context_const" (1000) - logic = "\<dots>" => "_DDDOT" (1000) - logic = "TYPE" "(" type[0] ")" => "_TYPE" (1000) - logic = "\<lambda>" pttrns[0] "." any[3] => "_lambda" (3) - logic = "\<lambda>" HOL.cases_syn[0] => "_lam_pats_syntax" (10) - logic = "(" logic[0] ")" (1000) - logic = "(" any[0] "," Product_Type.tuple_args[0] ")" => "_tuple" (1000) - logic = "..." => "_DDDOT" (1000) - logic = "%" pttrns[0] "." any[3] => "_lambda" (3) - logic = "%" HOL.cases_syn[0] => "_lam_pats_syntax" (10) - logic = "_" => "\<^const>Pure.dummy_pattern" (1000) - logic = "\<forall>" idts[0] "." logic[10] => "\<^const>HOL.All_binder" (10) - logic = "\<forall>" idt[0] "\<ge>" any[0] "." logic[10] => "_All_greater_eq" (10) - logic = "\<forall>" idt[0] ">" any[0] "." logic[10] => "_All_greater" (10) - logic = "\<forall>" idt[0] "\<le>" any[0] "." logic[10] => "_All_less_eq" (10) - logic = "\<forall>" idt[0] "<" any[0] "." logic[10] => "_All_less" (10) - logic = "\<forall>" pttrn[0] "\<in>" logic[0] "." logic[10] => "_Ball" (10) - logic = "\<forall>" idt[0] "\<subseteq>" any[0] "." logic[10] => "_setleAll" (10) - logic = "\<forall>" idt[0] "\<subset>" any[0] "." logic[10] => "_setlessAll" (10) - logic = "\<exists>" idts[0] "." logic[10] => "\<^const>HOL.Ex_binder" (10) - logic = "\<exists>" idt[0] "\<ge>" any[0] "." logic[10] => "_Ex_greater_eq" (10) - logic = "\<exists>" idt[0] ">" any[0] "." logic[10] => "_Ex_greater" (10) - logic = "\<exists>" idt[0] "\<le>" any[0] "." logic[10] => "_Ex_less_eq" (10) - logic = "\<exists>" idt[0] "<" any[0] "." logic[10] => "_Ex_less" (10) - logic = "\<exists>" pttrn[0] "\<in>" logic[0] "." logic[10] => "_Bex" (10) - logic = "\<exists>" idt[0] "\<subseteq>" any[0] "." logic[10] => "_setleEx" (10) - logic = "\<exists>" idt[0] "\<subset>" any[0] "." logic[10] => "_setlessEx" (10) - logic = "\<not>" logic[40] => "\<^const>HOL.Not" (40) - logic = "\<exists>!" idts[0] "." logic[10] => "\<^const>HOL.Ex1_binder" (10) - logic = "\<exists>!" pttrn[0] "\<in>" logic[0] "." logic[10] => "_Bex1" (10) - logic = "\<exists>!" idt[0] "\<subseteq>" any[0] "." logic[10] => "_setleEx1" (10) - logic = "~" logic[40] => "\<^const>HOL.Not" (40) - logic = "THE" pttrn[0] "." logic[10] => "_The" (10) - logic = "let" HOL.letbinds[0] "in" any[10] => "_Let" (10) - logic = "case" any[0] "of" HOL.cases_syn[0] => "_case_syntax" (10) - logic = "EX!" idts[0] "." logic[10] => "\<^const>HOL.Ex1_binder" (10) - logic = "EX!" pttrn[0] ":" logic[0] "." logic[10] => "_Bex1" (10) - logic = "EX" idts[0] "." logic[10] => "\<^const>HOL.Ex_binder" (10) - logic = "EX" idt[0] ">=" any[0] "." logic[10] => "_Ex_greater_eq" (10) - logic = "EX" idt[0] ">" any[0] "." logic[10] => "_Ex_greater" (10) - logic = "EX" idt[0] "<=" any[0] "." logic[10] => "_Ex_less_eq" (10) - logic = "EX" idt[0] "<" any[0] "." logic[10] => "_Ex_less" (10) - logic = "EX" pttrn[0] ":" logic[0] "." logic[10] => "_Bex" (10) - logic = "ALL" idts[0] "." logic[10] => "\<^const>HOL.All_binder" (10) - logic = "ALL" idt[0] ">=" any[0] "." logic[10] => "_All_greater_eq" (10) - logic = "ALL" idt[0] ">" any[0] "." logic[10] => "_All_greater" (10) - logic = "ALL" idt[0] "<=" any[0] "." logic[10] => "_All_less_eq" (10) - logic = "ALL" idt[0] "<" any[0] "." logic[10] => "_All_less" (10) - logic = "ALL" pttrn[0] ":" logic[0] "." logic[10] => "_Ball" (10) - logic = "?!" idts[0] "." logic[10] => "\<^const>HOL.Ex1_binder" (10) - logic = "?!" pttrn[0] ":" logic[0] "." logic[10] => "_Bex1" (10) - logic = "?" idts[0] "." logic[10] => "\<^const>HOL.Ex_binder" (10) - logic = "?" idt[0] "<=" any[0] "." logic[10] => "_Ex_less_eq" (10) - logic = "?" idt[0] "<" any[0] "." logic[10] => "_Ex_less" (10) - logic = "?" pttrn[0] ":" logic[0] "." logic[10] => "_Bex" (10) - logic = "!" idts[0] "." logic[10] => "\<^const>HOL.All_binder" (10) - logic = "!" idt[0] "<=" any[0] "." logic[10] => "_All_less_eq" (10) - logic = "!" idt[0] "<" any[0] "." logic[10] => "_All_less" (10) - logic = "!" pttrn[0] ":" logic[0] "." logic[10] => "_Ball" (10) - logic = "if" logic[0] "then" any[0] "else" any[10] => "\<^const>HOL.If" (10) - logic = "LEAST" idts[0] "." logic[10] => "\<^const>Orderings.ord_class.Least_binder" (10) - logic = "LEAST" id ":" logic[0] "." logic[10] => "_Bleast" (10) - logic = "LEAST" id "\<in>" logic[0] "." logic[10] => "_Bleast" (10) - logic = "LEAST" pttrn[0] "WRT" logic[4] "." logic[10] => "_LeastM" (10) - logic = "0" => "\<^const>Groups.zero_class.zero" (1000) - logic = "-" any[81] => "\<^const>Groups.uminus_class.uminus" (80) - logic = "\<bar>" any[0] "\<bar>" => "\<^const>Groups.abs_class.abs" (1000) - logic = "1" => "\<^const>Groups.one_class.one" (1000) - logic = "{" pttrn[0] "." logic[0] "}" => "_Coll" (1000) - logic = "{" pttrn[0] ":" logic[0] "." logic[0] "}" => "_Collect" (1000) - logic = "{" pttrn[0] "\<in>" logic[0] "." logic[0] "}" => "_Collect" (1000) - logic = "{" args[0] "}" => "_Finset" (1000) - logic = "{" any[0] "|" idts[0] "." logic[0] "}" => "_Setcompr" (1000) - logic = "{" any[0] "<..}" => "\<^const>Set_Interval.ord_class.greaterThan" (1000) - logic = "{" any[0] "..}" => "\<^const>Set_Interval.ord_class.atLeast" (1000) - logic = "{" any[0] "<..<" any[0] "}" => "\<^const>Set_Interval.ord_class.greaterThanLessThan" (1000) - logic = "{" any[0] "..<" any[0] "}" => "\<^const>Set_Interval.ord_class.atLeastLessThan" (1000) - logic = "{" any[0] "<.." any[0] "}" => "\<^const>Set_Interval.ord_class.greaterThanAtMost" (1000) - logic = "{" any[0] ".." any[0] "}" => "\<^const>Set_Interval.ord_class.atLeastAtMost" (1000) - logic = "{}" => "\<^const>Set.empty" (1000) - logic = "SUP" pttrn[0] ":" logic[0] "." any[10] => "_SUP" (10) - logic = "SUP" pttrns[0] "." any[10] => "_SUP1" (10) - logic = "INF" pttrn[0] ":" logic[0] "." any[10] => "_INF" (10) - logic = "INF" pttrns[0] "." any[10] => "_INF1" (10) - logic = "\<Inter>" logic[900] => "\<^const>Complete_Lattices.Inter" (900) - logic = "\<Inter>" pttrn[0] "\<in>" logic[0] "." logic[10] => "_INTER" (10) - logic = "\<Inter>" pttrns[0] "." logic[10] => "_INTER1" (10) - logic = "\<Inter>" any[0] "<" any[0] "." logic[10] => "_INTER_less" (10) - logic = "\<Inter>" any[0] "\<le>" any[0] "." logic[10] => "_INTER_le" (10) - logic = "INT" pttrn[0] ":" logic[0] "." logic[10] => "_INTER" (10) - logic = "INT" pttrns[0] "." logic[10] => "_INTER1" (10) - logic = "INT" any[0] "<" any[0] "." logic[10] => "_INTER_less" (10) - logic = "INT" any[0] "<=" any[0] "." logic[10] => "_INTER_le" (10) - logic = "\<Union>" logic[900] => "\<^const>Complete_Lattices.Union" (900) - logic = "\<Union>" pttrn[0] "\<in>" logic[0] "." logic[10] => "_UNION" (10) - logic = "\<Union>" pttrns[0] "." logic[10] => "_UNION1" (10) - logic = "\<Union>" any[0] "<" any[0] "." logic[10] => "_UNION_less" (10) - logic = "\<Union>" any[0] "\<le>" any[0] "." logic[10] => "_UNION_le" (10) - logic = "UN" pttrn[0] ":" logic[0] "." logic[10] => "_UNION" (10) - logic = "UN" pttrns[0] "." logic[10] => "_UNION1" (10) - logic = "UN" any[0] "<" any[0] "." logic[10] => "_UNION_less" (10) - logic = "UN" any[0] "<=" any[0] "." logic[10] => "_UNION_le" (10) - logic = "()" => "\<^const>Product_Type.Unity" (1000) - logic = "SIGMA" pttrn[0] ":" logic[0] "." logic[10] => "_Sigma" (10) - logic = "\<nat>" => "\<^const>Nat.semiring_1_class.Nats" (1000) - logic = "\<some>" pttrn[0] "." logic[10] => "_Eps" (10) - logic = "@" pttrn[0] "." logic[10] => "_Eps" (10) - logic = "SOME" pttrn[0] "." logic[10] => "_Eps" (10) - logic = "GREATEST" idts[0] "." logic[10] => "\<^const>Hilbert_Choice.Greatest_binder" (10) - logic = "GREATEST" pttrn[0] "WRT" logic[4] "." logic[10] => "_GreatestM" (10) - logic = "chain\<^sub>\<subseteq>" => "\<^const>Zorn.chain_subset" (1000) - logic = "CSUM" pttrn[0] ":" logic[51] "." logic[10] => "_Csum" (10) - logic = num_const[0] => "_Numeral" (1000) - logic = "\<Sum>" logic[1000] => "\<^const>Groups_Big.comm_monoid_add_class.Setsum" (999) - logic = "\<Sum>" pttrn[0] "\<in>" logic[51] "." any[10] => "_setsum" (10) - logic = "\<Sum>" pttrn[0] "|" logic[0] "." any[10] => "_qsetsum" (10) - logic = "\<Sum>" idt[0] "\<le>" any[0] "." any[10] => "_upto_setsum" (10) - logic = "\<Sum>" idt[0] "<" any[0] "." any[10] => "_upt_setsum" (10) - logic = "\<Sum>" idt[0] "=" any[0] "..<" any[0] "." any[10] => "_from_upto_setsum" (10) - logic = "\<Sum>" idt[0] "=" any[0] ".." any[0] "." any[10] => "_from_to_setsum" (10) - logic = "\<Sum>" pttrn[0] "\<leftarrow>" logic[51] "." any[10] => "_listsum" (10) - logic = "SUM" pttrn[0] ":" logic[51] "." any[10] => "_setsum" (10) - logic = "SUM" pttrn[0] "|" logic[0] "." any[10] => "_qsetsum" (10) - logic = "SUM" idt[0] "<=" any[0] "." any[10] => "_upto_setsum" (10) - logic = "SUM" idt[0] "<" any[0] "." any[10] => "_upt_setsum" (10) - logic = "SUM" idt[0] "=" any[0] "..<" any[0] "." any[10] => "_from_upto_setsum" (10) - logic = "SUM" idt[0] "=" any[0] ".." any[0] "." any[10] => "_from_to_setsum" (10) - logic = "SUM" pttrn[0] "<-" logic[51] "." any[10] => "_listsum" (10) - logic = "\<Prod>" logic[1000] => "\<^const>Groups_Big.comm_monoid_mult_class.Setprod" (999) - logic = "\<Prod>" pttrn[0] "\<in>" logic[51] "." any[10] => "_setprod" (10) - logic = "\<Prod>" pttrn[0] "|" logic[0] "." any[10] => "_qsetprod" (10) - logic = "\<Prod>" idt[0] "\<le>" any[0] "." any[10] => "_upto_setprod" (10) - logic = "\<Prod>" idt[0] "<" any[0] "." any[10] => "_upt_setprod" (10) - logic = "\<Prod>" idt[0] "=" any[0] "..<" any[0] "." any[10] => "_from_upto_setprod" (10) - logic = "\<Prod>" idt[0] "=" any[0] ".." any[0] "." any[10] => "_from_to_setprod" (10) - logic = "\<Prod>" pttrn[0] "\<leftarrow>" logic[51] "." any[10] => "_listprod" (10) - logic = "PROD" pttrn[0] ":" logic[51] "." any[10] => "_setprod" (10) - logic = "PROD" pttrn[0] "|" logic[0] "." any[10] => "_qsetprod" (10) - logic = "PROD" idt[0] "<=" any[0] "." any[10] => "_upto_setprod" (10) - logic = "PROD" idt[0] "<" any[0] "." any[10] => "_upt_setprod" (10) - logic = "PROD" idt[0] "=" any[0] "..<" any[0] "." any[10] => "_from_upto_setprod" (10) - logic = "PROD" idt[0] "=" any[0] ".." any[0] "." any[10] => "_from_to_setprod" (10) - logic = "PROD" pttrn[0] "<-" logic[51] "." any[10] => "_listprod" (10) - logic = "\<int>" => "\<^const>Int.ring_1_class.Ints" (1000) - logic = "\<Sqinter>\<^sub>f\<^sub>i\<^sub>n" logic[900] => "\<^const>Lattices_Big.semilattice_inf_class.Inf_fin" (900) - logic = "\<Squnion>\<^sub>f\<^sub>i\<^sub>n" logic[900] => "\<^const>Lattices_Big.semilattice_sup_class.Sup_fin" (900) - logic = "{..<" any[0] "}" => "\<^const>Set_Interval.ord_class.lessThan" (1000) - logic = "{.." any[0] "}" => "\<^const>Set_Interval.ord_class.atMost" (1000) - logic = "[]" => "\<^const>List.list.Nil" (1000) - logic = "[" args[0] "]" => "_list" (1000) - logic = "[" pttrn[0] "<-" logic[0] "." logic[0] "]" => "_filter" (1000) - logic = "[" pttrn[0] "\<leftarrow>" logic[0] "." logic[0] "]" => "_filter" (1000) - logic = "[" logic[0] "..<" logic[0] "]" => "\<^const>List.upt" (1000) - logic = "[" any[0] "." List.lc_qual[0] List.lc_quals[0] => "_listcompr" (1000) - logic = "[" logic[0] ".." logic[0] "]" => "\<^const>List.upto" (1000) - logic = "[" Map.maplets[0] "]" => "_Map" (1000) - logic = "CHR" str_position[0] => "_Char" (1000) - logic = str_position[0] => "_String" (1000) - logic = "TYPEREP" "(" type[0] ")" => "_TYPEREP" (1000) - logic = "\<lparr>" Record.fields[0] "," "\<dots>" "=" any[0] "\<rparr>" => "_record_scheme" (1000) - logic = "\<lparr>" Record.fields[0] "\<rparr>" => "_record" (1000) - logic = "(|" Record.fields[0] "," "..." "=" any[0] "|)" => "_record_scheme" (1000) - logic = "(|" Record.fields[0] "|)" => "_record" (1000) - logic = "\<forall>\<^sub>F" pttrn[0] "in" logic[0] "." logic[10] => "_eventually" (10) - logic = "\<exists>\<^sub>F" pttrn[0] "in" logic[0] "." logic[10] => "_frequently" (10) - logic = "\<exists>\<^sub>\<infinity>" idts[0] "." logic[10] => "\<^const>Filter.Inf_many_binder" (10) - logic = "\<forall>\<^sub>\<infinity>" idts[0] "." logic[10] => "\<^const>Filter.Alm_all_binder" (10) - logic = "MOST" idts[0] "." logic[10] => "\<^const>Filter.Alm_all_binder" (10) - logic = "INFM" idts[0] "." logic[10] => "\<^const>Filter.Inf_many_binder" (10) - logic = "LIM" pttrns[1000] any[10] "." any[0] ":>" any[10] => "_LIM" (10) - logic = logic[81] "\<times>\<^sub>F" logic[80] => "\<^const>Filter.prod_filter" (80) - logic = logic[900] "(" Map.maplets[0] ")" => "_MapUpd" (900) - logic = logic[51] "\<subseteq>\<^sub>m" logic[51] => "\<^const>Map.map_le" (50) - logic = logic[110] "|`" logic[111] => "\<^const>Map.restrict_map" (110) - logic = logic[100] "++" logic[101] => "\<^const>Map.map_add" (100) - logic = logic[55] "\<circ>\<^sub>m" logic[56] => "\<^const>Map.map_comp" (55) - logic = logic[100] "!" logic[101] => "\<^const>List.nth" (100) - logic = logic[66] "@" logic[65] => "\<^const>List.append" (65) - logic = logic[81] "respects2" logic[80] => "\<^const>Equiv_Relations.RESPECTS2" (80) - logic = logic[81] "respects" logic[80] => "\<^const>Equiv_Relations.RESPECTS" (80) - logic = logic[90] "//" logic[91] => "\<^const>Equiv_Relations.quotient" (90) - logic = logic[56] "initial_segment_of" logic[56] => "\<^const>Zorn.initialSegmentOf" (55) - logic = logic[81] "<*mlex*>" logic[80] => "\<^const>Wellfounded.mlex_prod" (80) - logic = logic[81] "<*lex*>" logic[80] => "\<^const>Wellfounded.lex_prod" (80) - logic = logic[1000] "^*" => "\<^const>Transitive_Closure.rtrancl" (999) - logic = logic[1000] "^+" => "\<^const>Transitive_Closure.trancl" (999) - logic = logic[1000] "^=" => "\<^const>Transitive_Closure.reflcl" (999) - logic = logic[1000] "^**" => "\<^const>Transitive_Closure.rtranclp" (1000) - logic = logic[1000] "^++" => "\<^const>Transitive_Closure.tranclp" (1000) - logic = logic[1000] "^==" => "\<^const>Transitive_Closure.reflclp" (1000) - logic = logic[1000] "\<^sup>=\<^sup>=" => "\<^const>Transitive_Closure.reflclp" (1000) - logic = logic[1000] "\<^sup>=" => "\<^const>Transitive_Closure.reflcl" (999) - logic = logic[1000] "\<^sup>*\<^sup>*" => "\<^const>Transitive_Closure.rtranclp" (1000) - logic = logic[1000] "\<^sup>+\<^sup>+" => "\<^const>Transitive_Closure.tranclp" (1000) - logic = logic[1000] "\<^sup>+" => "\<^const>Transitive_Closure.trancl" (999) - logic = logic[1000] "\<^sup>*" => "\<^const>Transitive_Closure.rtrancl" (999) - logic = logic[91] "``" logic[90] => "\<^const>Relation.Image" (90) - logic = logic[1000] "^-1" => "\<^const>Relation.converse" (999) - logic = logic[1000] "^--1" => "\<^const>Relation.conversep" (1000) - logic = logic[1000] "\<inverse>\<inverse>" => "\<^const>Relation.conversep" (1000) - logic = logic[1000] "\<inverse>" => "\<^const>Relation.converse" (999) - logic = logic[76] "OO" logic[75] => "\<^const>Relation.relcompp" (75) - logic = logic[76] "O" logic[75] => "\<^const>Relation.relcomp" (75) - logic = logic[66] "<+>" logic[65] => "\<^const>Sum_Type.Plus" (65) - logic = logic[81] "\<times>" logic[80] => "\<^const>Product_Type.Times" (80) - logic = logic[55] "o" logic[56] => "\<^const>Fun.comp" (55) - logic = logic[55] "\<circ>" logic[56] => "\<^const>Fun.comp" (55) - logic = logic[91] "-`" logic[90] => "\<^const>Set.vimage" (90) - logic = logic[91] "`" logic[90] => "\<^const>Set.image" (90) - logic = logic[65] "Un" logic[66] => "\<^const>Set.union" (65) - logic = logic[65] "\<union>" logic[66] => "\<^const>Set.union" (65) - logic = logic[70] "Int" logic[71] => "\<^const>Set.inter" (70) - logic = logic[70] "\<inter>" logic[71] => "\<^const>Set.inter" (70) - logic = logic[51] "\<supset>" logic[51] => "\<^const>Set.supset" (50) - logic = logic[51] "\<supseteq>" logic[51] => "\<^const>Set.supset_eq" (50) - logic = logic[51] "\<subset>" logic[51] => "\<^const>Set.subset" (50) - logic = logic[51] "\<subseteq>" logic[51] => "\<^const>Set.subset_eq" (50) - logic = logic[26] "\<longleftrightarrow>" logic[25] => "\<^const>HOL.iff" (25) - logic = logic[36] "&" logic[35] => "\<^const>HOL.conj" (35) - logic = logic[31] "|" logic[30] => "\<^const>HOL.disj" (30) - logic = logic[26] "-->" logic[25] => "\<^const>HOL.implies" (25) - logic = logic[31] "\<or>" logic[30] => "\<^const>HOL.disj" (30) - logic = logic[36] "\<and>" logic[35] => "\<^const>HOL.conj" (35) - logic = logic[26] "\<longrightarrow>" logic[25] => "\<^const>HOL.implies" (25) - logic = logic[1000] cargs[1000] => "_applC" (999) - logic = logic[4] "::" type[0] => "_constrain" (3) - logic = any[900] "(|" Record.field_updates[0] "|)" => "_record_update" (900) - logic = any[900] "\<lparr>" Record.field_updates[0] "\<rparr>" => "_record_update" (900) - logic = any[900] "[" List.lupdbinds[0] "]" => "_LUpdate" (900) - logic = any[66] "#" logic[65] => "\<^const>List.list.Cons" (65) - logic = any[70] "mod" any[71] => "\<^const>Divides.div_class.mod" (70) - logic = any[1000] "\<^sup>2" => "\<^const>Power.power_class.power2" (999) - logic = any[81] "^" logic[80] => "\<^const>Power.power_class.power" (80) - logic = any[81] "^^" logic[80] => "\<^const>Nat.compower" (80) - logic = any[70] "/" any[71] => "\<^const>Fields.inverse_class.inverse_divide" (70) - logic = any[70] "div" any[71] => "\<^const>Rings.divide_class.divide" (70) - logic = any[51] "dvd" any[51] => "\<^const>Rings.dvd_class.dvd" (50) - logic = any[1000] "(" Fun.updbinds[0] ")" => "_Update" (900) - logic = any[51] ":" logic[51] => "\<^const>Set.member" (50) - logic = any[51] "~:" logic[51] => "\<^const>Set.not_member" (50) - logic = any[51] "\<notin>" logic[51] => "\<^const>Set.not_member" (50) - logic = any[51] "\<in>" logic[51] => "\<^const>Set.member" (50) - logic = any[70] "*" any[71] => "\<^const>Groups.times_class.times" (70) - logic = any[65] "-" any[66] => "\<^const>Groups.minus_class.minus" (65) - logic = any[65] "+" any[66] => "\<^const>Groups.plus_class.plus" (65) - logic = any[51] ">=" any[51] => "\<^const>Orderings.ord_class.greater_eq" (50) - logic = any[51] "<=" any[51] => "\<^const>Orderings.ord_class.less_eq" (50) - logic = any[51] ">" any[51] => "\<^const>Orderings.ord_class.greater" (50) - logic = any[51] "\<ge>" any[51] => "\<^const>Orderings.ord_class.greater_eq" (50) - logic = any[51] "\<le>" any[51] => "\<^const>Orderings.ord_class.less_eq" (50) - logic = any[51] "<" any[51] => "\<^const>Orderings.ord_class.less" (50) - logic = any[50] "~=" any[51] => "\<^const>HOL.not_equal" (50) - logic = any[50] "\<noteq>" any[51] => "\<^const>HOL.not_equal" (50) - logic = any[50] "=" any[51] => "\<^const>HOL.eq" (50) - logic = var_position[-1] (-1) - logic = longid_position[-1] (-1) - logic = id_position[-1] (-1) - longid_position = longid => "_position" (1000) - num_const = num_position[0] => "_constify" (1000) - num_position = num_token => "_position" (1000) - "prop" = logic[0] => "\<^const>HOL.Trueprop" (5) - "prop" = prop'[-1] (-1) - prop' = "TERM" logic[0] => "\<^const>Pure.term" (1000) - prop' = "SORT_CONSTRAINT" "(" type[0] ")" => "_sort_constraint" (1000) - prop' = "OFCLASS" "(" type[0] "," logic[0] ")" => "_ofclass" (1000) - prop' = "\<lbrakk>" asms[0] "\<rbrakk>" "\<Longrightarrow>" "prop"[1] => "_bigimpl" (1) - prop' = "PROP" aprop[0] => "_aprop" (1000) - prop' = "(" prop'[0] ")" (1000) - prop' = "[|" asms[0] "|]" "==>" "prop"[1] => "_bigimpl" (1) - prop' = "!!" idts[0] "." "prop"[0] => "\<^const>Pure.all_binder" (0) - prop' = "\<And>" idts[0] "." "prop"[0] => "\<^const>Pure.all_binder" (0) - prop' = any[3] "\<equiv>" any[3] => "\<^const>Pure.eq" (2) - prop' = any[3] "==" any[3] => "\<^const>Pure.eq" (2) - prop' = "prop"[2] "\<Longrightarrow>" "prop"[1] => "\<^const>Pure.imp" (1) - prop' = "prop"[2] "==>" "prop"[1] => "\<^const>Pure.imp" (1) - prop' = "prop"[3] "&&&" "prop"[2] => "\<^const>Pure.conjunction" (2) - prop' = "prop"[2] "=simp=>" "prop"[1] => "\<^const>HOL.simp_implies" (1) - prop' = prop'[4] "::" type[0] => "_constrain" (3) - pttrn = "(" pttrn[0] "," Product_Type.patterns[0] ")" => "_pattern" (1000) - pttrn = idt[-1] (-1) - pttrns = pttrn[1] pttrns[0] => "_pttrns" (0) - pttrns = pttrn[-1] (-1) - sort = "{" classes[0] "}" => "_sort" (1000) - sort = "{}" => "_topsort" (1000) - sort = class_name[-1] (-1) - str_position = str_token => "_position" (1000) - string_position = string_token => "_position" (1000) - tid_position = tid => "_position_sort" (1000) - tvar_position = tvar => "_position_sort" (1000) - type = "_" => "\<^type>dummy" (1000) - type = "_" "::" sort[0] => "_dummy_ofsort" (1000) - type = "(" type[0] ")" (1000) - type = "(" type[0] "," types[0] ")" type_name[0] => "_tappl" (1000) - type = "[" types[0] "]" "\<Rightarrow>" type[0] => "_bracket" (0) - type = "[" types[0] "]" "=>" type[0] => "_bracket" (0) - type = tvar_position[1000] "::" sort[0] => "_ofsort" (1000) - type = tid_position[1000] "::" sort[0] => "_ofsort" (1000) - type = "\<lparr>" Record.field_types[0] "," "\<dots>" "::" type[0] "\<rparr>" => "_record_type_scheme" (1000) - type = "\<lparr>" Record.field_types[0] "\<rparr>" => "_record_type" (1000) - type = "(|" Record.field_types[0] "," "..." "::" type[0] "|)" => "_record_type_scheme" (1000) - type = type[1] "\<rightharpoonup>" type[0] => "\<^type>Map.map" (0) - type = type[11] "+" type[10] => "\<^type>Sum_Type.sum" (10) - type = type[21] "*" type[20] => "\<^type>Product_Type.prod" (20) - type = type[21] "\<times>" type[20] => "\<^type>Product_Type.prod" (20) - type = type[1] "=>" type[0] => "\<^type>fun" (0) - type = type[1000] type_name[0] => "_tapp" (1000) - type = type[1] "\<Rightarrow>" type[0] => "\<^type>fun" (0) - type = "(|" Record.field_types[0] "|)" => "_record_type" (1000) - type = type_name[-1] (-1) - type = tvar_position[-1] (-1) - type = tid_position[-1] (-1) - type_name = longid => "_type_name" (1000) - type_name = id => "_type_name" (1000) - types = type[0] "," types[0] => "_types" (1000) - types = type[-1] (-1) - var_position = var => "_position" (1000) - -end diff --git a/Citadelle/src/print_syntax/Gram_Transcendental.thy b/Citadelle/src/print_syntax/Gram_Transcendental.thy deleted file mode 100644 index c3c43417b62e7066fd165c42f255f6ce0ecbbc7f..0000000000000000000000000000000000000000 --- a/Citadelle/src/print_syntax/Gram_Transcendental.thy +++ /dev/null @@ -1,553 +0,0 @@ -(****************************************************************************** - * 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. - ******************************************************************************) - -chapter{* Part ... *} - -theory Gram_Transcendental -imports Gram -begin - -print_syntax' init Transcendental -prods: - Fun.updbind = any[0] ":=" any[0] => "_updbind" (1000) - Fun.updbinds = Fun.updbind[0] "," Fun.updbinds[0] => "_updbinds" (1000) - Fun.updbinds = Fun.updbind[-1] (-1) - HOL.case_syn = any[0] "=>" any[0] => "_case1" (10) - HOL.case_syn = any[0] "\<Rightarrow>" any[0] => "_case1" (10) - HOL.cases_syn = HOL.case_syn[0] "|" HOL.cases_syn[0] => "_case2" (1000) - HOL.cases_syn = HOL.case_syn[-1] (-1) - HOL.letbind = pttrn[0] "=" any[0] => "_bind" (10) - HOL.letbinds = HOL.letbind[0] ";" HOL.letbinds[0] => "_binds" (1000) - HOL.letbinds = HOL.letbind[-1] (-1) - List.lc_qual = logic[0] => "_lc_test" (1000) - List.lc_qual = any[0] "<-" logic[0] => "_lc_gen" (1000) - List.lc_qual = any[0] "\<leftarrow>" logic[0] => "_lc_gen" (1000) - List.lc_quals = "," List.lc_qual[0] List.lc_quals[0] => "_lc_quals" (1000) - List.lc_quals = "]" => "_lc_end" (1000) - List.lupdbind = any[0] ":=" any[0] => "_lupdbind" (1000) - List.lupdbinds = List.lupdbind[0] "," List.lupdbinds[0] => "_lupdbinds" (1000) - List.lupdbinds = List.lupdbind[-1] (-1) - Map.maplet = any[0] "|->" any[0] => "_maplet" (1000) - Map.maplet = any[0] "[|->]" any[0] => "_maplets" (1000) - Map.maplet = any[0] "\<mapsto>" any[0] => "_maplet" (1000) - Map.maplet = any[0] "[\<mapsto>]" any[0] => "_maplets" (1000) - Map.maplets = Map.maplet[0] "," Map.maplets[0] => "_Maplets" (1000) - Map.maplets = Map.maplet[-1] (-1) - Product_Type.patterns = pttrn[0] "," Product_Type.patterns[0] => "_patterns" (1000) - Product_Type.patterns = pttrn[-1] (-1) - Product_Type.tuple_args = any[0] => "_tuple_arg" (1000) - Product_Type.tuple_args = any[0] "," Product_Type.tuple_args[0] => "_tuple_args" (1000) - Record.field = Record.ident[0] "=" any[0] => "_field" (1000) - Record.field_type = Record.ident[0] "::" type[0] => "_field_type" (1000) - Record.field_types = Record.field_type[0] "," Record.field_types[0] => "_field_types" (1000) - Record.field_types = Record.field_type[-1] (-1) - Record.field_update = Record.ident[0] ":=" any[0] => "_field_update" (1000) - Record.field_updates = Record.field_update[0] "," Record.field_updates[0] => "_field_updates" (1000) - Record.field_updates = Record.field_update[-1] (-1) - Record.fields = Record.field[0] "," Record.fields[0] => "_fields" (1000) - Record.fields = Record.field[-1] (-1) - Record.ident = longid => "_constify" (1000) - Record.ident = id => "_constify" (1000) - any = prop'[-1] (-1) - any = logic[-1] (-1) - aprop = "_" => "\<^const>Pure.dummy_pattern" (1000) - aprop = "XCONST" longid_position[0] => "_context_xconst" (1000) - aprop = "XCONST" id_position[0] => "_context_xconst" (1000) - aprop = "CONST" longid_position[0] => "_context_const" (1000) - aprop = "CONST" id_position[0] => "_context_const" (1000) - aprop = "\<dots>" => "_DDDOT" (1000) - aprop = "(" aprop[0] ")" (1000) - aprop = "..." => "_DDDOT" (1000) - aprop = logic[1000] cargs[1000] => "_applC" (999) - aprop = var_position[-1] (-1) - aprop = longid_position[-1] (-1) - aprop = id_position[-1] (-1) - args = any[0] "," args[0] => "_args" (1000) - args = any[-1] (-1) - asms = "prop"[0] ";" asms[0] => "_asms" (1000) - asms = "prop"[0] => "_asm" (1000) - cargs = any[1000] cargs[1000] => "_cargs" (1000) - cargs = any[-1] (-1) - cartouche_position = cartouche => "_position" (1000) - class_name = longid => "_class_name" (1000) - class_name = id => "_class_name" (1000) - classes = class_name[0] "," classes[0] => "_classes" (1000) - classes = class_name[-1] (-1) - float_const = float_position[0] => "_constify" (1000) - float_position = float_token => "_position" (1000) - id_position = id => "_position" (1000) - idt = "(" idt[0] ")" (1000) - idt = "_" "::" type[0] => "_idtypdummy" (0) - idt = "_" => "_idtdummy" (1000) - idt = id_position[0] "::" type[0] => "_idtyp" (0) - idt = id_position[-1] (-1) - idts = idt[1] idts[0] => "_idts" (0) - idts = idt[-1] (-1) - index = "\<index>" => "_indexvar" (1000) - index = => "_indexdefault" (1000) - index = "\<^bsub>" logic[0] "\<^esub>" => "_index" (1000) tex_raw - logic = "op" "&&&" => "\<^const>Pure.conjunction" (1000) - logic = "op" "==>" => "\<^const>Pure.imp" (1000) - logic = "op" "==" => "\<^const>Pure.eq" (1000) - logic = "op" "\<Longrightarrow>" => "\<^const>Pure.imp" (1000) - logic = "op" "\<equiv>" => "\<^const>Pure.eq" (1000) - logic = "op" "\<longrightarrow>" => "\<^const>HOL.implies" (1000) - logic = "op" "=" => "\<^const>HOL.eq" (1000) - logic = "op" "\<and>" => "\<^const>HOL.conj" (1000) - logic = "op" "\<or>" => "\<^const>HOL.disj" (1000) - logic = "op" "\<noteq>" => "\<^const>HOL.not_equal" (1000) - logic = "op" "~=" => "\<^const>HOL.not_equal" (1000) - logic = "op" "-->" => "\<^const>HOL.implies" (1000) - logic = "op" "|" => "\<^const>HOL.disj" (1000) - logic = "op" "&" => "\<^const>HOL.conj" (1000) - logic = "op" "\<longleftrightarrow>" => "\<^const>HOL.iff" (1000) - logic = "op" "=simp=>" => "\<^const>HOL.simp_implies" (1000) - logic = "op" "<" => "\<^const>Orderings.ord_class.less" (1000) - logic = "op" "\<le>" => "\<^const>Orderings.ord_class.less_eq" (1000) - logic = "op" "\<ge>" => "\<^const>Orderings.ord_class.greater_eq" (1000) - logic = "op" ">" => "\<^const>Orderings.ord_class.greater" (1000) - logic = "op" "<=" => "\<^const>Orderings.ord_class.less_eq" (1000) - logic = "op" ">=" => "\<^const>Orderings.ord_class.greater_eq" (1000) - logic = "op" "+" => "\<^const>Groups.plus_class.plus" (1000) - logic = "op" "-" => "\<^const>Groups.minus_class.minus" (1000) - logic = "op" "*" => "\<^const>Groups.times_class.times" (1000) - logic = "op" "\<in>" => "\<^const>Set.member" (1000) - logic = "op" "\<notin>" => "\<^const>Set.not_member" (1000) - logic = "op" "~:" => "\<^const>Set.not_member" (1000) - logic = "op" ":" => "\<^const>Set.member" (1000) - logic = "op" "\<subseteq>" => "\<^const>Set.subset_eq" (1000) - logic = "op" "\<subset>" => "\<^const>Set.subset" (1000) - logic = "op" "\<supseteq>" => "\<^const>Set.supset_eq" (1000) - logic = "op" "\<supset>" => "\<^const>Set.supset" (1000) - logic = "op" "\<inter>" => "\<^const>Set.inter" (1000) - logic = "op" "Int" => "\<^const>Set.inter" (1000) - logic = "op" "\<union>" => "\<^const>Set.union" (1000) - logic = "op" "Un" => "\<^const>Set.union" (1000) - logic = "op" "`" => "\<^const>Set.image" (1000) - logic = "op" "-`" => "\<^const>Set.vimage" (1000) - logic = "op" "\<circ>" => "\<^const>Fun.comp" (1000) - logic = "op" "o" => "\<^const>Fun.comp" (1000) - logic = "op" "\<times>" => "\<^const>Product_Type.Times" (1000) - logic = "op" "<+>" => "\<^const>Sum_Type.Plus" (1000) - logic = "op" "dvd" => "\<^const>Rings.dvd_class.dvd" (1000) - logic = "op" "div" => "\<^const>Rings.divide_class.divide" (1000) - logic = "op" "/" => "\<^const>Fields.inverse_class.inverse_divide" (1000) - logic = "op" "^^" => "\<^const>Nat.compower" (1000) - logic = "op" "O" => "\<^const>Relation.relcomp" (1000) - logic = "op" "OO" => "\<^const>Relation.relcompp" (1000) - logic = "op" "``" => "\<^const>Relation.Image" (1000) - logic = "op" "<*lex*>" => "\<^const>Wellfounded.lex_prod" (1000) - logic = "op" "<*mlex*>" => "\<^const>Wellfounded.mlex_prod" (1000) - logic = "op" "initial_segment_of" => "\<^const>Zorn.initialSegmentOf" (1000) - logic = "op" "//" => "\<^const>Equiv_Relations.quotient" (1000) - logic = "op" "respects" => "\<^const>Equiv_Relations.RESPECTS" (1000) - logic = "op" "respects2" => "\<^const>Equiv_Relations.RESPECTS2" (1000) - logic = "op" "^" => "\<^const>Power.power_class.power" (1000) - logic = "op" "mod" => "\<^const>Divides.div_class.mod" (1000) - logic = "op" "#" => "\<^const>List.list.Cons" (1000) - logic = "op" "@" => "\<^const>List.append" (1000) - logic = "op" "!" => "\<^const>List.nth" (1000) - logic = "op" "\<circ>\<^sub>m" => "\<^const>Map.map_comp" (1000) - logic = "op" "++" => "\<^const>Map.map_add" (1000) - logic = "op" "|`" => "\<^const>Map.restrict_map" (1000) - logic = "op" "\<subseteq>\<^sub>m" => "\<^const>Map.map_le" (1000) - logic = "op" "\<times>\<^sub>F" => "\<^const>Filter.prod_filter" (1000) - logic = "op" "\<longlongrightarrow>" => "\<^const>Topological_Spaces.topological_space_class.tendsto" (1000) tex_raw - logic = "op" "*\<^sub>R" => "\<^const>Real_Vector_Spaces.scaleR_class.scaleR" (1000) - logic = "op" "/\<^sub>R" => "\<^const>Real_Vector_Spaces.scaleR_class.divideR" (1000) - logic = "op" "sums" => "\<^const>Series.sums" (1000) - logic = "op" "has_derivative" => "\<^const>Deriv.has_derivative" (1000) - logic = "op" "has_field_derivative" => "\<^const>Deriv.has_field_derivative" (1000) - logic = "op" "has_vector_derivative" => "\<^const>Deriv.has_vector_derivative" (1000) - logic = "op" "differentiable" => "\<^const>Deriv.differentiable" (1000) - logic = "op" "has_real_derivative" => "\<^const>Deriv.has_real_derivative" (1000) - logic = "op" "choose" => "\<^const>Binomial.binomial" (1000) - logic = "op" "gchoose" => "\<^const>Binomial.field_char_0_class.gbinomial" (1000) - logic = "op" "powr" => "\<^const>Transcendental.powr" (1000) - logic = "XCONST" longid_position[0] => "_context_xconst" (1000) - logic = "XCONST" id_position[0] => "_context_xconst" (1000) - logic = "CONST" longid_position[0] => "_context_const" (1000) - logic = "CONST" id_position[0] => "_context_const" (1000) - logic = "\<dots>" => "_DDDOT" (1000) - logic = "TYPE" "(" type[0] ")" => "_TYPE" (1000) - logic = "\<lambda>" pttrns[0] "." any[3] => "_lambda" (3) - logic = "\<lambda>" HOL.cases_syn[0] => "_lam_pats_syntax" (10) - logic = "(" logic[0] ")" (1000) - logic = "(" any[0] "," Product_Type.tuple_args[0] ")" => "_tuple" (1000) - logic = "..." => "_DDDOT" (1000) - logic = "%" pttrns[0] "." any[3] => "_lambda" (3) - logic = "%" HOL.cases_syn[0] => "_lam_pats_syntax" (10) - logic = "_" => "\<^const>Pure.dummy_pattern" (1000) - logic = "\<forall>" idts[0] "." logic[10] => "\<^const>HOL.All_binder" (10) - logic = "\<forall>" idt[0] "\<ge>" any[0] "." logic[10] => "_All_greater_eq" (10) - logic = "\<forall>" idt[0] ">" any[0] "." logic[10] => "_All_greater" (10) - logic = "\<forall>" idt[0] "\<le>" any[0] "." logic[10] => "_All_less_eq" (10) - logic = "\<forall>" idt[0] "<" any[0] "." logic[10] => "_All_less" (10) - logic = "\<forall>" pttrn[0] "\<in>" logic[0] "." logic[10] => "_Ball" (10) - logic = "\<forall>" idt[0] "\<subseteq>" any[0] "." logic[10] => "_setleAll" (10) - logic = "\<forall>" idt[0] "\<subset>" any[0] "." logic[10] => "_setlessAll" (10) - logic = "\<exists>" idts[0] "." logic[10] => "\<^const>HOL.Ex_binder" (10) - logic = "\<exists>" idt[0] "\<ge>" any[0] "." logic[10] => "_Ex_greater_eq" (10) - logic = "\<exists>" idt[0] ">" any[0] "." logic[10] => "_Ex_greater" (10) - logic = "\<exists>" idt[0] "\<le>" any[0] "." logic[10] => "_Ex_less_eq" (10) - logic = "\<exists>" idt[0] "<" any[0] "." logic[10] => "_Ex_less" (10) - logic = "\<exists>" pttrn[0] "\<in>" logic[0] "." logic[10] => "_Bex" (10) - logic = "\<exists>" idt[0] "\<subseteq>" any[0] "." logic[10] => "_setleEx" (10) - logic = "\<exists>" idt[0] "\<subset>" any[0] "." logic[10] => "_setlessEx" (10) - logic = "\<not>" logic[40] => "\<^const>HOL.Not" (40) - logic = "\<exists>!" idts[0] "." logic[10] => "\<^const>HOL.Ex1_binder" (10) - logic = "\<exists>!" pttrn[0] "\<in>" logic[0] "." logic[10] => "_Bex1" (10) - logic = "\<exists>!" idt[0] "\<subseteq>" any[0] "." logic[10] => "_setleEx1" (10) - logic = "~" logic[40] => "\<^const>HOL.Not" (40) - logic = "THE" pttrn[0] "." logic[10] => "_The" (10) - logic = "let" HOL.letbinds[0] "in" any[10] => "_Let" (10) - logic = "case" any[0] "of" HOL.cases_syn[0] => "_case_syntax" (10) - logic = "EX!" idts[0] "." logic[10] => "\<^const>HOL.Ex1_binder" (10) - logic = "EX!" pttrn[0] ":" logic[0] "." logic[10] => "_Bex1" (10) - logic = "EX" idts[0] "." logic[10] => "\<^const>HOL.Ex_binder" (10) - logic = "EX" idt[0] ">=" any[0] "." logic[10] => "_Ex_greater_eq" (10) - logic = "EX" idt[0] ">" any[0] "." logic[10] => "_Ex_greater" (10) - logic = "EX" idt[0] "<=" any[0] "." logic[10] => "_Ex_less_eq" (10) - logic = "EX" idt[0] "<" any[0] "." logic[10] => "_Ex_less" (10) - logic = "EX" pttrn[0] ":" logic[0] "." logic[10] => "_Bex" (10) - logic = "ALL" idts[0] "." logic[10] => "\<^const>HOL.All_binder" (10) - logic = "ALL" idt[0] ">=" any[0] "." logic[10] => "_All_greater_eq" (10) - logic = "ALL" idt[0] ">" any[0] "." logic[10] => "_All_greater" (10) - logic = "ALL" idt[0] "<=" any[0] "." logic[10] => "_All_less_eq" (10) - logic = "ALL" idt[0] "<" any[0] "." logic[10] => "_All_less" (10) - logic = "ALL" pttrn[0] ":" logic[0] "." logic[10] => "_Ball" (10) - logic = "?!" idts[0] "." logic[10] => "\<^const>HOL.Ex1_binder" (10) - logic = "?!" pttrn[0] ":" logic[0] "." logic[10] => "_Bex1" (10) - logic = "?" idts[0] "." logic[10] => "\<^const>HOL.Ex_binder" (10) - logic = "?" idt[0] "<=" any[0] "." logic[10] => "_Ex_less_eq" (10) - logic = "?" idt[0] "<" any[0] "." logic[10] => "_Ex_less" (10) - logic = "?" pttrn[0] ":" logic[0] "." logic[10] => "_Bex" (10) - logic = "!" idts[0] "." logic[10] => "\<^const>HOL.All_binder" (10) - logic = "!" idt[0] "<=" any[0] "." logic[10] => "_All_less_eq" (10) - logic = "!" idt[0] "<" any[0] "." logic[10] => "_All_less" (10) - logic = "!" pttrn[0] ":" logic[0] "." logic[10] => "_Ball" (10) - logic = "if" logic[0] "then" any[0] "else" any[10] => "\<^const>HOL.If" (10) - logic = "LEAST" idts[0] "." logic[10] => "\<^const>Orderings.ord_class.Least_binder" (10) - logic = "LEAST" id ":" logic[0] "." logic[10] => "_Bleast" (10) - logic = "LEAST" id "\<in>" logic[0] "." logic[10] => "_Bleast" (10) - logic = "LEAST" pttrn[0] "WRT" logic[4] "." logic[10] => "_LeastM" (10) - logic = "0" => "\<^const>Groups.zero_class.zero" (1000) - logic = "-" any[81] => "\<^const>Groups.uminus_class.uminus" (80) - logic = "\<bar>" any[0] "\<bar>" => "\<^const>Groups.abs_class.abs" (1000) - logic = "1" => "\<^const>Groups.one_class.one" (1000) - logic = "{" pttrn[0] "." logic[0] "}" => "_Coll" (1000) - logic = "{" pttrn[0] ":" logic[0] "." logic[0] "}" => "_Collect" (1000) - logic = "{" pttrn[0] "\<in>" logic[0] "." logic[0] "}" => "_Collect" (1000) - logic = "{" args[0] "}" => "_Finset" (1000) - logic = "{" any[0] "|" idts[0] "." logic[0] "}" => "_Setcompr" (1000) - logic = "{" any[0] "<..}" => "\<^const>Set_Interval.ord_class.greaterThan" (1000) - logic = "{" any[0] "..}" => "\<^const>Set_Interval.ord_class.atLeast" (1000) - logic = "{" any[0] "<..<" any[0] "}" => "\<^const>Set_Interval.ord_class.greaterThanLessThan" (1000) - logic = "{" any[0] "..<" any[0] "}" => "\<^const>Set_Interval.ord_class.atLeastLessThan" (1000) - logic = "{" any[0] "<.." any[0] "}" => "\<^const>Set_Interval.ord_class.greaterThanAtMost" (1000) - logic = "{" any[0] ".." any[0] "}" => "\<^const>Set_Interval.ord_class.atLeastAtMost" (1000) - logic = "{}" => "\<^const>Set.empty" (1000) - logic = "SUP" pttrn[0] ":" logic[0] "." any[10] => "_SUP" (10) - logic = "SUP" pttrns[0] "." any[10] => "_SUP1" (10) - logic = "INF" pttrn[0] ":" logic[0] "." any[10] => "_INF" (10) - logic = "INF" pttrns[0] "." any[10] => "_INF1" (10) - logic = "\<Inter>" logic[900] => "\<^const>Complete_Lattices.Inter" (900) - logic = "\<Inter>" pttrn[0] "\<in>" logic[0] "." logic[10] => "_INTER" (10) - logic = "\<Inter>" pttrns[0] "." logic[10] => "_INTER1" (10) - logic = "\<Inter>" any[0] "<" any[0] "." logic[10] => "_INTER_less" (10) - logic = "\<Inter>" any[0] "\<le>" any[0] "." logic[10] => "_INTER_le" (10) - logic = "INT" pttrn[0] ":" logic[0] "." logic[10] => "_INTER" (10) - logic = "INT" pttrns[0] "." logic[10] => "_INTER1" (10) - logic = "INT" any[0] "<" any[0] "." logic[10] => "_INTER_less" (10) - logic = "INT" any[0] "<=" any[0] "." logic[10] => "_INTER_le" (10) - logic = "\<Union>" logic[900] => "\<^const>Complete_Lattices.Union" (900) - logic = "\<Union>" pttrn[0] "\<in>" logic[0] "." logic[10] => "_UNION" (10) - logic = "\<Union>" pttrns[0] "." logic[10] => "_UNION1" (10) - logic = "\<Union>" any[0] "<" any[0] "." logic[10] => "_UNION_less" (10) - logic = "\<Union>" any[0] "\<le>" any[0] "." logic[10] => "_UNION_le" (10) - logic = "UN" pttrn[0] ":" logic[0] "." logic[10] => "_UNION" (10) - logic = "UN" pttrns[0] "." logic[10] => "_UNION1" (10) - logic = "UN" any[0] "<" any[0] "." logic[10] => "_UNION_less" (10) - logic = "UN" any[0] "<=" any[0] "." logic[10] => "_UNION_le" (10) - logic = "()" => "\<^const>Product_Type.Unity" (1000) - logic = "SIGMA" pttrn[0] ":" logic[0] "." logic[10] => "_Sigma" (10) - logic = "\<nat>" => "\<^const>Nat.semiring_1_class.Nats" (1000) - logic = "\<some>" pttrn[0] "." logic[10] => "_Eps" (10) - logic = "@" pttrn[0] "." logic[10] => "_Eps" (10) - logic = "SOME" pttrn[0] "." logic[10] => "_Eps" (10) - logic = "GREATEST" idts[0] "." logic[10] => "\<^const>Hilbert_Choice.Greatest_binder" (10) - logic = "GREATEST" pttrn[0] "WRT" logic[4] "." logic[10] => "_GreatestM" (10) - logic = "chain\<^sub>\<subseteq>" => "\<^const>Zorn.chain_subset" (1000) - logic = "CSUM" pttrn[0] ":" logic[51] "." logic[10] => "_Csum" (10) - logic = num_const[0] => "_Numeral" (1000) - logic = "\<Sum>" logic[1000] => "\<^const>Groups_Big.comm_monoid_add_class.Setsum" (999) - logic = "\<Sum>" pttrn[0] "\<in>" logic[51] "." any[10] => "_setsum" (10) - logic = "\<Sum>" pttrn[0] "|" logic[0] "." any[10] => "_qsetsum" (10) - logic = "\<Sum>" idt[0] "\<le>" any[0] "." any[10] => "_upto_setsum" (10) - logic = "\<Sum>" idt[0] "<" any[0] "." any[10] => "_upt_setsum" (10) - logic = "\<Sum>" idt[0] "=" any[0] "..<" any[0] "." any[10] => "_from_upto_setsum" (10) - logic = "\<Sum>" idt[0] "=" any[0] ".." any[0] "." any[10] => "_from_to_setsum" (10) - logic = "\<Sum>" pttrn[0] "\<leftarrow>" logic[51] "." any[10] => "_listsum" (10) - logic = "\<Sum>" idts[0] "." any[10] => "\<^const>Series.suminf_binder" (10) - logic = "SUM" pttrn[0] ":" logic[51] "." any[10] => "_setsum" (10) - logic = "SUM" pttrn[0] "|" logic[0] "." any[10] => "_qsetsum" (10) - logic = "SUM" idt[0] "<=" any[0] "." any[10] => "_upto_setsum" (10) - logic = "SUM" idt[0] "<" any[0] "." any[10] => "_upt_setsum" (10) - logic = "SUM" idt[0] "=" any[0] "..<" any[0] "." any[10] => "_from_upto_setsum" (10) - logic = "SUM" idt[0] "=" any[0] ".." any[0] "." any[10] => "_from_to_setsum" (10) - logic = "SUM" pttrn[0] "<-" logic[51] "." any[10] => "_listsum" (10) - logic = "\<Prod>" logic[1000] => "\<^const>Groups_Big.comm_monoid_mult_class.Setprod" (999) - logic = "\<Prod>" pttrn[0] "\<in>" logic[51] "." any[10] => "_setprod" (10) - logic = "\<Prod>" pttrn[0] "|" logic[0] "." any[10] => "_qsetprod" (10) - logic = "\<Prod>" idt[0] "\<le>" any[0] "." any[10] => "_upto_setprod" (10) - logic = "\<Prod>" idt[0] "<" any[0] "." any[10] => "_upt_setprod" (10) - logic = "\<Prod>" idt[0] "=" any[0] "..<" any[0] "." any[10] => "_from_upto_setprod" (10) - logic = "\<Prod>" idt[0] "=" any[0] ".." any[0] "." any[10] => "_from_to_setprod" (10) - logic = "\<Prod>" pttrn[0] "\<leftarrow>" logic[51] "." any[10] => "_listprod" (10) - logic = "PROD" pttrn[0] ":" logic[51] "." any[10] => "_setprod" (10) - logic = "PROD" pttrn[0] "|" logic[0] "." any[10] => "_qsetprod" (10) - logic = "PROD" idt[0] "<=" any[0] "." any[10] => "_upto_setprod" (10) - logic = "PROD" idt[0] "<" any[0] "." any[10] => "_upt_setprod" (10) - logic = "PROD" idt[0] "=" any[0] "..<" any[0] "." any[10] => "_from_upto_setprod" (10) - logic = "PROD" idt[0] "=" any[0] ".." any[0] "." any[10] => "_from_to_setprod" (10) - logic = "PROD" pttrn[0] "<-" logic[51] "." any[10] => "_listprod" (10) - logic = "\<int>" => "\<^const>Int.ring_1_class.Ints" (1000) - logic = "\<Sqinter>\<^sub>f\<^sub>i\<^sub>n" logic[900] => "\<^const>Lattices_Big.semilattice_inf_class.Inf_fin" (900) - logic = "\<Squnion>\<^sub>f\<^sub>i\<^sub>n" logic[900] => "\<^const>Lattices_Big.semilattice_sup_class.Sup_fin" (900) - logic = "{..<" any[0] "}" => "\<^const>Set_Interval.ord_class.lessThan" (1000) - logic = "{.." any[0] "}" => "\<^const>Set_Interval.ord_class.atMost" (1000) - logic = "[]" => "\<^const>List.list.Nil" (1000) - logic = "[" args[0] "]" => "_list" (1000) - logic = "[" pttrn[0] "<-" logic[0] "." logic[0] "]" => "_filter" (1000) - logic = "[" pttrn[0] "\<leftarrow>" logic[0] "." logic[0] "]" => "_filter" (1000) - logic = "[" logic[0] "..<" logic[0] "]" => "\<^const>List.upt" (1000) - logic = "[" any[0] "." List.lc_qual[0] List.lc_quals[0] => "_listcompr" (1000) - logic = "[" logic[0] ".." logic[0] "]" => "\<^const>List.upto" (1000) - logic = "[" Map.maplets[0] "]" => "_Map" (1000) - logic = "CHR" str_position[0] => "_Char" (1000) - logic = str_position[0] => "_String" (1000) - logic = "TYPEREP" "(" type[0] ")" => "_TYPEREP" (1000) - logic = "\<lparr>" Record.fields[0] "," "\<dots>" "=" any[0] "\<rparr>" => "_record_scheme" (1000) - logic = "\<lparr>" Record.fields[0] "\<rparr>" => "_record" (1000) - logic = "(|" Record.fields[0] "," "..." "=" any[0] "|)" => "_record_scheme" (1000) - logic = "(|" Record.fields[0] "|)" => "_record" (1000) - logic = "\<forall>\<^sub>F" pttrn[0] "in" logic[0] "." logic[10] => "_eventually" (10) - logic = "\<exists>\<^sub>F" pttrn[0] "in" logic[0] "." logic[10] => "_frequently" (10) - logic = "\<exists>\<^sub>\<infinity>" idts[0] "." logic[10] => "\<^const>Filter.Inf_many_binder" (10) - logic = "\<forall>\<^sub>\<infinity>" idts[0] "." logic[10] => "\<^const>Filter.Alm_all_binder" (10) - logic = "MOST" idts[0] "." logic[10] => "\<^const>Filter.Alm_all_binder" (10) - logic = "INFM" idts[0] "." logic[10] => "\<^const>Filter.Inf_many_binder" (10) - logic = "LIM" pttrns[1000] any[10] "." any[0] ":>" any[10] => "_LIM" (10) - logic = "\<lfloor>" any[0] "\<rfloor>" => "\<^const>Archimedean_Field.floor_ceiling_class.floor" (1000) - logic = "\<lceil>" any[0] "\<rceil>" => "\<^const>Archimedean_Field.ceiling" (1000) - logic = "\<rat>" => "\<^const>Rat.field_char_0_class.Rats" (1000) - logic = float_const[0] => "_Float" (1000) - logic = "at" any[1000] "within" logic[60] => "\<^const>Topological_Spaces.topological_space_class.at_within" (60) - logic = "at" => "\<^const>Topological_Spaces.topological_space_class.at" (1000) - logic = "\<real>" => "\<^const>Real_Vector_Spaces.Reals" (1000) - logic = "FDERIV" logic[1000] any[1000] ":>" logic[60] => "\<^const>Deriv.FDERIV" (60) - logic = "DERIV" logic[1000] any[1000] ":>" any[60] => "\<^const>Deriv.DERIV" (60) - logic = logic[51] "differentiable" logic[51] => "\<^const>Deriv.differentiable" (50) - logic = logic[51] "has_vector_derivative" any[51] => "\<^const>Deriv.has_vector_derivative" (50) - logic = logic[51] "has_field_derivative" any[51] => "\<^const>Deriv.has_field_derivative" (50) - logic = logic[51] "has_derivative" logic[51] => "\<^const>Deriv.has_derivative" (50) - logic = logic[81] "sums" any[80] => "\<^const>Series.sums" (80) - logic = logic[76] "*\<^sub>R" any[75] => "\<^const>Real_Vector_Spaces.scaleR_class.scaleR" (75) - logic = logic[60] "\<midarrow>" any[0] "\<rightarrow>" any[60] => "\<^const>Topological_Spaces.LIM" (60) - logic = logic[60] "\<longlonglongrightarrow>" any[60] => "\<^const>Topological_Spaces.topological_space_class.LIMSEQ" (60) tex_raw - logic = logic[56] "\<longlongrightarrow>" any[55] => "\<^const>Topological_Spaces.topological_space_class.tendsto" (55) tex_raw - logic = logic[81] "\<times>\<^sub>F" logic[80] => "\<^const>Filter.prod_filter" (80) - logic = logic[900] "(" Map.maplets[0] ")" => "_MapUpd" (900) - logic = logic[51] "\<subseteq>\<^sub>m" logic[51] => "\<^const>Map.map_le" (50) - logic = logic[110] "|`" logic[111] => "\<^const>Map.restrict_map" (110) - logic = logic[100] "++" logic[101] => "\<^const>Map.map_add" (100) - logic = logic[55] "\<circ>\<^sub>m" logic[56] => "\<^const>Map.map_comp" (55) - logic = logic[100] "!" logic[101] => "\<^const>List.nth" (100) - logic = logic[66] "@" logic[65] => "\<^const>List.append" (65) - logic = logic[81] "respects2" logic[80] => "\<^const>Equiv_Relations.RESPECTS2" (80) - logic = logic[81] "respects" logic[80] => "\<^const>Equiv_Relations.RESPECTS" (80) - logic = logic[90] "//" logic[91] => "\<^const>Equiv_Relations.quotient" (90) - logic = logic[56] "initial_segment_of" logic[56] => "\<^const>Zorn.initialSegmentOf" (55) - logic = logic[81] "<*mlex*>" logic[80] => "\<^const>Wellfounded.mlex_prod" (80) - logic = logic[81] "<*lex*>" logic[80] => "\<^const>Wellfounded.lex_prod" (80) - logic = logic[1000] "^*" => "\<^const>Transitive_Closure.rtrancl" (999) - logic = logic[1000] "^+" => "\<^const>Transitive_Closure.trancl" (999) - logic = logic[1000] "^=" => "\<^const>Transitive_Closure.reflcl" (999) - logic = logic[1000] "^**" => "\<^const>Transitive_Closure.rtranclp" (1000) - logic = logic[1000] "^++" => "\<^const>Transitive_Closure.tranclp" (1000) - logic = logic[1000] "^==" => "\<^const>Transitive_Closure.reflclp" (1000) - logic = logic[1000] "\<^sup>=\<^sup>=" => "\<^const>Transitive_Closure.reflclp" (1000) - logic = logic[1000] "\<^sup>=" => "\<^const>Transitive_Closure.reflcl" (999) - logic = logic[1000] "\<^sup>*\<^sup>*" => "\<^const>Transitive_Closure.rtranclp" (1000) - logic = logic[1000] "\<^sup>+\<^sup>+" => "\<^const>Transitive_Closure.tranclp" (1000) - logic = logic[1000] "\<^sup>+" => "\<^const>Transitive_Closure.trancl" (999) - logic = logic[1000] "\<^sup>*" => "\<^const>Transitive_Closure.rtrancl" (999) - logic = logic[91] "``" logic[90] => "\<^const>Relation.Image" (90) - logic = logic[1000] "^-1" => "\<^const>Relation.converse" (999) - logic = logic[1000] "^--1" => "\<^const>Relation.conversep" (1000) - logic = logic[1000] "\<inverse>\<inverse>" => "\<^const>Relation.conversep" (1000) - logic = logic[1000] "\<inverse>" => "\<^const>Relation.converse" (999) - logic = logic[76] "OO" logic[75] => "\<^const>Relation.relcompp" (75) - logic = logic[76] "O" logic[75] => "\<^const>Relation.relcomp" (75) - logic = logic[66] "<+>" logic[65] => "\<^const>Sum_Type.Plus" (65) - logic = logic[81] "\<times>" logic[80] => "\<^const>Product_Type.Times" (80) - logic = logic[55] "o" logic[56] => "\<^const>Fun.comp" (55) - logic = logic[55] "\<circ>" logic[56] => "\<^const>Fun.comp" (55) - logic = logic[91] "-`" logic[90] => "\<^const>Set.vimage" (90) - logic = logic[91] "`" logic[90] => "\<^const>Set.image" (90) - logic = logic[65] "Un" logic[66] => "\<^const>Set.union" (65) - logic = logic[65] "\<union>" logic[66] => "\<^const>Set.union" (65) - logic = logic[70] "Int" logic[71] => "\<^const>Set.inter" (70) - logic = logic[70] "\<inter>" logic[71] => "\<^const>Set.inter" (70) - logic = logic[51] "\<supset>" logic[51] => "\<^const>Set.supset" (50) - logic = logic[51] "\<supseteq>" logic[51] => "\<^const>Set.supset_eq" (50) - logic = logic[51] "\<subset>" logic[51] => "\<^const>Set.subset" (50) - logic = logic[51] "\<subseteq>" logic[51] => "\<^const>Set.subset_eq" (50) - logic = logic[26] "\<longleftrightarrow>" logic[25] => "\<^const>HOL.iff" (25) - logic = logic[36] "&" logic[35] => "\<^const>HOL.conj" (35) - logic = logic[31] "|" logic[30] => "\<^const>HOL.disj" (30) - logic = logic[26] "-->" logic[25] => "\<^const>HOL.implies" (25) - logic = logic[31] "\<or>" logic[30] => "\<^const>HOL.disj" (30) - logic = logic[36] "\<and>" logic[35] => "\<^const>HOL.conj" (35) - logic = logic[26] "\<longrightarrow>" logic[25] => "\<^const>HOL.implies" (25) - logic = logic[1000] cargs[1000] => "_applC" (999) - logic = logic[4] "::" type[0] => "_constrain" (3) - logic = any[70] "/\<^sub>R" logic[71] => "\<^const>Real_Vector_Spaces.scaleR_class.divideR" (70) - logic = any[900] "(|" Record.field_updates[0] "|)" => "_record_update" (900) - logic = any[900] "\<lparr>" Record.field_updates[0] "\<rparr>" => "_record_update" (900) - logic = any[900] "[" List.lupdbinds[0] "]" => "_LUpdate" (900) - logic = any[66] "#" logic[65] => "\<^const>List.list.Cons" (65) - logic = any[70] "mod" any[71] => "\<^const>Divides.div_class.mod" (70) - logic = any[1000] "\<^sup>2" => "\<^const>Power.power_class.power2" (999) - logic = any[81] "^" logic[80] => "\<^const>Power.power_class.power" (80) - logic = any[81] "^^" logic[80] => "\<^const>Nat.compower" (80) - logic = any[70] "/" any[71] => "\<^const>Fields.inverse_class.inverse_divide" (70) - logic = any[70] "div" any[71] => "\<^const>Rings.divide_class.divide" (70) - logic = any[51] "dvd" any[51] => "\<^const>Rings.dvd_class.dvd" (50) - logic = any[1000] "(" Fun.updbinds[0] ")" => "_Update" (900) - logic = any[51] ":" logic[51] => "\<^const>Set.member" (50) - logic = any[51] "~:" logic[51] => "\<^const>Set.not_member" (50) - logic = any[51] "\<notin>" logic[51] => "\<^const>Set.not_member" (50) - logic = any[51] "\<in>" logic[51] => "\<^const>Set.member" (50) - logic = any[70] "*" any[71] => "\<^const>Groups.times_class.times" (70) - logic = any[65] "-" any[66] => "\<^const>Groups.minus_class.minus" (65) - logic = any[65] "+" any[66] => "\<^const>Groups.plus_class.plus" (65) - logic = any[51] ">=" any[51] => "\<^const>Orderings.ord_class.greater_eq" (50) - logic = any[51] "<=" any[51] => "\<^const>Orderings.ord_class.less_eq" (50) - logic = any[51] ">" any[51] => "\<^const>Orderings.ord_class.greater" (50) - logic = any[51] "\<ge>" any[51] => "\<^const>Orderings.ord_class.greater_eq" (50) - logic = any[51] "\<le>" any[51] => "\<^const>Orderings.ord_class.less_eq" (50) - logic = any[51] "<" any[51] => "\<^const>Orderings.ord_class.less" (50) - logic = any[50] "~=" any[51] => "\<^const>HOL.not_equal" (50) - logic = any[50] "\<noteq>" any[51] => "\<^const>HOL.not_equal" (50) - logic = any[50] "=" any[51] => "\<^const>HOL.eq" (50) - logic = logic[51] "has_real_derivative" logic[51] => "\<^const>Deriv.has_real_derivative" (50) - logic = logic[65] "choose" logic[66] => "\<^const>Binomial.binomial" (65) - logic = any[65] "gchoose" logic[66] => "\<^const>Binomial.field_char_0_class.gbinomial" (65) - logic = any[81] "powr" any[80] => "\<^const>Transcendental.powr" (80) - logic = var_position[-1] (-1) - logic = longid_position[-1] (-1) - logic = id_position[-1] (-1) - longid_position = longid => "_position" (1000) - num_const = num_position[0] => "_constify" (1000) - num_position = num_token => "_position" (1000) - "prop" = logic[0] => "\<^const>HOL.Trueprop" (5) - "prop" = prop'[-1] (-1) - prop' = "TERM" logic[0] => "\<^const>Pure.term" (1000) - prop' = "SORT_CONSTRAINT" "(" type[0] ")" => "_sort_constraint" (1000) - prop' = "OFCLASS" "(" type[0] "," logic[0] ")" => "_ofclass" (1000) - prop' = "\<lbrakk>" asms[0] "\<rbrakk>" "\<Longrightarrow>" "prop"[1] => "_bigimpl" (1) - prop' = "PROP" aprop[0] => "_aprop" (1000) - prop' = "(" prop'[0] ")" (1000) - prop' = "[|" asms[0] "|]" "==>" "prop"[1] => "_bigimpl" (1) - prop' = "!!" idts[0] "." "prop"[0] => "\<^const>Pure.all_binder" (0) - prop' = "\<And>" idts[0] "." "prop"[0] => "\<^const>Pure.all_binder" (0) - prop' = any[3] "\<equiv>" any[3] => "\<^const>Pure.eq" (2) - prop' = any[3] "==" any[3] => "\<^const>Pure.eq" (2) - prop' = "prop"[2] "\<Longrightarrow>" "prop"[1] => "\<^const>Pure.imp" (1) - prop' = "prop"[2] "==>" "prop"[1] => "\<^const>Pure.imp" (1) - prop' = "prop"[3] "&&&" "prop"[2] => "\<^const>Pure.conjunction" (2) - prop' = "prop"[2] "=simp=>" "prop"[1] => "\<^const>HOL.simp_implies" (1) - prop' = prop'[4] "::" type[0] => "_constrain" (3) - pttrn = "(" pttrn[0] "," Product_Type.patterns[0] ")" => "_pattern" (1000) - pttrn = idt[-1] (-1) - pttrns = pttrn[1] pttrns[0] => "_pttrns" (0) - pttrns = pttrn[-1] (-1) - sort = "{" classes[0] "}" => "_sort" (1000) - sort = "{}" => "_topsort" (1000) - sort = class_name[-1] (-1) - str_position = str_token => "_position" (1000) - string_position = string_token => "_position" (1000) - tid_position = tid => "_position_sort" (1000) - tvar_position = tvar => "_position_sort" (1000) - type = "_" => "\<^type>dummy" (1000) - type = "_" "::" sort[0] => "_dummy_ofsort" (1000) - type = "(" type[0] ")" (1000) - type = "(" type[0] "," types[0] ")" type_name[0] => "_tappl" (1000) - type = "[" types[0] "]" "\<Rightarrow>" type[0] => "_bracket" (0) - type = "[" types[0] "]" "=>" type[0] => "_bracket" (0) - type = tvar_position[1000] "::" sort[0] => "_ofsort" (1000) - type = tid_position[1000] "::" sort[0] => "_ofsort" (1000) - type = "\<lparr>" Record.field_types[0] "," "\<dots>" "::" type[0] "\<rparr>" => "_record_type_scheme" (1000) - type = "\<lparr>" Record.field_types[0] "\<rparr>" => "_record_type" (1000) - type = "(|" Record.field_types[0] "," "..." "::" type[0] "|)" => "_record_type_scheme" (1000) - type = type[1] "\<rightharpoonup>" type[0] => "\<^type>Map.map" (0) - type = type[11] "+" type[10] => "\<^type>Sum_Type.sum" (10) - type = type[21] "*" type[20] => "\<^type>Product_Type.prod" (20) - type = type[21] "\<times>" type[20] => "\<^type>Product_Type.prod" (20) - type = type[1] "=>" type[0] => "\<^type>fun" (0) - type = type[1000] type_name[0] => "_tapp" (1000) - type = type[1] "\<Rightarrow>" type[0] => "\<^type>fun" (0) - type = "(|" Record.field_types[0] "|)" => "_record_type" (1000) - type = type_name[-1] (-1) - type = tvar_position[-1] (-1) - type = tid_position[-1] (-1) - type_name = longid => "_type_name" (1000) - type_name = id => "_type_name" (1000) - types = type[0] "," types[0] => "_types" (1000) - types = type[-1] (-1) - var_position = var => "_position" (1000) - -end diff --git a/Citadelle/src/print_syntax/Gram_UML_Main.thy b/Citadelle/src/print_syntax/Gram_UML_Main.thy deleted file mode 100644 index 7b255f0bed76702e65331d6c20ed5788c8147133..0000000000000000000000000000000000000000 --- a/Citadelle/src/print_syntax/Gram_UML_Main.thy +++ /dev/null @@ -1,736 +0,0 @@ -(****************************************************************************** - * 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. - ******************************************************************************) - -chapter{* Part ... *} - -theory Gram_UML_Main -imports Gram_Transcendental -begin - -print_syntax' (* UML_main *) remove Transcendental add any, args, cartouche_position, idt, id_position -prods: - Fun.updbind = any[0] ":=" any[0] => "_updbind" (1000) - Fun.updbinds = Fun.updbind[0] "," Fun.updbinds[0] => "_updbinds" (1000) - Fun.updbinds = Fun.updbind[-1] (-1) - HOL.case_syn = any[0] "=>" any[0] => "_case1" (10) - HOL.case_syn = any[0] "\<Rightarrow>" any[0] => "_case1" (10) - HOL.cases_syn = HOL.case_syn[0] "|" HOL.cases_syn[0] => "_case2" (1000) - HOL.cases_syn = HOL.case_syn[-1] (-1) - HOL.letbind = pttrn[0] "=" any[0] => "_bind" (10) - HOL.letbinds = HOL.letbind[0] ";" HOL.letbinds[0] => "_binds" (1000) - HOL.letbinds = HOL.letbind[-1] (-1) - List.lc_qual = logic[0] => "_lc_test" (1000) - List.lc_qual = any[0] "<-" logic[0] => "_lc_gen" (1000) - List.lc_qual = any[0] "\<leftarrow>" logic[0] => "_lc_gen" (1000) - List.lc_quals = "," List.lc_qual[0] List.lc_quals[0] => "_lc_quals" (1000) - List.lc_quals = "]" => "_lc_end" (1000) - List.lupdbind = any[0] ":=" any[0] => "_lupdbind" (1000) - List.lupdbinds = List.lupdbind[0] "," List.lupdbinds[0] => "_lupdbinds" (1000) - List.lupdbinds = List.lupdbind[-1] (-1) - Map.maplet = any[0] "|->" any[0] => "_maplet" (1000) - Map.maplet = any[0] "[|->]" any[0] => "_maplets" (1000) - Map.maplet = any[0] "\<mapsto>" any[0] => "_maplet" (1000) - Map.maplet = any[0] "[\<mapsto>]" any[0] => "_maplets" (1000) - Map.maplets = Map.maplet[0] "," Map.maplets[0] => "_Maplets" (1000) - Map.maplets = Map.maplet[-1] (-1) - Product_Type.patterns = pttrn[0] "," Product_Type.patterns[0] => "_patterns" (1000) - Product_Type.patterns = pttrn[-1] (-1) - Product_Type.tuple_args = any[0] => "_tuple_arg" (1000) - Product_Type.tuple_args = any[0] "," Product_Type.tuple_args[0] => "_tuple_args" (1000) - Record.field = Record.ident[0] "=" any[0] => "_field" (1000) - Record.field_type = Record.ident[0] "::" type[0] => "_field_type" (1000) - Record.field_types = Record.field_type[0] "," Record.field_types[0] => "_field_types" (1000) - Record.field_types = Record.field_type[-1] (-1) - Record.field_update = Record.ident[0] ":=" any[0] => "_field_update" (1000) - Record.field_updates = Record.field_update[0] "," Record.field_updates[0] => "_field_updates" (1000) - Record.field_updates = Record.field_update[-1] (-1) - Record.fields = Record.field[0] "," Record.fields[0] => "_fields" (1000) - Record.fields = Record.field[-1] (-1) - Record.ident = longid => "_constify" (1000) - Record.ident = id => "_constify" (1000) - any = prop'[-1] (-1) - any = logic[-1] (-1) - aprop = "_" => "\<^const>Pure.dummy_pattern" (1000) - aprop = "XCONST" longid_position[0] => "_context_xconst" (1000) - aprop = "XCONST" id_position[0] => "_context_xconst" (1000) - aprop = "CONST" longid_position[0] => "_context_const" (1000) - aprop = "CONST" id_position[0] => "_context_const" (1000) - aprop = "\<dots>" => "_DDDOT" (1000) - aprop = "(" aprop[0] ")" (1000) - aprop = "..." => "_DDDOT" (1000) - aprop = logic[1000] cargs[1000] => "_applC" (999) - aprop = var_position[-1] (-1) - aprop = longid_position[-1] (-1) - aprop = id_position[-1] (-1) - args = any[0] "," args[0] => "_args" (1000) - args = any[-1] (-1) - asms = "prop"[0] ";" asms[0] => "_asms" (1000) - asms = "prop"[0] => "_asm" (1000) - cargs = any[1000] cargs[1000] => "_cargs" (1000) - cargs = any[-1] (-1) - cartouche_position = cartouche => "_position" (1000) - class_name = longid => "_class_name" (1000) - class_name = id => "_class_name" (1000) - classes = class_name[0] "," classes[0] => "_classes" (1000) - classes = class_name[-1] (-1) - float_const = float_position[0] => "_constify" (1000) - float_position = float_token => "_position" (1000) - id_position = id => "_position" (1000) - idt = "(" idt[0] ")" (1000) - idt = "_" "::" type[0] => "_idtypdummy" (0) - idt = "_" => "_idtdummy" (1000) - idt = id_position[0] "::" type[0] => "_idtyp" (0) - idt = id_position[-1] (-1) - idts = idt[1] idts[0] => "_idts" (0) - idts = idt[-1] (-1) - index = "\<index>" => "_indexvar" (1000) - index = => "_indexdefault" (1000) - index = "\<^bsub>" logic[0] "\<^esub>" => "_index" (1000) - logic = "op" "&&&" => "\<^const>Pure.conjunction" (1000) - logic = "op" "==>" => "\<^const>Pure.imp" (1000) - logic = "op" "==" => "\<^const>Pure.eq" (1000) - logic = "op" "\<Longrightarrow>" => "\<^const>Pure.imp" (1000) - logic = "op" "\<equiv>" => "\<^const>Pure.eq" (1000) - logic = "op" "\<longrightarrow>" => "\<^const>HOL.implies" (1000) - logic = "op" "=" => "\<^const>HOL.eq" (1000) - logic = "op" "\<and>" => "\<^const>HOL.conj" (1000) - logic = "op" "\<or>" => "\<^const>HOL.disj" (1000) - logic = "op" "\<noteq>" => "\<^const>HOL.not_equal" (1000) - logic = "op" "~=" => "\<^const>HOL.not_equal" (1000) - logic = "op" "-->" => "\<^const>HOL.implies" (1000) - logic = "op" "|" => "\<^const>HOL.disj" (1000) - logic = "op" "&" => "\<^const>HOL.conj" (1000) - logic = "op" "\<longleftrightarrow>" => "\<^const>HOL.iff" (1000) - logic = "op" "=simp=>" => "\<^const>HOL.simp_implies" (1000) - logic = "op" "<" => "\<^const>Orderings.ord_class.less" (1000) - logic = "op" "\<le>" => "\<^const>Orderings.ord_class.less_eq" (1000) - logic = "op" "\<ge>" => "\<^const>Orderings.ord_class.greater_eq" (1000) - logic = "op" ">" => "\<^const>Orderings.ord_class.greater" (1000) - logic = "op" "<=" => "\<^const>Orderings.ord_class.less_eq" (1000) - logic = "op" ">=" => "\<^const>Orderings.ord_class.greater_eq" (1000) - logic = "op" "+" => "\<^const>Groups.plus_class.plus" (1000) - logic = "op" "-" => "\<^const>Groups.minus_class.minus" (1000) - logic = "op" "*" => "\<^const>Groups.times_class.times" (1000) - logic = "op" "\<in>" => "\<^const>Set.member" (1000) - logic = "op" "\<notin>" => "\<^const>Set.not_member" (1000) - logic = "op" "~:" => "\<^const>Set.not_member" (1000) - logic = "op" ":" => "\<^const>Set.member" (1000) - logic = "op" "\<subseteq>" => "\<^const>Set.subset_eq" (1000) - logic = "op" "\<subset>" => "\<^const>Set.subset" (1000) - logic = "op" "\<supseteq>" => "\<^const>Set.supset_eq" (1000) - logic = "op" "\<supset>" => "\<^const>Set.supset" (1000) - logic = "op" "\<inter>" => "\<^const>Set.inter" (1000) - logic = "op" "Int" => "\<^const>Set.inter" (1000) - logic = "op" "\<union>" => "\<^const>Set.union" (1000) - logic = "op" "Un" => "\<^const>Set.union" (1000) - logic = "op" "`" => "\<^const>Set.image" (1000) - logic = "op" "-`" => "\<^const>Set.vimage" (1000) - logic = "op" "\<circ>" => "\<^const>Fun.comp" (1000) - logic = "op" "o" => "\<^const>Fun.comp" (1000) - logic = "op" "\<times>" => "\<^const>Product_Type.Times" (1000) - logic = "op" "<+>" => "\<^const>Sum_Type.Plus" (1000) - logic = "op" "dvd" => "\<^const>Rings.dvd_class.dvd" (1000) - logic = "op" "div" => "\<^const>Rings.divide_class.divide" (1000) - logic = "op" "/" => "\<^const>Fields.inverse_class.inverse_divide" (1000) - logic = "op" "^^" => "\<^const>Nat.compower" (1000) - logic = "op" "O" => "\<^const>Relation.relcomp" (1000) - logic = "op" "OO" => "\<^const>Relation.relcompp" (1000) - logic = "op" "``" => "\<^const>Relation.Image" (1000) - logic = "op" "<*lex*>" => "\<^const>Wellfounded.lex_prod" (1000) - logic = "op" "<*mlex*>" => "\<^const>Wellfounded.mlex_prod" (1000) - logic = "op" "initial_segment_of" => "\<^const>Zorn.initialSegmentOf" (1000) - logic = "op" "//" => "\<^const>Equiv_Relations.quotient" (1000) - logic = "op" "respects" => "\<^const>Equiv_Relations.RESPECTS" (1000) - logic = "op" "respects2" => "\<^const>Equiv_Relations.RESPECTS2" (1000) - logic = "op" "^" => "\<^const>Power.power_class.power" (1000) - logic = "op" "mod" => "\<^const>Divides.div_class.mod" (1000) - logic = "op" "#" => "\<^const>List.list.Cons" (1000) - logic = "op" "@" => "\<^const>List.append" (1000) - logic = "op" "!" => "\<^const>List.nth" (1000) - logic = "op" "\<circ>\<^sub>m" => "\<^const>Map.map_comp" (1000) - logic = "op" "++" => "\<^const>Map.map_add" (1000) - logic = "op" "|`" => "\<^const>Map.restrict_map" (1000) - logic = "op" "\<subseteq>\<^sub>m" => "\<^const>Map.map_le" (1000) - logic = "op" "\<times>\<^sub>F" => "\<^const>Filter.prod_filter" (1000) - logic = "op" "\<longlongrightarrow>" => "\<^const>Topological_Spaces.topological_space_class.tendsto" (1000) - logic = "op" "*\<^sub>R" => "\<^const>Real_Vector_Spaces.scaleR_class.scaleR" (1000) - logic = "op" "/\<^sub>R" => "\<^const>Real_Vector_Spaces.scaleR_class.divideR" (1000) - logic = "op" "sums" => "\<^const>Series.sums" (1000) - logic = "op" "has_derivative" => "\<^const>Deriv.has_derivative" (1000) - logic = "op" "has_field_derivative" => "\<^const>Deriv.has_field_derivative" (1000) - logic = "op" "has_vector_derivative" => "\<^const>Deriv.has_vector_derivative" (1000) - logic = "op" "differentiable" => "\<^const>Deriv.differentiable" (1000) - logic = "op" "has_real_derivative" => "\<^const>Deriv.has_real_derivative" (1000) - logic = "op" "choose" => "\<^const>Binomial.binomial" (1000) - logic = "op" "gchoose" => "\<^const>Binomial.field_char_0_class.gbinomial" (1000) - logic = "op" "powr" => "\<^const>Transcendental.powr" (1000) - logic = "op" "\<triangleq>" => "\<^const>UML_Logic.StrongEq" (1000) - logic = "op" "\<triangleq>\<^sub>p\<^sub>r\<^sub>e" => "\<^const>UML_Logic.StrongEq\<^sub>p\<^sub>r\<^sub>e" (1000) - logic = "op" "\<triangleq>\<^sub>p\<^sub>o\<^sub>s\<^sub>t" => "\<^const>UML_Logic.StrongEq\<^sub>p\<^sub>o\<^sub>s\<^sub>t" (1000) - logic = "op" "and" => "\<^const>UML_Logic.OclAnd" (1000) - logic = "op" "or" => "\<^const>UML_Logic.OclOr" (1000) - logic = "op" "implies" => "\<^const>UML_Logic.OclImplies" (1000) - logic = "op" "\<doteq>" => "\<^const>UML_Logic.StrictRefEq" (1000) - logic = "op" "<>" => "_notequal" (1000) - logic = "op" "+\<^sub>i\<^sub>n\<^sub>t" => "\<^const>UML_Integer.OclAdd\<^sub>I\<^sub>n\<^sub>t\<^sub>e\<^sub>g\<^sub>e\<^sub>r" (1000) - logic = "op" "-\<^sub>i\<^sub>n\<^sub>t" => "\<^const>UML_Integer.OclMinus\<^sub>I\<^sub>n\<^sub>t\<^sub>e\<^sub>g\<^sub>e\<^sub>r" (1000) - logic = "op" "*\<^sub>i\<^sub>n\<^sub>t" => "\<^const>UML_Integer.OclMult\<^sub>I\<^sub>n\<^sub>t\<^sub>e\<^sub>g\<^sub>e\<^sub>r" (1000) - logic = "op" "div\<^sub>i\<^sub>n\<^sub>t" => "\<^const>UML_Integer.OclDivision\<^sub>I\<^sub>n\<^sub>t\<^sub>e\<^sub>g\<^sub>e\<^sub>r" (1000) - logic = "op" "mod\<^sub>i\<^sub>n\<^sub>t" => "\<^const>UML_Integer.OclModulus\<^sub>I\<^sub>n\<^sub>t\<^sub>e\<^sub>g\<^sub>e\<^sub>r" (1000) - logic = "op" "<\<^sub>i\<^sub>n\<^sub>t" => "\<^const>UML_Integer.OclLess\<^sub>I\<^sub>n\<^sub>t\<^sub>e\<^sub>g\<^sub>e\<^sub>r" (1000) - logic = "op" "\<le>\<^sub>i\<^sub>n\<^sub>t" => "\<^const>UML_Integer.OclLe\<^sub>I\<^sub>n\<^sub>t\<^sub>e\<^sub>g\<^sub>e\<^sub>r" (1000) - logic = "op" "+\<^sub>s\<^sub>t\<^sub>r\<^sub>i\<^sub>n\<^sub>g" => "\<^const>UML_String.OclAdd\<^sub>S\<^sub>t\<^sub>r\<^sub>i\<^sub>n\<^sub>g" (1000) - logic = "op" "+\<^sub>r\<^sub>e\<^sub>a\<^sub>l" => "\<^const>UML_Real.OclAdd\<^sub>R\<^sub>e\<^sub>a\<^sub>l" (1000) - logic = "op" "-\<^sub>r\<^sub>e\<^sub>a\<^sub>l" => "\<^const>UML_Real.OclMinus\<^sub>R\<^sub>e\<^sub>a\<^sub>l" (1000) - logic = "op" "*\<^sub>r\<^sub>e\<^sub>a\<^sub>l" => "\<^const>UML_Real.OclMult\<^sub>R\<^sub>e\<^sub>a\<^sub>l" (1000) - logic = "op" "div\<^sub>r\<^sub>e\<^sub>a\<^sub>l" => "\<^const>UML_Real.OclDivision\<^sub>R\<^sub>e\<^sub>a\<^sub>l" (1000) - logic = "op" "mod\<^sub>r\<^sub>e\<^sub>a\<^sub>l" => "\<^const>UML_Real.OclModulus\<^sub>R\<^sub>e\<^sub>a\<^sub>l" (1000) - logic = "op" "<\<^sub>r\<^sub>e\<^sub>a\<^sub>l" => "\<^const>UML_Real.OclLess\<^sub>R\<^sub>e\<^sub>a\<^sub>l" (1000) - logic = "op" "\<le>\<^sub>r\<^sub>e\<^sub>a\<^sub>l" => "\<^const>UML_Real.OclLe\<^sub>R\<^sub>e\<^sub>a\<^sub>l" (1000) - logic = "op" "\<cong>" => "\<^const>UML_Bag.ApproxEq" (1000) - logic = "XCONST" longid_position[0] => "_context_xconst" (1000) - logic = "XCONST" id_position[0] => "_context_xconst" (1000) - logic = "CONST" longid_position[0] => "_context_const" (1000) - logic = "CONST" id_position[0] => "_context_const" (1000) - logic = "\<dots>" => "_DDDOT" (1000) - logic = "TYPE" "(" type[0] ")" => "_TYPE" (1000) - logic = "\<lambda>" pttrns[0] "." any[3] => "_lambda" (3) - logic = "\<lambda>" HOL.cases_syn[0] => "_lam_pats_syntax" (10) - logic = "(" logic[0] ")" (1000) - logic = "(" any[0] "," Product_Type.tuple_args[0] ")" => "_tuple" (1000) - logic = "..." => "_DDDOT" (1000) - logic = "%" pttrns[0] "." any[3] => "_lambda" (3) - logic = "%" HOL.cases_syn[0] => "_lam_pats_syntax" (10) - logic = "_" => "\<^const>Pure.dummy_pattern" (1000) - logic = "\<forall>" idts[0] "." logic[10] => "\<^const>HOL.All_binder" (10) - logic = "\<forall>" idt[0] "\<ge>" any[0] "." logic[10] => "_All_greater_eq" (10) - logic = "\<forall>" idt[0] ">" any[0] "." logic[10] => "_All_greater" (10) - logic = "\<forall>" idt[0] "\<le>" any[0] "." logic[10] => "_All_less_eq" (10) - logic = "\<forall>" idt[0] "<" any[0] "." logic[10] => "_All_less" (10) - logic = "\<forall>" pttrn[0] "\<in>" logic[0] "." logic[10] => "_Ball" (10) - logic = "\<forall>" idt[0] "\<subseteq>" any[0] "." logic[10] => "_setleAll" (10) - logic = "\<forall>" idt[0] "\<subset>" any[0] "." logic[10] => "_setlessAll" (10) - logic = "\<exists>" idts[0] "." logic[10] => "\<^const>HOL.Ex_binder" (10) - logic = "\<exists>" idt[0] "\<ge>" any[0] "." logic[10] => "_Ex_greater_eq" (10) - logic = "\<exists>" idt[0] ">" any[0] "." logic[10] => "_Ex_greater" (10) - logic = "\<exists>" idt[0] "\<le>" any[0] "." logic[10] => "_Ex_less_eq" (10) - logic = "\<exists>" idt[0] "<" any[0] "." logic[10] => "_Ex_less" (10) - logic = "\<exists>" pttrn[0] "\<in>" logic[0] "." logic[10] => "_Bex" (10) - logic = "\<exists>" idt[0] "\<subseteq>" any[0] "." logic[10] => "_setleEx" (10) - logic = "\<exists>" idt[0] "\<subset>" any[0] "." logic[10] => "_setlessEx" (10) - logic = "\<not>" logic[40] => "\<^const>HOL.Not" (40) - logic = "\<exists>!" idts[0] "." logic[10] => "\<^const>HOL.Ex1_binder" (10) - logic = "\<exists>!" pttrn[0] "\<in>" logic[0] "." logic[10] => "_Bex1" (10) - logic = "\<exists>!" idt[0] "\<subseteq>" any[0] "." logic[10] => "_setleEx1" (10) - logic = "~" logic[40] => "\<^const>HOL.Not" (40) - logic = "THE" pttrn[0] "." logic[10] => "_The" (10) - logic = "let" HOL.letbinds[0] "in" any[10] => "_Let" (10) - logic = "case" any[0] "of" HOL.cases_syn[0] => "_case_syntax" (10) - logic = "EX!" idts[0] "." logic[10] => "\<^const>HOL.Ex1_binder" (10) - logic = "EX!" pttrn[0] ":" logic[0] "." logic[10] => "_Bex1" (10) - logic = "EX" idts[0] "." logic[10] => "\<^const>HOL.Ex_binder" (10) - logic = "EX" idt[0] ">=" any[0] "." logic[10] => "_Ex_greater_eq" (10) - logic = "EX" idt[0] ">" any[0] "." logic[10] => "_Ex_greater" (10) - logic = "EX" idt[0] "<=" any[0] "." logic[10] => "_Ex_less_eq" (10) - logic = "EX" idt[0] "<" any[0] "." logic[10] => "_Ex_less" (10) - logic = "EX" pttrn[0] ":" logic[0] "." logic[10] => "_Bex" (10) - logic = "ALL" idts[0] "." logic[10] => "\<^const>HOL.All_binder" (10) - logic = "ALL" idt[0] ">=" any[0] "." logic[10] => "_All_greater_eq" (10) - logic = "ALL" idt[0] ">" any[0] "." logic[10] => "_All_greater" (10) - logic = "ALL" idt[0] "<=" any[0] "." logic[10] => "_All_less_eq" (10) - logic = "ALL" idt[0] "<" any[0] "." logic[10] => "_All_less" (10) - logic = "ALL" pttrn[0] ":" logic[0] "." logic[10] => "_Ball" (10) - logic = "?!" idts[0] "." logic[10] => "\<^const>HOL.Ex1_binder" (10) - logic = "?!" pttrn[0] ":" logic[0] "." logic[10] => "_Bex1" (10) - logic = "?" idts[0] "." logic[10] => "\<^const>HOL.Ex_binder" (10) - logic = "?" idt[0] "<=" any[0] "." logic[10] => "_Ex_less_eq" (10) - logic = "?" idt[0] "<" any[0] "." logic[10] => "_Ex_less" (10) - logic = "?" pttrn[0] ":" logic[0] "." logic[10] => "_Bex" (10) - logic = "!" idts[0] "." logic[10] => "\<^const>HOL.All_binder" (10) - logic = "!" idt[0] "<=" any[0] "." logic[10] => "_All_less_eq" (10) - logic = "!" idt[0] "<" any[0] "." logic[10] => "_All_less" (10) - logic = "!" pttrn[0] ":" logic[0] "." logic[10] => "_Ball" (10) - logic = "if" logic[0] "then" any[0] "else" any[10] => "\<^const>HOL.If" (10) - logic = "if" logic[10] "then" logic[10] "else" logic[10] "endif" => "\<^const>UML_Logic.OclIf" (50) - logic = "LEAST" idts[0] "." logic[10] => "\<^const>Orderings.ord_class.Least_binder" (10) - logic = "LEAST" id ":" logic[0] "." logic[10] => "_Bleast" (10) - logic = "LEAST" id "\<in>" logic[0] "." logic[10] => "_Bleast" (10) - logic = "LEAST" pttrn[0] "WRT" logic[4] "." logic[10] => "_LeastM" (10) - logic = "0" => "\<^const>Groups.zero_class.zero" (1000) - logic = "-" any[81] => "\<^const>Groups.uminus_class.uminus" (80) - logic = "\<bar>" any[0] "\<bar>" => "\<^const>Groups.abs_class.abs" (1000) - logic = "1" => "\<^const>Groups.one_class.one" (1000) - logic = "{" pttrn[0] "." logic[0] "}" => "_Coll" (1000) - logic = "{" pttrn[0] ":" logic[0] "." logic[0] "}" => "_Collect" (1000) - logic = "{" pttrn[0] "\<in>" logic[0] "." logic[0] "}" => "_Collect" (1000) - logic = "{" args[0] "}" => "_Finset" (1000) - logic = "{" any[0] "|" idts[0] "." logic[0] "}" => "_Setcompr" (1000) - logic = "{" any[0] "<..}" => "\<^const>Set_Interval.ord_class.greaterThan" (1000) - logic = "{" any[0] "..}" => "\<^const>Set_Interval.ord_class.atLeast" (1000) - logic = "{" any[0] "<..<" any[0] "}" => "\<^const>Set_Interval.ord_class.greaterThanLessThan" (1000) - logic = "{" any[0] "..<" any[0] "}" => "\<^const>Set_Interval.ord_class.atLeastLessThan" (1000) - logic = "{" any[0] "<.." any[0] "}" => "\<^const>Set_Interval.ord_class.greaterThanAtMost" (1000) - logic = "{" any[0] ".." any[0] "}" => "\<^const>Set_Interval.ord_class.atLeastAtMost" (1000) - logic = "{}" => "\<^const>Set.empty" (1000) - logic = "SUP" pttrn[0] ":" logic[0] "." any[10] => "_SUP" (10) - logic = "SUP" pttrns[0] "." any[10] => "_SUP1" (10) - logic = "INF" pttrn[0] ":" logic[0] "." any[10] => "_INF" (10) - logic = "INF" pttrns[0] "." any[10] => "_INF1" (10) - logic = "\<Inter>" logic[900] => "\<^const>Complete_Lattices.Inter" (900) - logic = "\<Inter>" pttrn[0] "\<in>" logic[0] "." logic[10] => "_INTER" (10) - logic = "\<Inter>" pttrns[0] "." logic[10] => "_INTER1" (10) - logic = "\<Inter>" any[0] "<" any[0] "." logic[10] => "_INTER_less" (10) - logic = "\<Inter>" any[0] "\<le>" any[0] "." logic[10] => "_INTER_le" (10) - logic = "INT" pttrn[0] ":" logic[0] "." logic[10] => "_INTER" (10) - logic = "INT" pttrns[0] "." logic[10] => "_INTER1" (10) - logic = "INT" any[0] "<" any[0] "." logic[10] => "_INTER_less" (10) - logic = "INT" any[0] "<=" any[0] "." logic[10] => "_INTER_le" (10) - logic = "\<Union>" logic[900] => "\<^const>Complete_Lattices.Union" (900) - logic = "\<Union>" pttrn[0] "\<in>" logic[0] "." logic[10] => "_UNION" (10) - logic = "\<Union>" pttrns[0] "." logic[10] => "_UNION1" (10) - logic = "\<Union>" any[0] "<" any[0] "." logic[10] => "_UNION_less" (10) - logic = "\<Union>" any[0] "\<le>" any[0] "." logic[10] => "_UNION_le" (10) - logic = "UN" pttrn[0] ":" logic[0] "." logic[10] => "_UNION" (10) - logic = "UN" pttrns[0] "." logic[10] => "_UNION1" (10) - logic = "UN" any[0] "<" any[0] "." logic[10] => "_UNION_less" (10) - logic = "UN" any[0] "<=" any[0] "." logic[10] => "_UNION_le" (10) - logic = "()" => "\<^const>Product_Type.Unity" (1000) - logic = "SIGMA" pttrn[0] ":" logic[0] "." logic[10] => "_Sigma" (10) - logic = "\<nat>" => "\<^const>Nat.semiring_1_class.Nats" (1000) - logic = "\<some>" pttrn[0] "." logic[10] => "_Eps" (10) - logic = "@" pttrn[0] "." logic[10] => "_Eps" (10) - logic = "SOME" pttrn[0] "." logic[10] => "_Eps" (10) - logic = "GREATEST" idts[0] "." logic[10] => "\<^const>Hilbert_Choice.Greatest_binder" (10) - logic = "GREATEST" pttrn[0] "WRT" logic[4] "." logic[10] => "_GreatestM" (10) - logic = "chain\<^sub>\<subseteq>" => "\<^const>Zorn.chain_subset" (1000) - logic = "CSUM" pttrn[0] ":" logic[51] "." logic[10] => "_Csum" (10) - logic = num_const[0] => "_Numeral" (1000) - logic = "\<Sum>" logic[1000] => "\<^const>Groups_Big.comm_monoid_add_class.Setsum" (999) - logic = "\<Sum>" pttrn[0] "\<in>" logic[51] "." any[10] => "_setsum" (10) - logic = "\<Sum>" pttrn[0] "|" logic[0] "." any[10] => "_qsetsum" (10) - logic = "\<Sum>" idt[0] "\<le>" any[0] "." any[10] => "_upto_setsum" (10) - logic = "\<Sum>" idt[0] "<" any[0] "." any[10] => "_upt_setsum" (10) - logic = "\<Sum>" idt[0] "=" any[0] "..<" any[0] "." any[10] => "_from_upto_setsum" (10) - logic = "\<Sum>" idt[0] "=" any[0] ".." any[0] "." any[10] => "_from_to_setsum" (10) - logic = "\<Sum>" pttrn[0] "\<leftarrow>" logic[51] "." any[10] => "_listsum" (10) - logic = "\<Sum>" idts[0] "." any[10] => "\<^const>Series.suminf_binder" (10) - logic = "SUM" pttrn[0] ":" logic[51] "." any[10] => "_setsum" (10) - logic = "SUM" pttrn[0] "|" logic[0] "." any[10] => "_qsetsum" (10) - logic = "SUM" idt[0] "<=" any[0] "." any[10] => "_upto_setsum" (10) - logic = "SUM" idt[0] "<" any[0] "." any[10] => "_upt_setsum" (10) - logic = "SUM" idt[0] "=" any[0] "..<" any[0] "." any[10] => "_from_upto_setsum" (10) - logic = "SUM" idt[0] "=" any[0] ".." any[0] "." any[10] => "_from_to_setsum" (10) - logic = "SUM" pttrn[0] "<-" logic[51] "." any[10] => "_listsum" (10) - logic = "\<Prod>" logic[1000] => "\<^const>Groups_Big.comm_monoid_mult_class.Setprod" (999) - logic = "\<Prod>" pttrn[0] "\<in>" logic[51] "." any[10] => "_setprod" (10) - logic = "\<Prod>" pttrn[0] "|" logic[0] "." any[10] => "_qsetprod" (10) - logic = "\<Prod>" idt[0] "\<le>" any[0] "." any[10] => "_upto_setprod" (10) - logic = "\<Prod>" idt[0] "<" any[0] "." any[10] => "_upt_setprod" (10) - logic = "\<Prod>" idt[0] "=" any[0] "..<" any[0] "." any[10] => "_from_upto_setprod" (10) - logic = "\<Prod>" idt[0] "=" any[0] ".." any[0] "." any[10] => "_from_to_setprod" (10) - logic = "\<Prod>" pttrn[0] "\<leftarrow>" logic[51] "." any[10] => "_listprod" (10) - logic = "PROD" pttrn[0] ":" logic[51] "." any[10] => "_setprod" (10) - logic = "PROD" pttrn[0] "|" logic[0] "." any[10] => "_qsetprod" (10) - logic = "PROD" idt[0] "<=" any[0] "." any[10] => "_upto_setprod" (10) - logic = "PROD" idt[0] "<" any[0] "." any[10] => "_upt_setprod" (10) - logic = "PROD" idt[0] "=" any[0] "..<" any[0] "." any[10] => "_from_upto_setprod" (10) - logic = "PROD" idt[0] "=" any[0] ".." any[0] "." any[10] => "_from_to_setprod" (10) - logic = "PROD" pttrn[0] "<-" logic[51] "." any[10] => "_listprod" (10) - logic = "\<int>" => "\<^const>Int.ring_1_class.Ints" (1000) - logic = "\<Sqinter>\<^sub>f\<^sub>i\<^sub>n" logic[900] => "\<^const>Lattices_Big.semilattice_inf_class.Inf_fin" (900) - logic = "\<Squnion>\<^sub>f\<^sub>i\<^sub>n" logic[900] => "\<^const>Lattices_Big.semilattice_sup_class.Sup_fin" (900) - logic = "{..<" any[0] "}" => "\<^const>Set_Interval.ord_class.lessThan" (1000) - logic = "{.." any[0] "}" => "\<^const>Set_Interval.ord_class.atMost" (1000) - logic = "[]" => "\<^const>List.list.Nil" (1000) - logic = "[" args[0] "]" => "_list" (1000) - logic = "[" pttrn[0] "<-" logic[0] "." logic[0] "]" => "_filter" (1000) - logic = "[" pttrn[0] "\<leftarrow>" logic[0] "." logic[0] "]" => "_filter" (1000) - logic = "[" logic[0] "..<" logic[0] "]" => "\<^const>List.upt" (1000) - logic = "[" any[0] "." List.lc_qual[0] List.lc_quals[0] => "_listcompr" (1000) - logic = "[" logic[0] ".." logic[0] "]" => "\<^const>List.upto" (1000) - logic = "[" Map.maplets[0] "]" => "_Map" (1000) - logic = "CHR" str_position[0] => "_Char" (1000) - logic = str_position[0] => "_String" (1000) - logic = "TYPEREP" "(" type[0] ")" => "_TYPEREP" (1000) - logic = "\<lparr>" Record.fields[0] "," "\<dots>" "=" any[0] "\<rparr>" => "_record_scheme" (1000) - logic = "\<lparr>" Record.fields[0] "\<rparr>" => "_record" (1000) - logic = "(|" Record.fields[0] "," "..." "=" any[0] "|)" => "_record_scheme" (1000) - logic = "(|" Record.fields[0] "|)" => "_record" (1000) - logic = "\<forall>\<^sub>F" pttrn[0] "in" logic[0] "." logic[10] => "_eventually" (10) - logic = "\<exists>\<^sub>F" pttrn[0] "in" logic[0] "." logic[10] => "_frequently" (10) - logic = "\<exists>\<^sub>\<infinity>" idts[0] "." logic[10] => "\<^const>Filter.Inf_many_binder" (10) - logic = "\<forall>\<^sub>\<infinity>" idts[0] "." logic[10] => "\<^const>Filter.Alm_all_binder" (10) - logic = "MOST" idts[0] "." logic[10] => "\<^const>Filter.Alm_all_binder" (10) - logic = "INFM" idts[0] "." logic[10] => "\<^const>Filter.Inf_many_binder" (10) - logic = "LIM" pttrns[1000] any[10] "." any[0] ":>" any[10] => "_LIM" (10) - logic = "\<rat>" => "\<^const>Rat.field_char_0_class.Rats" (1000) - logic = float_const[0] => "_Float" (1000) - logic = "at" any[1000] "within" logic[60] => "\<^const>Topological_Spaces.topological_space_class.at_within" (60) - logic = "at" => "\<^const>Topological_Spaces.topological_space_class.at" (1000) - logic = "\<real>" => "\<^const>Real_Vector_Spaces.Reals" (1000) - logic = "FDERIV" logic[1000] any[1000] ":>" logic[60] => "\<^const>Deriv.FDERIV" (60) - logic = "DERIV" logic[1000] any[1000] ":>" any[60] => "\<^const>Deriv.DERIV" (60) - logic = "\<lfloor>" any[0] "\<rfloor>" => "\<^const>Option.option.Some" (1000) - logic = "\<lceil>" logic[0] "\<rceil>" => "\<^const>UML_Types.drop" (1000) - logic = "I\<lbrakk>" any[0] "\<rbrakk>" => "\<^const>UML_Types.Sem" (1000) - logic = "\<upsilon>" logic[100] => "\<^const>UML_Logic.valid" (100) - logic = "\<delta>" logic[100] => "\<^const>UML_Logic.defined" (100) - logic = "not" => "\<^const>UML_Logic.OclNot" (1000) - logic = "\<bottom>" => "\<^const>UML_Types.bot_class.bot" (1000) - logic = "\<bottom>" => "\<^const>Option.option.None" (1000) - logic = "Pair{" logic[0] "," logic[0] "}" => "\<^const>UML_Pair.OclPair" (1000) - logic = "\<zero>" => "\<^const>UML_Integer.OclInt0" (1000) - logic = "\<one>" => "\<^const>UML_Integer.OclInt1" (1000) - logic = "\<two>" => "\<^const>UML_Integer.OclInt2" (1000) - logic = "\<three>" => "\<^const>UML_Integer.OclInt3" (1000) - logic = "\<four>" => "\<^const>UML_Integer.OclInt4" (1000) - logic = "\<five>" => "\<^const>UML_Integer.OclInt5" (1000) - logic = "\<six>" => "\<^const>UML_Integer.OclInt6" (1000) - logic = "\<seven>" => "\<^const>UML_Integer.OclInt7" (1000) - logic = "\<eight>" => "\<^const>UML_Integer.OclInt8" (1000) - logic = "\<nine>" => "\<^const>UML_Integer.OclInt9" (1000) - logic = "\<one>\<zero>" => "\<^const>UML_Integer.OclInt10" (1000) - logic = "\<a>" => "\<^const>UML_String.OclStringa" (1000) - logic = "\<b>" => "\<^const>UML_String.OclStringb" (1000) - logic = "\<c>" => "\<^const>UML_String.OclStringc" (1000) - logic = "\<zero>.\<zero>" => "\<^const>UML_Real.OclReal0" (1000) - logic = "\<one>.\<zero>" => "\<^const>UML_Real.OclReal1" (1000) - logic = "\<two>.\<zero>" => "\<^const>UML_Real.OclReal2" (1000) - logic = "\<three>.\<zero>" => "\<^const>UML_Real.OclReal3" (1000) - logic = "\<four>.\<zero>" => "\<^const>UML_Real.OclReal4" (1000) - logic = "\<five>.\<zero>" => "\<^const>UML_Real.OclReal5" (1000) - logic = "\<six>.\<zero>" => "\<^const>UML_Real.OclReal6" (1000) - logic = "\<seven>.\<zero>" => "\<^const>UML_Real.OclReal7" (1000) - logic = "\<eight>.\<zero>" => "\<^const>UML_Real.OclReal8" (1000) - logic = "\<nine>.\<zero>" => "\<^const>UML_Real.OclReal9" (1000) - logic = "\<one>\<zero>.\<zero>" => "\<^const>UML_Real.OclReal10" (1000) - logic = "\<pi>" => "\<^const>UML_Real.OclRealpi" (1000) - logic = "Bag{}" => "\<^const>UML_Bag.mtBag" (1000) - logic = "Bag{" args[0] "}" => "_OclFinbag" (1000) - logic = "Set{}" => "\<^const>UML_Set.mtSet" (1000) - logic = "Set{" args[0] "}" => "_OclFinset" (1000) - logic = "Sequence{}" => "\<^const>UML_Sequence.mtSequence" (1000) - logic = "Sequence{" args[0] "}" => "_OclFinsequence" (1000) - logic = cartouche_position[0] => "_cartouche_oclstring" (1000) - logic = "_'" => "_ocl_denotation" (1000) - logic = logic[0] "->asBag\<^sub>P\<^sub>a\<^sub>i\<^sub>r()" => "\<^const>UML_Library.OclAsBag\<^sub>P\<^sub>a\<^sub>i\<^sub>r" (1000) - logic = logic[0] "->asBag\<^sub>S\<^sub>e\<^sub>t()" => "\<^const>UML_Library.OclAsBag\<^sub>S\<^sub>e\<^sub>t" (1000) - logic = logic[0] "->asBag\<^sub>S\<^sub>e\<^sub>q()" => "\<^const>UML_Library.OclAsBag\<^sub>S\<^sub>e\<^sub>q" (1000) - logic = logic[0] "->asSequence\<^sub>P\<^sub>a\<^sub>i\<^sub>r()" => "\<^const>UML_Library.OclAsSeq\<^sub>P\<^sub>a\<^sub>i\<^sub>r" (1000) - logic = logic[0] "->asSequence\<^sub>B\<^sub>a\<^sub>g()" => "\<^const>UML_Library.OclAsSeq\<^sub>B\<^sub>a\<^sub>g" (1000) - logic = logic[0] "->asSequence\<^sub>S\<^sub>e\<^sub>t()" => "\<^const>UML_Library.OclAsSeq\<^sub>S\<^sub>e\<^sub>t" (1000) - logic = logic[0] "->asSet\<^sub>B\<^sub>a\<^sub>g()" => "\<^const>UML_Library.OclAsSet\<^sub>B\<^sub>a\<^sub>g" (1000) - logic = logic[0] "->asSet\<^sub>P\<^sub>a\<^sub>i\<^sub>r()" => "\<^const>UML_Library.OclAsSet\<^sub>P\<^sub>a\<^sub>i\<^sub>r" (1000) - logic = logic[0] "->asSet\<^sub>S\<^sub>e\<^sub>q()" => "\<^const>UML_Library.OclAsSet\<^sub>S\<^sub>e\<^sub>q" (1000) - logic = logic[0] "->asPair\<^sub>B\<^sub>a\<^sub>g()" => "\<^const>UML_Library.OclAsPair\<^sub>B\<^sub>a\<^sub>g" (1000) - logic = logic[0] "->asPair\<^sub>S\<^sub>e\<^sub>t()" => "\<^const>UML_Library.OclAsPair\<^sub>S\<^sub>e\<^sub>t" (1000) - logic = logic[0] "->asPair\<^sub>S\<^sub>e\<^sub>q()" => "\<^const>UML_Library.OclAsPair\<^sub>S\<^sub>e\<^sub>q" (1000) - logic = logic[0] "->oclAsType\<^sub>I\<^sub>n\<^sub>t(Real)" => "\<^const>UML_Library.OclAsReal\<^sub>I\<^sub>n\<^sub>t" (1000) - logic = logic[0] "->oclAsType\<^sub>R\<^sub>e\<^sub>a\<^sub>l(Integer)" => "\<^const>UML_Library.OclAsInteger\<^sub>R\<^sub>e\<^sub>a\<^sub>l" (1000) - logic = logic[0] "->oclAsType\<^sub>R\<^sub>e\<^sub>a\<^sub>l(Boolean)" => "\<^const>UML_Library.OclAsBoolean\<^sub>R\<^sub>e\<^sub>a\<^sub>l" (1000) - logic = logic[0] "->oclAsType\<^sub>I\<^sub>n\<^sub>t(Boolean)" => "\<^const>UML_Library.OclAsBoolean\<^sub>I\<^sub>n\<^sub>t" (1000) - logic = logic[0] "->sum\<^sub>S\<^sub>e\<^sub>q()" => "\<^const>UML_Sequence.OclSum" (1000) - logic = logic[0] "->count\<^sub>S\<^sub>e\<^sub>q(" logic[0] ")" => "\<^const>UML_Sequence.OclCount" (1000) - logic = logic[0] "->any\<^sub>S\<^sub>e\<^sub>q()" => "\<^const>UML_Sequence.OclANY" (1000) - logic = logic[0] "->notEmpty\<^sub>S\<^sub>e\<^sub>q()" => "\<^const>UML_Sequence.OclNotEmpty" (1000) - logic = logic[0] "->isEmpty\<^sub>S\<^sub>e\<^sub>q()" => "\<^const>UML_Sequence.OclIsEmpty" (1000) - logic = logic[0] "->size\<^sub>S\<^sub>e\<^sub>q()" => "\<^const>UML_Sequence.OclSize" (1000) - logic = logic[0] "->select\<^sub>S\<^sub>e\<^sub>q(" id "|" logic[0] ")" => "_OclSelectSeq" (1000) - logic = logic[0] "->collect\<^sub>S\<^sub>e\<^sub>q(" id "|" logic[0] ")" => "_OclCollectSeq" (1000) - logic = logic[0] "->exists\<^sub>S\<^sub>e\<^sub>q(" id "|" logic[0] ")" => "_OclExistSeq" (1000) - logic = logic[0] "->forAll\<^sub>S\<^sub>e\<^sub>q(" id "|" logic[0] ")" => "_OclForallSeq" (1000) - logic = logic[0] "->iterate\<^sub>S\<^sub>e\<^sub>q(" idt[0] ";" idt[0] "=" any[0] "|" any[0] ")" => "_OclIterateSeq" (1000) - logic = logic[0] "->last\<^sub>S\<^sub>e\<^sub>q(" logic[0] ")" => "\<^const>UML_Sequence.OclLast" (1000) - logic = logic[0] "->first\<^sub>S\<^sub>e\<^sub>q(" logic[0] ")" => "\<^const>UML_Sequence.OclFirst" (1000) - logic = logic[0] "->at\<^sub>S\<^sub>e\<^sub>q(" logic[0] ")" => "\<^const>UML_Sequence.OclAt" (1000) - logic = logic[0] "->union\<^sub>S\<^sub>e\<^sub>q(" logic[0] ")" => "\<^const>UML_Sequence.OclUnion" (1000) - logic = logic[0] "->append\<^sub>S\<^sub>e\<^sub>q(" logic[0] ")" => "\<^const>UML_Sequence.OclAppend" (1000) - logic = logic[0] "->excluding\<^sub>S\<^sub>e\<^sub>q(" logic[0] ")" => "\<^const>UML_Sequence.OclExcluding" (1000) - logic = logic[0] "->including\<^sub>S\<^sub>e\<^sub>q(" logic[0] ")" => "\<^const>UML_Sequence.OclIncluding" (1000) - logic = logic[0] "->prepend\<^sub>S\<^sub>e\<^sub>q(" logic[0] ")" => "\<^const>UML_Sequence.OclPrepend" (1000) - logic = logic[0] "->sum\<^sub>S\<^sub>e\<^sub>t()" => "\<^const>UML_Set.OclSum" (1000) - logic = logic[0] "->count\<^sub>S\<^sub>e\<^sub>t(" logic[0] ")" => "\<^const>UML_Set.OclCount" (1000) - logic = logic[0] "->intersection\<^sub>S\<^sub>e\<^sub>t(" logic[0] ")" => "\<^const>UML_Set.OclIntersection" (1000) - logic = logic[0] "->union\<^sub>S\<^sub>e\<^sub>t(" logic[0] ")" => "\<^const>UML_Set.OclUnion" (1000) - logic = logic[0] "->excludesAll\<^sub>S\<^sub>e\<^sub>t(" logic[0] ")" => "\<^const>UML_Set.OclExcludesAll" (1000) - logic = logic[0] "->includesAll\<^sub>S\<^sub>e\<^sub>t(" logic[0] ")" => "\<^const>UML_Set.OclIncludesAll" (1000) - logic = logic[0] "->reject\<^sub>S\<^sub>e\<^sub>t(" id "|" logic[0] ")" => "_OclRejectSet" (1000) - logic = logic[0] "->select\<^sub>S\<^sub>e\<^sub>t(" id "|" logic[0] ")" => "_OclSelectSet" (1000) - logic = logic[0] "->iterate\<^sub>S\<^sub>e\<^sub>t(" idt[0] ";" idt[0] "=" any[0] "|" any[0] ")" => "_OclIterateSet" (1000) - logic = logic[0] "->exists\<^sub>S\<^sub>e\<^sub>t(" id "|" logic[0] ")" => "_OclExistSet" (1000) - logic = logic[0] "->forAll\<^sub>S\<^sub>e\<^sub>t(" id "|" logic[0] ")" => "_OclForallSet" (1000) - logic = logic[0] "->any\<^sub>S\<^sub>e\<^sub>t()" => "\<^const>UML_Set.OclANY" (1000) - logic = logic[0] "->notEmpty\<^sub>S\<^sub>e\<^sub>t()" => "\<^const>UML_Set.OclNotEmpty" (1000) - logic = logic[0] "->isEmpty\<^sub>S\<^sub>e\<^sub>t()" => "\<^const>UML_Set.OclIsEmpty" (1000) - logic = logic[0] "->size\<^sub>S\<^sub>e\<^sub>t()" => "\<^const>UML_Set.OclSize" (1000) - logic = logic[0] "->excludes\<^sub>S\<^sub>e\<^sub>t(" logic[0] ")" => "\<^const>UML_Set.OclExcludes" (1000) - logic = logic[0] "->includes\<^sub>S\<^sub>e\<^sub>t(" logic[0] ")" => "\<^const>UML_Set.OclIncludes" (1000) - logic = logic[0] "->excluding\<^sub>S\<^sub>e\<^sub>t(" logic[0] ")" => "\<^const>UML_Set.OclExcluding" (1000) - logic = logic[0] "->including\<^sub>S\<^sub>e\<^sub>t(" logic[0] ")" => "\<^const>UML_Set.OclIncluding" (1000) - logic = logic[0] "->sum\<^sub>B\<^sub>a\<^sub>g()" => "\<^const>UML_Bag.OclSum" (1000) - logic = logic[0] "->count\<^sub>B\<^sub>a\<^sub>g(" logic[0] ")" => "\<^const>UML_Bag.OclCount" (1000) - logic = logic[0] "->intersection\<^sub>B\<^sub>a\<^sub>g(" logic[0] ")" => "\<^const>UML_Bag.OclIntersection" (1000) - logic = logic[0] "->union\<^sub>B\<^sub>a\<^sub>g(" logic[0] ")" => "\<^const>UML_Bag.OclUnion" (1000) - logic = logic[0] "->excludesAll\<^sub>B\<^sub>a\<^sub>g(" logic[0] ")" => "\<^const>UML_Bag.OclExcludesAll" (1000) - logic = logic[0] "->includesAll\<^sub>B\<^sub>a\<^sub>g(" logic[0] ")" => "\<^const>UML_Bag.OclIncludesAll" (1000) - logic = logic[0] "->reject\<^sub>B\<^sub>a\<^sub>g(" id "|" logic[0] ")" => "_OclRejectBag" (1000) - logic = logic[0] "->select\<^sub>B\<^sub>a\<^sub>g(" id "|" logic[0] ")" => "_OclSelectBag" (1000) - logic = logic[0] "->iterate\<^sub>B\<^sub>a\<^sub>g(" idt[0] ";" idt[0] "=" any[0] "|" any[0] ")" => "_OclIterateBag" (1000) - logic = logic[0] "->exists\<^sub>B\<^sub>a\<^sub>g(" id "|" logic[0] ")" => "_OclExistBag" (1000) - logic = logic[0] "->forAll\<^sub>B\<^sub>a\<^sub>g(" id "|" logic[0] ")" => "_OclForallBag" (1000) - logic = logic[0] "->any\<^sub>B\<^sub>a\<^sub>g()" => "\<^const>UML_Bag.OclANY" (1000) - logic = logic[0] "->notEmpty\<^sub>B\<^sub>a\<^sub>g()" => "\<^const>UML_Bag.OclNotEmpty" (1000) - logic = logic[0] "->isEmpty\<^sub>B\<^sub>a\<^sub>g()" => "\<^const>UML_Bag.OclIsEmpty" (1000) - logic = logic[0] "->size\<^sub>B\<^sub>a\<^sub>g()" => "\<^const>UML_Bag.OclSize" (1000) - logic = logic[0] "->excludes\<^sub>B\<^sub>a\<^sub>g(" logic[0] ")" => "\<^const>UML_Bag.OclExcludes" (1000) - logic = logic[0] "->includes\<^sub>B\<^sub>a\<^sub>g(" logic[0] ")" => "\<^const>UML_Bag.OclIncludes" (1000) - logic = logic[0] "->excluding\<^sub>B\<^sub>a\<^sub>g(" logic[0] ")" => "\<^const>UML_Bag.OclExcluding" (1000) - logic = logic[0] "->including\<^sub>B\<^sub>a\<^sub>g(" logic[0] ")" => "\<^const>UML_Bag.OclIncluding" (1000) - logic = logic[30] "\<cong>" logic[31] => "\<^const>UML_Bag.ApproxEq" (30) - logic = logic[36] "\<le>\<^sub>r\<^sub>e\<^sub>a\<^sub>l" logic[36] => "\<^const>UML_Real.OclLe\<^sub>R\<^sub>e\<^sub>a\<^sub>l" (35) - logic = logic[36] "<\<^sub>r\<^sub>e\<^sub>a\<^sub>l" logic[36] => "\<^const>UML_Real.OclLess\<^sub>R\<^sub>e\<^sub>a\<^sub>l" (35) - logic = logic[46] "mod\<^sub>r\<^sub>e\<^sub>a\<^sub>l" logic[46] => "\<^const>UML_Real.OclModulus\<^sub>R\<^sub>e\<^sub>a\<^sub>l" (45) - logic = logic[46] "div\<^sub>r\<^sub>e\<^sub>a\<^sub>l" logic[46] => "\<^const>UML_Real.OclDivision\<^sub>R\<^sub>e\<^sub>a\<^sub>l" (45) - logic = logic[46] "*\<^sub>r\<^sub>e\<^sub>a\<^sub>l" logic[46] => "\<^const>UML_Real.OclMult\<^sub>R\<^sub>e\<^sub>a\<^sub>l" (45) - logic = logic[42] "-\<^sub>r\<^sub>e\<^sub>a\<^sub>l" logic[42] => "\<^const>UML_Real.OclMinus\<^sub>R\<^sub>e\<^sub>a\<^sub>l" (41) - logic = logic[41] "+\<^sub>r\<^sub>e\<^sub>a\<^sub>l" logic[41] => "\<^const>UML_Real.OclAdd\<^sub>R\<^sub>e\<^sub>a\<^sub>l" (40) - logic = logic[41] "+\<^sub>s\<^sub>t\<^sub>r\<^sub>i\<^sub>n\<^sub>g" logic[41] => "\<^const>UML_String.OclAdd\<^sub>S\<^sub>t\<^sub>r\<^sub>i\<^sub>n\<^sub>g" (40) - logic = logic[36] "\<le>\<^sub>i\<^sub>n\<^sub>t" logic[36] => "\<^const>UML_Integer.OclLe\<^sub>I\<^sub>n\<^sub>t\<^sub>e\<^sub>g\<^sub>e\<^sub>r" (35) - logic = logic[36] "<\<^sub>i\<^sub>n\<^sub>t" logic[36] => "\<^const>UML_Integer.OclLess\<^sub>I\<^sub>n\<^sub>t\<^sub>e\<^sub>g\<^sub>e\<^sub>r" (35) - logic = logic[46] "mod\<^sub>i\<^sub>n\<^sub>t" logic[46] => "\<^const>UML_Integer.OclModulus\<^sub>I\<^sub>n\<^sub>t\<^sub>e\<^sub>g\<^sub>e\<^sub>r" (45) - logic = logic[46] "div\<^sub>i\<^sub>n\<^sub>t" logic[46] => "\<^const>UML_Integer.OclDivision\<^sub>I\<^sub>n\<^sub>t\<^sub>e\<^sub>g\<^sub>e\<^sub>r" (45) - logic = logic[46] "*\<^sub>i\<^sub>n\<^sub>t" logic[46] => "\<^const>UML_Integer.OclMult\<^sub>I\<^sub>n\<^sub>t\<^sub>e\<^sub>g\<^sub>e\<^sub>r" (45) - logic = logic[42] "-\<^sub>i\<^sub>n\<^sub>t" logic[42] => "\<^const>UML_Integer.OclMinus\<^sub>I\<^sub>n\<^sub>t\<^sub>e\<^sub>g\<^sub>e\<^sub>r" (41) - logic = logic[41] "+\<^sub>i\<^sub>n\<^sub>t" logic[41] => "\<^const>UML_Integer.OclAdd\<^sub>I\<^sub>n\<^sub>t\<^sub>e\<^sub>g\<^sub>e\<^sub>r" (40) - logic = logic[0] ".Second()" => "\<^const>UML_Pair.OclSecond" (1000) - logic = logic[0] ".First()" => "\<^const>UML_Pair.OclFirst" (1000) - logic = logic[41] "<>" logic[41] => "_notequal" (40) - logic = logic[30] "\<doteq>" logic[31] => "\<^const>UML_Logic.StrictRefEq" (30) - logic = logic[0] "\<Turnstile>\<^sub>p\<^sub>o\<^sub>s\<^sub>t" logic[0] => "\<^const>UML_Logic.OclValid_at_post" (50) - logic = logic[0] "\<Turnstile>\<^sub>p\<^sub>r\<^sub>e" logic[0] => "\<^const>UML_Logic.OclValid_at_pre" (50) - logic = logic[0] "|\<noteq>" logic[0] => "_OclNonValid" (50) - logic = logic[0] "\<Turnstile>" logic[0] => "\<^const>UML_Logic.OclValid" (50) - logic = logic[25] "implies" logic[26] => "\<^const>UML_Logic.OclImplies" (25) - logic = logic[25] "or" logic[26] => "\<^const>UML_Logic.OclOr" (25) - logic = logic[30] "and" logic[31] => "\<^const>UML_Logic.OclAnd" (30) - logic = logic[30] "\<triangleq>\<^sub>p\<^sub>o\<^sub>s\<^sub>t" logic[31] => "\<^const>UML_Logic.StrongEq\<^sub>p\<^sub>o\<^sub>s\<^sub>t" (30) - logic = logic[30] "\<triangleq>\<^sub>p\<^sub>r\<^sub>e" logic[31] => "\<^const>UML_Logic.StrongEq\<^sub>p\<^sub>r\<^sub>e" (30) - logic = logic[30] "\<triangleq>" logic[31] => "\<^const>UML_Logic.StrongEq" (30) - logic = logic[65] "choose" logic[66] => "\<^const>Binomial.binomial" (65) - logic = logic[51] "has_real_derivative" logic[51] => "\<^const>Deriv.has_real_derivative" (50) - logic = logic[51] "differentiable" logic[51] => "\<^const>Deriv.differentiable" (50) - logic = logic[51] "has_vector_derivative" any[51] => "\<^const>Deriv.has_vector_derivative" (50) - logic = logic[51] "has_field_derivative" any[51] => "\<^const>Deriv.has_field_derivative" (50) - logic = logic[51] "has_derivative" logic[51] => "\<^const>Deriv.has_derivative" (50) - logic = logic[81] "sums" any[80] => "\<^const>Series.sums" (80) - logic = logic[76] "*\<^sub>R" any[75] => "\<^const>Real_Vector_Spaces.scaleR_class.scaleR" (75) - logic = logic[60] "\<midarrow>" any[0] "\<rightarrow>" any[60] => "\<^const>Topological_Spaces.LIM" (60) - logic = logic[60] "\<longlonglongrightarrow>" any[60] => "\<^const>Topological_Spaces.topological_space_class.LIMSEQ" (60) - logic = logic[56] "\<longlongrightarrow>" any[55] => "\<^const>Topological_Spaces.topological_space_class.tendsto" (55) - logic = logic[81] "\<times>\<^sub>F" logic[80] => "\<^const>Filter.prod_filter" (80) - logic = logic[900] "(" Map.maplets[0] ")" => "_MapUpd" (900) - logic = logic[51] "\<subseteq>\<^sub>m" logic[51] => "\<^const>Map.map_le" (50) - logic = logic[110] "|`" logic[111] => "\<^const>Map.restrict_map" (110) - logic = logic[100] "++" logic[101] => "\<^const>Map.map_add" (100) - logic = logic[55] "\<circ>\<^sub>m" logic[56] => "\<^const>Map.map_comp" (55) - logic = logic[100] "!" logic[101] => "\<^const>List.nth" (100) - logic = logic[66] "@" logic[65] => "\<^const>List.append" (65) - logic = logic[81] "respects2" logic[80] => "\<^const>Equiv_Relations.RESPECTS2" (80) - logic = logic[81] "respects" logic[80] => "\<^const>Equiv_Relations.RESPECTS" (80) - logic = logic[90] "//" logic[91] => "\<^const>Equiv_Relations.quotient" (90) - logic = logic[56] "initial_segment_of" logic[56] => "\<^const>Zorn.initialSegmentOf" (55) - logic = logic[81] "<*mlex*>" logic[80] => "\<^const>Wellfounded.mlex_prod" (80) - logic = logic[81] "<*lex*>" logic[80] => "\<^const>Wellfounded.lex_prod" (80) - logic = logic[1000] "^*" => "\<^const>Transitive_Closure.rtrancl" (999) - logic = logic[1000] "^+" => "\<^const>Transitive_Closure.trancl" (999) - logic = logic[1000] "^=" => "\<^const>Transitive_Closure.reflcl" (999) - logic = logic[1000] "^**" => "\<^const>Transitive_Closure.rtranclp" (1000) - logic = logic[1000] "^++" => "\<^const>Transitive_Closure.tranclp" (1000) - logic = logic[1000] "^==" => "\<^const>Transitive_Closure.reflclp" (1000) - logic = logic[1000] "\<^sup>=\<^sup>=" => "\<^const>Transitive_Closure.reflclp" (1000) - logic = logic[1000] "\<^sup>=" => "\<^const>Transitive_Closure.reflcl" (999) - logic = logic[1000] "\<^sup>*\<^sup>*" => "\<^const>Transitive_Closure.rtranclp" (1000) - logic = logic[1000] "\<^sup>+\<^sup>+" => "\<^const>Transitive_Closure.tranclp" (1000) - logic = logic[1000] "\<^sup>+" => "\<^const>Transitive_Closure.trancl" (999) - logic = logic[1000] "\<^sup>*" => "\<^const>Transitive_Closure.rtrancl" (999) - logic = logic[91] "``" logic[90] => "\<^const>Relation.Image" (90) - logic = logic[1000] "^-1" => "\<^const>Relation.converse" (999) - logic = logic[1000] "^--1" => "\<^const>Relation.conversep" (1000) - logic = logic[1000] "\<inverse>\<inverse>" => "\<^const>Relation.conversep" (1000) - logic = logic[1000] "\<inverse>" => "\<^const>Relation.converse" (999) - logic = logic[76] "OO" logic[75] => "\<^const>Relation.relcompp" (75) - logic = logic[76] "O" logic[75] => "\<^const>Relation.relcomp" (75) - logic = logic[66] "<+>" logic[65] => "\<^const>Sum_Type.Plus" (65) - logic = logic[81] "\<times>" logic[80] => "\<^const>Product_Type.Times" (80) - logic = logic[55] "o" logic[56] => "\<^const>Fun.comp" (55) - logic = logic[55] "\<circ>" logic[56] => "\<^const>Fun.comp" (55) - logic = logic[91] "-`" logic[90] => "\<^const>Set.vimage" (90) - logic = logic[91] "`" logic[90] => "\<^const>Set.image" (90) - logic = logic[65] "Un" logic[66] => "\<^const>Set.union" (65) - logic = logic[65] "\<union>" logic[66] => "\<^const>Set.union" (65) - logic = logic[70] "Int" logic[71] => "\<^const>Set.inter" (70) - logic = logic[70] "\<inter>" logic[71] => "\<^const>Set.inter" (70) - logic = logic[51] "\<supset>" logic[51] => "\<^const>Set.supset" (50) - logic = logic[51] "\<supseteq>" logic[51] => "\<^const>Set.supset_eq" (50) - logic = logic[51] "\<subset>" logic[51] => "\<^const>Set.subset" (50) - logic = logic[51] "\<subseteq>" logic[51] => "\<^const>Set.subset_eq" (50) - logic = logic[26] "\<longleftrightarrow>" logic[25] => "\<^const>HOL.iff" (25) - logic = logic[36] "&" logic[35] => "\<^const>HOL.conj" (35) - logic = logic[31] "|" logic[30] => "\<^const>HOL.disj" (30) - logic = logic[26] "-->" logic[25] => "\<^const>HOL.implies" (25) - logic = logic[31] "\<or>" logic[30] => "\<^const>HOL.disj" (30) - logic = logic[36] "\<and>" logic[35] => "\<^const>HOL.conj" (35) - logic = logic[26] "\<longrightarrow>" logic[25] => "\<^const>HOL.implies" (25) - logic = logic[1000] cargs[1000] => "_applC" (999) - logic = logic[4] "::" type[0] => "_constrain" (3) - logic = any[81] "powr" any[80] => "\<^const>Transcendental.powr" (80) - logic = any[65] "gchoose" logic[66] => "\<^const>Binomial.field_char_0_class.gbinomial" (65) - logic = any[70] "/\<^sub>R" logic[71] => "\<^const>Real_Vector_Spaces.scaleR_class.divideR" (70) - logic = any[900] "(|" Record.field_updates[0] "|)" => "_record_update" (900) - logic = any[900] "\<lparr>" Record.field_updates[0] "\<rparr>" => "_record_update" (900) - logic = any[900] "[" List.lupdbinds[0] "]" => "_LUpdate" (900) - logic = any[66] "#" logic[65] => "\<^const>List.list.Cons" (65) - logic = any[70] "mod" any[71] => "\<^const>Divides.div_class.mod" (70) - logic = any[1000] "\<^sup>2" => "\<^const>Power.power_class.power2" (999) - logic = any[81] "^" logic[80] => "\<^const>Power.power_class.power" (80) - logic = any[81] "^^" logic[80] => "\<^const>Nat.compower" (80) - logic = any[70] "/" any[71] => "\<^const>Fields.inverse_class.inverse_divide" (70) - logic = any[70] "div" any[71] => "\<^const>Rings.divide_class.divide" (70) - logic = any[51] "dvd" any[51] => "\<^const>Rings.dvd_class.dvd" (50) - logic = any[1000] "(" Fun.updbinds[0] ")" => "_Update" (900) - logic = any[51] ":" logic[51] => "\<^const>Set.member" (50) - logic = any[51] "~:" logic[51] => "\<^const>Set.not_member" (50) - logic = any[51] "\<notin>" logic[51] => "\<^const>Set.not_member" (50) - logic = any[51] "\<in>" logic[51] => "\<^const>Set.member" (50) - logic = any[70] "*" any[71] => "\<^const>Groups.times_class.times" (70) - logic = any[65] "-" any[66] => "\<^const>Groups.minus_class.minus" (65) - logic = any[65] "+" any[66] => "\<^const>Groups.plus_class.plus" (65) - logic = any[51] ">=" any[51] => "\<^const>Orderings.ord_class.greater_eq" (50) - logic = any[51] "<=" any[51] => "\<^const>Orderings.ord_class.less_eq" (50) - logic = any[51] ">" any[51] => "\<^const>Orderings.ord_class.greater" (50) - logic = any[51] "\<ge>" any[51] => "\<^const>Orderings.ord_class.greater_eq" (50) - logic = any[51] "\<le>" any[51] => "\<^const>Orderings.ord_class.less_eq" (50) - logic = any[51] "<" any[51] => "\<^const>Orderings.ord_class.less" (50) - logic = any[50] "~=" any[51] => "\<^const>HOL.not_equal" (50) - logic = any[50] "\<noteq>" any[51] => "\<^const>HOL.not_equal" (50) - logic = any[50] "=" any[51] => "\<^const>HOL.eq" (50) - logic = logic[0] ".allInstances()" => "\<^const>UML_State.OclAllInstances_at_post" (1000) - logic = logic[0] ".allInstances@pre()" => "\<^const>UML_State.OclAllInstances_at_pre" (1000) - logic = logic[0] ".oclIsNew()" => "\<^const>UML_State.OclIsNew" (1000) - logic = logic[0] ".oclIsDeleted()" => "\<^const>UML_State.OclIsDeleted" (1000) - logic = logic[0] ".oclIsMaintained()" => "\<^const>UML_State.OclIsMaintained" (1000) - logic = logic[0] ".oclIsAbsent()" => "\<^const>UML_State.OclIsAbsent" (1000) - logic = logic[0] "->oclIsModifiedOnly()" => "\<^const>UML_State.OclIsModifiedOnly" (1000) - logic = logic[0] "@pre" logic[0] => "\<^const>UML_State.OclSelf_at_pre" (1000) - logic = logic[0] "@post" logic[0] => "\<^const>UML_State.OclSelf_at_post" (1000) - logic = var_position[-1] (-1) - logic = longid_position[-1] (-1) - logic = id_position[-1] (-1) - longid_position = longid => "_position" (1000) - num_const = num_position[0] => "_constify" (1000) - num_position = num_token => "_position" (1000) - "prop" = logic[0] => "\<^const>HOL.Trueprop" (5) - "prop" = prop'[-1] (-1) - prop' = "TERM" logic[0] => "\<^const>Pure.term" (1000) - prop' = "SORT_CONSTRAINT" "(" type[0] ")" => "_sort_constraint" (1000) - prop' = "OFCLASS" "(" type[0] "," logic[0] ")" => "_ofclass" (1000) - prop' = "\<lbrakk>" asms[0] "\<rbrakk>" "\<Longrightarrow>" "prop"[1] => "_bigimpl" (1) - prop' = "PROP" aprop[0] => "_aprop" (1000) - prop' = "(" prop'[0] ")" (1000) - prop' = "[|" asms[0] "|]" "==>" "prop"[1] => "_bigimpl" (1) - prop' = "!!" idts[0] "." "prop"[0] => "\<^const>Pure.all_binder" (0) - prop' = "\<And>" idts[0] "." "prop"[0] => "\<^const>Pure.all_binder" (0) - prop' = any[3] "\<equiv>" any[3] => "\<^const>Pure.eq" (2) - prop' = any[3] "==" any[3] => "\<^const>Pure.eq" (2) - prop' = "prop"[2] "\<Longrightarrow>" "prop"[1] => "\<^const>Pure.imp" (1) - prop' = "prop"[2] "==>" "prop"[1] => "\<^const>Pure.imp" (1) - prop' = "prop"[3] "&&&" "prop"[2] => "\<^const>Pure.conjunction" (2) - prop' = "prop"[2] "=simp=>" "prop"[1] => "\<^const>HOL.simp_implies" (1) - prop' = prop'[4] "::" type[0] => "_constrain" (3) - pttrn = "(" pttrn[0] "," Product_Type.patterns[0] ")" => "_pattern" (1000) - pttrn = idt[-1] (-1) - pttrns = pttrn[1] pttrns[0] => "_pttrns" (0) - pttrns = pttrn[-1] (-1) - sort = "{" classes[0] "}" => "_sort" (1000) - sort = "{}" => "_topsort" (1000) - sort = class_name[-1] (-1) - str_position = str_token => "_position" (1000) - string_position = string_token => "_position" (1000) - tid_position = tid => "_position_sort" (1000) - tvar_position = tvar => "_position_sort" (1000) - type = "_" => "\<^type>dummy" (1000) - type = "_" "::" sort[0] => "_dummy_ofsort" (1000) - type = "(" type[0] ")" (1000) - type = "(" type[0] "," types[0] ")" type_name[0] => "_tappl" (1000) - type = "[" types[0] "]" "\<Rightarrow>" type[0] => "_bracket" (0) - type = "[" types[0] "]" "=>" type[0] => "_bracket" (0) - type = tvar_position[1000] "::" sort[0] => "_ofsort" (1000) - type = tid_position[1000] "::" sort[0] => "_ofsort" (1000) - type = "\<lparr>" Record.field_types[0] "," "\<dots>" "::" type[0] "\<rparr>" => "_record_type_scheme" (1000) - type = "\<lparr>" Record.field_types[0] "\<rparr>" => "_record_type" (1000) - type = "(|" Record.field_types[0] "," "..." "::" type[0] "|)" => "_record_type_scheme" (1000) - type = "(|" Record.field_types[0] "|)" => "_record_type" (1000) - type = "\<langle>" type[0] "\<rangle>\<^sub>\<bottom>" => "\<^type>Option.option" (1000) - type = "Pair(" type[0] "," type[0] ")" => "\<^type>UML_Types.Pair\<^sub>b\<^sub>a\<^sub>s\<^sub>e" (1000) - type = "Set(" type[0] ")" => "\<^type>UML_Types.Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e" (1000) - type = "Bag(" type[0] ")" => "\<^type>UML_Types.Bag\<^sub>b\<^sub>a\<^sub>s\<^sub>e" (1000) - type = "Sequence(" type[0] ")" => "\<^type>UML_Types.Sequence\<^sub>b\<^sub>a\<^sub>s\<^sub>e" (1000) - type = type[1] "\<rightharpoonup>" type[0] => "\<^type>Map.map" (0) - type = type[11] "+" type[10] => "\<^type>Sum_Type.sum" (10) - type = type[21] "*" type[20] => "\<^type>Product_Type.prod" (20) - type = type[21] "\<times>" type[20] => "\<^type>Product_Type.prod" (20) - type = type[1] "=>" type[0] => "\<^type>fun" (0) - type = type[1000] type_name[0] => "_tapp" (1000) - type = type[1] "\<Rightarrow>" type[0] => "\<^type>fun" (0) - type = type_name[-1] (-1) - type = tvar_position[-1] (-1) - type = tid_position[-1] (-1) - type_name = longid => "_type_name" (1000) - type_name = id => "_type_name" (1000) - types = type[0] "," types[0] => "_types" (1000) - types = type[-1] (-1) - var_position = var => "_position" (1000) - -end