oracle, header/local_theory/proof_markup: pass SymbolPos.text;
authorwenzelm
Thu, 14 Aug 2008 19:52:36 +0200
changeset 278714ef76f8788ad
parent 27870 643673ebe065
child 27872 631371a02b8c
oracle, header/local_theory/proof_markup: pass SymbolPos.text;
src/Pure/Isar/isar_cmd.ML
     1.1 --- a/src/Pure/Isar/isar_cmd.ML	Thu Aug 14 19:52:35 2008 +0200
     1.2 +++ b/src/Pure/Isar/isar_cmd.ML	Thu Aug 14 19:52:36 2008 +0200
     1.3 @@ -13,7 +13,8 @@
     1.4    val print_translation: bool * (string * Position.T) -> theory -> theory
     1.5    val typed_print_translation: bool * (string * Position.T) -> theory -> theory
     1.6    val print_ast_translation: bool * (string * Position.T) -> theory -> theory
     1.7 -  val oracle: bstring -> string -> string * Position.T -> theory -> theory
     1.8 +  val oracle: bstring -> SymbolPos.text * Position.T -> SymbolPos.text * Position.T ->
     1.9 +    theory -> theory
    1.10    val add_axioms: ((bstring * string) * Attrib.src list) list -> theory -> theory
    1.11    val add_defs: (bool * bool) * ((bstring * string) * Attrib.src list) list -> theory -> theory
    1.12    val declaration: string * Position.T -> local_theory -> local_theory
    1.13 @@ -84,10 +85,10 @@
    1.14    val print_prop: (string list * string) -> Toplevel.transition -> Toplevel.transition
    1.15    val print_term: (string list * string) -> Toplevel.transition -> Toplevel.transition
    1.16    val print_type: (string list * string) -> Toplevel.transition -> Toplevel.transition
    1.17 -  val header_markup: string * Position.T -> Toplevel.transition -> Toplevel.transition
    1.18 -  val local_theory_markup: xstring option * (string * Position.T) ->
    1.19 +  val header_markup: SymbolPos.text * Position.T -> Toplevel.transition -> Toplevel.transition
    1.20 +  val local_theory_markup: xstring option * (SymbolPos.text * Position.T) ->
    1.21      Toplevel.transition -> Toplevel.transition
    1.22 -  val proof_markup: string * Position.T -> Toplevel.transition -> Toplevel.transition
    1.23 +  val proof_markup: SymbolPos.text * Position.T -> Toplevel.transition -> Toplevel.transition
    1.24  end;
    1.25  
    1.26  structure IsarCmd: ISAR_CMD =
    1.27 @@ -155,20 +156,23 @@
    1.28  
    1.29  (* oracles *)
    1.30  
    1.31 -fun oracle name typ (oracle, pos) =
    1.32 -  let val txt =
    1.33 -    "local\
    1.34 -    \  type T = " ^ typ ^ ";\
    1.35 -    \  val oracle: theory -> T -> term = " ^ oracle ^ ";\n\
    1.36 -    \  val name = " ^ quote name ^ ";\n\
    1.37 -    \  exception Arg of T;\n\
    1.38 -    \  val _ = Context.>> (Context.map_theory\n\
    1.39 -    \    (Theory.add_oracle (name, fn (thy, Arg x) => oracle thy x)));\n\
    1.40 -    \  val thy = ML_Context.the_global_context ();\n\
    1.41 -    \  val invoke_" ^ name ^ " = Thm.invoke_oracle_i thy (Sign.full_name thy name);\n\
    1.42 -    \in\n\
    1.43 -    \  fun " ^ name ^ " thy x = invoke_" ^ name ^ " (thy, Arg x);\n\
    1.44 -    \end;\n";
    1.45 +fun oracle name typ_pos (oracle_txt, pos) =
    1.46 +  let
    1.47 +    val typ = SymbolPos.content (SymbolPos.explode typ_pos);
    1.48 +    val oracle = SymbolPos.content (SymbolPos.explode (oracle_txt, pos));
    1.49 +    val txt =
    1.50 +      "local\
    1.51 +      \  type T = " ^ typ ^ ";\
    1.52 +      \  val oracle: theory -> T -> term = " ^ oracle ^ ";\n\
    1.53 +      \  val name = " ^ quote name ^ ";\n\
    1.54 +      \  exception Arg of T;\n\
    1.55 +      \  val _ = Context.>> (Context.map_theory\n\
    1.56 +      \    (Theory.add_oracle (name, fn (thy, Arg x) => oracle thy x)));\n\
    1.57 +      \  val thy = ML_Context.the_global_context ();\n\
    1.58 +      \  val invoke_" ^ name ^ " = Thm.invoke_oracle_i thy (Sign.full_name thy name);\n\
    1.59 +      \in\n\
    1.60 +      \  fun " ^ name ^ " thy x = invoke_" ^ name ^ " (thy, Arg x);\n\
    1.61 +      \end;\n";
    1.62    in Context.theory_map (ML_Context.exec (fn () => ML_Context.eval false pos txt)) end;
    1.63  
    1.64