ocamlbuild/configuration.ml

   1 (***********************************************************************)
   2 (*                             ocamlbuild                              *)
   3 (*                                                                     *)
   4 (*  Nicolas Pouillard, Berke Durak, projet Gallium, INRIA Rocquencourt *)
   5 (*                                                                     *)
   6 (*  Copyright 2007 Institut National de Recherche en Informatique et   *)
   7 (*  en Automatique.  All rights reserved.  This file is distributed    *)
   8 (*  under the terms of the Q Public License version 1.0.               *)
   9 (*                                                                     *)
  10 (***********************************************************************)
  11
  12 (* $Id$ *)
  13 (* Original author: Nicolas Pouillard *)
  14 open My_std
  15 open Log
  16 open Lexers
  17
  18 type flag_list = (string * string) list
  19
  20 type t = Lexers.conf
  21
  22 let cache = Hashtbl.create 107
  23 let (configs, add_config) =
  24   let configs = ref [] in
  25   (fun () -> !configs),
  26   (fun config -> configs := config :: !configs; Hashtbl.clear cache)
  27
  28 let parse_string s =
  29   let conf = Lexers.conf_lines None 1 (Printf.sprintf "string: %S" s) (Lexing.from_string s) in
  30   add_config conf
  31
  32 let parse_file ?dir file =
  33   with_input_file file begin fun ic ->
  34     let conf = Lexers.conf_lines dir 1 (Printf.sprintf "file: %S" file) (Lexing.from_channel ic) in
  35     add_config conf
  36   end
  37
  38 let key_match = Glob.eval
  39
  40 let apply_config s (config : t) init =
  41   List.fold_left begin fun (tags, flags as acc) (key, v) ->
  42     if key_match key s then
  43       (List.fold_right Tags.add v.plus_tags (List.fold_right Tags.remove v.minus_tags tags),
  44        List.fold_right Flags.add v.plus_flags (List.fold_right Flags.remove v.minus_flags flags))
  45     else acc
  46   end init config
  47
  48 let apply_configs s =
  49   let (tags, flags) =
  50     List.fold_right (apply_config s) (configs ()) (Tags.empty, [])
  51   in (tags, Flags.to_spec flags)
  52
  53 let tags_and_flags_of_filename s =
  54   try Hashtbl.find cache s
  55   with Not_found ->
  56     let res = apply_configs s in
  57     let () = Hashtbl.replace cache s res in
  58     res
  59
  60 let tags_of_filename x = fst (tags_and_flags_of_filename x)
  61 let flags_of_filename x = snd (tags_and_flags_of_filename x)
  62
  63 let has_tag tag = Tags.mem tag (tags_of_filename "")
  64
  65 let tag_file file tags =
  66   if tags <> [] then parse_string (Printf.sprintf "%S: %s" file (String.concat ", " tags));;
  67
  68 let tag_any tags =
  69   if tags <> [] then parse_string (Printf.sprintf "true: %s" (String.concat ", " tags));;