Browse Source

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
master
Frédéric Tuong 5 years ago
parent
commit
208bb30780
  1. 3
      README_advanced.txt
  2. 6
      ROOT
  3. 2
      examples/Employee_Model/Analysis/Analysis_UML.thy
  4. 2
      examples/Employee_Model/Design/Design_UML.thy
  5. 2
      examples/archive/Isabelle_Finite_Set.thy
  6. 2
      examples/archive/Monads.thy
  7. 6
      src/UML_Types.thy
  8. 2
      src/collection_types/UML_Bag.thy
  9. 2
      src/collection_types/UML_Set.thy
  10. 4
      src/compiler/Aux_text.thy
  11. 2
      src/compiler/Core.thy
  12. 23
      src/compiler/Generator_dynamic_parallel.thy
  13. 23
      src/compiler/Generator_dynamic_sequential.thy
  14. 8
      src/compiler/Init_rbt.thy
  15. 2
      src/compiler_generic/Init.thy
  16. 7
      src/compiler_generic/ROOT
  17. 50
      src/compiler_generic/isabelle_home/src/Tools/Code/Isabelle_code_runtime.thy
  18. 10
      src/compiler_generic/isabelle_home/src/Tools/Code/Isabelle_code_target.thy
  19. 4
      src/compiler_generic/isabelle_para/src/Pure/Isar/outer_syntax.ML
  20. 42
      src/compiler_generic/isabelle_para/src/Pure/Isar/toplevel.ML
  21. 13
      src/compiler_generic/isabelle_para/src/Pure/PIDE/command.ML
  22. 283
      src/compiler_generic/isabelle_para/src/Pure/PIDE/resources.ML
  23. 190
      src/compiler_generic/isabelle_para/src/Pure/Thy/thy_info.ML
  24. 18
      src/compiler_generic/isabelle_para/src/Pure/Thy/thy_output.ML
  25. 23
      src/compiler_generic/toy_example/embedding/Generator_dynamic_sequential.thy
  26. 8
      src/compiler_generic/toy_example/embedding/Init_rbt.thy
  27. 2
      src/document/lstisar.sty

3
README_advanced.txt

@ -54,7 +54,7 @@ Isabelle (version 3.6) mentions:
of their own. No starting spaces, nothing after it."
In particular, it is not advised to put these tags in a single line:
\isatagafp ... \endisatagafp % wrong
otherwise as side effects some parts 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
separate line:
\isatagafp
@ -78,6 +78,7 @@ are close to not debug-able.
List of Isabelle versions to use depending on revisions:
=========================================================
2018/02/05 revision 13265: Isabelle2017 (October 2017)
2018/01/29 revision 13259: Isabelle2016-1 (December 2016)
2016/02/22 revision 12439: Isabelle2016 (February 2016)
2015/06/11 revision 11691: Isabelle2015 (May 2015)

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) *}
options [quick_and_dirty,document=pdf,document_output=document_generated,
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) *}
options [document=pdf,document_output=document_generated,
document_variants="document=noexample,-afp,-annexa",
@ -189,7 +189,7 @@ session "FOCL" in "src" = HOL +
"root.tex"
"FOCL_Syntax.tex"
session "FOCL-dirty" in "src" = HOL +
session "FOCL-dirty" in "src" = "HOL-Library" +
description {* Featherweight OCL (Compiler) *}
options [quick_and_dirty,document=pdf,document_output=document_generated,
document_variants="document=noexample,-afp,-annexa",

2
examples/Employee_Model/Analysis/Analysis_UML.thy

@ -637,7 +637,7 @@ by(simp add: OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny
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
functions into the object universes; we show that this is sufficient ``characterization.'' *}

2
examples/Employee_Model/Design/Design_UML.thy

@ -626,7 +626,7 @@ by(simp add: OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny
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
functions into the object universes; we show that this is sufficient ``characterization.'' *}

2
examples/archive/Isabelle_Finite_Set.thy

@ -122,7 +122,7 @@ like validity, not emptiness, finiteness...
Since the first hypothesis of @{text comp_fun_commute.fold_insert} is too general,
in order to replace it by another weaker locale we have the choice between
reusing the @{term comp_fun_commute} locale or whether completely defining a new locale.
Because elements 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.
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}. *}

2
examples/archive/Monads.thy

@ -409,7 +409,7 @@ lemma mbind_unit [simp]:
text{* The characteristic property of @{term mbind} --- which distinguishes it from
@{text mbind'} defined in the sequel --- is that it never fails; it ``swallows'' internal
errors occuring during the computation. *}
errors occurring during the computation. *}
lemma mbind_nofailure [simp]:
"mbind S f \<sigma> \<noteq> None"
apply(rule_tac x=\<sigma> in spec)

6
src/UML_Types.thy

@ -47,7 +47,7 @@
chapter{* Formalization I: OCL Types and Core Definitions \label{sec:focl-types}*}
theory UML_Types
imports Transcendental (* Testing *)
imports HOL.Transcendental (* Testing *)
keywords "Assert" :: thy_decl
and "Assert_local" :: thy_decl
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"
(Parse.term >> (fn elems_concl => theory (fn thy =>
case
lemma "code_unfold" (Specification.theorem true)
lemma "nbe" (Specification.theorem true)
(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
open HOLogic in
if Sign.typ_equiv thy (fastype_of expr, @{typ "prop"}) then

2
src/collection_types/UML_Bag.thy

@ -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
we can have in Featherweight OCL Bags containing all possible elements of a type, not only
those (finite) ones representable in a state. This holds for base types as well as class types,
although the notion for class-types --- involving object id's not occuring in a state ---
although the notion for class-types --- involving object id's not occurring in a state ---
requires some care.
In a world with @{term invalid} and @{term null}, there are two notions extensions possible:

2
src/collection_types/UML_Set.thy

@ -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
we can have in Featherweight OCL Sets containing all possible elements of a type, not only
those (finite) ones representable in a state. This holds for base types as well as class types,
although the notion for class-types --- involving object id's not occuring in a state ---
although the notion for class-types --- involving object id's not occurring in a state ---
requires some care.
In a world with @{term invalid} and @{term null}, there are two notions extensions possible:

4
src/compiler/Aux_text.thy

@ -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
two operations to declare and to provide two overloading definitions for the two static types.
\<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
functions into the object universes; we show that this is sufficient ``characterization.''\<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
two operations to declare and to provide two overloading definitions for the two static types.
\<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
functions into the object universes; we show that this is sufficient ``characterization.''\<close>
lazy_text\<open>\label{sec:eam-accessors}\<close>

2
src/compiler/Core.thy

@ -434,7 +434,7 @@ two operations to declare and to provide two overloading definitions for the two
, [ section \<open>OclAllInstances\<close>
, 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
functions into the object universes; we show that this is sufficient ``characterization.'' \<close> ]
, PRINT_allinst_def_id

23
src/compiler/Generator_dynamic_parallel.thy

@ -200,7 +200,7 @@ fun check l_oid l =
META.check_export_code
(writeln 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)
(Ml (Mp I Me) l_oid)
((META.SS_base o META.ST) l)
@ -1042,7 +1042,7 @@ fun export_code_tmp_file seris g =
else
Isabelle_System.with_tmp_file tmp_name (Deep0.Find.ext ml_compiler))
(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))
seris
(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
if mem_scala then Code_printing.apply_code_printing v else v end) in
List_mapi
(fn i => fn seri => case seri of (((ml_compiler, _), filename), _) =>
(fn i => fn seri => case seri of (((ml_compiler, _), (filename, _)), _) =>
let val (l, (out, err)) =
Deep0.Find.build
ml_compiler
@ -1240,12 +1240,13 @@ fun f_command l_mode =
fun mk_fic s = Path.append tmp_export_code (Path.make [s])
val () = Deep0.Find.check_compil ml_compiler ()
val () = Isabelle_System.mkdirs tmp_export_code in
((( (ml_compiler, ml_module)
, Path.implode (if Deep0.Find.export_mode ml_compiler = Deep0.Export_code_env.Directory then
tmp_export_code
else
mk_fic (Deep0.Find.function ml_compiler (Deep0.Find.ext ml_compiler))))
, export_arg), mk_fic)
(( ( (ml_compiler, ml_module)
, ( Path.implode (if Deep0.Find.export_mode ml_compiler = Deep0.Export_code_env.Directory then
tmp_export_code
else
mk_fic (Deep0.Find.function ml_compiler (Deep0.Find.ext ml_compiler)))
, Position.none))
, export_arg), mk_fic)
end)
(List.filter (fn (("self", _), _) => false | _ => true) (#seri_args i_deep))
val _ =
@ -1318,7 +1319,7 @@ let open Generation_mode
:: []))
|> Deep.export_code_cmd' seri_args
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]
end
in
@ -1363,7 +1364,7 @@ local
fun fold_thy_shallow f =
META.fold_thy_shallow
(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,
for raising earlier a specific error message *)
; error e))

23
src/compiler/Generator_dynamic_sequential.thy

@ -224,7 +224,7 @@ fun check l_oid l =
META.check_export_code
(writeln 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)
(Ml (Mp I Me) l_oid)
((META.SS_base o META.ST) l)
@ -1066,7 +1066,7 @@ fun export_code_tmp_file seris g =
else
Isabelle_System.with_tmp_file tmp_name (Deep0.Find.ext ml_compiler))
(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))
seris
(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
if mem_scala then Code_printing.apply_code_printing v else v end) in
List_mapi
(fn i => fn seri => case seri of (((ml_compiler, _), filename), _) =>
(fn i => fn seri => case seri of (((ml_compiler, _), (filename, _)), _) =>
let val (l, (out, err)) =
Deep0.Find.build
ml_compiler
@ -1264,12 +1264,13 @@ fun f_command l_mode =
fun mk_fic s = Path.append tmp_export_code (Path.make [s])
val () = Deep0.Find.check_compil ml_compiler ()
val () = Isabelle_System.mkdirs tmp_export_code in
((( (ml_compiler, ml_module)
, Path.implode (if Deep0.Find.export_mode ml_compiler = Deep0.Export_code_env.Directory then
tmp_export_code
else
mk_fic (Deep0.Find.function ml_compiler (Deep0.Find.ext ml_compiler))))
, export_arg), mk_fic)
(( ( (ml_compiler, ml_module)
, ( Path.implode (if Deep0.Find.export_mode ml_compiler = Deep0.Export_code_env.Directory then
tmp_export_code
else
mk_fic (Deep0.Find.function ml_compiler (Deep0.Find.ext ml_compiler)))
, Position.none))
, export_arg), mk_fic)
end)
(List.filter (fn (("self", _), _) => false | _ => true) (#seri_args i_deep))
val _ =
@ -1342,7 +1343,7 @@ let open Generation_mode
:: []))
|> Deep.export_code_cmd' seri_args
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]
end
in
@ -1387,7 +1388,7 @@ local
fun fold_thy_shallow f =
META.fold_thy_shallow
(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,
for raising earlier a specific error message *)
; error e))

8
src/compiler/Init_rbt.thy

@ -48,10 +48,10 @@ section\<open>Basic Extension of the Standard Library (Depending on RBT)\<close>
theory Init_rbt
imports "../compiler_generic/Init"
"~~/src/HOL/Library/RBT"
"~~/src/HOL/Library/Char_ord"
"~~/src/HOL/Library/List_lexord"
"~~/src/HOL/Library/Product_Lexorder"
"HOL-Library.RBT"
"HOL-Library.Char_ord"
"HOL-Library.List_lexord"
"HOL-Library.Product_Lexorder"
begin
locale RBT

2
src/compiler_generic/Init.thy

@ -40,7 +40,7 @@
******************************************************************************)
theory Init
imports "~~/src/HOL/Library/Code_Char"
imports "HOL-Library.Code_Char"
"isabelle_home/src/HOL/Isabelle_Main0"
begin

7
src/compiler_generic/ROOT

@ -74,8 +74,13 @@ session Isabelle_Meta_Model (AFP) = "HOL-Library" +
"toy_example/embedding/Generator_dynamic_sequential"
"toy_example/generator/Design_deep"
"toy_example/generator/Design_shallow"
"toy_example/document_generated/Design_generated_generated"
"document/Rail"
theories
(* This part ensures that generated theories are accepted:
in general, if X..._generated_generated.thy is wellformed
then we also have X..._generated.thy wellformed *)
"toy_example/document_generated/Design_generated"
"toy_example/document_generated/Design_generated_generated"
document_files
"root.bib"
"root.tex"

50
src/compiler_generic/isabelle_home/src/Tools/Code/Isabelle_code_runtime.thy

@ -56,7 +56,7 @@ Runtime services building on code generation into implementation language SML.
open Basic_Code_Symbol;
(** computation **)
(** ML compiler as evaluation environment **)
(* 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! **)
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
val thy = Proof_Context.theory_of ctxt;
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 consts = constrs @ functions;
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));
in
thy
@ -209,12 +245,12 @@ val _ =
Outer_Syntax.command @{command_keyword code_reflect'}
"enrich runtime environment with generated code"
(Scan.optional (@{keyword "open"} |-- Scan.succeed true) false --
Parse.name -- Scan.optional (@{keyword "datatypes"} |-- Parse.!!! (parse_datatype
Parse.name -- Scan.optional (@{keyword "datatypes"} |-- Parse.!!! (parse_datatype
::: Scan.repeat (@{keyword "and"} |-- parse_datatype))) []
-- Scan.optional (@{keyword "functions"} |-- Parse.!!! (Scan.repeat1 Parse.name)) []
-- Scan.option (@{keyword "file"} |-- Parse.!!! Parse.name)
>> (fn ((((all_public, module_name), raw_datatypes), raw_functions), some_file) => Toplevel.theory
(code_reflect_cmd all_public raw_datatypes raw_functions module_name some_file)))
(code_reflect_cmd all_public raw_datatypes raw_functions module_name some_file)));
end; (*local*)

10
src/compiler_generic/isabelle_home/src/Tools/Code/Isabelle_code_target.thy

@ -98,8 +98,14 @@ val parse_inst_ident = Parse.name --| @{keyword "::"} -- Parse.class;
(* code generation *)
fun prep_destination "" = NONE
| prep_destination s = SOME (Path.explode s);
fun prep_destination (s, pos) =
if s = "" then NONE
else
let
val _ = Position.report pos Markup.language_path;
val path = Path.explode s;
val _ = Position.report pos (Markup.path (Path.smart_implode path));
in SOME path end;
fun export_code_cmd all_public raw_cs seris ctxt =

4
src/compiler_generic/isabelle_para/src/Pure/Isar/outer_syntax.ML

@ -193,7 +193,7 @@ val local_theory_to_proof = local_theory_command Toplevel.local_theory_to_proof;
(* parse commands *)
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
@ -340,7 +340,7 @@ fun check_command ctxt (name, pos) =
(* 'ML' command -- required for bootstrapping Isar *)
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 =>
Toplevel.generic_theory
(ML_Context.exec (fn () =>

42
src/compiler_generic/isabelle_para/src/Pure/Isar/toplevel.ML

@ -79,8 +79,8 @@ sig
val exec_id: Document_ID.exec -> transitions -> transitions
val setmp_thread_position: transition -> ('a -> 'b) -> 'a -> 'b
val add_hook: (transition -> state -> state -> unit) -> unit
val get_timing: transition -> Time.time option
val put_timing: Time.time option -> transition -> transition
val get_timing: transition -> Time.time
val put_timing: Time.time -> transition -> transition
val transition: bool -> transition -> state -> state * (exn * string) option
val command_errors: bool -> transition -> state -> Runtime.error list * state option
val command_exception: bool -> transition -> state -> state
@ -296,7 +296,7 @@ datatype state_write = Store_backup | Store_default
datatype transition = Transition of
{name: string, (*command name*)
pos: Position.T, (*source position*)
timing: Time.time option, (*prescient timing information*)
timing: Time.time, (*prescient timing information*)
trans: trans list, (*primitive transitions (union)*)
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}) =
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 *)
@ -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 present_local_theory target = present_transaction (fn int =>
fun present_local_theory target = present_transaction (fn _ =>
(fn Theory (gthy, _) =>
let val (finish, lthy) = Named_Target.switch target gthy;
in Theory (finish lthy, SOME lthy) end
@ -581,7 +581,7 @@ fun put_timing timing = map_transition (fn (name, pos, _, trans, read_write) =>
local
fun app int (tr as Transition {name, trans, ...}) =
fun app int (tr as Transition {trans, ...}) =
setmp_thread_position tr (fn state =>
let
val timing_start = Timing.start ();
@ -622,7 +622,7 @@ end;
fun command_errors int tr st =
(case transition int tr st of
(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 =
(case transition int tr st of
@ -677,19 +677,9 @@ structure Result = Proof_Data
val get_result = Result.get o Proof.context_of;
val put_result = Proof.map_context o Result.put;
fun timing_estimate include_head elem =
let
val trs = Thy_Syntax.flat_element elem |> not include_head ? tl;
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 timing_estimate elem =
let val trs = tl (Thy_Syntax.flat_element elem)
in fold (fn tr => fn t => get_timing tr + t) trs Time.zeroTime end;
fun proof_future_enabled estimate st =
(case try proof_of st of
@ -698,18 +688,14 @@ fun proof_future_enabled estimate st =
not (Proof.is_relevant state) andalso
(if can (Proof.assert_bottom true) state
then Goal.future_enabled 1
else
(case estimate of
NONE => Goal.future_enabled 2
| SOME t => Goal.future_enabled_timing t)));
else Goal.future_enabled 2 orelse Goal.future_enabled_timing estimate));
fun atom_result keywords tr st =
let
val st' =
if Goal.future_enabled 1 andalso Keyword.is_diag keywords (name_of tr) then
(Execution.fork
{name = "Toplevel.diag", pos = pos_of tr,
pri = priority (timing_estimate true (Thy_Syntax.atom tr))}
{name = "Toplevel.diag", pos = pos_of tr, pri = ~1}
(fn () => command tr st); st)
else command tr st;
in (Result (tr, st'), st') end;
@ -721,7 +707,7 @@ fun element_result keywords (Thy_Syntax.Element (tr, NONE)) st = atom_result key
let
val (head_result, st') = atom_result keywords head_tr st;
val (body_elems, end_tr) = element_rest;
val estimate = timing_estimate false elem;
val estimate = timing_estimate elem;
in
if not (proof_future_enabled estimate st')
then
@ -736,7 +722,7 @@ fun element_result keywords (Thy_Syntax.Element (tr, NONE)) st = atom_result key
val future_proof =
Proof.future_proof (fn state =>
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 () =>
let
val State (SOME (Proof (prf, (_, orig_gthy))), prev, backup) = st';

13
src/compiler_generic/isabelle_para/src/Pure/PIDE/command.ML

@ -12,6 +12,7 @@ sig
val read: Keyword.keywords -> theory -> Path.T-> (unit -> theory) ->
blob list * int -> Token.T list -> Toplevel.transitions
type eval
val eval_exec_id: eval -> Document_ID.exec
val eval_eq: eval * eval -> bool
val eval_running: eval -> bool
val eval_finished: eval -> bool
@ -116,7 +117,7 @@ fun reports_of_token keywords tok =
Input.source_explode (Token.input_of tok)
|> map_filter (fn (sym, pos) =>
if Symbol.is_malformed sym
then SOME ((pos, Markup.bad), "Malformed symbolic character") else NONE);
then SOME ((pos, Markup.bad ()), "Malformed symbolic character") else NONE);
val is_malformed = Token.is_error tok orelse not (null malformed_symbols);
val reports = Token.reports keywords tok @ Token.completion_report tok @ malformed_symbols;
in (is_malformed, reports) end;
@ -201,7 +202,7 @@ fun check_cmts span tr st' =
(Thy_Output.output_text st' {markdown = false} (Token.input_of cmt); [])
handle 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 =
Toplevel.setmp_thread_position tr (fn () => Output.report [Markup.markup_only m]) ();
@ -242,7 +243,7 @@ fun eval_state' keywords span tr state =
let
val _ = status tr Markup.failed;
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
| SOME st' =>
let
@ -274,7 +275,7 @@ fun eval keywords master_dir init blobs_info span eval0 =
(fn () =>
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 {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;
@ -303,7 +304,7 @@ fun print_error tr opt_context e =
(Toplevel.setmp_thread_position tr o Runtime.controlled_execution opt_context) e ()
handle exn =>
if Exn.is_interrupt exn then Exn.reraise exn
else List.app (Future.error_message (Toplevel.pos_of tr)) (Runtime.exn_messages_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;
@ -332,7 +333,7 @@ fun print command_visible command_overlays keywords command_name eval old_prints
in
Print {
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;
fun bad_print name args exn =

283
src/compiler_generic/isabelle_para/src/Pure/PIDE/resources.ML

@ -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;

190
src/compiler_generic/isabelle_para/src/Pure/Thy/thy_info.ML

@ -16,10 +16,10 @@ sig
val use_theories:
{document: bool,
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
val use_thys: (string * Position.T) list -> unit
val use_thy: string * Position.T -> unit
val use_thy: string -> unit
val script_thy: Position.T -> string -> theory -> theory
val register_thy: theory -> unit
val finish: unit -> unit
@ -54,11 +54,9 @@ type deps =
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);
fun base_name s = Path.implode (Path.base (Path.explode s));
local
val global_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 master_directory = master_dir o #1 o get_thy;
val master_directory = master_dir_deps o #1 o get_thy;
(* access theory *)
@ -130,8 +128,8 @@ val remove_thy = change_thys o remove;
fun update deps theory thys =
let
val name = Context.theory_name theory;
val parents = map Context.theory_name (Theory.parents_of theory);
val name = Context.theory_long_name theory;
val parents = map Context.theory_long_name (Theory.parents_of theory);
val thys' = remove name thys;
val _ = map (get thys') parents;
@ -156,11 +154,10 @@ fun result_ord (Result {weight = i, ...}, Result {weight = j, ...}) = int_ord (j
fun join_theory (Result {theory, exec_id, ...}) =
let
(*toplevel proofs and diags*)
val _ = Future.join_tasks (maps Future.group_snapshot (Execution.peek exec_id));
(*fully nested proofs*)
val res = Exn.capture Thm.join_theory_proofs theory;
in res :: map Exn.Exn (maps Task_Queue.group_status (Execution.peek exec_id)) end;
val _ = Execution.join [exec_id];
val res = Exn.capture Thm.consolidate_theory theory;
val exns = maps Task_Queue.group_status (Execution.peek exec_id);
in res :: map Exn.Exn exns end;
datatype task =
Task of 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;
local
val schedule_seq =
String_Graph.schedule (fn deps => fn (_, task) =>
(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);
in () end);
in
fun schedule_tasks tasks =
if Multithreading.enabled () then schedule_futures tasks else schedule_seq tasks;
(* eval theory *)
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 *)
@ -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 (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);
fun commit () = update_thy deps theory;
in
@ -286,44 +375,45 @@ fun check_deps dir name =
in
fun require_thys document symbols last_timing initiators dir strs tasks =
fold_map (require_thy document symbols last_timing initiators dir) strs tasks |>> forall I
and require_thy document symbols last_timing initiators dir (str, require_pos) tasks =
fun require_thys document symbols last_timing initiators qualifier dir strs tasks =
fold_map (require_thy document symbols last_timing initiators qualifier dir) strs tasks
|>> forall I
and require_thy document symbols last_timing initiators qualifier dir (s, require_pos) tasks =
let
val path = Path.expand (Path.explode str);
val name = Path.implode (Path.base path);
val node_name = File.full_path dir (Resources.thy_path path);
val {node_name, master_dir, theory_name} = Resources.import_name qualifier dir s;
fun check_entry (Task (node_name', _, _)) =
if op = (apply2 File.platform_path (node_name, node_name'))
then ()
else
error ("Incoherent imports for theory " ^ quote name ^
error ("Incoherent imports for theory " ^ quote theory_name ^
Position.here require_pos ^ ":\n" ^
" " ^ Path.print node_name ^ "\n" ^
" " ^ Path.print node_name')
| check_entry _ = ();
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))
| NONE =>
let
val dir' = Path.append dir (Path.dir path);
val _ = member (op =) initiators name andalso error (cycle_msg initiators);
val _ = member (op =) initiators theory_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 =>
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);
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') =
require_thys document symbols last_timing (name :: initiators)
(Path.append dir (master_dir (Option.map #1 deps))) imports tasks;
require_thys document symbols last_timing (theory_name :: initiators)
qualifier' dir' imports tasks;
val all_current = current andalso parents_current;
val task =
if all_current then Finished (get_theory name)
if all_current then Finished (get_theory theory_name)
else
(case deps of
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 load =
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);
val tasks'' = new_entry name parents task tasks';
val tasks'' = new_entry theory_name parents task tasks';
in (all_current, tasks'') end)
end;
end;
(* use_thy *)
(* use theories *)
fun use_theories {document, symbols, last_timing, master_dir} imports =
schedule_tasks
(snd (require_thys document symbols last_timing [] master_dir imports String_Graph.empty));
fun use_theories {document, symbols, last_timing, qualifier, master_dir} imports =
let
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
{document = false, symbols = HTML.no_symbols, last_timing = K NONE, master_dir = Path.current};
val use_thy = use_thys o single;
{document = false, symbols = HTML.no_symbols, last_timing = K Time.zeroTime,
qualifier = Resources.default_qualifier, master_dir = Path.current}
[(name, Position.none)];
(* toplevel scripting -- without maintaining database *)
@ -371,7 +463,7 @@ fun script_thy pos txt thy =
fun register_thy theory =
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 imports = Resources.imports_of theory;
in
@ -389,4 +481,4 @@ fun finish () = change_thys (String_Graph.map (fn _ => fn (_, entry) => (NONE, e
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);

18
src/compiler_generic/isabelle_para/src/Pure/Thy/thy_output.ML

@ -44,13 +44,13 @@ struct
(** options **)
val display = Attrib.setup_option_bool ("thy_output_display", @{here});
val break = Attrib.setup_option_bool ("thy_output_break", @{here});
val quotes = Attrib.setup_option_bool ("thy_output_quotes", @{here});
val margin = Attrib.setup_option_int ("thy_output_margin", @{here});
val indent = Attrib.setup_option_int ("thy_output_indent", @{here});
val source = Attrib.setup_option_bool ("thy_output_source", @{here});
val modes = Attrib.setup_option_string ("thy_output_modes", @{here});
val display = Attrib.setup_option_bool ("thy_output_display", \<^here>);
val break = Attrib.setup_option_bool ("thy_output_break", \<^here>);
val quotes = Attrib.setup_option_bool ("thy_output_quotes", \<^here>);
val margin = Attrib.setup_option_int ("thy_output_margin", \<^here>);
val indent = Attrib.setup_option_int ("thy_output_indent", \<^here>);
val source = Attrib.setup_option_bool ("thy_output_source", \<^here>);
val modes = Attrib.setup_option_string ("thy_output_modes", \<^here>);
structure Wrappers = Proof_Data
@ -169,7 +169,7 @@ fun eval_antiq state (opts, src) =
fun cmd ctxt = wrap ctxt (fn () => command src state 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
@ -591,7 +591,7 @@ fun pretty_type 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;
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);

23
src/compiler_generic/toy_example/embedding/Generator_dynamic_sequential.thy

@ -219,7 +219,7 @@ fun check l_oid l =
META.check_export_code
(writeln 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)
(Ml (Mp I Me) l_oid)
((META.SS_base o META.ST) l)
@ -1061,7 +1061,7 @@ fun export_code_tmp_file seris g =
else
Isabelle_System.with_tmp_file tmp_name (Deep0.Find.ext ml_compiler))
(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))
seris
(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
if mem_scala then Code_printing.apply_code_printing v else v end) in
List_mapi
(fn i => fn seri => case seri of (((ml_compiler, _), filename), _) =>
(fn i => fn seri => case seri of (((ml_compiler, _), (filename, _)), _) =>
let val (l, (out, err)) =
Deep0.Find.build
ml_compiler
@ -1259,12 +1259,13 @@ fun f_command l_mode =
fun mk_fic s = Path.append tmp_export_code (Path.make [s])
val () = Deep0.Find.check_compil ml_compiler ()
val () = Isabelle_System.mkdirs tmp_export_code in
((( (ml_compiler, ml_module)
, Path.implode (if Deep0.Find.export_mode ml_compiler = Deep0.Export_code_env.Directory then
tmp_export_code
else
mk_fic (Deep0.Find.function ml_compiler (Deep0.Find.ext ml_compiler))))
, export_arg), mk_fic)
(( ( (ml_compiler, ml_module)
, ( Path.implode (if Deep0.Find.export_mode ml_compiler = Deep0.Export_code_env.Directory then
tmp_export_code
else
mk_fic (Deep0.Find.function ml_compiler (Deep0.Find.ext ml_compiler)))
, Position.none))
, export_arg), mk_fic)
end)
(List.filter (fn (("self", _), _) => false | _ => true) (#seri_args i_deep))
val _ =
@ -1337,7 +1338,7 @@ let open Generation_mode
:: []))
|> Deep.export_code_cmd' seri_args
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]
end
in
@ -1382,7 +1383,7 @@ local
fun fold_thy_shallow f =
META.fold_thy_shallow
(fn f => f () handle ERROR e =>
( warning "Shallow Backtracking: (true) Isabelle declarations occuring among the META-simulated ones are ignored (if any)"