matita/components/binaries/probe/options.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 A = Array
  13 module P = Printf
  14
  15 module C  = NCic
  16 module R  = Helm_registry
  17 module U  = NUri
  18 module US = NUri.UriSet
  19
  20 module UriPair = struct
  21
  22   type t = U.uri * U.uri
  23
  24   let equal (u1l,u1r) (u2l,u2r) =
  25      U.eq u1l u2l && U.eq u1r u2r
  26
  27   let compare (u1l,u1r) (u2l,u2r) =
  28     match U.compare u1l u2l with
  29     | 0 -> U.compare u1r u2r
  30     | c -> c
  31
  32   let hash (ul,ur) =
  33     Hashtbl.hash (U.hash ul, U.hash ur)
  34
  35 end
  36
  37 module UPS = Set.Make(UriPair)
  38
  39 type def_xflavour = [ C.def_flavour
  40                     | `Inductive
  41                     ]
  42
  43 let default_objs = US.empty
  44
  45 let default_srcs = US.empty
  46
  47 let default_names = US.empty
  48
  49 let default_remove = []
  50
  51 let default_exclude = []
  52
  53 let default_net = 0
  54
  55 let default_chars = 0
  56
  57 let default_debug_lexer = false
  58
  59 let default_no_devel = true
  60
  61 let default_no_init = true
  62
  63 let xflavours = 8
  64
  65 let slot = A.make xflavours 0
  66
  67 let objs = ref default_objs
  68
  69 let srcs = ref default_srcs
  70
  71 let names = ref default_names
  72
  73 let remove = ref default_remove
  74
  75 let exclude = ref default_exclude
  76
  77 let net = ref default_net
  78
  79 let chars = ref default_chars
  80
  81 let debug_lexer = ref default_debug_lexer
  82
  83 let no_devel = ref default_no_devel
  84
  85 let no_init = ref default_no_init
  86
  87 let deps = ref UPS.empty
  88
  89 let index_of_xflavour = function
  90   | `Inductive  -> 0
  91   | `Axiom      -> 1
  92   | `Definition -> 2
  93   | `Fact       -> 3
  94   | `Lemma      -> 4
  95   | `Theorem    -> 5
  96   | `Corollary  -> 6
  97   | `Example    -> 7
  98
  99 let add_xflavour n xf =
 100   let i = index_of_xflavour xf in
 101   slot.(i) <- slot.(i) + n
 102
 103 let clear_slot i _ = slot.(i) <- 0
 104
 105 let iter_xflavours map = A.iteri (fun _ -> map) slot
 106
 107 let add_dep c u =
 108   deps := UPS.add (c,u) !deps
 109
 110 let out_deps file =
 111   let och = open_out file in
 112   let map (a,b) =
 113     P.fprintf och "\"%s\": \"%s\"\n" (U.string_of_uri a) (U.string_of_uri b)
 114   in
 115   UPS.iter map !deps;
 116   close_out och
 117
 118 let clear () =
 119   R.clear (); A.iteri clear_slot slot;
 120   objs := default_objs; srcs := default_srcs; names := default_names;
 121   remove := default_remove; exclude := default_exclude; net := default_net;
 122   chars := default_chars; debug_lexer := default_debug_lexer;
 123   no_devel := default_no_devel; no_init := default_no_init;
 124   deps := UPS.empty