37 (** options **) |
39 (** options **) |
38 |
40 |
39 val show_consts_default = Goal_Display.show_consts_default; |
41 val show_consts_default = Goal_Display.show_consts_default; |
40 val show_consts = Goal_Display.show_consts; |
42 val show_consts = Goal_Display.show_consts; |
41 |
43 |
42 val show_hyps = Unsynchronized.ref false; (*false: print meta-hypotheses as dots*) |
44 val show_hyps_raw = Config.declare "show_hyps" (fn _ => Config.Bool false); |
43 val show_tags = Unsynchronized.ref false; (*false: suppress tags*) |
45 val show_hyps = Config.bool show_hyps_raw; |
|
46 |
|
47 val show_tags_raw = Config.declare "show_tags" (fn _ => Config.Bool false); |
|
48 val show_tags = Config.bool show_tags_raw; |
44 |
49 |
45 |
50 |
46 |
51 |
47 (** print thm **) |
52 (** print thm **) |
48 |
53 |
49 fun pretty_tag (name, arg) = Pretty.strs [name, quote arg]; |
54 fun pretty_tag (name, arg) = Pretty.strs [name, quote arg]; |
50 val pretty_tags = Pretty.list "[" "]" o map pretty_tag; |
55 val pretty_tags = Pretty.list "[" "]" o map pretty_tag; |
51 |
56 |
52 fun display_status false _ = "" |
57 fun display_status _ false _ = "" |
53 | display_status true th = |
58 | display_status show_hyps true th = |
54 let |
59 let |
55 val {oracle = oracle0, unfinished, failed} = Thm.status_of th; |
60 val {oracle = oracle0, unfinished, failed} = Thm.status_of th; |
56 val oracle = oracle0 andalso (not (! quick_and_dirty) orelse ! show_hyps); |
61 val oracle = oracle0 andalso (not (! quick_and_dirty) orelse show_hyps); |
57 in |
62 in |
58 if failed then "!!" |
63 if failed then "!!" |
59 else if oracle andalso unfinished then "!?" |
64 else if oracle andalso unfinished then "!?" |
60 else if oracle then "!" |
65 else if oracle then "!" |
61 else if unfinished then "?" |
66 else if unfinished then "?" |
62 else "" |
67 else "" |
63 end; |
68 end; |
64 |
69 |
65 fun pretty_thm_raw ctxt {quote, show_hyps = show_hyps', show_status} raw_th = |
70 fun pretty_thm_raw ctxt {quote, show_hyps = show_hyps', show_status} raw_th = |
66 let |
71 let |
|
72 val show_tags = Config.get ctxt show_tags; |
|
73 val show_hyps = Config.get ctxt show_hyps; |
|
74 |
67 val th = Thm.strip_shyps raw_th; |
75 val th = Thm.strip_shyps raw_th; |
68 val {hyps, tpairs, prop, ...} = Thm.rep_thm th; |
76 val {hyps, tpairs, prop, ...} = Thm.rep_thm th; |
69 val xshyps = Thm.extra_shyps th; |
77 val xshyps = Thm.extra_shyps th; |
70 val tags = Thm.get_tags th; |
78 val tags = Thm.get_tags th; |
71 |
79 |
72 val q = if quote then Pretty.quote else I; |
80 val q = if quote then Pretty.quote else I; |
73 val prt_term = q o Syntax.pretty_term ctxt; |
81 val prt_term = q o Syntax.pretty_term ctxt; |
74 |
82 |
75 val asms = map Thm.term_of (Assumption.all_assms_of ctxt); |
83 val asms = map Thm.term_of (Assumption.all_assms_of ctxt); |
76 val hyps' = if ! show_hyps then hyps else subtract (op aconv) asms hyps; |
84 val hyps' = if show_hyps then hyps else subtract (op aconv) asms hyps; |
77 val status = display_status show_status th; |
85 val status = display_status show_hyps show_status th; |
78 |
86 |
79 val hlen = length xshyps + length hyps' + length tpairs; |
87 val hlen = length xshyps + length hyps' + length tpairs; |
80 val hsymbs = |
88 val hsymbs = |
81 if hlen = 0 andalso status = "" then [] |
89 if hlen = 0 andalso status = "" then [] |
82 else if ! show_hyps orelse show_hyps' then |
90 else if show_hyps orelse show_hyps' then |
83 [Pretty.brk 2, Pretty.list "[" "]" |
91 [Pretty.brk 2, Pretty.list "[" "]" |
84 (map (q o Goal_Display.pretty_flexpair ctxt) tpairs @ map prt_term hyps' @ |
92 (map (q o Goal_Display.pretty_flexpair ctxt) tpairs @ map prt_term hyps' @ |
85 map (Syntax.pretty_sort ctxt) xshyps @ |
93 map (Syntax.pretty_sort ctxt) xshyps @ |
86 (if status = "" then [] else [Pretty.str status]))] |
94 (if status = "" then [] else [Pretty.str status]))] |
87 else [Pretty.brk 2, Pretty.str ("[" ^ implode (replicate hlen ".") ^ status ^ "]")]; |
95 else [Pretty.brk 2, Pretty.str ("[" ^ implode (replicate hlen ".") ^ status ^ "]")]; |
88 val tsymbs = |
96 val tsymbs = |
89 if null tags orelse not (! show_tags) then [] |
97 if null tags orelse not show_tags then [] |
90 else [Pretty.brk 1, pretty_tags tags]; |
98 else [Pretty.brk 1, pretty_tags tags]; |
91 in Pretty.block (prt_term prop :: (hsymbs @ tsymbs)) end; |
99 in Pretty.block (prt_term prop :: (hsymbs @ tsymbs)) end; |
92 |
100 |
93 fun pretty_thm_aux ctxt show_status = |
101 fun pretty_thm_aux ctxt show_status = |
94 pretty_thm_raw ctxt {quote = false, show_hyps = true, show_status = show_status}; |
102 pretty_thm_raw ctxt {quote = false, show_hyps = true, show_status = show_status}; |