Simplify the API for parsing remaining arguments of constructors

src/action.ml

@@ -30,7 +30,7 @@ struct
   let rec t sexp =
     let path = Path.t and string = String.t in
     sum
-      [ cstr_rest "run" (Program.t @> nil) string (fun prog args -> Run (prog, args))
+      [ cstr "run" (Program.t @> rest string) (fun prog args -> Run (prog, args))
       ; cstr "chdir"    (path @> t @> nil)        (fun dn t -> Chdir (dn, t))
       ; cstr "setenv"   (string @> string @> t @> nil)   (fun k v t -> Setenv (k, v, t))
       ; cstr "with-stdout-to"  (path @> t @> nil) (fun fn t -> Redirect (Stdout, fn, t))
@@ -39,7 +39,7 @@ struct
       ; cstr "ignore-stdout"   (t @> nil)      (fun t -> Ignore (Stdout, t))
       ; cstr "ignore-stderr"   (t @> nil)      (fun t -> Ignore (Stderr, t))
       ; cstr "ignore-outputs"  (t @> nil)      (fun t -> Ignore (Outputs, t))
-      ; cstr_rest "progn"      nil t         (fun l -> Progn l)
+      ; cstr "progn"           (rest t)        (fun l -> Progn l)
       ; cstr "echo"           (string @> nil)         (fun x -> Echo x)
       ; cstr "cat"            (path @> nil)         (fun x -> Cat x)
       ; cstr "copy" (path @> path @> nil)              (fun src dst -> Copy (src, dst))

src/jbuild.ml

@@ -1265,7 +1265,7 @@ module Stanzas = struct
           (fun glob -> [Copy_files {add_line_directive = false; glob}])
       ; cstr "copy_files#" (Copy_files.v1 @> nil)
           (fun glob -> [Copy_files {add_line_directive = true; glob}])
-      ; cstr_rest_loc "env" nil Env.rule
+      ; cstr_loc "env" (rest Env.rule)
           (fun loc rules -> [Env { loc; rules }])
       (* Just for validation and error messages *)
       ; cstr "jbuild_version" (Jbuild_version.t @> nil) (fun _ -> [])

src/stdune/sexp.ml

@@ -336,35 +336,31 @@ module Of_sexp = struct
       of_sexp_errorf ~hint:({ on = name ; candidates = state.known})
         name_sexp "Unknown field %s" name
 
-  type ('a, 'b) rest =
-    | No_rest : ('a, 'a) rest
-    | Many    : 'a t -> ('a list -> 'b, 'b) rest
-
   module Constructor_args_spec = struct
     type 'a conv = 'a t
     type ('a, 'b) t =
       | Nil  : ('a, 'a) t
+      | Rest : 'a conv -> ('a  list -> 'b, 'b) t
       | Cons : 'a conv * ('b, 'c) t -> ('a -> 'b, 'c) t
 
-    let rec convert : type a b c. (a, b) t -> (b, c) rest -> Ast.t -> Ast.t list -> a -> c
-      = fun t rest sexp sexps f ->
-        match t, rest, sexps with
-        | Nil, No_rest, [] -> f
-        | Nil, Many _ , [] -> f []
-        | Cons _, _, [] -> of_sexp_error sexp "not enough arguments"
-        | Nil, No_rest, _ :: _ -> of_sexp_error sexp "too many arguments"
-        | Nil, Many conv, l -> f (List.map l ~f:conv)
-        | Cons (conv, t), _, s :: sexps ->
-          convert t rest sexp sexps (f (conv s))
+    let rec convert : type a b. (a, b) t -> Ast.t -> Ast.t list -> a -> b
+      = fun t sexp sexps f ->
+        match t, sexps with
+        | Nil, [] -> f
+        | Rest conv, l  -> f (List.map l ~f:conv)
+        | Cons (conv, t), s :: sexps -> convert t sexp sexps (f (conv s))
+        | Cons _, [] -> of_sexp_error sexp "not enough arguments"
+        | Nil, _ :: _ -> of_sexp_error sexp "too many arguments"
   end
 
   let nil = Constructor_args_spec.Nil
   let ( @> ) a b = Constructor_args_spec.Cons (a, b)
+  let rest f = Constructor_args_spec.Rest f
 
   let field_multi name ?default args_spec f state =
     match find_single state name with
     | Some { values; entry; _ } ->
-      (Constructor_args_spec.convert args_spec No_rest entry values f,
+      (Constructor_args_spec.convert args_spec entry values f,
        consume name state)
     | None ->
       match default with
@@ -377,7 +373,7 @@ module Of_sexp = struct
       | None -> acc
       | Some { values; entry; prev } ->
         let x =
-          Constructor_args_spec.convert args_spec No_rest entry values f
+          Constructor_args_spec.convert args_spec entry values f
         in
         loop (x :: acc) prev
     in
@@ -385,10 +381,9 @@ module Of_sexp = struct
     (res, consume name state)
 
   module Constructor_spec = struct
-    type ('a, 'b, 'c) tuple =
+    type ('a, 'b) tuple =
       { name : string
       ; args : ('a, 'b) Constructor_args_spec.t
-      ; rest : ('b, 'c) rest
       ; make : Loc.t -> 'a
       }
 
@@ -398,8 +393,8 @@ module Of_sexp = struct
       }
 
     type 'a t =
-      | Tuple  : (_, _, 'a) tuple -> 'a t
-      | Record : 'a record        -> 'a t
+      | Tuple  : (_, 'a) tuple -> 'a t
+      | Record : 'a record     -> 'a t
 
     let name = function
       | Tuple  x -> x.name
@@ -408,9 +403,7 @@ module Of_sexp = struct
   module C = Constructor_spec
 
   let cstr_loc name args make =
-    C.Tuple { name; args; make; rest = No_rest }
-  let cstr_rest_loc name args rest make =
-    C.Tuple { name; args; make; rest = Many rest }
+    C.Tuple { name; args; make }
 
   let cstr_record name parse =
     C.Record { name; parse }
@@ -418,9 +411,6 @@ module Of_sexp = struct
   let cstr name args make =
     cstr_loc name args (fun _ -> make)
 
-  let cstr_rest name args rest make =
-    cstr_rest_loc name args rest (fun _ -> make)
-
   let equal_cstr_name a b = Name.compare a b = Eq
 
   let find_cstr cstrs sexp name =
@@ -441,7 +431,7 @@ module Of_sexp = struct
     match sexp with
     | Atom (loc, A s) -> begin
         match find_cstr cstrs sexp s with
-        | C.Tuple  t -> Constructor_args_spec.convert t.args t.rest sexp [] (t.make loc)
+        | C.Tuple  t -> Constructor_args_spec.convert t.args sexp [] (t.make loc)
         | C.Record _ -> of_sexp_error sexp "'%s' expect arguments"
       end
     | Quoted_string _ -> of_sexp_error sexp "Atom expected"
@@ -451,7 +441,8 @@ module Of_sexp = struct
       | Quoted_string _ | List _ -> of_sexp_error name_sexp "Atom expected"
       | Atom (_, A s) ->
         match find_cstr cstrs sexp s with
-        | C.Tuple  t -> Constructor_args_spec.convert t.args t.rest sexp args (t.make loc)
+        | C.Tuple  t -> Constructor_args_spec.convert t.args sexp args
+                          (t.make loc)
         | C.Record r -> record r.parse (List (loc, args))
 
   let enum cstrs sexp =

src/stdune/sexp.mli

@@ -129,6 +129,7 @@ module Of_sexp : sig
     :  'a t
     -> ('b, 'c) Constructor_args_spec.t
     -> ('a -> 'b, 'c) Constructor_args_spec.t
+  val rest : 'a t -> ('a list -> 'b, 'b) Constructor_args_spec.t
 
   (** Field that takes multiple values *)
   val field_multi
@@ -147,12 +148,6 @@ module Of_sexp : sig
     -> 'b list record_parser
 
   val cstr : string -> ('a, 'b) Constructor_args_spec.t -> 'a -> 'b Constructor_spec.t
-  val cstr_rest
-    :  string
-    -> ('a, 'b list -> 'c) Constructor_args_spec.t
-    -> 'b t
-    -> 'a
-    -> 'c Constructor_spec.t
 
   val cstr_record : string -> 'a record_parser -> 'a Constructor_spec.t
 
@@ -162,13 +157,6 @@ module Of_sexp : sig
     -> (Loc.t -> 'a)
     -> 'b Constructor_spec.t
 
-  val cstr_rest_loc
-    :  string
-    -> ('a, 'b list -> 'c) Constructor_args_spec.t
-    -> 'b t
-    -> (Loc.t -> 'a)
-    -> 'c Constructor_spec.t
-
   val sum
     :  'a Constructor_spec.t list
     -> 'a t