Merge branch 'afp_resubmission' of https://git.logicalhacking.com/Isabelle_DOF/Isabelle_DOF into afp_resubmission
This commit is contained in:
commit
7d6048bf64
|
@ -36,9 +36,12 @@ theory Isa_DOF (* Isabelle Document Ontology Framework *)
|
|||
|
||||
and "open_monitor*" "close_monitor*"
|
||||
"declare_reference*" "update_instance*"
|
||||
"doc_class" "onto_class" (* a syntactic alternative *)
|
||||
"ML*"
|
||||
"doc_class" "onto_class" (* a syntactic alternative *)
|
||||
"onto_morphism" :: thy_decl
|
||||
and "to"
|
||||
and "ML*"
|
||||
"define_shortcut*" "define_macro*" :: thy_decl
|
||||
|
||||
and "definition*" :: thy_defn
|
||||
and "theorem*" "lemma*" "corollary*" "proposition*" :: thy_goal_stmt
|
||||
and "schematic_goal*" :: thy_goal_stmt
|
||||
|
@ -3211,6 +3214,76 @@ val _ =
|
|||
|
||||
|
||||
|
||||
val clean_mixfix_sub = translate_string
|
||||
(fn "\<^sub>_" => "_"
|
||||
| "\<^sub>'" => "'"
|
||||
| c => c);
|
||||
|
||||
val prefix_sub = prefix "\<^sub>"
|
||||
|
||||
val convertN = "convert"
|
||||
|
||||
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 (clean_mixfix_sub
|
||||
#> String.explode
|
||||
#> map (prefix_sub o String.str)
|
||||
#> String.concat)
|
||||
val mixfix = oclasses_sub_string |> rev |> hd
|
||||
|> (oclasses_sub_string |> rev |> tl |> fold (fn x => fn y => x ^ "\<^sub>\<times>" ^ y))
|
||||
|> ISA_core.clean_mixfix
|
||||
val mixfix' = convertN ^ mixfix ^ "\<^sub>\<Rightarrow>"
|
||||
^ (dclass_string |> clean_mixfix_sub |> String.explode
|
||||
|> map (prefix_sub o String.str) |> String.concat)
|
||||
in SOME (Binding.name (convertN ^ 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". *)
|
||||
val _ =
|
||||
Outer_Syntax.command \<^command_keyword>\<open>onto_morphism\<close> "define ontology morpism"
|
||||
(parse_onto_morphism >> (Toplevel.theory o add_onto_morphism'));
|
||||
|
||||
|
||||
|
||||
end (* struct *)
|
||||
\<close>
|
||||
|
||||
|
|
|
@ -16,8 +16,6 @@ theory
|
|||
"M_05_Proofs_Ontologies"
|
||||
imports
|
||||
"M_04_Document_Ontology"
|
||||
keywords "onto_morphism" :: thy_decl
|
||||
and "to"
|
||||
begin
|
||||
|
||||
(*>*)
|
||||
|
@ -42,69 +40,6 @@ section*["morphisms"::scholarly_paper.text_section] \<open>Proving Properties ov
|
|||
|
||||
subsection\<open>Ontology-Morphisms: a Prototypical Example\<close>
|
||||
|
||||
(*<*) (* THIS CODE SHOULD GO INTO THE DOF KERNEL \<And>! *)
|
||||
|
||||
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>
|
||||
(*>*)
|
||||
|
||||
text\<open>We define a small ontology with the following classes:\<close>
|
||||
|
||||
doc_class AA = aa :: nat
|
||||
|
@ -126,21 +61,23 @@ resulting transformation of @{doc_class AA}-instances and @{doc_class BB}-instan
|
|||
but not injective. The \<^term>\<open>CC.tag_attribute\<close> is used to potentially differentiate instances with
|
||||
equal attribute-content and is irrelevant here.\<close>
|
||||
|
||||
text\<open>This specification construct introduces the following constants and definitions:
|
||||
\<^item> @{term [source] \<open>convert\<^sub>A\<^sub>A\<^sub>_\<^sub>B\<^sub>B\<^sub>_\<^sub>C\<^sub>C :: AA \<times> BB \<Rightarrow> CC\<close>}
|
||||
\<^item> @{term [source] \<open>convert\<^sub>D\<^sub>D\<^sub>_\<^sub>E\<^sub>E\<^sub>_\<^sub>F\<^sub>F :: DD \<times> EE \<Rightarrow> FF\<close>}
|
||||
\<^item> @{term [source] \<open>convert\<^sub>A\<^sub>A\<^sub>_\<^sub>B\<^sub>B\<^sub>_\<^sub>C\<^sub>C\<^sub>_\<^sub>D\<^sub>D\<^sub>_\<^sub>E\<^sub>E\<^sub>_\<^sub>F\<^sub>F :: AA \<times> BB \<times> CC \<times> DD \<times> EE \<Rightarrow> FF\<close>}
|
||||
|
||||
and corresponding definitions. \<close>
|
||||
|
||||
(*<*) (* Just a test, irrelevant for the document.*)
|
||||
|
||||
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,
|
||||
doc_class A_A = aa :: nat
|
||||
doc_class BB' = bb :: int
|
||||
onto_morphism (A_A, BB', CC, DD, EE) to FF
|
||||
where "convert\<^sub>A\<^sub>_\<^sub>A\<^sub>\<times>\<^sub>B\<^sub>B\<^sub>'\<^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 = int(aa (fst \<sigma>)) + bb (fst (snd \<sigma>))\<rparr>"
|
||||
|
||||
(*>*)
|
||||
|
||||
text\<open>This specification construct introduces the following constants and definitions:
|
||||
\<^item> @{term [source] \<open>convert\<^sub>A\<^sub>A\<^sub>_\<^sub>B\<^sub>B\<^sub>_\<^sub>C\<^sub>C :: AA \<times> BB \<Rightarrow> CC\<close>}
|
||||
\<^item> @{term [source] \<open>convert\<^sub>D\<^sub>D\<^sub>_\<^sub>E\<^sub>E\<^sub>_\<^sub>F\<^sub>F :: DD \<times> EE \<Rightarrow> FF\<close>}
|
||||
% @{term [source] \<open>convert\<^sub>A\<^sub>_\<^sub>A\<^sub>\<times>\<^sub>B\<^sub>B\<^sub>'\<^sub>\<times>\<^sub>C\<^sub>C\<^sub>\<times>\<^sub>D\<^sub>D\<^sub>\<times>\<^sub>E\<^sub>E\<^sub>\<Rightarrow>\<^sub>F\<^sub>F :: A_A \<times> BB' \<times> CC \<times> DD \<times> EE \<Rightarrow> FF\<close>}
|
||||
|
||||
and corresponding definitions. \<close>
|
||||
|
||||
subsection\<open>Proving the Preservation of Ontological Mappings : A Document-Ontology Morphism\<close>
|
||||
|
||||
text\<open>\<^dof> as a system is currently particularly geared towards \<^emph>\<open>document\<close>-ontologies, in
|
||||
|
@ -244,7 +181,6 @@ next
|
|||
using concatWith.elims apply blast
|
||||
using list.set_cases by force
|
||||
qed
|
||||
|
||||
|
||||
onto_morphism (acm) to elsevier
|
||||
where "convert\<^sub>a\<^sub>c\<^sub>m\<^sub>\<Rightarrow>\<^sub>e\<^sub>l\<^sub>s\<^sub>e\<^sub>v\<^sub>i\<^sub>e\<^sub>r \<sigma> =
|
||||
|
@ -384,7 +320,7 @@ text\<open>These two example ontologies were linked via conversion functions cal
|
|||
The hic is that we can prove for the morphisms connecting these ontologies, that the conversions
|
||||
are guaranteed to preserve the data-invariants, although the data-structures (and, of course,
|
||||
the presentation of them) is very different. Besides, morphisms functions can be ``forgetful''
|
||||
(\<^ie> surjective), ``embedding'' (\<^ie> injective) or even ``one-to-one'' ((\<^ie> bikjective).\<close>
|
||||
(\<^ie> surjective), ``embedding'' (\<^ie> injective) or even ``one-to-one'' ((\<^ie> bijective).\<close>
|
||||
|
||||
definition Item_to_Resource_morphism :: "Item \<Rightarrow> Resource"
|
||||
("_ \<langle>Resource\<rangle>\<^sub>I\<^sub>t\<^sub>e\<^sub>m" [1000]999)
|
||||
|
@ -483,7 +419,7 @@ Recall that the monitor of \<^term>\<open>scholarly_paper.article\<close> is def
|
|||
\<^vs>\<open>0.5cm\<close> However, it is possible to reason over the language of monitors and prove classical
|
||||
refinement notions such as trace-refinement on the monitor-level, so once-and-for-all for all
|
||||
instances of validated documents conforming to a particular ontology. The primitive recursive
|
||||
operators\<^term>\<open>RegExpInterface.Lang\<close> and \<^term>\<open>RegExpInterface.L\<^sub>s\<^sub>u\<^sub>b\<close> generate the languages of the
|
||||
operators \<^term>\<open>RegExpInterface.Lang\<close> and \<^term>\<open>RegExpInterface.L\<^sub>s\<^sub>u\<^sub>b\<close> generate the languages of the
|
||||
regular expression language, where \<^term>\<open>L\<^sub>s\<^sub>u\<^sub>b\<close> takes the sub-ordering relation of classes into
|
||||
account.
|
||||
|
||||
|
@ -510,7 +446,7 @@ of the above language refinement is quasi automatic. This proof is also part of
|
|||
|
||||
(*<*)
|
||||
|
||||
(* switch on regexp syntax *)
|
||||
(* switch off regexp syntax *)
|
||||
no_notation Star ("\<lbrace>(_)\<rbrace>\<^sup>*" [0]100)
|
||||
no_notation Plus (infixr "||" 55)
|
||||
no_notation Times (infixr "~~" 60)
|
||||
|
|
Loading…
Reference in New Issue