1structure comparelogs =
2struct
3
4val theory_width = 30
5
6
7structure Process = OS.Process
8
9
10fun die s = (TextIO.output(TextIO.stdErr, s ^ "\n");
11             Process.exit Process.failure)
12
13fun mkquiet {bequiet, diffsort, files} =
14    {bequiet = true, diffsort = diffsort, files = files}
15fun mkdiff {bequiet, diffsort, files} =
16    {bequiet = bequiet, diffsort = true, files = files}
17
18fun usage_msg appname =
19    "Usage:\n  " ^ appname ^ " file1 file2 ... filen\n\n" ^
20    "Options:\n\
21    \  -d    Sort results in order of the differences (only with two files)\n\
22    \  -q    Print raw data only, no sums, or fancy lines; (output to other tools)\n\
23    \  -h    Show this help message\n\
24    \  -?    Show this help message\n"
25
26fun show_usage appname =
27  (print (usage_msg appname); Process.exit Process.success)
28
29
30fun getargs appname args =
31  let
32    fun recurse args =
33      case args of
34        [] => {bequiet = false, diffsort = false, files = []}
35      | "-q" :: rest => mkquiet (recurse rest)
36      | "-d" :: rest => mkdiff (recurse rest)
37      | "-h" :: _ => show_usage appname
38      | "-?" :: _ => show_usage appname
39      | _ => {bequiet = false, diffsort = false, files = args}
40  in
41    recurse args
42  end
43
44fun print_dashes n =
45    (print (StringCvt.padLeft #"-" (15 * n + theory_width) "");
46     print "\n")
47
48fun read_file (fname,m) = let
49  val instr = TextIO.openIn fname
50  fun recurse m =
51    case TextIO.inputLine instr of
52      NONE => m
53    | SOME s => let
54        val [thyname, number_s] = String.tokens Char.isSpace s
55        val number = valOf (Real.fromString number_s)
56        val basemap =
57            case Binarymap.peek(m, fname) of
58              NONE => Binarymap.mkDict String.compare
59            | SOME m0 => m0
60        val submap = Binarymap.insert(basemap, thyname, number)
61      in
62        recurse (Binarymap.insert(m, fname, submap))
63      end
64in
65  recurse m before TextIO.closeIn instr
66end
67
68fun lookup m fname thy =
69    case Binarymap.peek(m, fname) of
70      NONE => NONE
71    | SOME m' => Binarymap.peek(m', thy)
72
73fun fmt_fname s = let
74  val s' = if size s > 14 then String.extract(s, size s - 14, NONE) else s
75in
76  StringCvt.padLeft #" " 15 s'
77end
78
79fun centered25 s = let
80  open StringCvt
81in
82  padLeft #" " 15 s
83end
84
85fun fmt_real r = centered25 (Real.fmt (StringCvt.FIX (SOME 3)) r)
86fun print_line m args thyname = let
87  open StringCvt
88  fun print_entry fname =
89      case lookup m fname thyname of
90        NONE => print (centered25 "--")
91      | SOME r => print (fmt_real r)
92in
93  print (StringCvt.padRight #" " theory_width thyname);
94  app print_entry args;
95  print "\n"
96end
97
98fun print_entry total_map fname = let
99  open StringCvt
100in
101  print (fmt_real (Binarymap.find(total_map, fname)))
102end
103
104fun main() = let
105  val args0 = CommandLine.arguments()
106  val {bequiet,diffsort,files = args} = getargs (CommandLine.name()) args0
107
108  val _ = if null args then die "Must specify at least one file to \"analyse\""
109          else ()
110
111  val _ = if length args <> 2 andalso diffsort then
112            die "-d option not appropriate when #files <> 2"
113          else ()
114  val base = hd args
115  val final_map = List.foldl read_file (Binarymap.mkDict String.compare) args
116  val base_theories =
117      map #1 (Binarymap.listItems (Binarymap.find(final_map, base)))
118      handle NotFound => die ("No data in base file: "^hd args)
119  val base_theories =
120    if diffsort then let
121        val [file1, file2] = args
122        fun nzero NONE = 0.0
123          | nzero (SOME r) = r
124        fun get f thy = nzero (lookup final_map f thy)
125        fun compare (thy1, thy2) = let
126          val t11 = get file1 thy1
127          val t12 = get file1 thy2
128          val t21 = get file2 thy1
129          val t22 = get file2 thy2
130        in
131          Real.compare (t21 - t11, t22 - t12)
132        end
133      in
134        Listsort.sort compare base_theories
135      end
136    else base_theories
137  fun calc_totals m = let
138    fun calc_file (fname, m0) = let
139      fun foldthis (thy, subtot) = let
140        val r = case lookup m fname thy of NONE => 0.0 | SOME v => v
141      in
142        subtot + r
143      end
144    in
145      Binarymap.insert(m0, fname, List.foldl foldthis 0.0 base_theories)
146    end
147  in
148    List.foldl calc_file (Binarymap.mkDict String.compare) args
149  end
150
151  val _ = if not bequiet then
152            (print (StringCvt.padLeft #" " theory_width "");
153             app (print o fmt_fname) args;
154             print "\n";
155             print_dashes (length args))
156          else ()
157
158  val _ = app (print_line final_map args) base_theories
159
160  val total_map = calc_totals final_map
161in
162  if not bequiet then
163    (print_dashes (length args);
164     print (StringCvt.padRight #" " theory_width "Total");
165     app (print_entry total_map) args;
166     print "\n")
167  else ()
168end
169
170end (* struct *)
171