20 val map_thy: 'a T -> ('a -> 'a) -> theory -> theory |
20 val map_thy: 'a T -> ('a -> 'a) -> theory -> theory |
21 val put_thy: 'a T -> 'a -> theory -> theory |
21 val put_thy: 'a T -> 'a -> theory -> theory |
22 val get_generic: Context.generic -> 'a T -> 'a |
22 val get_generic: Context.generic -> 'a T -> 'a |
23 val map_generic: 'a T -> ('a -> 'a) -> Context.generic -> Context.generic |
23 val map_generic: 'a T -> ('a -> 'a) -> Context.generic -> Context.generic |
24 val put_generic: 'a T -> 'a -> Context.generic -> Context.generic |
24 val put_generic: 'a T -> 'a -> Context.generic -> Context.generic |
25 val declare: bool -> string -> value -> value T |
25 val declare: bool -> string -> (Proof.context -> value) -> value T |
26 val name_of: 'a T -> string |
26 val name_of: 'a T -> string |
27 end; |
27 end; |
28 |
28 |
29 structure Config: CONFIG = |
29 structure Config: CONFIG = |
30 struct |
30 struct |
100 |
100 |
101 fun declare global name default = |
101 fun declare global name default = |
102 let |
102 let |
103 val id = serial (); |
103 val id = serial (); |
104 |
104 |
105 fun get_value context = the_default default (Inttab.lookup (Value.get context) id); |
105 fun get_value context = |
106 fun modify_value f = Value.map (Inttab.map_default (id, default) (type_check name f)); |
106 (case Inttab.lookup (Value.get context) id of |
|
107 SOME value => value |
|
108 | NONE => default (Context.proof_of context)); |
|
109 |
|
110 fun update_value f context = |
|
111 Value.map (Inttab.update (id, type_check name f (get_value context))) context; |
107 |
112 |
108 fun map_value f (context as Context.Proof _) = |
113 fun map_value f (context as Context.Proof _) = |
109 let val context' = modify_value f context in |
114 let val context' = update_value f context in |
110 if global andalso |
115 if global andalso |
111 get_value (Context.Theory (Context.theory_of context')) <> get_value context' |
116 get_value (Context.Theory (Context.theory_of context')) <> get_value context' |
112 then (warning ("Ignoring local change of global option " ^ quote name); context) |
117 then (warning ("Ignoring local change of global option " ^ quote name); context) |
113 else context' |
118 else context' |
114 end |
119 end |
115 | map_value f context = modify_value f context; |
120 | map_value f context = update_value f context; |
116 in Config {name = name, get_value = get_value, map_value = map_value} end; |
121 in Config {name = name, get_value = get_value, map_value = map_value} end; |
117 |
122 |
118 fun name_of (Config {name, ...}) = name; |
123 fun name_of (Config {name, ...}) = name; |
119 |
124 |
120 |
125 |