12 type operations |
12 type operations |
13 val assert: local_theory -> local_theory |
13 val assert: local_theory -> local_theory |
14 val restore: local_theory -> local_theory |
14 val restore: local_theory -> local_theory |
15 val level: Proof.context -> int |
15 val level: Proof.context -> int |
16 val assert_bottom: bool -> local_theory -> local_theory |
16 val assert_bottom: bool -> local_theory -> local_theory |
|
17 val mark_brittle: local_theory -> local_theory |
|
18 val assert_nonbrittle: local_theory -> local_theory |
17 val open_target: Name_Space.naming -> operations -> (local_theory -> local_theory) -> |
19 val open_target: Name_Space.naming -> operations -> (local_theory -> local_theory) -> |
18 local_theory -> local_theory |
20 local_theory -> local_theory |
19 val close_target: local_theory -> local_theory |
21 val close_target: local_theory -> local_theory |
20 val map_contexts: (int -> Proof.context -> Proof.context) -> local_theory -> local_theory |
22 val map_contexts: (int -> Proof.context -> Proof.context) -> local_theory -> local_theory |
21 val naming_of: local_theory -> Name_Space.naming |
23 val naming_of: local_theory -> Name_Space.naming |
93 |
95 |
94 (* context data *) |
96 (* context data *) |
95 |
97 |
96 structure Data = Proof_Data |
98 structure Data = Proof_Data |
97 ( |
99 ( |
98 type T = lthy list; |
100 type T = lthy list * bool; |
99 fun init _ = []; |
101 fun init _ = ([], false); |
100 ); |
102 ); |
101 |
103 |
102 fun assert lthy = |
104 fun assert lthy = |
103 if null (Data.get lthy) then error "Missing local theory context" else lthy; |
105 if null (fst (Data.get lthy)) then error "Missing local theory context" else lthy; |
104 |
106 |
105 val get_last_lthy = List.last o Data.get o assert; |
107 val get_last_lthy = List.last o fst o Data.get o assert; |
106 val get_first_lthy = hd o Data.get o assert; |
108 val get_first_lthy = hd o fst o Data.get o assert; |
107 |
109 |
108 fun map_first_lthy f = |
110 fun map_first_lthy f = |
109 assert #> |
111 assert #> |
110 Data.map (fn {naming, operations, after_close, target} :: parents => |
112 (Data.map o apfst) (fn {naming, operations, after_close, target} :: parents => |
111 make_lthy (f (naming, operations, after_close, target)) :: parents); |
113 make_lthy (f (naming, operations, after_close, target)) :: parents); |
112 |
114 |
113 fun restore lthy = #target (get_first_lthy lthy) |> Data.put (Data.get lthy); |
115 fun restore lthy = #target (get_first_lthy lthy) |> Data.put (fst (Data.get lthy), false); |
114 |
116 |
115 |
117 |
116 (* nested structure *) |
118 (* nested structure *) |
117 |
119 |
118 val level = length o Data.get; (*1: main target at bottom, >= 2: nested context*) |
120 val level = length o fst o Data.get; (*1: main target at bottom, >= 2: nested context*) |
119 |
121 |
120 fun assert_bottom b lthy = |
122 fun assert_bottom b lthy = |
121 let |
123 let |
122 val _ = assert lthy; |
124 val _ = assert lthy; |
123 val b' = level lthy <= 1; |
125 val b' = level lthy <= 1; |
127 else lthy |
129 else lthy |
128 end; |
130 end; |
129 |
131 |
130 fun open_target naming operations after_close target = |
132 fun open_target naming operations after_close target = |
131 assert target |
133 assert target |
132 |> Data.map (cons (make_lthy (naming, operations, after_close, target))); |
134 |> (Data.map o apfst) (cons (make_lthy (naming, operations, after_close, target))); |
133 |
135 |
134 fun close_target lthy = |
136 fun close_target lthy = |
135 let |
137 let |
136 val _ = assert_bottom false lthy; |
138 val _ = assert_bottom false lthy; |
137 val {after_close, ...} :: rest = Data.get lthy; |
139 val ({after_close, ...} :: rest, tainted) = Data.get lthy; |
138 in lthy |> Data.put rest |> restore |> after_close end; |
140 in lthy |> Data.put (rest, tainted) |> restore |> after_close end; |
139 |
141 |
140 fun map_contexts f lthy = |
142 fun map_contexts f lthy = |
141 let val n = level lthy in |
143 let val n = level lthy in |
142 lthy |> (Data.map o map_index) (fn (i, {naming, operations, after_close, target}) => |
144 lthy |> (Data.map o apfst o map_index) (fn (i, {naming, operations, after_close, target}) => |
143 make_lthy (naming, operations, after_close, |
145 make_lthy (naming, operations, after_close, |
144 target |
146 target |
145 |> Context_Position.set_visible false |
147 |> Context_Position.set_visible false |
146 |> f (n - i - 1) |
148 |> f (n - i - 1) |
147 |> Context_Position.restore_visible target)) |
149 |> Context_Position.restore_visible target)) |
148 |> f n |
150 |> f n |
149 end; |
151 end; |
|
152 |
|
153 |
|
154 (* brittle context -- implicit for nested structures *) |
|
155 |
|
156 val mark_brittle = Data.map (fn ([data], _) => ([data], true) | x => x); |
|
157 |
|
158 fun assert_nonbrittle lthy = |
|
159 if snd (Data.get lthy) orelse level lthy > 1 |
|
160 then error "Brittle local theory context" |
|
161 else lthy; |
150 |
162 |
151 |
163 |
152 (* naming *) |
164 (* naming *) |
153 |
165 |
154 val naming_of = #naming o get_first_lthy; |
166 val naming_of = #naming o get_first_lthy; |
288 (** init and exit **) |
300 (** init and exit **) |
289 |
301 |
290 (* init *) |
302 (* init *) |
291 |
303 |
292 fun init naming operations target = |
304 fun init naming operations target = |
293 target |> Data.map |
305 target |> (Data.map o apfst) |
294 (fn [] => [make_lthy (naming, operations, I, target)] |
306 (fn [] => [make_lthy (naming, operations, I, target)] |
295 | _ => error "Local theory already initialized") |
307 | _ => error "Local theory already initialized") |
296 |> checkpoint; |
308 |> checkpoint; |
297 |
309 |
298 |
310 |