From be657e09d67ca566c38a9f99e3253569055f935f Mon Sep 17 00:00:00 2001
From: Rudi Grinberg <me@rgrinberg.com>
Date: Mon, 30 Mar 2020 15:22:49 -0700
Subject: [PATCH 1/8] Print locations with Pp

Signed-off-by: Rudi Grinberg <me@rgrinberg.com>
---
 src/dune/print_diff.ml |  2 +-
 src/stdune/console.ml  |  3 +-
 src/stdune/loc.ml      | 70 ++++++++++++++++++++++++++----------------
 src/stdune/loc.mli     |  4 +--
 4 files changed, 49 insertions(+), 30 deletions(-)

diff --git a/src/dune/print_diff.ml b/src/dune/print_diff.ml
index 0fdbffb3b3d1..8b143ec9d1f7 100644
--- a/src/dune/print_diff.ml
+++ b/src/dune/print_diff.ml
@@ -41,7 +41,7 @@ let print ?(skip_trailing_cr = Sys.win32) path1 path2 =
         args
     in
     let args = args @ [ file1; file2 ] in
-    Format.eprintf "%a@?" Loc.print loc;
+    Format.eprintf "%a@?" Pp.render_ignore_tags (Loc.pp loc);
     let* () = Process.run ~dir ~env:Env.initial Strict path args in
     fallback ()
   in
diff --git a/src/stdune/console.ml b/src/stdune/console.ml
index 34ffde1a427f..605c12b56d0a 100644
--- a/src/stdune/console.ml
+++ b/src/stdune/console.ml
@@ -11,7 +11,8 @@ module Backend = struct
 
   module Dumb_no_flush : S = struct
     let print_user_message msg =
-      Option.iter msg.User_message.loc ~f:(Loc.print Format.err_formatter);
+      Option.iter msg.User_message.loc ~f:(fun loc ->
+          Pp.render_ignore_tags Format.err_formatter (Loc.pp loc));
       User_message.prerr { msg with loc = None }
 
     let set_status_line _ = ()
diff --git a/src/stdune/loc.ml b/src/stdune/loc.ml
index efabd5ca8769..6e6b8b0c4994 100644
--- a/src/stdune/loc.ml
+++ b/src/stdune/loc.ml
@@ -43,13 +43,23 @@ let is_none = equal none
 let to_file_colon_line t =
   Printf.sprintf "%s:%d" t.start.pos_fname t.start.pos_lnum
 
-let pp_file_colon_line ppf t = Format.pp_print_string ppf (to_file_colon_line t)
-
-let pp_line padding_width pp (lnum, l) =
-  Format.fprintf pp "%*s | %s\n" padding_width lnum l
-
-let pp_file_excerpt ~context_lines ~max_lines_to_print_in_full pp
-    { start; stop } =
+let pp_file_colon_line t = Pp.verbatim (to_file_colon_line t)
+
+let pp_left_pad n s =
+  let needed_spaces = n - String.length s in
+  Pp.verbatim
+    ( if needed_spaces > 0 then
+      String.make needed_spaces ' ' ^ s
+    else
+      s )
+
+let pp_line padding_width (lnum, l) =
+  let open Pp.O in
+  pp_left_pad padding_width lnum
+  ++ Pp.verbatim " | " ++ Pp.verbatim l ++ Pp.newline
+
+let pp_file_excerpt ~context_lines ~max_lines_to_print_in_full { start; stop } :
+    unit Pp.t =
   let start_c = start.pos_cnum - start.pos_bol in
   let stop_c = stop.pos_cnum - start.pos_bol in
   let file = start.pos_fname in
@@ -61,13 +71,14 @@ let pp_file_excerpt ~context_lines ~max_lines_to_print_in_full pp
     let* line =
       Result.try_with (fun () -> Io.String_path.file_line file line_num)
     in
-    if stop_c <= String.length line then (
+    if stop_c <= String.length line then
       let len = stop_c - start_c in
-      Format.fprintf pp "%a%*s@." (pp_line padding_width) (line_num_str, line)
-        (stop_c + padding_width + 3)
-        (String.make len '^');
-      Ok ()
-    ) else
+      let open Pp.O in
+      Ok
+        ( pp_line padding_width (line_num_str, line)
+        ++ pp_left_pad (stop_c + padding_width + 3) (String.make len '^')
+        ++ Pp.newline )
+    else
       let get_padding lines =
         let lnum, _ = Option.value_exn (List.last lines) in
         String.length lnum
@@ -76,10 +87,10 @@ let pp_file_excerpt ~context_lines ~max_lines_to_print_in_full pp
         (* We add 2 to the width of max line to account for the extra space and
            the `|` character at the end of a line number *)
         let line = String.make (padding_width + 2) '.' in
-        Format.fprintf pp "%s\n" line
+        Pp.verbatim line
       in
       let print_lines lines padding_width =
-        List.iter ~f:(fun (lnum, l) -> pp_line padding_width pp (lnum, l)) lines
+        Pp.concat_map lines ~f:(pp_line padding_width)
       in
       let file_lines ~start ~stop =
         Result.try_with (fun () -> Io.String_path.file_lines file ~start ~stop)
@@ -99,12 +110,15 @@ let pp_file_excerpt ~context_lines ~max_lines_to_print_in_full pp
           file_lines ~start:(stop.pos_lnum - context_lines) ~stop:stop.pos_lnum
         in
         let padding_width = get_padding last_shown_lines in
-        print_lines first_shown_lines padding_width;
-        print_ellipsis padding_width;
-        print_lines last_shown_lines padding_width
+        let open Pp.O in
+        print_lines first_shown_lines padding_width
+        ++ print_ellipsis padding_width
+        ++ print_lines last_shown_lines padding_width
   in
   let whole_file = start_c = 0 && stop_c = 0 in
-  if not whole_file then
+  if whole_file then
+    Pp.nop
+  else
     match
       let open Result.O in
       let* exists =
@@ -113,22 +127,26 @@ let pp_file_excerpt ~context_lines ~max_lines_to_print_in_full pp
       if exists then
         pp_file_excerpt ()
       else
-        Result.Ok ()
+        Result.Ok Pp.nop
     with
+    | Ok pp -> pp
     | Error exn ->
       let backtrace = Printexc.get_backtrace () in
       Format.eprintf "Raised when trying to print location contents of %s@.%a@."
         file
         (Exn.pp_uncaught ~backtrace)
-        exn
-    | Ok () -> Format.pp_print_flush pp ()
+        exn;
+      Pp.nop
 
-let print ppf ({ start; stop } as loc) =
+let pp ({ start; stop } as loc) =
   let start_c = start.pos_cnum - start.pos_bol in
   let stop_c = stop.pos_cnum - start.pos_bol in
-  Format.fprintf ppf "@{<loc>File \"%s\", line %d, characters %d-%d:@}@\n"
-    start.pos_fname start.pos_lnum start_c stop_c;
-  pp_file_excerpt ppf ~context_lines:2 ~max_lines_to_print_in_full:10 loc
+  let open Pp.O in
+  Pp.verbatim
+    (Printf.sprintf "File \"%s\", line %d, characters %d-%d:" start.pos_fname
+       start.pos_lnum start_c stop_c)
+  ++ Pp.newline
+  ++ pp_file_excerpt ~context_lines:2 ~max_lines_to_print_in_full:10 loc
 
 let on_same_line loc1 loc2 =
   let start1 = loc1.start in
diff --git a/src/stdune/loc.mli b/src/stdune/loc.mli
index 1277b6396f3c..dc4d3fc50d4b 100644
--- a/src/stdune/loc.mli
+++ b/src/stdune/loc.mli
@@ -27,9 +27,9 @@ val of_pos : string * int * int * int -> t
 
 val to_file_colon_line : t -> string
 
-val pp_file_colon_line : Format.formatter -> t -> unit
+val pp_file_colon_line : t -> unit Pp.t
 
-val print : Format.formatter -> t -> unit
+val pp : t -> unit Pp.t
 
 val on_same_line : t -> t -> bool
 

From 83f681193c23e7b8b4e7553f56971d6ff2c43361 Mon Sep 17 00:00:00 2001
From: Rudi Grinberg <me@rgrinberg.com>
Date: Mon, 30 Mar 2020 15:46:11 -0700
Subject: [PATCH 2/8] Print location in a friendlier way in errors

Signed-off-by: Rudi Grinberg <me@rgrinberg.com>
---
 src/dune/dir_contents.ml | 4 ++--
 src/dune/lib_info.ml     | 2 +-
 src/dune/package.ml      | 2 +-
 src/dune/rule.ml         | 2 +-
 src/stdune/loc.ml        | 2 ++
 src/stdune/loc.mli       | 2 ++
 6 files changed, 9 insertions(+), 5 deletions(-)

diff --git a/src/dune/dir_contents.ml b/src/dune/dir_contents.ml
index 759783a9cbca..87ceb95a3d83 100644
--- a/src/dune/dir_contents.ml
+++ b/src/dune/dir_contents.ml
@@ -69,9 +69,9 @@ let mlds t (doc : Documentation.t) =
   | Some x -> x
   | None ->
     Code_error.raise "Dir_contents.mlds"
-      [ ("doc", Loc.to_dyn doc.loc)
+      [ ("doc", Loc.to_dyn_hum doc.loc)
       ; ( "available"
-        , Dyn.Encoder.(list Loc.to_dyn)
+        , Dyn.Encoder.(list Loc.to_dyn_hum)
             (List.map map ~f:(fun (d, _) -> d.Documentation.loc)) )
       ]
 
diff --git a/src/dune/lib_info.ml b/src/dune/lib_info.ml
index 5de124126dd9..78cfdd42d965 100644
--- a/src/dune/lib_info.ml
+++ b/src/dune/lib_info.ml
@@ -452,7 +452,7 @@ let to_dyn path
   let open Dyn.Encoder in
   let snd f (_, x) = f x in
   record
-    [ ("loc", Loc.to_dyn loc)
+    [ ("loc", Loc.to_dyn_hum loc)
     ; ("name", Lib_name.to_dyn name)
     ; ("kind", Lib_kind.to_dyn kind)
     ; ("status", Status.to_dyn status)
diff --git a/src/dune/package.ml b/src/dune/package.ml
index 6f817f239238..42a047c03fd2 100644
--- a/src/dune/package.ml
+++ b/src/dune/package.ml
@@ -468,7 +468,7 @@ let to_dyn
     ; ("tags", list string tags)
     ; ("version", option string version)
     ; ( "deprecated_package_names"
-      , Name.Map.to_dyn Loc.to_dyn deprecated_package_names )
+      , Name.Map.to_dyn Loc.to_dyn_hum deprecated_package_names )
     ]
 
 let opam_file t = Path.Source.relative t.path (Name.opam_fn t.name)
diff --git a/src/dune/rule.ml b/src/dune/rule.ml
index 170802d49ad3..cb296c571956 100644
--- a/src/dune/rule.ml
+++ b/src/dune/rule.ml
@@ -77,7 +77,7 @@ module T = struct
       Loc.in_file (Path.source file)
 
   let to_dyn t : Dyn.t =
-    Record [ ("id", Id.to_dyn t.id); ("loc", Loc.to_dyn (loc t)) ]
+    Record [ ("id", Id.to_dyn t.id); ("loc", Loc.to_dyn_hum (loc t)) ]
 end
 
 include T
diff --git a/src/stdune/loc.ml b/src/stdune/loc.ml
index 6e6b8b0c4994..ac13a8744ce1 100644
--- a/src/stdune/loc.ml
+++ b/src/stdune/loc.ml
@@ -43,6 +43,8 @@ let is_none = equal none
 let to_file_colon_line t =
   Printf.sprintf "%s:%d" t.start.pos_fname t.start.pos_lnum
 
+let to_dyn_hum t : Dyn.t = String (to_file_colon_line t)
+
 let pp_file_colon_line t = Pp.verbatim (to_file_colon_line t)
 
 let pp_left_pad n s =
diff --git a/src/stdune/loc.mli b/src/stdune/loc.mli
index dc4d3fc50d4b..5bfd3a1140b6 100644
--- a/src/stdune/loc.mli
+++ b/src/stdune/loc.mli
@@ -29,6 +29,8 @@ val to_file_colon_line : t -> string
 
 val pp_file_colon_line : t -> unit Pp.t
 
+val to_dyn_hum : t -> Dyn.t
+
 val pp : t -> unit Pp.t
 
 val on_same_line : t -> t -> bool

From 18b46f39390d51c5d16b180707d8b2f23aba2517 Mon Sep 17 00:00:00 2001
From: Rudi Grinberg <me@rgrinberg.com>
Date: Tue, 31 Mar 2020 12:12:59 -0700
Subject: [PATCH 3/8] Add loc tag

Signed-off-by: Rudi Grinberg <me@rgrinberg.com>
---
 src/dune/print_diff.ml |  2 +-
 src/stdune/console.ml  |  2 +-
 src/stdune/loc.ml      | 15 +++++++++++----
 src/stdune/loc.mli     |  6 +++++-
 4 files changed, 18 insertions(+), 7 deletions(-)

diff --git a/src/dune/print_diff.ml b/src/dune/print_diff.ml
index 8b143ec9d1f7..28073da69b25 100644
--- a/src/dune/print_diff.ml
+++ b/src/dune/print_diff.ml
@@ -41,7 +41,7 @@ let print ?(skip_trailing_cr = Sys.win32) path1 path2 =
         args
     in
     let args = args @ [ file1; file2 ] in
-    Format.eprintf "%a@?" Pp.render_ignore_tags (Loc.pp loc);
+    Format.eprintf "%a@?" Loc.render (Loc.pp loc);
     let* () = Process.run ~dir ~env:Env.initial Strict path args in
     fallback ()
   in
diff --git a/src/stdune/console.ml b/src/stdune/console.ml
index 605c12b56d0a..fe85a640defa 100644
--- a/src/stdune/console.ml
+++ b/src/stdune/console.ml
@@ -12,7 +12,7 @@ module Backend = struct
   module Dumb_no_flush : S = struct
     let print_user_message msg =
       Option.iter msg.User_message.loc ~f:(fun loc ->
-          Pp.render_ignore_tags Format.err_formatter (Loc.pp loc));
+          Loc.render Format.err_formatter (Loc.pp loc));
       User_message.prerr { msg with loc = None }
 
     let set_status_line _ = ()
diff --git a/src/stdune/loc.ml b/src/stdune/loc.ml
index ac13a8744ce1..2f14e2495cf3 100644
--- a/src/stdune/loc.ml
+++ b/src/stdune/loc.ml
@@ -60,8 +60,10 @@ let pp_line padding_width (lnum, l) =
   pp_left_pad padding_width lnum
   ++ Pp.verbatim " | " ++ Pp.verbatim l ++ Pp.newline
 
+type tag = Loc
+
 let pp_file_excerpt ~context_lines ~max_lines_to_print_in_full { start; stop } :
-    unit Pp.t =
+    tag Pp.t =
   let start_c = start.pos_cnum - start.pos_bol in
   let stop_c = stop.pos_cnum - start.pos_bol in
   let file = start.pos_fname in
@@ -144,9 +146,10 @@ let pp ({ start; stop } as loc) =
   let start_c = start.pos_cnum - start.pos_bol in
   let stop_c = stop.pos_cnum - start.pos_bol in
   let open Pp.O in
-  Pp.verbatim
-    (Printf.sprintf "File \"%s\", line %d, characters %d-%d:" start.pos_fname
-       start.pos_lnum start_c stop_c)
+  Pp.tag Loc
+    (Pp.verbatim
+       (Printf.sprintf "File \"%s\", line %d, characters %d-%d:" start.pos_fname
+          start.pos_lnum start_c stop_c))
   ++ Pp.newline
   ++ pp_file_excerpt ~context_lines:2 ~max_lines_to_print_in_full:10 loc
 
@@ -158,3 +161,7 @@ let on_same_line loc1 loc2 =
   same_file && same_line
 
 let span begin_ end_ = { begin_ with stop = end_.stop }
+
+let rec render ppf pp =
+  Pp.render ppf pp ~tag_handler:(fun ppf Loc pp ->
+      Format.fprintf ppf "@{<loc>%a@}" render pp)
diff --git a/src/stdune/loc.mli b/src/stdune/loc.mli
index 5bfd3a1140b6..0222ab13a5c1 100644
--- a/src/stdune/loc.mli
+++ b/src/stdune/loc.mli
@@ -31,7 +31,11 @@ val pp_file_colon_line : t -> unit Pp.t
 
 val to_dyn_hum : t -> Dyn.t
 
-val pp : t -> unit Pp.t
+type tag = Loc
+
+val pp : t -> tag Pp.t
+
+val render : Format.formatter -> tag Pp.t -> unit
 
 val on_same_line : t -> t -> bool
 

From 80dcf6ed58155b41f09b8dd3c88f33aaea27fdf0 Mon Sep 17 00:00:00 2001
From: Rudi Grinberg <me@rgrinberg.com>
Date: Tue, 31 Mar 2020 11:58:18 -0700
Subject: [PATCH 4/8] Add targets module

Move multiplicities and all Targets types to it

Signed-off-by: Rudi Grinberg <me@rgrinberg.com>
---
 src/dune/action_unexpanded.ml  | 21 +++++++++---
 src/dune/action_unexpanded.mli |  6 ++--
 src/dune/dune_file.ml          | 43 ++---------------------
 src/dune/dune_file.mli         | 19 +---------
 src/dune/expander.ml           | 48 +++++---------------------
 src/dune/expander.mli          | 14 +-------
 src/dune/merlin.ml             |  4 ++-
 src/dune/preprocessing.ml      |  2 +-
 src/dune/simple_rules.ml       | 31 +++++++++--------
 src/dune/super_context.ml      | 22 ++----------
 src/dune/super_context.mli     |  2 +-
 src/dune/targets.ml            | 63 ++++++++++++++++++++++++++++++++++
 src/dune/targets.mli           | 36 +++++++++++++++++++
 13 files changed, 154 insertions(+), 157 deletions(-)
 create mode 100644 src/dune/targets.ml
 create mode 100644 src/dune/targets.mli

diff --git a/src/dune/action_unexpanded.ml b/src/dune/action_unexpanded.ml
index 0c75e0b4bde8..6e0a01dab7aa 100644
--- a/src/dune/action_unexpanded.ml
+++ b/src/dune/action_unexpanded.ml
@@ -499,11 +499,22 @@ module Infer = struct
             acc
       end)
 
-  let partial ~all_targets t =
-    if all_targets then
-      Partial_with_all_targets.infer t
-    else
-      Partial.infer t
+  let partial (targets : Targets.Or_forbidden.t) t =
+    match targets with
+    | Targets Infer -> Partial_with_all_targets.infer t
+    | Forbidden _ ->
+      (* Q: why don't we make sure that no targets were inferred?
+
+         A: Target detection is not robust and sufffers from false
+         positive/negatives. *)
+      { (Partial.infer t) with targets = Path.Build.Set.empty }
+    | Targets (Static { targets = written_by_user; multiplicity = _ }) ->
+      let outcome = Partial.infer t in
+      { outcome with
+        targets =
+          Path.Build.Set.union outcome.targets
+            (Path.Build.Set.of_list written_by_user)
+      }
 
   module S_unexp = struct
     module Targets = struct
diff --git a/src/dune/action_unexpanded.mli b/src/dune/action_unexpanded.mli
index dcda537782b5..51f8d26d6dc0 100644
--- a/src/dune/action_unexpanded.mli
+++ b/src/dune/action_unexpanded.mli
@@ -33,9 +33,9 @@ module Infer : sig
 
   val infer : Action.t -> Outcome.t
 
-  (** If [all_targets] is [true] and a target cannot be determined statically,
-      fail *)
-  val partial : all_targets:bool -> Partial.t -> Outcome.t
+  (** In [partial targets p], if [targets] is [Infer] and a target cannot be
+      determined statically, fail *)
+  val partial : Targets.Or_forbidden.t -> Partial.t -> Outcome.t
 
   (** Return the list of targets of an unexpanded action. *)
   val unexpanded_targets : t -> String_with_vars.t list
diff --git a/src/dune/dune_file.ml b/src/dune/dune_file.ml
index 1c655f8c9b02..ad886f12ad70 100644
--- a/src/dune/dune_file.ml
+++ b/src/dune/dune_file.ml
@@ -1562,45 +1562,6 @@ module Executables = struct
 end
 
 module Rule = struct
-  module Targets = struct
-    module Multiplicity = struct
-      type t =
-        | One
-        | Multiple
-    end
-
-    type static =
-      { targets : String_with_vars.t list
-      ; multiplicity : Multiplicity.t
-      }
-
-    type t =
-      (* List of files in the current directory *)
-      | Static of static
-      | Infer
-
-    let decode_static =
-      let+ syntax_version = Dune_lang.Syntax.get_exn Stanza.syntax
-      and+ targets = repeat String_with_vars.decode in
-      if syntax_version < (1, 3) then
-        List.iter targets ~f:(fun target ->
-            if String_with_vars.has_vars target then
-              Dune_lang.Syntax.Error.since
-                (String_with_vars.loc target)
-                Stanza.syntax (1, 3)
-                ~what:"Using variables in the targets field");
-      Static { targets; multiplicity = Multiple }
-
-    let decode_one_static =
-      let+ () = Dune_lang.Syntax.since Stanza.syntax (1, 11)
-      and+ target = String_with_vars.decode in
-      Static { targets = [ target ]; multiplicity = One }
-
-    let fields_parser =
-      fields_mutually_exclusive ~default:Infer
-        [ ("targets", decode_static); ("target", decode_one_static) ]
-  end
-
   module Mode = struct
     include Rule.Mode
 
@@ -1628,7 +1589,7 @@ module Rule = struct
   end
 
   type t =
-    { targets : Targets.t
+    { targets : String_with_vars.t Targets.t
     ; deps : Dep_conf.t Bindings.t
     ; action : Loc.t * Action_dune_lang.t
     ; mode : Rule.Mode.t
@@ -1692,7 +1653,7 @@ module Rule = struct
   let long_form =
     let+ loc = loc
     and+ action = field "action" (located Action_dune_lang.decode)
-    and+ targets = Targets.fields_parser
+    and+ targets = Targets.field
     and+ deps =
       field "deps" (Bindings.decode Dep_conf.decode) ~default:Bindings.empty
     and+ locks = field "locks" (repeat String_with_vars.decode) ~default:[]
diff --git a/src/dune/dune_file.mli b/src/dune/dune_file.mli
index d2959f3ebe46..d7a5734e127e 100644
--- a/src/dune/dune_file.mli
+++ b/src/dune/dune_file.mli
@@ -321,25 +321,8 @@ module Menhir : sig
 end
 
 module Rule : sig
-  module Targets : sig
-    module Multiplicity : sig
-      type t =
-        | One
-        | Multiple
-    end
-
-    type static =
-      { targets : String_with_vars.t list
-      ; multiplicity : Multiplicity.t
-      }
-
-    type t =
-      | Static of static
-      | Infer
-  end
-
   type t =
-    { targets : Targets.t
+    { targets : String_with_vars.t Targets.t
     ; deps : Dep_conf.t Bindings.t
     ; action : Loc.t * Action_dune_lang.t
     ; mode : Rule.Mode.t
diff --git a/src/dune/expander.ml b/src/dune/expander.ml
index 1cacbedcd04b..594414020884 100644
--- a/src/dune/expander.ml
+++ b/src/dune/expander.ml
@@ -291,18 +291,6 @@ module Resolved_forms = struct
       ~f:(fun acc (var, _) value -> Pform.Expansion.Map.add_exn acc var value)
 end
 
-module Targets = struct
-  type static =
-    { targets : Path.Build.t list
-    ; multiplicity : Dune_file.Rule.Targets.Multiplicity.t
-    }
-
-  type t =
-    | Static of static
-    | Infer
-    | Forbidden of string
-end
-
 let path_exp path = [ Value.Path path ]
 
 let str_exp str = [ Value.String str ]
@@ -478,31 +466,13 @@ let expand_and_record_dynamic acc ~map_exe ~dep_kind ~(dir : Path.Build.t)
     acc.failure <- Some { fail = (fun () -> raise e) };
     None
 
-let check_multiplicity ~pform ~declaration ~use =
-  let module Multiplicity = Dune_file.Rule.Targets.Multiplicity in
-  let loc = String_with_vars.Var.loc pform in
-  let error declaration use =
-    User_error.raise ~loc
-      [ Pp.textf
-          "You can only use the variable %%{%s} if you defined the list of \
-           targets using the field [%s] (not [%s])"
-          use use declaration
-      ]
-  in
-  match (declaration, use) with
-  | Multiplicity.One, Multiplicity.One
-  | Multiple, Multiple ->
-    ()
-  | One, Multiple -> error "target" "targets"
-  | Multiple, One -> error "targets" "target"
-
 let expand_and_record_deps acc ~(dir : Path.Build.t) ~dep_kind
     ~targets_written_by_user ~map_exe ~expand_var ~cc t pform syntax_version =
   let res =
-    let targets ~(multiplicity : Dune_file.Rule.Targets.Multiplicity.t) =
+    let targets ~(multiplicity : Targets.Multiplicity.t) =
       let loc = String_with_vars.Var.loc pform in
-      match (targets_written_by_user : Targets.t) with
-      | Infer ->
+      match (targets_written_by_user : Targets.Or_forbidden.t) with
+      | Targets.Or_forbidden.Targets Infer ->
         User_error.raise ~loc
           [ Pp.textf "You cannot use %s with inferred rules."
               (String_with_vars.Var.describe pform)
@@ -513,14 +483,12 @@ let expand_and_record_deps acc ~(dir : Path.Build.t) ~dep_kind
               (String_with_vars.Var.describe pform)
               context
           ]
-      | Static { targets; multiplicity = declared_multiplicity } ->
-        let value =
-          List.map ~f:Path.build targets |> Value.L.dirs
-          (* XXX hack to signal no dep *)
-        in
-        check_multiplicity ~pform ~declaration:declared_multiplicity
+      | Targets.Or_forbidden.Targets
+          (Static { targets; multiplicity = declared_multiplicity }) ->
+        Targets.Multiplicity.check ~loc ~declaration:declared_multiplicity
           ~use:multiplicity;
-        Some value
+        (* XXX hack to signal no dep *)
+        Some (List.map ~f:Path.build targets |> Value.L.dirs)
     in
     expand_var t pform syntax_version
     |> Option.bind ~f:(function
diff --git a/src/dune/expander.mli b/src/dune/expander.mli
index d3f0759035e7..581169940fdf 100644
--- a/src/dune/expander.mli
+++ b/src/dune/expander.mli
@@ -85,18 +85,6 @@ type reduced_var_result =
 val expand_with_reduced_var_set :
   context:Context.t -> reduced_var_result String_with_vars.expander
 
-module Targets : sig
-  type static =
-    { targets : Path.Build.t list
-    ; multiplicity : Dune_file.Rule.Targets.Multiplicity.t
-    }
-
-  type t =
-    | Static of static
-    | Infer
-    | Forbidden of string  (** context *)
-end
-
 (** Prepare a temporary expander capable of expanding variables in the [deps] or
     similar fields. This expander doesn't support variables that require us to
     build something to expand. For example, [%{exe:foo}] is allowed but
@@ -121,7 +109,7 @@ val expand_deps_like_field :
 val expand_action :
      t
   -> deps_written_by_user:Path.t Bindings.t Build.t
-  -> targets_written_by_user:Targets.t
+  -> targets_written_by_user:Targets.Or_forbidden.t
   -> dep_kind:Lib_deps_info.Kind.t
   -> map_exe:(Path.t -> Path.t)
   -> foreign_flags:
diff --git a/src/dune/merlin.ml b/src/dune/merlin.ml
index b4e7ef7194f6..4ce1ebd47e06 100644
--- a/src/dune/merlin.ml
+++ b/src/dune/merlin.ml
@@ -148,7 +148,9 @@ let pp_flag_of_action sctx ~expander ~loc ~action :
     | Some args ->
       let action =
         let targets_dir = Expander.dir expander in
-        let targets = Expander.Targets.Forbidden "preprocessing actions" in
+        let targets : Targets.Or_forbidden.t =
+          Forbidden "preprocessing actions"
+        in
         let action = Preprocessing.chdir (Run (exe, args)) in
         Super_context.Action.run sctx ~loc ~expander ~dep_kind:Optional ~targets
           ~targets_dir action
diff --git a/src/dune/preprocessing.ml b/src/dune/preprocessing.ml
index f40e0278bb89..e4426f8a9897 100644
--- a/src/dune/preprocessing.ml
+++ b/src/dune/preprocessing.ml
@@ -480,7 +480,7 @@ let action_for_pp sctx ~dep_kind ~loc ~expander ~action ~src ~target =
   let action = chdir action in
   let bindings = Pform.Map.input_file (Path.build src) in
   let expander = Expander.add_bindings expander ~bindings in
-  let targets = Expander.Targets.Forbidden "preprocessing actions" in
+  let targets = Targets.Or_forbidden.Forbidden "preprocessing actions" in
   let targets_dir = Option.value ~default:src target |> Path.Build.parent_exn in
   let action =
     SC.Action.run sctx action ~loc ~expander ~dep_kind ~targets ~targets_dir
diff --git a/src/dune/simple_rules.ml b/src/dune/simple_rules.ml
index 4490cad929d2..8752e86ad9fa 100644
--- a/src/dune/simple_rules.ml
+++ b/src/dune/simple_rules.ml
@@ -85,21 +85,22 @@ let user_rule sctx ?extra_bindings ~dir ~expander (rule : Rule.t) =
         Alias_rules.add_empty sctx ~alias ~loc:(Some rule.loc) ~stamp);
     Path.Build.Set.empty
   | true -> (
-    let targets : Expander.Targets.t =
-      match rule.targets with
-      | Infer -> Infer
-      | Static { targets; multiplicity } ->
-        let targets =
-          List.concat_map targets ~f:(fun target ->
-              let error_loc = String_with_vars.loc target in
-              ( match multiplicity with
-              | One ->
-                [ Expander.expand expander ~mode:Single ~template:target ]
-              | Multiple -> Expander.expand expander ~mode:Many ~template:target
-              )
-              |> List.map ~f:(check_filename ~dir ~error_loc))
-        in
-        Expander.Targets.Static { multiplicity; targets }
+    let targets : Targets.Or_forbidden.t =
+      Targets
+        ( match rule.targets with
+        | Infer -> Infer
+        | Static { targets; multiplicity } ->
+          let targets =
+            List.concat_map targets ~f:(fun target ->
+                let error_loc = String_with_vars.loc target in
+                ( match multiplicity with
+                | One ->
+                  [ Expander.expand expander ~mode:Single ~template:target ]
+                | Multiple ->
+                  Expander.expand expander ~mode:Many ~template:target )
+                |> List.map ~f:(check_filename ~dir ~error_loc))
+          in
+          Static { multiplicity; targets } )
     in
     let bindings = dep_bindings ~extra_bindings rule.deps in
     let expander = Expander.add_bindings expander ~bindings in
diff --git a/src/dune/super_context.ml b/src/dune/super_context.ml
index f35170bbdeb7..609f2a1e5d13 100644
--- a/src/dune/super_context.ml
+++ b/src/dune/super_context.ml
@@ -682,10 +682,8 @@ module Action = struct
       ~targets_dir t deps_written_by_user : Action.t Build.With_targets.t =
     let dir = Expander.dir expander in
     let map_exe = map_exe sctx in
-    ( match (targets_written_by_user : Expander.Targets.t) with
-    | Static _
-    | Infer ->
-      ()
+    ( match (targets_written_by_user : Targets.Or_forbidden.t) with
+    | Targets _ -> ()
     | Forbidden context -> (
       match U.Infer.unexpanded_targets t with
       | [] -> ()
@@ -705,21 +703,7 @@ module Action = struct
         ~final:(fun expander t -> U.Partial.expand t ~expander ~map_exe)
     in
     let { U.Infer.Outcome.deps; targets } =
-      match targets_written_by_user with
-      | Infer -> U.Infer.partial partially_expanded ~all_targets:true
-      | Static { targets = targets_written_by_user; multiplicity = _ } ->
-        let targets_written_by_user =
-          Path.Build.Set.of_list targets_written_by_user
-        in
-        let { U.Infer.Outcome.deps; targets } =
-          U.Infer.partial partially_expanded ~all_targets:false
-        in
-        { deps; targets = Path.Build.Set.union targets targets_written_by_user }
-      | Forbidden _ ->
-        let { U.Infer.Outcome.deps; targets = _ } =
-          U.Infer.partial partially_expanded ~all_targets:false
-        in
-        { U.Infer.Outcome.deps; targets = Path.Build.Set.empty }
+      U.Infer.partial targets_written_by_user partially_expanded
     in
     let targets = Path.Build.Set.to_list targets in
     List.iter targets ~f:(fun target ->
diff --git a/src/dune/super_context.mli b/src/dune/super_context.mli
index 9c0a13ffbcbf..dd4098a29507 100644
--- a/src/dune/super_context.mli
+++ b/src/dune/super_context.mli
@@ -187,7 +187,7 @@ module Action : sig
     -> loc:Loc.t
     -> expander:Expander.t
     -> dep_kind:Lib_deps_info.Kind.t
-    -> targets:Expander.Targets.t
+    -> targets:Targets.Or_forbidden.t
     -> targets_dir:Path.Build.t
     -> Action_unexpanded.t
     -> Path.t Bindings.t Build.t
diff --git a/src/dune/targets.ml b/src/dune/targets.ml
new file mode 100644
index 000000000000..6393472cec86
--- /dev/null
+++ b/src/dune/targets.ml
@@ -0,0 +1,63 @@
+open Import
+
+module Multiplicity = struct
+  type t =
+    | One
+    | Multiple
+
+  let check ~loc ~declaration ~use =
+    let error declaration use =
+      User_error.raise ~loc
+        [ Pp.textf
+            "You can only use the variable %%{%s} if you defined the list of \
+             targets using the field [%s] (not [%s])"
+            use use declaration
+        ]
+    in
+    match (declaration, use) with
+    | One, One
+    | Multiple, Multiple ->
+      ()
+    | One, Multiple -> error "target" "targets"
+    | Multiple, One -> error "targets" "target"
+end
+
+module Static = struct
+  type 'path t =
+    { targets : 'path list
+    ; multiplicity : Multiplicity.t
+    }
+end
+
+type 'a t =
+  | Static of 'a Static.t
+  | Infer
+
+module Or_forbidden = struct
+  type nonrec t =
+    | Forbidden of string
+    | Targets of Path.Build.t t
+end
+
+let decode_static =
+  let open Dune_lang.Decoder in
+  let+ syntax_version = Dune_lang.Syntax.get_exn Stanza.syntax
+  and+ targets = repeat String_with_vars.decode in
+  if syntax_version < (1, 3) then
+    List.iter targets ~f:(fun target ->
+        if String_with_vars.has_vars target then
+          Dune_lang.Syntax.Error.since
+            (String_with_vars.loc target)
+            Stanza.syntax (1, 3) ~what:"Using variables in the targets field");
+  Static { targets; multiplicity = Multiple }
+
+let decode_one_static =
+  let open Dune_lang.Decoder in
+  let+ () = Dune_lang.Syntax.since Stanza.syntax (1, 11)
+  and+ target = String_with_vars.decode in
+  Static { targets = [ target ]; multiplicity = One }
+
+let field =
+  let open Dune_lang.Decoder in
+  fields_mutually_exclusive ~default:Infer
+    [ ("targets", decode_static); ("target", decode_one_static) ]
diff --git a/src/dune/targets.mli b/src/dune/targets.mli
new file mode 100644
index 000000000000..95dc776fe8b3
--- /dev/null
+++ b/src/dune/targets.mli
@@ -0,0 +1,36 @@
+(** Defines target behavior for rules. *)
+
+open Import
+
+module Multiplicity : sig
+  type t =
+    | One
+    | Multiple
+
+  val check : loc:Loc.t -> declaration:t -> use:t -> unit
+end
+
+module Static : sig
+  type 'path t =
+    { targets : 'path list
+    ; multiplicity : Multiplicity.t
+    }
+end
+
+(** Static targets are listed by the user while [Infer] denotes that dune must
+    discover all the targets. In the [Static] case, dune still implicitly adds
+    the list of inferred targets *)
+type 'a t =
+  | Static of 'a Static.t
+  | Infer
+
+module Or_forbidden : sig
+  (** In some situations, actions may not have targets. [Forbidden _] is used to
+      denote that *)
+  type nonrec t =
+    | Forbidden of string
+    | Targets of Path.Build.t t
+end
+
+(** target or targets with field with the correct multiplicity *)
+val field : String_with_vars.t t Dune_lang.Decoder.fields_parser

From 794127f37d98e954cef994930ec02106138110e3 Mon Sep 17 00:00:00 2001
From: Jeremie Dimino <jeremie@dimino.org>
Date: Wed, 1 Apr 2020 15:31:10 +0100
Subject: [PATCH 5/8] Make the API of Targets.Multiplicity.check more obvious

Now that it lives further away from the use site, we don't have the
context to guess what it means. Use a more explicit function name and
label names to help make it more obvious.

Signed-off-by: Jeremie Dimino <jeremie@dimino.org>
---
 src/dune/expander.ml | 6 +++---
 src/dune/targets.ml  | 8 ++++----
 src/dune/targets.mli | 6 +++---
 3 files changed, 10 insertions(+), 10 deletions(-)

diff --git a/src/dune/expander.ml b/src/dune/expander.ml
index 594414020884..f14c317b6b48 100644
--- a/src/dune/expander.ml
+++ b/src/dune/expander.ml
@@ -484,9 +484,9 @@ let expand_and_record_deps acc ~(dir : Path.Build.t) ~dep_kind
               context
           ]
       | Targets.Or_forbidden.Targets
-          (Static { targets; multiplicity = declared_multiplicity }) ->
-        Targets.Multiplicity.check ~loc ~declaration:declared_multiplicity
-          ~use:multiplicity;
+          (Static { targets; multiplicity = field_multiplicity }) ->
+        Targets.Multiplicity.check_variable_matches_field ~loc
+          ~field:field_multiplicity ~variable:multiplicity;
         (* XXX hack to signal no dep *)
         Some (List.map ~f:Path.build targets |> Value.L.dirs)
     in
diff --git a/src/dune/targets.ml b/src/dune/targets.ml
index 6393472cec86..b648ecbd94c2 100644
--- a/src/dune/targets.ml
+++ b/src/dune/targets.ml
@@ -5,16 +5,16 @@ module Multiplicity = struct
     | One
     | Multiple
 
-  let check ~loc ~declaration ~use =
-    let error declaration use =
+  let check_variable_matches_field ~loc ~field ~variable =
+    let error field variable =
       User_error.raise ~loc
         [ Pp.textf
             "You can only use the variable %%{%s} if you defined the list of \
              targets using the field [%s] (not [%s])"
-            use use declaration
+            variable variable field
         ]
     in
-    match (declaration, use) with
+    match (field, variable) with
     | One, One
     | Multiple, Multiple ->
       ()
diff --git a/src/dune/targets.mli b/src/dune/targets.mli
index 95dc776fe8b3..229a8a509538 100644
--- a/src/dune/targets.mli
+++ b/src/dune/targets.mli
@@ -4,10 +4,10 @@ open Import
 
 module Multiplicity : sig
   type t =
-    | One
-    | Multiple
+    | One  (** [target] field or variable *)
+    | Multiple  (** [targets] field or variable *)
 
-  val check : loc:Loc.t -> declaration:t -> use:t -> unit
+  val check_variable_matches_field : loc:Loc.t -> field:t -> variable:t -> unit
 end
 
 module Static : sig

From fa431293de2421bdc0f458d0b2f386af93c95eeb Mon Sep 17 00:00:00 2001
From: Emilio Jesus Gallego Arias <e+git@x80.org>
Date: Sun, 29 Mar 2020 01:38:45 -0400
Subject: [PATCH 6/8] [coq] Allow implicit composition with the boot theory.

Otherwise when composing with Coq itself, developments not using
`From Coq Require...` won't compile.

This is until we deprecate the implicit nature of the Coq prefix,
hopefully in 8.12.

Signed-off-by: Emilio Jesus Gallego Arias <e+git@x80.org>
---
 src/dune/coq_lib.ml   | 4 ++++
 src/dune/coq_lib.mli  | 2 ++
 src/dune/coq_rules.ml | 3 ++-
 3 files changed, 8 insertions(+), 1 deletion(-)

diff --git a/src/dune/coq_lib.ml b/src/dune/coq_lib.ml
index 9ff752947140..3ec0aadf2aff 100644
--- a/src/dune/coq_lib.ml
+++ b/src/dune/coq_lib.ml
@@ -12,6 +12,7 @@ open! Stdune
 type t =
   { name : Loc.t * Coq_lib_name.t
   ; wrapper : string
+  ; implicit : bool (* Only useful for the stdlib *)
   ; src_root : Path.Build.t
   ; obj_root : Path.Build.t
   ; theories : (Loc.t * Coq_lib_name.t) list
@@ -21,6 +22,8 @@ type t =
 
 let name l = snd l.name
 
+let implicit l = l.implicit
+
 let location l = fst l.name
 
 let wrapper l = l.wrapper
@@ -84,6 +87,7 @@ module DB = struct
     ( name
     , { name = s.name
       ; wrapper = Coq_lib_name.wrapper name
+      ; implicit = s.boot
       ; obj_root = dir
       ; src_root = dir
       ; theories = s.buildable.theories
diff --git a/src/dune/coq_lib.mli b/src/dune/coq_lib.mli
index 8e38a65056cd..706fc03ec513 100644
--- a/src/dune/coq_lib.mli
+++ b/src/dune/coq_lib.mli
@@ -8,6 +8,8 @@ type t
 
 val name : t -> Coq_lib_name.t
 
+val implicit : t -> bool
+
 (* this is not really a wrapper for the prefix path *)
 val wrapper : t -> string
 
diff --git a/src/dune/coq_rules.ml b/src/dune/coq_rules.ml
index bfacfd5ab584..6ceca717f13e 100644
--- a/src/dune/coq_rules.ml
+++ b/src/dune/coq_rules.ml
@@ -107,7 +107,8 @@ module Context = struct
     let setup_theory_flag lib =
       let wrapper = Coq_lib.wrapper lib in
       let dir = Coq_lib.src_root lib in
-      [ Command.Args.A "-Q"; Path (Path.build dir); A wrapper ]
+      let binding_flag = if Coq_lib.implicit lib then "-R" else "-Q" in
+      [ Command.Args.A binding_flag; Path (Path.build dir); A wrapper ]
     in
     fun t ->
       Command.of_result_map t.theories_deps ~f:(fun libs ->

From b47a5d446ee99d7d5862393216b235dc8b183fd5 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Fran=C3=A7ois=20Bobot?= <francois.bobot@cea.fr>
Date: Fri, 3 Apr 2020 08:45:24 +0200
Subject: [PATCH 7/8] [Cram sanitization] path separator used to separate
 directory
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

 * Allows to sanitize list of directories that can be found in environment
   variables

Signed-off-by: François Bobot <francois.bobot@cea.fr>
---
 otherlibs/cram/bin/sanitize.ml | 3 ++-
 1 file changed, 2 insertions(+), 1 deletion(-)

diff --git a/otherlibs/cram/bin/sanitize.ml b/otherlibs/cram/bin/sanitize.ml
index b57c4ac5bcd1..033a0254f689 100644
--- a/otherlibs/cram/bin/sanitize.ml
+++ b/otherlibs/cram/bin/sanitize.ml
@@ -15,7 +15,8 @@ let rewrite_paths =
       exit 2
     | Ok map ->
       let abs_path_re =
-        Re.(compile (seq [ char '/'; rep1 (diff any (set " \n\r\t")) ]))
+        let not_dir = Printf.sprintf " \n\r\t%c" Bin.path_sep in
+        Re.(compile (seq [ char '/'; rep1 (diff any (set not_dir)) ]))
       in
       fun s ->
         Re.replace abs_path_re s ~f:(fun g ->

From 74e3b30064dcf5bf768775febe19dd12a0c10ae6 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=A9mie=20Dimino?= <jeremie@dimino.org>
Date: Mon, 6 Apr 2020 13:23:52 +0100
Subject: [PATCH 8/8] Replace all the Decoder.if_* functions by a single
 Decoder.alt (#3318)

Signed-off-by: Jeremie Dimino <jeremie@dimino.org>
---
 src/dune/action_dune_lang.ml                  | 21 ++--
 src/dune/bindings.ml                          | 14 ++-
 src/dune/blang.ml                             | 14 ++-
 src/dune/dep_conf.ml                          |  6 +-
 src/dune/dune_env.ml                          |  8 +-
 src/dune/dune_file.ml                         | 35 +++----
 src/dune/foreign.ml                           |  2 +-
 src/dune/format_config.ml                     |  6 +-
 src/dune/inline_tests.ml                      | 38 +++-----
 src/dune/lib_dep.ml                           | 37 ++++---
 src/dune/mdx.ml                               |  2 +-
 src/dune/package.ml                           | 13 +--
 src/dune_lang/decoder.ml                      | 96 +++++++++++--------
 src/dune_lang/decoder.mli                     | 42 ++++----
 .../test-cases/cmdliner-dep-conf/run.t        |  2 +-
 .../test-cases/re-exported-deps/run.t         |  4 +-
 16 files changed, 162 insertions(+), 178 deletions(-)

diff --git a/src/dune/action_dune_lang.ml b/src/dune/action_dune_lang.ml
index ea35212d4712..518793598dbb 100644
--- a/src/dune/action_dune_lang.ml
+++ b/src/dune/action_dune_lang.ml
@@ -93,17 +93,14 @@ let compare_no_locs t1 t2 = Poly.compare (remove_locs t1) (remove_locs t2)
 open Dune_lang.Decoder
 
 let decode =
-  if_list
-    ~then_:
-      ( located decode >>| fun (loc, action) ->
-        validate ~loc action;
-        action )
-    ~else_:
-      ( loc >>| fun loc ->
-        User_error.raise ~loc
-          [ Pp.textf
-              "if you meant for this to be executed with bash, write (bash \
-               \"...\") instead"
-          ] )
+  (let+ loc, action = located decode in
+   validate ~loc action;
+   action)
+  <|> let+ loc = loc in
+      User_error.raise ~loc
+        [ Pp.textf
+            "if you meant for this to be executed with bash, write (bash \
+             \"...\") instead"
+        ]
 
 let to_dyn a = Dune_lang.to_dyn (encode a)
diff --git a/src/dune/bindings.ml b/src/dune/bindings.ml
index a89dfbaa934e..e5bea9bb722e 100644
--- a/src/dune/bindings.ml
+++ b/src/dune/bindings.ml
@@ -39,11 +39,15 @@ let to_dyn dyn_of_a bindings =
 let decode elem =
   let+ l =
     repeat
-      (if_paren_colon_form
-         ~then_:
-           (let+ values = repeat elem in
-            fun (loc, name) -> Left (loc, name, values))
-         ~else_:(elem >>| Either.right))
+      ( enter
+          (let+ loc, name =
+             located
+               (atom_matching ~desc:"Atom of the form :<name>"
+                  (String.drop_prefix ~prefix:":"))
+           and+ values = repeat elem in
+           Left (loc, name, values))
+      <|> let+ value = elem in
+          Right value )
   in
   let rec loop vars acc = function
     | [] -> List.rev acc
diff --git a/src/dune/blang.ml b/src/dune/blang.ml
index a37ad209aaf5..e0aff000ff57 100644
--- a/src/dune/blang.ml
+++ b/src/dune/blang.ml
@@ -80,14 +80,12 @@ let decode =
   in
   let decode =
     fix (fun t ->
-        if_list
-          ~then_:
-            ( [ ("or", repeat t >>| fun x -> Or x)
-              ; ("and", repeat t >>| fun x -> And x)
-              ]
-              @ ops
-            |> sum )
-          ~else_:(String_with_vars.decode >>| fun v -> Expr v))
+        sum ~force_parens:true
+          ( ("or", repeat t >>| fun x -> Or x)
+          :: ("and", repeat t >>| fun x -> And x)
+          :: ops )
+        <|> let+ v = String_with_vars.decode in
+            Expr v)
   in
   let+ () = Dune_lang.Syntax.since Stanza.syntax (1, 1)
   and+ decode = decode in
diff --git a/src/dune/dep_conf.ml b/src/dune/dep_conf.ml
index 41288e879c19..5c5319c077bb 100644
--- a/src/dune/dep_conf.ml
+++ b/src/dune/dep_conf.ml
@@ -41,7 +41,7 @@ let decode_sandbox_config =
 let decode =
   let decode =
     let sw = String_with_vars.decode in
-    sum
+    sum ~force_parens:true
       [ ("file", sw >>| fun x -> File x)
       ; ("alias", sw >>| fun x -> Alias x)
       ; ("alias_rec", sw >>| fun x -> Alias_rec x)
@@ -61,7 +61,9 @@ let decode =
       ; ("sandbox", decode_sandbox_config >>| fun x -> Sandbox_config x)
       ]
   in
-  if_list ~then_:decode ~else_:(String_with_vars.decode >>| fun x -> File x)
+  decode
+  <|> let+ x = String_with_vars.decode in
+      File x
 
 open Dune_lang
 
diff --git a/src/dune/dune_env.ml b/src/dune/dune_env.ml
index aeb032534a53..c6a3151000f6 100644
--- a/src/dune/dune_env.ml
+++ b/src/dune/dune_env.ml
@@ -178,11 +178,9 @@ module Stanza = struct
   let rule =
     enter
       (let+ pat =
-         match_keyword
-           [ ("_", return Any) ]
-           ~fallback:
-             (let+ p = Profile.decode in
-              Profile p)
+         keyword "_" >>> return Any
+         <|> let+ p = Profile.decode in
+             Profile p
        and+ configs = fields config in
        (pat, configs))
 
diff --git a/src/dune/dune_file.ml b/src/dune/dune_file.ml
index ad886f12ad70..f987ddc9f3af 100644
--- a/src/dune/dune_file.ml
+++ b/src/dune/dune_file.ml
@@ -414,7 +414,7 @@ module Buildable = struct
            (field ~default:None "self_build_stubs_archive"
               ( Dune_lang.Syntax.deleted_in Stanza.syntax (2, 0)
                   ~extra_info:"Use the (foreign_archives ...) field instead."
-              >>> option string )))
+              >>> enter (maybe string) )))
     and+ modules_without_implementation =
       modules_field "modules_without_implementation"
     and+ libraries =
@@ -1303,13 +1303,11 @@ module Executables = struct
     let simple = Dune_lang.Decoder.enum simple_representations
 
     let decode =
-      if_list
-        ~then_:
-          (enter
-             (let+ mode = Mode_conf.decode
-              and+ kind = Binary_kind.decode in
-              make mode kind))
-        ~else_:simple
+      enter
+        (let+ mode = Mode_conf.decode
+         and+ kind = Binary_kind.decode in
+         make mode kind)
+      <|> simple
 
     let simple_encode link_mode =
       let is_ok (_, candidate) = compare candidate link_mode = Eq in
@@ -1704,20 +1702,13 @@ module Rule = struct
     }
 
   let ocamllex =
-    if_eos
-      ~then_:
-        (return { modules = []; mode = Standard; enabled_if = Blang.true_ })
-      ~else_:
-        (if_list
-           ~then_:
-             (fields
-                (let+ modules = field "modules" (repeat string)
-                 and+ mode = Mode.field
-                 and+ enabled_if = enabled_if ~since:(Some (1, 4)) in
-                 { modules; mode; enabled_if }))
-           ~else_:
-             ( repeat string >>| fun modules ->
-               { modules; mode = Standard; enabled_if = Blang.true_ } ))
+    (let+ modules = repeat string in
+     { modules; mode = Standard; enabled_if = Blang.true_ })
+    <|> fields
+          (let+ modules = field "modules" (repeat string)
+           and+ mode = Mode.field
+           and+ enabled_if = enabled_if ~since:(Some (1, 4)) in
+           { modules; mode; enabled_if })
 
   let ocamlyacc = ocamllex
 
diff --git a/src/dune/foreign.ml b/src/dune/foreign.ml
index e84c987bfa2f..fd0599c6e9f6 100644
--- a/src/dune/foreign.ml
+++ b/src/dune/foreign.ml
@@ -183,7 +183,7 @@ module Stubs = struct
         let+ loc, lib_name = sum [ ("lib", located Lib_name.decode) ] in
         Lib (loc, lib_name)
       in
-      if_list ~then_:parse_lib ~else_:parse_dir
+      parse_lib <|> parse_dir
   end
 
   type t =
diff --git a/src/dune/format_config.ml b/src/dune/format_config.ml
index f7dcb0c4b6e6..8ad47c9ef7e6 100644
--- a/src/dune/format_config.ml
+++ b/src/dune/format_config.ml
@@ -96,11 +96,7 @@ let dune2_record_syntax =
   Some { loc; enabled_for }
 
 let dune2_dec =
-  if_list
-    ~then_:(fields dune2_record_syntax)
-    ~else_:
-      (let+ () = keyword "disabled" in
-       None)
+  keyword "disabled" >>> return None <|> fields dune2_record_syntax
 
 let dune2_default = Some { loc = Loc.none; enabled_for = Enabled_for.All }
 
diff --git a/src/dune/inline_tests.ml b/src/dune/inline_tests.ml
index c83830c19e9d..351882358ab7 100644
--- a/src/dune/inline_tests.ml
+++ b/src/dune/inline_tests.ml
@@ -169,15 +169,6 @@ include Sub_system.Register_end_point (struct
 
     type Sub_system_info.t += T of t
 
-    let empty loc =
-      { loc
-      ; deps = []
-      ; flags = Ordered_set_lang.Unexpanded.standard
-      ; backend = None
-      ; modes = Mode_conf.Set.default
-      ; libraries = []
-      }
-
     let loc t = t.loc
 
     let backends t = Option.map t.backend ~f:(fun x -> [ x ])
@@ -187,22 +178,19 @@ include Sub_system.Register_end_point (struct
     open Dune_lang.Decoder
 
     let decode =
-      if_eos ~then_:(loc >>| empty)
-        ~else_:
-          (fields
-             (let+ loc = loc
-              and+ deps = field "deps" (repeat Dep_conf.decode) ~default:[]
-              and+ flags = Ordered_set_lang.Unexpanded.field "flags"
-              and+ backend = field_o "backend" (located Lib_name.decode)
-              and+ libraries =
-                field "libraries" (repeat (located Lib_name.decode)) ~default:[]
-              and+ modes =
-                field "modes"
-                  ( Dune_lang.Syntax.since syntax (1, 11)
-                  >>> Mode_conf.Set.decode )
-                  ~default:Mode_conf.Set.default
-              in
-              { loc; deps; flags; backend; libraries; modes }))
+      fields
+        (let+ loc = loc
+         and+ deps = field "deps" (repeat Dep_conf.decode) ~default:[]
+         and+ flags = Ordered_set_lang.Unexpanded.field "flags"
+         and+ backend = field_o "backend" (located Lib_name.decode)
+         and+ libraries =
+           field "libraries" (repeat (located Lib_name.decode)) ~default:[]
+         and+ modes =
+           field "modes"
+             (Dune_lang.Syntax.since syntax (1, 11) >>> Mode_conf.Set.decode)
+             ~default:Mode_conf.Set.default
+         in
+         { loc; deps; flags; backend; libraries; modes })
 
     (* We don't use this at the moment, but we could implement it for debugging
        purposes *)
diff --git a/src/dune/lib_dep.ml b/src/dune/lib_dep.ml
index bc703168ac59..696e04343212 100644
--- a/src/dune/lib_dep.ml
+++ b/src/dune/lib_dep.ml
@@ -122,25 +122,24 @@ let to_lib_names = function
 
 let decode ~allow_re_export =
   let open Dune_lang.Decoder in
-  if_list
-    ~then_:
-      (enter
-         (let* cloc, constr = located string in
-          match constr with
-          | "re_export" ->
-            if not allow_re_export then
-              User_error.raise ~loc:cloc
-                [ Pp.text "re_export is not allowed here" ];
-            let+ () = Dune_lang.Syntax.since Stanza.syntax (2, 0)
-            and+ loc, name = located Lib_name.decode in
-            Re_export (loc, name)
-          | "select" ->
-            let+ select = Select.decode in
-            Select select
-          | _ -> User_error.raise ~loc:cloc [ Pp.text "invalid constructor" ]))
-    ~else_:
-      (let+ loc, name = located Lib_name.decode in
-       Direct (loc, name))
+  let+ loc, t =
+    located
+      ( sum ~force_parens:true
+          [ ( "re_export"
+            , let+ () = Dune_lang.Syntax.since Stanza.syntax (2, 0)
+              and+ loc, name = located Lib_name.decode in
+              Re_export (loc, name) )
+          ; ( "select"
+            , let+ select = Select.decode in
+              Select select )
+          ]
+      <|> let+ loc, name = located Lib_name.decode in
+          Direct (loc, name) )
+  in
+  match t with
+  | Re_export _ when not allow_re_export ->
+    User_error.raise ~loc [ Pp.text "re_export is not allowed here" ]
+  | _ -> t
 
 let encode =
   let open Dune_lang.Encoder in
diff --git a/src/dune/mdx.ml b/src/dune/mdx.ml
index 72acb639b4c3..30c2b0db0c84 100644
--- a/src/dune/mdx.ml
+++ b/src/dune/mdx.ml
@@ -105,7 +105,7 @@ module Prelude = struct
       let+ file = path in
       Default file
     in
-    if_list ~then_:(enter decode_env) ~else_:decode_default
+    enter decode_env <|> decode_default
 
   let to_args ~dir t : _ Command.Args.t list =
     let bpath p = Path.build (Path.Build.append_local dir p) in
diff --git a/src/dune/package.ml b/src/dune/package.ml
index 42a047c03fd2..7044bddd2d99 100644
--- a/src/dune/package.ml
+++ b/src/dune/package.ml
@@ -123,11 +123,7 @@ module Dependency = struct
         List.map Op.map ~f:(fun (name, op) ->
             ( name
             , let+ x = Var.decode
-              and+ y =
-                if_eos ~then_:(return None)
-                  ~else_:
-                    (let+ v = Var.decode in
-                     Some v)
+              and+ y = maybe Var.decode
               and+ loc = loc
               and+ version = Dune_lang.Syntax.get_exn Stanza.syntax in
               match y with
@@ -183,10 +179,9 @@ module Dependency = struct
       and+ expr = Constraint.decode in
       { name; constraint_ = Some expr }
     in
-    if_list ~then_:(enter constrained)
-      ~else_:
-        (let+ name = Name.decode in
-         { name; constraint_ = None })
+    enter constrained
+    <|> let+ name = Name.decode in
+        { name; constraint_ = None }
 
   let rec opam_constraint : Constraint.t -> OpamParserTypes.value =
     let nopos = Opam_file.nopos in
diff --git a/src/dune_lang/decoder.ml b/src/dune_lang/decoder.ml
index a09c45bdaad2..e663d8d3e87d 100644
--- a/src/dune_lang/decoder.ml
+++ b/src/dune_lang/decoder.ml
@@ -138,19 +138,11 @@ let loc : type k. k context -> k -> Loc.t * k =
   | Values (loc, _, _) -> (loc, state)
   | Fields (loc, _, _) -> (loc, state)
 
-let at_eos : type k. k context -> k -> bool =
+let eos : type k. k context -> k -> bool * k =
  fun ctx state ->
   match ctx with
-  | Values _ -> state = []
-  | Fields _ -> Name.Map.is_empty state.unparsed
-
-let eos ctx state = (at_eos ctx state, state)
-
-let if_eos ~then_ ~else_ ctx state =
-  if at_eos ctx state then
-    then_ ctx state
-  else
-    else_ ctx state
+  | Values _ -> (state = [], state)
+  | Fields _ -> (Name.Map.is_empty state.unparsed, state)
 
 let repeat : 'a t -> 'a list t =
   let rec loop t acc ctx l =
@@ -238,17 +230,20 @@ let junk_everything : type k. (unit, k) parser =
 
 let keyword kwd =
   next (function
-    | Atom (_, s) when Atom.to_string s = kwd -> ()
+    | Atom (_, A s) when s = kwd -> ()
     | sexp ->
       User_error.raise ~loc:(Ast.loc sexp) [ Pp.textf "'%s' expected" kwd ])
 
-let match_keyword l ~fallback =
-  peek >>= function
-  | Some (Atom (_, A s)) -> (
-    match List.assoc l s with
-    | Some t -> junk >>> t
-    | None -> fallback )
-  | _ -> fallback
+let atom_matching f ~desc =
+  next (fun sexp ->
+      match
+        match sexp with
+        | Atom (_, A s) -> f s
+        | _ -> None
+      with
+      | Some x -> x
+      | None ->
+        User_error.raise ~loc:(Ast.loc sexp) [ Pp.textf "%s expected" desc ])
 
 let until_keyword kwd ~before ~after =
   let rec loop acc =
@@ -286,19 +281,33 @@ let enter t =
         result ctx (t ctx l)
       | sexp -> User_error.raise ~loc:(Ast.loc sexp) [ Pp.text "List expected" ])
 
-let if_list ~then_ ~else_ =
-  peek_exn >>= function
-  | List _ -> then_
-  | _ -> else_
-
-let if_paren_colon_form ~then_ ~else_ =
-  peek_exn >>= function
-  | List (_, Atom (loc, A s) :: _) when String.is_prefix s ~prefix:":" ->
-    let name = String.drop s 1 in
-    enter
-      ( junk >>= fun () ->
-        then_ >>| fun f -> f (loc, name) )
-  | _ -> else_
+let ( <|> ) =
+  (* 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
+     will be implemented in a better way and with a much cleaner semantic. *)
+  let approximate_how_much_input_a_failing_branch_consumed
+      (exn : Exn_with_backtrace.t) =
+    Printexc.raw_backtrace_length exn.backtrace
+  in
+  let compare_input_consumed exn1 exn2 =
+    Int.compare
+      (approximate_how_much_input_a_failing_branch_consumed exn1)
+      (approximate_how_much_input_a_failing_branch_consumed exn2)
+  in
+  fun a b ctx state ->
+    try a ctx state
+    with exn_a -> (
+      let exn_a = Exn_with_backtrace.capture exn_a in
+      try b ctx state
+      with exn_b ->
+        let exn_b = Exn_with_backtrace.capture exn_b in
+        Exn_with_backtrace.reraise
+          ( match compare_input_consumed exn_a exn_b with
+          | Gt -> exn_a
+          | Eq
+          | Lt ->
+            exn_b ) )
 
 let fix f =
   let rec p = lazy (f r)
@@ -423,11 +432,7 @@ let bytes_unit =
     ; ("GB", 1000 * 1000 * 1000)
     ]
 
-let option t =
-  enter
-    (eos >>= function
-     | true -> return None
-     | false -> t >>| Option.some)
+let maybe t = t >>| Option.some <|> return None
 
 let find_cstr cstrs loc name ctx values =
   match List.assoc cstrs name with
@@ -438,15 +443,22 @@ let find_cstr cstrs loc name ctx values =
         (User_message.did_you_mean name ~candidates:(List.map cstrs ~f:fst))
       [ Pp.textf "Unknown constructor %s" name ]
 
-let sum cstrs =
+let sum ?(force_parens = false) cstrs =
   next_with_user_context (fun uc sexp ->
       match sexp with
-      | Atom (loc, A s) -> find_cstr cstrs loc s (Values (loc, Some s, uc)) []
+      | Atom (loc, A s) when not force_parens ->
+        find_cstr cstrs loc s (Values (loc, Some s, uc)) []
+      | Atom (loc, _)
       | Template { loc; _ }
-      | Quoted_string (loc, _) ->
-        User_error.raise ~loc [ Pp.text "Atom expected" ]
+      | Quoted_string (loc, _)
       | List (loc, []) ->
-        User_error.raise ~loc [ Pp.text "Non-empty list expected" ]
+        User_error.raise ~loc
+          [ Pp.textf "S-expression of the form %s expected"
+              ( if force_parens then
+                "(<atom> ...)"
+              else
+                "(<atom> ...) or <atom>" )
+          ]
       | List (loc, name :: args) -> (
         match name with
         | Quoted_string (loc, _)
diff --git a/src/dune_lang/decoder.mli b/src/dune_lang/decoder.mli
index ef4e838986e1..15e0e35eaea3 100644
--- a/src/dune_lang/decoder.mli
+++ b/src/dune_lang/decoder.mli
@@ -75,27 +75,21 @@ val set_many : Univ_map.t -> ('a, 'k) parser -> ('a, 'k) parser
 (** Return the location of the list currently being parsed. *)
 val loc : (Loc.t, _) parser
 
-(** End of sequence condition. Uses [then_] if there are no more S-expressions
-    to parse, [else_] otherwise. *)
-val if_eos : then_:('a, 'b) parser -> else_:('a, 'b) parser -> ('a, 'b) 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
 
-(** If the next element of the sequence is a list, parse it with [then_],
-    otherwise parse it with [else_]. *)
-val if_list : then_:'a t -> else_:'a t -> 'a t
+(** [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. *)
+val atom_matching : (string -> 'a option) -> desc:string -> 'a t
 
-(** If the next element of the sequence is of the form [(:<name> ...)], use
-    [then_] to parse [...]. Otherwise use [else_]. *)
-val if_paren_colon_form : then_:(Loc.t * string -> 'a) t -> else_:'a t -> 'a t
+(** [keyword s] is a short-hand for
 
-(** Expect the next element to be the following atom. *)
+    {[ atom_matching (String.equal s) ~desc:(sprintf "'%s'" s) ]} *)
 val keyword : string -> unit t
 
-(** [match_keyword \[(k1, t1); (k2, t2); ...\] ~fallback] inspects the next
-    element of the input sequence. If it is an atom equal to one of [k1], [k2],
-    ... then the corresponding parser is used to parse the rest of the sequence.
-    Other [fallback] is used. *)
-val match_keyword : (string * 'a t) list -> fallback:'a t -> 'a t
-
 (** Use [before] to parse elements until the keyword is reached. Then use
     [after] to parse the rest. *)
 val until_keyword :
@@ -138,7 +132,14 @@ val pair : 'a t -> 'b t -> ('a * 'b) t
 
 val triple : 'a t -> 'b t -> 'c t -> ('a * 'b * 'c) t
 
-val option : 'a t -> 'a option t
+(** [maybe t] is a short-hand for:
+
+    {[
+      (let+ x = t in
+       Some x)
+      <|> return None
+    ]} *)
+val maybe : 'a t -> 'a option t
 
 (** Consume the next element as a duration, requiring 's', 'm' or 'h' suffix *)
 val duration : int t
@@ -178,8 +179,11 @@ val enum : (string * 'a) list -> 'a t
 (** Parser that parse a S-expression of the form
     [(<atom> <s-exp1> <s-exp2> ...)] or [<atom>]. [<atom>] is looked up in the
     list and the remaining s-expressions are parsed using the corresponding list
-    parser. *)
-val sum : (string * 'a t) list -> 'a t
+    parser.
+
+    If [force_parens] is [true], then the form [<atom>] is never accepted. The
+    default is [false]. *)
+val sum : ?force_parens:bool -> (string * 'a t) list -> 'a t
 
 (** Check the result of a list parser, and raise a properly located error in
     case of failure. *)
diff --git a/test/blackbox-tests/test-cases/cmdliner-dep-conf/run.t b/test/blackbox-tests/test-cases/cmdliner-dep-conf/run.t
index f8ef5df7464b..4d30197b470e 100755
--- a/test/blackbox-tests/test-cases/cmdliner-dep-conf/run.t
+++ b/test/blackbox-tests/test-cases/cmdliner-dep-conf/run.t
@@ -20,7 +20,7 @@
   [1]
 
   $ dune build "()"
-  dune: TARGET... arguments: Non-empty list expected
+  dune: TARGET... arguments: Unexpected list
   Usage: dune build [OPTION]... [TARGET]...
   Try `dune build --help' or `dune --help' for more information.
   [1]
diff --git a/test/blackbox-tests/test-cases/re-exported-deps/run.t b/test/blackbox-tests/test-cases/re-exported-deps/run.t
index 4354c9d4b1d6..d8f2334b9e5f 100644
--- a/test/blackbox-tests/test-cases/re-exported-deps/run.t
+++ b/test/blackbox-tests/test-cases/re-exported-deps/run.t
@@ -43,8 +43,8 @@ transtive deps expressed in the dune-package
 Re-exporting deps in executables isn't allowed
   $ dune build --root re-export-exe @all
   Entering directory 're-export-exe'
-  File "dune", line 7, characters 13-22:
+  File "dune", line 7, characters 12-27:
   7 |  (libraries (re_export foo)))
-                   ^^^^^^^^^
+                  ^^^^^^^^^^^^^^^
   Error: re_export is not allowed here
   [1]