src/Pure/Thy/thy_output.ML
changeset 38767 d8da44a8dd25
parent 38766 8891f4520d16
child 38832 fc0aa40a1b08
equal deleted inserted replaced
38766:8891f4520d16 38767:d8da44a8dd25
     4 Theory document output with antiquotations.
     4 Theory document output with antiquotations.
     5 *)
     5 *)
     6 
     6 
     7 signature THY_OUTPUT =
     7 signature THY_OUTPUT =
     8 sig
     8 sig
     9   val display: bool Unsynchronized.ref
     9   val display_default: bool Unsynchronized.ref
    10   val quotes: bool Unsynchronized.ref
    10   val quotes_default: bool Unsynchronized.ref
    11   val indent: int Unsynchronized.ref
    11   val indent_default: int Unsynchronized.ref
    12   val source: bool Unsynchronized.ref
    12   val source_default: bool Unsynchronized.ref
    13   val break: bool Unsynchronized.ref
    13   val break_default: bool Unsynchronized.ref
       
    14   val display: bool Config.T
       
    15   val quotes: bool Config.T
       
    16   val indent: int Config.T
       
    17   val source: bool Config.T
       
    18   val break: bool Config.T
    14   val add_wrapper: ((unit -> string) -> unit -> string) -> Proof.context -> Proof.context
    19   val add_wrapper: ((unit -> string) -> unit -> string) -> Proof.context -> Proof.context
    15   val add_option: string -> (string -> Proof.context -> Proof.context) -> unit
    20   val add_option: string -> (string -> Proof.context -> Proof.context) -> unit
    16   val defined_command: string -> bool
    21   val defined_command: string -> bool
    17   val defined_option: string -> bool
    22   val defined_option: string -> bool
    18   val print_antiquotations: unit -> unit
    23   val print_antiquotations: unit -> unit
    23   datatype markup = Markup | MarkupEnv | Verbatim
    28   datatype markup = Markup | MarkupEnv | Verbatim
    24   val modes: string list Unsynchronized.ref
    29   val modes: string list Unsynchronized.ref
    25   val eval_antiquote: Scan.lexicon -> Toplevel.state -> Symbol_Pos.text * Position.T -> string
    30   val eval_antiquote: Scan.lexicon -> Toplevel.state -> Symbol_Pos.text * Position.T -> string
    26   val present_thy: Scan.lexicon -> (string -> string list) -> (markup -> string -> bool) ->
    31   val present_thy: Scan.lexicon -> (string -> string list) -> (markup -> string -> bool) ->
    27     (Toplevel.transition * Toplevel.state) list -> (Token.T, 'a) Source.source -> Buffer.T
    32     (Toplevel.transition * Toplevel.state) list -> (Token.T, 'a) Source.source -> Buffer.T
    28   val pretty_text: string -> Pretty.T
    33   val pretty_text: Proof.context -> string -> Pretty.T
    29   val pretty_term: Proof.context -> term -> Pretty.T
    34   val pretty_term: Proof.context -> term -> Pretty.T
    30   val pretty_thm: Proof.context -> thm -> Pretty.T
    35   val pretty_thm: Proof.context -> thm -> Pretty.T
    31   val str_of_source: Args.src -> string
    36   val str_of_source: Args.src -> string
    32   val maybe_pretty_source: ('a -> Pretty.T) -> Args.src -> 'a list -> Pretty.T list
    37   val maybe_pretty_source: (Proof.context -> 'a -> Pretty.T) -> Proof.context ->
    33   val output: Pretty.T list -> string
    38     Args.src -> 'a list -> Pretty.T list
       
    39   val output: Proof.context -> Pretty.T list -> string
    34 end;
    40 end;
    35 
    41 
    36 structure Thy_Output: THY_OUTPUT =
    42 structure Thy_Output: THY_OUTPUT =
    37 struct
    43 struct
    38 
    44 
    39 (** global options **)
    45 (** global options **)
    40 
    46 
    41 val display = Unsynchronized.ref false;
    47 val display_default = Unsynchronized.ref false;
    42 val quotes = Unsynchronized.ref false;
    48 val quotes_default = Unsynchronized.ref false;
    43 val indent = Unsynchronized.ref 0;
    49 val indent_default = Unsynchronized.ref 0;
    44 val source = Unsynchronized.ref false;
    50 val source_default = Unsynchronized.ref false;
    45 val break = Unsynchronized.ref false;
    51 val break_default = Unsynchronized.ref false;
       
    52 
       
    53 val (display, setup_display) = Attrib.config_bool "thy_output_display" (fn _ => ! display_default);
       
    54 val (quotes, setup_quotes) = Attrib.config_bool "thy_output_quotes" (fn _ => ! quotes_default);
       
    55 val (indent, setup_indent) = Attrib.config_int "thy_output_indent" (fn _ => ! indent_default);
       
    56 val (source, setup_source) = Attrib.config_bool "thy_output_source" (fn _ => ! source_default);
       
    57 val (break, setup_break) = Attrib.config_bool "thy_output_break" (fn _ => ! break_default);
       
    58 
       
    59 val _ = Context.>> (Context.map_theory
       
    60  (setup_display #> setup_quotes #> setup_indent #> setup_source #> setup_break));
    46 
    61 
    47 
    62 
    48 structure Wrappers = Proof_Data
    63 structure Wrappers = Proof_Data
    49 (
    64 (
    50   type T = ((unit -> string) -> unit -> string) list;
    65   type T = ((unit -> string) -> unit -> string) list;
   436 val _ = add_option "show_question_marks" (add_wrapper o setmp_CRITICAL show_question_marks o boolean);
   451 val _ = add_option "show_question_marks" (add_wrapper o setmp_CRITICAL show_question_marks o boolean);
   437 val _ = add_option "long_names" (add_wrapper o setmp_CRITICAL Name_Space.long_names o boolean);
   452 val _ = add_option "long_names" (add_wrapper o setmp_CRITICAL Name_Space.long_names o boolean);
   438 val _ = add_option "short_names" (add_wrapper o setmp_CRITICAL Name_Space.short_names o boolean);
   453 val _ = add_option "short_names" (add_wrapper o setmp_CRITICAL Name_Space.short_names o boolean);
   439 val _ = add_option "unique_names" (add_wrapper o setmp_CRITICAL Name_Space.unique_names o boolean);
   454 val _ = add_option "unique_names" (add_wrapper o setmp_CRITICAL Name_Space.unique_names o boolean);
   440 val _ = add_option "eta_contract" (add_wrapper o setmp_CRITICAL Syntax.eta_contract o boolean);
   455 val _ = add_option "eta_contract" (add_wrapper o setmp_CRITICAL Syntax.eta_contract o boolean);
   441 val _ = add_option "display" (add_wrapper o setmp_CRITICAL display o boolean);
   456 val _ = add_option "display" (Config.put display o boolean);
   442 val _ = add_option "break" (add_wrapper o setmp_CRITICAL break o boolean);
   457 val _ = add_option "break" (Config.put break o boolean);
   443 val _ = add_option "quotes" (add_wrapper o setmp_CRITICAL quotes o boolean);
   458 val _ = add_option "quotes" (Config.put quotes o boolean);
   444 val _ = add_option "mode" (add_wrapper o Print_Mode.with_modes o single);
   459 val _ = add_option "mode" (add_wrapper o Print_Mode.with_modes o single);
   445 val _ = add_option "margin" (add_wrapper o setmp_CRITICAL Pretty.margin_default o integer);
   460 val _ = add_option "margin" (add_wrapper o setmp_CRITICAL Pretty.margin_default o integer);
   446 val _ = add_option "indent" (add_wrapper o setmp_CRITICAL indent o integer);
   461 val _ = add_option "indent" (Config.put indent o integer);
   447 val _ = add_option "source" (add_wrapper o setmp_CRITICAL source o boolean);
   462 val _ = add_option "source" (Config.put source o boolean);
   448 val _ = add_option "goals_limit" (add_wrapper o setmp_CRITICAL goals_limit o integer);
   463 val _ = add_option "goals_limit" (add_wrapper o setmp_CRITICAL goals_limit o integer);
   449 
   464 
   450 
   465 
   451 (* basic pretty printing *)
   466 (* basic pretty printing *)
   452 
   467 
   453 fun tweak_line s =
   468 fun tweak_line ctxt s =
   454   if ! display then s else Symbol.strip_blanks s;
   469   if Config.get ctxt display then s else Symbol.strip_blanks s;
   455 
   470 
   456 val pretty_text = Pretty.chunks o map Pretty.str o map tweak_line o Library.split_lines;
   471 fun pretty_text ctxt =
       
   472   Pretty.chunks o map Pretty.str o map (tweak_line ctxt) o Library.split_lines;
   457 
   473 
   458 fun pretty_term ctxt t = Syntax.pretty_term (Variable.auto_fixes t ctxt) t;
   474 fun pretty_term ctxt t = Syntax.pretty_term (Variable.auto_fixes t ctxt) t;
   459 
   475 
   460 fun pretty_thm ctxt = pretty_term ctxt o Thm.full_prop_of;
   476 fun pretty_thm ctxt = pretty_term ctxt o Thm.full_prop_of;
   461 
   477 
   500 
   516 
   501 (* default output *)
   517 (* default output *)
   502 
   518 
   503 val str_of_source = space_implode " " o map Token.unparse o #2 o #1 o Args.dest_src;
   519 val str_of_source = space_implode " " o map Token.unparse o #2 o #1 o Args.dest_src;
   504 
   520 
   505 fun maybe_pretty_source pretty src xs =
   521 fun maybe_pretty_source pretty ctxt src xs =
   506   map pretty xs  (*always pretty in order to exhibit errors!*)
   522   map (pretty ctxt) xs  (*always pretty in order to exhibit errors!*)
   507   |> (if ! source then K [pretty_text (str_of_source src)] else I);
   523   |> (if Config.get ctxt source then K [pretty_text ctxt (str_of_source src)] else I);
   508 
   524 
   509 fun output prts =
   525 fun output ctxt prts =
   510   prts
   526   prts
   511   |> (if ! quotes then map Pretty.quote else I)
   527   |> (if Config.get ctxt quotes then map Pretty.quote else I)
   512   |> (if ! display then
   528   |> (if Config.get ctxt display then
   513     map (Output.output o Pretty.string_of o Pretty.indent (! indent))
   529     map (Output.output o Pretty.string_of o Pretty.indent (Config.get ctxt indent))
   514     #> space_implode "\\isasep\\isanewline%\n"
   530     #> space_implode "\\isasep\\isanewline%\n"
   515     #> enclose "\\begin{isabelle}%\n" "%\n\\end{isabelle}"
   531     #> enclose "\\begin{isabelle}%\n" "%\n\\end{isabelle}"
   516   else
   532   else
   517     map (Output.output o (if ! break then Pretty.string_of else Pretty.str_of))
   533     map (Output.output o (if Config.get ctxt break then Pretty.string_of else Pretty.str_of))
   518     #> space_implode "\\isasep\\isanewline%\n"
   534     #> space_implode "\\isasep\\isanewline%\n"
   519     #> enclose "\\isa{" "}");
   535     #> enclose "\\isa{" "}");
   520 
   536 
   521 
   537 
   522 
   538 
   525 (* basic entities *)
   541 (* basic entities *)
   526 
   542 
   527 local
   543 local
   528 
   544 
   529 fun basic_entities name scan pretty = antiquotation name scan
   545 fun basic_entities name scan pretty = antiquotation name scan
   530   (fn {source, context, ...} => output o maybe_pretty_source (pretty context) source);
   546   (fn {source, context, ...} => output context o maybe_pretty_source pretty context source);
   531 
   547 
   532 fun basic_entities_style name scan pretty = antiquotation name scan
   548 fun basic_entities_style name scan pretty = antiquotation name scan
   533   (fn {source, context, ...} => fn (style, xs) =>
   549   (fn {source, context, ...} => fn (style, xs) =>
   534     output (maybe_pretty_source (fn x => pretty context (style, x)) source xs));
   550     output context
       
   551       (maybe_pretty_source (fn ctxt => fn x => pretty ctxt (style, x)) context source xs));
   535 
   552 
   536 fun basic_entity name scan = basic_entities name (scan >> single);
   553 fun basic_entity name scan = basic_entities name (scan >> single);
   537 
   554 
   538 in
   555 in
   539 
   556 
   543 val _ = basic_entity "term_type" (Term_Style.parse -- Args.term) pretty_term_typ;
   560 val _ = basic_entity "term_type" (Term_Style.parse -- Args.term) pretty_term_typ;
   544 val _ = basic_entity "typeof" (Term_Style.parse -- Args.term) pretty_term_typeof;
   561 val _ = basic_entity "typeof" (Term_Style.parse -- Args.term) pretty_term_typeof;
   545 val _ = basic_entity "const" (Args.const_proper false) pretty_const;
   562 val _ = basic_entity "const" (Args.const_proper false) pretty_const;
   546 val _ = basic_entity "abbrev" (Scan.lift Args.name_source) pretty_abbrev;
   563 val _ = basic_entity "abbrev" (Scan.lift Args.name_source) pretty_abbrev;
   547 val _ = basic_entity "typ" Args.typ_abbrev Syntax.pretty_typ;
   564 val _ = basic_entity "typ" Args.typ_abbrev Syntax.pretty_typ;
   548 val _ = basic_entity "text" (Scan.lift Args.name) (K pretty_text);
   565 val _ = basic_entity "text" (Scan.lift Args.name) pretty_text;
   549 val _ = basic_entities "prf" Attrib.thms (pretty_prf false);
   566 val _ = basic_entities "prf" Attrib.thms (pretty_prf false);
   550 val _ = basic_entities "full_prf" Attrib.thms (pretty_prf true);
   567 val _ = basic_entities "full_prf" Attrib.thms (pretty_prf true);
   551 val _ = basic_entity "theory" (Scan.lift Args.name) pretty_theory;
   568 val _ = basic_entity "theory" (Scan.lift Args.name) pretty_theory;
   552 
   569 
   553 val _ = basic_entities_style "thm_style" (Term_Style.parse_bare -- Attrib.thms) pretty_thm_style;
   570 val _ = basic_entities_style "thm_style" (Term_Style.parse_bare -- Attrib.thms) pretty_thm_style;
   564   (case try Toplevel.proof_of state of
   581   (case try Toplevel.proof_of state of
   565     SOME prf => prf
   582     SOME prf => prf
   566   | _ => error "No proof state");
   583   | _ => error "No proof state");
   567 
   584 
   568 fun goal_state name main_goal = antiquotation name (Scan.succeed ())
   585 fun goal_state name main_goal = antiquotation name (Scan.succeed ())
   569   (fn {state, ...} => fn () => output
   586   (fn {state, context, ...} => fn () => output context
   570     [Pretty.chunks (Proof.pretty_goals main_goal (proof_state state))]);
   587     [Pretty.chunks (Proof.pretty_goals main_goal (proof_state state))]);
   571 
   588 
   572 in
   589 in
   573 
   590 
   574 val _ = goal_state "goals" true;
   591 val _ = goal_state "goals" true;
   588       val prop_src =
   605       val prop_src =
   589         (case Args.dest_src source of ((a, arg :: _), pos) => Args.src ((a, [arg]), pos));
   606         (case Args.dest_src source of ((a, arg :: _), pos) => Args.src ((a, [arg]), pos));
   590       val _ = context
   607       val _ = context
   591         |> Proof.theorem NONE (K I) [[(prop, [])]]
   608         |> Proof.theorem NONE (K I) [[(prop, [])]]
   592         |> Proof.global_terminal_proof methods;
   609         |> Proof.global_terminal_proof methods;
   593     in output (maybe_pretty_source (pretty_term context) prop_src [prop]) end);
   610     in output context (maybe_pretty_source pretty_term context prop_src [prop]) end);
   594 
   611 
   595 
   612 
   596 (* ML text *)
   613 (* ML text *)
   597 
   614 
   598 local
   615 local
   599 
   616 
   600 fun ml_text name ml = antiquotation name (Scan.lift Args.name_source_position)
   617 fun ml_text name ml = antiquotation name (Scan.lift Args.name_source_position)
   601   (fn {context, ...} => fn (txt, pos) =>
   618   (fn {context, ...} => fn (txt, pos) =>
   602    (ML_Context.eval_in (SOME context) false pos (ml pos txt);
   619    (ML_Context.eval_in (SOME context) false pos (ml pos txt);
   603     Symbol_Pos.content (Symbol_Pos.explode (txt, pos))
   620     Symbol_Pos.content (Symbol_Pos.explode (txt, pos))
   604     |> (if ! quotes then quote else I)
   621     |> (if Config.get context quotes then quote else I)
   605     |> (if ! display then enclose "\\begin{verbatim}\n" "\n\\end{verbatim}"
   622     |> (if Config.get context display then enclose "\\begin{verbatim}\n" "\n\\end{verbatim}"
   606     else
   623     else
   607       split_lines
   624       split_lines
   608       #> map (space_implode "\\verb,|," o map (enclose "\\verb|" "|") o space_explode "|")
   625       #> map (space_implode "\\verb,|," o map (enclose "\\verb|" "|") o space_explode "|")
   609       #> space_implode "\\isasep\\isanewline%\n")));
   626       #> space_implode "\\isasep\\isanewline%\n")));
   610 
   627