src/Pure/Isar/isar_output.ML
changeset 19058 1e65cf5ae9ea
parent 18988 d6e5fa2ba8b8
child 19581 4ae6a14b742f
equal deleted inserted replaced
19057:9201b2bb36c2 19058:1e65cf5ae9ea
     9 sig
     9 sig
    10   val display: bool ref
    10   val display: bool ref
    11   val quotes: bool ref
    11   val quotes: bool ref
    12   val indent: int ref
    12   val indent: int ref
    13   val source: bool ref
    13   val source: bool ref
    14   val add_commands: (string * (Args.src -> Toplevel.state -> string)) list -> unit
    14   val add_commands: (string * (Args.src -> Toplevel.node option -> string)) list -> unit
    15   val add_options: (string * (string -> (unit -> string) -> unit -> string)) list -> unit
    15   val add_options: (string * (string -> (unit -> string) -> unit -> string)) list -> unit
    16   val print_antiquotations: unit -> unit
    16   val print_antiquotations: unit -> unit
    17   val boolean: string -> bool
    17   val boolean: string -> bool
    18   val integer: string -> int
    18   val integer: string -> int
    19   val args: (Context.generic * Args.T list -> 'a * (Context.generic * Args.T list)) ->
    19   val args: (Context.generic * Args.T list -> 'a * (Context.generic * Args.T list)) ->
    20     (Args.src -> Proof.context -> 'a -> string) -> Args.src -> Toplevel.state -> string
    20     (Args.src -> Proof.context -> 'a -> string) -> Args.src -> Toplevel.node option -> string
    21   datatype markup = Markup | MarkupEnv | Verbatim
    21   datatype markup = Markup | MarkupEnv | Verbatim
    22   val modes: string list ref
    22   val modes: string list ref
    23   val eval_antiquote: Scan.lexicon -> Toplevel.state -> string * Position.T -> string
    23   val eval_antiquote: Scan.lexicon -> Toplevel.node option -> string * Position.T -> string
    24   val present_thy: Scan.lexicon -> (string -> string list) -> (markup -> string -> bool) ->
    24   val present_thy: Scan.lexicon -> (string -> string list) -> (markup -> string -> bool) ->
    25     Toplevel.transition list -> (OuterLex.token, 'a) Source.source -> Buffer.T
    25     Toplevel.transition list -> (OuterLex.token, 'a) Source.source -> Buffer.T
    26   val output_list: (Proof.context -> 'a -> Pretty.T) -> Args.src ->
    26   val output_list: (Proof.context -> 'a -> Pretty.T) -> Args.src ->
    27     Proof.context -> 'a list -> string
    27     Proof.context -> 'a list -> string
    28   val output: (Proof.context -> 'a -> Pretty.T) -> Args.src -> Proof.context -> 'a -> string
    28   val output: (Proof.context -> 'a -> Pretty.T) -> Args.src -> Proof.context -> 'a -> string
    49 (** maintain global commands **)
    49 (** maintain global commands **)
    50 
    50 
    51 local
    51 local
    52 
    52 
    53 val global_commands =
    53 val global_commands =
    54   ref (Symtab.empty: (Args.src -> Toplevel.state -> string) Symtab.table);
    54   ref (Symtab.empty: (Args.src -> Toplevel.node option -> string) Symtab.table);
    55 
    55 
    56 val global_options =
    56 val global_options =
    57   ref (Symtab.empty: (string -> (unit -> string) -> unit -> string) Symtab.table);
    57   ref (Symtab.empty: (string -> (unit -> string) -> unit -> string) Symtab.table);
    58 
    58 
    59 fun add_item kind (name, x) tab =
    59 fun add_item kind (name, x) tab =
   110 
   110 
   111 (* args syntax *)
   111 (* args syntax *)
   112 
   112 
   113 fun syntax scan = Args.context_syntax "antiquotation" scan;
   113 fun syntax scan = Args.context_syntax "antiquotation" scan;
   114 
   114 
   115 fun args scan f src state : string =
   115 fun args scan f src node : string =
   116   let
   116   let
   117     val thy = Toplevel.theory_of state;
   117     val loc = if ! locale = "" then NONE else SOME (! locale);
   118     val ctxt0 =
   118     val (ctxt, x) = syntax scan src (Toplevel.body_context_node node loc);
   119       if ! locale = "" then Toplevel.body_context_of state
       
   120       else #2 (Locale.init (Locale.intern thy (! locale)) thy);
       
   121     val (ctxt, x) = syntax scan src ctxt0;
       
   122   in f src ctxt x end;
   119   in f src ctxt x end;
   123 
   120 
   124 
   121 
   125 (* outer syntax *)
   122 (* outer syntax *)
   126 
   123 
   153 
   150 
   154 (* eval_antiquote *)
   151 (* eval_antiquote *)
   155 
   152 
   156 val modes = ref ([]: string list);
   153 val modes = ref ([]: string list);
   157 
   154 
   158 fun eval_antiquote lex state (str, pos) =
   155 fun eval_antiquote lex node (str, pos) =
   159   let
   156   let
   160     fun expand (Antiquote.Text s) = s
   157     fun expand (Antiquote.Text s) = s
   161       | expand (Antiquote.Antiq x) =
   158       | expand (Antiquote.Antiq x) =
   162           let val (opts, src) = antiq_args lex x in
   159           let val (opts, src) = antiq_args lex x in
   163             options opts (fn () => command src state) ();  (*preview errors!*)
   160             options opts (fn () => command src node) ();  (*preview errors!*)
   164             Library.setmp print_mode (! modes @ Latex.modes @ ! print_mode)
   161             Library.setmp print_mode (! modes @ Latex.modes @ ! print_mode)
   165               (Output.no_warnings (options opts (fn () => command src state))) ()
   162               (Output.no_warnings (options opts (fn () => command src node))) ()
   166           end;
   163           end;
   167     val ants = Antiquote.antiquotes_of (str, pos);
   164     val ants = Antiquote.antiquotes_of (str, pos);
   168   in
   165   in
   169     if Toplevel.is_toplevel state andalso exists Antiquote.is_antiq ants then
   166     if is_none node andalso exists Antiquote.is_antiq ants then
   170       error ("Cannot expand antiquotations at top-level" ^ Position.str_of pos)
   167       error ("Cannot expand antiquotations at top-level" ^ Position.str_of pos)
   171     else implode (map expand ants)
   168     else implode (map expand ants)
   172   end;
   169   end;
   173 
   170 
   174 
   171 
   184   | MarkupEnvToken of string * (string * Position.T)
   181   | MarkupEnvToken of string * (string * Position.T)
   185   | VerbatimToken of string * Position.T;
   182   | VerbatimToken of string * Position.T;
   186 
   183 
   187 fun output_token lex state =
   184 fun output_token lex state =
   188   let
   185   let
   189     val eval = eval_antiquote lex state
   186     val eval = eval_antiquote lex (try Toplevel.node_of state)
   190   in
   187   in
   191     fn NoToken => ""
   188     fn NoToken => ""
   192      | BasicToken tok => Latex.output_basic tok
   189      | BasicToken tok => Latex.output_basic tok
   193      | MarkupToken (cmd, txt) => Latex.output_markup cmd (eval txt)
   190      | MarkupToken (cmd, txt) => Latex.output_markup cmd (eval txt)
   194      | MarkupEnvToken (cmd, txt) => Latex.output_markup_env cmd (eval txt)
   191      | MarkupEnvToken (cmd, txt) => Latex.output_markup_env cmd (eval txt)
   480     #> space_implode "\\isasep\\isanewline%\n"
   477     #> space_implode "\\isasep\\isanewline%\n"
   481     #> enclose "\\isa{" "}");
   478     #> enclose "\\isa{" "}");
   482 
   479 
   483 fun output pretty src ctxt = output_list pretty src ctxt o single;
   480 fun output pretty src ctxt = output_list pretty src ctxt o single;
   484 
   481 
   485 fun output_goals main_goal src state = args (Scan.succeed ()) (output (fn _ => fn _ =>
   482 fun proof_state node =
   486   Pretty.chunks (Proof.pretty_goals main_goal (Toplevel.proof_of state
   483   (case Option.map Toplevel.proof_node node of
   487       handle Toplevel.UNDEF => error "No proof state")))) src state;
   484     SOME (SOME prf) => ProofHistory.current prf
       
   485   | _ => error "No proof state");
       
   486 
       
   487 fun output_goals main_goal src node = args (Scan.succeed ()) (output (fn _ => fn _ =>
       
   488   Pretty.chunks (Proof.pretty_goals main_goal (proof_state node)))) src node;
   488 
   489 
   489 fun ml_val txt = "fn _ => (" ^ txt ^ ");";
   490 fun ml_val txt = "fn _ => (" ^ txt ^ ");";
   490 fun ml_type txt = "val _ = NONE : (" ^ txt ^ ") option;";
   491 fun ml_type txt = "val _ = NONE : (" ^ txt ^ ") option;";
   491 fun ml_struct txt = "functor DUMMY_FUNCTOR() = struct structure DUMMY = " ^ txt ^ " end;"
   492 fun ml_struct txt = "functor DUMMY_FUNCTOR() = struct structure DUMMY = " ^ txt ^ " end;"
   492 
   493