| author | wenzelm | 
| Sat, 20 Aug 2022 17:25:55 +0200 | |
| changeset 75928 | fa8d9e5ef913 | 
| parent 75604 | 39df30349778 | 
| permissions | -rw-r--r-- | 
| 68090 | 1 | (* Title: Pure/Thy/export.ML | 
| 2 | Author: Makarius | |
| 3 | ||
| 68102 | 4 | Manage theory exports: compressed blobs. | 
| 68090 | 5 | *) | 
| 6 | ||
| 7 | signature EXPORT = | |
| 8 | sig | |
| 70051 | 9 | val report_export: theory -> Path.binding -> unit | 
| 70499 | 10 | type params = | 
| 11 |     {theory: theory, binding: Path.binding, executable: bool, compress: bool, strict: bool}
 | |
| 70991 
f9f7c34b7dd4
more scalable protocol_message: use XML.body directly (Output.output hook is not required);
 wenzelm parents: 
70907diff
changeset | 12 | val export_params: params -> XML.body -> unit | 
| 
f9f7c34b7dd4
more scalable protocol_message: use XML.body directly (Output.output hook is not required);
 wenzelm parents: 
70907diff
changeset | 13 | val export: theory -> Path.binding -> XML.body -> unit | 
| 
f9f7c34b7dd4
more scalable protocol_message: use XML.body directly (Output.output hook is not required);
 wenzelm parents: 
70907diff
changeset | 14 | val export_executable: theory -> Path.binding -> XML.body -> unit | 
| 70015 
c8e08d8ffb93
clarified signature: more explicit type Path.binding;
 wenzelm parents: 
70013diff
changeset | 15 | val export_file: theory -> Path.binding -> Path.T -> unit | 
| 
c8e08d8ffb93
clarified signature: more explicit type Path.binding;
 wenzelm parents: 
70013diff
changeset | 16 | val export_executable_file: theory -> Path.binding -> Path.T -> unit | 
| 70009 
435fb018e8ee
"export_code ... file_prefix ..." is the preferred way to produce output within the logical file-system within the theory context, as well as session exports;
 wenzelm parents: 
69788diff
changeset | 17 | val markup: theory -> Path.T -> Markup.T | 
| 
435fb018e8ee
"export_code ... file_prefix ..." is the preferred way to produce output within the logical file-system within the theory context, as well as session exports;
 wenzelm parents: 
69788diff
changeset | 18 | val message: theory -> Path.T -> string | 
| 68090 | 19 | end; | 
| 20 | ||
| 21 | structure Export: EXPORT = | |
| 22 | struct | |
| 23 | ||
| 69648 | 24 | (* export *) | 
| 25 | ||
| 70051 | 26 | fun report_export thy binding = | 
| 27 | let | |
| 28 | val theory_name = Context.theory_long_name thy; | |
| 29 | val (path, pos) = Path.dest_binding binding; | |
| 72511 
460d743010bc
clarified signature: overloaded "+" for Path.append;
 wenzelm parents: 
72103diff
changeset | 30 | val markup = Markup.export_path (Path.implode (Path.basic theory_name + path)); | 
| 70051 | 31 | in Context_Position.report_generic (Context.Theory thy) pos markup end; | 
| 32 | ||
| 70499 | 33 | type params = | 
| 34 |   {theory: theory, binding: Path.binding, executable: bool, compress: bool, strict: bool};
 | |
| 68105 | 35 | |
| 70991 
f9f7c34b7dd4
more scalable protocol_message: use XML.body directly (Output.output hook is not required);
 wenzelm parents: 
70907diff
changeset | 36 | fun export_params ({theory = thy, binding, executable, compress, strict}: params) body =
 | 
| 70051 | 37 | (report_export thy binding; | 
| 38 | (Output.try_protocol_message o Markup.export) | |
| 74166 | 39 |    {id = Position.id_of (Position.thread_data ()),
 | 
| 70051 | 40 | serial = serial (), | 
| 41 | theory_name = Context.theory_long_name thy, | |
| 70055 
36fb663145e5
type Path.binding may be empty: check later via proper_binding;
 wenzelm parents: 
70051diff
changeset | 42 | name = Path.implode_binding (tap Path.proper_binding binding), | 
| 70051 | 43 | executable = executable, | 
| 70499 | 44 | compress = compress, | 
| 73559 | 45 | strict = strict} [body]); | 
| 68090 | 46 | |
| 70991 
f9f7c34b7dd4
more scalable protocol_message: use XML.body directly (Output.output hook is not required);
 wenzelm parents: 
70907diff
changeset | 47 | fun export thy binding body = | 
| 70499 | 48 | export_params | 
| 70991 
f9f7c34b7dd4
more scalable protocol_message: use XML.body directly (Output.output hook is not required);
 wenzelm parents: 
70907diff
changeset | 49 |     {theory = thy, binding = binding, executable = false, compress = true, strict = true} body;
 | 
| 69788 | 50 | |
| 70991 
f9f7c34b7dd4
more scalable protocol_message: use XML.body directly (Output.output hook is not required);
 wenzelm parents: 
70907diff
changeset | 51 | fun export_executable thy binding body = | 
| 70499 | 52 | export_params | 
| 70991 
f9f7c34b7dd4
more scalable protocol_message: use XML.body directly (Output.output hook is not required);
 wenzelm parents: 
70907diff
changeset | 53 |     {theory = thy, binding = binding, executable = true, compress = true, strict = true} body;
 | 
| 70013 | 54 | |
| 70991 
f9f7c34b7dd4
more scalable protocol_message: use XML.body directly (Output.output hook is not required);
 wenzelm parents: 
70907diff
changeset | 55 | fun export_file thy binding file = | 
| 75604 
39df30349778
more scalable generated files and code export, using Bytes.T;
 wenzelm parents: 
74166diff
changeset | 56 | export thy binding (Bytes.contents_blob (Bytes.read file)); | 
| 70991 
f9f7c34b7dd4
more scalable protocol_message: use XML.body directly (Output.output hook is not required);
 wenzelm parents: 
70907diff
changeset | 57 | |
| 
f9f7c34b7dd4
more scalable protocol_message: use XML.body directly (Output.output hook is not required);
 wenzelm parents: 
70907diff
changeset | 58 | fun export_executable_file thy binding file = | 
| 75604 
39df30349778
more scalable generated files and code export, using Bytes.T;
 wenzelm parents: 
74166diff
changeset | 59 | export_executable thy binding (Bytes.contents_blob (Bytes.read file)); | 
| 68090 | 60 | |
| 69648 | 61 | |
| 62 | (* information message *) | |
| 63 | ||
| 70009 
435fb018e8ee
"export_code ... file_prefix ..." is the preferred way to produce output within the logical file-system within the theory context, as well as session exports;
 wenzelm parents: 
69788diff
changeset | 64 | fun markup thy path = | 
| 
435fb018e8ee
"export_code ... file_prefix ..." is the preferred way to produce output within the logical file-system within the theory context, as well as session exports;
 wenzelm parents: 
69788diff
changeset | 65 | let | 
| 72511 
460d743010bc
clarified signature: overloaded "+" for Path.append;
 wenzelm parents: 
72103diff
changeset | 66 | val thy_path = Path.basic (Context.theory_long_name thy) + path; | 
| 70009 
435fb018e8ee
"export_code ... file_prefix ..." is the preferred way to produce output within the logical file-system within the theory context, as well as session exports;
 wenzelm parents: 
69788diff
changeset | 67 | val name = (Markup.nameN, Path.implode thy_path); | 
| 69650 | 68 |   in Active.make_markup Markup.theory_exportsN {implicit = false, properties = [name]} end;
 | 
| 69648 | 69 | |
| 70009 
435fb018e8ee
"export_code ... file_prefix ..." is the preferred way to produce output within the logical file-system within the theory context, as well as session exports;
 wenzelm parents: 
69788diff
changeset | 70 | fun message thy path = | 
| 
435fb018e8ee
"export_code ... file_prefix ..." is the preferred way to produce output within the logical file-system within the theory context, as well as session exports;
 wenzelm parents: 
69788diff
changeset | 71 | "See " ^ Markup.markup (markup thy path) "theory exports"; | 
| 69648 | 72 | |
| 68090 | 73 | end; |