From cae4948b7244ab4ae78089b3cf542873af9aca5e Mon Sep 17 00:00:00 2001 From: Jeremie Dimino Date: Thu, 17 May 2018 16:13:35 +0100 Subject: [PATCH] Allow fields that can appear multiple times --- src/stdune/sexp.ml | 65 ++++++++++++++++++++++++++++++++++------ src/stdune/sexp.mli | 15 ++++++++++ test/unit-tests/sexp.mlt | 7 +++++ 3 files changed, 78 insertions(+), 9 deletions(-) diff --git a/src/stdune/sexp.ml b/src/stdune/sexp.ml index f6f68470..cc42e58a 100644 --- a/src/stdune/sexp.ml +++ b/src/stdune/sexp.ml @@ -142,6 +142,7 @@ module Of_sexp = struct type unparsed_field = { values : Ast.t list ; entry : Ast.t + ; prev : unparsed_field option (* Previous occurrence of this field *) } module Name = struct @@ -235,12 +236,29 @@ module Of_sexp = struct let field_missing state name = of_sexp_errorf_loc state.loc "field %s missing" name + let rec multiple_occurrences ~name ~last ~prev = + match prev.prev with + | Some prev_prev -> + (* Make the error message point to the second occurrence *) + multiple_occurrences ~name ~last:prev ~prev:prev_prev + | None -> + of_sexp_errorf last.entry "Field %S is present too many times" name + [@@inline never] + + let find_single state name = + let res = Name_map.find state.unparsed name in + (match res with + | Some ({ prev = Some prev; _ } as last) -> + multiple_occurrences ~name ~last ~prev + | _ -> ()); + res + let field name ?(short=Short_syntax.Not_allowed) ?default value_of_sexp state = - match Name_map.find state.unparsed name with + match find_single state name with | Some { values = [value]; _ } -> (value_of_sexp value, consume name state) - | Some { values = []; entry } -> + | Some { values = []; entry; _ } -> (Short_syntax.parse short entry name, consume name state) | Some f -> @@ -251,10 +269,10 @@ module Of_sexp = struct | None -> field_missing state name let field_o name ?(short=Short_syntax.Not_allowed) value_of_sexp state = - match Name_map.find state.unparsed name with + match find_single state name with | Some { values = [value]; _ } -> (Some (value_of_sexp value), consume name state) - | Some { values = []; entry } -> + | Some { values = []; entry; _ } -> (Some (Short_syntax.parse short entry name), consume name state) | Some f -> @@ -263,6 +281,20 @@ module Of_sexp = struct let field_b name = field name bool ~default:false ~short:(This true) + let dup_field name ?(short=Short_syntax.Not_allowed) value_of_sexp state = + let rec loop acc field = + match field with + | None -> acc + | Some { values = [value]; prev; _ } -> + loop (value_of_sexp value :: acc) prev + | Some { values = []; entry; prev } -> + loop (Short_syntax.parse short entry name :: acc) prev + | Some f -> + too_many_values name f + in + let res = loop [] (Name_map.find state.unparsed name) in + (res, consume name state) + let make_record_parser_state sexp = match sexp with | Atom _ | Quoted_string _ -> of_sexp_error sexp "List expected" @@ -273,9 +305,11 @@ module Of_sexp = struct | List (_, name_sexp :: values) -> begin match name_sexp with | Atom (_, A name) -> - if Name_map.mem acc name then - of_sexp_errorf sexp "Field %S is present too many times" name; - Name_map.add acc name { values; entry = sexp } + Name_map.add acc name + { values + ; entry = sexp + ; prev = Name_map.find acc name + } | List _ | Quoted_string _ -> of_sexp_error name_sexp "Atom expected" end @@ -328,8 +362,8 @@ module Of_sexp = struct let ( @> ) a b = Constructor_args_spec.Cons (a, b) let field_multi name ?default args_spec f state = - match Name_map.find state.unparsed name with - | Some { values; entry } -> + match find_single state name with + | Some { values; entry; _ } -> (Constructor_args_spec.convert args_spec No_rest entry values f, consume name state) | None -> @@ -337,6 +371,19 @@ module Of_sexp = struct | Some v -> (v, add_known name state) | None -> field_missing state name + let dup_field_multi name args_spec f state = + let rec loop acc field = + match field with + | None -> acc + | Some { values; entry; prev } -> + let x = + Constructor_args_spec.convert args_spec No_rest entry values f + in + loop (x :: acc) prev + in + let res = loop [] (Name_map.find state.unparsed name) in + (res, consume name state) + module Constructor_spec = struct type ('a, 'b, 'c) tuple = { name : string diff --git a/src/stdune/sexp.mli b/src/stdune/sexp.mli index 13341b53..e152d6ae 100644 --- a/src/stdune/sexp.mli +++ b/src/stdune/sexp.mli @@ -100,6 +100,13 @@ module Of_sexp : sig -> 'a option record_parser val field_b : string -> bool record_parser + (** A field that can appear multiple times *) + val dup_field + : string + -> ?short:'a Short_syntax.t + -> 'a t + -> 'a list record_parser + val map_validate : 'a record_parser -> f:('a -> ('b, string) Result.result) @@ -131,6 +138,14 @@ module Of_sexp : sig -> 'a -> 'b record_parser + (** A field that can appear multiple times and each time takes + multiple values *) + val dup_field_multi + : string + -> ('a, 'b) Constructor_args_spec.t + -> 'a + -> 'b list record_parser + val cstr : string -> ('a, 'b) Constructor_args_spec.t -> 'a -> 'b Constructor_spec.t val cstr_rest : string diff --git a/test/unit-tests/sexp.mlt b/test/unit-tests/sexp.mlt index 826c7d42..c6da9b38 100644 --- a/test/unit-tests/sexp.mlt +++ b/test/unit-tests/sexp.mlt @@ -31,3 +31,10 @@ Exception: Stdune__Sexp.Of_sexp.Of_sexp (, "Field \"foo\" is present too many times", None). |}] + +let of_sexp = record (dup_field "foo" int) +let x = of_sexp sexp +[%%expect{| +val of_sexp : int list Stdune.Sexp.Of_sexp.t = +val x : int list = [1; 2] +|}]