blob: ecf87787ad73104fe0ac24493e35648870abef48 (
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
|
(**************************************************************************)
(* *)
(* OCaml *)
(* *)
(* Jeremie Dimino, Jane Street Europe *)
(* *)
(* Copyright 2015 Institut National de Recherche en Informatique et *)
(* en Automatique. *)
(* *)
(* All rights reserved. This file is distributed under the terms of *)
(* the GNU Lesser General Public License version 2.1, with the *)
(* special exception on linking described in the file LICENSE. *)
(* *)
(**************************************************************************)
open Asttypes
open Parsetree
type error =
| Multiple_attributes of string
| No_payload_expected of string
exception Error of Location.t * error
let get_no_payload_attribute alt_names attrs =
match List.filter (fun (n, _) -> List.mem n.txt alt_names) attrs with
| [] -> None
| [ (name, PStr []) ] -> Some name
| [ (name, _) ] ->
raise (Error (name.loc, No_payload_expected name.txt))
| _ :: (name, _) :: _ ->
raise (Error (name.loc, Multiple_attributes name.txt))
let has_no_payload_attribute alt_names attrs =
match get_no_payload_attribute alt_names attrs with
| None -> false
| Some _ -> true
open Format
let report_error ppf = function
| Multiple_attributes name ->
fprintf ppf "Too many `%s' attributes" name
| No_payload_expected name ->
fprintf ppf "Attribute `%s' does not accept a payload" name
let () =
Location.register_error_of_exn
(function
| Error (loc, err) ->
Some (Location.error_of_printer loc report_error err)
| _ ->
None
)
|
