Update to isabelle 2023 and add morphism examples

This commit is contained in:
Nicolas Méric 2024-04-04 00:10:51 +02:00
parent 0bf21336f1
commit 7791538b54
9 changed files with 669 additions and 14 deletions

View File

@ -37,13 +37,14 @@ fun gen_enriched_document_command2 name {body} cid_transform attr_transform mark
xstring_opt:(xstring * Position.T) option),
toks_list:Input.source list)
: theory -> theory =
let val ((binding,cid_pos), doc_attrs) = meta_args
let val toplvl = Toplevel.make_state o SOME
val ((binding,cid_pos), doc_attrs) = meta_args
val oid = Binding.name_of binding
val oid' = if meta_args = ODL_Meta_Args_Parser.empty_meta_args
then "output"
else oid
(* as side-effect, generates markup *)
fun check_n_tex_text thy toks = let val ctxt = Toplevel.presentation_context (Toplevel.make_state (SOME thy))
fun check_n_tex_text thy toks = let val ctxt = Toplevel.presentation_context (toplvl thy)
val pos = Input.pos_of toks;
val _ = Context_Position.reports ctxt
[(pos, Markup.language_document (Input.is_delimited toks)),

View File

@ -22,8 +22,10 @@ session "Isabelle_DOF" (AFP) = "Functional-Automata" +
"thys/manual/M_01_Introduction"
"thys/manual/M_02_Background"
"thys/manual/M_03_GuidedTour"
"thys/manual/M_04_RefMan"
"thys/manual/M_05_Implementation"
"thys/manual/M_04_Document_Ontology"
"thys/manual/M_05_Proofs_Ontologies"
"thys/manual/M_06_RefMan"
"thys/manual/M_07_Implementation"
"thys/manual/Isabelle_DOF_Manual"
document_files
"root.bib"

View File

@ -2,6 +2,8 @@
\input{M_01_Introduction.tex}
\input{M_02_Background.tex}
\input{M_03_GuidedTour.tex}
\input{M_04_RefMan.tex}
\input{M_05_Implementation.tex}
\input{M_04_Document_Ontology.tex}
\input{M_05_Proofs_Ontologies.tex}
\input{M_06_RefMan.tex}
\input{M_07_Implementation.tex}
\input{Isabelle_DOF_Manual.tex}

View File

@ -2359,6 +2359,7 @@ fun onto_macro_cmd_command (name, pos) descr cmd output_cmd =
))))
(* Core Command Definitions *)
val _ =
@ -2691,7 +2692,9 @@ fun gen_theorem schematic bundle_includes prep_att prep_stmt
|> prep_statement (prep_att lthy) prep_stmt elems raw_concl;
val atts = more_atts @ map (prep_att lthy) raw_atts;
val print_cfg = {interactive = int, pos = Position.thread_data (), proof_state= false}
val pos = Position.thread_data ();
val print_results =
Proof_Display.print_results {interactive = int, pos = pos, proof_state = false};
fun after_qed' results goal_ctxt' =
let
@ -2703,13 +2706,13 @@ fun gen_theorem schematic bundle_includes prep_att prep_stmt
Local_Theory.notes_kind kind
(map2 (fn (b, _) => fn ths => (b, [(ths, [])])) stmt results') lthy;
val lthy'' =
if Binding.is_empty_atts (name, atts) then
(Proof_Display.print_results print_cfg lthy' ((kind, ""), res); lthy')
if Binding.is_empty_atts (name, atts)
then (print_results lthy' ((kind, ""), res); lthy')
else
let
val ([(res_name, _)], lthy'') =
Local_Theory.notes_kind kind [((name, atts), [(maps #2 res, [])])] lthy';
val _ = Proof_Display.print_results print_cfg lthy' ((kind, res_name), res);
val _ = print_results lthy' ((kind, res_name), res);
in lthy'' end;
in after_qed results' lthy'' end;

View File

@ -13,7 +13,7 @@
(*<*)
theory "Isabelle_DOF_Manual"
imports "M_05_Implementation"
imports "M_07_Implementation"
begin
close_monitor*[this]
check_doc_global

View File

@ -0,0 +1,230 @@
(*************************************************************************
* Copyright (C)
* 2019-2022 University of Exeter
* 2018-2022 University of Paris-Saclay
* 2018 The University of Sheffield
*
* License:
* This program can be redistributed and/or modified under the terms
* of the 2-clause BSD-style license.
*
* SPDX-License-Identifier: BSD-2-Clause
*************************************************************************)
(*<*)
theory
"M_04_Document_Ontology"
imports
"M_03_GuidedTour"
keywords "class_synonym" :: thy_defn
begin
(*>*)
(*<*)
definition combinator1 :: "'a \<Rightarrow> ('a \<Rightarrow> 'b) \<Rightarrow> 'b" (infixl "|>" 65)
where "x |> f = f x"
ML\<open>
local
val _ =
Outer_Syntax.local_theory \<^command_keyword>\<open>class_synonym\<close> "declare type abbreviation"
(Parse.type_args -- Parse.binding --
(\<^keyword>\<open>=\<close> |-- Parse.!!! (Parse.typ -- Parse.opt_mixfix'))
>> (fn ((args, a), (rhs, mx)) => snd o Typedecl.abbrev_cmd (a, args, mx) rhs));
in end
\<close>
(*>*)
(*<*)
doc_class "title" = short_title :: "string option" <= "None"
(*doc_class '\<alpha> affiliation =
journal_style :: '\<alpha>
*)
doc_class elsevier =
organization :: string
address_line :: string
postcode :: int
city :: string
(*doc_class elsevier_affiliation = affiliation +*)
doc_class acm =
position :: string
institution :: string
department :: int
street_address :: string
city :: string
state :: int
country :: string
postcode :: int
(*doc_class acm_affiliation = affiliation +*)
doc_class lncs =
institution :: string
(*doc_class lncs_affiliation = affiliation +*)
doc_class author =
name :: string
email :: "string" <= "''''"
invariant ne_name :: "name \<sigma> \<noteq> ''''"
doc_class elsevier_author = "author" +
affiliations :: "elsevier list"
short_author :: string
url :: string
footnote :: string
text*[el1:: "elsevier"]\<open>\<close>
(*text*[el_aff1:: "affiliation", journal_style = "@{elsevier \<open>el1\<close>}"]\<open>\<close>*)
term*\<open>@{elsevier \<open>el1\<close>}\<close>
text*[el_auth1:: "elsevier_author", affiliations = "[@{elsevier \<open>el1\<close>}]"]\<open>\<close>
doc_class acm_author = "author" +
affiliations :: "acm list"
orcid :: int
footnote :: string
text*[acm1:: "acm"]\<open>\<close>
(*text*[acm_aff1:: "acm affiliation", journal_style = "@{acm \<open>acm1\<close>}"]\<open>\<close>*)
text*[acm_auth1:: "acm_author", affiliations = "[@{acm \<open>acm1\<close>}]"]\<open>\<close>
doc_class lncs_author = "author" +
affiliations :: "lncs list"
orcid :: int
short_author :: string
footnote :: string
text*[lncs1:: "lncs"]\<open>\<close>
(*text*[lncs_aff1:: "lncs affiliation", journal_style = "@{lncs \<open>lncs1\<close>}"]\<open>\<close>*)
text*[lncs_auth1:: "lncs_author", affiliations = "[@{lncs \<open>lncs1\<close>}]"]\<open>\<close>
doc_class "text_element" =
authored_by :: "author set" <= "{}"
level :: "int option" <= "None"
invariant authors_req :: "authored_by \<sigma> \<noteq> {}"
and level_req :: "the (level \<sigma>) > 1"
doc_class "introduction" = "text_element" +
authored_by :: "(author) set" <= "UNIV"
doc_class "technical" = "text_element" +
formal_results :: "thm list"
doc_class "definition" = "technical" +
is_formal :: "bool"
doc_class "theorem" = "technical" +
is_formal :: "bool"
assumptions :: "term list" <= "[]"
statement :: "term option" <= "None"
doc_class "conclusion" = "text_element" +
resumee :: "(definition set \<times> theorem set)"
invariant is_form :: "(\<exists>x\<in>(fst (resumee \<sigma>)). definition.is_formal x) \<longrightarrow>
(\<exists>y\<in>(snd (resumee \<sigma>)). is_formal y)"
text*[def::"definition", is_formal = "True"]\<open>\<close>
text*[theo::"theorem", is_formal = "False"]\<open>\<close>
text*[conc::"conclusion", resumee="({@{definition \<open>def\<close>}}, {@{theorem \<open>theo\<close>}})"]\<open>\<close>
value*\<open>resumee @{conclusion \<open>conc\<close>} |> fst\<close>
value*\<open>resumee @{conclusion \<open>conc\<close>} |> snd\<close>
doc_class "article" =
style_id :: string <= "''LNCS''"
accepts "(title ~~ \<lbrace>author\<rbrace>\<^sup>+ ~~ \<lbrace>introduction\<rbrace>\<^sup>+
~~ \<lbrace>\<lbrace>definition ~~ example\<rbrace>\<^sup>+ || theorem\<rbrace>\<^sup>+ ~~ \<lbrace>conclusion\<rbrace>\<^sup>+)"
datatype kind = expert_opinion | argument | "proof"
onto_class result = " technical" +
evidence :: kind
property :: " theorem list" <= "[]"
invariant has_property :: "evidence \<sigma> = proof \<longleftrightarrow> property \<sigma> \<noteq> []"
(*>*)
text*[paper_m::float, main_caption="\<open>A Basic Document Ontology: paper$^m$\<close>"]\<open>
@{boxed_theory_text [display,indent=5]
\<open>doc_class "title" = short_title :: "string option" <= "None"
doc_class affiliation =
journal_style :: '\<alpha>
doc_class author =
affiliations :: "'\<alpha> affiliation list"
name :: string
email :: "string" <= "''''"
invariant ne_name :: "name \<sigma> \<noteq> ''''"
doc_class "text_element" =
authored_by :: "('\<alpha> author) set" <= "{}"
level :: "int option" <= "None"
invariant authors_req :: "authored_by \<noteq> {}"
and level_req :: "the (level) > 1"
doc_class "introduction" = text_element +
authored_by :: "('\<alpha> author) set" <= "UNIV"
doc_class "technical" = text_element +
formal_results :: "thm list"
doc_class "definition" = technical +
is_formal :: "bool"
doc_class "theorem" = technical +
assumptions :: "term list" <= "[]"
statement :: "term option" <= "None"
doc_class "conclusion" = text_element +
resumee :: "(definition set \<times> theorem set)"
invariant (\<forall>x\<in>fst resumee. is_formal x)
\<longrightarrow> (\<exists>y\<in>snd resumee. is_formal y)
doc_class "article" =
style_id :: string <= "''LNCS''"
accepts "(title ~~ \<lbrace>author\<rbrace>\<^sup>+ ~~ \<lbrace>introduction\<rbrace>\<^sup>+
~~ \<lbrace>\<lbrace>definition ~~ example\<rbrace>\<^sup>+ || theorem\<rbrace>\<^sup>+ ~~ \<lbrace>conclusion\<rbrace>\<^sup>+)"\<close>}
\<close>
(*<*)
datatype role = PM \<comment> \<open>Program Manager\<close>
| RQM \<comment> \<open>Requirements Manager\<close>
| DES \<comment> \<open>Designer\<close>
| IMP \<comment> \<open>Implementer\<close>
| ASR \<comment> \<open>Assessor\<close>
| INT \<comment> \<open>Integrator\<close>
| TST \<comment> \<open>Tester\<close>
| VER \<comment> \<open>Verifier\<close>
| VnV \<comment> \<open>Verification and Validation\<close>
| VAL \<comment> \<open>Validator\<close>
abbreviation developer where "developer == DES"
abbreviation validator where "validator == VAL"
abbreviation verifier where "verifier == VER"
doc_class requirement = Isa_COL.text_element +
long_name :: "string option"
is_concerned :: "role set"
text*[req1::requirement,
is_concerned="{developer, validator}"]
\<open>The operating system shall provide secure
memory separation.\<close>
text\<open>
The recurring issue of the certification
is @{requirement \<open>req1\<close>} ...\<close>
term "\<lparr>long_name = None,is_concerned = {developer,validator}\<rparr>"
(*>*)
(*<*)
end
(*>*)

View File

@ -0,0 +1,417 @@
(*************************************************************************
* Copyright (C)
* 2019-2022 University of Exeter
* 2018-2022 University of Paris-Saclay
* 2018 The University of Sheffield
*
* License:
* This program can be redistributed and/or modified under the terms
* of the 2-clause BSD-style license.
*
* SPDX-License-Identifier: BSD-2-Clause
*************************************************************************)
(*<*)
theory
"M_05_Proofs_Ontologies"
imports
"M_04_Document_Ontology"
keywords "onto_morphism" :: thy_decl
and "to"
begin
(*>*)
section*["morphisms"::scholarly_paper.text_section] \<open>Proving Morphisms on Ontologies\<close>
(* rethink examples: should we "morph" previdence too ? ? ? *)
(*<*)
(* Mapped_PILIB_Ontology example *)
term\<open>fold (+) S 0\<close>
definition sum
where "sum S = (fold (+) S 0)"
datatype Hardware_Type =
Motherboard |
Expansion_Card |
Storage_Device |
Fixed_Media |
Removable_Media |
Input_Device |
Output_Device
datatype Software_Type =
Operating_system |
Text_editor |
Web_Navigator |
Development_Environment
(* Reference Ontology *)
onto_class Resource =
name :: string
onto_class Electronic = Resource +
provider :: string
manufacturer :: string
onto_class Component = Electronic +
mass :: int
onto_class Simulation_Model = Electronic +
simulate :: Component
composed_of :: "Component list"
version :: int
onto_class Informatic = Resource +
description :: string
onto_class Hardware = Informatic +
type :: Hardware_Type
mass :: int
composed_of :: "Component list"
invariant c1 :: "mass \<sigma> = sum(map Component.mass (composed_of \<sigma>))"
onto_class Software = Informatic +
type :: Software_Type
version :: int
(* Local Ontology *)
onto_class Item =
name :: string
onto_class Product = Item +
serial_number :: int
provider :: string
mass :: int
onto_class Electronic_Component = Product +
serial_number :: int
onto_class Monitor = Product +
composed_of :: "Electronic_Component list"
invariant c2 :: "Product.mass \<sigma> = sum(map Product.mass (composed_of \<sigma>))"
term\<open>Product.mass \<sigma> = sum(map Product.mass (composed_of \<sigma>))\<close>
onto_class Computer_Software = Item +
type :: Software_Type
version :: int
(* Mapping or Morphism *)
definition Item_to_Resource_morphism :: "Item \<Rightarrow> Resource"
("_ \<langle>Resource\<rangle>\<^sub>I\<^sub>t\<^sub>e\<^sub>m" [1000]999)
where " \<sigma> \<langle>Resource\<rangle>\<^sub>I\<^sub>t\<^sub>e\<^sub>m =
\<lparr> Resource.tag_attribute = 1::int ,
Resource.name = name \<sigma> \<rparr>"
definition Product_to_Resource_morphism :: "Product \<Rightarrow> Resource"
("_ \<langle>Resource\<rangle>\<^sub>P\<^sub>r\<^sub>o\<^sub>d\<^sub>u\<^sub>c\<^sub>t" [1000]999)
where " \<sigma> \<langle>Resource\<rangle>\<^sub>P\<^sub>r\<^sub>o\<^sub>d\<^sub>u\<^sub>c\<^sub>t =
\<lparr> Resource.tag_attribute = 2::int ,
Resource.name = name \<sigma> \<rparr>"
definition Computer_Software_to_Software_morphism :: "Computer_Software \<Rightarrow> Software"
("_ \<langle>Software\<rangle>\<^sub>S\<^sub>o\<^sub>f\<^sub>t\<^sub>C\<^sub>m\<^sub>p" [1000]999)
where "\<sigma> \<langle>Software\<rangle>\<^sub>S\<^sub>o\<^sub>f\<^sub>t\<^sub>C\<^sub>m\<^sub>p =
\<lparr> Resource.tag_attribute = 3::int ,
Resource.name = name \<sigma> ,
Informatic.description = ''no description'',
Software.type = type \<sigma> ,
Software.version = version \<sigma> \<rparr>"
definition Electronic_Component_to_Component_morphism :: "Electronic_Component \<Rightarrow> Component"
("_ \<langle>Component\<rangle>\<^sub>E\<^sub>l\<^sub>e\<^sub>c\<^sub>C\<^sub>m\<^sub>p" [1000]999)
where "\<sigma> \<langle>Component\<rangle>\<^sub>E\<^sub>l\<^sub>e\<^sub>c\<^sub>C\<^sub>m\<^sub>p =
\<lparr> Resource.tag_attribute = 4::int ,
Resource.name = name \<sigma> ,
Electronic.provider = provider \<sigma> ,
Electronic.manufacturer = ''no manufacturer'' ,
Component.mass = mass \<sigma> \<rparr>"
definition Monitor_to_Hardware_morphism :: "Monitor \<Rightarrow> Hardware"
("_ \<langle>Hardware\<rangle>\<^sub>C\<^sub>o\<^sub>m\<^sub>p\<^sub>u\<^sub>t\<^sub>e\<^sub>r\<^sub>H\<^sub>a\<^sub>r\<^sub>d\<^sub>w\<^sub>a\<^sub>r\<^sub>e" [1000]999)
where "\<sigma> \<langle>Hardware\<rangle>\<^sub>C\<^sub>o\<^sub>m\<^sub>p\<^sub>u\<^sub>t\<^sub>e\<^sub>r\<^sub>H\<^sub>a\<^sub>r\<^sub>d\<^sub>w\<^sub>a\<^sub>r\<^sub>e =
\<lparr> Resource.tag_attribute = 5::int ,
Resource.name = name \<sigma> ,
Informatic.description = ''no description'',
Hardware.type = Output_Device,
Hardware.mass = mass \<sigma> ,
Hardware.composed_of = map Electronic_Component_to_Component_morphism (composed_of \<sigma>)
\<rparr>"
lemma inv_c2_preserved :
"c2_inv \<sigma> \<Longrightarrow> c1_inv (\<sigma> \<langle>Hardware\<rangle>\<^sub>C\<^sub>o\<^sub>m\<^sub>p\<^sub>u\<^sub>t\<^sub>e\<^sub>r\<^sub>H\<^sub>a\<^sub>r\<^sub>d\<^sub>w\<^sub>a\<^sub>r\<^sub>e)"
unfolding c1_inv_def c2_inv_def
Monitor_to_Hardware_morphism_def Electronic_Component_to_Component_morphism_def
by (auto simp: comp_def)
lemma Monitor_to_Hardware_morphism_total :
"Monitor_to_Hardware_morphism ` ({X::Monitor. c2_inv X}) \<subseteq> ({X::Hardware. c1_inv X})"
using inv_c2_preserved
by auto
type_synonym local_ontology = "Item * Electronic_Component * Monitor"
type_synonym reference_ontology = "Resource * Component * Hardware"
fun ontology_mapping :: "local_ontology \<Rightarrow> reference_ontology" where
"ontology_mapping (x, y, z) = (x \<langle>Resource\<rangle>\<^sub>I\<^sub>t\<^sub>e\<^sub>m , y \<langle>Component\<rangle>\<^sub>E\<^sub>l\<^sub>e\<^sub>c\<^sub>C\<^sub>m\<^sub>p, z \<langle>Hardware\<rangle>\<^sub>C\<^sub>o\<^sub>m\<^sub>p\<^sub>u\<^sub>t\<^sub>e\<^sub>r\<^sub>H\<^sub>a\<^sub>r\<^sub>d\<^sub>w\<^sub>a\<^sub>r\<^sub>e)"
lemma ontology_mapping_total :
"ontology_mapping ` {X. c2_inv (snd (snd X))}
\<subseteq> {X. c1_inv (snd (snd X))}"
using inv_c2_preserved
by auto
doc_class "title" = short_title :: "string option" <= "None"
(*doc_class '\<alpha> affiliation =
journal_style :: '\<alpha>
*)
doc_class elsevier =
organization :: string
address_line :: string
postcode :: int
city :: string
(*doc_class elsevier_affiliation = affiliation +*)
doc_class acm =
position :: string
institution :: string
department :: int
street_address :: string
city :: string
state :: int
country :: string
postcode :: int
(*doc_class acm_affiliation = affiliation +*)
doc_class lncs =
institution :: string
(*doc_class lncs_affiliation = affiliation +*)
doc_class author =
firstname :: string
surname :: string
email :: "string" <= "''''"
invariant ne_fsnames :: "firstname \<sigma> \<noteq> '''' \<and> surname \<sigma> \<noteq> ''''"
doc_class elsevier_author = "author" +
affiliations :: "elsevier list"
short_author :: string
url :: string
footnote :: string
text*[el1:: "elsevier"]\<open>\<close>
(*text*[el_aff1:: "affiliation", journal_style = "@{elsevier \<open>el1\<close>}"]\<open>\<close>*)
term*\<open>@{elsevier \<open>el1\<close>}\<close>
text*[el_auth1:: "elsevier_author", affiliations = "[@{elsevier \<open>el1\<close>}]"]\<open>\<close>
doc_class acm_author = "author" +
affiliations :: "acm list"
orcid :: int
footnote :: string
text*[acm1:: "acm"]\<open>\<close>
(*text*[acm_aff1:: "acm affiliation", journal_style = "@{acm \<open>acm1\<close>}"]\<open>\<close>*)
text*[acm_auth1:: "acm_author", affiliations = "[@{acm \<open>acm1\<close>}]"]\<open>\<close>
doc_class lncs_author = "author" +
affiliations :: "lncs list"
orcid :: int
short_author :: string
footnote :: string
text*[lncs1:: "lncs"]\<open>\<close>
(*text*[lncs_aff1:: "lncs affiliation", journal_style = "@{lncs \<open>lncs1\<close>}"]\<open>\<close>*)
text*[lncs_auth1:: "lncs_author", affiliations = "[@{lncs \<open>lncs1\<close>}]"]\<open>\<close>
doc_class "text_element" =
authored_by :: "author set" <= "{}"
level :: "int option" <= "None"
invariant authors_req :: "authored_by \<sigma> \<noteq> {}"
and level_req :: "the (level \<sigma>) > 1"
doc_class "introduction" = "text_element" +
authored_by :: "(author) set" <= "UNIV"
doc_class "technical" = "text_element" +
formal_results :: "thm list"
doc_class "definition" = "technical" +
is_formal :: "bool"
doc_class "theorem" = "technical" +
is_formal :: "bool"
assumptions :: "term list" <= "[]"
statement :: "term option" <= "None"
doc_class "conclusion" = "text_element" +
resumee :: "(definition set \<times> theorem set)"
invariant is_form :: "(\<exists>x\<in>(fst (resumee \<sigma>)). definition.is_formal x) \<longrightarrow>
(\<exists>y\<in>(snd (resumee \<sigma>)). is_formal y)"
text*[def::"definition", is_formal = "True"]\<open>\<close>
text*[theo::"theorem", is_formal = "False"]\<open>\<close>
text*[conc::"conclusion", resumee="({@{definition \<open>def\<close>}}, {@{theorem \<open>theo\<close>}})"]\<open>\<close>
value*\<open>resumee @{conclusion \<open>conc\<close>} |> fst\<close>
value*\<open>resumee @{conclusion \<open>conc\<close>} |> snd\<close>
doc_class "article" =
style_id :: string <= "''LNCS''"
accepts "(title ~~ \<lbrace>author\<rbrace>\<^sup>+ ~~ \<lbrace>introduction\<rbrace>\<^sup>+
~~ \<lbrace>\<lbrace>definition ~~ example\<rbrace>\<^sup>+ || theorem\<rbrace>\<^sup>+ ~~ \<lbrace>conclusion\<rbrace>\<^sup>+)"
definition elsevier_to_acm_morphism :: "elsevier \<Rightarrow> M_04_Document_Ontology.acm"
("_ \<langle>acm\<rangle>\<^sub>e\<^sub>l\<^sub>s\<^sub>e\<^sub>v\<^sub>i\<^sub>e\<^sub>r" [1000]999)
where "\<sigma> \<langle>acm\<rangle>\<^sub>e\<^sub>l\<^sub>s\<^sub>e\<^sub>v\<^sub>i\<^sub>e\<^sub>r =
\<lparr> M_04_Document_Ontology.acm.tag_attribute = 1::int,
M_04_Document_Ontology.acm.position = ''no position'',
M_04_Document_Ontology.acm.institution = organization \<sigma>,
M_04_Document_Ontology.acm.department = 0,
M_04_Document_Ontology.acm.street_address = address_line \<sigma>,
M_04_Document_Ontology.acm.city = elsevier.city \<sigma>,
M_04_Document_Ontology.acm.state = 0,
M_04_Document_Ontology.acm.country = ''no country'',
M_04_Document_Ontology.acm.postcode = elsevier.postcode \<sigma> \<rparr>"
(*definition elsevier_aff_to_acm_aff_morphism :: "elsevier affiliation \<Rightarrow> Introduction.acm Introduction.affiliation"
("_ \<langle>acm'_aff\<rangle>\<^sub>e\<^sub>l\<^sub>s\<^sub>e\<^sub>v\<^sub>i\<^sub>e\<^sub>r'_\<^sub>a\<^sub>f\<^sub>f" [1000]999)
where "\<sigma> \<langle>acm_aff\<rangle>\<^sub>e\<^sub>l\<^sub>s\<^sub>e\<^sub>v\<^sub>i\<^sub>e\<^sub>r_\<^sub>a\<^sub>f\<^sub>f =
\<lparr> Introduction.affiliation.tag_attribute = 1::int,
Introduction.affiliation.journal_style = (affiliation.journal_style \<sigma>)
|> (\<lambda>x. x \<langle>acm\<rangle>\<^sub>e\<^sub>l\<^sub>s\<^sub>e\<^sub>v\<^sub>i\<^sub>e\<^sub>r) \<rparr>"*)
definition acm_name where "acm_name f s = f @ '' '' @ s"
definition elsevier_author_to_acm_author_morphism :: "elsevier_author \<Rightarrow> M_04_Document_Ontology.acm_author"
("_ \<langle>acm'_auth\<rangle>\<^sub>e\<^sub>l\<^sub>s\<^sub>e\<^sub>v\<^sub>i\<^sub>e\<^sub>r'_\<^sub>a\<^sub>u\<^sub>t\<^sub>h" [1000]999)
where "\<sigma> \<langle>acm_auth\<rangle>\<^sub>e\<^sub>l\<^sub>s\<^sub>e\<^sub>v\<^sub>i\<^sub>e\<^sub>r_\<^sub>a\<^sub>u\<^sub>t\<^sub>h =
\<lparr> M_04_Document_Ontology.author.tag_attribute = 1::int,
M_04_Document_Ontology.author.name = acm_name (firstname \<sigma>) (surname \<sigma>),
M_04_Document_Ontology.author.email = author.email \<sigma>,
M_04_Document_Ontology.acm_author.affiliations = (elsevier_author.affiliations \<sigma>)
|> map (\<lambda>x. x \<langle>acm\<rangle>\<^sub>e\<^sub>l\<^sub>s\<^sub>e\<^sub>v\<^sub>i\<^sub>e\<^sub>r) ,
M_04_Document_Ontology.acm_author.orcid = 0,
M_04_Document_Ontology.acm_author.footnote = elsevier_author.footnote \<sigma> \<rparr>"
lemma elsevier_inv_preserved :
"ne_fsnames_inv \<sigma> \<Longrightarrow> M_04_Document_Ontology.ne_name_inv (\<sigma> \<langle>acm_auth\<rangle>\<^sub>e\<^sub>l\<^sub>s\<^sub>e\<^sub>v\<^sub>i\<^sub>e\<^sub>r_\<^sub>a\<^sub>u\<^sub>t\<^sub>h)"
unfolding ne_fsnames_inv_def M_04_Document_Ontology.ne_name_inv_def
elsevier_author_to_acm_author_morphism_def
by (simp add: combinator1_def acm_name_def)
lemma elsevier_author_to_acm_author_morphism_total :
"elsevier_author_to_acm_author_morphism ` ({X::elsevier_author. ne_fsnames_inv X}) \<subseteq> ({X::M_04_Document_Ontology.acm_author. M_04_Document_Ontology.ne_name_inv X})"
using elsevier_inv_preserved
by auto
ML\<open>
fun add_onto_morphism classes_mappings eqs thy =
if (length classes_mappings = length eqs) then
let
val specs = map (fn x => (Binding.empty_atts, x)) eqs
val converts =
map (fn (oclasses, dclass) =>
let
val oclasses_string = map YXML.content_of oclasses
val dclass_string = YXML.content_of dclass
val const_sub_name = dclass_string
|> (oclasses_string |> fold_rev (fn x => fn y => x ^ "_" ^ y))
|> String.explode |> map (fn x => "\<^sub>" ^ (String.str x)) |> String.concat
val convert_typ = oclasses_string |> rev |> hd
|> (oclasses_string |> rev |> tl |> fold (fn x => fn y => x ^ " \<times> " ^ y))
val convert_typ' = convert_typ ^ " \<Rightarrow> " ^ dclass_string
val oclasses_sub_string = oclasses_string
|> map (fn x => x |> String.explode |> map (fn y => "\<^sub>" ^ (String.str y)) |> String.concat)
val mixfix = oclasses_sub_string |> rev |> hd
|> (oclasses_sub_string |> rev |> tl |> fold (fn x => fn y => x ^ "\<^sub>\<times>" ^ y))
val mixfix' = "convert" ^ mixfix ^ "\<^sub>\<Rightarrow>"
^ (dclass_string |> String.explode
|> map (fn x => "\<^sub>" ^ (String.str x)) |> String.concat)
in SOME (Binding.name ("convert" ^ const_sub_name), SOME convert_typ', Mixfix.mixfix mixfix') end)
classes_mappings
val args = map (fn (x, y) => (x, y, [], [])) (converts ~~ specs)
val lthy = Named_Target.theory_init thy
val updated_lthy = fold (fn (decl, spec, prems, params) => fn lthy =>
let
val (_, lthy') = Specification.definition_cmd decl params prems spec true lthy
in lthy' end) args lthy
in Local_Theory.exit_global updated_lthy end
(* alternative way to update the theory using the Theory.join_theory function *)
(*val lthys = map (fn (decl, spec, prems, params) =>
let
val (_, lthy') = Specification.definition_cmd decl params prems spec true lthy
in lthy' end) args
val thys = map (Local_Theory.exit_global) lthys
in Theory.join_theory thys end*)
else error("The number of morphisms declarations does not match the number of definitions")
fun add_onto_morphism' (classes_mappings, eqs) = add_onto_morphism classes_mappings eqs
val parse_onto_morphism = Parse.and_list
((Parse.$$$ "(" |-- Parse.enum1 "," Parse.typ --| Parse.$$$ ")" --| \<^keyword>\<open>to\<close>)
-- Parse.typ)
-- (\<^keyword>\<open>where\<close> |-- Parse.and_list Parse.prop)
(* The name of the definitions must follow this rule:
for the declaration "onto_morphism (AA, BB) to CC",
the name of the constant must be "convert\<^sub>A\<^sub>A\<^sub>\<times>\<^sub>B\<^sub>B\<^sub>\<Rightarrow>\<^sub>C\<^sub>C".
See the examples below.
*)
val _ =
Outer_Syntax.command \<^command_keyword>\<open>onto_morphism\<close> "define ontology morpism"
(parse_onto_morphism >> (Toplevel.theory o add_onto_morphism'));
\<close>
find_consts name:"convert"
doc_class AA =
aa :: int
doc_class BB =
bb :: int
doc_class CC =
cc :: int
doc_class DD =
dd :: int
doc_class EE =
ee :: int
doc_class FF =
ff :: int
onto_morphism (AA, BB) to CC
and (DD, EE) to FF
where "convert\<^sub>A\<^sub>A\<^sub>\<times>\<^sub>B\<^sub>B\<^sub>\<Rightarrow>\<^sub>C\<^sub>C \<sigma> = \<lparr> CC.tag_attribute = 1::int, CC.cc = aa (fst \<sigma>) + bb (snd \<sigma>)\<rparr>"
and "convert\<^sub>D\<^sub>D\<^sub>\<times>\<^sub>E\<^sub>E\<^sub>\<Rightarrow>\<^sub>F\<^sub>F \<sigma> = \<lparr> FF.tag_attribute = 1::int, FF.ff = dd (fst \<sigma>) + ee (snd \<sigma>) \<rparr>"
onto_morphism (AA, BB, CC, DD, EE) to FF
where "convert\<^sub>A\<^sub>A\<^sub>\<times>\<^sub>B\<^sub>B\<^sub>\<times>\<^sub>C\<^sub>C\<^sub>\<times>\<^sub>D\<^sub>D\<^sub>\<times>\<^sub>E\<^sub>E\<^sub>\<Rightarrow>\<^sub>F\<^sub>F \<sigma> = \<lparr> FF.tag_attribute = 1::int, FF.ff = aa (fst \<sigma>) + bb (fst (snd \<sigma>))\<rparr>"
find_consts name:"convert"
find_theorems name:"convert"
(*>*)
chapter*[onto_proofs::technical]\<open>Proofs on Ontologies\<close>
(*<*)
end
(*>*)

View File

@ -12,9 +12,9 @@
*************************************************************************)
(*<*)
theory "M_05_Implementation"
imports "M_04_RefMan"
begin
theory "M_07_Implementation"
imports "M_06_RefMan"
begin
(*>*)