upgrade to Isabelle2017 and afp-2017
git-svn-id: https://projects.brucker.ch/hol-testgen/svn/HOL-TestGen/trunk/hol-testgen@13265 3260e6d1-4efc-4170-b0a7-36055960796d
This commit is contained in:
parent
50c90536d4
commit
208bb30780
|
@ -54,7 +54,7 @@ Isabelle (version 3.6) mentions:
|
||||||
of their own. No starting spaces, nothing after it."
|
of their own. No starting spaces, nothing after it."
|
||||||
In particular, it is not advised to put these tags in a single line:
|
In particular, it is not advised to put these tags in a single line:
|
||||||
\isatagafp ... \endisatagafp % wrong
|
\isatagafp ... \endisatagafp % wrong
|
||||||
otherwise as side effects some parts occuring after these tags may be
|
otherwise as side effects some parts occurring after these tags may be
|
||||||
skipped. The recommanded solution is to always write each tag in a
|
skipped. The recommanded solution is to always write each tag in a
|
||||||
separate line:
|
separate line:
|
||||||
\isatagafp
|
\isatagafp
|
||||||
|
@ -78,6 +78,7 @@ are close to not debug-able.
|
||||||
|
|
||||||
List of Isabelle versions to use depending on revisions:
|
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)
|
2018/01/29 revision 13259: Isabelle2016-1 (December 2016)
|
||||||
2016/02/22 revision 12439: Isabelle2016 (February 2016)
|
2016/02/22 revision 12439: Isabelle2016 (February 2016)
|
||||||
2015/06/11 revision 11691: Isabelle2015 (May 2015)
|
2015/06/11 revision 11691: Isabelle2015 (May 2015)
|
||||||
|
|
6
ROOT
6
ROOT
|
@ -101,7 +101,7 @@ session "OCL" in "src" = HOL +
|
||||||
|
|
||||||
(******************************************************)
|
(******************************************************)
|
||||||
|
|
||||||
session "OCL-all-dirty" in "src" = HOL +
|
session "OCL-all-dirty" in "src" = "HOL-Library" +
|
||||||
description {* Featherweight OCL (Long and Dirty) *}
|
description {* Featherweight OCL (Long and Dirty) *}
|
||||||
options [quick_and_dirty,document=pdf,document_output=document_generated,
|
options [quick_and_dirty,document=pdf,document_output=document_generated,
|
||||||
document_variants="document=afp,-annexa,-noexample",
|
document_variants="document=afp,-annexa,-noexample",
|
||||||
|
@ -164,7 +164,7 @@ session "OCL-all-dirty" in "src" = HOL +
|
||||||
|
|
||||||
(******************************************************)
|
(******************************************************)
|
||||||
|
|
||||||
session "FOCL" in "src" = HOL +
|
session "FOCL" in "src" = "HOL-Library" +
|
||||||
description {* Featherweight OCL (Compiler) *}
|
description {* Featherweight OCL (Compiler) *}
|
||||||
options [document=pdf,document_output=document_generated,
|
options [document=pdf,document_output=document_generated,
|
||||||
document_variants="document=noexample,-afp,-annexa",
|
document_variants="document=noexample,-afp,-annexa",
|
||||||
|
@ -189,7 +189,7 @@ session "FOCL" in "src" = HOL +
|
||||||
"root.tex"
|
"root.tex"
|
||||||
"FOCL_Syntax.tex"
|
"FOCL_Syntax.tex"
|
||||||
|
|
||||||
session "FOCL-dirty" in "src" = HOL +
|
session "FOCL-dirty" in "src" = "HOL-Library" +
|
||||||
description {* Featherweight OCL (Compiler) *}
|
description {* Featherweight OCL (Compiler) *}
|
||||||
options [quick_and_dirty,document=pdf,document_output=document_generated,
|
options [quick_and_dirty,document=pdf,document_output=document_generated,
|
||||||
document_variants="document=noexample,-afp,-annexa",
|
document_variants="document=noexample,-afp,-annexa",
|
||||||
|
|
|
@ -637,7 +637,7 @@ by(simp add: OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny
|
||||||
|
|
||||||
section{* OclAllInstances *}
|
section{* OclAllInstances *}
|
||||||
|
|
||||||
text{* To denote OCL-types occuring in OCL expressions syntactically---as, for example, as
|
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
|
``argument'' of \inlineisar{oclAllInstances()}---we use the inverses of the injection
|
||||||
functions into the object universes; we show that this is sufficient ``characterization.'' *}
|
functions into the object universes; we show that this is sufficient ``characterization.'' *}
|
||||||
|
|
||||||
|
|
|
@ -626,7 +626,7 @@ by(simp add: OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny
|
||||||
|
|
||||||
section{* OclAllInstances *}
|
section{* OclAllInstances *}
|
||||||
|
|
||||||
text{* To denote OCL-types occuring in OCL expressions syntactically---as, for example, as
|
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
|
``argument'' of \inlineisar{oclAllInstances()}---we use the inverses of the injection
|
||||||
functions into the object universes; we show that this is sufficient ``characterization.'' *}
|
functions into the object universes; we show that this is sufficient ``characterization.'' *}
|
||||||
|
|
||||||
|
|
|
@ -122,7 +122,7 @@ like validity, not emptiness, finiteness...
|
||||||
Since the first hypothesis of @{text comp_fun_commute.fold_insert} is too general,
|
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
|
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.
|
reusing the @{term comp_fun_commute} locale or whether completely defining a new locale.
|
||||||
Because elements occuring in the type of @{term Finite_Set.fold_graph} are represented in polymorphic form,
|
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.
|
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
|
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}. *}
|
to each functions in a duplicated version of @{term comp_fun_commute}. *}
|
||||||
|
|
|
@ -409,7 +409,7 @@ lemma mbind_unit [simp]:
|
||||||
|
|
||||||
text{* The characteristic property of @{term mbind} --- which distinguishes it from
|
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
|
@{text mbind'} defined in the sequel --- is that it never fails; it ``swallows'' internal
|
||||||
errors occuring during the computation. *}
|
errors occurring during the computation. *}
|
||||||
lemma mbind_nofailure [simp]:
|
lemma mbind_nofailure [simp]:
|
||||||
"mbind S f \<sigma> \<noteq> None"
|
"mbind S f \<sigma> \<noteq> None"
|
||||||
apply(rule_tac x=\<sigma> in spec)
|
apply(rule_tac x=\<sigma> in spec)
|
||||||
|
|
|
@ -47,7 +47,7 @@
|
||||||
chapter{* Formalization I: OCL Types and Core Definitions \label{sec:focl-types}*}
|
chapter{* Formalization I: OCL Types and Core Definitions \label{sec:focl-types}*}
|
||||||
|
|
||||||
theory UML_Types
|
theory UML_Types
|
||||||
imports Transcendental (* Testing *)
|
imports HOL.Transcendental (* Testing *)
|
||||||
keywords "Assert" :: thy_decl
|
keywords "Assert" :: thy_decl
|
||||||
and "Assert_local" :: thy_decl
|
and "Assert_local" :: thy_decl
|
||||||
begin
|
begin
|
||||||
|
@ -624,9 +624,9 @@ fun outer_syntax_command command_spec theory in_local =
|
||||||
Outer_Syntax.command command_spec "assert that the given specification is true"
|
Outer_Syntax.command command_spec "assert that the given specification is true"
|
||||||
(Parse.term >> (fn elems_concl => theory (fn thy =>
|
(Parse.term >> (fn elems_concl => theory (fn thy =>
|
||||||
case
|
case
|
||||||
lemma "code_unfold" (Specification.theorem true)
|
lemma "nbe" (Specification.theorem true)
|
||||||
(fn lthy =>
|
(fn lthy =>
|
||||||
let val expr = Value_Command.value lthy (Syntax.read_term lthy elems_concl)
|
let val expr = Nbe.dynamic_value lthy (Syntax.read_term lthy elems_concl)
|
||||||
val thy = Proof_Context.theory_of lthy
|
val thy = Proof_Context.theory_of lthy
|
||||||
open HOLogic in
|
open HOLogic in
|
||||||
if Sign.typ_equiv thy (fastype_of expr, @{typ "prop"}) then
|
if Sign.typ_equiv thy (fastype_of expr, @{typ "prop"}) then
|
||||||
|
|
|
@ -71,7 +71,7 @@ text{* Our notion of typed bag goes beyond the usual notion of a finite executab
|
||||||
is powerful enough to capture \emph{the extension of a type} in UML and OCL. This means
|
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
|
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,
|
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 occuring in a state ---
|
although the notion for class-types --- involving object id's not occurring in a state ---
|
||||||
requires some care.
|
requires some care.
|
||||||
|
|
||||||
In a world with @{term invalid} and @{term null}, there are two notions extensions possible:
|
In a world with @{term invalid} and @{term null}, there are two notions extensions possible:
|
||||||
|
|
|
@ -63,7 +63,7 @@ text{* Our notion of typed set goes beyond the usual notion of a finite executab
|
||||||
is powerful enough to capture \emph{the extension of a type} in UML and OCL. This means
|
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
|
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,
|
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 occuring in a state ---
|
although the notion for class-types --- involving object id's not occurring in a state ---
|
||||||
requires some care.
|
requires some care.
|
||||||
|
|
||||||
In a world with @{term invalid} and @{term null}, there are two notions extensions possible:
|
In a world with @{term invalid} and @{term null}, there are two notions extensions possible:
|
||||||
|
|
|
@ -157,7 +157,7 @@ lazy_text\<open>For each Class \emph{C}, we will have a casting operation \inlin
|
||||||
lazy_text\<open>Thus, since we have two class-types in our concrete class hierarchy, we have
|
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.
|
two operations to declare and to provide two overloading definitions for the two static types.
|
||||||
\<close>
|
\<close>
|
||||||
lazy_text\<open>To denote OCL-types occuring in OCL expressions syntactically---as, for example, as
|
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
|
``argument'' of \inlineisar{oclAllInstances()}---we use the inverses of the injection
|
||||||
functions into the object universes; we show that this is sufficient ``characterization.''\<close>
|
functions into the object universes; we show that this is sufficient ``characterization.''\<close>
|
||||||
lazy_text\<open>\label{sec:edm-accessors}\<close>
|
lazy_text\<open>\label{sec:edm-accessors}\<close>
|
||||||
|
@ -237,7 +237,7 @@ lazy_text\<open>For each Class \emph{C}, we will have a casting operation \inlin
|
||||||
lazy_text\<open>Thus, since we have two class-types in our concrete class hierarchy, we have
|
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.
|
two operations to declare and to provide two overloading definitions for the two static types.
|
||||||
\<close>
|
\<close>
|
||||||
lazy_text\<open>To denote OCL-types occuring in OCL expressions syntactically---as, for example, as
|
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
|
``argument'' of \inlineisar{oclAllInstances()}---we use the inverses of the injection
|
||||||
functions into the object universes; we show that this is sufficient ``characterization.''\<close>
|
functions into the object universes; we show that this is sufficient ``characterization.''\<close>
|
||||||
lazy_text\<open>\label{sec:eam-accessors}\<close>
|
lazy_text\<open>\label{sec:eam-accessors}\<close>
|
||||||
|
|
|
@ -434,7 +434,7 @@ two operations to declare and to provide two overloading definitions for the two
|
||||||
|
|
||||||
, [ section \<open>OclAllInstances\<close>
|
, [ section \<open>OclAllInstances\<close>
|
||||||
, txt'' [ \<open>
|
, txt'' [ \<open>
|
||||||
To denote \OCL-types occuring in \OCL expressions syntactically---as, for example, as
|
To denote \OCL-types occurring in \OCL expressions syntactically---as, for example, as
|
||||||
``argument'' of \inlineisar{oclAllInstances()}---we use the inverses of the injection
|
``argument'' of \inlineisar{oclAllInstances()}---we use the inverses of the injection
|
||||||
functions into the object universes; we show that this is sufficient ``characterization.'' \<close> ]
|
functions into the object universes; we show that this is sufficient ``characterization.'' \<close> ]
|
||||||
, PRINT_allinst_def_id
|
, PRINT_allinst_def_id
|
||||||
|
|
|
@ -200,7 +200,7 @@ fun check l_oid l =
|
||||||
META.check_export_code
|
META.check_export_code
|
||||||
(writeln o Mi)
|
(writeln o Mi)
|
||||||
(warning o Mi)
|
(warning o Mi)
|
||||||
(writeln o Markup.markup Markup.bad o Mi)
|
(fn s => writeln (Markup.markup (Markup.bad ()) (Mi s)))
|
||||||
(error o To_string0)
|
(error o To_string0)
|
||||||
(Ml (Mp I Me) l_oid)
|
(Ml (Mp I Me) l_oid)
|
||||||
((META.SS_base o META.ST) l)
|
((META.SS_base o META.ST) l)
|
||||||
|
@ -1042,7 +1042,7 @@ fun export_code_tmp_file seris g =
|
||||||
else
|
else
|
||||||
Isabelle_System.with_tmp_file tmp_name (Deep0.Find.ext ml_compiler))
|
Isabelle_System.with_tmp_file tmp_name (Deep0.Find.ext ml_compiler))
|
||||||
(fn filename =>
|
(fn filename =>
|
||||||
g (((((ml_compiler, ml_module), Path.implode filename), export_arg) :: accu)))
|
g (((((ml_compiler, ml_module), (Path.implode filename, Position.none)), export_arg) :: accu)))
|
||||||
end))
|
end))
|
||||||
seris
|
seris
|
||||||
(fn f => f [])
|
(fn f => f [])
|
||||||
|
@ -1063,7 +1063,7 @@ fun export_code_cmd' seris tmp_export_code f_err raw_cs thy =
|
||||||
let val v = Deep0.apply_hs_code_identifiers Deep0.Export_code_env.Haskell.argument thy in
|
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
|
if mem_scala then Code_printing.apply_code_printing v else v end) in
|
||||||
List_mapi
|
List_mapi
|
||||||
(fn i => fn seri => case seri of (((ml_compiler, _), filename), _) =>
|
(fn i => fn seri => case seri of (((ml_compiler, _), (filename, _)), _) =>
|
||||||
let val (l, (out, err)) =
|
let val (l, (out, err)) =
|
||||||
Deep0.Find.build
|
Deep0.Find.build
|
||||||
ml_compiler
|
ml_compiler
|
||||||
|
@ -1240,12 +1240,13 @@ fun f_command l_mode =
|
||||||
fun mk_fic s = Path.append tmp_export_code (Path.make [s])
|
fun mk_fic s = Path.append tmp_export_code (Path.make [s])
|
||||||
val () = Deep0.Find.check_compil ml_compiler ()
|
val () = Deep0.Find.check_compil ml_compiler ()
|
||||||
val () = Isabelle_System.mkdirs tmp_export_code in
|
val () = Isabelle_System.mkdirs tmp_export_code in
|
||||||
((( (ml_compiler, ml_module)
|
(( ( (ml_compiler, ml_module)
|
||||||
, Path.implode (if Deep0.Find.export_mode ml_compiler = Deep0.Export_code_env.Directory then
|
, ( Path.implode (if Deep0.Find.export_mode ml_compiler = Deep0.Export_code_env.Directory then
|
||||||
tmp_export_code
|
tmp_export_code
|
||||||
else
|
else
|
||||||
mk_fic (Deep0.Find.function ml_compiler (Deep0.Find.ext ml_compiler))))
|
mk_fic (Deep0.Find.function ml_compiler (Deep0.Find.ext ml_compiler)))
|
||||||
, export_arg), mk_fic)
|
, Position.none))
|
||||||
|
, export_arg), mk_fic)
|
||||||
end)
|
end)
|
||||||
(List.filter (fn (("self", _), _) => false | _ => true) (#seri_args i_deep))
|
(List.filter (fn (("self", _), _) => false | _ => true) (#seri_args i_deep))
|
||||||
val _ =
|
val _ =
|
||||||
|
@ -1318,7 +1319,7 @@ let open Generation_mode
|
||||||
:: []))
|
:: []))
|
||||||
|> Deep.export_code_cmd' seri_args
|
|> Deep.export_code_cmd' seri_args
|
||||||
tmp_export_code
|
tmp_export_code
|
||||||
(fn (((_, _), msg), _) => fn err => if err <> 0 then error msg else ())
|
(fn (((_, _), (msg, _)), _) => fn err => if err <> 0 then error msg else ())
|
||||||
[name_main]
|
[name_main]
|
||||||
end
|
end
|
||||||
in
|
in
|
||||||
|
@ -1363,7 +1364,7 @@ local
|
||||||
fun fold_thy_shallow f =
|
fun fold_thy_shallow f =
|
||||||
META.fold_thy_shallow
|
META.fold_thy_shallow
|
||||||
(fn f => f () handle ERROR e =>
|
(fn f => f () handle ERROR e =>
|
||||||
( warning "Shallow Backtracking: (true) Isabelle declarations occuring among the META-simulated ones are ignored (if any)"
|
( 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,
|
(* TODO automatically determine if there is such Isabelle declarations,
|
||||||
for raising earlier a specific error message *)
|
for raising earlier a specific error message *)
|
||||||
; error e))
|
; error e))
|
||||||
|
|
|
@ -224,7 +224,7 @@ fun check l_oid l =
|
||||||
META.check_export_code
|
META.check_export_code
|
||||||
(writeln o Mi)
|
(writeln o Mi)
|
||||||
(warning o Mi)
|
(warning o Mi)
|
||||||
(writeln o Markup.markup Markup.bad o Mi)
|
(fn s => writeln (Markup.markup (Markup.bad ()) (Mi s)))
|
||||||
(error o To_string0)
|
(error o To_string0)
|
||||||
(Ml (Mp I Me) l_oid)
|
(Ml (Mp I Me) l_oid)
|
||||||
((META.SS_base o META.ST) l)
|
((META.SS_base o META.ST) l)
|
||||||
|
@ -1066,7 +1066,7 @@ fun export_code_tmp_file seris g =
|
||||||
else
|
else
|
||||||
Isabelle_System.with_tmp_file tmp_name (Deep0.Find.ext ml_compiler))
|
Isabelle_System.with_tmp_file tmp_name (Deep0.Find.ext ml_compiler))
|
||||||
(fn filename =>
|
(fn filename =>
|
||||||
g (((((ml_compiler, ml_module), Path.implode filename), export_arg) :: accu)))
|
g (((((ml_compiler, ml_module), (Path.implode filename, Position.none)), export_arg) :: accu)))
|
||||||
end))
|
end))
|
||||||
seris
|
seris
|
||||||
(fn f => f [])
|
(fn f => f [])
|
||||||
|
@ -1087,7 +1087,7 @@ fun export_code_cmd' seris tmp_export_code f_err raw_cs thy =
|
||||||
let val v = Deep0.apply_hs_code_identifiers Deep0.Export_code_env.Haskell.argument thy in
|
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
|
if mem_scala then Code_printing.apply_code_printing v else v end) in
|
||||||
List_mapi
|
List_mapi
|
||||||
(fn i => fn seri => case seri of (((ml_compiler, _), filename), _) =>
|
(fn i => fn seri => case seri of (((ml_compiler, _), (filename, _)), _) =>
|
||||||
let val (l, (out, err)) =
|
let val (l, (out, err)) =
|
||||||
Deep0.Find.build
|
Deep0.Find.build
|
||||||
ml_compiler
|
ml_compiler
|
||||||
|
@ -1264,12 +1264,13 @@ fun f_command l_mode =
|
||||||
fun mk_fic s = Path.append tmp_export_code (Path.make [s])
|
fun mk_fic s = Path.append tmp_export_code (Path.make [s])
|
||||||
val () = Deep0.Find.check_compil ml_compiler ()
|
val () = Deep0.Find.check_compil ml_compiler ()
|
||||||
val () = Isabelle_System.mkdirs tmp_export_code in
|
val () = Isabelle_System.mkdirs tmp_export_code in
|
||||||
((( (ml_compiler, ml_module)
|
(( ( (ml_compiler, ml_module)
|
||||||
, Path.implode (if Deep0.Find.export_mode ml_compiler = Deep0.Export_code_env.Directory then
|
, ( Path.implode (if Deep0.Find.export_mode ml_compiler = Deep0.Export_code_env.Directory then
|
||||||
tmp_export_code
|
tmp_export_code
|
||||||
else
|
else
|
||||||
mk_fic (Deep0.Find.function ml_compiler (Deep0.Find.ext ml_compiler))))
|
mk_fic (Deep0.Find.function ml_compiler (Deep0.Find.ext ml_compiler)))
|
||||||
, export_arg), mk_fic)
|
, Position.none))
|
||||||
|
, export_arg), mk_fic)
|
||||||
end)
|
end)
|
||||||
(List.filter (fn (("self", _), _) => false | _ => true) (#seri_args i_deep))
|
(List.filter (fn (("self", _), _) => false | _ => true) (#seri_args i_deep))
|
||||||
val _ =
|
val _ =
|
||||||
|
@ -1342,7 +1343,7 @@ let open Generation_mode
|
||||||
:: []))
|
:: []))
|
||||||
|> Deep.export_code_cmd' seri_args
|
|> Deep.export_code_cmd' seri_args
|
||||||
tmp_export_code
|
tmp_export_code
|
||||||
(fn (((_, _), msg), _) => fn err => if err <> 0 then error msg else ())
|
(fn (((_, _), (msg, _)), _) => fn err => if err <> 0 then error msg else ())
|
||||||
[name_main]
|
[name_main]
|
||||||
end
|
end
|
||||||
in
|
in
|
||||||
|
@ -1387,7 +1388,7 @@ local
|
||||||
fun fold_thy_shallow f =
|
fun fold_thy_shallow f =
|
||||||
META.fold_thy_shallow
|
META.fold_thy_shallow
|
||||||
(fn f => f () handle ERROR e =>
|
(fn f => f () handle ERROR e =>
|
||||||
( warning "Shallow Backtracking: (true) Isabelle declarations occuring among the META-simulated ones are ignored (if any)"
|
( 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,
|
(* TODO automatically determine if there is such Isabelle declarations,
|
||||||
for raising earlier a specific error message *)
|
for raising earlier a specific error message *)
|
||||||
; error e))
|
; error e))
|
||||||
|
|
|
@ -48,10 +48,10 @@ section\<open>Basic Extension of the Standard Library (Depending on RBT)\<close>
|
||||||
|
|
||||||
theory Init_rbt
|
theory Init_rbt
|
||||||
imports "../compiler_generic/Init"
|
imports "../compiler_generic/Init"
|
||||||
"~~/src/HOL/Library/RBT"
|
"HOL-Library.RBT"
|
||||||
"~~/src/HOL/Library/Char_ord"
|
"HOL-Library.Char_ord"
|
||||||
"~~/src/HOL/Library/List_lexord"
|
"HOL-Library.List_lexord"
|
||||||
"~~/src/HOL/Library/Product_Lexorder"
|
"HOL-Library.Product_Lexorder"
|
||||||
begin
|
begin
|
||||||
|
|
||||||
locale RBT
|
locale RBT
|
||||||
|
|
|
@ -40,7 +40,7 @@
|
||||||
******************************************************************************)
|
******************************************************************************)
|
||||||
|
|
||||||
theory Init
|
theory Init
|
||||||
imports "~~/src/HOL/Library/Code_Char"
|
imports "HOL-Library.Code_Char"
|
||||||
"isabelle_home/src/HOL/Isabelle_Main0"
|
"isabelle_home/src/HOL/Isabelle_Main0"
|
||||||
|
|
||||||
begin
|
begin
|
||||||
|
|
|
@ -74,8 +74,13 @@ session Isabelle_Meta_Model (AFP) = "HOL-Library" +
|
||||||
"toy_example/embedding/Generator_dynamic_sequential"
|
"toy_example/embedding/Generator_dynamic_sequential"
|
||||||
"toy_example/generator/Design_deep"
|
"toy_example/generator/Design_deep"
|
||||||
"toy_example/generator/Design_shallow"
|
"toy_example/generator/Design_shallow"
|
||||||
"toy_example/document_generated/Design_generated_generated"
|
|
||||||
"document/Rail"
|
"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
|
document_files
|
||||||
"root.bib"
|
"root.bib"
|
||||||
"root.tex"
|
"root.tex"
|
||||||
|
|
|
@ -56,7 +56,7 @@ Runtime services building on code generation into implementation language SML.
|
||||||
|
|
||||||
open Basic_Code_Symbol;
|
open Basic_Code_Symbol;
|
||||||
|
|
||||||
(** computation **)
|
(** ML compiler as evaluation environment **)
|
||||||
|
|
||||||
(* technical prerequisites *)
|
(* technical prerequisites *)
|
||||||
|
|
||||||
|
@ -72,7 +72,7 @@ fun compile_ML verbose code context =
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
(* computation as evaluation into ML language values *)
|
(* evaluation into ML language values *)
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
@ -82,7 +82,43 @@ fun compile_ML verbose code context =
|
||||||
|
|
||||||
(** full static evaluation -- still with limited coverage! **)
|
(** full static evaluation -- still with limited coverage! **)
|
||||||
|
|
||||||
fun evaluation_code ctxt module_name program tycos consts all_public =
|
|
||||||
|
|
||||||
|
(** 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
|
let
|
||||||
val thy = Proof_Context.theory_of ctxt;
|
val thy = Proof_Context.theory_of ctxt;
|
||||||
val (ml_modules, target_names) =
|
val (ml_modules, target_names) =
|
||||||
|
@ -104,7 +140,7 @@ fun evaluation_code ctxt module_name program tycos consts all_public =
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
(** code antiquotation **)
|
(** code and computation antiquotations **)
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
@ -184,7 +220,7 @@ fun gen_code_reflect prep_type prep_const all_public raw_datatypes raw_functions
|
||||||
val functions = map (prep_const thy) raw_functions;
|
val functions = map (prep_const thy) raw_functions;
|
||||||
val consts = constrs @ functions;
|
val consts = constrs @ functions;
|
||||||
val program = Code_Thingol.consts_program ctxt consts;
|
val program = Code_Thingol.consts_program ctxt consts;
|
||||||
val result = evaluation_code ctxt module_name program tycos consts all_public
|
val result = runtime_code'' ctxt module_name program tycos consts all_public
|
||||||
|> (apsnd o apsnd) (chop (length constrs));
|
|> (apsnd o apsnd) (chop (length constrs));
|
||||||
in
|
in
|
||||||
thy
|
thy
|
||||||
|
@ -209,12 +245,12 @@ val _ =
|
||||||
Outer_Syntax.command @{command_keyword code_reflect'}
|
Outer_Syntax.command @{command_keyword code_reflect'}
|
||||||
"enrich runtime environment with generated code"
|
"enrich runtime environment with generated code"
|
||||||
(Scan.optional (@{keyword "open"} |-- Scan.succeed true) false --
|
(Scan.optional (@{keyword "open"} |-- Scan.succeed true) false --
|
||||||
Parse.name -- Scan.optional (@{keyword "datatypes"} |-- Parse.!!! (parse_datatype
|
Parse.name -- Scan.optional (@{keyword "datatypes"} |-- Parse.!!! (parse_datatype
|
||||||
::: Scan.repeat (@{keyword "and"} |-- parse_datatype))) []
|
::: Scan.repeat (@{keyword "and"} |-- parse_datatype))) []
|
||||||
-- Scan.optional (@{keyword "functions"} |-- Parse.!!! (Scan.repeat1 Parse.name)) []
|
-- Scan.optional (@{keyword "functions"} |-- Parse.!!! (Scan.repeat1 Parse.name)) []
|
||||||
-- Scan.option (@{keyword "file"} |-- Parse.!!! Parse.name)
|
-- Scan.option (@{keyword "file"} |-- Parse.!!! Parse.name)
|
||||||
>> (fn ((((all_public, module_name), raw_datatypes), raw_functions), some_file) => Toplevel.theory
|
>> (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)))
|
(code_reflect_cmd all_public raw_datatypes raw_functions module_name some_file)));
|
||||||
|
|
||||||
end; (*local*)
|
end; (*local*)
|
||||||
|
|
||||||
|
|
|
@ -98,8 +98,14 @@ val parse_inst_ident = Parse.name --| @{keyword "::"} -- Parse.class;
|
||||||
|
|
||||||
(* code generation *)
|
(* code generation *)
|
||||||
|
|
||||||
fun prep_destination "" = NONE
|
fun prep_destination (s, pos) =
|
||||||
| prep_destination s = SOME (Path.explode s);
|
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 =
|
fun export_code_cmd all_public raw_cs seris ctxt =
|
||||||
|
|
|
@ -193,7 +193,7 @@ val local_theory_to_proof = local_theory_command Toplevel.local_theory_to_proof;
|
||||||
(* parse commands *)
|
(* parse commands *)
|
||||||
|
|
||||||
val bootstrap =
|
val bootstrap =
|
||||||
Config.bool (Config.declare ("Outer_Syntax.bootstrap", @{here}) (K (Config.Bool true)));
|
Config.bool (Config.declare ("Outer_Syntax.bootstrap", \<^here>) (K (Config.Bool true)));
|
||||||
|
|
||||||
local
|
local
|
||||||
|
|
||||||
|
@ -340,7 +340,7 @@ fun check_command ctxt (name, pos) =
|
||||||
(* 'ML' command -- required for bootstrapping Isar *)
|
(* 'ML' command -- required for bootstrapping Isar *)
|
||||||
|
|
||||||
val _ =
|
val _ =
|
||||||
command ("ML", @{here}) "ML text within theory or local theory"
|
command ("ML", \<^here>) "ML text within theory or local theory"
|
||||||
(Parse.ML_source >> (fn source =>
|
(Parse.ML_source >> (fn source =>
|
||||||
Toplevel.generic_theory
|
Toplevel.generic_theory
|
||||||
(ML_Context.exec (fn () =>
|
(ML_Context.exec (fn () =>
|
||||||
|
|
|
@ -79,8 +79,8 @@ sig
|
||||||
val exec_id: Document_ID.exec -> transitions -> transitions
|
val exec_id: Document_ID.exec -> transitions -> transitions
|
||||||
val setmp_thread_position: transition -> ('a -> 'b) -> 'a -> 'b
|
val setmp_thread_position: transition -> ('a -> 'b) -> 'a -> 'b
|
||||||
val add_hook: (transition -> state -> state -> unit) -> unit
|
val add_hook: (transition -> state -> state -> unit) -> unit
|
||||||
val get_timing: transition -> Time.time option
|
val get_timing: transition -> Time.time
|
||||||
val put_timing: Time.time option -> transition -> transition
|
val put_timing: Time.time -> transition -> transition
|
||||||
val transition: bool -> transition -> state -> state * (exn * string) option
|
val transition: bool -> transition -> state -> state * (exn * string) option
|
||||||
val command_errors: bool -> transition -> state -> Runtime.error list * state option
|
val command_errors: bool -> transition -> state -> Runtime.error list * state option
|
||||||
val command_exception: bool -> transition -> state -> state
|
val command_exception: bool -> transition -> state -> state
|
||||||
|
@ -296,7 +296,7 @@ datatype state_write = Store_backup | Store_default
|
||||||
datatype transition = Transition of
|
datatype transition = Transition of
|
||||||
{name: string, (*command name*)
|
{name: string, (*command name*)
|
||||||
pos: Position.T, (*source position*)
|
pos: Position.T, (*source position*)
|
||||||
timing: Time.time option, (*prescient timing information*)
|
timing: Time.time, (*prescient timing information*)
|
||||||
trans: trans list, (*primitive transitions (union)*)
|
trans: trans list, (*primitive transitions (union)*)
|
||||||
read_write: state_read * state_write}; (*state update status*)
|
read_write: state_read * state_write}; (*state update status*)
|
||||||
|
|
||||||
|
@ -308,7 +308,7 @@ fun make_transition (name, pos, timing, trans, read_write) =
|
||||||
fun map_transition f (Transition {name, pos, timing, trans, read_write}) =
|
fun map_transition f (Transition {name, pos, timing, trans, read_write}) =
|
||||||
make_transition (f (name, pos, timing, trans, read_write));
|
make_transition (f (name, pos, timing, trans, read_write));
|
||||||
|
|
||||||
val empty = make_transition ("", Position.none, NONE, [], (Load_previous, Store_default));
|
val empty = make_transition ("", Position.none, Time.zeroTime, [], (Load_previous, Store_default));
|
||||||
|
|
||||||
|
|
||||||
(* diagnostics *)
|
(* diagnostics *)
|
||||||
|
@ -446,7 +446,7 @@ fun local_theory' restricted target f = present_transaction (fn int =>
|
||||||
|
|
||||||
fun local_theory restricted target f = local_theory' restricted target (K f);
|
fun local_theory restricted target f = local_theory' restricted target (K f);
|
||||||
|
|
||||||
fun present_local_theory target = present_transaction (fn int =>
|
fun present_local_theory target = present_transaction (fn _ =>
|
||||||
(fn Theory (gthy, _) =>
|
(fn Theory (gthy, _) =>
|
||||||
let val (finish, lthy) = Named_Target.switch target gthy;
|
let val (finish, lthy) = Named_Target.switch target gthy;
|
||||||
in Theory (finish lthy, SOME lthy) end
|
in Theory (finish lthy, SOME lthy) end
|
||||||
|
@ -581,7 +581,7 @@ fun put_timing timing = map_transition (fn (name, pos, _, trans, read_write) =>
|
||||||
|
|
||||||
local
|
local
|
||||||
|
|
||||||
fun app int (tr as Transition {name, trans, ...}) =
|
fun app int (tr as Transition {trans, ...}) =
|
||||||
setmp_thread_position tr (fn state =>
|
setmp_thread_position tr (fn state =>
|
||||||
let
|
let
|
||||||
val timing_start = Timing.start ();
|
val timing_start = Timing.start ();
|
||||||
|
@ -622,7 +622,7 @@ end;
|
||||||
fun command_errors int tr st =
|
fun command_errors int tr st =
|
||||||
(case transition int tr st of
|
(case transition int tr st of
|
||||||
(st', NONE) => ([], SOME st')
|
(st', NONE) => ([], SOME st')
|
||||||
| (_, SOME (exn, _)) => (Runtime.exn_messages_ids exn, NONE));
|
| (_, SOME (exn, _)) => (Runtime.exn_messages exn, NONE));
|
||||||
|
|
||||||
fun command_exception int tr st =
|
fun command_exception int tr st =
|
||||||
(case transition int tr st of
|
(case transition int tr st of
|
||||||
|
@ -677,19 +677,9 @@ structure Result = Proof_Data
|
||||||
val get_result = Result.get o Proof.context_of;
|
val get_result = Result.get o Proof.context_of;
|
||||||
val put_result = Proof.map_context o Result.put;
|
val put_result = Proof.map_context o Result.put;
|
||||||
|
|
||||||
fun timing_estimate include_head elem =
|
fun timing_estimate elem =
|
||||||
let
|
let val trs = tl (Thy_Syntax.flat_element elem)
|
||||||
val trs = Thy_Syntax.flat_element elem |> not include_head ? tl;
|
in fold (fn tr => fn t => get_timing tr + t) trs Time.zeroTime end;
|
||||||
val timings = map get_timing trs;
|
|
||||||
in
|
|
||||||
if forall is_some timings then
|
|
||||||
SOME (fold (curry (op +) o the) timings Time.zeroTime)
|
|
||||||
else NONE
|
|
||||||
end;
|
|
||||||
|
|
||||||
fun priority NONE = ~1
|
|
||||||
| priority (SOME estimate) =
|
|
||||||
Int.min (Real.floor (Real.max (Math.log10 (Time.toReal estimate), ~3.0)) - 3, ~1);
|
|
||||||
|
|
||||||
fun proof_future_enabled estimate st =
|
fun proof_future_enabled estimate st =
|
||||||
(case try proof_of st of
|
(case try proof_of st of
|
||||||
|
@ -698,18 +688,14 @@ fun proof_future_enabled estimate st =
|
||||||
not (Proof.is_relevant state) andalso
|
not (Proof.is_relevant state) andalso
|
||||||
(if can (Proof.assert_bottom true) state
|
(if can (Proof.assert_bottom true) state
|
||||||
then Goal.future_enabled 1
|
then Goal.future_enabled 1
|
||||||
else
|
else Goal.future_enabled 2 orelse Goal.future_enabled_timing estimate));
|
||||||
(case estimate of
|
|
||||||
NONE => Goal.future_enabled 2
|
|
||||||
| SOME t => Goal.future_enabled_timing t)));
|
|
||||||
|
|
||||||
fun atom_result keywords tr st =
|
fun atom_result keywords tr st =
|
||||||
let
|
let
|
||||||
val st' =
|
val st' =
|
||||||
if Goal.future_enabled 1 andalso Keyword.is_diag keywords (name_of tr) then
|
if Goal.future_enabled 1 andalso Keyword.is_diag keywords (name_of tr) then
|
||||||
(Execution.fork
|
(Execution.fork
|
||||||
{name = "Toplevel.diag", pos = pos_of tr,
|
{name = "Toplevel.diag", pos = pos_of tr, pri = ~1}
|
||||||
pri = priority (timing_estimate true (Thy_Syntax.atom tr))}
|
|
||||||
(fn () => command tr st); st)
|
(fn () => command tr st); st)
|
||||||
else command tr st;
|
else command tr st;
|
||||||
in (Result (tr, st'), st') end;
|
in (Result (tr, st'), st') end;
|
||||||
|
@ -721,7 +707,7 @@ fun element_result keywords (Thy_Syntax.Element (tr, NONE)) st = atom_result key
|
||||||
let
|
let
|
||||||
val (head_result, st') = atom_result keywords head_tr st;
|
val (head_result, st') = atom_result keywords head_tr st;
|
||||||
val (body_elems, end_tr) = element_rest;
|
val (body_elems, end_tr) = element_rest;
|
||||||
val estimate = timing_estimate false elem;
|
val estimate = timing_estimate elem;
|
||||||
in
|
in
|
||||||
if not (proof_future_enabled estimate st')
|
if not (proof_future_enabled estimate st')
|
||||||
then
|
then
|
||||||
|
@ -736,7 +722,7 @@ fun element_result keywords (Thy_Syntax.Element (tr, NONE)) st = atom_result key
|
||||||
val future_proof =
|
val future_proof =
|
||||||
Proof.future_proof (fn state =>
|
Proof.future_proof (fn state =>
|
||||||
Execution.fork
|
Execution.fork
|
||||||
{name = "Toplevel.future_proof", pos = pos_of head_tr, pri = priority estimate}
|
{name = "Toplevel.future_proof", pos = pos_of head_tr, pri = ~1}
|
||||||
(fn () =>
|
(fn () =>
|
||||||
let
|
let
|
||||||
val State (SOME (Proof (prf, (_, orig_gthy))), prev, backup) = st';
|
val State (SOME (Proof (prf, (_, orig_gthy))), prev, backup) = st';
|
||||||
|
|
|
@ -12,6 +12,7 @@ sig
|
||||||
val read: Keyword.keywords -> theory -> Path.T-> (unit -> theory) ->
|
val read: Keyword.keywords -> theory -> Path.T-> (unit -> theory) ->
|
||||||
blob list * int -> Token.T list -> Toplevel.transitions
|
blob list * int -> Token.T list -> Toplevel.transitions
|
||||||
type eval
|
type eval
|
||||||
|
val eval_exec_id: eval -> Document_ID.exec
|
||||||
val eval_eq: eval * eval -> bool
|
val eval_eq: eval * eval -> bool
|
||||||
val eval_running: eval -> bool
|
val eval_running: eval -> bool
|
||||||
val eval_finished: eval -> bool
|
val eval_finished: eval -> bool
|
||||||
|
@ -116,7 +117,7 @@ fun reports_of_token keywords tok =
|
||||||
Input.source_explode (Token.input_of tok)
|
Input.source_explode (Token.input_of tok)
|
||||||
|> map_filter (fn (sym, pos) =>
|
|> map_filter (fn (sym, pos) =>
|
||||||
if Symbol.is_malformed sym
|
if Symbol.is_malformed sym
|
||||||
then SOME ((pos, Markup.bad), "Malformed symbolic character") else NONE);
|
then SOME ((pos, Markup.bad ()), "Malformed symbolic character") else NONE);
|
||||||
val is_malformed = Token.is_error tok orelse not (null malformed_symbols);
|
val is_malformed = Token.is_error tok orelse not (null malformed_symbols);
|
||||||
val reports = Token.reports keywords tok @ Token.completion_report tok @ malformed_symbols;
|
val reports = Token.reports keywords tok @ Token.completion_report tok @ malformed_symbols;
|
||||||
in (is_malformed, reports) end;
|
in (is_malformed, reports) end;
|
||||||
|
@ -201,7 +202,7 @@ fun check_cmts span tr st' =
|
||||||
(Thy_Output.output_text st' {markdown = false} (Token.input_of cmt); [])
|
(Thy_Output.output_text st' {markdown = false} (Token.input_of cmt); [])
|
||||||
handle exn =>
|
handle exn =>
|
||||||
if Exn.is_interrupt exn then Exn.reraise exn
|
if Exn.is_interrupt exn then Exn.reraise exn
|
||||||
else Runtime.exn_messages_ids exn)) ();
|
else Runtime.exn_messages exn)) ();
|
||||||
|
|
||||||
fun report tr m =
|
fun report tr m =
|
||||||
Toplevel.setmp_thread_position tr (fn () => Output.report [Markup.markup_only m]) ();
|
Toplevel.setmp_thread_position tr (fn () => Output.report [Markup.markup_only m]) ();
|
||||||
|
@ -242,7 +243,7 @@ fun eval_state' keywords span tr state =
|
||||||
let
|
let
|
||||||
val _ = status tr Markup.failed;
|
val _ = status tr Markup.failed;
|
||||||
val _ = status tr Markup.finished;
|
val _ = status tr Markup.finished;
|
||||||
val _ = if null errs then (report tr Markup.bad; Exn.interrupt ()) else ();
|
val _ = if null errs then (report tr (Markup.bad ()); Exn.interrupt ()) else ();
|
||||||
in {failed = true, command = tr, state = st} end
|
in {failed = true, command = tr, state = st} end
|
||||||
| SOME st' =>
|
| SOME st' =>
|
||||||
let
|
let
|
||||||
|
@ -274,7 +275,7 @@ fun eval keywords master_dir init blobs_info span eval0 =
|
||||||
(fn () =>
|
(fn () =>
|
||||||
read keywords thy master_dir init blobs_info span |> Toplevel.exec_id exec_id) ();
|
read keywords thy master_dir init blobs_info span |> Toplevel.exec_id exec_id) ();
|
||||||
in eval_state keywords span tr eval_state0 end;
|
in eval_state keywords span tr eval_state0 end;
|
||||||
in Eval {exec_id = exec_id, eval_process = Lazy.lazy process} end;
|
in Eval {exec_id = exec_id, eval_process = Lazy.lazy_name "Command.eval" process} end;
|
||||||
|
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
@ -303,7 +304,7 @@ fun print_error tr opt_context e =
|
||||||
(Toplevel.setmp_thread_position tr o Runtime.controlled_execution opt_context) e ()
|
(Toplevel.setmp_thread_position tr o Runtime.controlled_execution opt_context) e ()
|
||||||
handle exn =>
|
handle exn =>
|
||||||
if Exn.is_interrupt exn then Exn.reraise exn
|
if Exn.is_interrupt exn then Exn.reraise exn
|
||||||
else List.app (Future.error_message (Toplevel.pos_of tr)) (Runtime.exn_messages_ids 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_finished (Print {print_process, ...}) = Lazy.is_finished print_process;
|
||||||
|
|
||||||
|
@ -332,7 +333,7 @@ fun print command_visible command_overlays keywords command_name eval old_prints
|
||||||
in
|
in
|
||||||
Print {
|
Print {
|
||||||
name = name, args = args, delay = delay, pri = pri, persistent = persistent,
|
name = name, args = args, delay = delay, pri = pri, persistent = persistent,
|
||||||
exec_id = exec_id, print_process = Lazy.lazy process}
|
exec_id = exec_id, print_process = Lazy.lazy_name "Command.print" process}
|
||||||
end;
|
end;
|
||||||
|
|
||||||
fun bad_print name args exn =
|
fun bad_print name args exn =
|
||||||
|
|
|
@ -1,283 +0,0 @@
|
||||||
(* Title: Pure/PIDE/resources.ML
|
|
||||||
Author: Makarius
|
|
||||||
|
|
||||||
Resources for theories and auxiliary files.
|
|
||||||
*)
|
|
||||||
|
|
||||||
signature RESOURCES =
|
|
||||||
sig
|
|
||||||
val master_directory: theory -> Path.T
|
|
||||||
val imports_of: theory -> (string * Position.T) list
|
|
||||||
val thy_path: Path.T -> Path.T
|
|
||||||
val check_thy: Path.T -> string ->
|
|
||||||
{master: Path.T * SHA1.digest, text: string, theory_pos: Position.T,
|
|
||||||
imports: (string * Position.T) list, keywords: Thy_Header.keywords}
|
|
||||||
val parse_files: string -> (theory -> Token.file list) parser
|
|
||||||
val provide: Path.T * SHA1.digest -> theory -> theory
|
|
||||||
val provide_parse_files: string -> (theory -> Token.file list * theory) parser
|
|
||||||
val loaded_files_current: theory -> bool
|
|
||||||
val begin_theory: Path.T -> Thy_Header.header -> theory list -> theory
|
|
||||||
val load_thy: bool -> HTML.symbols -> (Toplevel.transition -> Time.time option) -> int ->
|
|
||||||
Path.T -> Thy_Header.header -> Position.T -> string -> theory list ->
|
|
||||||
theory * (unit -> unit) * int
|
|
||||||
end;
|
|
||||||
|
|
||||||
structure Resources: RESOURCES =
|
|
||||||
struct
|
|
||||||
|
|
||||||
(* manage source files *)
|
|
||||||
|
|
||||||
type files =
|
|
||||||
{master_dir: Path.T, (*master directory of theory source*)
|
|
||||||
imports: (string * Position.T) list, (*source specification of imports*)
|
|
||||||
provided: (Path.T * SHA1.digest) list}; (*source path, digest*)
|
|
||||||
|
|
||||||
fun make_files (master_dir, imports, provided): files =
|
|
||||||
{master_dir = master_dir, imports = imports, provided = provided};
|
|
||||||
|
|
||||||
structure Files = Theory_Data
|
|
||||||
(
|
|
||||||
type T = files;
|
|
||||||
val empty = make_files (Path.current, [], []);
|
|
||||||
fun extend _ = empty;
|
|
||||||
fun merge _ = empty;
|
|
||||||
);
|
|
||||||
|
|
||||||
fun map_files f =
|
|
||||||
Files.map (fn {master_dir, imports, provided} =>
|
|
||||||
make_files (f (master_dir, imports, provided)));
|
|
||||||
|
|
||||||
|
|
||||||
val master_directory = #master_dir o Files.get;
|
|
||||||
val imports_of = #imports o Files.get;
|
|
||||||
|
|
||||||
fun put_deps master_dir imports = map_files (fn _ => (master_dir, imports, []));
|
|
||||||
|
|
||||||
|
|
||||||
(* theory files *)
|
|
||||||
|
|
||||||
val thy_path = Path.ext "thy";
|
|
||||||
|
|
||||||
fun check_file dir file = File.check_file (File.full_path dir file);
|
|
||||||
|
|
||||||
fun check_thy dir thy_name =
|
|
||||||
let
|
|
||||||
val path = thy_path (Path.basic thy_name);
|
|
||||||
val master_file = check_file dir path;
|
|
||||||
val text = File.read master_file;
|
|
||||||
|
|
||||||
val {name = (name, pos), imports, keywords} =
|
|
||||||
Thy_Header.read (Path.position master_file) text;
|
|
||||||
val _ = thy_name <> name andalso
|
|
||||||
error ("Bad theory name " ^ quote name ^
|
|
||||||
" for file " ^ Path.print path ^ Position.here pos);
|
|
||||||
in
|
|
||||||
{master = (master_file, SHA1.digest text), text = text, theory_pos = pos,
|
|
||||||
imports = imports, keywords = keywords}
|
|
||||||
end;
|
|
||||||
|
|
||||||
|
|
||||||
(* load files *)
|
|
||||||
|
|
||||||
fun parse_files cmd =
|
|
||||||
Scan.ahead Parse.not_eof -- Parse.path >> (fn (tok, name) => fn thy =>
|
|
||||||
(case Token.get_files tok of
|
|
||||||
[] =>
|
|
||||||
let
|
|
||||||
val keywords = Thy_Header.get_keywords thy;
|
|
||||||
val master_dir = master_directory thy;
|
|
||||||
val pos = Token.pos_of tok;
|
|
||||||
val src_paths = Keyword.command_files keywords cmd (Path.explode name);
|
|
||||||
in map (Command.read_file master_dir pos) src_paths end
|
|
||||||
| files => map Exn.release files));
|
|
||||||
|
|
||||||
fun provide (src_path, id) =
|
|
||||||
map_files (fn (master_dir, imports, provided) =>
|
|
||||||
if AList.defined (op =) provided src_path then
|
|
||||||
error ("Duplicate use of source file: " ^ Path.print src_path)
|
|
||||||
else (master_dir, imports, (src_path, id) :: provided));
|
|
||||||
|
|
||||||
fun provide_parse_files cmd =
|
|
||||||
parse_files cmd >> (fn files => fn thy =>
|
|
||||||
let
|
|
||||||
val fs = files thy;
|
|
||||||
val thy' = fold (fn {src_path, digest, ...} => provide (src_path, digest)) fs thy;
|
|
||||||
in (fs, thy') end);
|
|
||||||
|
|
||||||
fun load_file thy src_path =
|
|
||||||
let
|
|
||||||
val full_path = check_file (master_directory thy) src_path;
|
|
||||||
val text = File.read full_path;
|
|
||||||
val id = SHA1.digest text;
|
|
||||||
in ((full_path, id), text) end;
|
|
||||||
|
|
||||||
fun loaded_files_current thy =
|
|
||||||
#provided (Files.get thy) |>
|
|
||||||
forall (fn (src_path, id) =>
|
|
||||||
(case try (load_file thy) src_path of
|
|
||||||
NONE => false
|
|
||||||
| SOME ((_, id'), _) => id = id'));
|
|
||||||
|
|
||||||
|
|
||||||
(* load theory *)
|
|
||||||
|
|
||||||
fun begin_theory master_dir {name, imports, keywords} parents =
|
|
||||||
Theory.begin_theory name parents
|
|
||||||
|> put_deps master_dir imports
|
|
||||||
|> Thy_Header.add_keywords keywords;
|
|
||||||
|
|
||||||
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) 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 load_thy document symbols last_timing update_time master_dir header text_pos text parents =
|
|
||||||
let
|
|
||||||
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 toks = Token.explode keywords text_pos text;
|
|
||||||
val spans = Outer_Syntax.parse_spans toks;
|
|
||||||
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 () =
|
|
||||||
begin_theory master_dir header parents
|
|
||||||
|> Present.begin_theory 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
|
|
||||||
val res = filter_out (Toplevel.is_ignored o #1) (maps Toplevel.join_results results);
|
|
||||||
in
|
|
||||||
if exists (Toplevel.is_skipped_proof o #2) res then
|
|
||||||
warning ("Cannot present theory with skipped proofs: " ^ quote name)
|
|
||||||
else
|
|
||||||
if document then let val tex_source = Thy_Output.present_thy thy res toks |> Buffer.content in Present.theory_output name tex_source end else ()
|
|
||||||
end;
|
|
||||||
|
|
||||||
in (thy, present, size text) end;
|
|
||||||
|
|
||||||
|
|
||||||
(* antiquotations *)
|
|
||||||
|
|
||||||
local
|
|
||||||
|
|
||||||
fun err msg pos = error (msg ^ Position.here pos);
|
|
||||||
|
|
||||||
fun check_path check_file ctxt dir (name, pos) =
|
|
||||||
let
|
|
||||||
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.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 document_antiq check_file ctxt (name, pos) =
|
|
||||||
let
|
|
||||||
val dir = master_directory (Proof_Context.theory_of ctxt);
|
|
||||||
val _ = check_path check_file ctxt dir (name, pos);
|
|
||||||
in
|
|
||||||
space_explode "/" name
|
|
||||||
|> map Latex.output_ascii
|
|
||||||
|> space_implode (Latex.output_ascii "/" ^ "\\discretionary{}{}{}")
|
|
||||||
|> enclose "\\isatt{" "}"
|
|
||||||
end;
|
|
||||||
|
|
||||||
fun ML_antiq check_file ctxt (name, pos) =
|
|
||||||
let val path = check_path check_file ctxt Path.current (name, pos);
|
|
||||||
in "Path.explode " ^ ML_Syntax.print_string (Path.implode path) end;
|
|
||||||
|
|
||||||
in
|
|
||||||
|
|
||||||
val _ = Theory.setup
|
|
||||||
(Thy_Output.antiquotation @{binding path} (Scan.lift (Parse.position Parse.path))
|
|
||||||
(document_antiq NONE o #context) #>
|
|
||||||
Thy_Output.antiquotation @{binding file} (Scan.lift (Parse.position Parse.path))
|
|
||||||
(document_antiq (SOME File.check_file) o #context) #>
|
|
||||||
Thy_Output.antiquotation @{binding dir} (Scan.lift (Parse.position Parse.path))
|
|
||||||
(document_antiq (SOME File.check_dir) o #context) #>
|
|
||||||
ML_Antiquotation.value @{binding path}
|
|
||||||
(Args.context -- Scan.lift (Parse.position Parse.path)
|
|
||||||
>> uncurry (ML_antiq NONE)) #>
|
|
||||||
ML_Antiquotation.value @{binding file}
|
|
||||||
(Args.context -- Scan.lift (Parse.position Parse.path)
|
|
||||||
>> uncurry (ML_antiq (SOME File.check_file))) #>
|
|
||||||
ML_Antiquotation.value @{binding dir}
|
|
||||||
(Args.context -- Scan.lift (Parse.position Parse.path)
|
|
||||||
>> uncurry (ML_antiq (SOME File.check_dir))));
|
|
||||||
|
|
||||||
end;
|
|
||||||
|
|
||||||
end;
|
|
|
@ -16,10 +16,10 @@ sig
|
||||||
val use_theories:
|
val use_theories:
|
||||||
{document: bool,
|
{document: bool,
|
||||||
symbols: HTML.symbols,
|
symbols: HTML.symbols,
|
||||||
last_timing: Toplevel.transition -> Time.time option,
|
last_timing: Toplevel.transition -> Time.time,
|
||||||
|
qualifier: string,
|
||||||
master_dir: Path.T} -> (string * Position.T) list -> unit
|
master_dir: Path.T} -> (string * Position.T) list -> unit
|
||||||
val use_thys: (string * Position.T) list -> unit
|
val use_thy: string -> unit
|
||||||
val use_thy: string * Position.T -> unit
|
|
||||||
val script_thy: Position.T -> string -> theory -> theory
|
val script_thy: Position.T -> string -> theory -> theory
|
||||||
val register_thy: theory -> unit
|
val register_thy: theory -> unit
|
||||||
val finish: unit -> unit
|
val finish: unit -> unit
|
||||||
|
@ -54,11 +54,9 @@ type deps =
|
||||||
|
|
||||||
fun make_deps master imports : deps = {master = master, imports = imports};
|
fun make_deps master imports : deps = {master = master, imports = imports};
|
||||||
|
|
||||||
fun master_dir (d: deps option) =
|
fun master_dir_deps (d: deps option) =
|
||||||
the_default Path.current (Option.map (Path.dir o #1 o #master) d);
|
the_default Path.current (Option.map (Path.dir o #1 o #master) d);
|
||||||
|
|
||||||
fun base_name s = Path.implode (Path.base (Path.explode s));
|
|
||||||
|
|
||||||
local
|
local
|
||||||
val global_thys =
|
val global_thys =
|
||||||
Synchronized.var "Thy_Info.thys"
|
Synchronized.var "Thy_Info.thys"
|
||||||
|
@ -88,7 +86,7 @@ fun get_thy name = get (get_thys ()) name;
|
||||||
|
|
||||||
val lookup_deps = Option.map #1 o lookup_thy;
|
val lookup_deps = Option.map #1 o lookup_thy;
|
||||||
|
|
||||||
val master_directory = master_dir o #1 o get_thy;
|
val master_directory = master_dir_deps o #1 o get_thy;
|
||||||
|
|
||||||
|
|
||||||
(* access theory *)
|
(* access theory *)
|
||||||
|
@ -130,8 +128,8 @@ val remove_thy = change_thys o remove;
|
||||||
|
|
||||||
fun update deps theory thys =
|
fun update deps theory thys =
|
||||||
let
|
let
|
||||||
val name = Context.theory_name theory;
|
val name = Context.theory_long_name theory;
|
||||||
val parents = map Context.theory_name (Theory.parents_of theory);
|
val parents = map Context.theory_long_name (Theory.parents_of theory);
|
||||||
|
|
||||||
val thys' = remove name thys;
|
val thys' = remove name thys;
|
||||||
val _ = map (get thys') parents;
|
val _ = map (get thys') parents;
|
||||||
|
@ -156,11 +154,10 @@ fun result_ord (Result {weight = i, ...}, Result {weight = j, ...}) = int_ord (j
|
||||||
|
|
||||||
fun join_theory (Result {theory, exec_id, ...}) =
|
fun join_theory (Result {theory, exec_id, ...}) =
|
||||||
let
|
let
|
||||||
(*toplevel proofs and diags*)
|
val _ = Execution.join [exec_id];
|
||||||
val _ = Future.join_tasks (maps Future.group_snapshot (Execution.peek exec_id));
|
val res = Exn.capture Thm.consolidate_theory theory;
|
||||||
(*fully nested proofs*)
|
val exns = maps Task_Queue.group_status (Execution.peek exec_id);
|
||||||
val res = Exn.capture Thm.join_theory_proofs theory;
|
in res :: map Exn.Exn exns end;
|
||||||
in res :: map Exn.Exn (maps Task_Queue.group_status (Execution.peek exec_id)) end;
|
|
||||||
|
|
||||||
datatype task =
|
datatype task =
|
||||||
Task of Path.T * string list * (theory list -> result) |
|
Task of Path.T * string list * (theory list -> result) |
|
||||||
|
@ -171,8 +168,6 @@ fun task_finished (Task _) = false
|
||||||
|
|
||||||
fun task_parents deps (parents: string list) = map (the o AList.lookup (op =) deps) parents;
|
fun task_parents deps (parents: string list) = map (the o AList.lookup (op =) deps) parents;
|
||||||
|
|
||||||
local
|
|
||||||
|
|
||||||
val schedule_seq =
|
val schedule_seq =
|
||||||
String_Graph.schedule (fn deps => fn (_, task) =>
|
String_Graph.schedule (fn deps => fn (_, task) =>
|
||||||
(case task of
|
(case task of
|
||||||
|
@ -224,12 +219,106 @@ val schedule_futures = Thread_Attributes.uninterruptible (fn _ => fn tasks =>
|
||||||
val _ = Par_Exn.release_all (results1 @ results2 @ results3 @ results4);
|
val _ = Par_Exn.release_all (results1 @ results2 @ results3 @ results4);
|
||||||
in () end);
|
in () end);
|
||||||
|
|
||||||
in
|
|
||||||
|
|
||||||
fun schedule_tasks tasks =
|
(* eval theory *)
|
||||||
if Multithreading.enabled () then schedule_futures tasks else schedule_seq tasks;
|
|
||||||
|
|
||||||
end;
|
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) 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 document symbols last_timing update_time master_dir header text_pos text parents =
|
||||||
|
let
|
||||||
|
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 toks = Token.explode keywords text_pos text;
|
||||||
|
val spans = Outer_Syntax.parse_spans toks;
|
||||||
|
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 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
|
||||||
|
val res = filter_out (Toplevel.is_ignored o #1) (maps Toplevel.join_results results);
|
||||||
|
in
|
||||||
|
if exists (Toplevel.is_skipped_proof o #2) res then
|
||||||
|
warning ("Cannot present theory with skipped proofs: " ^ quote name)
|
||||||
|
else
|
||||||
|
if document then let val tex_source = Thy_Output.present_thy thy res toks |> Buffer.content in Present.theory_output thy tex_source end else ()
|
||||||
|
end;
|
||||||
|
|
||||||
|
in (thy, present, size text) end;
|
||||||
|
|
||||||
|
|
||||||
(* require_thy -- checking database entries wrt. the file-system *)
|
(* require_thy -- checking database entries wrt. the file-system *)
|
||||||
|
@ -259,7 +348,7 @@ fun load_thy document symbols last_timing
|
||||||
|
|
||||||
val text_pos = Position.put_id (Document_ID.print exec_id) (Path.position thy_path);
|
val text_pos = Position.put_id (Document_ID.print exec_id) (Path.position thy_path);
|
||||||
val (theory, present, weight) =
|
val (theory, present, weight) =
|
||||||
Resources.load_thy document symbols last_timing update_time dir header text_pos text
|
eval_thy document symbols last_timing update_time dir header text_pos text
|
||||||
(if name = Context.PureN then [Context.the_global_context ()] else parents);
|
(if name = Context.PureN then [Context.the_global_context ()] else parents);
|
||||||
fun commit () = update_thy deps theory;
|
fun commit () = update_thy deps theory;
|
||||||
in
|
in
|
||||||
|
@ -286,44 +375,45 @@ fun check_deps dir name =
|
||||||
|
|
||||||
in
|
in
|
||||||
|
|
||||||
fun require_thys document symbols last_timing initiators dir strs tasks =
|
fun require_thys document symbols last_timing initiators qualifier dir strs tasks =
|
||||||
fold_map (require_thy document symbols last_timing initiators dir) strs tasks |>> forall I
|
fold_map (require_thy document symbols last_timing initiators qualifier dir) strs tasks
|
||||||
and require_thy document symbols last_timing initiators dir (str, require_pos) tasks =
|
|>> forall I
|
||||||
|
and require_thy document symbols last_timing initiators qualifier dir (s, require_pos) tasks =
|
||||||
let
|
let
|
||||||
val path = Path.expand (Path.explode str);
|
val {node_name, master_dir, theory_name} = Resources.import_name qualifier dir s;
|
||||||
val name = Path.implode (Path.base path);
|
|
||||||
val node_name = File.full_path dir (Resources.thy_path path);
|
|
||||||
fun check_entry (Task (node_name', _, _)) =
|
fun check_entry (Task (node_name', _, _)) =
|
||||||
if op = (apply2 File.platform_path (node_name, node_name'))
|
if op = (apply2 File.platform_path (node_name, node_name'))
|
||||||
then ()
|
then ()
|
||||||
else
|
else
|
||||||
error ("Incoherent imports for theory " ^ quote name ^
|
error ("Incoherent imports for theory " ^ quote theory_name ^
|
||||||
Position.here require_pos ^ ":\n" ^
|
Position.here require_pos ^ ":\n" ^
|
||||||
" " ^ Path.print node_name ^ "\n" ^
|
" " ^ Path.print node_name ^ "\n" ^
|
||||||
" " ^ Path.print node_name')
|
" " ^ Path.print node_name')
|
||||||
| check_entry _ = ();
|
| check_entry _ = ();
|
||||||
in
|
in
|
||||||
(case try (String_Graph.get_node tasks) name of
|
(case try (String_Graph.get_node tasks) theory_name of
|
||||||
SOME task => (check_entry task; (task_finished task, tasks))
|
SOME task => (check_entry task; (task_finished task, tasks))
|
||||||
| NONE =>
|
| NONE =>
|
||||||
let
|
let
|
||||||
val dir' = Path.append dir (Path.dir path);
|
val _ = member (op =) initiators theory_name andalso error (cycle_msg initiators);
|
||||||
val _ = member (op =) initiators name andalso error (cycle_msg initiators);
|
|
||||||
|
|
||||||
val (current, deps, theory_pos, imports, keywords) = check_deps dir' name
|
val (current, deps, theory_pos, imports, keywords) = check_deps master_dir theory_name
|
||||||
handle ERROR msg =>
|
handle ERROR msg =>
|
||||||
cat_error msg
|
cat_error msg
|
||||||
("The error(s) above occurred for theory " ^ quote name ^
|
("The error(s) above occurred for theory " ^ quote theory_name ^
|
||||||
Position.here require_pos ^ required_by "\n" initiators);
|
Position.here require_pos ^ required_by "\n" initiators);
|
||||||
|
|
||||||
val parents = map (base_name o #1) imports;
|
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') =
|
val (parents_current, tasks') =
|
||||||
require_thys document symbols last_timing (name :: initiators)
|
require_thys document symbols last_timing (theory_name :: initiators)
|
||||||
(Path.append dir (master_dir (Option.map #1 deps))) imports tasks;
|
qualifier' dir' imports tasks;
|
||||||
|
|
||||||
val all_current = current andalso parents_current;
|
val all_current = current andalso parents_current;
|
||||||
val task =
|
val task =
|
||||||
if all_current then Finished (get_theory name)
|
if all_current then Finished (get_theory theory_name)
|
||||||
else
|
else
|
||||||
(case deps of
|
(case deps of
|
||||||
NONE => raise Fail "Malformed deps"
|
NONE => raise Fail "Malformed deps"
|
||||||
|
@ -332,27 +422,29 @@ and require_thy document symbols last_timing initiators dir (str, require_pos) t
|
||||||
val update_time = serial ();
|
val update_time = serial ();
|
||||||
val load =
|
val load =
|
||||||
load_thy document symbols last_timing initiators update_time dep
|
load_thy document symbols last_timing initiators update_time dep
|
||||||
text (name, theory_pos) keywords;
|
text (theory_name, theory_pos) keywords;
|
||||||
in Task (node_name, parents, load) end);
|
in Task (node_name, parents, load) end);
|
||||||
|
|
||||||
val tasks'' = new_entry name parents task tasks';
|
val tasks'' = new_entry theory_name parents task tasks';
|
||||||
in (all_current, tasks'') end)
|
in (all_current, tasks'') end)
|
||||||
end;
|
end;
|
||||||
|
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
|
||||||
(* use_thy *)
|
(* use theories *)
|
||||||
|
|
||||||
fun use_theories {document, symbols, last_timing, master_dir} imports =
|
fun use_theories {document, symbols, last_timing, qualifier, master_dir} imports =
|
||||||
schedule_tasks
|
let
|
||||||
(snd (require_thys document symbols last_timing [] master_dir imports String_Graph.empty));
|
val (_, tasks) =
|
||||||
|
require_thys document symbols last_timing [] qualifier master_dir imports String_Graph.empty;
|
||||||
|
in if Multithreading.enabled () then schedule_futures tasks else schedule_seq tasks end;
|
||||||
|
|
||||||
val use_thys =
|
fun use_thy name =
|
||||||
use_theories
|
use_theories
|
||||||
{document = false, symbols = HTML.no_symbols, last_timing = K NONE, master_dir = Path.current};
|
{document = false, symbols = HTML.no_symbols, last_timing = K Time.zeroTime,
|
||||||
|
qualifier = Resources.default_qualifier, master_dir = Path.current}
|
||||||
val use_thy = use_thys o single;
|
[(name, Position.none)];
|
||||||
|
|
||||||
|
|
||||||
(* toplevel scripting -- without maintaining database *)
|
(* toplevel scripting -- without maintaining database *)
|
||||||
|
@ -371,7 +463,7 @@ fun script_thy pos txt thy =
|
||||||
|
|
||||||
fun register_thy theory =
|
fun register_thy theory =
|
||||||
let
|
let
|
||||||
val name = Context.theory_name theory;
|
val name = Context.theory_long_name theory;
|
||||||
val {master, ...} = Resources.check_thy (Resources.master_directory theory) name;
|
val {master, ...} = Resources.check_thy (Resources.master_directory theory) name;
|
||||||
val imports = Resources.imports_of theory;
|
val imports = Resources.imports_of theory;
|
||||||
in
|
in
|
||||||
|
@ -389,4 +481,4 @@ fun finish () = change_thys (String_Graph.map (fn _ => fn (_, entry) => (NONE, e
|
||||||
|
|
||||||
end;
|
end;
|
||||||
|
|
||||||
fun use_thy name = Runtime.toplevel_program (fn () => Thy_Info.use_thy (name, Position.none));
|
fun use_thy name = Runtime.toplevel_program (fn () => Thy_Info.use_thy name);
|
||||||
|
|
|
@ -44,13 +44,13 @@ struct
|
||||||
|
|
||||||
(** options **)
|
(** options **)
|
||||||
|
|
||||||
val display = Attrib.setup_option_bool ("thy_output_display", @{here});
|
val display = Attrib.setup_option_bool ("thy_output_display", \<^here>);
|
||||||
val break = Attrib.setup_option_bool ("thy_output_break", @{here});
|
val break = Attrib.setup_option_bool ("thy_output_break", \<^here>);
|
||||||
val quotes = Attrib.setup_option_bool ("thy_output_quotes", @{here});
|
val quotes = Attrib.setup_option_bool ("thy_output_quotes", \<^here>);
|
||||||
val margin = Attrib.setup_option_int ("thy_output_margin", @{here});
|
val margin = Attrib.setup_option_int ("thy_output_margin", \<^here>);
|
||||||
val indent = Attrib.setup_option_int ("thy_output_indent", @{here});
|
val indent = Attrib.setup_option_int ("thy_output_indent", \<^here>);
|
||||||
val source = Attrib.setup_option_bool ("thy_output_source", @{here});
|
val source = Attrib.setup_option_bool ("thy_output_source", \<^here>);
|
||||||
val modes = Attrib.setup_option_string ("thy_output_modes", @{here});
|
val modes = Attrib.setup_option_string ("thy_output_modes", \<^here>);
|
||||||
|
|
||||||
|
|
||||||
structure Wrappers = Proof_Data
|
structure Wrappers = Proof_Data
|
||||||
|
@ -169,7 +169,7 @@ fun eval_antiq state (opts, src) =
|
||||||
|
|
||||||
fun cmd ctxt = wrap ctxt (fn () => command src state ctxt) ();
|
fun cmd ctxt = wrap ctxt (fn () => command src state ctxt) ();
|
||||||
val _ = cmd preview_ctxt;
|
val _ = cmd preview_ctxt;
|
||||||
val print_modes = space_explode "," (Config.get print_ctxt modes) @ Latex.modes;
|
val print_modes = space_explode "," (Config.get print_ctxt modes) @ [Latex.latexN];
|
||||||
in Print_Mode.with_modes print_modes (fn () => cmd print_ctxt) () end;
|
in Print_Mode.with_modes print_modes (fn () => cmd print_ctxt) () end;
|
||||||
|
|
||||||
in
|
in
|
||||||
|
@ -591,7 +591,7 @@ fun pretty_type ctxt s =
|
||||||
let val Type (name, _) = Proof_Context.read_type_name {proper = true, strict = false} ctxt s
|
let val Type (name, _) = Proof_Context.read_type_name {proper = true, strict = false} ctxt s
|
||||||
in Pretty.str (Proof_Context.extern_type ctxt name) end;
|
in Pretty.str (Proof_Context.extern_type ctxt name) end;
|
||||||
|
|
||||||
fun pretty_prf full ctxt = Proof_Syntax.pretty_proof_of ctxt full;
|
fun pretty_prf full ctxt = Proof_Syntax.pretty_clean_proof_of ctxt full;
|
||||||
|
|
||||||
fun pretty_theory ctxt (name, pos) = (Theory.check ctxt (name, pos); Pretty.str name);
|
fun pretty_theory ctxt (name, pos) = (Theory.check ctxt (name, pos); Pretty.str name);
|
||||||
|
|
||||||
|
|
|
@ -219,7 +219,7 @@ fun check l_oid l =
|
||||||
META.check_export_code
|
META.check_export_code
|
||||||
(writeln o Mi)
|
(writeln o Mi)
|
||||||
(warning o Mi)
|
(warning o Mi)
|
||||||
(writeln o Markup.markup Markup.bad o Mi)
|
(fn s => writeln (Markup.markup (Markup.bad ()) (Mi s)))
|
||||||
(error o To_string0)
|
(error o To_string0)
|
||||||
(Ml (Mp I Me) l_oid)
|
(Ml (Mp I Me) l_oid)
|
||||||
((META.SS_base o META.ST) l)
|
((META.SS_base o META.ST) l)
|
||||||
|
@ -1061,7 +1061,7 @@ fun export_code_tmp_file seris g =
|
||||||
else
|
else
|
||||||
Isabelle_System.with_tmp_file tmp_name (Deep0.Find.ext ml_compiler))
|
Isabelle_System.with_tmp_file tmp_name (Deep0.Find.ext ml_compiler))
|
||||||
(fn filename =>
|
(fn filename =>
|
||||||
g (((((ml_compiler, ml_module), Path.implode filename), export_arg) :: accu)))
|
g (((((ml_compiler, ml_module), (Path.implode filename, Position.none)), export_arg) :: accu)))
|
||||||
end))
|
end))
|
||||||
seris
|
seris
|
||||||
(fn f => f [])
|
(fn f => f [])
|
||||||
|
@ -1082,7 +1082,7 @@ fun export_code_cmd' seris tmp_export_code f_err raw_cs thy =
|
||||||
let val v = Deep0.apply_hs_code_identifiers Deep0.Export_code_env.Haskell.argument thy in
|
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
|
if mem_scala then Code_printing.apply_code_printing v else v end) in
|
||||||
List_mapi
|
List_mapi
|
||||||
(fn i => fn seri => case seri of (((ml_compiler, _), filename), _) =>
|
(fn i => fn seri => case seri of (((ml_compiler, _), (filename, _)), _) =>
|
||||||
let val (l, (out, err)) =
|
let val (l, (out, err)) =
|
||||||
Deep0.Find.build
|
Deep0.Find.build
|
||||||
ml_compiler
|
ml_compiler
|
||||||
|
@ -1259,12 +1259,13 @@ fun f_command l_mode =
|
||||||
fun mk_fic s = Path.append tmp_export_code (Path.make [s])
|
fun mk_fic s = Path.append tmp_export_code (Path.make [s])
|
||||||
val () = Deep0.Find.check_compil ml_compiler ()
|
val () = Deep0.Find.check_compil ml_compiler ()
|
||||||
val () = Isabelle_System.mkdirs tmp_export_code in
|
val () = Isabelle_System.mkdirs tmp_export_code in
|
||||||
((( (ml_compiler, ml_module)
|
(( ( (ml_compiler, ml_module)
|
||||||
, Path.implode (if Deep0.Find.export_mode ml_compiler = Deep0.Export_code_env.Directory then
|
, ( Path.implode (if Deep0.Find.export_mode ml_compiler = Deep0.Export_code_env.Directory then
|
||||||
tmp_export_code
|
tmp_export_code
|
||||||
else
|
else
|
||||||
mk_fic (Deep0.Find.function ml_compiler (Deep0.Find.ext ml_compiler))))
|
mk_fic (Deep0.Find.function ml_compiler (Deep0.Find.ext ml_compiler)))
|
||||||
, export_arg), mk_fic)
|
, Position.none))
|
||||||
|
, export_arg), mk_fic)
|
||||||
end)
|
end)
|
||||||
(List.filter (fn (("self", _), _) => false | _ => true) (#seri_args i_deep))
|
(List.filter (fn (("self", _), _) => false | _ => true) (#seri_args i_deep))
|
||||||
val _ =
|
val _ =
|
||||||
|
@ -1337,7 +1338,7 @@ let open Generation_mode
|
||||||
:: []))
|
:: []))
|
||||||
|> Deep.export_code_cmd' seri_args
|
|> Deep.export_code_cmd' seri_args
|
||||||
tmp_export_code
|
tmp_export_code
|
||||||
(fn (((_, _), msg), _) => fn err => if err <> 0 then error msg else ())
|
(fn (((_, _), (msg, _)), _) => fn err => if err <> 0 then error msg else ())
|
||||||
[name_main]
|
[name_main]
|
||||||
end
|
end
|
||||||
in
|
in
|
||||||
|
@ -1382,7 +1383,7 @@ local
|
||||||
fun fold_thy_shallow f =
|
fun fold_thy_shallow f =
|
||||||
META.fold_thy_shallow
|
META.fold_thy_shallow
|
||||||
(fn f => f () handle ERROR e =>
|
(fn f => f () handle ERROR e =>
|
||||||
( warning "Shallow Backtracking: (true) Isabelle declarations occuring among the META-simulated ones are ignored (if any)"
|
( 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,
|
(* TODO automatically determine if there is such Isabelle declarations,
|
||||||
for raising earlier a specific error message *)
|
for raising earlier a specific error message *)
|
||||||
; error e))
|
; error e))
|
||||||
|
|
|
@ -43,10 +43,10 @@ section\<open>Basic Extension of the Standard Library (Depending on RBT)\<close>
|
||||||
|
|
||||||
theory Init_rbt
|
theory Init_rbt
|
||||||
imports "../../Init"
|
imports "../../Init"
|
||||||
"~~/src/HOL/Library/RBT"
|
"HOL-Library.RBT"
|
||||||
"~~/src/HOL/Library/Char_ord"
|
"HOL-Library.Char_ord"
|
||||||
"~~/src/HOL/Library/List_lexord"
|
"HOL-Library.List_lexord"
|
||||||
"~~/src/HOL/Library/Product_Lexorder"
|
"HOL-Library.Product_Lexorder"
|
||||||
begin
|
begin
|
||||||
|
|
||||||
locale RBT
|
locale RBT
|
||||||
|
|
|
@ -401,7 +401,7 @@
|
||||||
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
|
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,%
|
classoffset=2,%
|
||||||
keywordstyle=\color{Blue}\textbf,%
|
keywordstyle=\color{Blue}\textbf,%
|
||||||
morekeywords={axclass,class,instance,recdef,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},%
|
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,%
|
classoffset=3,%
|
||||||
keywordstyle=\color{BrickRed}\textbf,%
|
keywordstyle=\color{BrickRed}\textbf,%
|
||||||
morekeywords={oops,sorry},%
|
morekeywords={oops,sorry},%
|
||||||
|
|
Loading…
Reference in New Issue