|
1 (* Title: Pure/goal_display.ML |
|
2 Author: Lawrence C Paulson, Cambridge University Computer Laboratory |
|
3 Author: Makarius |
|
4 |
|
5 Display tactical goal state. |
|
6 *) |
|
7 |
|
8 signature GOAL_DISPLAY = |
|
9 sig |
|
10 val goals_limit: int ref |
|
11 val show_consts: bool ref |
|
12 val pretty_flexpair: Proof.context -> term * term -> Pretty.T |
|
13 val pretty_goals: Proof.context -> {total: bool, main: bool, maxgoals: int} -> |
|
14 thm -> Pretty.T list |
|
15 val pretty_goals_without_context: int -> thm -> Pretty.T list |
|
16 end; |
|
17 |
|
18 structure Goal_Display: GOAL_DISPLAY = |
|
19 struct |
|
20 |
|
21 val goals_limit = ref 10; (*max number of goals to print*) |
|
22 val show_consts = ref false; (*true: show consts with types in proof state output*) |
|
23 |
|
24 fun pretty_flexpair ctxt (t, u) = Pretty.block |
|
25 [Syntax.pretty_term ctxt t, Pretty.str " =?=", Pretty.brk 1, Syntax.pretty_term ctxt u]; |
|
26 |
|
27 |
|
28 (*print thm A1,...,An/B in "goal style" -- premises as numbered subgoals*) |
|
29 |
|
30 local |
|
31 |
|
32 fun ins_entry (x, y) = |
|
33 AList.default (op =) (x, []) #> |
|
34 AList.map_entry (op =) x (insert (op =) y); |
|
35 |
|
36 val add_consts = Term.fold_aterms |
|
37 (fn Const (c, T) => ins_entry (T, (c, T)) |
|
38 | _ => I); |
|
39 |
|
40 val add_vars = Term.fold_aterms |
|
41 (fn Free (x, T) => ins_entry (T, (x, ~1)) |
|
42 | Var (xi, T) => ins_entry (T, xi) |
|
43 | _ => I); |
|
44 |
|
45 val add_varsT = Term.fold_atyps |
|
46 (fn TFree (x, S) => ins_entry (S, (x, ~1)) |
|
47 | TVar (xi, S) => ins_entry (S, xi) |
|
48 | _ => I); |
|
49 |
|
50 fun sort_idxs vs = map (apsnd (sort (prod_ord string_ord int_ord))) vs; |
|
51 fun sort_cnsts cs = map (apsnd (sort_wrt fst)) cs; |
|
52 |
|
53 fun consts_of t = sort_cnsts (add_consts t []); |
|
54 fun vars_of t = sort_idxs (add_vars t []); |
|
55 fun varsT_of t = rev (sort_idxs (Term.fold_types add_varsT t [])); |
|
56 |
|
57 in |
|
58 |
|
59 fun pretty_goals ctxt {total, main, maxgoals} state = |
|
60 let |
|
61 val prt_sort = Syntax.pretty_sort ctxt; |
|
62 val prt_typ = Syntax.pretty_typ ctxt; |
|
63 val prt_term = Syntax.pretty_term ctxt; |
|
64 |
|
65 fun prt_atoms prt prtT (X, xs) = Pretty.block |
|
66 [Pretty.block (Pretty.commas (map prt xs)), Pretty.str " ::", |
|
67 Pretty.brk 1, prtT X]; |
|
68 |
|
69 fun prt_var (x, ~1) = prt_term (Syntax.free x) |
|
70 | prt_var xi = prt_term (Syntax.var xi); |
|
71 |
|
72 fun prt_varT (x, ~1) = prt_typ (TFree (x, [])) |
|
73 | prt_varT xi = prt_typ (TVar (xi, [])); |
|
74 |
|
75 val prt_consts = prt_atoms (prt_term o Const) prt_typ; |
|
76 val prt_vars = prt_atoms prt_var prt_typ; |
|
77 val prt_varsT = prt_atoms prt_varT prt_sort; |
|
78 |
|
79 |
|
80 fun pretty_list _ _ [] = [] |
|
81 | pretty_list name prt lst = [Pretty.big_list name (map prt lst)]; |
|
82 |
|
83 fun pretty_subgoal (n, A) = Pretty.markup Markup.subgoal |
|
84 [Pretty.str (" " ^ string_of_int n ^ ". "), prt_term A]; |
|
85 fun pretty_subgoals As = map pretty_subgoal (1 upto length As ~~ As); |
|
86 |
|
87 val pretty_ffpairs = pretty_list "flex-flex pairs:" (pretty_flexpair ctxt); |
|
88 |
|
89 val pretty_consts = pretty_list "constants:" prt_consts o consts_of; |
|
90 val pretty_vars = pretty_list "variables:" prt_vars o vars_of; |
|
91 val pretty_varsT = pretty_list "type variables:" prt_varsT o varsT_of; |
|
92 |
|
93 |
|
94 val {prop, tpairs, ...} = Thm.rep_thm state; |
|
95 val (As, B) = Logic.strip_horn prop; |
|
96 val ngoals = length As; |
|
97 |
|
98 fun pretty_gs (types, sorts) = |
|
99 (if main then [prt_term B] else []) @ |
|
100 (if ngoals = 0 then [Pretty.str "No subgoals!"] |
|
101 else if ngoals > maxgoals then |
|
102 pretty_subgoals (Library.take (maxgoals, As)) @ |
|
103 (if total then [Pretty.str ("A total of " ^ string_of_int ngoals ^ " subgoals...")] |
|
104 else []) |
|
105 else pretty_subgoals As) @ |
|
106 pretty_ffpairs tpairs @ |
|
107 (if ! show_consts then pretty_consts prop else []) @ |
|
108 (if types then pretty_vars prop else []) @ |
|
109 (if sorts then pretty_varsT prop else []); |
|
110 in |
|
111 setmp show_no_free_types true |
|
112 (setmp show_types (! show_types orelse ! show_sorts orelse ! show_all_types) |
|
113 (setmp show_sorts false pretty_gs)) |
|
114 (! show_types orelse ! show_sorts orelse ! show_all_types, ! show_sorts) |
|
115 end; |
|
116 |
|
117 fun pretty_goals_without_context n th = |
|
118 pretty_goals (Syntax.init_pretty_global (Thm.theory_of_thm th)) |
|
119 {total = true, main = true, maxgoals = n} th; |
|
120 |
|
121 end; |
|
122 |
|
123 end; |
|
124 |