From f78f46bcce38fc54c665ce2efda15c2ba4b4eb2d Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=A9mie=20Dimino?= <jeremie@dimino.org>
Date: Tue, 6 Oct 2015 10:58:17 +0000
Subject: [PATCH] Add parsing/Attr_helper

git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@16451 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02
---
 .depend                 |  6 ++++++
 Makefile                |  2 +-
 parsing/attr_helper.ml  | 46 +++++++++++++++++++++++++++++++++++++++++
 parsing/attr_helper.mli | 26 +++++++++++++++++++++++
 4 files changed, 79 insertions(+), 1 deletion(-)
 create mode 100644 parsing/attr_helper.ml
 create mode 100644 parsing/attr_helper.mli

diff --git a/.depend b/.depend
index c67b2efc2..fd18b7737 100644
--- a/.depend
+++ b/.depend
@@ -28,6 +28,8 @@ parsing/ast_helper.cmi : parsing/parsetree.cmi parsing/longident.cmi \
     parsing/location.cmi parsing/docstrings.cmi parsing/asttypes.cmi
 parsing/ast_mapper.cmi : parsing/parsetree.cmi parsing/location.cmi
 parsing/asttypes.cmi : parsing/location.cmi
+parsing/attr_helper.cmi : parsing/parsetree.cmi parsing/location.cmi \
+    parsing/asttypes.cmi
 parsing/docstrings.cmi : parsing/parsetree.cmi parsing/location.cmi
 parsing/lexer.cmi : parsing/parser.cmi parsing/location.cmi
 parsing/location.cmi : utils/warnings.cmi
@@ -55,6 +57,10 @@ parsing/ast_mapper.cmx : parsing/parsetree.cmi utils/misc.cmx \
     parsing/longident.cmx parsing/location.cmx utils/config.cmx \
     utils/clflags.cmx parsing/asttypes.cmi parsing/ast_helper.cmx \
     parsing/ast_mapper.cmi
+parsing/attr_helper.cmo : parsing/parsetree.cmi parsing/location.cmi \
+    parsing/asttypes.cmi parsing/attr_helper.cmi
+parsing/attr_helper.cmx : parsing/parsetree.cmi parsing/location.cmx \
+    parsing/asttypes.cmi parsing/attr_helper.cmi
 parsing/docstrings.cmo : utils/warnings.cmi parsing/parsetree.cmi \
     parsing/location.cmi parsing/asttypes.cmi parsing/docstrings.cmi
 parsing/docstrings.cmx : utils/warnings.cmx parsing/parsetree.cmi \
diff --git a/Makefile b/Makefile
index 942ae3fd6..0989df22c 100644
--- a/Makefile
+++ b/Makefile
@@ -48,7 +48,7 @@ PARSING=parsing/location.cmo parsing/longident.cmo \
   parsing/syntaxerr.cmo parsing/parser.cmo \
   parsing/lexer.cmo parsing/parse.cmo parsing/printast.cmo \
   parsing/pprintast.cmo \
-  parsing/ast_mapper.cmo
+  parsing/ast_mapper.cmo parsing/attr_helper.cmo
 
 TYPING=typing/ident.cmo typing/path.cmo \
   typing/primitive.cmo typing/types.cmo \
diff --git a/parsing/attr_helper.ml b/parsing/attr_helper.ml
new file mode 100644
index 000000000..6339b61c8
--- /dev/null
+++ b/parsing/attr_helper.ml
@@ -0,0 +1,46 @@
+(***********************************************************************)
+(*                                                                     *)
+(*                                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 Q Public License version 1.0.               *)
+(*                                                                     *)
+(***********************************************************************)
+
+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 name attrs =
+  match List.filter (fun (n, _) -> n.txt = name) 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))
+
+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
+    )
diff --git a/parsing/attr_helper.mli b/parsing/attr_helper.mli
new file mode 100644
index 000000000..ed613a52e
--- /dev/null
+++ b/parsing/attr_helper.mli
@@ -0,0 +1,26 @@
+(***********************************************************************)
+(*                                                                     *)
+(*                                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 Q Public License version 1.0.               *)
+(*                                                                     *)
+(***********************************************************************)
+
+(** Helpers for attributes *)
+
+open Asttypes
+open Parsetree
+
+type error =
+  | Multiple_attributes of string
+  | No_payload_expected of string
+
+val get_no_payload_attribute : string -> attributes -> string loc option
+
+exception Error of Location.t * error
+
+val report_error: Format.formatter -> error -> unit