| author | wenzelm | 
| Fri, 16 Sep 2022 14:57:48 +0200 | |
| changeset 76170 | 5912209b4fb6 | 
| parent 74561 | 8e6c973003c8 | 
| child 77723 | b761c91c2447 | 
| permissions | -rw-r--r-- | 
| 59901 | 1 | (* Title: Pure/Isar/experiment.ML | 
| 2 | Author: Makarius | |
| 3 | ||
| 4 | Target for specification experiments that are mostly private. | |
| 5 | *) | |
| 6 | ||
| 7 | signature EXPERIMENT = | |
| 8 | sig | |
| 69087 
06017b2c4552
suppress aux. locales from command 'experiment' -- avoid crash of theory Dict_Construction.Test_Dict_Construction (AFP);
 wenzelm parents: 
59923diff
changeset | 9 | val is_experiment: theory -> string -> bool | 
| 59901 | 10 | val experiment: Element.context_i list -> theory -> Binding.scope * local_theory | 
| 11 | val experiment_cmd: Element.context list -> theory -> Binding.scope * local_theory | |
| 12 | end; | |
| 13 | ||
| 14 | structure Experiment: EXPERIMENT = | |
| 15 | struct | |
| 16 | ||
| 69087 
06017b2c4552
suppress aux. locales from command 'experiment' -- avoid crash of theory Dict_Construction.Test_Dict_Construction (AFP);
 wenzelm parents: 
59923diff
changeset | 17 | structure Data = Theory_Data | 
| 
06017b2c4552
suppress aux. locales from command 'experiment' -- avoid crash of theory Dict_Construction.Test_Dict_Construction (AFP);
 wenzelm parents: 
59923diff
changeset | 18 | ( | 
| 
06017b2c4552
suppress aux. locales from command 'experiment' -- avoid crash of theory Dict_Construction.Test_Dict_Construction (AFP);
 wenzelm parents: 
59923diff
changeset | 19 | type T = Symtab.set; | 
| 
06017b2c4552
suppress aux. locales from command 'experiment' -- avoid crash of theory Dict_Construction.Test_Dict_Construction (AFP);
 wenzelm parents: 
59923diff
changeset | 20 | val empty = Symtab.empty; | 
| 
06017b2c4552
suppress aux. locales from command 'experiment' -- avoid crash of theory Dict_Construction.Test_Dict_Construction (AFP);
 wenzelm parents: 
59923diff
changeset | 21 | val merge = Symtab.merge (K true); | 
| 
06017b2c4552
suppress aux. locales from command 'experiment' -- avoid crash of theory Dict_Construction.Test_Dict_Construction (AFP);
 wenzelm parents: 
59923diff
changeset | 22 | ); | 
| 
06017b2c4552
suppress aux. locales from command 'experiment' -- avoid crash of theory Dict_Construction.Test_Dict_Construction (AFP);
 wenzelm parents: 
59923diff
changeset | 23 | |
| 
06017b2c4552
suppress aux. locales from command 'experiment' -- avoid crash of theory Dict_Construction.Test_Dict_Construction (AFP);
 wenzelm parents: 
59923diff
changeset | 24 | fun is_experiment thy name = Symtab.defined (Data.get thy) name; | 
| 
06017b2c4552
suppress aux. locales from command 'experiment' -- avoid crash of theory Dict_Construction.Test_Dict_Construction (AFP);
 wenzelm parents: 
59923diff
changeset | 25 | |
| 59901 | 26 | fun gen_experiment add_locale elems thy = | 
| 27 | let | |
| 59919 
fe1d8576b483
clarified name space policy: show less stuff in usual print functions;
 wenzelm parents: 
59901diff
changeset | 28 |     val experiment_name = Binding.name ("experiment" ^ serial_string ()) |> Binding.concealed;
 | 
| 69087 
06017b2c4552
suppress aux. locales from command 'experiment' -- avoid crash of theory Dict_Construction.Test_Dict_Construction (AFP);
 wenzelm parents: 
59923diff
changeset | 29 | val lthy = | 
| 
06017b2c4552
suppress aux. locales from command 'experiment' -- avoid crash of theory Dict_Construction.Test_Dict_Construction (AFP);
 wenzelm parents: 
59923diff
changeset | 30 | thy | 
| 72536 
589645894305
bundle mixins for locale and class specifications
 haftmann parents: 
69087diff
changeset | 31 | |> add_locale experiment_name Binding.empty [] ([], []) elems | 
| 69087 
06017b2c4552
suppress aux. locales from command 'experiment' -- avoid crash of theory Dict_Construction.Test_Dict_Construction (AFP);
 wenzelm parents: 
59923diff
changeset | 32 | |-> (Local_Theory.background_theory o Data.map o Symtab.insert_set); | 
| 59901 | 33 | val (scope, naming) = | 
| 34 | Name_Space.new_scope (Proof_Context.naming_of (Local_Theory.target_of lthy)); | |
| 59923 
b21c82422d65
support private scope for individual local theory commands;
 wenzelm parents: 
59919diff
changeset | 35 | val naming' = naming |> Name_Space.private_scope scope; | 
| 59919 
fe1d8576b483
clarified name space policy: show less stuff in usual print functions;
 wenzelm parents: 
59901diff
changeset | 36 | val lthy' = lthy | 
| 
fe1d8576b483
clarified name space policy: show less stuff in usual print functions;
 wenzelm parents: 
59901diff
changeset | 37 | |> Local_Theory.map_contexts (K (Proof_Context.map_naming (K naming'))) | 
| 
fe1d8576b483
clarified name space policy: show less stuff in usual print functions;
 wenzelm parents: 
59901diff
changeset | 38 | |> Local_Theory.map_background_naming Name_Space.concealed; | 
| 59901 | 39 | in (scope, lthy') end; | 
| 40 | ||
| 41 | val experiment = gen_experiment Expression.add_locale; | |
| 42 | val experiment_cmd = gen_experiment Expression.add_locale_cmd; | |
| 43 | ||
| 44 | end; |