src/Pure/Isar/element.ML
changeset 64398 5076725247fa
parent 63395 734723445a8c
child 67522 9e712280cc37
equal deleted inserted replaced
64397:6e9c22c494c5 64398:5076725247fa
   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