src/Pure/Isar/local_theory.ML
changeset 66336 13e7dc5f7c3d
parent 66335 a849ce33923d
child 67652 11716a084cae
equal deleted inserted replaced
66335:a849ce33923d 66336:13e7dc5f7c3d
    65   val notation: bool -> Syntax.mode -> (term * mixfix) list -> local_theory -> local_theory
    65   val notation: bool -> Syntax.mode -> (term * mixfix) list -> local_theory -> local_theory
    66   val type_alias: binding -> string -> local_theory -> local_theory
    66   val type_alias: binding -> string -> local_theory -> local_theory
    67   val const_alias: binding -> string -> local_theory -> local_theory
    67   val const_alias: binding -> string -> local_theory -> local_theory
    68   val init: {background_naming: Name_Space.naming, exit: local_theory -> Proof.context} ->
    68   val init: {background_naming: Name_Space.naming, exit: local_theory -> Proof.context} ->
    69     operations -> Proof.context -> local_theory
    69     operations -> Proof.context -> local_theory
    70   val exit_of: local_theory -> local_theory -> Proof.context
       
    71   val exit: local_theory -> Proof.context
    70   val exit: local_theory -> Proof.context
    72   val exit_global: local_theory -> theory
    71   val exit_global: local_theory -> theory
    73   val exit_result: (morphism -> 'a -> 'b) -> 'a * local_theory -> 'b * Proof.context
    72   val exit_result: (morphism -> 'a -> 'b) -> 'a * local_theory -> 'b * Proof.context
    74   val exit_result_global: (morphism -> 'a -> 'b) -> 'a * local_theory -> 'b * theory
    73   val exit_result_global: (morphism -> 'a -> 'b) -> 'a * local_theory -> 'b * theory
    75   val init_target: {background_naming: Name_Space.naming, after_close: local_theory -> local_theory,
    74   val init_target: {background_naming: Name_Space.naming, after_close: local_theory -> local_theory} ->
    76     exit: local_theory -> Proof.context} -> operations ->
    75     operations -> local_theory -> Binding.scope * local_theory
    77     local_theory -> Binding.scope * local_theory
       
    78   val open_target: local_theory -> Binding.scope * local_theory
    76   val open_target: local_theory -> Binding.scope * local_theory
    79   val close_target: local_theory -> local_theory
    77   val close_target: local_theory -> local_theory
    80 end;
    78 end;
    81 
    79 
    82 structure Local_Theory: LOCAL_THEORY =
    80 structure Local_Theory: LOCAL_THEORY =
   354 fun init {background_naming, exit} operations target =
   352 fun init {background_naming, exit} operations target =
   355   target |> Data.map
   353   target |> Data.map
   356     (fn [] => [make_lthy (background_naming, operations, I, exit, false, target)]
   354     (fn [] => [make_lthy (background_naming, operations, I, exit, false, target)]
   357       | _ => error "Local theory already initialized");
   355       | _ => error "Local theory already initialized");
   358 
   356 
   359 val exit_of = #exit o top_of;
   357 val exit_of = #exit o bottom_of;
   360 
   358 
   361 fun exit lthy = exit_of lthy lthy;
   359 fun exit lthy = exit_of lthy lthy;
   362 val exit_global = Proof_Context.theory_of o exit;
   360 val exit_global = Proof_Context.theory_of o exit;
   363 
   361 
   364 fun exit_result f (x, lthy) =
   362 fun exit_result f (x, lthy) =
   375   in (f phi x, thy) end;
   373   in (f phi x, thy) end;
   376 
   374 
   377 
   375 
   378 (* nested targets *)
   376 (* nested targets *)
   379 
   377 
   380 fun init_target {background_naming, after_close, exit} operations lthy =
   378 fun init_target {background_naming, after_close} operations lthy =
   381   let
   379   let
   382     val _ = assert lthy;
   380     val _ = assert lthy;
   383     val after_close' = Proof_Context.restore_naming lthy #> after_close;
   381     val after_close' = Proof_Context.restore_naming lthy #> after_close;
   384     val (scope, target) = Proof_Context.new_scope lthy;
   382     val (scope, target) = Proof_Context.new_scope lthy;
   385     val lthy' =
   383     val lthy' =
   386       target
   384       target
   387       |> Data.map (cons (make_lthy (background_naming, operations, after_close', exit, true, target)));
   385       |> Data.map (cons (make_lthy (background_naming, operations, after_close', exit_of lthy, true, target)));
   388   in (scope, lthy') end;
   386   in (scope, lthy') end;
   389 
   387 
   390 fun open_target lthy =
   388 fun open_target lthy =
   391   init_target {background_naming = background_naming_of lthy, after_close = I,
   389   init_target {background_naming = background_naming_of lthy, after_close = I}
   392     exit = exit_of lthy} (operations_of lthy) lthy;
   390     (operations_of lthy) lthy;
   393 
   391 
   394 fun close_target lthy =
   392 fun close_target lthy =
   395   let
   393   let
   396     val _ = assert_not_bottom lthy;
   394     val _ = assert_not_bottom lthy;
   397     val ({after_close, ...} :: rest) = Data.get lthy;
   395     val ({after_close, ...} :: rest) = Data.get lthy;