Merge branch 'toplevel-ppx' of https://github.com/stephanieyou/dune i…

…nto toplevel-ppx

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 ->

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)

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

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

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

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

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

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
 

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 ->

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
 

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)) )
       ]
 

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))
 

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
@@ -1562,45 +1560,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 +1587,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 +1651,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:[]
@@ -1743,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
 

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