src/Pure/display.ML
changeset 39166 19efc2af3e6c
parent 39125 f45d332a90e3
child 42358 b47d41d9f4b5
equal deleted inserted replaced
39165:e790a5560834 39166:19efc2af3e6c
     7 
     7 
     8 signature BASIC_DISPLAY =
     8 signature BASIC_DISPLAY =
     9 sig
     9 sig
    10   val show_consts_default: bool Unsynchronized.ref
    10   val show_consts_default: bool Unsynchronized.ref
    11   val show_consts: bool Config.T
    11   val show_consts: bool Config.T
    12   val show_hyps: bool Unsynchronized.ref
    12   val show_hyps_raw: Config.raw
    13   val show_tags: bool Unsynchronized.ref
    13   val show_hyps: bool Config.T
       
    14   val show_tags_raw: Config.raw
       
    15   val show_tags: bool Config.T
    14 end;
    16 end;
    15 
    17 
    16 signature DISPLAY =
    18 signature DISPLAY =
    17 sig
    19 sig
    18   include BASIC_DISPLAY
    20   include BASIC_DISPLAY
    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};