From 10937dfe039a45ced4bf06128967e7427f088d27 Mon Sep 17 00:00:00 2001 From: Rudi Grinberg Date: Sun, 27 Sep 2020 12:40:26 -0700 Subject: [PATCH 1/2] Make <|> more general Make it work on field parsers Signed-off-by: Rudi Grinberg --- src/dune_lang/decoder.ml | 2 +- src/dune_lang/decoder.mli | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/src/dune_lang/decoder.ml b/src/dune_lang/decoder.ml index 586eca6ac1e..274950669f5 100644 --- a/src/dune_lang/decoder.ml +++ b/src/dune_lang/decoder.ml @@ -330,7 +330,7 @@ let ( <|> ) = (approximate_how_much_input_a_failing_branch_consumed exn1) (approximate_how_much_input_a_failing_branch_consumed exn2) in - fun a b ctx state -> + fun (type a k) (a : (a, k) parser) (b : (a, k) parser) ctx state -> try a ctx state with exn_a -> ( let exn_a = Exn_with_backtrace.capture exn_a in diff --git a/src/dune_lang/decoder.mli b/src/dune_lang/decoder.mli index 6465dfd7261..36c19e23c23 100644 --- a/src/dune_lang/decoder.mli +++ b/src/dune_lang/decoder.mli @@ -80,7 +80,7 @@ val loc : (Loc.t, _) parser (** [a <|> b] is either [a] or [b]. If [a] fails to parse the input, then try [b]. If [b] fails as well, raise the error from the parser that consumed the most input. *) -val ( <|> ) : 'a t -> 'a t -> 'a t +val ( <|> ) : ('a, 'k) parser -> ('a, 'k) parser -> ('a, 'k) parser (** [atom_matching f] expects the next element to be an atom for which [f] returns [Some v]. [desc] is used to describe the atom in case of error. [f] From d4b8481316a5c0982bd7a54615b74365ab99bd55 Mon Sep 17 00:00:00 2001 From: Rudi Grinberg Date: Sun, 27 Sep 2020 12:54:03 -0700 Subject: [PATCH 2/2] Add Decoder.either primitive Like the current <|>, but it lets us know which parser completed. Simplifies an instance where we do the separation ourselves. Signed-off-by: Rudi Grinberg --- src/dune_lang/decoder.ml | 14 ++++++++++---- src/dune_lang/decoder.mli | 3 +++ src/dune_rules/bindings.ml | 18 +++++++++--------- 3 files changed, 22 insertions(+), 13 deletions(-) diff --git a/src/dune_lang/decoder.ml b/src/dune_lang/decoder.ml index 274950669f5..075e579d6eb 100644 --- a/src/dune_lang/decoder.ml +++ b/src/dune_lang/decoder.ml @@ -316,7 +316,7 @@ let enter t = result ctx (t ctx l) | sexp -> User_error.raise ~loc:(Ast.loc sexp) [ Pp.text "List expected" ]) -let ( <|> ) = +let either = (* Before you read this code, close your eyes and internalise the fact that this code is temporary. It is a temporary state as part of a larger work to turn [Decoder.t] into a pure applicative. Once this is done, this function @@ -330,11 +330,11 @@ let ( <|> ) = (approximate_how_much_input_a_failing_branch_consumed exn1) (approximate_how_much_input_a_failing_branch_consumed exn2) in - fun (type a k) (a : (a, k) parser) (b : (a, k) parser) ctx state -> - try a ctx state + fun a b ctx state -> + try (a >>| Either.left) ctx state with exn_a -> ( let exn_a = Exn_with_backtrace.capture exn_a in - try b ctx state + try (b >>| Either.right) ctx state with exn_b -> let exn_b = Exn_with_backtrace.capture exn_b in Exn_with_backtrace.reraise @@ -344,6 +344,12 @@ let ( <|> ) = | Lt -> exn_b ) ) +let ( <|> ) x y = + let+ res = either x y in + match res with + | Left x -> x + | Right x -> x + let fix f = let rec p = lazy (f r) and r ast = (Lazy.force p) ast in diff --git a/src/dune_lang/decoder.mli b/src/dune_lang/decoder.mli index 36c19e23c23..34fd8540bf0 100644 --- a/src/dune_lang/decoder.mli +++ b/src/dune_lang/decoder.mli @@ -82,6 +82,9 @@ val loc : (Loc.t, _) parser most input. *) val ( <|> ) : ('a, 'k) parser -> ('a, 'k) parser -> ('a, 'k) parser +val either : + ('a, 'k) parser -> ('b, 'k) parser -> (('a, 'b) Either.t, 'k) parser + (** [atom_matching f] expects the next element to be an atom for which [f] returns [Some v]. [desc] is used to describe the atom in case of error. [f] must not raise. *) diff --git a/src/dune_rules/bindings.ml b/src/dune_rules/bindings.ml index 4ded0866300..e9267bf0c61 100644 --- a/src/dune_rules/bindings.ml +++ b/src/dune_rules/bindings.ml @@ -40,15 +40,15 @@ let to_dyn dyn_of_a bindings = let decode elem = let+ l = repeat - ( enter - (let+ loc, name = - located - (atom_matching ~desc:"Atom of the form :" - (String.drop_prefix ~prefix:":")) - and+ values = repeat elem in - Left (loc, name, values)) - <|> let+ value = elem in - Right value ) + (either + (enter + (let+ loc, name = + located + (atom_matching ~desc:"Atom of the form :" + (String.drop_prefix ~prefix:":")) + and+ values = repeat elem in + (loc, name, values))) + elem) in let rec loop vars acc = function | [] -> List.rev acc