author | berghofe |
Wed, 04 May 2005 18:50:21 +0200 | |
changeset 15925 | f13f4694c36d |
parent 15801 | d2f5ca3c048d |
child 16436 | 7eb6b6cbd166 |
permissions | -rw-r--r-- |
6185 | 1 |
(* Title: Pure/context.ML |
2 |
ID: $Id$ |
|
3 |
Author: Markus Wenzel, TU Muenchen |
|
4 |
||
15801 | 5 |
Theory contexts. |
6185 | 6 |
*) |
7 |
||
8 |
signature BASIC_CONTEXT = |
|
9 |
sig |
|
10 |
val context: theory -> unit |
|
11 |
val the_context: unit -> theory |
|
12 |
end; |
|
13 |
||
14 |
signature CONTEXT = |
|
15 |
sig |
|
16 |
include BASIC_CONTEXT |
|
17 |
val get_context: unit -> theory option |
|
18 |
val set_context: theory option -> unit |
|
19 |
val reset_context: unit -> unit |
|
6238 | 20 |
val setmp: theory option -> ('a -> 'b) -> 'a -> 'b |
6310 | 21 |
val pass: theory option -> ('a -> 'b) -> 'a -> 'b * theory option |
22 |
val pass_theory: theory -> ('a -> 'b) -> 'a -> 'b * theory |
|
6238 | 23 |
val save: ('a -> 'b) -> 'a -> 'b |
6185 | 24 |
val >> : (theory -> theory) -> unit |
10914 | 25 |
val ml_output: (string -> unit) * (string -> unit) |
8348
ebbbfdb35c84
added use_mltext, use_mltext_theory, use_let, use_setup (from isar_thy.ML);
wenzelm
parents:
6310
diff
changeset
|
26 |
val use_mltext: string -> bool -> theory option -> unit |
ebbbfdb35c84
added use_mltext, use_mltext_theory, use_let, use_setup (from isar_thy.ML);
wenzelm
parents:
6310
diff
changeset
|
27 |
val use_mltext_theory: string -> bool -> theory -> theory |
ebbbfdb35c84
added use_mltext, use_mltext_theory, use_let, use_setup (from isar_thy.ML);
wenzelm
parents:
6310
diff
changeset
|
28 |
val use_let: string -> string -> string -> theory -> theory |
15801 | 29 |
val add_setup: (theory -> theory) list -> unit |
30 |
val setup: unit -> (theory -> theory) list |
|
6185 | 31 |
end; |
32 |
||
33 |
structure Context: CONTEXT = |
|
34 |
struct |
|
35 |
||
36 |
||
15801 | 37 |
(** implicit theory context in ML **) |
6185 | 38 |
|
39 |
local |
|
15531 | 40 |
val current_theory = ref (NONE: theory option); |
6185 | 41 |
in |
42 |
fun get_context () = ! current_theory; |
|
43 |
fun set_context opt_thy = current_theory := opt_thy; |
|
6238 | 44 |
fun setmp opt_thy f x = Library.setmp current_theory opt_thy f x; |
6185 | 45 |
end; |
46 |
||
47 |
fun the_context () = |
|
48 |
(case get_context () of |
|
15531 | 49 |
SOME thy => thy |
6185 | 50 |
| _ => error "Unknown theory context"); |
51 |
||
15531 | 52 |
fun context thy = set_context (SOME thy); |
53 |
fun reset_context () = set_context NONE; |
|
6185 | 54 |
|
6310 | 55 |
fun pass opt_thy f x = |
6261 | 56 |
setmp opt_thy (fn x => let val y = f x in (y, get_context ()) end) x; |
57 |
||
6310 | 58 |
fun pass_theory thy f x = |
15531 | 59 |
(case pass (SOME thy) f x of |
60 |
(y, SOME thy') => (y, thy') |
|
61 |
| (_, NONE) => error "Lost theory context in ML"); |
|
6261 | 62 |
|
6238 | 63 |
fun save f x = setmp (get_context ()) f x; |
64 |
||
6185 | 65 |
|
66 |
(* map context *) |
|
67 |
||
68 |
nonfix >>; |
|
15531 | 69 |
fun >> f = set_context (SOME (f (the_context ()))); |
6185 | 70 |
|
71 |
||
8348
ebbbfdb35c84
added use_mltext, use_mltext_theory, use_let, use_setup (from isar_thy.ML);
wenzelm
parents:
6310
diff
changeset
|
72 |
(* use ML text *) |
ebbbfdb35c84
added use_mltext, use_mltext_theory, use_let, use_setup (from isar_thy.ML);
wenzelm
parents:
6310
diff
changeset
|
73 |
|
10914 | 74 |
val ml_output = (writeln, error_msg: string -> unit); |
14976 | 75 |
|
76 |
fun use_output verb txt = use_text ml_output verb (Symbol.escape txt); |
|
10914 | 77 |
|
10924
92305ae9f460
use_output: proper handling of non-ASCII symbols;
wenzelm
parents:
10914
diff
changeset
|
78 |
fun use_mltext txt verb opt_thy = setmp opt_thy (fn () => use_output verb txt) (); |
92305ae9f460
use_output: proper handling of non-ASCII symbols;
wenzelm
parents:
10914
diff
changeset
|
79 |
fun use_mltext_theory txt verb thy = #2 (pass_theory thy (use_output verb) txt); |
8348
ebbbfdb35c84
added use_mltext, use_mltext_theory, use_let, use_setup (from isar_thy.ML);
wenzelm
parents:
6310
diff
changeset
|
80 |
|
ebbbfdb35c84
added use_mltext, use_mltext_theory, use_let, use_setup (from isar_thy.ML);
wenzelm
parents:
6310
diff
changeset
|
81 |
fun use_context txt = use_mltext_theory ("Context.>> (" ^ txt ^ ");") false; |
ebbbfdb35c84
added use_mltext, use_mltext_theory, use_let, use_setup (from isar_thy.ML);
wenzelm
parents:
6310
diff
changeset
|
82 |
|
9586 | 83 |
fun use_let bind body txt = |
84 |
use_context ("let " ^ bind ^ " = " ^ txt ^ " in\n" ^ body ^ " end"); |
|
8348
ebbbfdb35c84
added use_mltext, use_mltext_theory, use_let, use_setup (from isar_thy.ML);
wenzelm
parents:
6310
diff
changeset
|
85 |
|
15801 | 86 |
|
87 |
||
88 |
(** delayed theory setup **) |
|
89 |
||
90 |
local |
|
91 |
val setup_fns = ref ([]: (theory -> theory) list); |
|
92 |
in |
|
93 |
fun add_setup fns = setup_fns := ! setup_fns @ fns; |
|
94 |
fun setup () = let val fns = ! setup_fns in setup_fns := []; fns end; |
|
95 |
end; |
|
8348
ebbbfdb35c84
added use_mltext, use_mltext_theory, use_let, use_setup (from isar_thy.ML);
wenzelm
parents:
6310
diff
changeset
|
96 |
|
ebbbfdb35c84
added use_mltext, use_mltext_theory, use_let, use_setup (from isar_thy.ML);
wenzelm
parents:
6310
diff
changeset
|
97 |
|
6185 | 98 |
end; |
99 |
||
100 |
structure BasicContext: BASIC_CONTEXT = Context; |
|
101 |
open BasicContext; |