Simplify the API for inlined records in constructors

src/stdune/sexp.ml

@@ -339,18 +339,26 @@ module Of_sexp = struct
   module Constructor_args_spec = struct
     type 'a conv = 'a t
     type ('a, 'b) t =
-      | Nil  : ('a, 'a) t
+      | Nil    : ('a, 'a) t
-      | Rest : 'a conv -> ('a  list -> 'b, 'b) t
+      | Rest   : 'a conv -> ('a  list -> 'b, 'b) t
-      | Loc  : ('a, 'b) t -> (Loc.t -> 'a, 'b) t
+      | Record : 'a record_parser -> ('a -> 'b, 'b) t
-      | Cons : 'a conv * ('b, 'c) t -> ('a -> 'b, 'c) t
+      | Loc    : ('a, 'b) t -> (Loc.t -> 'a, 'b) t
+      | Cons   : 'a conv * ('b, 'c) t -> ('a -> 'b, 'c) t
 
     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)
-        | Loc t, sexps -> convert t sexp sexps (f (Ast.loc sexp))
+        | Record rp, l -> begin
-        | Cons (conv, t), s :: sexps -> convert t sexp sexps (f (conv s))
+            match sexp with
+            | Atom (_, A s) | Quoted_string (_, s) ->
+              of_sexp_errorf sexp "'%s' expect arguments" s
+            | List (loc, _) ->
+              f (record rp (List (loc, l)))
+          end
+        | Loc t, l -> convert t sexp l (f (Ast.loc sexp))
+        | Cons (conv, t), s :: l -> convert t sexp l (f (conv s))
         | Cons _, [] -> of_sexp_error sexp "not enough arguments"
         | Nil, _ :: _ -> of_sexp_error sexp "too many arguments"
   end
@@ -359,6 +367,7 @@ module Of_sexp = struct
   let ( @> ) a b = Constructor_args_spec.Cons (a, b)
   let rest f = Constructor_args_spec.Rest f
   let cstr_loc x = Constructor_args_spec.Loc x
+  let rest_as_record rp = Constructor_args_spec.Record rp
 
   let field_multi name ?default args_spec f state =
     match find_single state name with
@@ -384,32 +393,19 @@ module Of_sexp = struct
     (res, consume name state)
 
   module Constructor_spec = struct
-    type ('a, 'b) tuple =
+    type ('a, 'b) unpacked =
       { name : string
       ; args : ('a, 'b) Constructor_args_spec.t
       ; make : 'a
       }
 
-    type 'a record =
+    type 'a t = T : (_, 'a) unpacked -> 'a t [@@unboxed]
-      { name  : string
-      ; parse : 'a record_parser
-      }
 
-    type 'a t =
+    let name (T t) = t.name
-      | Tuple  : (_, 'a) tuple -> 'a t
-      | Record : 'a record     -> 'a t
-
-    let name = function
-      | Tuple  x -> x.name
-      | Record x -> x.name
   end
   module C = Constructor_spec
 
-  let cstr name args make =
+  let cstr name args make = C.T { name; args; make }
-    C.Tuple { name; args; make }
-
-  let cstr_record name parse =
-    C.Record { name; parse }
 
   let equal_cstr_name a b = Name.compare a b = Eq
 
@@ -422,27 +418,23 @@ module Of_sexp = struct
     | None ->
       of_sexp_errorf sexp
         ~hint:{ on = String.uncapitalize name
-              ; candidates = List.map cstrs ~f:(fun c ->
+              ; candidates = List.map cstrs ~f:C.name
-                  String.uncapitalize (C.name c))
               }
         "Unknown constructor %s" name
 
   let sum cstrs sexp =
     match sexp with
-    | Atom (_, A s) -> begin
+    | Atom (_, A s) ->
-        match find_cstr cstrs sexp s with
+      let (C.T cstr) = find_cstr cstrs sexp s in
-        | C.Tuple  t -> Constructor_args_spec.convert t.args sexp [] t.make
+      Constructor_args_spec.convert cstr.args sexp [] cstr.make
-        | C.Record _ -> of_sexp_error sexp "'%s' expect arguments"
-      end
     | Quoted_string _ -> of_sexp_error sexp "Atom expected"
     | List (_, []) -> of_sexp_error sexp "non-empty list expected"
-    | List (loc, name_sexp :: args) ->
+    | List (_, name_sexp :: args) ->
       match name_sexp with
       | Quoted_string _ | List _ -> of_sexp_error name_sexp "Atom expected"
       | Atom (_, A s) ->
-        match find_cstr cstrs sexp s with
+        let (C.T cstr) = find_cstr cstrs sexp s in
-        | C.Tuple  t -> Constructor_args_spec.convert t.args sexp args t.make
+        Constructor_args_spec.convert cstr.args sexp args cstr.make
-        | C.Record r -> record r.parse (List (loc, args))
 
   let enum cstrs sexp =
     match sexp with

src/stdune/sexp.mli

@@ -133,6 +133,9 @@ module Of_sexp : sig
   (** Parse all remaining arguments using the following parser *)
   val rest : 'a t -> ('a list -> 'b, 'b) Constructor_args_spec.t
 
+  (** Parse all remaining arguments using the following record parser *)
+  val rest_as_record : 'a record_parser -> ('a -> 'b, 'b) Constructor_args_spec.t
+
   (** Capture the location of the constructor *)
   val cstr_loc
     :  ('a, 'b) Constructor_args_spec.t
@@ -159,10 +162,6 @@ module Of_sexp : sig
     -> ('a, 'b) Constructor_args_spec.t
     -> 'a
     -> 'b Constructor_spec.t
-  val cstr_record
-    :  string
-    -> 'a record_parser
-    -> 'a Constructor_spec.t
 
   val sum
     :  'a Constructor_spec.t list

src/workspace.ml

@@ -63,10 +63,12 @@ module Context = struct
     | List (_, List _ :: _) as sexp -> Opam (record (Opam.t ~profile) sexp)
     | sexp ->
       sum
-        [ cstr_record "default"
+        [ cstr "default"
-            (Default.t ~profile >>= fun x -> return (Default x))
+            (rest_as_record (Default.t ~profile))
-        ; cstr_record "opam"
+            (fun x -> Default x)
-            (Opam.t ~profile >>= fun x -> return (Opam x))
+        ; cstr "opam"
+            (rest_as_record (Opam.t ~profile))
+            (fun x -> Opam x)
         ]
         sexp