more explicit Toplevel.open_target/close_target;
authorwenzelm
Wed, 21 Mar 2012 23:26:35 +0100
changeset 47946451fc10a81f3
parent 47945 2027ff3136cc
child 47947 15cd66da537f
more explicit Toplevel.open_target/close_target;
replaced 'context_includes' by 'context' 'includes';
tuned command descriptions;
etc/isar-keywords-ZF.el
etc/isar-keywords.el
src/Pure/Isar/bundle.ML
src/Pure/Isar/isar_syn.ML
src/Pure/Isar/named_target.ML
src/Pure/Isar/toplevel.ML
     1.1 --- a/etc/isar-keywords-ZF.el	Wed Mar 21 21:24:13 2012 +0100
     1.2 +++ b/etc/isar-keywords-ZF.el	Wed Mar 21 23:26:35 2012 +0100
     1.3 @@ -45,7 +45,6 @@
     1.4      "commit"
     1.5      "consts"
     1.6      "context"
     1.7 -    "context_includes"
     1.8      "corollary"
     1.9      "datatype"
    1.10      "declaration"
    1.11 @@ -227,6 +226,7 @@
    1.12      "if"
    1.13      "imports"
    1.14      "in"
    1.15 +    "includes"
    1.16      "induction"
    1.17      "infix"
    1.18      "infixl"
    1.19 @@ -357,7 +357,6 @@
    1.20      "coinductive"
    1.21      "consts"
    1.22      "context"
    1.23 -    "context_includes"
    1.24      "datatype"
    1.25      "declaration"
    1.26      "declare"
     2.1 --- a/etc/isar-keywords.el	Wed Mar 21 21:24:13 2012 +0100
     2.2 +++ b/etc/isar-keywords.el	Wed Mar 21 23:26:35 2012 +0100
     2.3 @@ -64,7 +64,6 @@
     2.4      "commit"
     2.5      "consts"
     2.6      "context"
     2.7 -    "context_includes"
     2.8      "corollary"
     2.9      "cpodef"
    2.10      "datatype"
    2.11 @@ -306,6 +305,7 @@
    2.12      "if"
    2.13      "imports"
    2.14      "in"
    2.15 +    "includes"
    2.16      "infix"
    2.17      "infixl"
    2.18      "infixr"
    2.19 @@ -471,7 +471,6 @@
    2.20      "coinductive_set"
    2.21      "consts"
    2.22      "context"
    2.23 -    "context_includes"
    2.24      "datatype"
    2.25      "declaration"
    2.26      "declare"
     3.1 --- a/src/Pure/Isar/bundle.ML	Wed Mar 21 21:24:13 2012 +0100
     3.2 +++ b/src/Pure/Isar/bundle.ML	Wed Mar 21 23:26:35 2012 +0100
     3.3 @@ -15,12 +15,12 @@
     3.4      (binding * string option * mixfix) list -> local_theory -> local_theory
     3.5    val includes: string list -> Proof.context -> Proof.context
     3.6    val includes_cmd: (xstring * Position.T) list -> Proof.context -> Proof.context
     3.7 +  val context_includes: string list -> generic_theory -> local_theory
     3.8 +  val context_includes_cmd: (xstring * Position.T) list -> generic_theory -> local_theory
     3.9    val include_: string list -> Proof.state -> Proof.state
    3.10    val include_cmd: (xstring * Position.T) list -> Proof.state -> Proof.state
    3.11    val including: string list -> Proof.state -> Proof.state
    3.12    val including_cmd: (xstring * Position.T) list -> Proof.state -> Proof.state
    3.13 -  val context_includes: string list -> local_theory -> local_theory
    3.14 -  val context_includes_cmd: (xstring * Position.T) list -> local_theory -> local_theory
    3.15    val print_bundles: Proof.context -> unit
    3.16  end;
    3.17  
    3.18 @@ -93,16 +93,22 @@
    3.19      val note = ((Binding.empty, []), map (apsnd (map attrib)) decls);
    3.20    in #2 (Proof_Context.note_thmss "" [note] ctxt) end;
    3.21  
    3.22 -fun gen_context prep args lthy =
    3.23 -  Named_Target.assert lthy
    3.24 -  |> gen_includes prep args
    3.25 -  |> Local_Theory.open_target (Local_Theory.naming_of lthy) (Local_Theory.operations_of lthy);
    3.26 +fun gen_context prep args (Context.Theory thy) =
    3.27 +      Named_Target.theory_init thy
    3.28 +      |> Local_Theory.target (gen_includes prep args)
    3.29 +  | gen_context prep args (Context.Proof lthy) =
    3.30 +      Named_Target.assert lthy
    3.31 +      |> gen_includes prep args
    3.32 +      |> Local_Theory.open_target (Local_Theory.naming_of lthy) (Local_Theory.operations_of lthy);
    3.33  
    3.34  in
    3.35  
    3.36  val includes = gen_includes (K I);
    3.37  val includes_cmd = gen_includes check;
    3.38  
    3.39 +val context_includes = gen_context (K I);
    3.40 +val context_includes_cmd = gen_context check;
    3.41 +
    3.42  fun include_ bs = Proof.assert_forward #> Proof.map_context (includes bs) #> Proof.reset_facts;
    3.43  fun include_cmd bs =
    3.44    Proof.assert_forward #> Proof.map_context (includes_cmd bs) #> Proof.reset_facts;
    3.45 @@ -110,9 +116,6 @@
    3.46  fun including bs = Proof.assert_backward #> Proof.map_context (includes bs);
    3.47  fun including_cmd bs = Proof.assert_backward #> Proof.map_context (includes_cmd bs);
    3.48  
    3.49 -val context_includes = gen_context (K I);
    3.50 -val context_includes_cmd = gen_context check;
    3.51 -
    3.52  end;
    3.53  
    3.54  
     4.1 --- a/src/Pure/Isar/isar_syn.ML	Wed Mar 21 21:24:13 2012 +0100
     4.2 +++ b/src/Pure/Isar/isar_syn.ML	Wed Mar 21 23:26:35 2012 +0100
     4.3 @@ -25,16 +25,17 @@
     4.4  (** init and exit **)
     4.5  
     4.6  val _ =
     4.7 -  Outer_Syntax.command ("theory", Keyword.tag_theory Keyword.thy_begin) "begin theory"
     4.8 +  Outer_Syntax.command ("theory", Keyword.tag_theory Keyword.thy_begin) "begin theory context"
     4.9      (Thy_Header.args >> (fn header =>
    4.10        Toplevel.print o
    4.11          Toplevel.init_theory
    4.12            (fn () => Thy_Info.toplevel_begin_theory (Thy_Load.get_master_path ()) header)));
    4.13  
    4.14  val _ =
    4.15 -  Outer_Syntax.command ("end", Keyword.tag_theory Keyword.thy_end) "end (local) theory"
    4.16 +  Outer_Syntax.command ("end", Keyword.tag_theory Keyword.thy_end) "end context"
    4.17      (Scan.succeed
    4.18 -      (Toplevel.exit o Toplevel.end_local_theory o Toplevel.end_proof (K Proof.end_notepad)));
    4.19 +      (Toplevel.exit o Toplevel.end_local_theory o Toplevel.close_target o
    4.20 +        Toplevel.end_proof (K Proof.end_notepad)));
    4.21  
    4.22  
    4.23  
    4.24 @@ -406,14 +407,6 @@
    4.25        (fn (x, y) => Toplevel.theory (Isar_Cmd.oracle x y)));
    4.26  
    4.27  
    4.28 -(* local theories *)
    4.29 -
    4.30 -val _ =
    4.31 -  Outer_Syntax.command ("context", Keyword.thy_decl) "enter local theory context"
    4.32 -    (Parse.position Parse.xname --| Parse.begin >> (fn name =>
    4.33 -      Toplevel.print o Toplevel.begin_local_theory true (Named_Target.context_cmd name)));
    4.34 -
    4.35 -
    4.36  (* bundled declarations *)
    4.37  
    4.38  val _ =
    4.39 @@ -434,17 +427,21 @@
    4.40        >> (Toplevel.print oo (Toplevel.proof o Bundle.including_cmd)));
    4.41  
    4.42  val _ =
    4.43 -  Outer_Syntax.local_theory ("context_includes", Keyword.thy_decl)  (* FIXME 'context' 'includes' *)
    4.44 -    "nested target context including bundled declarations"
    4.45 -    (Scan.repeat1 (Parse.position Parse.xname) --| Parse.begin
    4.46 -      >> Bundle.context_includes_cmd);
    4.47 -
    4.48 -val _ =
    4.49    Outer_Syntax.improper_command ("print_bundles", Keyword.diag) "print bundles of declarations"
    4.50      (Scan.succeed (Toplevel.no_timing o Toplevel.unknown_context o
    4.51        Toplevel.keep (Bundle.print_bundles o Toplevel.context_of)));
    4.52  
    4.53  
    4.54 +(* local theories *)
    4.55 +
    4.56 +val _ =
    4.57 +  Outer_Syntax.command ("context", Keyword.thy_decl) "begin local theory context"
    4.58 +    ((Parse_Spec.includes >> (Toplevel.open_target o Bundle.context_includes_cmd) ||
    4.59 +      Parse.position Parse.xname >> (fn name =>
    4.60 +        Toplevel.print o Toplevel.begin_local_theory true (Named_Target.context_cmd name)))
    4.61 +      --| Parse.begin);
    4.62 +
    4.63 +
    4.64  (* locales *)
    4.65  
    4.66  val locale_val =
    4.67 @@ -567,8 +564,7 @@
    4.68  val _ = gen_theorem true Thm.corollaryK;
    4.69  
    4.70  val _ =
    4.71 -  Outer_Syntax.local_theory_to_proof ("notepad", Keyword.thy_decl)
    4.72 -    "Isar proof state as formal notepad, without any result"
    4.73 +  Outer_Syntax.local_theory_to_proof ("notepad", Keyword.thy_decl) "begin proof context"
    4.74      (Parse.begin >> K Proof.begin_notepad);
    4.75  
    4.76  val _ =
     5.1 --- a/src/Pure/Isar/named_target.ML	Wed Mar 21 21:24:13 2012 +0100
     5.2 +++ b/src/Pure/Isar/named_target.ML	Wed Mar 21 23:26:35 2012 +0100
     5.3 @@ -215,7 +215,7 @@
     5.4  val theory_init = init I "";
     5.5  
     5.6  val reinit =
     5.7 -  assert #> Data.get #> the #>
     5.8 +  Local_Theory.assert_bottom true #> Data.get #> the #>
     5.9    (fn Target {target, before_exit, ...} => Local_Theory.exit_global #> init before_exit target);
    5.10  
    5.11  fun context_cmd ("-", _) thy = init I "" thy
     6.1 --- a/src/Pure/Isar/toplevel.ML	Wed Mar 21 21:24:13 2012 +0100
     6.2 +++ b/src/Pure/Isar/toplevel.ML	Wed Mar 21 23:26:35 2012 +0100
     6.3 @@ -58,6 +58,8 @@
     6.4    val theory': (bool -> theory -> theory) -> transition -> transition
     6.5    val begin_local_theory: bool -> (theory -> local_theory) -> transition -> transition
     6.6    val end_local_theory: transition -> transition
     6.7 +  val open_target: (generic_theory -> local_theory) -> transition -> transition
     6.8 +  val close_target: transition -> transition
     6.9    val local_theory': (xstring * Position.T) option -> (bool -> local_theory -> local_theory) ->
    6.10      transition -> transition
    6.11    val local_theory: (xstring * Position.T) option -> (local_theory -> local_theory) ->
    6.12 @@ -105,7 +107,7 @@
    6.13  (* local theory wrappers *)
    6.14  
    6.15  val loc_init = Named_Target.context_cmd;
    6.16 -val loc_exit = Local_Theory.exit_global;
    6.17 +val loc_exit = Local_Theory.assert_bottom true #> Local_Theory.exit_global;
    6.18  
    6.19  fun loc_begin loc (Context.Theory thy) = loc_init (the_default ("-", Position.none) loc) thy
    6.20    | loc_begin NONE (Context.Proof lthy) = lthy
    6.21 @@ -456,6 +458,20 @@
    6.22    (fn Theory (Context.Proof lthy, _) => Theory (Context.Theory (loc_exit lthy), SOME lthy)
    6.23      | _ => raise UNDEF));
    6.24  
    6.25 +fun open_target f = transaction (fn _ =>
    6.26 +  (fn Theory (gthy, _) =>
    6.27 +        let val lthy = f gthy
    6.28 +        in Theory (Context.Proof lthy, SOME lthy) end
    6.29 +    | _ => raise UNDEF));
    6.30 +
    6.31 +val close_target = transaction (fn _ =>
    6.32 +  (fn Theory (Context.Proof lthy, _) =>
    6.33 +        (case try Local_Theory.close_target lthy of
    6.34 +          SOME lthy' => Theory (Context.Proof lthy', SOME lthy)
    6.35 +        | NONE => raise UNDEF)
    6.36 +    | _ => raise UNDEF));
    6.37 +
    6.38 +
    6.39  local
    6.40  
    6.41  fun local_theory_presentation loc f = present_transaction (fn int =>