forked from colinbenner/ocaml-llvm
-
Notifications
You must be signed in to change notification settings - Fork 16
/
param_tags.ml
56 lines (45 loc) · 1.99 KB
/
param_tags.ml
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
(***********************************************************************)
(* 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. *)
(* *)
(***********************************************************************)
(* Original author: Romain Bardou *)
module StringSet = Set.Make(String)
module SSOSet = Set.Make(struct
type t = string * string option
let compare = Pervasives.compare
end)
(* tag name -> tag action (string -> unit) *)
let declared_tags = Hashtbl.create 17
let acknowledged_tags = ref SSOSet.empty
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 acknowledge tag =
let tag = Lexers.tag_gen (Lexing.from_string tag) in
acknowledged_tags := SSOSet.add tag !acknowledged_tags
let really_acknowledge (name, param) =
match param with
| None ->
if Hashtbl.mem declared_tags name then
Log.eprintf "Warning: tag %S expects a parameter" name
| Some param ->
let actions = List.rev (Hashtbl.find_all declared_tags name) in
if actions = [] then
Log.eprintf "Warning: tag %S does not expect a parameter, but is used with parameter %S" name param;
List.iter (fun f -> f param) actions
let init () =
SSOSet.iter really_acknowledge !acknowledged_tags
let make = Printf.sprintf "%s(%s)"