blob: 456239031df8561912c97d5c8692f530ac41ab82 (
plain)
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
54
55
56
57
58
59
60
61
62
|
(***********************************************************************)
(* *)
(* ocamlbuild *)
(* *)
(* Nicolas Pouillard, Berke Durak, projet Gallium, INRIA Rocquencourt *)
(* *)
(* Copyright 2007 Institut National de Recherche en Informatique et *)
(* en Automatique. All rights reserved. This file is distributed *)
(* under the terms of the Q Public License version 1.0. *)
(* *)
(***********************************************************************)
open My_std
(* Original author: Romain Bardou *)
module StringSet = Set.Make(String)
(* tag name -> tag action (string -> unit) *)
let declared_tags = Hashtbl.create 17
let acknowledged_tags = ref []
let only_once f =
let instances = ref StringSet.empty in
fun param ->
if StringSet.mem param !instances then ()
else begin
instances := StringSet.add param !instances;
f param
end
let declare name action =
Hashtbl.add declared_tags name (only_once action)
let parse source tag = Lexers.tag_gen source (lexbuf_of_string tag)
let acknowledge source maybe_loc tag =
acknowledged_tags := (parse source tag, maybe_loc) :: !acknowledged_tags
let really_acknowledge ?(quiet=false) ((name, param), maybe_loc) =
match param with
| None ->
if Hashtbl.mem declared_tags name && not quiet then
Log.eprintf "%aWarning: tag %S expects a parameter"
Loc.print_loc_option maybe_loc name
| Some param ->
let actions = List.rev (Hashtbl.find_all declared_tags name) in
if actions = [] && not quiet then
Log.eprintf "%aWarning: tag %S does not expect a parameter, \
but is used with parameter %S"
Loc.print_loc_option maybe_loc name param;
List.iter (fun f -> f param) actions
let partial_init ?quiet source tags =
let parse_noloc tag = (parse source tag, None) in
Tags.iter (fun tag -> really_acknowledge ?quiet (parse_noloc tag)) tags
let init () =
List.iter really_acknowledge (My_std.List.ordered_unique !acknowledged_tags)
let make = Printf.sprintf "%s(%s)"
|
