125 let |
125 let |
126 val prt_typ = Pretty.quote o Syntax.pretty_typ ctxt; |
126 val prt_typ = Pretty.quote o Syntax.pretty_typ ctxt; |
127 val prt_term = Pretty.quote o Syntax.pretty_term ctxt; |
127 val prt_term = Pretty.quote o Syntax.pretty_term ctxt; |
128 val prt_terms = separate (Pretty.keyword2 "and") o map prt_term; |
128 val prt_terms = separate (Pretty.keyword2 "and") o map prt_term; |
129 val prt_binding = Attrib.pretty_binding ctxt; |
129 val prt_binding = Attrib.pretty_binding ctxt; |
|
130 val prt_name = Proof_Context.pretty_name ctxt; |
130 |
131 |
131 fun prt_show (a, ts) = |
132 fun prt_show (a, ts) = |
132 Pretty.block (Pretty.breaks (prt_binding a ":" @ prt_terms (map fst ts))); |
133 Pretty.block (Pretty.breaks (prt_binding a ":" @ prt_terms (map fst ts))); |
133 |
134 |
134 fun prt_var (x, SOME T, _) = Pretty.block |
135 fun prt_var (x, SOME T, _) = Pretty.block |
135 [Pretty.str (Binding.name_of x ^ " ::"), Pretty.brk 1, prt_typ T] |
136 [prt_name (Binding.name_of x), Pretty.str " ::", Pretty.brk 1, prt_typ T] |
136 | prt_var (x, NONE, _) = Pretty.str (Binding.name_of x); |
137 | prt_var (x, NONE, _) = prt_name (Binding.name_of x); |
137 val prt_vars = separate (Pretty.keyword2 "and") o map prt_var; |
138 val prt_vars = separate (Pretty.keyword2 "and") o map prt_var; |
138 |
139 |
139 fun prt_obtain (_, ([], props)) = Pretty.block (Pretty.breaks (prt_terms props)) |
140 fun prt_obtain (_, ([], props)) = Pretty.block (Pretty.breaks (prt_terms props)) |
140 | prt_obtain (_, (vars, props)) = Pretty.block (Pretty.breaks |
141 | prt_obtain (_, (vars, props)) = Pretty.block (Pretty.breaks |
141 (prt_vars vars @ [Pretty.keyword2 "where"] @ prt_terms props)); |
142 (prt_vars vars @ [Pretty.keyword2 "where"] @ prt_terms props)); |
150 fun gen_pretty_ctxt show_attribs ctxt = |
151 fun gen_pretty_ctxt show_attribs ctxt = |
151 let |
152 let |
152 val prt_typ = Pretty.quote o Syntax.pretty_typ ctxt; |
153 val prt_typ = Pretty.quote o Syntax.pretty_typ ctxt; |
153 val prt_term = Pretty.quote o Syntax.pretty_term ctxt; |
154 val prt_term = Pretty.quote o Syntax.pretty_term ctxt; |
154 val prt_thm = Pretty.cartouche o Thm.pretty_thm ctxt; |
155 val prt_thm = Pretty.cartouche o Thm.pretty_thm ctxt; |
|
156 val prt_name = Proof_Context.pretty_name ctxt; |
155 |
157 |
156 fun prt_binding (b, atts) = |
158 fun prt_binding (b, atts) = |
157 Attrib.pretty_binding ctxt (b, if show_attribs then atts else []); |
159 Attrib.pretty_binding ctxt (b, if show_attribs then atts else []); |
158 |
160 |
159 fun prt_fact (ths, atts) = |
161 fun prt_fact (ths, atts) = |
163 Attrib.pretty_attribs ctxt atts; |
165 Attrib.pretty_attribs ctxt atts; |
164 |
166 |
165 fun prt_mixfix NoSyn = [] |
167 fun prt_mixfix NoSyn = [] |
166 | prt_mixfix mx = [Pretty.brk 2, Mixfix.pretty_mixfix mx]; |
168 | prt_mixfix mx = [Pretty.brk 2, Mixfix.pretty_mixfix mx]; |
167 |
169 |
168 fun prt_fix (x, SOME T, mx) = Pretty.block (Pretty.str (Binding.name_of x ^ " ::") :: |
170 fun prt_fix (x, SOME T, mx) = Pretty.block (prt_name (Binding.name_of x) :: Pretty.str " ::" :: |
169 Pretty.brk 1 :: prt_typ T :: Pretty.brk 1 :: prt_mixfix mx) |
171 Pretty.brk 1 :: prt_typ T :: Pretty.brk 1 :: prt_mixfix mx) |
170 | prt_fix (x, NONE, mx) = Pretty.block (Pretty.str (Binding.name_of x) :: |
172 | prt_fix (x, NONE, mx) = Pretty.block (prt_name (Binding.name_of x) :: |
171 Pretty.brk 1 :: prt_mixfix mx); |
173 Pretty.brk 1 :: prt_mixfix mx); |
172 fun prt_constrain (x, T) = prt_fix (Binding.name x, SOME T, NoSyn); |
174 fun prt_constrain (x, T) = prt_fix (Binding.name x, SOME T, NoSyn); |
173 |
175 |
174 fun prt_asm (a, ts) = |
176 fun prt_asm (a, ts) = |
175 Pretty.block (Pretty.breaks (prt_binding a ":" @ map (prt_term o fst) ts)); |
177 Pretty.block (Pretty.breaks (prt_binding a ":" @ map (prt_term o fst) ts)); |
202 val thesis = Var ((Auto_Bind.thesisN, Thm.maxidx_of th + 1), fastype_of C); |
204 val thesis = Var ((Auto_Bind.thesisN, Thm.maxidx_of th + 1), fastype_of C); |
203 val th' = Thm.instantiate ([], [(Term.dest_Var C, Thm.cterm_of ctxt thesis)]) th; |
205 val th' = Thm.instantiate ([], [(Term.dest_Var C, Thm.cterm_of ctxt thesis)]) th; |
204 in (th', true) end |
206 in (th', true) end |
205 | NONE => (th, false)); |
207 | NONE => (th, false)); |
206 |
208 |
207 fun thm_name kind th prts = |
209 fun thm_name ctxt kind th prts = |
208 let val head = |
210 let val head = |
209 if Thm.has_name_hint th then |
211 if Thm.has_name_hint th then |
210 Pretty.block [Pretty.keyword1 kind, |
212 Pretty.block [Pretty.keyword1 kind, Pretty.brk 1, |
211 Pretty.brk 1, Pretty.str (Long_Name.base_name (Thm.get_name_hint th) ^ ":")] |
213 Proof_Context.pretty_name ctxt (Long_Name.base_name (Thm.get_name_hint th)), Pretty.str ":"] |
212 else Pretty.keyword1 kind |
214 else Pretty.keyword1 kind |
213 in Pretty.block (Pretty.fbreaks (head :: prts)) end; |
215 in Pretty.block (Pretty.fbreaks (head :: prts)) end; |
214 |
216 |
215 fun obtain prop ctxt = |
217 fun obtain prop ctxt = |
216 let |
218 let |
242 pretty_ctxt ctxt' (Assumes (map (fn t => (Binding.empty_atts, [(t, [])])) assumes)) @ |
244 pretty_ctxt ctxt' (Assumes (map (fn t => (Binding.empty_atts, [(t, [])])) assumes)) @ |
243 (if null cases then pretty_stmt ctxt' (Shows [(Binding.empty_atts, [(concl, [])])]) |
245 (if null cases then pretty_stmt ctxt' (Shows [(Binding.empty_atts, [(concl, [])])]) |
244 else |
246 else |
245 let val (clauses, ctxt'') = fold_map obtain cases ctxt' |
247 let val (clauses, ctxt'') = fold_map obtain cases ctxt' |
246 in pretty_stmt ctxt'' (Obtains clauses) end) |
248 in pretty_stmt ctxt'' (Obtains clauses) end) |
247 end |> thm_name kind raw_th; |
249 end |> thm_name ctxt kind raw_th; |
248 |
250 |
249 end; |
251 end; |
250 |
252 |
251 |
253 |
252 |
254 |