Parse bindings in the new syntax

Signed-off-by: Rudi Grinberg <rudi.grinberg@gmail.com>

src/jbuild.ml

@@ -262,21 +262,16 @@ module Named = struct
   let t elem =
     let binding =
       peek_exn >>= function
-      | Atom (loc, A s) when String.length s > 1 && s.[0] = ':' ->
-        begin
-          string >>= fun name ->
-          peek >>= function
-          | None -> of_sexp_errorf loc "Naked binding %s" s
-          | Some _ ->
-            elem >>| fun elem ->
-            Left (name, (loc, elem))
-        end
+      | List (_, Atom (loc, A s) :: _) when
+          String.length s > 1 && s.[0] = ':' ->
+        binding elem >>| fun (name, values) ->
+        Left (name, (loc, values))
       | _ ->
         elem >>| fun elem -> Right elem
     in
     list binding >>| (fun bindings ->
       let (named, unnamed) = List.partition_map bindings ~f:(fun x -> x) in
-      { unnamed = List.flatten unnamed
+      { unnamed
       ; named =
           (match String.Map.of_list named with
            | Ok x -> x
@@ -331,15 +326,6 @@ module Dep_conf = struct
   let t =
     make_dep_parser ~single:(fun x -> x) ~many:(sum dep_cons)
 
-  let bindings =
-    let dep =
-      make_dep_parser ~single:List.singleton ~many:(
-        ("list", repeat t)
-        :: List.map dep_cons ~f:(fun (n, d) -> (n, d >>| List.singleton))
-        |> sum)
-    in
-    Named.t dep
-
   open Sexp
   let sexp_of_t = function
     | File t ->
@@ -1202,7 +1188,7 @@ module Rule = struct
     >>= fun action ->
     field "targets" (list file_in_current_dir)
     >>= fun targets ->
-    field "deps" Dep_conf.bindings ~default:Named.empty
+    field "deps" (Named.t Dep_conf.t) ~default:Named.empty
     >>= fun deps ->
     field "locks"   (list String_with_vars.t) ~default:[] >>= fun locks ->
     map_validate
@@ -1421,7 +1407,7 @@ module Alias_conf = struct
        field_o "package" Pkg.t                          >>= fun package ->
        field_o "action" (located Action.Unexpanded.t)   >>= fun action ->
        field "locks" (list String_with_vars.t) ~default:[] >>= fun locks ->
-       field "deps" Dep_conf.bindings ~default:Named.empty
+       field "deps" (Named.t Dep_conf.t) ~default:Named.empty
        >>= fun deps ->
        return
          { name
@@ -1445,7 +1431,7 @@ module Tests = struct
       (Buildable.t                                         >>= fun buildable ->
        field_oslu "link_flags"                             >>= fun link_flags ->
        names                                               >>= fun names ->
-       field "deps" Dep_conf.bindings ~default:Named.empty >>= fun deps ->
+       field "deps" (Named.t Dep_conf.t) ~default:Named.empty >>= fun deps ->
        field_o "package" Pkg.t                             >>= fun package ->
        field "locks" (list String_with_vars.t) ~default:[] >>= fun locks ->
        field "modes" Executables.Link_mode.Set.t

src/stdune/sexp.ml

@@ -380,6 +380,26 @@ module Of_sexp = struct
               }
         "Unknown constructor %s" name
 
+  let binding t =
+    let t name = repeat t >>| fun t -> (name, t) in
+    next_with_user_context (fun uc sexp ->
+      match sexp with
+      | Atom (loc, A s) ->
+        let ctx = Values (loc, Some s, uc) in
+        result ctx (t s ctx [])
+      | Template { loc; _ }
+      | Quoted_string (loc, _) ->
+        of_sexp_error loc "Atom expected"
+      | List (loc, []) ->
+        of_sexp_error loc "Non-empty list expected"
+      | List (loc, name :: args) ->
+        match name with
+        | Quoted_string (loc, _) | List (loc, _) | Template { loc; _ } ->
+          of_sexp_error loc "Atom expected"
+        | Atom (s_loc, A s) ->
+          let ctx loc = Values (loc, Some s, uc) in
+          result (ctx s_loc) (t s (ctx loc) args))
+
   let sum cstrs =
     next_with_user_context (fun uc sexp ->
       match sexp with

src/stdune/sexp.mli

@@ -201,6 +201,8 @@ module Of_sexp : sig
       list parser. *)
   val sum : (string * 'a t) list -> 'a t
 
+  val binding : 'a t -> (string * ('a list)) t
+
   (** Check the result of a list parser, and raise a properly located
       error in case of failure. *)
   val map_validate

test/blackbox-tests/test-cases/dep-vars/dune

@@ -1,5 +1,5 @@
 
 (rule
- (deps :foo (list a b) :baz foo (list (alias test)) (list a b c))
+ (deps (:foo a b) (:baz foo (alias test)) a b c)
  (targets bar)
  (action (with-stdout-to bar (echo "foo"))))

test/blackbox-tests/test-cases/merlin-tests/run.t

@@ -4,18 +4,6 @@
       ocamlopt sanitize-dot-merlin/.sanitize_dot_merlin.eobjs/sanitize_dot_merlin.{cmx,o}
       ocamlopt sanitize-dot-merlin/sanitize_dot_merlin.exe
   sanitize_dot_merlin alias print-merlins
-  # Processing exe/.merlin
-  B $LIB_PREFIX/lib/bytes
-  B $LIB_PREFIX/lib/findlib
-  B $LIB_PREFIX/lib/ocaml
-  B ../_build/default/exe/.x.eobjs
-  B ../_build/default/lib/.foo.objs
-  S $LIB_PREFIX/lib/bytes
-  S $LIB_PREFIX/lib/findlib
-  S $LIB_PREFIX/lib/ocaml
-  S .
-  S ../lib
-  FLG -w -40
   # Processing lib/.merlin
   B $LIB_PREFIX/lib/bytes
   B $LIB_PREFIX/lib/findlib
@@ -28,6 +16,18 @@
   S .
   FLG -ppx '$PPX/fooppx@./ppx.exe --as-ppx --cookie '\''library-name="foo"'\'''
   FLG -open Foo -w -40 -open Bar -w -40
+  # Processing exe/.merlin
+  B $LIB_PREFIX/lib/bytes
+  B $LIB_PREFIX/lib/findlib
+  B $LIB_PREFIX/lib/ocaml
+  B ../_build/default/exe/.x.eobjs
+  B ../_build/default/lib/.foo.objs
+  S $LIB_PREFIX/lib/bytes
+  S $LIB_PREFIX/lib/findlib
+  S $LIB_PREFIX/lib/ocaml
+  S .
+  S ../lib
+  FLG -w -40
 
 Make sure a ppx directive is generated
 

test/blackbox-tests/test-cases/misc/run.t

@@ -2,5 +2,22 @@
   File "dune", line 44, characters 19-42:
   Warning: Directory dir-that-doesnt-exist doesn't exist.
           diff alias runtest
-          diff alias runtest
-          diff alias runtest
+          diff alias runtest (exit 1)
+  (cd _build/default && /usr/bin/diff -u result expected)
+  --- result	2018-07-09 21:13:11.000000000 +0700
+  +++ expected	2018-07-09 21:13:11.000000000 +0700
+  @@ -1 +1 @@
+  -c.txt b.txt a.txt dune
+  \ No newline at end of file
+  +dune a.txt b.txt c.txt
+  \ No newline at end of file
+          diff alias runtest (exit 1)
+  (cd _build/default && /usr/bin/diff -u result2 expected2)
+  --- result2	2018-07-09 21:13:11.000000000 +0700
+  +++ expected2	2018-07-09 21:13:11.000000000 +0700
+  @@ -1 +1 @@
+  -sub-tree/dir/b sub-tree/a
+  \ No newline at end of file
+  +sub-tree/a sub-tree/dir/b
+  \ No newline at end of file
+  [1]