less verbosity in batch mode -- spam reduction and notable performance improvement;
authorwenzelm
Sat, 13 Aug 2011 22:04:07 +0200
changeset 45063a32ca9165928
parent 45062 be78e13a80d6
child 45064 013f7b14f6ff
less verbosity in batch mode -- spam reduction and notable performance improvement;
clarified Proof_Display.print_consts;
src/HOL/Tools/Function/function.ML
src/Pure/Isar/isar_syn.ML
src/Pure/Isar/proof_display.ML
src/Pure/Isar/specification.ML
     1.1 --- a/src/HOL/Tools/Function/function.ML	Sat Aug 13 21:28:01 2011 +0200
     1.2 +++ b/src/HOL/Tools/Function/function.ML	Sat Aug 13 22:04:07 2011 +0200
     1.3 @@ -125,9 +125,7 @@
     1.4            pinducts=snd pinducts', simps=NONE, inducts=NONE, termination=termination',
     1.5            fs=fs, R=R, defname=defname, is_partial=true }
     1.6  
     1.7 -        val _ =
     1.8 -          if not is_external then ()
     1.9 -          else Specification.print_consts lthy (K false) (map fst fixes)
    1.10 +        val _ = Proof_Display.print_consts is_external lthy (K false) (map fst fixes)
    1.11        in
    1.12          (info, 
    1.13           lthy |> Local_Theory.declaration false (add_function_data o morph_function_data info))
     2.1 --- a/src/Pure/Isar/isar_syn.ML	Sat Aug 13 21:28:01 2011 +0200
     2.2 +++ b/src/Pure/Isar/isar_syn.ML	Sat Aug 13 22:04:07 2011 +0200
     2.3 @@ -218,11 +218,11 @@
     2.4  (* constant definitions and abbreviations *)
     2.5  
     2.6  val _ =
     2.7 -  Outer_Syntax.local_theory "definition" "constant definition" Keyword.thy_decl
     2.8 -    (Parse_Spec.constdef >> (fn args => #2 o Specification.definition_cmd args));
     2.9 +  Outer_Syntax.local_theory' "definition" "constant definition" Keyword.thy_decl
    2.10 +    (Parse_Spec.constdef >> (fn args => #2 oo Specification.definition_cmd args));
    2.11  
    2.12  val _ =
    2.13 -  Outer_Syntax.local_theory "abbreviation" "constant abbreviation" Keyword.thy_decl
    2.14 +  Outer_Syntax.local_theory' "abbreviation" "constant abbreviation" Keyword.thy_decl
    2.15      (opt_mode -- (Scan.option Parse_Spec.constdecl -- Parse.prop)
    2.16        >> (fn (mode, args) => Specification.abbreviation_cmd mode args));
    2.17  
    2.18 @@ -263,18 +263,18 @@
    2.19  (* theorems *)
    2.20  
    2.21  fun theorems kind =
    2.22 -  Parse_Spec.name_facts >> (fn args => #2 o Specification.theorems_cmd kind args);
    2.23 +  Parse_Spec.name_facts >> (fn args => #2 oo Specification.theorems_cmd kind args);
    2.24  
    2.25  val _ =
    2.26 -  Outer_Syntax.local_theory "theorems" "define theorems" Keyword.thy_decl (theorems Thm.theoremK);
    2.27 +  Outer_Syntax.local_theory' "theorems" "define theorems" Keyword.thy_decl (theorems Thm.theoremK);
    2.28  
    2.29  val _ =
    2.30 -  Outer_Syntax.local_theory "lemmas" "define lemmas" Keyword.thy_decl (theorems Thm.lemmaK);
    2.31 +  Outer_Syntax.local_theory' "lemmas" "define lemmas" Keyword.thy_decl (theorems Thm.lemmaK);
    2.32  
    2.33  val _ =
    2.34 -  Outer_Syntax.local_theory "declare" "declare theorems" Keyword.thy_decl
    2.35 +  Outer_Syntax.local_theory' "declare" "declare theorems" Keyword.thy_decl
    2.36      (Parse.and_list1 Parse_Spec.xthms1
    2.37 -      >> (fn args => #2 o Specification.theorems_cmd "" [(Attrib.empty_binding, flat args)]));
    2.38 +      >> (fn args => #2 oo Specification.theorems_cmd "" [(Attrib.empty_binding, flat args)]));
    2.39  
    2.40  
    2.41  (* name space entry path *)
     3.1 --- a/src/Pure/Isar/proof_display.ML	Sat Aug 13 21:28:01 2011 +0200
     3.2 +++ b/src/Pure/Isar/proof_display.ML	Sat Aug 13 22:04:07 2011 +0200
     3.3 @@ -18,7 +18,7 @@
     3.4    val print_theory: theory -> unit
     3.5    val string_of_rule: Proof.context -> string -> thm -> string
     3.6    val print_results: bool -> Proof.context -> ((string * string) * (string * thm list) list) -> unit
     3.7 -  val pretty_consts: Proof.context -> (string * typ -> bool) -> (string * typ) list -> Pretty.T
     3.8 +  val print_consts: bool -> Proof.context -> (string * typ -> bool) -> (string * typ) list -> unit
     3.9  end
    3.10  
    3.11  structure Proof_Display: PROOF_DISPLAY =
    3.12 @@ -115,13 +115,17 @@
    3.13  
    3.14  fun pretty_vars ctxt kind vs = Pretty.big_list kind (map (pretty_var ctxt) vs);
    3.15  
    3.16 -in
    3.17 -
    3.18  fun pretty_consts ctxt pred cs =
    3.19    (case filter pred (#1 (Proof_Context.inferred_fixes ctxt)) of
    3.20      [] => pretty_vars ctxt "constants" cs
    3.21    | ps => Pretty.chunks [pretty_vars ctxt "parameters" ps, pretty_vars ctxt "constants" cs]);
    3.22  
    3.23 +in
    3.24 +
    3.25 +fun print_consts do_print ctxt pred cs =
    3.26 +  if not do_print orelse null cs then ()
    3.27 +  else Pretty.writeln (pretty_consts ctxt pred cs);
    3.28 +
    3.29  end;
    3.30  
    3.31  end;
     4.1 --- a/src/Pure/Isar/specification.ML	Sat Aug 13 21:28:01 2011 +0200
     4.2 +++ b/src/Pure/Isar/specification.ML	Sat Aug 13 22:04:07 2011 +0200
     4.3 @@ -7,7 +7,6 @@
     4.4  
     4.5  signature SPECIFICATION =
     4.6  sig
     4.7 -  val print_consts: local_theory -> (string * typ -> bool) -> (string * typ) list -> unit
     4.8    val check_spec:
     4.9      (binding * typ option * mixfix) list -> (Attrib.binding * term) list -> Proof.context ->
    4.10      (((binding * typ) * mixfix) list * (Attrib.binding * term) list) * Proof.context
    4.11 @@ -37,23 +36,26 @@
    4.12    val definition:
    4.13      (binding * typ option * mixfix) option * (Attrib.binding * term) ->
    4.14      local_theory -> (term * (string * thm)) * local_theory
    4.15 +  val definition':
    4.16 +    (binding * typ option * mixfix) option * (Attrib.binding * term) ->
    4.17 +    bool -> local_theory -> (term * (string * thm)) * local_theory
    4.18    val definition_cmd:
    4.19      (binding * string option * mixfix) option * (Attrib.binding * string) ->
    4.20 -    local_theory -> (term * (string * thm)) * local_theory
    4.21 +    bool -> local_theory -> (term * (string * thm)) * local_theory
    4.22    val abbreviation: Syntax.mode -> (binding * typ option * mixfix) option * term ->
    4.23 -    local_theory -> local_theory
    4.24 +    bool -> local_theory -> local_theory
    4.25    val abbreviation_cmd: Syntax.mode -> (binding * string option * mixfix) option * string ->
    4.26 -    local_theory -> local_theory
    4.27 +    bool -> local_theory -> local_theory
    4.28    val type_notation: bool -> Syntax.mode -> (typ * mixfix) list -> local_theory -> local_theory
    4.29    val type_notation_cmd: bool -> Syntax.mode -> (string * mixfix) list -> local_theory -> local_theory
    4.30    val notation: bool -> Syntax.mode -> (term * mixfix) list -> local_theory -> local_theory
    4.31    val notation_cmd: bool -> Syntax.mode -> (string * mixfix) list -> local_theory -> local_theory
    4.32    val theorems: string ->
    4.33      (Attrib.binding * (thm list * Attrib.src list) list) list ->
    4.34 -    local_theory -> (string * thm list) list * local_theory
    4.35 +    bool -> local_theory -> (string * thm list) list * local_theory
    4.36    val theorems_cmd: string ->
    4.37      (Attrib.binding * (Facts.ref * Attrib.src list) list) list ->
    4.38 -    local_theory -> (string * thm list) list * local_theory
    4.39 +    bool -> local_theory -> (string * thm list) list * local_theory
    4.40    val theorem: string -> Method.text option ->
    4.41      (thm list list -> local_theory -> local_theory) -> Attrib.binding ->
    4.42      Element.context_i list -> Element.statement_i ->
    4.43 @@ -76,12 +78,6 @@
    4.44  structure Specification: SPECIFICATION =
    4.45  struct
    4.46  
    4.47 -(* diagnostics *)
    4.48 -
    4.49 -fun print_consts _ _ [] = ()
    4.50 -  | print_consts ctxt pred cs = Pretty.writeln (Proof_Display.pretty_consts ctxt pred cs);
    4.51 -
    4.52 -
    4.53  (* prepare specification *)
    4.54  
    4.55  local
    4.56 @@ -166,7 +162,7 @@
    4.57  
    4.58  (* axiomatization -- within global theory *)
    4.59  
    4.60 -fun gen_axioms do_print prep raw_vars raw_specs thy =
    4.61 +fun gen_axioms prep raw_vars raw_specs thy =
    4.62    let
    4.63      val ((vars, specs), _) = prep raw_vars raw_specs (Proof_Context.init_global thy);
    4.64      val xs = map (fn ((b, T), _) => (Variable.check_name b, T)) vars;
    4.65 @@ -188,13 +184,10 @@
    4.66        |> Spec_Rules.add Spec_Rules.Unknown (consts, maps (maps #1 o #2) axioms)
    4.67        |> Local_Theory.notes axioms;
    4.68  
    4.69 -    val _ =
    4.70 -      if not do_print then ()
    4.71 -      else print_consts facts_lthy (K false) xs;
    4.72    in ((consts, map #2 facts), Local_Theory.exit_global facts_lthy) end;
    4.73  
    4.74 -val axiomatization = gen_axioms false check_specification;
    4.75 -val axiomatization_cmd = gen_axioms true read_specification;
    4.76 +val axiomatization = gen_axioms check_specification;
    4.77 +val axiomatization_cmd = gen_axioms read_specification;
    4.78  
    4.79  fun axiom (b, ax) = axiomatization [] [(b, [ax])] #>> (hd o hd o snd);
    4.80  fun axiom_cmd (b, ax) = axiomatization_cmd [] [(b, [ax])] #>> (hd o hd o snd);
    4.81 @@ -202,7 +195,7 @@
    4.82  
    4.83  (* definition *)
    4.84  
    4.85 -fun gen_def do_print prep (raw_var, raw_spec) lthy =
    4.86 +fun gen_def prep (raw_var, raw_spec) int lthy =
    4.87    let
    4.88      val (vars, [((raw_name, atts), prop)]) = fst (prep (the_list raw_var) [raw_spec] lthy);
    4.89      val (((x, T), rhs), prove) = Local_Defs.derived_def lthy true prop;
    4.90 @@ -228,18 +221,18 @@
    4.91          [((name, Code.add_default_eqn_attrib :: atts), [([th], [])])];
    4.92  
    4.93      val lhs' = Morphism.term (Local_Theory.target_morphism lthy4) lhs;
    4.94 -    val _ =
    4.95 -      if not do_print then ()
    4.96 -      else print_consts lthy4 (member (op =) (Term.add_frees lhs' [])) [(x, T)];
    4.97 +
    4.98 +    val _ = Proof_Display.print_consts int lthy4 (member (op =) (Term.add_frees lhs' [])) [(x, T)];
    4.99    in ((lhs, (def_name, th')), lthy4) end;
   4.100  
   4.101 -val definition = gen_def false check_free_spec;
   4.102 -val definition_cmd = gen_def true read_free_spec;
   4.103 +val definition' = gen_def check_free_spec;
   4.104 +fun definition spec = definition' spec false;
   4.105 +val definition_cmd = gen_def read_free_spec;
   4.106  
   4.107  
   4.108  (* abbreviation *)
   4.109  
   4.110 -fun gen_abbrev do_print prep mode (raw_var, raw_prop) lthy =
   4.111 +fun gen_abbrev prep mode (raw_var, raw_prop) int lthy =
   4.112    let
   4.113      val ((vars, [(_, prop)]), _) =
   4.114        prep (the_list raw_var) [(Attrib.empty_binding, raw_prop)]
   4.115 @@ -260,11 +253,11 @@
   4.116        |> Local_Theory.abbrev mode (var, rhs) |> snd
   4.117        |> Proof_Context.restore_syntax_mode lthy;
   4.118  
   4.119 -    val _ = if not do_print then () else print_consts lthy' (K false) [(x, T)];
   4.120 +    val _ = Proof_Display.print_consts int lthy' (K false) [(x, T)];
   4.121    in lthy' end;
   4.122  
   4.123 -val abbreviation = gen_abbrev false check_free_spec;
   4.124 -val abbreviation_cmd = gen_abbrev true read_free_spec;
   4.125 +val abbreviation = gen_abbrev check_free_spec;
   4.126 +val abbreviation_cmd = gen_abbrev read_free_spec;
   4.127  
   4.128  
   4.129  (* notation *)
   4.130 @@ -290,14 +283,14 @@
   4.131  
   4.132  (* fact statements *)
   4.133  
   4.134 -fun gen_theorems prep_fact prep_att kind raw_facts lthy =
   4.135 +fun gen_theorems prep_fact prep_att kind raw_facts int lthy =
   4.136    let
   4.137      val attrib = prep_att (Proof_Context.theory_of lthy);
   4.138      val facts = raw_facts |> map (fn ((name, atts), bs) =>
   4.139        ((name, map attrib atts),
   4.140          bs |> map (fn (b, more_atts) => (prep_fact lthy b, map attrib more_atts))));
   4.141      val (res, lthy') = lthy |> Local_Theory.notes_kind kind facts;
   4.142 -    val _ = Proof_Display.print_results true lthy' ((kind, ""), res);
   4.143 +    val _ = Proof_Display.print_results int lthy' ((kind, ""), res);
   4.144    in (res, lthy') end;
   4.145  
   4.146  val theorems = gen_theorems (K I) (K I);
   4.147 @@ -389,12 +382,12 @@
   4.148            (map2 (fn (a, _) => fn ths => (a, [(ths, [])])) stmt results')
   4.149          |> (fn (res, lthy') =>
   4.150            if Binding.is_empty name andalso null atts then
   4.151 -            (Proof_Display.print_results true lthy' ((kind, ""), res); lthy')
   4.152 +            (Proof_Display.print_results int lthy' ((kind, ""), res); lthy')
   4.153            else
   4.154              let
   4.155                val ([(res_name, _)], lthy'') = lthy'
   4.156                  |> Local_Theory.notes_kind kind [((name, atts), [(maps #2 res, [])])];
   4.157 -              val _ = Proof_Display.print_results true lthy' ((kind, res_name), res);
   4.158 +              val _ = Proof_Display.print_results int lthy' ((kind, res_name), res);
   4.159              in lthy'' end)
   4.160          |> after_qed results'
   4.161        end;
   4.162 @@ -411,7 +404,8 @@
   4.163  
   4.164  in
   4.165  
   4.166 -val theorem = gen_theorem false (K I) Expression.cert_statement;
   4.167 +val theorem' = gen_theorem false (K I) Expression.cert_statement;
   4.168 +fun theorem a b c d e f = theorem' a b c d e f;
   4.169  val theorem_cmd = gen_theorem false Attrib.intern_src Expression.read_statement;
   4.170  
   4.171  val schematic_theorem = gen_theorem true (K I) Expression.cert_statement;