]> matita.cs.unibo.it Git - helm.git/blob - helm/software/helena/src/automath/autOutput.ml
new message reporting system improves performance significatively
[helm.git] / helm / software / helena / src / automath / autOutput.ml
1 (*
2     ||M||  This file is part of HELM, an Hypertextual, Electronic        
3     ||A||  Library of Mathematics, developed at the Computer Science     
4     ||T||  Department, University of Bologna, Italy.                     
5     ||I||                                                                
6     ||T||  HELM is free software; you can redistribute it and/or         
7     ||A||  modify it under the terms of the GNU General Public License   
8     \   /  version 2 or (at your option) any later version.              
9      \ /   This software is distributed as is, NO WARRANTY.              
10       V_______________________________________________________________ *)
11
12 module P  = Printf
13 module C  = Cps
14 module L  = Log
15 module A  = Aut
16 module AA = AutProcess
17
18 type counters = {
19    sections: int;
20    contexts: int;
21    blocks:   int;
22    decls:    int;
23    defs:     int;
24    sorts:    int;
25    grefs:    int;
26    appls:    int;
27    absts:    int;
28    pars:     int;
29    xnodes:   int
30 }
31
32 let level = 2
33
34 let initial_counters = {
35    sections = 0; contexts = 0; blocks = 0; decls = 0; defs = 0;
36    sorts = 0; grefs = 0; appls = 0; absts = 0; pars = 0; xnodes = 0
37 }
38
39 let rec count_term f c = function
40    | A.Sort _         -> 
41       f {c with sorts = succ c.sorts; xnodes = succ c.xnodes}
42    | A.GRef (_, ts)   -> 
43       let c = {c with grefs = succ c.grefs} in
44       let c = {c with pars = c.pars + List.length ts} in
45       let c = {c with xnodes = succ c.xnodes + List.length ts} in
46       C.list_fold_left f count_term c ts
47    | A.Appl (v, t)    -> 
48       let c = {c with appls = succ c.appls; xnodes = succ c.xnodes} in
49       let f c = count_term f c t in
50       count_term f c v
51    | A.Abst (_, w, t) -> 
52       let c = {c with absts = succ c.absts; xnodes = succ c.xnodes} in
53       let f c = count_term f c t in
54       count_term f c w
55
56 let count_command f c = function
57    | A.Section _        ->
58       f {c with sections = succ c.sections}
59    | A.Context _        ->
60       f {c with contexts = succ c.contexts}
61    | A.Block (_, w)     -> 
62       let c = {c with blocks = succ c.blocks; xnodes = succ c.xnodes} in
63       count_term f c w
64    | A.Decl (_, w)      -> 
65       let c = {c with decls = succ c.decls; xnodes = succ c.xnodes} in
66       count_term f c w
67    | A.Def (_, w, _, t) -> 
68       let c = {c with defs = succ c.defs; xnodes = succ c.xnodes} in
69       let f c = count_term f c t in
70       count_term f c w
71
72 let print_counters f c =
73    let terms = c.sorts + c.grefs + c.appls + c.absts in
74    let entities = c.sections + c.contexts + c.blocks + c.decls + c.defs in
75    L.warn level (P.sprintf "Automath representation summary");
76    L.warn level (P.sprintf "  Total book entities:      %7u" entities);
77    L.warn level (P.sprintf "    Section entities:       %7u" c.sections);
78    L.warn level (P.sprintf "    Context entities:       %7u" c.contexts);
79    L.warn level (P.sprintf "    Block entities:         %7u" c.blocks);
80    L.warn level (P.sprintf "    Declaration entities:   %7u" c.decls);
81    L.warn level (P.sprintf "    Definition entities:    %7u" c.defs);
82    L.warn level (P.sprintf "  Total Parameter items:    %7u" c.pars);
83    L.warn level (P.sprintf "    Application items:      %7u" c.pars);
84    L.warn level (P.sprintf "  Total term items:         %7u" terms);
85    L.warn level (P.sprintf "    Sort items:             %7u" c.sorts);
86    L.warn level (P.sprintf "    Reference items:        %7u" c.grefs);
87    L.warn level (P.sprintf "    Application items:      %7u" c.appls);
88    L.warn level (P.sprintf "    Abstraction items:      %7u" c.absts);
89    L.warn level (P.sprintf "  Global Int. Complexity:   unknown");
90    L.warn level (P.sprintf "    + Abbreviation nodes:   %7u" c.xnodes);
91    f ()
92
93 let print_process_counters f c =
94    let f iao iar iac iag =
95       L.warn level (P.sprintf "Automath process summary");
96       L.warn level (P.sprintf "  Implicit after opening:   %7u" iao);
97       L.warn level (P.sprintf "  Implicit after reopening: %7u" iar);
98       L.warn level (P.sprintf "  Implicit after closing:   %7u" iac);
99       L.warn level (P.sprintf "  Implicit after global:    %7u" iag);
100       f ()
101    in
102    AA.get_counters f c