File: debug.ml

package info (click to toggle)
coinst 1.9.1-1
  • links: PTS, VCS
  • area: main
  • in suites: jessie, jessie-kfreebsd
  • size: 1,628 kB
  • ctags: 2,683
  • sloc: ml: 15,681; makefile: 149; ansic: 52
file content (53 lines) | stat: -rw-r--r-- 1,638 bytes parent folder | download | duplicates (4)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
(* Co-installability tools
 * http://coinst.irill.org/
 * Copyright (C) 2011 Jérôme Vouillon
 * Laboratoire PPS - CNRS Université Paris Diderot
 *
 * These programs are free software; you can redistribute them and/or
 * modify them under the terms of the GNU General Public License as
 * published by the Free Software Foundation; either version 2 of the
 * License, or (at your option) any later version.
 *
 * This program is distributed in the hope that it will be useful, but
 * WITHOUT ANY WARRANTY; without even the implied warranty of
 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
 * Lesser General Public License for more details.
 *
 * You should have received a copy of the GNU General Public License
 * along with this program.  If not, see <http://www.gnu.org/licenses/>.
 *)

type t = { mutable state : bool; name : string; desc : string }

let debugs = ref []
let association = Hashtbl.create 11

let make s desc l =
  let d =
    try
      List.assoc s !debugs
    with Not_found ->
      let d = { state = false; name = s; desc = desc } in
      debugs := (s, d) :: !debugs;
      d
  in
  List.iter (fun s' -> Hashtbl.add association s' s) l;
  fun () -> d.state

let print () =
  Format.eprintf "Debug options:@.";
  List.iter
    (fun (_, d) -> Format.eprintf "    %s: %s@." d.name d.desc) !debugs;
  exit 1

let rec set s =
  if s = "help" || not (List.mem_assoc s !debugs) then
    print ()
  else
    try
      let d = List.assoc s !debugs in
      if not d.state then begin
        d.state <- true;
        List.iter set (Hashtbl.find_all association s)
      end
    with Not_found -> ()