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 |