unikernel/duniverse/ppx_sexp_conv/.gitignore

@@ -0,0 +1,5 @@
+_build
+*.install
+*.merlin
+_opam
+

unikernel/duniverse/ppx_sexp_conv/.ocamlformat

@@ -0,0 +1 @@
+profile=janestreet

unikernel/duniverse/ppx_sexp_conv/CHANGES.md

@@ -0,0 +1,54 @@
+## v0.11
+
+- Depend on ppxlib instead of (now deprecated) ppx\_core, ppx\_driver and
+  ppx\_metaquot.
+
+## v0.10
+
+- Added new `[@@deriving sexp]` record-field attribute, `[@sexp.omit_nil]`, for
+  a field that is omitted if its sexp representation is `()`.
+
+- Improved `[%sexp_of: 'a]` and `[%of_sexp: 'a]` to not expose variable names
+  intended for internal use.
+
+## v0.9
+
+## 113.43.00
+
+- Fix generator for polymorphic types where var names clashes with type name: `type 't t = ...`
+
+## 113.33.00
+
+- Clean up the documentation for sexplib, modernizing it to include
+  `ppx_sexp_conv`, and breaking up the documentation between sexplib and
+  `ppx_sexp_conv`.  Also changed the formatting to use org-mode, so it
+  will render properly on github.  Markdown doesn't render well by
+  default, unless you use quite different conventions about linebeaks.
+
+## 113.24.00
+
+- Trying to improve the tests in ppx\_sexp\_conv because they are a mess.
+  At least all tests are automatic now. And more things are tested like
+  the sexpification of exceptions.
+
+- Update to follow `Type_conv` and `Ppx_core` evolution.
+
+- Make ppx\_sexp\_conv correctly handle aliases to polymorphic variants:
+
+  type t = ` `A ` `@@deriving sexp`
+  type u = t `@@deriving sexp`
+  type v = ` u | `B ` `@@deriving sexp`
+
+  Before, `v_of_sexp` would never manage to read `B.  This problem is
+  now fixed if you use `sexp_poly` on `u` instead of `sexp`, and if you
+  don't, you get an "unbound value __u_of_sexp__".  People should use
+  `sexp_poly` when they have a polymorphic variant type that is not
+  syntactically a polymorphic variant, but in practice it's simpler to
+  replace `sexp` by `sexp_poly` when faced with the error above.
+
+  The need for `sexp_poly` should happen only in one new case: an
+  implementation says `type u = t `@@deriving sexp`` but the interface
+  says `type u = ``A` `@@deriving sexp``.  (the old case where it was
+  already needed is when you have an interface that says `type u = t
+  `@@deriving sexp`` and in some other implementation you try to say
+  `type t = ` That_module.t | `A ` `@@deriving sexp``).

unikernel/duniverse/ppx_sexp_conv/CONTRIBUTING.md

@@ -0,0 +1,67 @@
+This repository contains open source software that is developed and
+maintained by [Jane Street][js].
+
+Contributions to this project are welcome and should be submitted via
+GitHub pull requests.
+
+Signing contributions
+---------------------
+
+We require that you sign your contributions. Your signature certifies
+that you wrote the patch or otherwise have the right to pass it on as
+an open-source patch. The rules are pretty simple: if you can certify
+the below (from [developercertificate.org][dco]):
+
+```
+Developer Certificate of Origin
+Version 1.1
+
+Copyright (C) 2004, 2006 The Linux Foundation and its contributors.
+1 Letterman Drive
+Suite D4700
+San Francisco, CA, 94129
+
+Everyone is permitted to copy and distribute verbatim copies of this
+license document, but changing it is not allowed.
+
+
+Developer's Certificate of Origin 1.1
+
+By making a contribution to this project, I certify that:
+
+(a) The contribution was created in whole or in part by me and I
+    have the right to submit it under the open source license
+    indicated in the file; or
+
+(b) The contribution is based upon previous work that, to the best
+    of my knowledge, is covered under an appropriate open source
+    license and I have the right under that license to submit that
+    work with modifications, whether created in whole or in part
+    by me, under the same open source license (unless I am
+    permitted to submit under a different license), as indicated
+    in the file; or
+
+(c) The contribution was provided directly to me by some other
+    person who certified (a), (b) or (c) and I have not modified
+    it.
+
+(d) I understand and agree that this project and the contribution
+    are public and that a record of the contribution (including all
+    personal information I submit with it, including my sign-off) is
+    maintained indefinitely and may be redistributed consistent with
+    this project or the open source license(s) involved.
+```
+
+Then you just add a line to every git commit message:
+
+```
+Signed-off-by: Joe Smith <joe.smith@email.com>
+```
+
+Use your real name (sorry, no pseudonyms or anonymous contributions.)
+
+If you set your `user.name` and `user.email` git configs, you can sign
+your commit automatically with git commit -s.
+
+[dco]: http://developercertificate.org/
+[js]: https://opensource.janestreet.com/

unikernel/duniverse/ppx_sexp_conv/LICENSE.md

@@ -0,0 +1,21 @@
+The MIT License
+
+Copyright (c) 2015--2024 Jane Street Group, LLC <opensource-contacts@janestreet.com>
+
+Permission is hereby granted, free of charge, to any person obtaining a copy
+of this software and associated documentation files (the "Software"), to deal
+in the Software without restriction, including without limitation the rights
+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
+copies of the Software, and to permit persons to whom the Software is
+furnished to do so, subject to the following conditions:
+
+The above copyright notice and this permission notice shall be included in all
+copies or substantial portions of the Software.
+
+THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+SOFTWARE.

unikernel/duniverse/ppx_sexp_conv/Makefile

@@ -0,0 +1,17 @@
+INSTALL_ARGS := $(if $(PREFIX),--prefix $(PREFIX),)
+
+default:
+	dune build
+
+install:
+	dune install $(INSTALL_ARGS)
+
+uninstall:
+	dune uninstall $(INSTALL_ARGS)
+
+reinstall: uninstall install
+
+clean:
+	dune clean
+
+.PHONY: default install uninstall reinstall clean

unikernel/duniverse/ppx_sexp_conv/README.org

@@ -0,0 +1,582 @@
+#+TITLE: ppx_sexp_conv
+
+* [@@deriving sexp]
+
+=ppx_sexp_conv= is a PPX syntax extension that generates code for
+converting OCaml types to and from s-expressions, as defined in the
+[[https://github.com/janestreet/sexplib][=sexplib=]] library.  S-expressions are defined by the following type:
+
+#+begin_src ocaml
+type sexp = Atom of string | List of sexp list
+#+end_src
+
+and are rendered as parenthesized lists of strings, /e.g./ =(This (is
+an) (s expression))=.
+
+=ppx_sexp_conv= fits into the [[https://github.com/whitequark/ppx_deriving][=ppx_deriving=]] framework, so you can
+invoke it the same way you invoke any other deriving plug-in.  Thus,
+we can write
+
+#+begin_src ocaml
+type int_pair = (int * int) [@@deriving sexp]
+#+end_src
+
+to get two values defined automatically, =sexp_of_int_pair= and
+=int_pair_of_sexp=.  If we only want one direction, we can write one
+of the following.
+
+#+begin_src ocaml
+type int_pair = (int * int) [@@deriving sexp_of]
+type int_pair = (int * int) [@@deriving of_sexp]
+#+end_src
+
+These sexp-converters depend on having a set of converters for basic
+values (/e.g./, =int_of_sexp=) already in scope.  This can be done by
+writing:
+
+#+begin_src ocaml
+open Sexplib.Std
+#+end_src
+
+If you're using [[https://github.com/janestreet/core][=Core=]], you can get the same effect with =open Core=.
+
+It's also possible to construct converters based on type expressions,
+/i.e./:
+
+#+begin_src ocaml
+  [%sexp_of: (int * string) list] [1,"one"; 2,"two"]
+  |> Sexp.to_string;;
+  => "((1 one) (2 two))"
+
+  [%sexp_of: (int * string) list] [1,"one"; 2,"two"]
+  |> [%of_sexp: (int * string) list];;
+  => [1,"one"; 2,"two"]
+#+end_src
+
+For =%sexp_of=, we can also omit the conversion of some types by
+putting underscores for that type name.
+
+#+begin_src ocaml
+  [%sexp_of: (int * _) list] [1,"one"; 2,"two"]
+  |> Sexp.to_string;;
+  => "((1 _)(2 _))"
+#+end_src
+
+* [@@deriving sexp_grammar]
+
+If =ppx_sexp_conv= can derive =of_sexp=, it can also generate a description of
+the sexps that the resulting =t_of_sexp= would accept.  This is the sexp grammar.
+See =Sexplib0.Sexp_grammar= for details. Use =[@@deriving sexp_grammar]= to derive
+the grammar for a type.
+
+It is possible to construct sexp grammars directly from type expressions, e.g.,
+
+#+BEGIN_SRC ocaml
+[%sexp_grammar: (int, bool array) Either.t Base.Map.M(String).t]
+#+END_SRC
+
+** Tagging grammars
+
+Use =[@sexp_grammar.tag key = value]=, where =(key : string)= and =(value :
+Sexp.t)=, to annotate a grammar with a tag that can be inspected at runtime.
+
+** Custom grammars
+
+Use =[@sexp_grammar.custom grammar]= to override a type's sexp grammar with
+=grammar=.
+
+** Stub grammars
+
+Annotate a type with =[@sexp_grammar.any]= to use a stub grammar that accepts
+any sexp. Alternately, write =[@sexp_grammar.any desc]= where =(desc : string)=
+to use =desc= as a human-readable description for the stub grammar.
+
+* Conversion rules
+
+In the following, we'll review the serialization rules for different
+OCaml types.
+
+** Basic types
+
+Basic types are represented as atoms.  For numbers like =int=,
+=int32=, =int64=, =float=, the string in the atom is what is accepted
+the standard ocaml functions =int_of_string=, =Int32.of_string=, etc.
+For the types =char= or =string=, the string in the atom is
+respectively a one character string or the string itself.
+
+** Lists and arrays
+
+OCaml-lists and arrays are represented as s-expression lists.
+
+** Tuples and unit
+
+OCaml tuples are treated as lists of values in the same order as in
+the tuple.  The type =unit= is treated like a 0-tuple.  /e.g./:
+
+#+begin_src ocaml
+  (3.14, "foo", "bar bla", 27)  =>  (3.14 foo "bar bla" 27)
+#+end_src
+
+** Options
+
+With options, =None= is treated as a zero-element list, and =Some= is
+treated as a singleton list, as shown below.
+
+#+begin_src ocaml
+None        =>  ()
+Some value  =>  (value)
+#+end_src
+
+We also support reading options following the ordinary rules for
+variants /i.e./:
+
+#+begin_src ocaml
+None        =>  None
+Some value  =>  (Some value)
+#+end_src
+
+The rules for variants are described below.
+
+** Records
+
+Records are represented as lists of lists, where each inner list is a
+key-value pair. Each pair consists of the name of the record field
+(first element), and its value (second element).  /e.g./:
+
+#+begin_src ocaml
+  { foo = (3,4);
+    bar = "some string"; }
+  => ((foo (3 4)) (bar "some string"))
+#+end_src
+
+Type specifications of records allow the use of several attributes. The
+attribute =sexp.option= indicates that a record field should be optional.
+/e.g./:
+
+#+begin_src ocaml
+  type t =
+    { x : int option;
+      y : int option [@sexp.option];
+    } [@@deriving sexp]
+#+end_src
+
+The following examples show how this works.
+
+#+begin_src ocaml
+  { x = Some 1; y = Some 2; } => ((x (1)) (y 2))
+  { x = None  ; y = None;   } => ((x ()))
+#+end_src
+
+Note that, when present, an optional value is represented as the bare
+value, rather than explicitly as an option.
+
+The attribute =sexp.bool= indicates that a boolean record field is shown
+as either present or absent, but not as containing a value.
+
+#+begin_src ocaml
+  type t = { enabled : bool [@sexp.bool] } [@@deriving sexp]
+
+  { enabled = true } => ((enabled))
+  { enabled = false } => ()
+#+end_src
+
+The attributes =sexp.list= and =sexp.array= indicate that a list or array record
+field, respectively, can be omitted when it is empty.
+
+#+begin_src ocaml
+  type t =
+    { arr : int array [@sexp.array]
+    ; lst : int list [@sexp.list]
+    }
+  [@@deriving sexp]
+
+  { arr = [||]; lst = [] } => ()
+  { arr = [|1;2|]; lst = [3;4] } => ((arr (1 2)) (lst (3 4)))
+#+end_src
+
+*** Defaults
+
+More complex default values can be specified explicitly using several
+constructs, /e.g./:
+
+#+begin_src ocaml
+  type t =
+    { a : int [@default 42];
+      b : int [@default 3] [@sexp_drop_default (=)];
+      c : int [@default 3] [@sexp_drop_if fun x -> x = 3];
+      d : int Queue.t [@sexp.omit_nil]
+    } [@@deriving sexp]
+#+end_src
+
+The =@default= annotation lets one specify a default value to be
+selected if the field is not specified, when converting from an
+s-expression.  The =@sexp_drop_default= annotation implies that the
+field will be dropped when generating the s-expression if the value
+being serialized is equal to the default according to the specified equality
+function. =@sexp_drop_if= is like =@sexp_drop_default=, except that
+it lets you specify the condition under which the field is dropped.
+Finally, =@sexp.omit_nil= means to treat a missing field as if it
+has value =List []= when reading, and drop the field if it has value
+=List []= when writing.
+
+**** Specifying equality for [@sexp_drop_default]
+
+The equality used by [@sexp_drop_default] is customizable. There
+are several ways to specify the equality function:
+
+#+begin_src ocaml
+  type t =
+    { a : u [@default u0] [@sexp_drop_default (=)]; (* explicit user-provided function *)
+      b : u [@default u0] [@sexp_drop_default.compare]; (* uses [%compare.equal: u] *)
+      c : u [@default u0] [@sexp_drop_default.equal]; (* uses [%equal: u] *)
+      d : u [@default u0] [@sexp_drop_default.sexp]; (* compares sexp representations *)
+      e : u [@default u0] [@sexp_drop_default]; (* deprecated. uses polymorphic equality. *)
+    } [@@deriving sexp]
+#+end_src
+
+*** Allowing extra fields
+
+The =@sexp.allow_extra_fields= annotation lets one specify that the
+sexp-converters should silently ignore extra fields, instead of
+raising.  This applies only to the record to which the annotation is
+attached, and not to deeper sexp converters that may be called during
+conversion of a sexp to the record.
+
+#+begin_src ocaml
+  type t = { a: int } [@@deriving sexp]
+  ((a 0)(b b)) => exception
+
+  type t = { a: int } [@@deriving sexp] [@@sexp.allow_extra_fields]
+  ((a 0)(b b)) => {a = 0}
+
+  type t = A of { a : int } [@sexp.allow_extra_fields] [@@deriving sexp]
+  (A (a 0)(b b)) => A {a = 0}
+#+end_src
+
+** Variants
+
+Constant constructors in variants are represented as
+strings. Constructors with arguments are represented as lists, the
+first element being the constructor name, the rest being its
+arguments. Constructors may also be started in lowercase in
+S-expressions, but will always be converted to uppercase when
+converting from OCaml values.
+
+For example:
+
+#+begin_src ocaml
+  type t = A | B of int * float * t [@@deriving sexp]
+  B (42, 3.14, B (-1, 2.72, A))  =>  (B 42 3.14 (B -1 2.72 A))
+#+end_src
+
+The above example also demonstrates recursion in data structures.
+
+Variants support the attribute =sexp.list= when a clause has a single
+list as its argument.
+
+#+begin_src ocaml
+  type t =
+   | A of int list
+   | B of int list [@sexp.list]
+
+  A [1; 2; 3] => (A (1 2 3))
+  B [1; 2; 3] => (B 1 2 3)
+#+end_src
+
+*** Inline records
+
+Constructors with inline records are represented as lists, the first element
+being the constructor name, the rest being the record fields, represented the
+same way as in record types, but without being wrapped in an extra layer of
+parentheses.
+
+#+begin_src ocaml
+  type t = A of { x : int }
+
+  A { x = 8 } => (A (x 8))
+#+end_src
+
+** Polymorphic variants
+
+Polymorphic variants behave almost the same as ordinary variants.  The
+notable difference is that polymorphic variant constructors must
+always start with an either lower- or uppercase character, matching
+the way it was specified in the type definition.  This is because
+OCaml distinguishes between upper and lowercase variant
+constructors. Note that type specifications containing unions of
+variant types are also supported by the S-expression converter, for
+example as in:
+
+#+begin_src ocaml
+  type ab = [ `A | `B ] [@@deriving sexp]
+  type cd = [ `C | `D ] [@@deriving sexp]
+  type abcd = [ ab | cd ] [@@deriving sexp]
+#+end_src
+
+However, because `ppx_sexp_conv` needs to generate additional code to
+support inclusions of polymorphic variants, `ppx_sexp_conv` needs to
+know when processing a type definition whether it might be included in
+a polymorphic variant. `ppx_sexp_conv` will only generate the extra
+code automatically in the common case where the type definition is
+syntactically a polymorphic variant like in the example
+above. Otherwise, you will need to indicate it by using `[@@deriving
+sexp_poly]` (resp `of_sexp_poly`) instead of `[@@deriving sexp]` (resp
+`of_sexp`):
+
+#+begin_src ocaml
+  type ab = [ `A | `B ] [@@deriving sexp]
+  type alias_of_ab = ab [@@deriving sexp_poly]
+  type abcd = [ ab | `C | `D ] [@@deriving sexp]
+#+end_src
+
+** Polymorphic values
+
+There is nothing special about polymorphic values as long as there are
+conversion functions for the type parameters.  /e.g./:
+
+#+begin_src ocaml
+type 'a t = A | B of 'a [@@deriving sexp]
+type foo = int t [@@deriving sexp]
+#+end_src
+
+In the above case the conversion functions will behave as if =foo= had
+been defined as a monomorphic version of =t= with ='a= replaced by
+=int= on the right hand side.
+
+If a data structure is indeed polymorphic and you want to convert it,
+you will have to supply the conversion functions for the type
+parameters at runtime.  If you wanted to convert a value of type ='a
+t= as in the above example, you would have to write something like
+this:
+
+#+begin_src ocaml
+  sexp_of_t sexp_of_a v
+#+end_src
+
+where =sexp_of_a=, which may also be named differently in this
+particular case, is a function that converts values of type ='a= to an
+S-expression.  Types with more than one parameter require passing
+conversion functions for those parameters in the order of their
+appearance on the left hand side of the type definition.
+
+** Opaque values
+
+Opaque values are ones for which we do not want to perform
+conversions.  This may be, because we do not have S-expression
+converters for them, or because we do not want to apply them in a
+particular type context. /e.g./ to hide large, unimportant parts of
+configurations.  To prevent the preprocessor from generating calls to
+converters, simply apply the attribute =sexp.opaque= to the type.  If the type
+is for a record field, it will likely need parentheses to avoid applying the
+attribute to the record field itself, /e.g./:
+
+#+begin_src ocaml
+  type foo = int * (stuff [@sexp.opaque]) [@@deriving sexp]
+
+  type bar =
+    { a : int
+    ; b : (stuff [@sexp.opaque])
+    }
+  [@@deriving sexp]
+#+end_src
+
+Thus, there is no need to specify converters for type =stuff=, and if
+there are any, they will not be used in this particular context.
+Needless to say, it is not possible to convert such an S-expression
+back to the original value.  Here is an example conversion:
+
+#+begin_src ocaml
+  (42, some_stuff)  =>  (42 <opaque>)
+#+end_src
+
+** Exceptions
+
+S-expression converters for exceptions can be automatically
+registered.
+
+#+begin_src ocaml
+  module M = struct
+    exception Foo of int [@@deriving sexp]
+  end
+#+end_src
+
+Such exceptions will be translated in a similar way as sum types, but
+their constructor will be prefixed with the fully qualified module
+path (here: =M.Foo=) so as to be able to discriminate between them
+without problems.
+
+The user can then easily convert an exception matching the above one
+to an S-expression using =sexp_of_exn=.  User-defined conversion
+functions can be registered, too, by calling =add_exn_converter=.
+This should make it very convenient for users to catch arbitrary
+exceptions escaping their program and pretty-printing them, including
+all arguments, as S-expressions.  The library already contains
+mappings for all known exceptions that can escape functions in the
+OCaml standard library.
+
+** Hash tables
+
+The Stdlib's Hash tables, which are abstract values in OCaml, are
+represented as association lists, /i.e./ lists of key-value pairs,
+/e.g./:
+
+#+begin_src scheme
+  ((foo 42) (bar 3))
+#+end_src
+
+Reading in the above S-expression as hash table mapping strings to
+integers (=(string, int) Hashtbl.t=) will map =foo= to =42= and =bar=
+to =3=.
+
+Note that the order of elements in the list may matter, because the
+OCaml-implementation of hash tables keeps duplicates.  Bindings will
+be inserted into the hash table in the order of appearance. Therefore,
+the last binding of a key will be the "visible" one, the others are
+"hidden".  See the OCaml documentation on hash tables for details.
+
+* A note about signatures
+
+In signatures, =ppx_sexp_conv= tries to generate an include of a named
+interface, instead of a list of value bindings.
+That is:
+
+#+begin_src ocaml
+type 'a t [@@deriving sexp]
+#+end_src
+
+will generate:
+
+#+begin_src ocaml
+include Sexpable.S1 with type 'a t := 'a t
+#+end_src
+
+instead of:
+
+#+begin_src ocaml
+val t_of_sexp : (Sexp.t -> 'a) -> Sexp.t -> 'a t
+val sexp_of_t : ('a -> Sexp.t) -> 'a t -> Sexp.t
+#+end_src
+
+There are however a number of limitations:
+- the type has to be named t
+- the type can only have up to 3 parameters
+- there shouldn't be any constraint on the type parameters
+
+If these aren't met, then =ppx_sexp_conv= will simply generate a list of value
+bindings.
+
+** Weird looking type errors
+
+In some cases, a type can meet all the conditions listed above, in which case the
+rewriting will apply, but lead to a type error. This happens when the type [t]
+is an alias to a type which does have constraints on the parameters, for
+instance:
+
+#+begin_src ocaml
+type 'a s constraint 'a = [> `read ]
+val sexp_of_s : ...
+val s_of_sexp : ...
+type 'a t = 'a s [@@deriving_inline sexp]
+include Sexpable.S1 with type 'a t := 'a t
+[@@@end]
+#+end_src
+
+will give an error looking like:
+
+#+begin_src
+Error: In this `with' constraint, the new definition of t
+       does not match its original definition in the constrained signature:
+       Type declarations do not match:
+         type 'a t = 'a t constraint 'a = [> `read ]
+       is not included in
+         type 'a t
+       File "sexpable.mli", line 8, characters 21-58: Expected declaration
+       Their constraints differ.
+#+end_src
+
+To workaround that error, simply copy the constraint on the type which has the
+=[@@deriving]= annotation. This will force generating a list of value bindings.
+
+* Deprecated syntax
+
+Originally, ~ppx_sexp_conv~ used special types instead of attributes. Those
+types have been replaced with attributes. Here are the appropriate conversions
+to update from code using the old types to the new attributes.
+
+
+** Opaque types
+
+Convert uses of ~sexp_opaque~ to uses of ~[@sexp.opaque]~. The ~[@sexp.opaque]~
+attribute usually needs explicit parentheses to clarify what type it annotate.
+
+Before:
+
+#+begin_src ocaml
+type t = int sexp_opaque list
+[@@deriving sexp]
+#+end_src
+
+After:
+
+#+begin_src ocaml
+type t = (int [@sexp.opaque]) list
+[@@deriving sexp]
+#+end_src
+
+** Record fields
+
+Convert uses of ~sexp_option~, ~sexp_list~, ~sexp_array~, and ~sexp_bool~ to
+uses of ~[@sexp.option]~, ~[@sexp.list]~, ~[@sexp.array]~, and ~[@sexp.bool]~ as
+appropriate. The attribute only specifies the modification, not the type, so you
+will need to use the regular types ~option~, ~list~, ~array~, and/or ~bool~ as
+well. Unlike ~[@sexp.opaque]~, these attributes do not need extra parentheses.
+
+Before:
+
+#+begin_src ocaml
+type t =
+  { a : int sexp_option
+  ; b : int sexp_list
+  ; c : int sexp_array
+  ; d : sexp_bool
+  }
+[@@deriving sexp]
+#+end_src
+
+After:
+
+#+begin_src ocaml
+type t =
+  { a : int option [@sexp.option]
+  ; b : int list [@sexp.list]
+  ; c : int array [@sexp.array]
+  ; d : bool [@sexp.bool]
+  }
+[@@deriving sexp]
+#+end_src
+
+** Variant constructors
+
+Convert uses of ~sexp_list~ in variants and polymorphic variants to uses of
+~[@sexp.list]~. You need to add the regular type ~list~ as well. Unlike
+~[@sexp.opaque]~, this attribute does not need extra parentheses.
+
+Before:
+
+#+begin_src ocaml
+type t = A of int sexp_list
+[@@deriving sexp]
+
+type u = [`B of int sexp_list]
+[@@deriving sexp]
+#+end_src
+
+After:
+
+#+begin_src ocaml
+type t = A of int list [@sexp.list]
+[@@deriving sexp]
+
+type u = [`B of int list [@sexp.list]]
+[@@deriving sexp]
+#+end_src

unikernel/duniverse/ppx_sexp_conv/bench/dune

@@ -0,0 +1,5 @@
+(library
+ (name ppx_sexp_conv_bench)
+ (libraries base parsexp)
+ (preprocess
+  (pps ppx_bench ppx_compare ppx_sexp_conv)))

unikernel/duniverse/ppx_sexp_conv/bench/ppx_sexp_conv_bench.ml

@@ -0,0 +1,209 @@
+open! Base
+
+let bench_sexp_of_t ~sexp_of_t t =
+  let t = Sys.opaque_identity t in
+  fun () -> sexp_of_t t
+;;
+
+let bench_t_of_sexp ~t_of_sexp string =
+  let sexp = Sys.opaque_identity (Parsexp.Single.parse_string_exn string) in
+  fun () -> t_of_sexp sexp
+;;
+
+let%bench_module "Record" =
+  (module struct
+    type t =
+      { a : int
+      ; b : int option [@omit_nil]
+      ; c : bool [@sexp.bool]
+      ; d : int array [@sexp.array]
+      ; e : int list [@sexp.list]
+      ; f : int option [@sexp.option]
+      ; g : int [@default 0] [@sexp_drop_default ( = )]
+      ; h : int [@default 0] [@sexp_drop_default.compare]
+      ; i : int [@default 0] [@sexp_drop_default.equal]
+      ; j : int [@default 0] [@sexp_drop_default.sexp]
+      ; k : 'a. 'a list
+      }
+    [@@deriving sexp]
+
+    let%bench_fun "sexp_of_t, full" =
+      bench_sexp_of_t
+        ~sexp_of_t
+        { a = 1
+        ; b = Some 2
+        ; c = true
+        ; d = [| 3; 4 |]
+        ; e = [ 5; 6 ]
+        ; f = Some 7
+        ; g = 8
+        ; h = 9
+        ; i = 10
+        ; j = 11
+        ; k = []
+        }
+    ;;
+
+    let%bench_fun "sexp_of_t, empty" =
+      bench_sexp_of_t
+        ~sexp_of_t
+        { a = 0
+        ; b = None
+        ; c = false
+        ; d = [||]
+        ; e = []
+        ; f = None
+        ; g = 0
+        ; h = 0
+        ; i = 0
+        ; j = 0
+        ; k = []
+        }
+    ;;
+
+    let%bench_fun "t_of_sexp, full, in order" =
+      bench_t_of_sexp
+        ~t_of_sexp
+        "((a 1) (b (2)) (c) (d (3 4)) (e (5 6)) (f 7) (g 8) (h 9) (i 10) (j 11) (k ()))"
+    ;;
+
+    let%bench_fun "t_of_sexp, full, reverse order" =
+      bench_t_of_sexp
+        ~t_of_sexp
+        "((k ()) (j 11) (i 10) (h 9) (g 8) (f 7) (e (5 6)) (d (3 4)) (c) (b (2)) (a 1))"
+    ;;
+
+    let%bench_fun "t_of_sexp, empty" = bench_t_of_sexp ~t_of_sexp "((a 0) (k ()))"
+  end)
+;;
+
+let%bench_module "Variant" =
+  (module struct
+    type t =
+      | Atomic
+      | Tuple of int * string
+      | List of int list [@sexp.list]
+      | Record of
+          { a : int
+          ; b : int option [@omit_nil]
+          ; c : bool [@sexp.bool]
+          ; d : int array [@sexp.array]
+          ; e : int list [@sexp.list]
+          ; f : int option [@sexp.option]
+          ; g : int [@default 0] [@sexp_drop_default ( = )]
+          ; h : int [@default 0] [@sexp_drop_default.compare]
+          ; i : int [@default 0] [@sexp_drop_default.equal]
+          ; j : int [@default 0] [@sexp_drop_default.sexp]
+          ; k : 'a. 'a list
+          }
+    [@@deriving sexp]
+
+    let%bench_fun "sexp_of_t, atomic" = bench_sexp_of_t ~sexp_of_t Atomic
+    let%bench_fun "sexp_of_t, tuple" = bench_sexp_of_t ~sexp_of_t (Tuple (1, "hello"))
+    let%bench_fun "sexp_of_t, list, full" = bench_sexp_of_t ~sexp_of_t (List [ 1; 2 ])
+    let%bench_fun "sexp_of_t, list, empty" = bench_sexp_of_t ~sexp_of_t (List [])
+
+    let%bench_fun "sexp_of_t, record, full" =
+      bench_sexp_of_t
+        ~sexp_of_t
+        (Record
+           { a = 1
+           ; b = Some 2
+           ; c = true
+           ; d = [| 3; 4 |]
+           ; e = [ 5; 6 ]
+           ; f = Some 7
+           ; g = 8
+           ; h = 9
+           ; i = 10
+           ; j = 11
+           ; k = []
+           })
+    ;;
+
+    let%bench_fun "sexp_of_t, record, empty" =
+      bench_sexp_of_t
+        ~sexp_of_t
+        (Record
+           { a = 0
+           ; b = None
+           ; c = false
+           ; d = [||]
+           ; e = []
+           ; f = None
+           ; g = 0
+           ; h = 0
+           ; i = 0
+           ; j = 0
+           ; k = []
+           })
+    ;;
+
+    let%bench_fun "t_of_sexp, atomic" = bench_t_of_sexp ~t_of_sexp "Atomic"
+    let%bench_fun "t_of_sexp, tuple" = bench_t_of_sexp ~t_of_sexp "(Tuple 1 hello)"
+    let%bench_fun "t_of_sexp, list, full" = bench_t_of_sexp ~t_of_sexp "(List 1 2)"
+    let%bench_fun "t_of_sexp, list, empty" = bench_t_of_sexp ~t_of_sexp "(List)"
+
+    let%bench_fun "t_of_sexp, record, full, in order" =
+      bench_t_of_sexp
+        ~t_of_sexp
+        "(Record (a 1) (b (2)) (c) (d (3 4)) (e (5 6)) (f 7) (g 8) (h 9) (i 10) (j 11) \
+         (k ()))"
+    ;;
+
+    let%bench_fun "t_of_sexp, record, full, reverse order" =
+      bench_t_of_sexp
+        ~t_of_sexp
+        "(Record (k ()) (j 11) (i 10) (h 9) (g 8) (f 7) (e (5 6)) (d (3 4)) (c) (b (2)) \
+         (a 1))"
+    ;;
+
+    let%bench_fun "t_of_sexp, record, empty" =
+      bench_t_of_sexp ~t_of_sexp "(Record (a 0) (k ()))"
+    ;;
+  end)
+;;
+
+let%bench_module "Tag" =
+  (module struct
+    type t =
+      [ `Atomic
+      | `Tuple of int * string
+      | `List of int list [@sexp.list]
+      ]
+    [@@deriving sexp]
+
+    let%bench_fun "sexp_of_t, atomic" = bench_sexp_of_t ~sexp_of_t `Atomic
+    let%bench_fun "sexp_of_t, tuple" = bench_sexp_of_t ~sexp_of_t (`Tuple (1, "hello"))
+    let%bench_fun "sexp_of_t, list, full" = bench_sexp_of_t ~sexp_of_t (`List [ 1; 2 ])
+    let%bench_fun "sexp_of_t, list, empty" = bench_sexp_of_t ~sexp_of_t (`List [])
+    let%bench_fun "t_of_sexp, atomic" = bench_t_of_sexp ~t_of_sexp "Atomic"
+    let%bench_fun "t_of_sexp, tuple" = bench_t_of_sexp ~t_of_sexp "(Tuple (1 hello))"
+    let%bench_fun "t_of_sexp, list, full" = bench_t_of_sexp ~t_of_sexp "(List 1 2)"
+    let%bench_fun "t_of_sexp, list, empty" = bench_t_of_sexp ~t_of_sexp "(List)"
+  end)
+;;
+
+let%bench_module "Inherit" =
+  (module struct
+    type atomic = [ `Atomic ] [@@deriving sexp]
+    type tuple = [ `Tuple of int * string ] [@@deriving sexp]
+    type listed = [ `List of int list [@sexp.list] ] [@@deriving sexp]
+
+    type t =
+      [ atomic
+      | tuple
+      | listed
+      ]
+    [@@deriving sexp]
+
+    let%bench_fun "sexp_of_t, atomic" = bench_sexp_of_t ~sexp_of_t `Atomic
+    let%bench_fun "sexp_of_t, tuple" = bench_sexp_of_t ~sexp_of_t (`Tuple (1, "hello"))
+    let%bench_fun "sexp_of_t, list, full" = bench_sexp_of_t ~sexp_of_t (`List [ 1; 2 ])
+    let%bench_fun "sexp_of_t, list, empty" = bench_sexp_of_t ~sexp_of_t (`List [])
+    let%bench_fun "t_of_sexp, atomic" = bench_t_of_sexp ~t_of_sexp "Atomic"
+    let%bench_fun "t_of_sexp, tuple" = bench_t_of_sexp ~t_of_sexp "(Tuple (1 hello))"
+    let%bench_fun "t_of_sexp, list, full" = bench_t_of_sexp ~t_of_sexp "(List 1 2)"
+    let%bench_fun "t_of_sexp, list, empty" = bench_t_of_sexp ~t_of_sexp "(List)"
+  end)
+;;

unikernel/duniverse/ppx_sexp_conv/bench/ppx_sexp_conv_bench.mli

@@ -0,0 +1 @@
+(*_ This module deliberately exports nothing. *)

unikernel/duniverse/ppx_sexp_conv/dune-project

@@ -0,0 +1 @@
+(lang dune 3.11)

unikernel/duniverse/ppx_sexp_conv/expander/attrs.ml

@@ -0,0 +1,232 @@
+open! Base
+open! Ppxlib
+
+module To_lift = struct
+  type 'a t = { to_lift : 'a } [@@unboxed]
+end
+
+open To_lift
+
+let default =
+  Attribute.declare
+    "sexp.default"
+    Attribute.Context.label_declaration
+    Ast_pattern.(pstr (pstr_eval __ nil ^:: nil))
+    (fun x -> { to_lift = x })
+;;
+
+let drop_default =
+  Attribute.declare
+    "sexp.sexp_drop_default"
+    Attribute.Context.label_declaration
+    Ast_pattern.(pstr (alt_option (pstr_eval __ nil ^:: nil) nil))
+    (function
+     | None -> None
+     | Some x -> Some { to_lift = x })
+;;
+
+let drop_default_equal =
+  Attribute.declare
+    "sexp.@sexp_drop_default.equal"
+    Attribute.Context.label_declaration
+    Ast_pattern.(pstr nil)
+    ()
+;;
+
+let drop_default_compare =
+  Attribute.declare
+    "sexp.@sexp_drop_default.compare"
+    Attribute.Context.label_declaration
+    Ast_pattern.(pstr nil)
+    ()
+;;
+
+let drop_default_sexp =
+  Attribute.declare
+    "sexp.@sexp_drop_default.sexp"
+    Attribute.Context.label_declaration
+    Ast_pattern.(pstr nil)
+    ()
+;;
+
+let drop_if =
+  Attribute.declare
+    "sexp.sexp_drop_if"
+    Attribute.Context.label_declaration
+    Ast_pattern.(pstr (pstr_eval __ nil ^:: nil))
+    (fun x -> { to_lift = x })
+;;
+
+let opaque =
+  Attribute.declare "sexp.opaque" Attribute.Context.core_type Ast_pattern.(pstr nil) ()
+;;
+
+let omit_nil =
+  Attribute.declare
+    "sexp.omit_nil"
+    Attribute.Context.label_declaration
+    Ast_pattern.(pstr nil)
+    ()
+;;
+
+let option =
+  Attribute.declare
+    "sexp.option"
+    Attribute.Context.label_declaration
+    Ast_pattern.(pstr nil)
+    ()
+;;
+
+let list =
+  Attribute.declare
+    "sexp.list"
+    Attribute.Context.label_declaration
+    Ast_pattern.(pstr nil)
+    ()
+;;
+
+let array =
+  Attribute.declare
+    "sexp.array"
+    Attribute.Context.label_declaration
+    Ast_pattern.(pstr nil)
+    ()
+;;
+
+let bool =
+  Attribute.declare
+    "sexp.bool"
+    Attribute.Context.label_declaration
+    Ast_pattern.(pstr nil)
+    ()
+;;
+
+let list_variant =
+  Attribute.declare
+    "sexp.list"
+    Attribute.Context.constructor_declaration
+    Ast_pattern.(pstr nil)
+    ()
+;;
+
+let list_exception =
+  Attribute.declare "sexp.list" Attribute.Context.type_exception Ast_pattern.(pstr nil) ()
+;;
+
+let list_poly =
+  Attribute.declare "sexp.list" Attribute.Context.rtag Ast_pattern.(pstr nil) ()
+;;
+
+let allow_extra_fields_td =
+  Attribute.declare
+    "sexp.allow_extra_fields"
+    Attribute.Context.type_declaration
+    Ast_pattern.(pstr nil)
+    ()
+;;
+
+let allow_extra_fields_cd =
+  Attribute.declare
+    "sexp.allow_extra_fields"
+    Attribute.Context.constructor_declaration
+    Ast_pattern.(pstr nil)
+    ()
+;;
+
+let grammar_custom =
+  Attribute.declare
+    "sexp_grammar.custom"
+    Attribute.Context.core_type
+    Ast_pattern.(single_expr_payload __)
+    (fun x -> x)
+;;
+
+let grammar_any =
+  Attribute.declare
+    "sexp_grammar.any"
+    Attribute.Context.core_type
+    Ast_pattern.(alt_option (single_expr_payload (estring __)) (pstr nil))
+    (fun x -> x)
+;;
+
+let tag_attribute_for_context context =
+  let open Ast_pattern in
+  let key_equals_value =
+    Ast_pattern.(
+      pexp_apply (pexp_ident (lident (string "="))) (no_label __ ^:: no_label __ ^:: nil)
+      |> pack2)
+  in
+  let get_captured_values ast_pattern context expression =
+    Ast_pattern.to_func ast_pattern context expression.pexp_loc expression (fun x -> x)
+  in
+  let rec collect_sequence expression =
+    match expression.pexp_desc with
+    | Pexp_sequence (l, r) -> l :: collect_sequence r
+    | _ -> [ expression ]
+  in
+  let esequence ast_pattern =
+    Ast_pattern.of_func (fun context _loc expression k ->
+      collect_sequence expression
+      |> List.map ~f:(get_captured_values ast_pattern context)
+      |> k)
+  in
+  Attribute.declare
+    "sexp_grammar.tag"
+    context
+    (pstr (pstr_eval (esequence key_equals_value) nil ^:: nil))
+    (fun x -> x)
+;;
+
+let tag_type = tag_attribute_for_context Core_type
+let tag_ld = tag_attribute_for_context Label_declaration
+let tag_cd = tag_attribute_for_context Constructor_declaration
+let tag_poly = tag_attribute_for_context Rtag
+
+let tags_attribute_for_context context =
+  Attribute.declare
+    "sexp_grammar.tags"
+    context
+    Ast_pattern.(single_expr_payload __)
+    (fun x -> x)
+;;
+
+let tags_type = tags_attribute_for_context Core_type
+let tags_ld = tags_attribute_for_context Label_declaration
+let tags_cd = tags_attribute_for_context Constructor_declaration
+let tags_poly = tags_attribute_for_context Rtag
+
+let invalid_attribute ~loc attr description =
+  Location.raise_errorf
+    ~loc
+    "ppx_sexp_conv: [@%s] is only allowed on type [%s]."
+    (Attribute.name attr)
+    description
+;;
+
+let fail_if_allow_extra_field_cd ~loc x =
+  if Option.is_some (Attribute.get allow_extra_fields_cd x)
+  then
+    Location.raise_errorf
+      ~loc
+      "ppx_sexp_conv: [@@allow_extra_fields] is only allowed on inline records."
+;;
+
+let fail_if_allow_extra_field_td ~loc x =
+  if Option.is_some (Attribute.get allow_extra_fields_td x)
+  then (
+    match x.ptype_kind with
+    | Ptype_variant cds
+      when List.exists cds ~f:(fun cd ->
+             match cd.pcd_args with
+             | Pcstr_record _ -> true
+             | _ -> false) ->
+      Location.raise_errorf
+        ~loc
+        "ppx_sexp_conv: [@@@@allow_extra_fields] only works on records. For inline \
+         records, do: type t = A of { a : int } [@@allow_extra_fields] | B [@@@@deriving \
+         sexp]"
+    | _ ->
+      Location.raise_errorf
+        ~loc
+        "ppx_sexp_conv: [@@@@allow_extra_fields] is only allowed on records.")
+;;

unikernel/duniverse/ppx_sexp_conv/expander/attrs.mli

@@ -0,0 +1,40 @@
+open! Base
+open! Ppxlib
+
+(** [default], [drop_default], and [drop_if] attributes are annotated with expressions
+    that should be lifted out of the scope of ppx-generated temporary variables. See the
+    [Lifted] module. *)
+module To_lift : sig
+  type 'a t = { to_lift : 'a } [@@unboxed]
+end
+
+val default : (label_declaration, expression To_lift.t) Attribute.t
+val drop_default : (label_declaration, expression To_lift.t option) Attribute.t
+val drop_if : (label_declaration, expression To_lift.t) Attribute.t
+val drop_default_equal : (label_declaration, unit) Attribute.t
+val drop_default_compare : (label_declaration, unit) Attribute.t
+val drop_default_sexp : (label_declaration, unit) Attribute.t
+val omit_nil : (label_declaration, unit) Attribute.t
+val option : (label_declaration, unit) Attribute.t
+val list : (label_declaration, unit) Attribute.t
+val array : (label_declaration, unit) Attribute.t
+val bool : (label_declaration, unit) Attribute.t
+val opaque : (core_type, unit) Attribute.t
+val list_variant : (constructor_declaration, unit) Attribute.t
+val list_exception : (type_exception, unit) Attribute.t
+val list_poly : (row_field, unit) Attribute.t
+val allow_extra_fields_td : (type_declaration, unit) Attribute.t
+val allow_extra_fields_cd : (constructor_declaration, unit) Attribute.t
+val invalid_attribute : loc:Location.t -> (_, _) Attribute.t -> string -> 'a
+val fail_if_allow_extra_field_cd : loc:Location.t -> constructor_declaration -> unit
+val fail_if_allow_extra_field_td : loc:Location.t -> type_declaration -> unit
+val grammar_any : (core_type, string option) Attribute.t
+val grammar_custom : (core_type, expression) Attribute.t
+val tag_type : (core_type, (expression * expression) list) Attribute.t
+val tag_ld : (label_declaration, (expression * expression) list) Attribute.t
+val tag_cd : (constructor_declaration, (expression * expression) list) Attribute.t
+val tag_poly : (row_field, (expression * expression) list) Attribute.t
+val tags_type : (core_type, expression) Attribute.t
+val tags_ld : (label_declaration, expression) Attribute.t
+val tags_cd : (constructor_declaration, expression) Attribute.t
+val tags_poly : (row_field, expression) Attribute.t

unikernel/duniverse/ppx_sexp_conv/expander/conversion.ml

@@ -0,0 +1,184 @@
+open! Base
+open! Ppxlib
+open Ast_builder.Default
+open Helpers
+
+module Reference = struct
+  type t =
+    { types : type_declaration list
+    ; binds : value_binding list list
+    ; ident : longident_loc
+    ; args : (arg_label * expression) list
+    }
+
+  let bind t binds = { t with binds = binds :: t.binds }
+  let bind_types t types = { t with types = types @ t.types }
+
+  let maybe_apply { types; binds; ident; args } ~loc maybe_arg =
+    let ident = pexp_ident ~loc ident in
+    let args =
+      match maybe_arg with
+      | None -> args
+      | Some arg -> args @ [ Nolabel, arg ]
+    in
+    let expr =
+      match args with
+      | [] -> ident
+      | _ -> pexp_apply ~loc ident args
+    in
+    with_types ~loc ~types (with_let ~loc ~binds expr)
+  ;;
+
+  let apply t ~loc arg = maybe_apply t ~loc (Some arg)
+  let to_expression t ~loc = maybe_apply t ~loc None
+
+  let to_value_expression t ~loc ~rec_flag ~values_being_defined =
+    let may_refer_directly_to ident =
+      match rec_flag with
+      | Nonrecursive -> true
+      | Recursive -> not (Set.mem values_being_defined (Longident.name ident.txt))
+    in
+    match t with
+    | { types = []; binds = []; ident; args = [] } when may_refer_directly_to ident ->
+      pexp_ident ~loc ident
+    | _ -> fresh_lambda ~loc (fun ~arg -> apply t ~loc arg)
+  ;;
+end
+
+module Lambda = struct
+  type t =
+    { types : type_declaration list
+    ; binds : value_binding list list
+    ; cases : cases
+    }
+
+  let bind t binds = { t with binds = binds :: t.binds }
+  let bind_types t types = { t with types = types @ t.types }
+
+  (* generic case: use [function] or [match] *)
+  let maybe_apply_generic ~loc ~types ~binds maybe_arg cases =
+    let expr =
+      match maybe_arg with
+      | None -> pexp_function_cases ~loc cases
+      | Some arg -> pexp_match ~loc arg cases
+    in
+    with_types ~loc ~types (with_let ~loc ~binds expr)
+  ;;
+
+  (* zero cases: synthesize an "impossible" case, i.e. [| _ -> .] *)
+  let maybe_apply_impossible ~loc ~types ~binds maybe_arg =
+    [ case ~lhs:(ppat_any ~loc) ~guard:None ~rhs:(pexp_unreachable ~loc) ]
+    |> maybe_apply_generic ~loc ~binds ~types maybe_arg
+  ;;
+
+  (* one case without guard: use [fun] or [let] *)
+  let maybe_apply_simple ~loc ~types ~binds maybe_arg pat body =
+    let expr =
+      match maybe_arg with
+      | None -> pexp_fun ~loc Nolabel None pat body
+      | Some arg -> pexp_let ~loc Nonrecursive [ value_binding ~loc ~pat ~expr:arg ] body
+    in
+    with_types ~loc ~types (with_let ~loc ~binds expr)
+  ;;
+
+  (* shared special-casing logic for [apply] and [to_expression] *)
+  let maybe_apply t ~loc maybe_arg =
+    match t with
+    | { types; binds; cases = [] } -> maybe_apply_impossible ~loc ~types ~binds maybe_arg
+    | { types; binds; cases = [ { pc_lhs; pc_guard = None; pc_rhs } ] } ->
+      maybe_apply_simple ~loc ~types ~binds maybe_arg pc_lhs pc_rhs
+    | { types; binds; cases } -> maybe_apply_generic ~loc ~types ~binds maybe_arg cases
+  ;;
+
+  let apply t ~loc arg = maybe_apply t ~loc (Some arg)
+  let to_expression t ~loc = maybe_apply t ~loc None
+
+  let to_value_expression t ~loc =
+    match t with
+    | { types = []; binds = []; cases = _ } ->
+      (* lambdas without [let] are already values *)
+      let expr = to_expression t ~loc in
+      assert (is_value_expression expr);
+      expr
+    | _ -> fresh_lambda ~loc (fun ~arg -> apply t ~loc arg)
+  ;;
+end
+
+type t =
+  | Reference of Reference.t
+  | Lambda of Lambda.t
+
+let of_lambda cases = Lambda { types = []; binds = []; cases }
+
+let of_reference_exn expr =
+  match expr.pexp_desc with
+  | Pexp_ident ident -> Reference { types = []; binds = []; ident; args = [] }
+  | Pexp_apply ({ pexp_desc = Pexp_ident ident; _ }, args) ->
+    Reference { types = []; binds = []; ident; args }
+  | _ ->
+    Location.raise_errorf
+      ~loc:expr.pexp_loc
+      "ppx_sexp_conv: internal error.\n\
+       [Conversion.of_reference_exn] expected an identifier possibly applied to arguments.\n\
+       Instead, got:\n\
+       %s"
+      (Pprintast.string_of_expression expr)
+;;
+
+let to_expression t ~loc =
+  match t with
+  | Reference reference -> Reference.to_expression ~loc reference
+  | Lambda lambda -> Lambda.to_expression ~loc lambda
+;;
+
+let to_value_expression t ~loc ~rec_flag ~values_being_defined =
+  match t with
+  | Reference reference ->
+    Reference.to_value_expression ~loc ~rec_flag ~values_being_defined reference
+  | Lambda lambda -> Lambda.to_value_expression ~loc lambda
+;;
+
+let apply t ~loc e =
+  match t with
+  | Reference reference -> Reference.apply ~loc reference e
+  | Lambda lambda -> Lambda.apply ~loc lambda e
+;;
+
+let bind t binds =
+  match t with
+  | Reference reference -> Reference (Reference.bind reference binds)
+  | Lambda lambda -> Lambda (Lambda.bind lambda binds)
+;;
+
+let bind_types t types =
+  match t with
+  | Reference reference -> Reference (Reference.bind_types reference types)
+  | Lambda lambda -> Lambda (Lambda.bind_types lambda types)
+;;
+
+module Apply_all = struct
+  type t =
+    { bindings : value_binding list
+    ; arguments : pattern list
+    ; converted : expression list
+    }
+end
+
+let gen_symbols list ~prefix =
+  List.mapi list ~f:(fun i _ -> gen_symbol ~prefix:(prefix ^ Int.to_string i) ())
+;;
+
+let apply_all ts ~loc =
+  let arguments_names = gen_symbols ts ~prefix:"arg" in
+  let converted_names = gen_symbols ts ~prefix:"res" in
+  let bindings =
+    List.map3_exn ts arguments_names converted_names ~f:(fun t arg conv ->
+      let expr = apply ~loc t (evar ~loc arg) in
+      value_binding ~loc ~pat:(pvar ~loc conv) ~expr)
+  in
+  ({ bindings
+   ; arguments = List.map arguments_names ~f:(pvar ~loc)
+   ; converted = List.map converted_names ~f:(evar ~loc)
+   }
+    : Apply_all.t)
+;;

unikernel/duniverse/ppx_sexp_conv/expander/conversion.mli

@@ -0,0 +1,53 @@
+open! Base
+open! Ppxlib
+
+(** Sexp conversion function, expressed as either a single expression or as a collection
+    of [match] cases. Expressing as cases rather than wrapping directly in [pexp_function_cases]
+    allows us to simplify some expressions built on this. *)
+type t
+
+(** Construct [t] from a list of pattern/expression cases. *)
+val of_lambda : cases -> t
+
+(** Construct [t] from an identifier, possibly applied to arguments. Raise on any other
+    form of expression. *)
+val of_reference_exn : expression -> t
+
+(** Convert [t] to an expression. *)
+val to_expression : t -> loc:location -> expression
+
+(** Convert [t] to an expression that is a syntactic value, i.e. a constant, identifier,
+    or lambda expression that does no "work", can can be preallocated, and works in the
+    context of a [let rec]. *)
+val to_value_expression
+  :  t
+  -> loc:location
+  -> rec_flag:rec_flag
+  -> values_being_defined:Set.M(String).t
+  -> expression
+
+(** Apply [t] to an argument. *)
+val apply
+  :  t
+  -> loc:location
+  -> expression (** argument [t] is applied to *)
+  -> expression
+
+(** Wrap [t] in [let]-bindings. *)
+val bind : t -> value_binding list -> t
+
+(** Wrap [t] in [let open .. in] with type declarations. *)
+val bind_types : t -> type_declaration list -> t
+
+module Apply_all : sig
+  type t =
+    { bindings : value_binding list
+    ; arguments : pattern list
+    ; converted : expression list
+    }
+end
+
+(** Applies each [t] to a fresh variable, and binds the results to fresh variables.
+    Returns the corresponding [value_binding]s, patterns for the argument variables, and
+    expressions for the result variables. *)
+val apply_all : t list -> loc:location -> Apply_all.t

unikernel/duniverse/ppx_sexp_conv/expander/dune

@@ -0,0 +1,8 @@
+(library
+ (name ppx_sexp_conv_expander)
+ (public_name ppx_sexp_conv.expander)
+ (libraries base compiler-libs.common ppxlib ppxlib_jane
+   ppxlib.metaquot_lifters)
+ (ppx_runtime_libraries ppx_sexp_conv.runtime-lib sexplib0)
+ (preprocess
+  (pps ppxlib.metaquot ppxlib.traverse)))

unikernel/duniverse/ppx_sexp_conv/expander/expand_of_sexp.mli

@@ -0,0 +1,28 @@
+open! Base
+open! Ppxlib
+
+module Sig_generate_of_sexp : sig
+  (** Given a type, produce the type of its [of_sexp] conversion. *)
+  val type_of_of_sexp : loc:location -> core_type -> core_type
+
+  (** Derive an [of_sexp] interface for a list of type declarations. *)
+  val mk_sig
+    :  poly:bool
+    -> loc:location
+    -> path:string
+    -> rec_flag * type_declaration list
+    -> signature_item list
+end
+
+module Str_generate_of_sexp : sig
+  (** Given a type, produce its [of_sexp] conversion. *)
+  val core_type_of_sexp : path:string -> core_type -> expression
+
+  (** Derive an [of_sexp] implementation for a list of type declarations. *)
+  val tds_of_sexp
+    :  loc:location
+    -> poly:bool
+    -> path:string
+    -> rec_flag * type_declaration list
+    -> structure_item list
+end

unikernel/duniverse/ppx_sexp_conv/expander/expand_sexp_of.ml

@@ -0,0 +1,822 @@
+open! Base
+open! Ppxlib
+open Ast_builder.Default
+open Helpers
+open Lifted.Monad_infix
+
+(* Generates the signature for type conversion to S-expressions *)
+module Sig_generate_sexp_of = struct
+  let type_of_sexp_of ~loc t =
+    let loc = { loc with loc_ghost = true } in
+    [%type: [%t t] -> Sexplib0.Sexp.t]
+  ;;
+
+  let mk_type td = combinator_type_of_type_declaration td ~f:type_of_sexp_of
+
+  let mk_sig ~loc:_ ~path:_ (_rf, tds) =
+    List.map tds ~f:(fun td ->
+      let loc = td.ptype_loc in
+      psig_value
+        ~loc
+        (value_description
+           ~loc
+           ~name:(Located.map (( ^ ) "sexp_of_") td.ptype_name)
+           ~type_:(mk_type td)
+           ~prim:[]))
+  ;;
+
+  let mk_sig_exn ~loc:_ ~path:_ _te = []
+end
+
+module Str_generate_sexp_of = struct
+  module Types_being_defined = struct
+    type t =
+      | Nonrec
+      | Rec of Set.M(String).t
+
+    let to_rec_flag = function
+      | Nonrec -> Nonrecursive
+      | Rec _ -> Recursive
+    ;;
+
+    let to_values_being_defined = function
+      | Nonrec -> Set.empty (module String)
+      | Rec types -> Set.map (module String) types ~f:(fun s -> "sexp_of_" ^ s)
+    ;;
+  end
+
+  let sexp_of_type_constr ~loc id args =
+    type_constr_conv ~loc id ~f:(fun s -> "sexp_of_" ^ s) args
+  ;;
+
+  (* Conversion of types *)
+  let rec sexp_of_type ~renaming typ : Conversion.t =
+    let loc = { typ.ptyp_loc with loc_ghost = true } in
+    match Ppxlib_jane.Jane_syntax.Core_type.of_ast typ with
+    | Some (Jtyp_tuple alist, (_ : attributes)) ->
+      Conversion.of_lambda [ sexp_of_labeled_tuple ~renaming ~loc alist ]
+    | Some (Jtyp_layout _, _) | None ->
+      (match typ with
+       | _ when Option.is_some (Attribute.get Attrs.opaque typ) ->
+         Conversion.of_reference_exn [%expr Sexplib0.Sexp_conv.sexp_of_opaque]
+       | [%type: _] ->
+         Conversion.of_lambda [ ppat_any ~loc --> [%expr Sexplib0.Sexp.Atom "_"] ]
+       | [%type: [%t? _] sexp_opaque] ->
+         Conversion.of_reference_exn [%expr Sexplib0.Sexp_conv.sexp_of_opaque]
+       | { ptyp_desc = Ptyp_tuple tp; _ } ->
+         Conversion.of_lambda [ sexp_of_tuple ~renaming (loc, tp) ]
+       | { ptyp_desc = Ptyp_var parm; _ } ->
+         (match Renaming.binding_kind renaming parm ~loc with
+          | Universally_bound fresh ->
+            Conversion.of_reference_exn (Fresh_name.expression fresh)
+          | Existentially_bound -> sexp_of_type ~renaming [%type: _])
+       | { ptyp_desc = Ptyp_constr (id, args); _ } ->
+         Conversion.of_reference_exn
+           (sexp_of_type_constr
+              ~loc
+              id
+              (List.map args ~f:(fun tp ->
+                 Conversion.to_expression ~loc (sexp_of_type ~renaming tp))))
+       | { ptyp_desc = Ptyp_arrow (_, _, _); _ } ->
+         Conversion.of_lambda
+           [ ppat_any ~loc
+             --> [%expr Sexplib0.Sexp_conv.sexp_of_fun Sexplib0.Sexp_conv.ignore]
+           ]
+       | { ptyp_desc = Ptyp_variant (row_fields, Closed, _); _ } ->
+         sexp_of_variant ~renaming (loc, row_fields)
+       | { ptyp_desc = Ptyp_poly (parms, poly_tp); _ } ->
+         sexp_of_poly ~renaming parms poly_tp
+       | { ptyp_desc = Ptyp_variant (_, Open, _); _ }
+       | { ptyp_desc = Ptyp_object (_, _); _ }
+       | { ptyp_desc = Ptyp_class (_, _); _ }
+       | { ptyp_desc = Ptyp_alias (_, _); _ }
+       | { ptyp_desc = Ptyp_package _; _ }
+       | { ptyp_desc = Ptyp_extension _; _ }
+       | { ptyp_desc = Ptyp_open _; _ } ->
+         Location.raise_errorf ~loc "Type unsupported for ppx [sexp_of] conversion")
+
+  (* Conversion of (unlabeled) tuples *)
+  and sexp_of_tuple ~renaming (loc, tps) =
+    let fps = List.map ~f:(fun tp -> sexp_of_type ~renaming tp) tps in
+    let ({ bindings; arguments; converted } : Conversion.Apply_all.t) =
+      Conversion.apply_all ~loc fps
+    in
+    let in_expr = [%expr Sexplib0.Sexp.List [%e elist ~loc converted]] in
+    let expr = pexp_let ~loc Nonrecursive bindings in_expr in
+    ppat_tuple ~loc arguments --> expr
+
+  (* Conversion of labeled tuples *)
+  and sexp_of_labeled_tuple ~renaming ~loc alist =
+    assert (Labeled_tuple.is_valid alist);
+    let ({ bindings; arguments; converted } : Conversion.Apply_all.t) =
+      List.map alist ~f:(fun (_, core_type) -> sexp_of_type ~renaming core_type)
+      |> Conversion.apply_all ~loc
+    in
+    let expr =
+      let sexp_exprs =
+        (* Constructor inference allows to to leave off [Sexplib0.Sexp.] here. *)
+        List.map2_exn alist converted ~f:(fun (label_option, _) expr ->
+          [%expr
+            List
+              [ Atom [%e estring ~loc (Labeled_tuple.atom_of_label label_option)]
+              ; [%e expr]
+              ]])
+      in
+      [%expr Sexplib0.Sexp.List [%e elist ~loc sexp_exprs]]
+      |> pexp_let ~loc Nonrecursive bindings
+    in
+    let pat =
+      ( List.map2_exn alist arguments ~f:(fun (label_option, _) arg -> label_option, arg)
+      , Closed )
+      |> Ppxlib_jane.Jane_syntax.Labeled_tuples.pat_of ~loc
+    in
+    pat --> expr
+
+  (* Conversion of variant types *)
+  and sexp_of_variant ~renaming ((loc, row_fields) : Location.t * row_field list)
+    : Conversion.t
+    =
+    let item row =
+      match row.prf_desc with
+      | Rtag ({ txt = cnstr; _ }, true, []) ->
+        ppat_variant ~loc cnstr None
+        --> [%expr Sexplib0.Sexp.Atom [%e estring ~loc cnstr]]
+      | Rtag ({ txt = cnstr; _ }, _, [ tp ])
+        when Option.is_some (Attribute.get Attrs.list_poly row) ->
+        (match tp with
+         | [%type: [%t? tp] list] ->
+           let cnv_expr = Conversion.to_expression ~loc (sexp_of_type ~renaming tp) in
+           let name = Fresh_name.create "l" ~loc in
+           ppat_variant ~loc cnstr (Some (Fresh_name.pattern name))
+           --> [%expr
+                 Sexplib0.Sexp.List
+                   (Sexplib0.Sexp.Atom [%e estring ~loc cnstr]
+                    :: Sexplib0.Sexp_conv.list_map
+                         [%e cnv_expr]
+                         [%e Fresh_name.expression name])]
+         | _ -> Attrs.invalid_attribute ~loc Attrs.list_poly "_ list")
+      | Rtag ({ txt = cnstr; _ }, _, [ [%type: [%t? tp] sexp_list] ]) ->
+        let cnv_expr = Conversion.to_expression ~loc (sexp_of_type ~renaming tp) in
+        let name = Fresh_name.create "l" ~loc in
+        ppat_variant ~loc cnstr (Some (Fresh_name.pattern name))
+        --> [%expr
+              Sexplib0.Sexp.List
+                (Sexplib0.Sexp.Atom [%e estring ~loc cnstr]
+                 :: Sexplib0.Sexp_conv.list_map
+                      [%e cnv_expr]
+                      [%e Fresh_name.expression name])]
+      | Rtag ({ txt = cnstr; _ }, false, [ tp ]) ->
+        let cnstr_expr = [%expr Sexplib0.Sexp.Atom [%e estring ~loc cnstr]] in
+        let fresh = Fresh_name.create "v" ~loc in
+        let cnstr_arg =
+          Conversion.apply ~loc (sexp_of_type ~renaming tp) (Fresh_name.expression fresh)
+        in
+        let expr = [%expr Sexplib0.Sexp.List [%e elist ~loc [ cnstr_expr; cnstr_arg ]]] in
+        ppat_variant ~loc cnstr (Some (Fresh_name.pattern fresh)) --> expr
+      | Rinherit { ptyp_desc = Ptyp_constr (id, []); _ } ->
+        let name = Fresh_name.create "v" ~loc in
+        ppat_alias ~loc (ppat_type ~loc id) (Fresh_name.to_string_loc name)
+        --> sexp_of_type_constr ~loc id [ Fresh_name.expression name ]
+      | Rtag (_, true, [ _ ]) | Rtag (_, _, _ :: _ :: _) ->
+        Location.raise_errorf ~loc "unsupported: polymorphic variant intersection type"
+      | Rinherit ({ ptyp_desc = Ptyp_constr (id, _ :: _); _ } as typ) ->
+        let call = Conversion.to_expression ~loc (sexp_of_type ~renaming typ) in
+        let name = Fresh_name.create "v" ~loc in
+        ppat_alias ~loc (ppat_type ~loc id) (Fresh_name.to_string_loc name)
+        --> [%expr [%e call] [%e Fresh_name.expression name]]
+      | Rinherit _ ->
+        Location.raise_errorf
+          ~loc
+          "unsupported: polymorphic variant with invalid (non-identifier) inherited type"
+      | Rtag (_, false, []) ->
+        Location.raise_errorf ~loc "unsupported: polymorphic variant empty type"
+    in
+    Conversion.of_lambda (List.map ~f:item row_fields)
+
+  (* Polymorphic record fields *)
+  and sexp_of_poly ~renaming parms tp =
+    let loc = tp.ptyp_loc in
+    let renaming =
+      List.fold_left
+        parms
+        ~init:renaming
+        ~f:(Renaming.add_universally_bound ~prefix:"_of_")
+    in
+    let bindings =
+      let mk_binding parm =
+        let name =
+          match Renaming.binding_kind renaming parm.txt ~loc:parm.loc with
+          | Universally_bound name -> name
+          | Existentially_bound -> assert false
+        in
+        value_binding
+          ~loc
+          ~pat:(Fresh_name.pattern name)
+          ~expr:[%expr Sexplib0.Sexp_conv.sexp_of_opaque]
+      in
+      List.map ~f:mk_binding parms
+    in
+    Conversion.bind (sexp_of_type ~renaming tp) bindings
+  ;;
+
+  (* Conversion of record types *)
+
+  let mk_rec_patt loc patt name fresh =
+    let p = Loc.make (Longident.Lident name) ~loc, Fresh_name.pattern fresh in
+    patt @ [ p ]
+  ;;
+
+  type is_empty_expr =
+    | Inspect_value of (location -> expression -> expression)
+    | Inspect_sexp of (cnv_expr:expression -> location -> expression -> expression)
+
+  let sexp_of_record_field ~renaming ~bnds patt expr name tp ?sexp_of is_empty_expr =
+    let loc = tp.ptyp_loc in
+    let fresh = Fresh_name.create name ~loc in
+    let patt = mk_rec_patt loc patt name fresh in
+    let cnv_expr = Conversion.to_expression ~loc (sexp_of_type ~renaming tp) in
+    let cnv_expr =
+      match sexp_of with
+      | None -> cnv_expr
+      | Some sexp_of -> [%expr [%e sexp_of] [%e cnv_expr]]
+    in
+    let bnd = Fresh_name.create "bnd" ~loc in
+    let arg = Fresh_name.create "arg" ~loc in
+    let expr =
+      [%expr
+        let [%p Fresh_name.pattern bnds] =
+          [%e
+            match is_empty_expr with
+            | Inspect_value is_empty_expr ->
+              [%expr
+                if [%e is_empty_expr loc (Fresh_name.expression fresh)]
+                then [%e Fresh_name.expression bnds]
+                else (
+                  let [%p Fresh_name.pattern arg] =
+                    [%e cnv_expr] [%e Fresh_name.expression fresh]
+                  in
+                  let [%p Fresh_name.pattern bnd] =
+                    Sexplib0.Sexp.List
+                      [ Sexplib0.Sexp.Atom [%e estring ~loc name]
+                      ; [%e Fresh_name.expression arg]
+                      ]
+                  in
+                  ([%e Fresh_name.expression bnd] :: [%e Fresh_name.expression bnds]
+                    : _ Stdlib.List.t))]
+            | Inspect_sexp is_empty_expr ->
+              [%expr
+                let [%p Fresh_name.pattern arg] =
+                  [%e cnv_expr] [%e Fresh_name.expression fresh]
+                in
+                if [%e is_empty_expr ~cnv_expr loc (Fresh_name.expression arg)]
+                then [%e Fresh_name.expression bnds]
+                else (
+                  let [%p Fresh_name.pattern bnd] =
+                    Sexplib0.Sexp.List
+                      [ Sexplib0.Sexp.Atom [%e estring ~loc name]
+                      ; [%e Fresh_name.expression arg]
+                      ]
+                  in
+                  ([%e Fresh_name.expression bnd] :: [%e Fresh_name.expression bnds]
+                    : _ Stdlib.List.t))]]
+        in
+        [%e expr]]
+    in
+    patt, expr
+  ;;
+
+  let disallow_type_variables_and_recursive_occurrences
+    ~types_being_defined
+    ~loc
+    ~attr_name
+    tp
+    =
+    let disallow_variables =
+      let iter =
+        object
+          inherit Ast_traverse.iter as super
+
+          method! core_type_desc =
+            function
+            | Ptyp_var v ->
+              Location.raise_errorf
+                ~loc
+                "[@%s] was used, but the type of the field contains a type variable: '%s.\n\
+                 Comparison is not avaiable for type variables.\n\
+                 Consider using [@sexp_drop_if _] or [@sexp_drop_default.sexp] instead."
+                attr_name
+                v
+            | t -> super#core_type_desc t
+        end
+      in
+      iter#core_type
+    in
+    let disallow_recursive_occurrences =
+      match (types_being_defined : Types_being_defined.t) with
+      | Nonrec -> fun _ -> ()
+      | Rec types_being_defined ->
+        let iter =
+          object
+            inherit Ast_traverse.iter as super
+
+            method! core_type_desc =
+              function
+              | Ptyp_constr ({ loc = _; txt = Lident s }, _) as t ->
+                if Set.mem types_being_defined s
+                then
+                  Location.raise_errorf
+                    ~loc
+                    "[@%s] was used, but the type of the field contains a type defined \
+                     in the current recursive block: %s.\n\
+                     This is not supported.\n\
+                     Consider using [@sexp_drop_if _] or [@sexp_drop_default.sexp] \
+                     instead."
+                    attr_name
+                    s;
+                super#core_type_desc t
+              | t -> super#core_type_desc t
+          end
+        in
+        iter#core_type
+    in
+    disallow_variables tp;
+    disallow_recursive_occurrences tp
+  ;;
+
+  let sexp_of_default_field
+    ~types_being_defined
+    how
+    ~renaming
+    ~bnds
+    patt
+    expr
+    name
+    tp
+    ?sexp_of
+    default
+    =
+    let is_empty =
+      let inspect_value equality_f =
+        Inspect_value (fun loc expr -> [%expr [%e equality_f loc] [%e default] [%e expr]])
+      in
+      match (how : Record_field_attrs.Sexp_of.Drop.t) with
+      | Sexp ->
+        Inspect_sexp
+          (fun ~cnv_expr loc sexp_expr ->
+            [%expr Sexplib0.Sexp_conv.( = ) ([%e cnv_expr] [%e default]) [%e sexp_expr]])
+        |> Lifted.return
+      | No_arg ->
+        inspect_value (fun loc ->
+          [%expr
+            Sexplib0.Sexp_conv.( = ) [@ocaml.ppwarning
+                                       "[@sexp_drop_default] is deprecated: please use \
+                                        one of:\n\
+                                        - [@sexp_drop_default f] and give an explicit \
+                                        equality function ([f = Poly.(=)] corresponds to \
+                                        the old behavior)\n\
+                                        - [@sexp_drop_default.compare] if the type \
+                                        supports [%compare]\n\
+                                        - [@sexp_drop_default.equal] if the type \
+                                        supports [%equal]\n\
+                                        - [@sexp_drop_default.sexp] if you want to \
+                                        compare the sexp representations\n"]])
+        |> Lifted.return
+      | Func lifted -> lifted >>| fun f -> inspect_value (fun _ -> f)
+      | Compare ->
+        inspect_value (fun loc ->
+          disallow_type_variables_and_recursive_occurrences
+            ~types_being_defined
+            ~attr_name:"sexp_drop_default.compare"
+            ~loc
+            tp;
+          [%expr [%compare.equal: [%t tp]]])
+        |> Lifted.return
+      | Equal ->
+        inspect_value (fun loc ->
+          disallow_type_variables_and_recursive_occurrences
+            ~types_being_defined
+            ~attr_name:"sexp_drop_default.equal"
+            ~loc
+            tp;
+          [%expr [%equal: [%t tp]]])
+        |> Lifted.return
+    in
+    is_empty >>| sexp_of_record_field ~renaming ~bnds patt expr name tp ?sexp_of
+  ;;
+
+  let sexp_of_label_declaration_list ~types_being_defined ~renaming loc flds ~wrap_expr =
+    let bnds = Fresh_name.create "bnds" ~loc in
+    let list_empty_expr =
+      Inspect_value
+        (fun loc lst ->
+          [%expr
+            match [%e lst] with
+            | [] -> true
+            | _ -> false])
+    in
+    let array_empty_expr =
+      Inspect_value
+        (fun loc arr ->
+          [%expr
+            match [%e arr] with
+            | [||] -> true
+            | _ -> false])
+    in
+    let coll lifted ld =
+      lifted
+      >>= fun ((patt : (Longident.t loc * pattern) list), expr) ->
+      let name = ld.pld_name.txt in
+      let loc = ld.pld_name.loc in
+      let fresh = Fresh_name.create name ~loc in
+      match Record_field_attrs.Sexp_of.create ~loc ld with
+      | Sexp_option tp ->
+        let v = Fresh_name.create "v" ~loc in
+        let bnd = Fresh_name.create "bnd" ~loc in
+        let arg = Fresh_name.create "arg" ~loc in
+        let patt = mk_rec_patt loc patt name fresh in
+        let vname = Fresh_name.expression v in
+        let cnv_expr = Conversion.apply ~loc (sexp_of_type ~renaming tp) vname in
+        let expr =
+          [%expr
+            let [%p Fresh_name.pattern bnds] =
+              match [%e Fresh_name.expression fresh] with
+              | Stdlib.Option.None -> [%e Fresh_name.expression bnds]
+              | Stdlib.Option.Some [%p Fresh_name.pattern v] ->
+                let [%p Fresh_name.pattern arg] = [%e cnv_expr] in
+                let [%p Fresh_name.pattern bnd] =
+                  Sexplib0.Sexp.List
+                    [ Sexplib0.Sexp.Atom [%e estring ~loc name]
+                    ; [%e Fresh_name.expression arg]
+                    ]
+                in
+                ([%e Fresh_name.expression bnd] :: [%e Fresh_name.expression bnds]
+                  : _ Stdlib.List.t)
+            in
+            [%e expr]]
+        in
+        Lifted.return (patt, expr)
+      | Sexp_bool ->
+        let patt = mk_rec_patt loc patt name fresh in
+        let bnd = Fresh_name.create "bnd" ~loc in
+        let expr =
+          [%expr
+            let [%p Fresh_name.pattern bnds] =
+              if [%e Fresh_name.expression fresh]
+              then (
+                let [%p Fresh_name.pattern bnd] =
+                  Sexplib0.Sexp.List [ Sexplib0.Sexp.Atom [%e estring ~loc name] ]
+                in
+                ([%e Fresh_name.expression bnd] :: [%e Fresh_name.expression bnds]
+                  : _ Stdlib.List.t))
+              else [%e Fresh_name.expression bnds]
+            in
+            [%e expr]]
+        in
+        Lifted.return (patt, expr)
+      | Sexp_list tp ->
+        sexp_of_record_field
+          ~renaming
+          ~bnds
+          patt
+          expr
+          name
+          tp
+          ~sexp_of:
+            (* deliberately using whatever [sexp_of_list] is in scope *)
+            [%expr sexp_of_list]
+          list_empty_expr
+        |> Lifted.return
+      | Sexp_array tp ->
+        sexp_of_record_field
+          ~renaming
+          ~bnds
+          patt
+          expr
+          name
+          tp
+          ~sexp_of:
+            (* deliberately using whatever [sexp_of_array] is in scope *)
+            [%expr sexp_of_array]
+          array_empty_expr
+        |> Lifted.return
+      | Specific (Drop_default how) ->
+        let tp = ld.pld_type in
+        (match Attribute.get Attrs.default ld with
+         | None -> Location.raise_errorf ~loc "no default to drop"
+         | Some { to_lift = default } ->
+           Record_field_attrs.lift_default ~loc ld default
+           >>= sexp_of_default_field
+                 ~types_being_defined
+                 how
+                 ~renaming
+                 ~bnds
+                 patt
+                 expr
+                 name
+                 tp)
+      | Specific (Drop_if test) ->
+        test
+        >>| fun test ->
+        let tp = ld.pld_type in
+        sexp_of_record_field
+          ~renaming
+          ~bnds
+          patt
+          expr
+          name
+          tp
+          (Inspect_value (fun loc expr -> [%expr [%e test] [%e expr]]))
+      | Omit_nil ->
+        let tp = ld.pld_type in
+        let patt = mk_rec_patt loc patt name fresh in
+        let vname = Fresh_name.expression fresh in
+        let arg = Fresh_name.create "arg" ~loc in
+        let cnv_expr = Conversion.apply ~loc (sexp_of_type ~renaming tp) vname in
+        let bnds_expr =
+          [%expr
+            match [%e cnv_expr] with
+            | Sexplib0.Sexp.List [] -> [%e Fresh_name.expression bnds]
+            | [%p Fresh_name.pattern arg] ->
+              (Sexplib0.Sexp.List
+                 [ Sexplib0.Sexp.Atom [%e estring ~loc name]
+                 ; [%e Fresh_name.expression arg]
+                 ]
+               :: [%e Fresh_name.expression bnds]
+                : _ Stdlib.List.t)]
+        in
+        ( patt
+        , [%expr
+            let [%p Fresh_name.pattern bnds] = [%e bnds_expr] in
+            [%e expr]] )
+        |> Lifted.return
+      | Specific Keep ->
+        let tp = ld.pld_type in
+        let patt = mk_rec_patt loc patt name fresh in
+        let vname = Fresh_name.expression fresh in
+        let arg = Fresh_name.create "arg" ~loc in
+        let cnv_expr = Conversion.apply ~loc (sexp_of_type ~renaming tp) vname in
+        let bnds_expr =
+          [%expr
+            let [%p Fresh_name.pattern arg] = [%e cnv_expr] in
+            (Sexplib0.Sexp.List
+               [ Sexplib0.Sexp.Atom [%e estring ~loc name]
+               ; [%e Fresh_name.expression arg]
+               ]
+             :: [%e Fresh_name.expression bnds]
+              : _ Stdlib.List.t)]
+        in
+        ( patt
+        , [%expr
+            let [%p Fresh_name.pattern bnds] = [%e bnds_expr] in
+            [%e expr]] )
+        |> Lifted.return
+    in
+    let init_expr = wrap_expr (Fresh_name.expression bnds) in
+    List.fold_left ~f:coll ~init:(Lifted.return ([], init_expr)) flds
+    >>| fun (patt, expr) ->
+    ( ppat_record ~loc patt Closed
+    , [%expr
+        let [%p Fresh_name.pattern bnds] = ([] : _ Stdlib.List.t) in
+        [%e expr]] )
+  ;;
+
+  (* Conversion of sum types *)
+
+  let branch_sum
+    row
+    inline_attr
+    ~types_being_defined
+    renaming
+    ~loc
+    constr_lid
+    constr_str
+    args
+    =
+    match args with
+    | Pcstr_record lds ->
+      let cnstr_expr = [%expr Sexplib0.Sexp.Atom [%e constr_str]] in
+      sexp_of_label_declaration_list
+        ~types_being_defined
+        ~renaming
+        loc
+        lds
+        ~wrap_expr:(fun expr -> [%expr Sexplib0.Sexp.List ([%e cnstr_expr] :: [%e expr])])
+      >>| fun (patt, expr) -> ppat_construct ~loc constr_lid (Some patt) --> expr
+    | Pcstr_tuple pcd_args ->
+      (match pcd_args with
+       | [] ->
+         ppat_construct ~loc constr_lid None
+         --> [%expr Sexplib0.Sexp.Atom [%e constr_str]]
+         |> Lifted.return
+       | args ->
+         (match args with
+          | [ tp ] when Option.is_some (Attribute.get inline_attr row) ->
+            (match tp with
+             | [%type: [%t? tp] list] ->
+               let cnv_expr = Conversion.to_expression ~loc (sexp_of_type ~renaming tp) in
+               let name = Fresh_name.create "l" ~loc in
+               ppat_construct ~loc constr_lid (Some (Fresh_name.pattern name))
+               --> [%expr
+                     Sexplib0.Sexp.List
+                       (Sexplib0.Sexp.Atom [%e constr_str]
+                        :: Sexplib0.Sexp_conv.list_map
+                             [%e cnv_expr]
+                             [%e Fresh_name.expression name])]
+             | _ -> Attrs.invalid_attribute ~loc inline_attr "_ list")
+          | [ [%type: [%t? tp] sexp_list] ] ->
+            let cnv_expr = Conversion.to_expression ~loc (sexp_of_type ~renaming tp) in
+            let name = Fresh_name.create "l" ~loc in
+            ppat_construct ~loc constr_lid (Some (Fresh_name.pattern name))
+            --> [%expr
+                  Sexplib0.Sexp.List
+                    (Sexplib0.Sexp.Atom [%e constr_str]
+                     :: Sexplib0.Sexp_conv.list_map
+                          [%e cnv_expr]
+                          [%e Fresh_name.expression name])]
+          | _ ->
+            let sexp_of_args = List.map ~f:(sexp_of_type ~renaming) args in
+            let cnstr_expr = [%expr Sexplib0.Sexp.Atom [%e constr_str]] in
+            let ({ bindings; arguments; converted } : Conversion.Apply_all.t) =
+              Conversion.apply_all ~loc sexp_of_args
+            in
+            let patt =
+              match arguments with
+              | [ arg ] -> arg
+              | _ -> ppat_tuple ~loc arguments
+            in
+            ppat_construct ~loc constr_lid (Some patt)
+            --> pexp_let
+                  ~loc
+                  Nonrecursive
+                  bindings
+                  [%expr Sexplib0.Sexp.List [%e elist ~loc (cnstr_expr :: converted)]])
+         |> Lifted.return)
+  ;;
+
+  let sexp_of_sum ~types_being_defined ~renaming tps cds =
+    List.map cds ~f:(fun cd ->
+      let renaming =
+        Renaming.with_constructor_declaration renaming ~type_parameters:tps cd
+      in
+      let constr_lid = Located.map lident cd.pcd_name in
+      let constr_str = estring ~loc:cd.pcd_name.loc cd.pcd_name.txt in
+      branch_sum
+        cd
+        Attrs.list_variant
+        ~types_being_defined
+        renaming
+        ~loc:cd.pcd_loc
+        constr_lid
+        constr_str
+        cd.pcd_args)
+    |> Lifted.all
+    >>| Conversion.of_lambda
+  ;;
+
+  (* Empty type *)
+  let sexp_of_nil loc = Conversion.of_lambda [ ppat_any ~loc --> [%expr assert false] ]
+
+  (* Generate code from type definitions *)
+
+  let sexp_of_td ~types_being_defined td =
+    let td = name_type_params_in_td td in
+    let tps = List.map td.ptype_params ~f:get_type_param_name in
+    let { ptype_name = { txt = type_name; loc = _ }; ptype_loc = loc; _ } = td in
+    let renaming = Renaming.of_type_declaration td ~prefix:"_of_" in
+    let body =
+      let body =
+        match td.ptype_kind with
+        | Ptype_variant cds ->
+          sexp_of_sum
+            ~renaming
+            ~types_being_defined
+            (List.map tps ~f:(fun x -> x.txt))
+            cds
+        | Ptype_record lds ->
+          sexp_of_label_declaration_list
+            ~renaming
+            loc
+            lds
+            ~types_being_defined
+            ~wrap_expr:(fun expr -> [%expr Sexplib0.Sexp.List [%e expr]])
+          >>| fun (patt, expr) -> Conversion.of_lambda [ patt --> expr ]
+        | Ptype_open ->
+          Location.raise_errorf ~loc "ppx_sexp_conv: open types not supported"
+        | Ptype_abstract ->
+          (match td.ptype_manifest with
+           | None -> sexp_of_nil loc
+           | Some ty -> sexp_of_type ~renaming ty)
+          |> Lifted.return
+      in
+      body
+      >>| fun body ->
+      let is_private_alias =
+        match td.ptype_kind, td.ptype_manifest, td.ptype_private with
+        | Ptype_abstract, Some _, Private -> true
+        | _ -> false
+      in
+      if is_private_alias
+      then (
+        (* Replace all type variable by _ to avoid generalization problems *)
+        let ty_src =
+          core_type_of_type_declaration td |> replace_variables_by_underscores
+        in
+        let manifest =
+          match td.ptype_manifest with
+          | Some manifest -> manifest
+          | None -> Location.raise_errorf ~loc "sexp_of_td/no-manifest"
+        in
+        let ty_dst = replace_variables_by_underscores manifest in
+        let v = Fresh_name.create "v" ~loc in
+        let coercion =
+          [%expr ([%e Fresh_name.expression v] : [%t ty_src] :> [%t ty_dst])]
+        in
+        [%expr fun [%p Fresh_name.pattern v] -> [%e Conversion.apply ~loc body coercion]])
+      else
+        (* Prevent violation of value restriction, problems with recursive types, and
+           top-level effects by eta-expanding function definitions *)
+        Conversion.to_value_expression
+          ~loc
+          ~rec_flag:(Types_being_defined.to_rec_flag types_being_defined)
+          ~values_being_defined:
+            (Types_being_defined.to_values_being_defined types_being_defined)
+          body
+    in
+    let typ = Sig_generate_sexp_of.mk_type td in
+    let func_name = "sexp_of_" ^ type_name in
+    let body =
+      body
+      >>| fun body ->
+      let patts =
+        List.map tps ~f:(fun id ->
+          match Renaming.binding_kind renaming id.txt ~loc:id.loc with
+          | Universally_bound name -> Fresh_name.pattern name
+          | Existentially_bound -> assert false)
+      in
+      let rec_flag = Types_being_defined.to_rec_flag types_being_defined in
+      eta_reduce_if_possible_and_nonrec ~rec_flag (eabstract ~loc patts body)
+    in
+    let body = Lifted.let_bind_user_expressions ~loc body in
+    constrained_function_binding loc td typ ~tps ~func_name body
+  ;;
+
+  let sexp_of_tds ~loc ~path:_ (rec_flag, tds) =
+    let rec_flag = really_recursive_respecting_opaque rec_flag tds in
+    let (types_being_defined : Types_being_defined.t) =
+      match rec_flag with
+      | Nonrecursive -> Nonrec
+      | Recursive ->
+        Rec (Set.of_list (module String) (List.map tds ~f:(fun td -> td.ptype_name.txt)))
+    in
+    let bindings = List.map tds ~f:(sexp_of_td ~types_being_defined) in
+    pstr_value_list ~loc rec_flag bindings
+  ;;
+
+  let sexp_of_exn ~loc:_ ~path ec =
+    let renaming = Renaming.without_type () in
+    let get_full_cnstr str = path ^ "." ^ str in
+    let loc = ec.ptyexn_loc in
+    let expr =
+      match ec.ptyexn_constructor with
+      | { pext_name = cnstr
+        ; pext_kind = Pext_decl (_, extension_constructor_kind, None)
+        ; _
+        } ->
+        let constr_lid = Located.map lident cnstr in
+        branch_sum
+          ec
+          Attrs.list_exception
+          ~types_being_defined:Nonrec
+          renaming
+          ~loc
+          constr_lid
+          (estring ~loc (get_full_cnstr cnstr.txt))
+          extension_constructor_kind
+        >>| fun converter ->
+        let assert_false = ppat_any ~loc --> [%expr assert false] in
+        [%expr
+          Sexplib0.Sexp_conv.Exn_converter.add
+            [%extension_constructor [%e pexp_construct ~loc constr_lid None]]
+            [%e
+              Conversion.to_expression
+                ~loc
+                (Conversion.of_lambda [ converter; assert_false ])]]
+      | { pext_kind = Pext_decl (_, _, Some _); _ } ->
+        Location.raise_errorf ~loc "sexp_of_exn/:"
+      | { pext_kind = Pext_rebind _; _ } ->
+        Location.raise_errorf ~loc "sexp_of_exn/rebind"
+    in
+    let expr = Lifted.let_bind_user_expressions ~loc expr in
+    [ pstr_value ~loc Nonrecursive [ value_binding ~loc ~pat:[%pat? ()] ~expr ] ]
+  ;;
+
+  let sexp_of_core_type core_type =
+    let loc = { core_type.ptyp_loc with loc_ghost = true } in
+    sexp_of_type ~renaming:(Renaming.without_type ()) core_type
+    |> Conversion.to_value_expression
+         ~loc
+         ~rec_flag:Nonrecursive
+         ~values_being_defined:(Set.empty (module String))
+    |> Merlin_helpers.hide_expression
+  ;;
+end

unikernel/duniverse/ppx_sexp_conv/expander/expand_sexp_of.mli

@@ -0,0 +1,32 @@
+open! Base
+open! Ppxlib
+
+module Sig_generate_sexp_of : sig
+  (** Given a type, produce the type of its [sexp_of] conversion. *)
+  val type_of_sexp_of : loc:location -> core_type -> core_type
+
+  (** Derive a [sexp_of] interface for a list of type declarations. *)
+  val mk_sig
+    :  loc:location
+    -> path:string
+    -> rec_flag * type_declaration list
+    -> signature_item list
+
+  (** Derive a [sexp_of] interface for an exception declaration. *)
+  val mk_sig_exn : loc:location -> path:string -> type_exception -> signature_item list
+end
+
+module Str_generate_sexp_of : sig
+  (** Given a type, produce its [sexp_of] conversion. *)
+  val sexp_of_core_type : core_type -> expression
+
+  (** Derive a [sexp_of] implementation for a list of type declarations. *)
+  val sexp_of_tds
+    :  loc:location
+    -> path:string
+    -> rec_flag * type_declaration list
+    -> structure_item list
+
+  (** Derive a [sexp_of] implementation for an exception declaration. *)
+  val sexp_of_exn : loc:location -> path:string -> type_exception -> structure_item list
+end

unikernel/duniverse/ppx_sexp_conv/expander/fresh_name.ml

@@ -0,0 +1,14 @@
+open! Base
+open Ppxlib
+open Ast_builder.Default
+
+type t =
+  { loc : location
+  ; unique_name : string
+  }
+
+let create string ~loc = { loc; unique_name = gen_symbol ~prefix:string () }
+let of_string_loc { loc; txt } = create txt ~loc
+let to_string_loc { loc; unique_name } = { loc; txt = unique_name }
+let expression { loc; unique_name } = evar unique_name ~loc
+let pattern { loc; unique_name } = pvar unique_name ~loc

unikernel/duniverse/ppx_sexp_conv/expander/fresh_name.mli

@@ -0,0 +1,21 @@
+(** Represents freshly generated names at ppx expansion time. *)
+
+open! Base
+open Ppxlib
+
+type t
+
+(** Creates a new fresh name using the given string as a prefix. *)
+val create : string -> loc:location -> t
+
+(** [of_string_loc { loc; txt }] is equivalent to [create txt ~loc] *)
+val of_string_loc : string loc -> t
+
+(** Extracts the freshly created name and its location. *)
+val to_string_loc : t -> string loc
+
+(** Constructs an expression referring to the fresh name. *)
+val expression : t -> expression
+
+(** Constructs a pattern binding the fresh name. *)
+val pattern : t -> pattern

unikernel/duniverse/ppx_sexp_conv/expander/helpers.ml

@@ -0,0 +1,253 @@
+open! Base
+open! Ppxlib
+open Ast_builder.Default
+
+let ( --> ) lhs rhs = case ~guard:None ~lhs ~rhs
+
+(* Utility functions *)
+
+let replace_variables_by_underscores =
+  let map =
+    object
+      inherit Ast_traverse.map as super
+
+      method! core_type_desc =
+        function
+        | Ptyp_var _ -> Ptyp_any
+        | t -> super#core_type_desc t
+    end
+  in
+  map#core_type
+;;
+
+let make_rigid_types tps =
+  List.fold
+    tps
+    ~init:(Map.empty (module String))
+    ~f:(fun map tp ->
+      Map.update map tp.txt ~f:(function
+        | None -> Fresh_name.of_string_loc tp
+        | Some fresh ->
+          (* Ignore duplicate names, the typechecker will raise after expansion. *)
+          fresh))
+;;
+
+let find_rigid_type ~loc ~rigid_types name =
+  match Map.find rigid_types name with
+  | Some tp -> Fresh_name.to_string_loc tp
+  | None ->
+    (* Ignore unbound type names, the typechecker will raise after expansion. *)
+    { txt = name; loc }
+;;
+
+let make_type_rigid ~rigid_types =
+  let map =
+    object
+      inherit Ast_traverse.map as super
+
+      method! core_type ty =
+        let ptyp_desc =
+          match ty.ptyp_desc with
+          | Ptyp_var s ->
+            Ptyp_constr
+              (Located.map_lident (find_rigid_type ~loc:ty.ptyp_loc ~rigid_types s), [])
+          | desc -> super#core_type_desc desc
+        in
+        { ty with ptyp_desc }
+    end
+  in
+  map#core_type
+;;
+
+(* Generates the quantified type [ ! 'a .. 'z . (make_mono_type t ('a .. 'z)) ] or
+   [type a .. z. make_mono_type t (a .. z)] when [use_rigid_variables] is true.
+   Annotation are needed for non regular recursive datatypes and gadt when the return type
+   of constructors are constrained. Unfortunately, putting rigid variables everywhere does
+   not work because of certains types with constraints. We thus only use rigid variables
+   for sum types, which includes all GADTs. *)
+
+let tvars_of_core_type : core_type -> string list =
+  let tvars =
+    object
+      inherit [string list] Ast_traverse.fold as super
+
+      method! core_type x acc =
+        match x.ptyp_desc with
+        | Ptyp_var x -> if List.mem acc x ~equal:String.equal then acc else x :: acc
+        | _ -> super#core_type x acc
+    end
+  in
+  fun typ -> List.rev (tvars#core_type typ [])
+;;
+
+let constrained_function_binding
+  (* placing a suitably polymorphic or rigid type constraint on the pattern or body *)
+    (loc : Location.t)
+  (td : type_declaration)
+  (typ : core_type)
+  ~(tps : string loc list)
+  ~(func_name : string)
+  (body : expression)
+  =
+  let vars = tvars_of_core_type typ in
+  let has_vars =
+    match vars with
+    | [] -> false
+    | _ :: _ -> true
+  in
+  let pat =
+    let pat = pvar ~loc func_name in
+    if not has_vars
+    then pat
+    else (
+      let vars = List.map ~f:(fun txt -> { txt; loc }) vars in
+      ppat_constraint ~loc pat (ptyp_poly ~loc vars typ))
+  in
+  let body =
+    let use_rigid_variables =
+      match td.ptype_kind with
+      | Ptype_variant _ -> true
+      | _ -> false
+    in
+    if use_rigid_variables
+    then (
+      let rigid_types = make_rigid_types tps in
+      List.fold_right
+        tps
+        ~f:(fun tp body ->
+          pexp_newtype ~loc (find_rigid_type ~loc:tp.loc ~rigid_types tp.txt) body)
+        ~init:(pexp_constraint ~loc body (make_type_rigid ~rigid_types typ)))
+    else if has_vars
+    then body
+    else pexp_constraint ~loc body typ
+  in
+  value_binding ~loc ~pat ~expr:body
+;;
+
+let with_let ~loc ~binds body =
+  List.fold_right binds ~init:body ~f:(fun bind body ->
+    if List.is_empty bind then body else pexp_let ~loc Nonrecursive bind body)
+;;
+
+let with_types ~loc ~types body =
+  if List.is_empty types
+  then body
+  else
+    pexp_open
+      ~loc
+      (open_infos
+         ~loc
+         ~override:Fresh
+         ~expr:
+           (pmod_structure
+              ~loc
+              (List.map types ~f:(fun type_decl -> pstr_type ~loc Recursive [ type_decl ]))))
+      body
+;;
+
+let fresh_lambda ~loc apply =
+  let var = gen_symbol ~prefix:"x" () in
+  let pat = pvar ~loc var in
+  let arg = evar ~loc var in
+  let body = apply ~arg in
+  pexp_fun ~loc Nolabel None pat body
+;;
+
+let rec is_value_expression expr =
+  match expr.pexp_desc with
+  (* Syntactic values. *)
+  | Pexp_ident _ | Pexp_constant _ | Pexp_function _ | Pexp_lazy _ -> true
+  (* Type-only wrappers; we check their contents. *)
+  | Pexp_constraint (expr, (_ : core_type))
+  | Pexp_coerce (expr, (_ : core_type option), (_ : core_type))
+  | Pexp_newtype ((_ : string loc), expr) -> is_value_expression expr
+  (* Allocating constructors; they are only values if all of their contents are. *)
+  | Pexp_tuple exprs -> List.for_all exprs ~f:is_value_expression
+  | Pexp_construct (_, maybe_expr) -> Option.for_all maybe_expr ~f:is_value_expression
+  | Pexp_variant (_, maybe_expr) -> Option.for_all maybe_expr ~f:is_value_expression
+  | Pexp_record (fields, maybe_expr) ->
+    List.for_all fields ~f:(fun (_, expr) -> is_value_expression expr)
+    && Option.for_all maybe_expr ~f:is_value_expression
+  (* Not values, or not always values. We make a conservative approximation. *)
+  | Pexp_unreachable
+  | Pexp_let _
+  | Pexp_apply _
+  | Pexp_match _
+  | Pexp_try _
+  | Pexp_field _
+  | Pexp_setfield _
+  | Pexp_array _
+  | Pexp_ifthenelse _
+  | Pexp_sequence _
+  | Pexp_while _
+  | Pexp_for _
+  | Pexp_send _
+  | Pexp_new _
+  | Pexp_setinstvar _
+  | Pexp_override _
+  | Pexp_letmodule _
+  | Pexp_letexception _
+  | Pexp_assert _
+  | Pexp_poly _
+  | Pexp_object _
+  | Pexp_pack _
+  | Pexp_open _
+  | Pexp_letop _
+  | Pexp_extension _ -> false
+;;
+
+let really_recursive_respecting_opaque rec_flag tds =
+  (object
+     inherit type_is_recursive rec_flag tds as super
+
+     method! core_type ctype =
+       match ctype with
+       | _ when Option.is_some (Attribute.get ~mark_as_seen:false Attrs.opaque ctype) ->
+         ()
+       | [%type: [%t? _] sexp_opaque] -> ()
+       | _ -> super#core_type ctype
+  end)
+    #go
+    ()
+;;
+
+let strip_attributes =
+  object
+    inherit Ast_traverse.map
+
+    method! attribute attr =
+      Location.raise_errorf ~loc:attr.attr_loc "failed to strip attribute from syntax"
+
+    method! attributes _ = []
+
+    method! signature items =
+      List.filter items ~f:(fun item ->
+        match item.psig_desc with
+        | Psig_attribute _ -> false
+        | _ -> true)
+
+    method! structure items =
+      List.filter items ~f:(fun item ->
+        match item.pstr_desc with
+        | Pstr_attribute _ -> false
+        | _ -> true)
+
+    method! class_signature csig =
+      { csig with
+        pcsig_fields =
+          List.filter csig.pcsig_fields ~f:(fun field ->
+            match field.pctf_desc with
+            | Pctf_attribute _ -> false
+            | _ -> true)
+      }
+
+    method! class_structure cstr =
+      { cstr with
+        pcstr_fields =
+          List.filter cstr.pcstr_fields ~f:(fun field ->
+            match field.pcf_desc with
+            | Pcf_attribute _ -> false
+            | _ -> true)
+      }
+  end
+;;

unikernel/duniverse/ppx_sexp_conv/expander/helpers.mli

@@ -0,0 +1,41 @@
+open! Base
+open! Ppxlib
+
+(** Constructs a branch of a [match] or [function] expression with no guard. *)
+val ( --> ) : pattern -> expression -> case
+
+(** Replace all type variables like ['a] with wildcard ([_]) types. *)
+val replace_variables_by_underscores : core_type -> core_type
+
+(** Create a binding for a derived function, adding a type annotation if required. *)
+val constrained_function_binding
+  :  location (** location to use for the binding *)
+  -> type_declaration (** type declaration used to derive the function *)
+  -> core_type (** type of the function *)
+  -> tps:string loc list (** names of type parameters in the declaration *)
+  -> func_name:string (** name to bind the function to *)
+  -> expression (** expression representing the function *)
+  -> value_binding
+
+(** Wraps an expression in layers of non-recursive [let] bindings, with the bindings
+    sorted from outermost to innermost. *)
+val with_let : loc:location -> binds:value_binding list list -> expression -> expression
+
+(** Wraps an expression in [let open] containing type declarations, if non-empty. *)
+val with_types : loc:location -> types:type_declaration list -> expression -> expression
+
+(** Constructs a lambda of a fresh variable. Passes a reference to that variable as [arg]
+    to construct the lambda's body. *)
+val fresh_lambda : loc:location -> (arg:expression -> expression) -> expression
+
+(** Conservative approximation of which expressions are syntactically values, i.e.
+    constants, variables, or lambdas. When [true], these expressions have no effects
+    (other than possibly closure allocation) and can be used in [let rec] definitions.
+    When [false], they may need to be eta-expanded or wrapped in [lazy]. *)
+val is_value_expression : expression -> bool
+
+(** Shadows [Ppxlib.really_recursive] with a version that respects the [[@opaque]]
+    attribute. *)
+val really_recursive_respecting_opaque : rec_flag -> type_declaration list -> rec_flag
+
+val strip_attributes : Ast_traverse.map

unikernel/duniverse/ppx_sexp_conv/expander/labeled_tuple.ml

@@ -0,0 +1,8 @@
+open! Base
+
+let is_valid alist = List.exists alist ~f:(fun (option, _) -> Option.is_some option)
+
+let atom_of_label = function
+  | None -> "."
+  | Some string -> "~" ^ string
+;;

unikernel/duniverse/ppx_sexp_conv/expander/labeled_tuple.mli

@@ -0,0 +1,9 @@
+(* Support for labeled tuples, a language feature currently only implemented in Jane
+   Street's experimental branch of the compiler
+   (https://github.com/ocaml-flambda/flambda-backend/). *)
+
+open! Base
+open Ppxlib_jane
+
+val is_valid : Jane_syntax.Labeled_tuples.core_type -> bool
+val atom_of_label : string option -> string

unikernel/duniverse/ppx_sexp_conv/expander/lifted.ml

@@ -0,0 +1,46 @@
+open! Base
+open Ppxlib
+open Ast_builder.Default
+
+type 'a t =
+  { value_bindings : value_binding list
+  ; body : 'a
+  }
+
+include Monad.Make (struct
+  type nonrec 'a t = 'a t
+
+  let return body = { value_bindings = []; body }
+
+  let bind a ~f =
+    let b = f a.body in
+    { value_bindings = a.value_bindings @ b.value_bindings; body = b.body }
+  ;;
+
+  let map = `Define_using_bind
+end)
+
+let create ~loc ~prefix ~ty rhs =
+  let name = gen_symbol ~prefix () in
+  let lhs = pvar ~loc name in
+  let body = evar ~loc name in
+  let ty, rhs, body =
+    if Helpers.is_value_expression rhs
+    then ty, rhs, body
+    else (
+      (* Thunkify the value to evaluate when referred to. *)
+      let ty = [%type: Stdlib.Unit.t -> [%t ty]] in
+      let rhs = [%expr fun () -> [%e rhs]] in
+      let body = [%expr [%e body] ()] in
+      ty, rhs, body)
+  in
+  { value_bindings = [ value_binding ~loc ~pat:(ppat_constraint ~loc lhs ty) ~expr:rhs ]
+  ; body
+  }
+;;
+
+let let_bind_user_expressions { value_bindings; body } ~loc =
+  if List.is_empty value_bindings
+  then body
+  else pexp_let ~loc Nonrecursive value_bindings body
+;;

unikernel/duniverse/ppx_sexp_conv/expander/lifted.mli

@@ -0,0 +1,20 @@
+open! Base
+open Ppxlib
+
+(** Represents an ['a], along with some user expressions that should lifted out of the
+    scope of internal bindings. For example, if a user writes [[@@default x]], they mean
+    [x] in the surface code, not some temporary variable [x] added by ppx machinery. *)
+type 'a t
+
+(** As a monad, combines all client expressions so they can be lifted to the outermost
+    level of generated code. *)
+include Monad.S with type 'a t := 'a t
+
+(** Lifts the given expression and binds it to a fresh variable starting with [prefix].
+    The expression is evaluated each time it is referred to. The binding is annotated with
+    [ty]. Uses [loc] for generated code. *)
+val create : loc:location -> prefix:string -> ty:core_type -> expression -> expression t
+
+(** Uses [let] to bind all lifted user expressions, with the contained expression as the
+    body. Should be called in whatever scope the user should be able to refer to. *)
+val let_bind_user_expressions : expression t -> loc:location -> expression

unikernel/duniverse/ppx_sexp_conv/expander/ppx_sexp_conv_expander.ml

@@ -0,0 +1,55 @@
+open Base
+open Ppxlib
+open Ast_builder.Default
+module Attrs = Attrs
+module Record_field_attrs = Record_field_attrs
+open Expand_sexp_of
+open Expand_of_sexp
+
+module Sexp_of = struct
+  let type_extension ty =
+    Sig_generate_sexp_of.type_of_sexp_of ~loc:{ ty.ptyp_loc with loc_ghost = true } ty
+  ;;
+
+  let core_type ty = Str_generate_sexp_of.sexp_of_core_type ty
+  let sig_type_decl = Sig_generate_sexp_of.mk_sig
+  let sig_exception = Sig_generate_sexp_of.mk_sig_exn
+  let str_type_decl = Str_generate_sexp_of.sexp_of_tds
+  let str_exception = Str_generate_sexp_of.sexp_of_exn
+end
+
+module Sexp_grammar = Ppx_sexp_conv_grammar
+
+module Of_sexp = struct
+  let type_extension ty = Sig_generate_of_sexp.type_of_of_sexp ~loc:ty.ptyp_loc ty
+  let core_type = Str_generate_of_sexp.core_type_of_sexp
+
+  let sig_type_decl ~poly ~loc ~path tds =
+    Sig_generate_of_sexp.mk_sig ~poly ~loc ~path tds
+  ;;
+
+  let str_type_decl ~loc ~poly ~path tds =
+    Str_generate_of_sexp.tds_of_sexp ~loc ~poly ~path tds
+  ;;
+end
+
+module Sig_sexp = struct
+  let mk_sig ~loc ~path decls =
+    List.concat
+      [ Sig_generate_sexp_of.mk_sig ~loc ~path decls
+      ; Sig_generate_of_sexp.mk_sig ~poly:false ~loc ~path decls
+      ]
+  ;;
+
+  let sig_type_decl ~loc ~path ((_rf, tds) as decls) =
+    match
+      mk_named_sig
+        ~loc
+        ~sg_name:"Sexplib0.Sexpable.S"
+        ~handle_polymorphic_variant:false
+        tds
+    with
+    | Some include_infos -> [ psig_include ~loc include_infos ]
+    | None -> mk_sig ~loc ~path decls
+  ;;
+end

unikernel/duniverse/ppx_sexp_conv/expander/ppx_sexp_conv_expander.mli

@@ -0,0 +1,72 @@
+open Ppxlib
+module Attrs = Attrs
+module Record_field_attrs = Record_field_attrs
+
+module Sexp_of : sig
+  val type_extension : core_type -> core_type
+  val core_type : core_type -> expression
+
+  val sig_type_decl
+    :  loc:Location.t
+    -> path:string
+    -> rec_flag * type_declaration list
+    -> signature
+
+  val sig_exception : loc:Location.t -> path:string -> type_exception -> signature
+
+  val str_type_decl
+    :  loc:Location.t
+    -> path:string
+    -> rec_flag * type_declaration list
+    -> structure
+
+  val str_exception : loc:Location.t -> path:string -> type_exception -> structure
+end
+
+module Of_sexp : sig
+  val type_extension : core_type -> core_type
+  val core_type : path:string -> core_type -> expression
+
+  val sig_type_decl
+    :  poly:bool
+    -> loc:Location.t
+    -> path:string
+    -> rec_flag * type_declaration list
+    -> signature
+
+  val str_type_decl
+    :  loc:Location.t
+    -> poly:bool (** the type is annotated with sexp_poly instead of sexp *)
+    -> path:string (** the module path within the file *)
+    -> rec_flag * type_declaration list
+    -> structure
+end
+
+module Sexp_grammar : sig
+  val type_extension : ctxt:Expansion_context.Extension.t -> core_type -> core_type
+
+  val core_type
+    :  tags_of_doc_comments:bool
+    -> ctxt:Expansion_context.Extension.t
+    -> core_type
+    -> expression
+
+  val sig_type_decl
+    :  ctxt:Expansion_context.Deriver.t
+    -> rec_flag * type_declaration list
+    -> signature
+
+  val str_type_decl
+    :  ctxt:Expansion_context.Deriver.t
+    -> rec_flag * type_declaration list
+    -> bool (** [true] means capture doc comments as tags *)
+    -> structure
+end
+
+module Sig_sexp : sig
+  val sig_type_decl
+    :  loc:Location.t
+    -> path:string
+    -> rec_flag * type_declaration list
+    -> signature
+end

unikernel/duniverse/ppx_sexp_conv/expander/ppx_sexp_conv_grammar.ml

@@ -0,0 +1,722 @@
+open! Base
+open! Ppxlib
+open Ast_builder.Default
+
+let copy =
+  object
+    inherit Ast_traverse.map
+    method! location loc = { loc with loc_ghost = true }
+    method! attributes _ = []
+  end
+;;
+
+let unsupported ~loc string =
+  Location.raise_errorf ~loc "sexp_grammar: %s are unsupported" string
+;;
+
+let ewith_tag ~loc ~key ~value grammar =
+  [%expr { key = [%e key]; value = [%e value]; grammar = [%e grammar] }]
+;;
+
+let eno_tag ~loc grammar = [%expr No_tag [%e grammar]]
+let etag ~loc with_tag = [%expr Tag [%e with_tag]]
+let etagged ~loc with_tag = [%expr Tagged [%e with_tag]]
+
+let tag_of_doc_comment ~loc comment =
+  ( [%expr Ppx_sexp_conv_lib.Sexp_grammar.doc_comment_tag]
+  , [%expr Atom [%e estring ~loc comment]] )
+;;
+
+module Tags = struct
+  type t =
+    { defined_using_tags : expression option
+    ; defined_using_tag : (expression * expression) list
+    }
+
+  let get x ~tags ~tag =
+    { defined_using_tags = Attribute.get tags x
+    ; defined_using_tag = Attribute.get tag x |> Option.value ~default:[]
+    }
+  ;;
+end
+
+let rec with_tag_assoc_list grammar ~loc ~tags_expr ~wrap_tag ~wrap_tags =
+  match tags_expr with
+  | [%expr []] -> grammar
+  | [%expr ([%e? key], [%e? value]) :: [%e? tags_expr]] ->
+    wrap_tag
+      ~loc
+      (ewith_tag
+         ~loc
+         ~key
+         ~value
+         (with_tag_assoc_list grammar ~loc ~tags_expr ~wrap_tag ~wrap_tags))
+  | _ -> wrap_tags grammar ~loc ~tags_expr
+;;
+
+let with_tags grammar ~wrap_tag ~wrap_tags ~loc ~(tags : Tags.t) ~comments =
+  let tags_from_comments = List.map comments ~f:(tag_of_doc_comment ~loc) in
+  let init =
+    match tags.defined_using_tags with
+    | None -> grammar
+    | Some tags_expr -> with_tag_assoc_list grammar ~loc ~tags_expr ~wrap_tag ~wrap_tags
+  in
+  List.fold_right
+    (List.concat [ tags_from_comments; tags.defined_using_tag ])
+    ~init
+    ~f:(fun (key, value) grammar -> wrap_tag ~loc (ewith_tag ~loc ~key ~value grammar))
+;;
+
+let with_tags_as_list grammar ~core_type ~loc ~tags ~comments =
+  let wrap_tags grammar ~loc ~tags_expr =
+    [%expr
+      Sexplib0.Sexp_conv.sexp_grammar_with_tag_list
+        ([%e grammar] : [%t core_type] Sexplib0.Sexp_grammar.with_tag_list)
+        ~tags:[%e tags_expr]]
+  in
+  with_tags (eno_tag ~loc grammar) ~wrap_tag:etag ~wrap_tags ~loc ~tags ~comments
+;;
+
+let with_tags_as_grammar grammar ~loc ~tags ~comments =
+  let wrap_tags grammar ~loc ~tags_expr =
+    [%expr Sexplib0.Sexp_conv.sexp_grammar_with_tags [%e grammar] ~tags:[%e tags_expr]]
+  in
+  with_tags grammar ~wrap_tag:etagged ~wrap_tags ~loc ~tags ~comments
+;;
+
+let grammar_name name = name ^ "_sexp_grammar"
+let tyvar_grammar_name name = grammar_name ("_'" ^ name)
+let estr { loc; txt } = estring ~loc txt
+
+let grammar_type ~loc core_type =
+  [%type: [%t copy#core_type core_type] Sexplib0.Sexp_grammar.t]
+;;
+
+let abstract_grammar ~ctxt ~loc id =
+  let module_name =
+    ctxt |> Expansion_context.Deriver.code_path |> Code_path.fully_qualified_path
+  in
+  [%expr Any [%e estr { id with txt = String.concat ~sep:"." [ module_name; id.txt ] }]]
+;;
+
+let arrow_grammar ~loc = [%expr Sexplib0.Sexp_conv.fun_sexp_grammar.untyped]
+let opaque_grammar ~loc = [%expr Sexplib0.Sexp_conv.opaque_sexp_grammar.untyped]
+let any_grammar ~loc name = [%expr Any [%e estring ~loc name]]
+let list_grammar ~loc expr = [%expr List [%e expr]]
+let many_grammar ~loc expr = [%expr Many [%e expr]]
+let fields_grammar ~loc expr = [%expr Fields [%e expr]]
+let tyvar_grammar ~loc expr = [%expr Tyvar [%e expr]]
+let recursive_grammar ~loc name args = [%expr Recursive ([%e name], [%e args])]
+
+let tycon_grammar ~loc tycon_name params defns =
+  [%expr Tycon ([%e tycon_name], [%e params], [%e defns])]
+;;
+
+let defns_type ~loc = [%type: Sexplib0.Sexp_grammar.defn Stdlib.List.t Stdlib.Lazy.t]
+
+let untyped_grammar ~loc expr =
+  match expr with
+  | [%expr { untyped = [%e? untyped] }] -> untyped
+  | _ -> [%expr [%e expr].untyped]
+;;
+
+let typed_grammar ~loc expr =
+  match expr with
+  | [%expr [%e? typed].untyped] -> typed
+  | _ -> [%expr { untyped = [%e expr] }]
+;;
+
+let annotated_grammar ~loc expr core_type =
+  pexp_constraint ~loc expr (grammar_type ~loc core_type)
+;;
+
+let defn_expr ~loc ~tycon ~tyvars ~grammar =
+  [%expr { tycon = [%e tycon]; tyvars = [%e tyvars]; grammar = [%e grammar] }]
+;;
+
+let union_grammar ~loc exprs =
+  match exprs with
+  | [] -> [%expr Union []]
+  | [ expr ] -> expr
+  | _ -> [%expr Union [%e elist ~loc exprs]]
+;;
+
+let tuple_grammar ~loc exprs =
+  List.fold_right exprs ~init:[%expr Empty] ~f:(fun expr rest ->
+    [%expr Cons ([%e expr], [%e rest])])
+;;
+
+let atom_clause ~loc = [%expr Atom_clause]
+let list_clause ~loc args = [%expr List_clause { args = [%e args] }]
+
+module Variant_clause_type = struct
+  type t =
+    { name : label loc
+    ; comments : string list
+    ; tags : Tags.t
+    ; clause_kind : expression
+    }
+
+  let to_grammar_expr { name; comments; tags; clause_kind } ~loc =
+    [%expr { name = [%e estr name]; clause_kind = [%e clause_kind] }]
+    |> with_tags_as_list
+         ~loc:name.loc
+         ~comments
+         ~tags
+         ~core_type:[%type: Sexplib0.Sexp_grammar.clause]
+  ;;
+end
+
+let variant_grammars ~loc ~case_sensitivity ~clauses =
+  match List.is_empty clauses with
+  | true -> []
+  | false ->
+    let clause_exprs = List.map clauses ~f:(Variant_clause_type.to_grammar_expr ~loc) in
+    let grammar =
+      [%expr
+        Variant
+          { case_sensitivity = [%e case_sensitivity]
+          ; clauses = [%e elist ~loc clause_exprs]
+          }]
+    in
+    [ grammar ]
+;;
+
+(* Wrap [expr] in [fun a b ... ->] for type parameters. *)
+let td_params_fun td expr =
+  let loc = td.ptype_loc in
+  let params =
+    List.map td.ptype_params ~f:(fun param ->
+      let { loc; txt } = get_type_param_name param in
+      pvar ~loc (tyvar_grammar_name txt))
+  in
+  eabstract ~loc params expr
+;;
+
+module Row_field_type = struct
+  type t =
+    | Inherit of core_type
+    | Tag_no_arg of string loc
+    | Tag_with_arg of string loc * core_type
+
+  let of_row_field ~loc row_field =
+    match row_field with
+    | Rinherit core_type -> Inherit core_type
+    | Rtag (name, possibly_no_arg, possible_type_args) ->
+      (match possibly_no_arg, possible_type_args with
+       | true, [] -> Tag_no_arg name
+       | false, [ core_type ] -> Tag_with_arg (name, core_type)
+       | false, [] -> unsupported ~loc "empty polymorphic variant types"
+       | true, _ :: _ | false, _ :: _ :: _ -> unsupported ~loc "intersection types")
+  ;;
+end
+
+let attr_doc_comments attributes ~tags_of_doc_comments =
+  match tags_of_doc_comments with
+  | false -> []
+  | true ->
+    let doc_pattern = Ast_pattern.(pstr (pstr_eval (estring __) nil ^:: nil)) in
+    List.filter_map attributes ~f:(fun attribute ->
+      match attribute.attr_name.txt with
+      | "ocaml.doc" | "doc" ->
+        Ast_pattern.parse
+          doc_pattern
+          attribute.attr_loc
+          attribute.attr_payload
+          ~on_error:(fun () -> None)
+          (fun doc -> Some doc)
+      | _ -> None)
+;;
+
+let grammar_of_type_tags core_type grammar ~tags_of_doc_comments =
+  let tags = Tags.get core_type ~tags:Attrs.tags_type ~tag:Attrs.tag_type in
+  let loc = core_type.ptyp_loc in
+  let comments = attr_doc_comments ~tags_of_doc_comments core_type.ptyp_attributes in
+  with_tags_as_grammar grammar ~loc ~tags ~comments
+;;
+
+let grammar_of_field_tags field grammar ~tags_of_doc_comments =
+  let tags = Tags.get field ~tags:Attrs.tags_ld ~tag:Attrs.tag_ld in
+  let loc = field.pld_loc in
+  let comments = attr_doc_comments ~tags_of_doc_comments field.pld_attributes in
+  with_tags_as_list
+    grammar
+    ~loc
+    ~tags
+    ~comments
+    ~core_type:[%type: Sexplib0.Sexp_grammar.field]
+;;
+
+let rec grammar_of_type core_type ~rec_flag ~tags_of_doc_comments =
+  let loc = core_type.ptyp_loc in
+  let grammar =
+    let from_attribute =
+      match
+        ( Attribute.get Attrs.grammar_custom core_type
+        , Attribute.get Attrs.grammar_any core_type )
+      with
+      | Some _, Some _ ->
+        Some
+          [%expr
+            [%ocaml.warning
+              "[@sexp_grammar.custom] and [@sexp_grammar.any] are mutually exclusive"]]
+      | Some expr, None ->
+        Some (untyped_grammar ~loc (annotated_grammar ~loc expr core_type))
+      | None, Some maybe_name ->
+        Some (any_grammar ~loc (Option.value maybe_name ~default:"ANY"))
+      | None, None ->
+        (* only check [[@sexp.opaque]] if neither other attribute is present, so that it
+           only counts as using the attribute when we actually base the grammar on it *)
+        (match Attribute.get Attrs.opaque core_type with
+         | Some () -> Some (opaque_grammar ~loc)
+         | None -> None)
+    in
+    match from_attribute with
+    | Some expr -> expr
+    | None ->
+      (match Ppxlib_jane.Jane_syntax.Core_type.of_ast core_type with
+       | Some (Jtyp_tuple ltps, _attrs) ->
+         grammar_of_labeled_tuple ~loc ~rec_flag ~tags_of_doc_comments ltps
+       | Some (Jtyp_layout _, _) | None ->
+         (match core_type.ptyp_desc with
+          | Ptyp_any -> any_grammar ~loc "_"
+          | Ptyp_var name ->
+            (match rec_flag with
+             | Recursive ->
+               (* For recursive grammars, [grammar_of_type] for any type variables is called
+                  inside a [defn]. The variables should therefore be resolved as [Tyvar]
+                  grammars. *)
+               tyvar_grammar ~loc (estring ~loc name)
+             | Nonrecursive ->
+               (* Outside recursive [defn]s, type variables are passed in as function
+                  arguments. *)
+               unapplied_type_constr_conv
+                 ~loc
+                 ~f:tyvar_grammar_name
+                 (Located.lident ~loc name)
+               |> untyped_grammar ~loc)
+          | Ptyp_arrow _ -> arrow_grammar ~loc
+          | Ptyp_tuple list ->
+            List.map ~f:(grammar_of_type ~rec_flag ~tags_of_doc_comments) list
+            |> tuple_grammar ~loc
+            |> list_grammar ~loc
+          | Ptyp_constr (id, args) ->
+            List.map args ~f:(fun core_type ->
+              let loc = core_type.ptyp_loc in
+              grammar_of_type ~rec_flag ~tags_of_doc_comments core_type
+              |> typed_grammar ~loc)
+            |> type_constr_conv ~loc ~f:grammar_name id
+            |> untyped_grammar ~loc
+          | Ptyp_object _ -> unsupported ~loc "object types"
+          | Ptyp_class _ -> unsupported ~loc "class types"
+          | Ptyp_alias _ -> unsupported ~loc "type aliases"
+          | Ptyp_variant (rows, closed_flag, (_ : string list option)) ->
+            (match closed_flag with
+             | Open -> unsupported ~loc "open polymorphic variant types"
+             | Closed ->
+               grammar_of_polymorphic_variant ~loc ~rec_flag ~tags_of_doc_comments rows)
+          | Ptyp_poly _ -> unsupported ~loc "explicitly polymorphic types"
+          | Ptyp_package _ -> unsupported ~loc "first-class module types"
+          | Ptyp_extension _ -> unsupported ~loc "unexpanded ppx extensions"
+          | Ptyp_open _ -> unsupported ~loc "local module open"))
+  in
+  grammar_of_type_tags core_type grammar ~tags_of_doc_comments
+
+and grammar_of_labeled_tuple ~loc ~rec_flag ~tags_of_doc_comments alist =
+  assert (Labeled_tuple.is_valid alist);
+  let fields =
+    List.concat_map alist ~f:(fun (lbl, typ) ->
+      let lbl = Labeled_tuple.atom_of_label lbl in
+      let field = grammar_of_type ~rec_flag ~tags_of_doc_comments typ in
+      let clauses : Variant_clause_type.t list =
+        (* Labeled tuples are encoded as a list of singleton variants, where the
+           constructor name is used for the label. *)
+        [ { name = { txt = lbl; loc }
+          ; comments = []
+          ; tags =
+              { defined_using_tags = None; defined_using_tag = [] }
+              (* We can use empty comments and tags because it's not possible to attach an
+             attribute to a labeled tuple field. *)
+          ; clause_kind = list_clause ~loc [%expr Cons ([%e field], Empty)]
+          }
+        ]
+      in
+      let case_sensitivity = [%expr Case_sensitive] in
+      variant_grammars ~loc ~case_sensitivity ~clauses)
+  in
+  list_grammar ~loc (tuple_grammar ~loc fields)
+
+and grammar_of_polymorphic_variant ~loc ~rec_flag ~tags_of_doc_comments rows =
+  let inherits, clauses =
+    List.partition_map rows ~f:(fun row : (_, Variant_clause_type.t) Either.t ->
+      let tags = Tags.get row ~tags:Attrs.tags_poly ~tag:Attrs.tag_poly in
+      let comments = attr_doc_comments ~tags_of_doc_comments row.prf_attributes in
+      match Attribute.get Attrs.list_poly row with
+      | Some () ->
+        (match Row_field_type.of_row_field ~loc row.prf_desc with
+         | Tag_with_arg (name, [%type: [%t? ty] list]) ->
+           let clause_kind =
+             grammar_of_type ~rec_flag ~tags_of_doc_comments ty
+             |> many_grammar ~loc
+             |> list_clause ~loc
+           in
+           Second { name; comments; tags; clause_kind }
+         | _ -> Attrs.invalid_attribute ~loc Attrs.list_poly "_ list")
+      | None ->
+        (match Row_field_type.of_row_field ~loc row.prf_desc with
+         | Inherit core_type ->
+           First
+             (grammar_of_type ~rec_flag ~tags_of_doc_comments core_type
+              |> with_tags_as_grammar ~loc ~tags ~comments)
+         | Tag_no_arg name ->
+           Second { name; comments; tags; clause_kind = atom_clause ~loc }
+         | Tag_with_arg (name, core_type) ->
+           let clause_kind =
+             [ grammar_of_type ~rec_flag ~tags_of_doc_comments core_type ]
+             |> tuple_grammar ~loc
+             |> list_clause ~loc
+           in
+           Second { name; comments; tags; clause_kind }))
+  in
+  variant_grammars ~loc ~case_sensitivity:[%expr Case_sensitive] ~clauses
+  |> List.append inherits
+  |> union_grammar ~loc
+;;
+
+let record_expr ~loc ~rec_flag ~tags_of_doc_comments ~extra_attr syntax fields =
+  let fields =
+    List.map fields ~f:(fun field ->
+      let loc = field.pld_loc in
+      let field_kind = Record_field_attrs.Of_sexp.create ~loc field in
+      let required =
+        match field_kind with
+        | Specific Required -> true
+        | Specific (Default _)
+        | Sexp_bool | Sexp_option _ | Sexp_array _ | Sexp_list _ | Omit_nil -> false
+      in
+      let args =
+        match field_kind with
+        | Specific Required | Specific (Default _) | Omit_nil ->
+          [%expr
+            Cons
+              ([%e grammar_of_type ~tags_of_doc_comments ~rec_flag field.pld_type], Empty)]
+        | Sexp_bool -> [%expr Empty]
+        | Sexp_option ty ->
+          [%expr Cons ([%e grammar_of_type ~tags_of_doc_comments ~rec_flag ty], Empty)]
+        | Sexp_list ty | Sexp_array ty ->
+          [%expr
+            Cons
+              (List (Many [%e grammar_of_type ~tags_of_doc_comments ~rec_flag ty]), Empty)]
+      in
+      [%expr
+        { name = [%e estr field.pld_name]
+        ; required = [%e ebool ~loc required]
+        ; args = [%e args]
+        }]
+      |> grammar_of_field_tags field ~tags_of_doc_comments)
+  in
+  let allow_extra_fields =
+    match Attribute.get extra_attr syntax with
+    | Some () -> true
+    | None -> false
+  in
+  [%expr
+    { allow_extra_fields = [%e ebool ~loc allow_extra_fields]
+    ; fields = [%e elist ~loc fields]
+    }]
+;;
+
+let grammar_of_variant ~loc ~rec_flag ~tags_of_doc_comments clause_decls =
+  let clauses =
+    List.map clause_decls ~f:(fun clause : Variant_clause_type.t ->
+      let loc = clause.pcd_loc in
+      let tags = Tags.get clause ~tags:Attrs.tags_cd ~tag:Attrs.tag_cd in
+      let comments = attr_doc_comments ~tags_of_doc_comments clause.pcd_attributes in
+      match Attribute.get Attrs.list_variant clause with
+      | Some () ->
+        (match clause.pcd_args with
+         | Pcstr_tuple [ [%type: [%t? ty] list] ] ->
+           let args =
+             many_grammar ~loc (grammar_of_type ty ~rec_flag ~tags_of_doc_comments)
+           in
+           { name = clause.pcd_name; comments; tags; clause_kind = list_clause ~loc args }
+         | _ -> Attrs.invalid_attribute ~loc Attrs.list_variant "_ list")
+      | None ->
+        (match clause.pcd_args with
+         | Pcstr_tuple [] ->
+           { name = clause.pcd_name; comments; tags; clause_kind = atom_clause ~loc }
+         | Pcstr_tuple (_ :: _ as args) ->
+           let args =
+             tuple_grammar
+               ~loc
+               (List.map args ~f:(grammar_of_type ~rec_flag ~tags_of_doc_comments))
+           in
+           { name = clause.pcd_name; comments; tags; clause_kind = list_clause ~loc args }
+         | Pcstr_record fields ->
+           let args =
+             record_expr
+               ~loc
+               ~rec_flag
+               ~tags_of_doc_comments
+               ~extra_attr:Attrs.allow_extra_fields_cd
+               clause
+               fields
+             |> fields_grammar ~loc
+           in
+           { name = clause.pcd_name; comments; tags; clause_kind = list_clause ~loc args }))
+  in
+  variant_grammars
+    ~loc
+    ~case_sensitivity:[%expr Case_sensitive_except_first_character]
+    ~clauses
+  |> union_grammar ~loc
+;;
+
+let grammar_of_td ~ctxt ~rec_flag ~tags_of_doc_comments td =
+  let loc = td.ptype_loc in
+  match td.ptype_kind with
+  | Ptype_open -> unsupported ~loc "open types"
+  | Ptype_record fields ->
+    record_expr
+      ~loc
+      ~rec_flag
+      ~tags_of_doc_comments
+      ~extra_attr:Attrs.allow_extra_fields_td
+      td
+      fields
+    |> fields_grammar ~loc
+    |> list_grammar ~loc
+  | Ptype_variant clauses ->
+    grammar_of_variant ~loc ~rec_flag ~tags_of_doc_comments clauses
+  | Ptype_abstract ->
+    (match td.ptype_manifest with
+     | None -> abstract_grammar ~ctxt ~loc td.ptype_name
+     | Some core_type -> grammar_of_type ~rec_flag ~tags_of_doc_comments core_type)
+;;
+
+let pattern_of_td td =
+  let { loc; txt } = td.ptype_name in
+  ppat_constraint
+    ~loc
+    (pvar ~loc (grammar_name txt))
+    (ptyp_poly
+       ~loc
+       (List.map td.ptype_params ~f:get_type_param_name)
+       (combinator_type_of_type_declaration td ~f:grammar_type))
+;;
+
+(* Any grammar expression that is purely a constant does no work, and does not need to be
+   wrapped in [Lazy]. *)
+let rec is_preallocated_constant expr =
+  match expr.pexp_desc with
+  | Pexp_constraint (expr, _) | Pexp_coerce (expr, _, _) | Pexp_open (_, expr) ->
+    is_preallocated_constant expr
+  | Pexp_constant _ -> true
+  | Pexp_tuple args -> List.for_all ~f:is_preallocated_constant args
+  | Pexp_variant (_, maybe_arg) | Pexp_construct (_, maybe_arg) ->
+    Option.for_all ~f:is_preallocated_constant maybe_arg
+  | Pexp_record (fields, maybe_template) ->
+    List.for_all fields ~f:(fun (_, expr) -> is_preallocated_constant expr)
+    && Option.for_all ~f:is_preallocated_constant maybe_template
+  | _ -> false
+;;
+
+(* Any grammar expression that just refers to a previously defined grammar also does not
+   need to be wrapped in [Lazy]. Accessing the previous grammar is work, but building the
+   closure for a lazy value is at least as much work anyway. *)
+let rec is_variable_access expr =
+  match expr.pexp_desc with
+  | Pexp_constraint (expr, _) | Pexp_coerce (expr, _, _) | Pexp_open (_, expr) ->
+    is_variable_access expr
+  | Pexp_ident _ -> true
+  | Pexp_field (expr, _) -> is_variable_access expr
+  | _ -> false
+;;
+
+let grammar_needs_lazy_wrapper expr =
+  not (is_preallocated_constant expr || is_variable_access expr)
+;;
+
+let lazy_grammar ~loc td expr =
+  if List.is_empty td.ptype_params
+     (* polymorphic types generate functions, so the body does not need a [lazy] wrapper *)
+     && grammar_needs_lazy_wrapper expr
+  then [%expr Lazy (lazy [%e expr])]
+  else expr
+;;
+
+let force_expr ~loc expr = [%expr Stdlib.Lazy.force [%e expr]]
+
+(* Definitions of grammars that do not refer to each other. *)
+let nonrecursive_grammars ~ctxt ~loc ~tags_of_doc_comments td_lists =
+  List.concat_map td_lists ~f:(fun tds ->
+    List.map tds ~f:(fun td ->
+      let td = name_type_params_in_td td in
+      let loc = td.ptype_loc in
+      let pat = pattern_of_td td in
+      let expr =
+        grammar_of_td ~ctxt ~rec_flag:Nonrecursive ~tags_of_doc_comments td
+        |> lazy_grammar td ~loc
+        |> typed_grammar ~loc
+        |> td_params_fun td
+      in
+      value_binding ~loc ~pat ~expr)
+    |> pstr_value_list ~loc Nonrecursive)
+;;
+
+(* Type constructor grammars used to "tie the knot" for (mutally) recursive grammars. *)
+let recursive_grammar_tycons tds =
+  List.map tds ~f:(fun td ->
+    let td = name_type_params_in_td td in
+    let loc = td.ptype_loc in
+    let pat = pattern_of_td td in
+    let expr =
+      recursive_grammar
+        ~loc
+        (estr td.ptype_name)
+        (List.map td.ptype_params ~f:(fun param ->
+           let { loc; txt } = get_type_param_name param in
+           tyvar_grammar_name txt |> evar ~loc |> untyped_grammar ~loc)
+         |> elist ~loc)
+      |> typed_grammar ~loc
+      |> td_params_fun td
+    in
+    value_binding ~loc ~pat ~expr)
+;;
+
+(* Recursive grammar definitions, based on the type constructors from above. *)
+let recursive_grammar_defns ~ctxt ~loc ~tags_of_doc_comments tds =
+  List.map tds ~f:(fun td ->
+    let td = name_type_params_in_td td in
+    let loc = td.ptype_loc in
+    let tycon = estr td.ptype_name in
+    let tyvars =
+      List.map td.ptype_params ~f:(fun param -> estr (get_type_param_name param))
+      |> elist ~loc
+    in
+    let grammar = grammar_of_td ~ctxt ~rec_flag:Recursive ~tags_of_doc_comments td in
+    defn_expr ~loc ~tycon ~tyvars ~grammar)
+  |> elist ~loc
+;;
+
+(* Grammar expression using [Recursive] and a shared definition of grammar definitions.
+   The shared definitions are wrapped in [lazy] to avoid toplevel side effects. *)
+let recursive_grammar_expr ~defns_name td =
+  let td = name_type_params_in_td td in
+  let loc = td.ptype_loc in
+  let pat = pattern_of_td td in
+  let expr =
+    let tyvars =
+      List.map td.ptype_params ~f:(fun param ->
+        let { loc; txt } = get_type_param_name param in
+        tyvar_grammar_name txt |> evar ~loc |> untyped_grammar ~loc)
+      |> elist ~loc
+    in
+    tycon_grammar
+      ~loc
+      (estr td.ptype_name)
+      tyvars
+      (evar ~loc defns_name |> force_expr ~loc)
+    |> lazy_grammar td ~loc
+    |> typed_grammar ~loc
+    |> td_params_fun td
+  in
+  value_binding ~loc ~pat ~expr
+;;
+
+(* Puts together recursive grammar definitions from the parts implemented above. *)
+let recursive_grammars ~ctxt ~loc ~tags_of_doc_comments tds =
+  match List.is_empty tds with
+  | true -> []
+  | false ->
+    let defns_name = gen_symbol ~prefix:"grammars" () in
+    let defns_item =
+      let expr =
+        recursive_grammar_defns ~ctxt ~loc ~tags_of_doc_comments tds
+        |> pexp_let ~loc Nonrecursive (recursive_grammar_tycons tds)
+        |> pexp_lazy ~loc
+      in
+      let pat = ppat_constraint ~loc (pvar ~loc defns_name) (defns_type ~loc) in
+      pstr_value ~loc Nonrecursive [ value_binding ~loc ~pat ~expr ]
+    in
+    let grammars_item =
+      List.map tds ~f:(recursive_grammar_expr ~defns_name) |> pstr_value ~loc Nonrecursive
+    in
+    [%str
+      include struct
+        open struct
+          [%%i defns_item]
+        end
+
+        [%%i grammars_item]
+      end]
+;;
+
+let partition_recursive_and_nonrecursive ~rec_flag tds =
+  match (rec_flag : rec_flag) with
+  | Nonrecursive -> [], [ tds ]
+  | Recursive ->
+    (* Pulling out non-recursive references repeatedly means we only "tie the knot" for
+       variables that actually need it, and we don't have to manually [ignore] the added
+       bindings in case they are unused. *)
+    let rec loop tds ~acc =
+      let obj =
+        object
+          inherit type_is_recursive Recursive tds
+          method recursion td = {<type_names = [ td.ptype_name.txt ]>}#go ()
+        end
+      in
+      let recursive, nonrecursive =
+        List.partition_tf tds ~f:(fun td ->
+          match obj#recursion td with
+          | Recursive -> true
+          | Nonrecursive -> false)
+      in
+      if List.is_empty recursive || List.is_empty nonrecursive
+      then recursive, nonrecursive :: acc
+      else loop recursive ~acc:(nonrecursive :: acc)
+    in
+    loop tds ~acc:[]
+;;
+
+let str_type_decl ~ctxt (rec_flag, tds) tags_of_doc_comments =
+  let loc = Expansion_context.Deriver.derived_item_loc ctxt in
+  let recursive, nonrecursive = partition_recursive_and_nonrecursive ~rec_flag tds in
+  [ recursive_grammars ~ctxt ~loc ~tags_of_doc_comments recursive
+  ; nonrecursive_grammars ~ctxt ~loc ~tags_of_doc_comments nonrecursive
+  ]
+  |> List.concat
+;;
+
+let sig_type_decl ~ctxt:_ (_rec_flag, tds) =
+  List.map tds ~f:(fun td ->
+    let loc = td.ptype_loc in
+    value_description
+      ~loc
+      ~name:(Loc.map td.ptype_name ~f:grammar_name)
+      ~type_:(combinator_type_of_type_declaration td ~f:grammar_type)
+      ~prim:[]
+    |> psig_value ~loc)
+;;
+
+let extension_loc ~ctxt =
+  let loc = Expansion_context.Extension.extension_point_loc ctxt in
+  { loc with loc_ghost = true }
+;;
+
+let core_type ~tags_of_doc_comments ~ctxt core_type =
+  let loc = extension_loc ~ctxt in
+  pexp_constraint
+    ~loc
+    (core_type
+     |> grammar_of_type ~rec_flag:Nonrecursive ~tags_of_doc_comments
+     |> typed_grammar ~loc)
+    (core_type |> grammar_type ~loc)
+  |> Merlin_helpers.hide_expression
+;;
+
+let type_extension ~ctxt core_type =
+  assert_no_attributes_in#core_type core_type;
+  let loc = extension_loc ~ctxt in
+  core_type |> grammar_type ~loc
+;;

unikernel/duniverse/ppx_sexp_conv/expander/ppx_sexp_conv_grammar.mli

@@ -0,0 +1,21 @@
+open! Base
+open! Ppxlib
+
+val type_extension : ctxt:Expansion_context.Extension.t -> core_type -> core_type
+
+val core_type
+  :  tags_of_doc_comments:bool
+  -> ctxt:Expansion_context.Extension.t
+  -> core_type
+  -> expression
+
+val sig_type_decl
+  :  ctxt:Expansion_context.Deriver.t
+  -> rec_flag * type_declaration list
+  -> signature
+
+val str_type_decl
+  :  ctxt:Expansion_context.Deriver.t
+  -> rec_flag * type_declaration list
+  -> bool (** [true] means capture doc comments as tags *)
+  -> structure

unikernel/duniverse/ppx_sexp_conv/expander/record_field_attrs.ml

@@ -0,0 +1,133 @@
+open! Base
+open! Ppxlib
+open Attrs
+
+module Generic = struct
+  type 'specific t =
+    | Omit_nil
+    | Sexp_array of core_type
+    | Sexp_bool
+    | Sexp_list of core_type
+    | Sexp_option of core_type
+    | Specific of 'specific
+end
+
+open Generic
+
+let get_attribute attr ld ~f =
+  Option.map (Attribute.get attr ld) ~f:(fun x -> f x, Attribute.name attr)
+;;
+
+let create ~loc specific_getters ld ~if_no_attribute =
+  let generic_getters =
+    [ get_attribute omit_nil ~f:(fun () -> Omit_nil)
+    ; (fun ld ->
+        match ld.pld_type with
+        | ty when Option.is_some (Attribute.get bool ld) ->
+          (match ty with
+           | [%type: bool] -> Some (Sexp_bool, "[@sexp.bool]")
+           | _ -> invalid_attribute ~loc bool "bool")
+        | ty when Option.is_some (Attribute.get option ld) ->
+          (match ty with
+           | [%type: [%t? ty] option] -> Some (Sexp_option ty, "[@sexp.option]")
+           | _ -> invalid_attribute ~loc option "_ option")
+        | ty when Option.is_some (Attribute.get list ld) ->
+          (match ty with
+           | [%type: [%t? ty] list] -> Some (Sexp_list ty, "[@sexp.list]")
+           | _ -> invalid_attribute ~loc list "_ list")
+        | ty when Option.is_some (Attribute.get array ld) ->
+          (match ty with
+           | [%type: [%t? ty] array] -> Some (Sexp_array ty, "[@sexp.array]")
+           | _ -> invalid_attribute ~loc array "_ array")
+        | _ -> None)
+    ]
+  in
+  let getters =
+    let wrapped_getters =
+      List.map specific_getters ~f:(fun get ld ->
+        Option.map (get ld) ~f:(fun (specific, string) -> Specific specific, string))
+    in
+    List.concat [ wrapped_getters; generic_getters ]
+  in
+  match List.filter_map getters ~f:(fun f -> f ld) with
+  | [] -> Specific if_no_attribute
+  | [ (v, _) ] -> v
+  | _ :: _ :: _ as attributes ->
+    Location.raise_errorf
+      ~loc
+      "The following elements are mutually exclusive: %s"
+      (String.concat ~sep:" " (List.map attributes ~f:snd))
+;;
+
+let strip_attributes =
+  object
+    inherit Ast_traverse.map
+    method! attributes _ = []
+  end
+;;
+
+let lift_default ~loc ld expr =
+  let ty = strip_attributes#core_type ld.pld_type in
+  Lifted.create ~loc ~prefix:"default" ~ty expr
+;;
+
+let lift_drop_default ~loc ld expr =
+  let ty = strip_attributes#core_type ld.pld_type in
+  Lifted.create
+    ~loc
+    ~prefix:"drop_default"
+    ~ty:[%type: [%t ty] -> [%t ty] -> Stdlib.Bool.t]
+    expr
+;;
+
+let lift_drop_if ~loc ld expr =
+  let ty = strip_attributes#core_type ld.pld_type in
+  Lifted.create ~loc ~prefix:"drop_if" ~ty:[%type: [%t ty] -> Stdlib.Bool.t] expr
+;;
+
+module Of_sexp = struct
+  type t =
+    | Default of expression Lifted.t
+    | Required
+
+  let create ~loc ld =
+    create
+      ~loc
+      [ get_attribute default ~f:(fun { to_lift = default } ->
+          Default (lift_default ~loc ld default))
+      ]
+      ld
+      ~if_no_attribute:Required
+  ;;
+end
+
+module Sexp_of = struct
+  module Drop = struct
+    type t =
+      | No_arg
+      | Compare
+      | Equal
+      | Sexp
+      | Func of expression Lifted.t
+  end
+
+  type t =
+    | Drop_default of Drop.t
+    | Drop_if of expression Lifted.t
+    | Keep
+
+  let create ~loc ld =
+    create
+      ~loc
+      [ get_attribute drop_default ~f:(function
+          | None -> Drop_default No_arg
+          | Some { to_lift = e } -> Drop_default (Func (lift_drop_default ~loc ld e)))
+      ; get_attribute drop_default_equal ~f:(fun () -> Drop_default Equal)
+      ; get_attribute drop_default_compare ~f:(fun () -> Drop_default Compare)
+      ; get_attribute drop_default_sexp ~f:(fun () -> Drop_default Sexp)
+      ; get_attribute drop_if ~f:(fun { to_lift = x } -> Drop_if (lift_drop_if ~loc ld x))
+      ]
+      ld
+      ~if_no_attribute:Keep
+  ;;
+end

unikernel/duniverse/ppx_sexp_conv/expander/record_field_attrs.mli

@@ -0,0 +1,41 @@
+open! Base
+open! Ppxlib
+
+module Generic : sig
+  type 'specific t =
+    | Omit_nil
+    | Sexp_array of core_type
+    | Sexp_bool
+    | Sexp_list of core_type
+    | Sexp_option of core_type
+    | Specific of 'specific
+end
+
+module Of_sexp : sig
+  type t =
+    | Default of expression Lifted.t
+    | Required
+
+  val create : loc:Location.t -> label_declaration -> t Generic.t
+end
+
+module Sexp_of : sig
+  module Drop : sig
+    type t =
+      | No_arg
+      | Compare
+      | Equal
+      | Sexp
+      | Func of expression Lifted.t
+  end
+
+  type t =
+    | Drop_default of Drop.t
+    | Drop_if of expression Lifted.t
+    | Keep
+
+  val create : loc:Location.t -> label_declaration -> t Generic.t
+end
+
+(** Lift the contents of [Attrs.default]. *)
+val lift_default : loc:location -> label_declaration -> expression -> expression Lifted.t

unikernel/duniverse/ppx_sexp_conv/expander/renaming.ml

@@ -0,0 +1,120 @@
+open! Base
+open! Ppxlib
+
+type t =
+  { universal : (Fresh_name.t, string loc) Result.t Map.M(String).t
+  ; existential : bool
+  }
+
+module Binding_kind = struct
+  type t =
+    | Universally_bound of Fresh_name.t
+    | Existentially_bound
+end
+
+let add_universally_bound t name ~prefix =
+  { t with
+    universal =
+      Map.set
+        t.universal
+        ~key:name.txt
+        ~data:(Ok (Fresh_name.create (prefix ^ name.txt) ~loc:name.loc))
+  }
+;;
+
+let binding_kind t var ~loc =
+  match Map.find t.universal var with
+  | None ->
+    if t.existential
+    then Binding_kind.Existentially_bound
+    else Location.raise_errorf ~loc "ppx_sexp_conv: unbound type variable '%s" var
+  | Some (Ok fresh) -> Binding_kind.Universally_bound fresh
+  | Some (Error { loc; txt }) -> Location.raise_errorf ~loc "%s" txt
+;;
+
+(* Return a map translating type variables appearing in the return type of a GADT
+   constructor to their name in the type parameter list.
+
+   For instance:
+
+   {[
+     type ('a, 'b) t = X : 'x * 'y -> ('x, 'y) t
+   ]}
+
+   will produce:
+
+   {v
+     "x" -> Ok "a"
+     "y" -> Ok "b"
+   v}
+
+   If a variable appears twice in the return type it will map to [Error _]. If a
+   variable cannot be mapped to a parameter of the type declaration, it will map to
+   [Error] (for instance [A : 'a -> 'a list t]).
+
+   It returns [original] on user error, to let the typer give the error message *)
+let with_constructor_declaration original cd ~type_parameters:tps =
+  (* Add all type variables of a type to a map. *)
+  let add_typevars =
+    object
+      inherit [t] Ast_traverse.fold as super
+
+      method! core_type ty t =
+        match ty.ptyp_desc with
+        | Ptyp_var var ->
+          let error =
+            { loc = ty.ptyp_loc
+            ; txt = "ppx_sexp_conv: variable is not a parameter of the type constructor"
+            }
+          in
+          { t with universal = Map.set t.universal ~key:var ~data:(Error error) }
+        | _ -> super#core_type ty t
+    end
+  in
+  let aux t tp_name tp_in_return_type =
+    match tp_in_return_type.ptyp_desc with
+    | Ptyp_var var ->
+      let data =
+        let loc = tp_in_return_type.ptyp_loc in
+        if Map.mem t.universal var
+        then Error { loc; txt = "ppx_sexp_conv: duplicate variable" }
+        else (
+          match Map.find original.universal tp_name with
+          | Some result -> result
+          | None -> Error { loc; txt = "ppx_sexp_conv: unbound type parameter" })
+      in
+      { t with universal = Map.set t.universal ~key:var ~data }
+    | _ -> add_typevars#core_type tp_in_return_type t
+  in
+  match cd.pcd_res with
+  | None -> original
+  | Some ty ->
+    (match ty.ptyp_desc with
+     | Ptyp_constr (_, params) ->
+       if List.length params <> List.length tps
+       then original
+       else
+         Stdlib.ListLabels.fold_left2
+           tps
+           params
+           ~init:{ existential = true; universal = Map.empty (module String) }
+           ~f:aux
+     | _ -> original)
+;;
+
+let of_type_declaration decl ~prefix =
+  { existential = false
+  ; universal =
+      List.fold
+        decl.ptype_params
+        ~init:(Map.empty (module String))
+        ~f:(fun map param ->
+          let name = get_type_param_name param in
+          Map.update map name.txt ~f:(function
+            | None -> Ok (Fresh_name.create (prefix ^ name.txt) ~loc:name.loc)
+            | Some _ ->
+              Error { loc = name.loc; txt = "ppx_sexp_conv: duplicate variable" }))
+  }
+;;
+
+let without_type () = { existential = false; universal = Map.empty (module String) }

unikernel/duniverse/ppx_sexp_conv/expander/renaming.mli

@@ -0,0 +1,52 @@
+(* A renaming is a mapping from type variable name to type variable name.
+   In definitions such as:
+
+   type 'a t =
+   | A : <type> -> 'b t
+   | B of 'a
+
+   we generate a function that takes an sexp_of parameter named after 'a, but 'a is not in
+   scope in <type> when handling the constructor A (because A is a gadt constructor).
+   Instead the type variables in scope are the ones defined in the return type of A,
+   namely 'b. There could be less or more type variable in cases such as:
+
+   type _ less = Less : int less
+   type _ more = More : ('a * 'a) more
+
+   If for instance, <type> is ['b * 'c], when we find 'b, we will look for ['b] in the
+   renaming and find ['a] (only in that gadt branch, it could be something else in other
+   branches), at which point we can call the previously bound sexp_of parameter named
+   after 'a.
+   If we can't find a resulting name, like when looking up ['c] in the renaming, then we
+   assume the variable is existentially quantified and treat it as [_] (which is ok,
+   assuming there are no constraints). *)
+open! Base
+open! Ppxlib
+
+type t
+
+(** Renaming for contexts outside a type declaration, such as expression extensions. *)
+val without_type : unit -> t
+
+(** Renaming for a type declaration. Adds [prefix] to bindings for type parameters. *)
+val of_type_declaration : type_declaration -> prefix:string -> t
+
+(** Adds a new name with the given [prefix] for a universally bound type variable. *)
+val add_universally_bound : t -> string loc -> prefix:string -> t
+
+module Binding_kind : sig
+  type t =
+    | Universally_bound of Fresh_name.t
+    | Existentially_bound
+end
+
+(** Looks up the binding for a type variable. *)
+val binding_kind : t -> string -> loc:location -> Binding_kind.t
+
+(** Extends the renaming of a type declaration with GADT context for a constructor
+    declaration, if any. *)
+val with_constructor_declaration
+  :  t
+  -> constructor_declaration
+  -> type_parameters:string list
+  -> t

unikernel/duniverse/ppx_sexp_conv/ppx_sexp_conv.opam

@@ -0,0 +1,25 @@
+opam-version: "2.0"
+version: "v0.17.1"
+maintainer: "Jane Street developers"
+authors: ["Jane Street Group, LLC"]
+homepage: "https://github.com/janestreet/ppx_sexp_conv"
+bug-reports: "https://github.com/janestreet/ppx_sexp_conv/issues"
+dev-repo: "git+https://github.com/janestreet/ppx_sexp_conv.git"
+doc: "https://ocaml.janestreet.com/ocaml-core/latest/doc/ppx_sexp_conv/index.html"
+license: "MIT"
+build: [
+  ["dune" "build" "-p" name "-j" jobs]
+]
+depends: [
+  "ocaml"       {>= "5.1.0"}
+  "base"        {>= "v0.17" & < "v0.18"}
+  "ppxlib_jane" {>= "v0.17" & < "v0.18"}
+  "sexplib0"    {>= "v0.17" & < "v0.18"}
+  "dune"        {>= "3.11.0"}
+  "ppxlib"      {>= "0.36.0"}
+]
+available: arch != "arm32" & arch != "x86_32"
+synopsis: "[@@deriving] plugin to generate S-expression conversion functions"
+description: "
+Part of the Jane Street's PPX rewriters collection.
+"

unikernel/duniverse/ppx_sexp_conv/runtime-lib/dune

@@ -0,0 +1,5 @@
+(library
+ (name ppx_sexp_conv_lib)
+ (public_name ppx_sexp_conv.runtime-lib)
+ (libraries sexplib0)
+ (preprocess no_preprocessing))

unikernel/duniverse/ppx_sexp_conv/runtime-lib/ppx_sexp_conv_lib.ml

@@ -0,0 +1,11 @@
+module Conv = Sexplib0.Sexp_conv
+module Conv_error = Sexplib0.Sexp_conv_error
+module Sexp_grammar = Sexplib0.Sexp_grammar
+
+module Sexp = struct
+  include Sexplib0.Sexp
+
+  let t_sexp_grammar = Conv.sexp_t_sexp_grammar
+end
+
+module Sexpable = Sexplib0.Sexpable

unikernel/duniverse/ppx_sexp_conv/src/dune

@@ -0,0 +1,6 @@
+(library
+ (name ppx_sexp_conv)
+ (public_name ppx_sexp_conv)
+ (kind ppx_deriver)
+ (libraries ppxlib ppx_sexp_conv_expander)
+ (preprocess no_preprocessing))

unikernel/duniverse/ppx_sexp_conv/src/ppx_sexp_conv.ml

@@ -0,0 +1,155 @@
+(* sexp_conv: Preprocessing Module for Automated S-expression Conversions *)
+
+open Ppxlib
+module Attrs = Ppx_sexp_conv_expander.Attrs
+
+let register_extension name f =
+  let extension = Extension.declare name Expression Ast_pattern.(ptyp __) f in
+  Driver.register_transformation
+    ("Ppxlib.Deriving." ^ name)
+    ~rules:[ Context_free.Rule.extension extension ]
+;;
+
+module Sexp_grammar = struct
+  module E = Ppx_sexp_conv_expander.Sexp_grammar
+
+  let name = "sexp_grammar"
+  let flags = Deriving.Args.(empty +> flag "tags_of_doc_comments")
+  let str_type_decl = Deriving.Generator.V2.make flags E.str_type_decl
+  let sig_type_decl = Deriving.Generator.V2.make_noarg E.sig_type_decl
+  let deriver = Deriving.add name ~sig_type_decl ~str_type_decl
+
+  (* We default to [tags_of_doc_comments=true] in this case, because doc comments in a
+     [%sexp_grammar] expression have no other purpose. *)
+  let expr_extension =
+    Extension.V3.declare
+      name
+      Expression
+      Ast_pattern.(ptyp __)
+      (E.core_type ~tags_of_doc_comments:true)
+  ;;
+
+  let type_extension =
+    Extension.V3.declare name Core_type Ast_pattern.(ptyp __) E.type_extension
+  ;;
+
+  let () =
+    Driver.register_transformation
+      "Ppxlib.Deriving.sexp_grammar"
+      ~rules:
+        [ Context_free.Rule.extension expr_extension
+        ; Context_free.Rule.extension type_extension
+        ]
+  ;;
+end
+
+module Sexp_of = struct
+  module E = Ppx_sexp_conv_expander.Sexp_of
+
+  let name = "sexp_of"
+
+  let str_type_decl =
+    Deriving.Generator.make_noarg
+      E.str_type_decl
+      ~attributes:
+        [ Attribute.T Attrs.default
+        ; Attribute.T Attrs.drop_default
+        ; Attribute.T Attrs.drop_if
+        ]
+  ;;
+
+  let str_exception = Deriving.Generator.make_noarg E.str_exception
+  let sig_type_decl = Deriving.Generator.make_noarg E.sig_type_decl
+  let sig_exception = Deriving.Generator.make_noarg E.sig_exception
+
+  let deriver =
+    Deriving.add name ~str_type_decl ~str_exception ~sig_type_decl ~sig_exception
+  ;;
+
+  let extension ~loc:_ ~path:_ ctyp = E.core_type ctyp
+  let () = register_extension name extension
+
+  let () =
+    Driver.register_transformation
+      name
+      ~rules:
+        [ Context_free.Rule.extension
+            (Extension.declare
+               name
+               Core_type
+               Ast_pattern.(ptyp __)
+               (fun ~loc:_ ~path:_ ty -> E.type_extension ty))
+        ]
+  ;;
+end
+
+module Of_sexp = struct
+  module E = Ppx_sexp_conv_expander.Of_sexp
+
+  let name = "of_sexp"
+
+  let str_type_decl =
+    Deriving.Generator.make_noarg
+      (E.str_type_decl ~poly:false)
+      ~attributes:[ Attribute.T Attrs.default ]
+  ;;
+
+  let sig_type_decl = Deriving.Generator.make_noarg (E.sig_type_decl ~poly:false)
+  let deriver = Deriving.add name ~str_type_decl ~sig_type_decl
+  let extension ~loc:_ ~path ctyp = E.core_type ~path ctyp
+  let () = register_extension name extension
+
+  let () =
+    Driver.register_transformation
+      name
+      ~rules:
+        [ Context_free.Rule.extension
+            (Extension.declare
+               name
+               Core_type
+               Ast_pattern.(ptyp __)
+               (fun ~loc:_ ~path:_ ty -> E.type_extension ty))
+        ]
+  ;;
+end
+
+module Of_sexp_poly = struct
+  module E = Ppx_sexp_conv_expander.Of_sexp
+
+  let str_type_decl =
+    Deriving.Generator.make_noarg
+      (E.str_type_decl ~poly:true)
+      ~attributes:[ Attribute.T Attrs.default ]
+  ;;
+
+  let sig_type_decl = Deriving.Generator.make_noarg (E.sig_type_decl ~poly:true)
+  let deriver = Deriving.add "of_sexp_poly" ~sig_type_decl ~str_type_decl
+end
+
+let sexp_of = Sexp_of.deriver
+let of_sexp = Of_sexp.deriver
+let of_sexp_poly = Of_sexp_poly.deriver
+let sexp_grammar = Sexp_grammar.deriver
+
+module Sexp_in_sig = struct
+  module E = Ppx_sexp_conv_expander.Sig_sexp
+
+  let sig_type_decl = Deriving.Generator.make_noarg E.sig_type_decl
+
+  let deriver =
+    Deriving.add
+      "ppx_sexp_conv: let this be a string that wouldn't parse if put in the source"
+      ~sig_type_decl
+  ;;
+end
+
+let sexp =
+  Deriving.add_alias
+    "sexp"
+    [ sexp_of; of_sexp ]
+    ~sig_type_decl:[ Sexp_in_sig.deriver ]
+    ~str_exception:[ sexp_of ]
+    ~sig_exception:[ sexp_of ]
+;;
+
+let sexp_poly = Deriving.add_alias "sexp_poly" [ sexp_of; of_sexp_poly ]

unikernel/duniverse/ppx_sexp_conv/src/ppx_sexp_conv.mli

@@ -0,0 +1,8 @@
+open Ppxlib
+
+val of_sexp : Deriving.t
+val sexp_of : Deriving.t
+val sexp : Deriving.t
+val of_sexp_poly : Deriving.t
+val sexp_poly : Deriving.t
+val sexp_grammar : Deriving.t

unikernel/duniverse/ppx_sexp_conv/test/dune

@@ -0,0 +1,6 @@
+(library
+ (name ppx_sexp_conv_test)
+ (libraries base expect_test_helpers_core sexplib)
+ (flags :standard -w -30)
+ (preprocess
+  (pps ppxlib ppx_sexp_conv ppx_compare ppx_here ppx_inline_test ppx_expect)))

unikernel/duniverse/ppx_sexp_conv/test/errors.mlt

@@ -0,0 +1,284 @@
+type t = { a : int [@sexp_drop_default] [@sexp.omit_nil] } [@@deriving sexp_of]
+
+[%%expect
+  {|
+Line _, characters _-_:
+Error: The following elements are mutually exclusive: sexp.sexp_drop_default sexp.omit_nil
+|}]
+
+type t = { a : int list [@sexp.list] [@sexp.omit_nil] } [@@deriving sexp_of]
+
+[%%expect
+  {|
+Line _, characters _-_:
+Error: The following elements are mutually exclusive: sexp.omit_nil [@sexp.list]
+|}]
+
+type t = { a : int [@default 0] [@sexp.omit_nil] } [@@deriving of_sexp]
+
+[%%expect
+  {|
+Line _, characters _-_:
+Error: The following elements are mutually exclusive: sexp.default sexp.omit_nil
+|}]
+
+type t = int [@@deriving sexp] [@@sexp.allow_extra_fields]
+
+[%%expect
+  {|
+Line _, characters _-_:
+Error: ppx_sexp_conv: [@@allow_extra_fields] is only allowed on records.
+|}]
+
+type 'a t = 'a option =
+  | None
+  | Some of 'a
+[@@deriving sexp] [@@sexp.allow_extra_fields]
+
+[%%expect
+  {|
+Line _, characters _-_:
+Error: ppx_sexp_conv: [@@allow_extra_fields] is only allowed on records.
+|}]
+
+type 'a t = Some of { a : int } [@@deriving sexp] [@@sexp.allow_extra_fields]
+
+[%%expect
+  {|
+Line _, characters _-_:
+Error: ppx_sexp_conv: [@@allow_extra_fields] only works on records. For inline records, do: type t = A of { a : int } [@allow_extra_fields] | B [@@deriving sexp]
+|}]
+
+type 'a t =
+  | Some of { a : int }
+  | None [@sexp.allow_extra_fields]
+[@@deriving sexp]
+
+[%%expect
+  {|
+Line _, characters _-_:
+Error: ppx_sexp_conv: [@allow_extra_fields] is only allowed on inline records.
+|}]
+
+type t =
+  | Non
+  | Som of { next : t [@default Non] [@sexp_drop_default.equal] }
+[@@deriving sexp]
+
+[%%expect
+  {|
+Line _, characters _-_:
+Error: [@sexp_drop_default.equal] was used, but the type of the field contains a type defined in the current recursive block: t.
+This is not supported.
+Consider using [@sexp_drop_if _] or [@sexp_drop_default.sexp] instead.
+|}]
+
+type nonrec 'a t = { foo : 'a option [@default None] [@sexp_drop_default.equal] }
+[@@deriving sexp]
+
+[%%expect
+  {|
+Line _, characters _-_:
+Error: [@sexp_drop_default.equal] was used, but the type of the field contains a type variable: 'a.
+Comparison is not avaiable for type variables.
+Consider using [@sexp_drop_if _] or [@sexp_drop_default.sexp] instead.
+|}]
+
+open Base
+
+type t = { a : int [@default 8] [@sexp_drop_default] } [@@deriving sexp_of]
+
+[%%expect
+  {|
+Line _, characters _-_:
+Error (warning 22 [preprocessor]): [@sexp_drop_default] is deprecated: please use one of:
+- [@sexp_drop_default f] and give an explicit equality function ([f = Poly.(=)] corresponds to the old behavior)
+- [@sexp_drop_default.compare] if the type supports [%compare]
+- [@sexp_drop_default.equal] if the type supports [%equal]
+- [@sexp_drop_default.sexp] if you want to compare the sexp representations
+|}]
+
+type t = { x : unit [@sexp.opaque] } [@@deriving sexp_of]
+type t = { x : unit [@sexp.opaque] } [@@deriving of_sexp]
+type t = { x : unit [@sexp.opaque] } [@@deriving sexp_grammar]
+
+[%%expect
+  {|
+Line _, characters _-_:
+Error: Attribute `sexp.opaque' was not used.
+       Hint: `sexp.opaque' is available for core types but is used here in
+       the
+       context of a label declaration.
+       Did you put it at the wrong level?
+
+Line _, characters _-_:
+Error: Attribute `sexp.opaque' was not used.
+       Hint: `sexp.opaque' is available for core types but is used here in
+       the
+       context of a label declaration.
+       Did you put it at the wrong level?
+
+Line _, characters _-_:
+Error: Attribute `sexp.opaque' was not used.
+       Hint: `sexp.opaque' is available for core types but is used here in
+       the
+       context of a label declaration.
+       Did you put it at the wrong level?
+|}]
+
+type t = { x : unit [@sexp.option] } [@@deriving sexp_of]
+type t = { x : unit [@sexp.option] } [@@deriving of_sexp]
+type t = { x : unit [@sexp.option] } [@@deriving sexp_grammar]
+
+[%%expect
+  {|
+Line _, characters _-_:
+Error: ppx_sexp_conv: [@sexp.option] is only allowed on type [_ option].
+
+Line _, characters _-_:
+Error: ppx_sexp_conv: [@sexp.option] is only allowed on type [_ option].
+
+Line _, characters _-_:
+Error: ppx_sexp_conv: [@sexp.option] is only allowed on type [_ option].
+|}]
+
+type t = { x : unit [@sexp.list] } [@@deriving sexp_of]
+type t = { x : unit [@sexp.list] } [@@deriving of_sexp]
+type t = { x : unit [@sexp.list] } [@@deriving sexp_grammar]
+
+[%%expect
+  {|
+Line _, characters _-_:
+Error: ppx_sexp_conv: [@sexp.list] is only allowed on type [_ list].
+
+Line _, characters _-_:
+Error: ppx_sexp_conv: [@sexp.list] is only allowed on type [_ list].
+
+Line _, characters _-_:
+Error: ppx_sexp_conv: [@sexp.list] is only allowed on type [_ list].
+|}]
+
+type t = { x : unit [@sexp.array] } [@@deriving sexp_of]
+type t = { x : unit [@sexp.array] } [@@deriving of_sexp]
+type t = { x : unit [@sexp.array] } [@@deriving sexp_grammar]
+
+[%%expect
+  {|
+Line _, characters _-_:
+Error: ppx_sexp_conv: [@sexp.array] is only allowed on type [_ array].
+
+Line _, characters _-_:
+Error: ppx_sexp_conv: [@sexp.array] is only allowed on type [_ array].
+
+Line _, characters _-_:
+Error: ppx_sexp_conv: [@sexp.array] is only allowed on type [_ array].
+|}]
+
+type t = { x : unit [@sexp.bool] } [@@deriving sexp_of]
+type t = { x : unit [@sexp.bool] } [@@deriving of_sexp]
+type t = { x : unit [@sexp.bool] } [@@deriving sexp_grammar]
+
+[%%expect
+  {|
+Line _, characters _-_:
+Error: ppx_sexp_conv: [@sexp.bool] is only allowed on type [bool].
+
+Line _, characters _-_:
+Error: ppx_sexp_conv: [@sexp.bool] is only allowed on type [bool].
+
+Line _, characters _-_:
+Error: ppx_sexp_conv: [@sexp.bool] is only allowed on type [bool].
+|}]
+
+type t = A of unit [@sexp.list] [@@deriving sexp_of]
+type t = A of unit [@sexp.list] [@@deriving of_sexp]
+type t = A of unit [@sexp.list] [@@deriving sexp_grammar]
+
+[%%expect
+  {|
+Line _, characters _-_:
+Error: ppx_sexp_conv: [@sexp.list] is only allowed on type [_ list].
+
+Line _, characters _-_:
+Error: ppx_sexp_conv: [@sexp.list] is only allowed on type [_ list].
+
+Line _, characters _-_:
+Error: ppx_sexp_conv: [@sexp.list] is only allowed on type [_ list].
+|}]
+
+type t = [ `A of unit [@sexp.list] ] [@@deriving sexp_of]
+type t = [ `A of unit [@sexp.list] ] [@@deriving of_sexp]
+type t = [ `A of unit [@sexp.list] ] [@@deriving sexp_grammar]
+
+[%%expect
+  {|
+Line _, characters _-_:
+Error: ppx_sexp_conv: [@sexp.list] is only allowed on type [_ list].
+
+Line _, characters _-_:
+Error: ppx_sexp_conv: [@sexp.list] is only allowed on type [_ list].
+
+Line _, characters _-_:
+Error: ppx_sexp_conv: [@sexp.list] is only allowed on type [_ list].
+|}]
+
+let (_ : _) = [%sexp_grammar: 'k -> 'v -> ('k * 'v) list]
+
+[%%expect {| |}]
+
+let (_ : _) = [%sexp_grammar: < for_all : 'k 'v. ('k * 'v) list > ]
+
+[%%expect
+  {|
+Line _, characters _-_:
+Error: sexp_grammar: object types are unsupported
+|}]
+
+let (_ : _) = [%sexp_grammar: < other : 'k 'v. ('k * 'v) list > ]
+
+[%%expect
+  {|
+Line _, characters _-_:
+Error: sexp_grammar: object types are unsupported
+|}]
+
+type t = < for_all : 'k 'v. ('k * 'v) list > [@@deriving sexp_grammar]
+
+[%%expect
+  {|
+Line _, characters _-_:
+Error: sexp_grammar: object types are unsupported
+|}]
+
+type t = < other : 'k 'v. ('k * 'v) list > [@@deriving sexp_grammar]
+
+[%%expect
+  {|
+Line _, characters _-_:
+Error: sexp_grammar: object types are unsupported
+|}]
+
+type t = T : 'a -> t [@@deriving sexp_grammar]
+
+[%%expect
+  {|
+Line _, characters _-_:
+Error: Unbound value _'a_sexp_grammar
+Hint: Did you mean char_sexp_grammar, int_sexp_grammar or ref_sexp_grammar?
+|}]
+
+(* If we can sensibly derive [sexp_grammar], we might as well, because the user might
+   still be able to pair it with a consistent hand-written [t_of_sexp]. *)
+type _ t = T : int -> string t [@@deriving sexp_grammar]
+
+[%%expect {| |}]
+
+type _ t = T : int -> string t [@@deriving of_sexp]
+
+[%%expect
+  {|
+Line _, characters _-_:
+Error: This expression has type string t
+       but an expression was expected of type a__098_ t
+       Type string is not compatible with type a__098_
+|}]

unikernel/duniverse/ppx_sexp_conv/test/examples.mlt

@@ -0,0 +1,67 @@
+module Position_for_polymorphic_variant_errors = struct
+  type t1 = [ `A ] [@@deriving of_sexp]
+  type t2 = [ `B ] [@@deriving of_sexp]
+  type t3 = A of [ t1 | t2 ] [@@deriving of_sexp]
+
+  let (_ : t3) = t3_of_sexp (List [ Atom "A"; Atom "C" ])
+end
+
+[%%expect
+  {|
+Exception:
+(Of_sexp_error
+  "examples.mlt.Position_for_polymorphic_variant_errors.t3_of_sexp: no matching variant found"
+  (invalid_sexp C))
+|}]
+
+let _ = [%sexp_of: 'a]
+
+[%%expect
+  {|
+Line _, characters _-_:
+Error: ppx_sexp_conv: unbound type variable 'a
+|}]
+
+let _ = [%of_sexp: 'a]
+
+[%%expect
+  {|
+Line _, characters _-_:
+Error: ppx_sexp_conv: unbound type variable 'a
+|}]
+
+let _ = [%sexp (() : 'a)]
+
+[%%expect
+  {|
+Line _, characters _-_:
+Error: ppx_sexp_conv: unbound type variable 'a
+|}]
+
+type 'a t =
+  | None
+  | Something_else of { value : 'a }
+[@@deriving sexp]
+
+[%%expect {| |}]
+
+module Record_with_defaults = struct
+  open Sexplib0.Sexp_conv
+
+  let a_field = "a_field"
+  let b_field = "b_field"
+
+  type record_with_defaults =
+    { a : string [@default a_field]
+    ; b : string [@default b_field]
+    }
+  [@@deriving of_sexp]
+end
+
+[%%expect {| |}]
+
+module Polymorphic_recursion = struct
+  type 'a t = T of 'a t t [@@deriving sexp_grammar]
+end
+
+[%%expect {| |}]

unikernel/duniverse/ppx_sexp_conv/test/expansion.mli

@@ -0,0 +1,450 @@
+open! Base
+
+module Abstract : sig
+  type t [@@deriving_inline sexp]
+
+  include sig
+    [@@@ocaml.warning "-32"]
+
+    include Sexplib0.Sexpable.S with type t := t
+  end
+  [@@ocaml.doc "@inline"]
+
+  [@@@end]
+end
+
+module Tuple : sig
+  type t = int * int * int [@@deriving_inline sexp]
+
+  include sig
+    [@@@ocaml.warning "-32"]
+
+    include Sexplib0.Sexpable.S with type t := t
+  end
+  [@@ocaml.doc "@inline"]
+
+  [@@@end]
+end
+
+module Record : sig
+  type t =
+    { a : int
+    ; b : int
+    ; c : int
+    }
+  [@@deriving_inline sexp]
+
+  include sig
+    [@@@ocaml.warning "-32"]
+
+    include Sexplib0.Sexpable.S with type t := t
+  end
+  [@@ocaml.doc "@inline"]
+
+  [@@@end]
+end
+
+module Mutable_record : sig
+  type t =
+    { mutable a : int
+    ; mutable b : int
+    ; mutable c : int
+    }
+  [@@deriving_inline sexp]
+
+  include sig
+    [@@@ocaml.warning "-32"]
+
+    include Sexplib0.Sexpable.S with type t := t
+  end
+  [@@ocaml.doc "@inline"]
+
+  [@@@end]
+end
+
+module Variant : sig
+  type t =
+    | A
+    | B of int * int
+    | C of
+        { a : int
+        ; b : int
+        ; d : int
+        }
+    | D of
+        { mutable a : int
+        ; mutable b : int
+        ; mutable t : int
+        }
+  [@@deriving_inline sexp]
+
+  include sig
+    [@@@ocaml.warning "-32"]
+
+    include Sexplib0.Sexpable.S with type t := t
+  end
+  [@@ocaml.doc "@inline"]
+
+  [@@@end]
+end
+
+module Poly_variant : sig
+  type t =
+    [ `A
+    | `B of int
+    ]
+  [@@deriving_inline sexp]
+
+  include sig
+    [@@@ocaml.warning "-32"]
+
+    val sexp_of_t : t -> Sexplib0.Sexp.t
+    val t_of_sexp : Sexplib0.Sexp.t -> t
+    val __t_of_sexp__ : Sexplib0.Sexp.t -> t
+  end
+  [@@ocaml.doc "@inline"]
+
+  [@@@end]
+end
+
+module Inline_poly_variant : sig
+  type t =
+    [ Poly_variant.t
+    | `C of int * int
+    ]
+  [@@deriving_inline sexp]
+
+  include sig
+    [@@@ocaml.warning "-32"]
+
+    val sexp_of_t : t -> Sexplib0.Sexp.t
+    val t_of_sexp : Sexplib0.Sexp.t -> t
+    val __t_of_sexp__ : Sexplib0.Sexp.t -> t
+  end
+  [@@ocaml.doc "@inline"]
+
+  [@@@end]
+end
+
+module Recursive : sig
+  type t =
+    | Banana of t
+    | Orange
+  [@@deriving_inline sexp]
+
+  include sig
+    [@@@ocaml.warning "-32"]
+
+    include Sexplib0.Sexpable.S with type t := t
+  end
+  [@@ocaml.doc "@inline"]
+
+  [@@@end]
+end
+
+module Nonrecursive : sig
+  open Recursive
+
+  type nonrec t = t [@@deriving_inline sexp]
+
+  include sig
+    [@@@ocaml.warning "-32"]
+
+    include Sexplib0.Sexpable.S with type t := t
+  end
+  [@@ocaml.doc "@inline"]
+
+  [@@@end]
+end
+
+module Mutually_recursive : sig
+  type a =
+    | A
+    | B of b
+    | C of
+        { a : a
+        ; b : b
+        ; c : c
+        }
+
+  and b =
+    { a : a
+    ; b : b
+    }
+
+  and c = a [@@deriving_inline sexp]
+
+  include sig
+    [@@@ocaml.warning "-32"]
+
+    val sexp_of_a : a -> Sexplib0.Sexp.t
+    val sexp_of_b : b -> Sexplib0.Sexp.t
+    val sexp_of_c : c -> Sexplib0.Sexp.t
+    val a_of_sexp : Sexplib0.Sexp.t -> a
+    val b_of_sexp : Sexplib0.Sexp.t -> b
+    val c_of_sexp : Sexplib0.Sexp.t -> c
+  end
+  [@@ocaml.doc "@inline"]
+
+  [@@@end]
+end
+
+module Alias : sig
+  type t = Recursive.t [@@deriving_inline sexp]
+
+  include sig
+    [@@@ocaml.warning "-32"]
+
+    include Sexplib0.Sexpable.S with type t := t
+  end
+  [@@ocaml.doc "@inline"]
+
+  [@@@end]
+end
+
+module Re_export : sig
+  type t = Recursive.t =
+    | Banana of t
+    | Orange
+  [@@deriving_inline sexp]
+
+  include sig
+    [@@@ocaml.warning "-32"]
+
+    include Sexplib0.Sexpable.S with type t := t
+  end
+  [@@ocaml.doc "@inline"]
+
+  [@@@end]
+end
+
+module Unary : sig
+  type 'a t = 'a list option [@@deriving_inline sexp]
+
+  include sig
+    [@@@ocaml.warning "-32"]
+
+    include Sexplib0.Sexpable.S1 with type 'a t := 'a t
+  end
+  [@@ocaml.doc "@inline"]
+
+  [@@@end]
+end
+
+module Binary : sig
+  type ('a, 'b) t = ('a, 'b) Either.t [@@deriving_inline sexp]
+
+  include sig
+    [@@@ocaml.warning "-32"]
+
+    include Sexplib0.Sexpable.S2 with type ('a, 'b) t := ('a, 'b) t
+  end
+  [@@ocaml.doc "@inline"]
+
+  [@@@end]
+end
+
+module First_order : sig
+  type 'a t = 'a -> 'a [@@deriving_inline sexp]
+
+  include sig
+    [@@@ocaml.warning "-32"]
+
+    include Sexplib0.Sexpable.S1 with type 'a t := 'a t
+  end
+  [@@ocaml.doc "@inline"]
+
+  [@@@end]
+end
+
+module Second_order : sig
+  type ('a, 'b) t = ('a -> 'a) -> ('a -> 'b) -> ('b -> 'b) -> 'a -> 'b
+  [@@deriving_inline sexp]
+
+  include sig
+    [@@@ocaml.warning "-32"]
+
+    include Sexplib0.Sexpable.S2 with type ('a, 'b) t := ('a, 'b) t
+  end
+  [@@ocaml.doc "@inline"]
+
+  [@@@end]
+end
+
+module Named_arguments : sig
+  type t = ?a:int -> b:int -> int -> int [@@deriving_inline sexp]
+
+  include sig
+    [@@@ocaml.warning "-32"]
+
+    include Sexplib0.Sexpable.S with type t := t
+  end
+  [@@ocaml.doc "@inline"]
+
+  [@@@end]
+end
+
+module Gadt : sig
+  type _ t =
+    | A : _ option t
+    | B : int -> int t
+    | C : 'a list -> unit t
+  [@@deriving_inline sexp_of]
+
+  include sig
+    [@@@ocaml.warning "-32"]
+
+    val sexp_of_t : ('a__001_ -> Sexplib0.Sexp.t) -> 'a__001_ t -> Sexplib0.Sexp.t
+  end
+  [@@ocaml.doc "@inline"]
+
+  [@@@end]
+end
+
+module Recursive_record_containing_variant : sig
+  type t =
+    { a : [ `A of t ]
+    ; b : [ `B ]
+    }
+  [@@deriving_inline sexp]
+
+  include sig
+    [@@@ocaml.warning "-32"]
+
+    include Sexplib0.Sexpable.S with type t := t
+  end
+  [@@ocaml.doc "@inline"]
+
+  [@@@end]
+end
+
+module Poly_record : sig
+  type t =
+    { a : 'a. 'a list
+    ; b : 'b. 'b option
+    ; c : 'c. 'c
+    }
+  [@@deriving_inline sexp]
+
+  include sig
+    [@@@ocaml.warning "-32"]
+
+    include Sexplib0.Sexpable.S with type t := t
+  end
+  [@@ocaml.doc "@inline"]
+
+  [@@@end]
+end
+
+module Record_with_defaults : sig
+  type t =
+    { a : int
+    ; b : int
+    ; c : int
+    ; d : int
+    ; e : int
+    ; f : int
+    }
+  [@@deriving_inline sexp]
+
+  include sig
+    [@@@ocaml.warning "-32"]
+
+    include Sexplib0.Sexpable.S with type t := t
+  end
+  [@@ocaml.doc "@inline"]
+
+  [@@@end]
+end
+
+module Record_with_special_types : sig
+  type t =
+    { a : int option
+    ; b : int list
+    ; c : int array
+    ; d : bool
+    }
+  [@@deriving_inline sexp]
+
+  include sig
+    [@@@ocaml.warning "-32"]
+
+    include Sexplib0.Sexpable.S with type t := t
+  end
+  [@@ocaml.doc "@inline"]
+
+  [@@@end]
+end
+
+module Record_with_omit_nil : sig
+  type t =
+    { a : int option
+    ; b : int list
+    ; c : unit
+    ; d : int
+    }
+  [@@deriving_inline sexp]
+
+  include sig
+    [@@@ocaml.warning "-32"]
+
+    include Sexplib0.Sexpable.S with type t := t
+  end
+  [@@ocaml.doc "@inline"]
+
+  [@@@end]
+end
+
+module Variant_with_sexp_list : sig
+  type t = A of int list [@@deriving_inline sexp]
+
+  include sig
+    [@@@ocaml.warning "-32"]
+
+    include Sexplib0.Sexpable.S with type t := t
+  end
+  [@@ocaml.doc "@inline"]
+
+  [@@@end]
+end
+
+module Poly_variant_with_sexp_list : sig
+  type t = [ `A of int list ] [@@deriving_inline sexp]
+
+  include sig
+    [@@@ocaml.warning "-32"]
+
+    val sexp_of_t : t -> Sexplib0.Sexp.t
+    val t_of_sexp : Sexplib0.Sexp.t -> t
+    val __t_of_sexp__ : Sexplib0.Sexp.t -> t
+  end
+  [@@ocaml.doc "@inline"]
+
+  [@@@end]
+end
+
+module Record_allowing_extra_fields : sig
+  type t = { a : int } [@@deriving_inline sexp]
+
+  include sig
+    [@@@ocaml.warning "-32"]
+
+    include Sexplib0.Sexpable.S with type t := t
+  end
+  [@@ocaml.doc "@inline"]
+
+  [@@@end]
+end
+
+module Opaque : sig
+  type t = int list [@@deriving_inline sexp]
+
+  include sig
+    [@@@ocaml.warning "-32"]
+
+    include Sexplib0.Sexpable.S with type t := t
+  end
+  [@@ocaml.doc "@inline"]
+
+  [@@@end]
+end

unikernel/duniverse/ppx_sexp_conv/test/lib/conv_test.ml

@@ -0,0 +1,63 @@
+open Ppx_sexp_conv_lib
+open Conv
+
+let%test_module "Exceptions" =
+  (module struct
+    let check_sexp exn string =
+      match sexp_of_exn_opt exn with
+      | None -> raise exn
+      | Some sexp ->
+        let sexp_as_string = Ppx_sexp_conv_lib.Sexp.to_string sexp in
+        if sexp_as_string <> string then failwith sexp_as_string
+    ;;
+
+    (* first global exceptions, checking different arities since they
+       don't have the same representation *)
+    exception Arg0 [@@deriving sexp]
+    exception Arg1 of int [@@deriving sexp]
+    exception Arg2 of int * int [@@deriving sexp]
+
+    let%test_unit _ = check_sexp Arg0 "conv_test.ml.Arg0"
+    let%test_unit _ = check_sexp (Arg1 1) "(conv_test.ml.Arg1 1)"
+    let%test_unit _ = check_sexp (Arg2 (2, 3)) "(conv_test.ml.Arg2 2 3)"
+
+    (* now local exceptions *)
+    let exn (type a) a sexp_of_a =
+      let module M = struct
+        exception E of a [@@deriving sexp]
+      end
+      in
+      M.E a
+    ;;
+
+    let%test_unit "incompatible exceptions with the same name" =
+      let e_int = exn 1 sexp_of_int in
+      let e_string = exn "a" sexp_of_string in
+      check_sexp e_int "(conv_test.ml.E 1)";
+      check_sexp e_string "(conv_test.ml.E a)"
+    ;;
+
+    let%test_unit "sexp converters are finalized properly for local exceptions" =
+      Gc.compact ();
+      Gc.compact ();
+      let size_before =
+        Ppx_sexp_conv_lib.Conv.Exn_converter.For_unit_tests_only.size ()
+      in
+      let e = exn 2.5 sexp_of_float in
+      let size_after_local_exn =
+        Ppx_sexp_conv_lib.Conv.Exn_converter.For_unit_tests_only.size ()
+      in
+      let e_finalized = ref false in
+      Gc.finalise (fun _ -> e_finalized := true) e;
+      check_sexp e "(conv_test.ml.E 2.5)";
+      Gc.compact ();
+      Gc.compact ();
+      assert !e_finalized;
+      let size_after_gc =
+        Ppx_sexp_conv_lib.Conv.Exn_converter.For_unit_tests_only.size ()
+      in
+      assert (size_before + 1 = size_after_local_exn);
+      assert (size_before = size_after_gc)
+    ;;
+  end)
+;;

unikernel/duniverse/ppx_sexp_conv/test/lib/conv_test.mli

@@ -0,0 +1 @@
+(*_ This signature is deliberately empty. *)

unikernel/duniverse/ppx_sexp_conv/test/lib/dune

@@ -0,0 +1,5 @@
+(library
+ (name ppx_sexp_conv_lib_test)
+ (libraries ppx_sexp_conv_lib)
+ (preprocess
+  (pps ppxlib ppx_sexp_conv ppx_here ppx_inline_test)))

unikernel/duniverse/ppx_sexp_conv/test/nonrec_test.ml

@@ -0,0 +1,118 @@
+open Ppx_sexp_conv_lib.Conv
+
+type t = float [@@deriving sexp]
+
+module M : sig
+  type t = float list [@@deriving sexp]
+end = struct
+  type nonrec t = t list [@@deriving sexp]
+end
+
+type 'a u = 'a [@@deriving sexp]
+
+module M2 : sig
+  type 'a u = 'a list [@@deriving sexp]
+end = struct
+  type nonrec 'a u = 'a u list [@@deriving sexp]
+end
+
+type 'a v = 'a w
+and 'a w = A of 'a v [@@deriving sexp]
+
+type 'a v_ = 'a v [@@deriving sexp]
+type 'a w_ = 'a w [@@deriving sexp]
+
+module M3 : sig
+  type 'a v = 'a w_ [@@deriving sexp]
+  type 'a w = 'a v_ [@@deriving sexp]
+end = struct
+  type nonrec 'a v = 'a w
+  and 'a w = 'a v [@@deriving sexp]
+end
+
+type t0 = A of t0 [@@deriving sexp]
+
+module B : sig
+  type nonrec t0 = t0 [@@deriving sexp]
+end = struct
+  type nonrec t0 = t0 = A of t0 [@@deriving sexp]
+end
+
+type t1 = A of t2
+and t2 = B of t1 [@@deriving sexp]
+
+module C : sig
+  type nonrec t1 = t1 [@@deriving sexp]
+  type nonrec t2 = t2 [@@deriving sexp]
+end = struct
+  type nonrec t1 = t1 = A of t2
+  and t2 = t2 = B of t1 [@@deriving sexp]
+end
+
+type 'a v1 = A of 'a v2
+and 'a v2 = B of 'a v1 [@@deriving sexp]
+
+module D : sig
+  type nonrec 'a v1 = 'a v1 [@@deriving sexp]
+  type nonrec 'a v2 = 'a v2 [@@deriving sexp]
+end = struct
+  type nonrec 'a v1 = 'a v1 = A of 'a v2
+  and 'a v2 = 'a v2 = B of 'a v1 [@@deriving sexp]
+end
+
+type +'a w1
+
+module E = struct
+  type nonrec +'a w1 = 'a w1
+end
+
+type 'a y1 = A of 'a y2
+and 'a y2 = B of 'a y1
+
+module F : sig
+  type nonrec 'a y2 = B of 'a y1
+  type nonrec 'a y1 = 'a y1
+end = struct
+  type nonrec 'a y1 = 'a y1 = A of 'a y2
+  and 'a y2 = B of 'a y1
+end
+
+type z1 = A of z1
+
+module G : sig
+  module A : sig
+    type z2 = A of z2
+  end
+
+  module B : sig
+    type z2 = A of z2
+  end
+
+  module C : sig
+    type z2 = A of z2
+  end
+end = struct
+  type z2 = z1 = A of z1
+
+  module A = struct
+    type nonrec z2 = z1 = A of z2
+  end
+
+  module B = struct
+    type nonrec z2 = z2 = A of z2
+  end
+
+  module C = struct
+    type nonrec z2 = z2 = A of z1
+  end
+end
+
+type ('a, 'b) zz = A of 'a * 'b
+
+module H = struct
+  type nonrec ('a, 'b) zz = ('a, 'b) zz = A of 'a * 'b
+end
+
+module I = struct
+  type nonrec 'a zz = ('a, 'a) zz
+end

unikernel/duniverse/ppx_sexp_conv/test/ppx_sexp_test.ml

@@ -0,0 +1,889 @@
+open Ppx_sexp_conv_lib
+open Conv
+
+(* Module names below are used in error messages being tested. *)
+[@@@warning "-unused-module"]
+
+module Sum_and_polymorphic_variants = struct
+  type poly =
+    [ `No_arg
+    | `One_arg of int
+    | `One_tuple of int * string
+    | `Two_args of int * string
+    ]
+  [@@deriving sexp, sexp_grammar]
+
+  let%test_unit _ =
+    List.iter
+      (fun (value, sexp) ->
+        assert (sexp_of_poly value = sexp);
+        assert (poly_of_sexp sexp = value))
+      [ `No_arg, Sexp.Atom "No_arg"
+      ; (`One_arg 1, Sexp.(List [ Atom "One_arg"; Atom "1" ]))
+      ; ( `One_tuple (1, "a")
+        , Sexp.(List [ Atom "One_tuple"; List [ Atom "1"; Atom "a" ] ]) )
+      ; (`Two_args (1, "a"), Sexp.(List [ Atom "Two_args"; List [ Atom "1"; Atom "a" ] ]))
+      ]
+  ;;
+
+  type nominal =
+    | No_arg
+    | One_arg of int
+    | One_tuple of (int * string)
+    | Two_args of int * string
+  [@@deriving sexp, sexp_grammar]
+
+  let%test_unit _ =
+    List.iter
+      (fun (value, sexp) ->
+        assert (sexp_of_nominal value = sexp);
+        assert (nominal_of_sexp sexp = value))
+      [ No_arg, Sexp.Atom "No_arg"
+      ; (One_arg 1, Sexp.(List [ Atom "One_arg"; Atom "1" ]))
+      ; (One_tuple (1, "a"), Sexp.(List [ Atom "One_tuple"; List [ Atom "1"; Atom "a" ] ]))
+      ; (Two_args (1, "a"), Sexp.(List [ Atom "Two_args"; Atom "1"; Atom "a" ]))
+      ]
+  ;;
+end
+
+module Records = struct
+  type t =
+    { a : int
+    ; b : (float * string) list option
+    }
+  [@@deriving sexp, sexp_grammar]
+
+  let%test_unit _ =
+    let t = { a = 2; b = Some [ 1., "a"; 2.3, "b" ] } in
+    let sexp = Sexplib.Sexp.of_string "((a 2)(b (((1 a)(2.3 b)))))" in
+    assert (t_of_sexp sexp = t);
+    assert (sexp_of_t t = sexp)
+  ;;
+
+  let%expect_test _ =
+    let sexp = Sexplib.Sexp.of_string "((a)(b ()))" in
+    Expect_test_helpers_core.show_raise (fun () -> t_of_sexp sexp);
+    [%expect
+      {|
+      (raised (
+        Of_sexp_error
+        "ppx_sexp_test.ml.Records.t_of_sexp: record conversion: only pairs expected, their first element must be an atom"
+        (invalid_sexp ((a) (b ())))))
+      |}]
+  ;;
+
+  let%expect_test _ =
+    let sexp = Sexplib.Sexp.of_string "((a 1)(a))" in
+    Expect_test_helpers_core.show_raise (fun () -> t_of_sexp sexp);
+    [%expect
+      {|
+      (raised (
+        Of_sexp_error
+        "ppx_sexp_test.ml.Records.t_of_sexp: duplicate fields: a"
+        (invalid_sexp ((a 1) (a)))))
+      |}]
+  ;;
+
+  let%expect_test _ =
+    let sexp = Sexplib.Sexp.of_string "((a 3 4))" in
+    Expect_test_helpers_core.show_raise (fun () -> t_of_sexp sexp);
+    [%expect
+      {|
+      (raised (
+        Of_sexp_error
+        "ppx_sexp_test.ml.Records.t_of_sexp: record conversion: only pairs expected, their first element must be an atom"
+        (invalid_sexp (a 3 4))))
+      |}]
+  ;;
+
+  let%expect_test _ =
+    let sexp = Sexplib.Sexp.of_string "((c 3))" in
+    Expect_test_helpers_core.show_raise (fun () -> t_of_sexp sexp);
+    [%expect
+      {|
+      (raised (
+        Of_sexp_error
+        "ppx_sexp_test.ml.Records.t_of_sexp: extra fields: c"
+        (invalid_sexp ((c 3)))))
+      |}]
+  ;;
+end
+
+module Inline_records = struct
+  type t =
+    | A of
+        { a : int
+        ; b : (float * string) list option
+        }
+    | B of int
+  [@@deriving sexp, sexp_grammar]
+
+  let%test_unit _ =
+    let t = A { a = 2; b = Some [ 1., "a"; 2.3, "b" ] } in
+    let sexp = Sexplib.Sexp.of_string "(A (a 2)(b (((1 a)(2.3 b)))))" in
+    assert (t_of_sexp sexp = t);
+    assert (sexp_of_t t = sexp)
+  ;;
+end
+
+module User_specified_conversion = struct
+  type my_float = float
+
+  let sexp_of_my_float n = Sexp.Atom (Printf.sprintf "%.4f" n)
+  let my_float_of_sexp = float_of_sexp
+
+  let%test_unit _ =
+    let my_float : my_float = 1.2 in
+    let sexp = Sexp.Atom "1.2000" in
+    assert (my_float_of_sexp sexp = my_float);
+    assert (sexp_of_my_float my_float = sexp)
+  ;;
+end
+
+module Exceptions : sig
+  (* no sexp_grammars for exceptions, as they can't be parsed *)
+  exception E0 [@@deriving sexp]
+  exception E1 of string [@@deriving sexp]
+  exception E2 of string * int [@@deriving sexp]
+  exception E_tuple of (string * int) [@@deriving sexp]
+
+  exception
+    E_record of
+      { a : string
+      ; b : int
+      }
+  [@@deriving sexp]
+end = struct
+  exception E0 [@@deriving sexp]
+  exception E1 of string [@@deriving sexp]
+  exception E2 of string * int [@@deriving sexp]
+  exception E_tuple of (string * int) [@@deriving sexp]
+
+  exception
+    E_record of
+      { a : string
+      ; b : int
+      }
+  [@@deriving sexp]
+
+  let%test_unit _ =
+    let cases =
+      [ E0, "ppx_sexp_test.ml.Exceptions.E0"
+      ; E1 "a", "(ppx_sexp_test.ml.Exceptions.E1 a)"
+      ; E2 ("b", 2), "(ppx_sexp_test.ml.Exceptions.E2 b 2)"
+      ; E_tuple ("c", 3), "(ppx_sexp_test.ml.Exceptions.E_tuple(c 3))"
+      ; E_record { a = "c"; b = 3 }, "(ppx_sexp_test.ml.Exceptions.E_record(a c)(b 3))"
+      ]
+    in
+    List.iter
+      (fun (exn, sexp_as_str) ->
+        let sexp = Sexplib.Sexp.of_string sexp_as_str in
+        assert ([%sexp_of: exn] exn = sexp))
+      cases
+  ;;
+end
+
+module Abstract_types_are_allowed_in_structures : sig
+  type t [@@deriving sexp, sexp_grammar]
+end = struct
+  type t [@@deriving sexp, sexp_grammar]
+end
+
+module Manifest_types = struct
+  type a = { t : int }
+  type b = a = { t : int } [@@deriving sexp, sexp_grammar]
+end
+
+module Uses_of_exn = struct
+  type t = int * exn [@@deriving sexp_of]
+end
+
+module Function_types : sig
+  type t1 = int -> unit [@@deriving sexp, sexp_grammar]
+  type t2 = label:int -> ?optional:int -> unit -> unit [@@deriving sexp, sexp_grammar]
+end = struct
+  type t1 = int -> unit [@@deriving sexp, sexp_grammar]
+  type t2 = label:int -> ?optional:int -> unit -> unit [@@deriving sexp, sexp_grammar]
+end
+
+module No_unused_rec = struct
+  type r = { r : int } [@@deriving sexp, sexp_grammar]
+end
+
+module Field_name_should_not_be_rewritten = struct
+  open No_unused_rec
+
+  type nonrec r = { r : r }
+
+  let _ = fun (r : r) -> r.r
+end
+
+module Polymorphic_variant_inclusion = struct
+  type sub1 =
+    [ `C1
+    | `C2
+    ]
+  [@@deriving sexp, sexp_grammar]
+
+  type 'b sub2 =
+    [ `C4
+    | `C5 of 'b
+    ]
+  [@@deriving sexp, sexp_grammar]
+
+  type ('a, 'b) t = [ sub1 | `C3 of [ `Nested of 'a ] | 'b sub2 | `C6 ] option
+  [@@deriving sexp, sexp_grammar]
+
+  let%test_unit _ =
+    let cases : ((string * string, float) t * _) list =
+      [ None, "()"
+      ; Some `C1, "(C1)"
+      ; Some `C2, "(C2)"
+      ; Some (`C3 (`Nested ("a", "b"))), "((C3 (Nested (a b))))"
+      ; Some `C4, "(C4)"
+      ; Some (`C5 1.5), "((C5 1.5))"
+      ; Some `C6, "(C6)"
+      ]
+    in
+    List.iter
+      (fun (t, sexp_as_str) ->
+        let sexp = Sexplib.Sexp.of_string sexp_as_str in
+        assert ([%of_sexp: (string * string, float) t] sexp = t);
+        assert ([%sexp_of: (string * string, float) t] t = sexp))
+      cases
+  ;;
+
+  type sub1_alias = sub1 [@@deriving sexp_poly, sexp_grammar]
+
+  type u =
+    [ `A
+    | sub1_alias
+    | `D
+    ]
+  [@@deriving sexp, sexp_grammar]
+
+  let%test_unit _ =
+    let cases : (u * _) list = [ `A, "A"; `C1, "C1"; `C2, "C2"; `D, "D" ] in
+    List.iter
+      (fun (u, sexp_as_str) ->
+        let sexp = Sexplib.Sexp.of_string sexp_as_str in
+        assert ([%of_sexp: u] sexp = u);
+        assert ([%sexp_of: u] u = sexp))
+      cases
+  ;;
+end
+
+module Polymorphic_record_field = struct
+  type 'x t =
+    { poly : 'a 'b. 'a list
+    ; maybe_x : 'x option
+    }
+  [@@deriving sexp]
+
+  let%test_unit _ =
+    let t x = { poly = []; maybe_x = Some x } in
+    let sexp = Sexplib.Sexp.of_string "((poly ())(maybe_x (1)))" in
+    assert (t_of_sexp int_of_sexp sexp = t 1);
+    assert (sexp_of_t sexp_of_int (t 1) = sexp)
+  ;;
+end
+
+module No_unused_value_warnings : sig end = struct
+  module No_warning : sig
+    type t = [ `A ] [@@deriving sexp, sexp_grammar]
+  end = struct
+    type t = [ `A ] [@@deriving sexp, sexp_grammar]
+  end
+
+  module Empty = struct end
+
+  module No_warning2 (X : sig
+    type t [@@deriving sexp, sexp_grammar]
+  end) =
+  struct end
+
+  (* this one can't be handled (what if Empty was a functor, huh?) *)
+  (* module No_warning3(X : sig type t with sexp end) = Empty *)
+  module type S = sig
+    type t = [ `A ] [@@deriving sexp, sexp_grammar]
+  end
+
+  module No_warning4 : S = struct
+    type t = [ `A ] [@@deriving sexp, sexp_grammar]
+  end
+
+  module No_warning5 : S = (
+    (
+    struct
+      type t = [ `A ] [@@deriving sexp, sexp_grammar]
+    end :
+      S) :
+      S)
+
+  module Nested_functors (M1 : sig
+    type t [@@deriving sexp, sexp_grammar]
+  end) (M2 : sig
+    type t [@@deriving sexp, sexp_grammar]
+  end) =
+  struct end
+
+  let () =
+    let module M : sig
+      type t [@@deriving sexp, sexp_grammar]
+    end = struct
+      type t [@@deriving sexp, sexp_grammar]
+    end
+    in
+    ()
+  ;;
+
+  module Include = struct
+    include (
+      struct
+        type t = int [@@deriving sexp, sexp_grammar]
+      end :
+        sig
+          type t [@@deriving sexp, sexp_grammar]
+        end
+        with type t := int)
+  end
+end
+
+module Default = struct
+  type t = { a : int [@default 2] } [@@deriving sexp, sexp_grammar]
+
+  let%test _ = Sexp.(List [ List [ Atom "a"; Atom "1" ] ]) = sexp_of_t { a = 1 }
+  let%test _ = Sexp.(List [ List [ Atom "a"; Atom "2" ] ]) = sexp_of_t { a = 2 }
+  let%test _ = t_of_sexp Sexp.(List [ List [ Atom "a"; Atom "1" ] ]) = { a = 1 }
+  let%test _ = t_of_sexp Sexp.(List [ List [ Atom "a"; Atom "2" ] ]) = { a = 2 }
+  let%test _ = t_of_sexp Sexp.(List []) = { a = 2 }
+end
+
+module Type_alias = struct
+  (* checking that the [as 'a] is supported and ignored in signatures, that it still
+     exports the sexp_of_t__ when needed *)
+  module B : sig
+    type a = [ `A ]
+    type t = [ `A ] as 'a constraint 'a = a [@@deriving sexp, sexp_grammar]
+  end = struct
+    type a = [ `A ] [@@deriving sexp, sexp_grammar]
+    type t = [ `A ] [@@deriving sexp, sexp_grammar]
+  end
+
+  let%test _ = Sexp.to_string (B.sexp_of_t `A) = "A"
+  let%test _ = `A = B.t_of_sexp (Sexplib.Sexp.of_string "A")
+
+  module B2 = struct
+    type t =
+      [ B.t
+      | `B
+      ]
+    [@@deriving sexp, sexp_grammar]
+  end
+
+  module C : sig
+    type t = int as 'a [@@deriving sexp, sexp_grammar]
+  end = struct
+    type t = int [@@deriving sexp, sexp_grammar]
+  end
+
+  module D : sig
+    type t = 'a constraint 'a = int [@@deriving sexp, sexp_grammar]
+  end = struct
+    type t = int [@@deriving sexp, sexp_grammar]
+  end
+end
+
+module Tricky_variants = struct
+  (* Checking that the generated code compiles (there used to be a problem with subtyping
+     constraints preventing proper generalization). *)
+  type t = [ `a ] [@@deriving sexp, sexp_grammar]
+  type 'a u = [ t | `b of 'a ] * int [@@deriving sexp, sexp_grammar]
+end
+
+module Drop_default = struct
+  open! Base
+  open Expect_test_helpers_core
+
+  type t = { a : int } [@@deriving equal]
+
+  let test ?cr t_of_sexp sexp_of_t =
+    let ( = ) = Sexp.( = ) in
+    require ?cr [%here] (Sexp.(List [ List [ Atom "a"; Atom "1" ] ]) = sexp_of_t { a = 1 });
+    require ?cr [%here] (Sexp.(List []) = sexp_of_t { a = 2 });
+    let ( = ) = equal in
+    require ?cr [%here] (t_of_sexp Sexp.(List [ List [ Atom "a"; Atom "1" ] ]) = { a = 1 });
+    require ?cr [%here] (t_of_sexp Sexp.(List [ List [ Atom "a"; Atom "2" ] ]) = { a = 2 });
+    require ?cr [%here] (t_of_sexp Sexp.(List []) = { a = 2 })
+  ;;
+
+  type my_int = int [@@deriving sexp, sexp_grammar]
+
+  module Poly = struct
+    type nonrec t = t = { a : my_int [@default 2] [@sexp_drop_default Poly.( = )] }
+    [@@deriving sexp, sexp_grammar]
+
+    let%test_unit _ = test t_of_sexp sexp_of_t
+  end
+
+  module Equal = struct
+    let equal_my_int = equal_int
+
+    type nonrec t = t = { a : my_int [@default 2] [@sexp_drop_default.equal] }
+    [@@deriving sexp, sexp_grammar]
+
+    let%test_unit _ = test t_of_sexp sexp_of_t
+  end
+
+  module Compare = struct
+    let compare_my_int = compare_int
+
+    type nonrec t = t = { a : my_int [@default 2] [@sexp_drop_default.compare] }
+    [@@deriving sexp, sexp_grammar]
+
+    let%test_unit _ = test t_of_sexp sexp_of_t
+  end
+
+  module Sexp = struct
+    type nonrec t = t = { a : my_int [@default 2] [@sexp_drop_default.sexp] }
+    [@@deriving sexp, sexp_grammar]
+
+    let%test_unit _ = test t_of_sexp sexp_of_t
+  end
+end
+
+module Drop_if = struct
+  type t = { a : int [@default 2] [@sexp_drop_if fun x -> x mod 2 = 0] }
+  [@@deriving sexp, sexp_grammar]
+
+  let%test _ = Sexp.(List [ List [ Atom "a"; Atom "1" ] ]) = sexp_of_t { a = 1 }
+  let%test _ = Sexp.(List []) = sexp_of_t { a = 2 }
+  let%test _ = Sexp.(List [ List [ Atom "a"; Atom "3" ] ]) = sexp_of_t { a = 3 }
+  let%test _ = Sexp.(List []) = sexp_of_t { a = 4 }
+  let%test _ = t_of_sexp Sexp.(List [ List [ Atom "a"; Atom "1" ] ]) = { a = 1 }
+  let%test _ = t_of_sexp Sexp.(List [ List [ Atom "a"; Atom "2" ] ]) = { a = 2 }
+  let%test _ = t_of_sexp Sexp.(List [ List [ Atom "a"; Atom "3" ] ]) = { a = 3 }
+  let%test _ = t_of_sexp Sexp.(List [ List [ Atom "a"; Atom "4" ] ]) = { a = 4 }
+  let%test _ = t_of_sexp Sexp.(List []) = { a = 2 }
+
+  type u =
+    { a : int
+         [@sexp_drop_if
+           fun x ->
+             (* pa_type_conv used to drop parens altogether, causing type errors in the
+                 following code *)
+             let pair = x, 2 in
+             match Some pair with
+             | None -> true
+             | Some (x, y) -> x = y]
+    }
+  [@@deriving sexp, sexp_grammar]
+end
+
+module Omit_nil = struct
+  type natural_option = int
+
+  let sexp_of_natural_option i = if i >= 0 then sexp_of_int i else sexp_of_unit ()
+
+  let natural_option_of_sexp = function
+    | Sexp.List [] -> -1
+    | sexp -> int_of_sexp sexp
+  ;;
+
+  let natural_option_sexp_grammar : natural_option Sexplib0.Sexp_grammar.t =
+    { untyped = Union [ List Empty; Integer ] }
+  ;;
+
+  let check sexp_of_t t_of_sexp str t =
+    let sexp = Sexplib.Sexp.of_string str in
+    assert (sexp = sexp_of_t t);
+    assert (t_of_sexp sexp = t)
+  ;;
+
+  type t = { a : natural_option [@sexp.omit_nil] } [@@deriving sexp, sexp_grammar]
+
+  let%test_unit _ = check sexp_of_t t_of_sexp "()" { a = -1 }
+  let%test_unit _ = check sexp_of_t t_of_sexp "((a 1))" { a = 1 }
+
+  type t2 = A of { a : int list [@sexp.omit_nil] } [@@deriving sexp, sexp_grammar]
+
+  let%test_unit _ = check sexp_of_t2 t2_of_sexp "(A)" (A { a = [] })
+  let%test_unit _ = check sexp_of_t2 t2_of_sexp "(A (a (1)))" (A { a = [ 1 ] })
+end
+
+module No_unused_rec_warning = struct
+  type r = { field : r -> unit } [@@deriving sexp_of]
+end
+
+module True_and_false = struct
+  type t =
+    | True
+    | False
+  [@@deriving sexp, sexp_grammar]
+
+  let%test _ = Sexp.to_string (sexp_of_t True) = "True"
+  let%test _ = Sexp.to_string (sexp_of_t False) = "False"
+  let%test _ = True = t_of_sexp (Sexplib.Sexp.of_string "True")
+  let%test _ = False = t_of_sexp (Sexplib.Sexp.of_string "False")
+  let%test _ = True = t_of_sexp (Sexplib.Sexp.of_string "true")
+  let%test _ = False = t_of_sexp (Sexplib.Sexp.of_string "false")
+
+  type u =
+    | True of int
+    | False of int
+  [@@deriving sexp, sexp_grammar]
+
+  let%test _ = Sexp.to_string (sexp_of_u (True 1)) = "(True 1)"
+  let%test _ = Sexp.to_string (sexp_of_u (False 2)) = "(False 2)"
+  let%test _ = True 1 = u_of_sexp (Sexplib.Sexp.of_string "(True 1)")
+  let%test _ = False 2 = u_of_sexp (Sexplib.Sexp.of_string "(False 2)")
+  let%test _ = True 1 = u_of_sexp (Sexplib.Sexp.of_string "(true 1)")
+  let%test _ = False 2 = u_of_sexp (Sexplib.Sexp.of_string "(false 2)")
+
+  exception True [@@deriving sexp]
+
+  let%test _ = "ppx_sexp_test.ml.True_and_false.True" = Sexp.to_string (sexp_of_exn True)
+
+  exception False of int [@@deriving sexp]
+
+  let%test _ =
+    "(ppx_sexp_test.ml.True_and_false.False 1)" = Sexp.to_string (sexp_of_exn (False 1))
+  ;;
+
+  type v =
+    [ `True
+    | `False of int
+    ]
+  [@@deriving sexp, sexp_grammar]
+
+  let%test _ = Sexp.to_string (sexp_of_v `True) = "True"
+  let%test _ = Sexp.to_string (sexp_of_v (`False 2)) = "(False 2)"
+end
+
+module Gadt = struct
+  let is_eq sexp str =
+    let sexp2 = Sexplib.Sexp.of_string str in
+    if sexp <> sexp2
+    then (
+      Printf.printf "%S vs %S\n%!" (Sexp.to_string sexp) str;
+      assert false)
+  ;;
+
+  (* plain type without argument *)
+  type 'a s = Packed : 'a s [@@deriving sexp_of]
+
+  let%test_unit _ = is_eq ([%sexp_of: int s] Packed) "Packed"
+
+  (* two kind of existential variables *)
+  type 'a t = Packed : 'a * _ * ('b[@sexp.opaque]) -> 'a t [@warning "-3"]
+  [@@deriving sexp_of]
+
+  let%test_unit _ =
+    is_eq ([%sexp_of: int t] (Packed (2, "asd", 1.))) "(Packed 2 _ <opaque>)"
+  ;;
+
+  (* plain type with argument *)
+  type 'a u = A : 'a -> 'a u [@@deriving sexp_of]
+
+  let%test_unit _ = is_eq ([%sexp_of: int u] (A 2)) "(A 2)"
+
+  (* recursive *)
+  type v = A : v option -> v [@@deriving sexp_of]
+
+  let%test_unit _ = is_eq ([%sexp_of: v] (A (Some (A None)))) "(A((A())))"
+
+  (* implicit existential variable *)
+  type w = A : 'a * int * ('a -> string) -> w [@@deriving sexp_of]
+
+  let%test_unit _ = is_eq ([%sexp_of: w] (A (1., 2, string_of_float))) "(A _ 2 <fun>)"
+
+  (* tricky variable naming *)
+  type 'a x = A : 'a -> 'b x [@@deriving sexp_of]
+
+  let%test_unit _ = is_eq ([%sexp_of: int x] (A 1.)) "(A _)"
+
+  (* interaction with inline record *)
+  type _ x2 = A : { x : 'c } -> 'c x2 [@@deriving sexp_of]
+
+  let%test_unit _ = is_eq ([%sexp_of: int x2] (A { x = 1 })) "(A (x 1))"
+
+  (* unused but colliding variables *)
+  type (_, _) y = A : ('a, 'a) y [@@deriving sexp_of]
+
+  let%test_unit _ = is_eq ([%sexp_of: (int, int) y] A) "A"
+
+  (* making sure we're not reversing parameters *)
+  type (_, _) z = A : ('a * 'b) -> ('a, 'b) z [@@deriving sexp_of]
+
+  let%test_unit _ = is_eq ([%sexp_of: (int, string) z] (A (1, "a"))) "(A (1 a))"
+
+  (* interaction with universal quantifiers *)
+  type _ z2 = A : { x : 'c. 'c option } -> 'c z2 [@@deriving sexp_of]
+
+  let%test_unit _ = is_eq ([%sexp_of: unit z2] (A { x = None })) "(A (x ()))"
+end
+
+module Anonymous_variable = struct
+  type _ t = int [@@deriving sexp, sexp_grammar]
+
+  let%test _ = Sexp.to_string ([%sexp_of: _ t] 2) = "2"
+  let%test _ = [%of_sexp: _ t] (Sexplib.Sexp.of_string "2") = 2
+
+  (* making sure we don't generate signatures like (_ -> Sexp.t) -> _ t -> Sexp.t which
+     are too general *)
+  module M : sig
+    type _ t [@@deriving sexp, sexp_grammar]
+  end = struct
+    type 'a t = 'a [@@deriving sexp, sexp_grammar]
+  end
+end
+
+module Record_field_disambiguation = struct
+  type a =
+    { fl : float
+    ; b : b
+    }
+
+  and b = { fl : int } [@@deriving sexp, sexp_grammar]
+end
+
+module Private = struct
+  type t = private int [@@deriving sexp_of]
+  type ('a, 'b) u = private t [@@deriving sexp_of]
+  type ('a, 'b, 'c) v = private ('a, 'b) u [@@deriving sexp_of]
+end
+
+module Nonregular_types = struct
+  type 'a nonregular =
+    | Leaf of 'a
+    | Branch of ('a * 'a) nonregular
+  [@@deriving sexp, sexp_grammar]
+
+  type 'a variant = [ `A of 'a ] [@@deriving sexp, sexp_grammar]
+
+  type ('a, 'b) nonregular_with_variant =
+    | Branch of ([ | 'a list variant ], 'b) nonregular_with_variant
+  [@@deriving sexp, sexp_grammar]
+end
+
+module Opaque = struct
+  type t = (int[@sexp.opaque]) list [@@deriving sexp, sexp_grammar]
+
+  let sexp = Sexplib.Sexp.of_string "(<opaque> <opaque>)"
+  let t = [ 1; 2 ]
+  let%test _ = sexp_of_t t = sexp
+
+  let%test _ =
+    match t_of_sexp sexp with
+    | _ -> false
+    | exception _ -> true
+  ;;
+
+  type u = ([ `A of int ][@sexp.opaque]) [@@deriving sexp, sexp_grammar]
+
+  let sexp = Sexplib.Sexp.of_string "<opaque>"
+  let u = `A 1
+  let%test _ = sexp_of_u u = sexp
+
+  let%test _ =
+    match u_of_sexp sexp with
+    | _ -> false
+    | exception _ -> true
+  ;;
+end
+
+module Optional = struct
+  type t = { optional : int option [@sexp.option] } [@@deriving sexp, sexp_grammar]
+
+  let sexp = Sexplib.Sexp.of_string "()"
+  let t = { optional = None }
+  let%test _ = t_of_sexp sexp = t
+  let%test _ = sexp_of_t t = sexp
+  let sexp = Sexplib.Sexp.of_string "((optional 5))"
+  let t = { optional = Some 5 }
+  let%test _ = t_of_sexp sexp = t
+  let%test _ = sexp_of_t t = sexp
+end
+
+module Nonempty = struct
+  type t =
+    { list : int list [@sexp.list]
+    ; array : int array [@sexp.array]
+    }
+  [@@deriving sexp, sexp_grammar]
+
+  let sexp = Sexplib.Sexp.of_string "()"
+  let t = { list = []; array = [||] }
+  let%test _ = t_of_sexp sexp = t
+  let%test _ = sexp_of_t t = sexp
+  let sexp = Sexplib.Sexp.of_string "((list (1 2 3)) (array (3 2 1)))"
+  let t = { list = [ 1; 2; 3 ]; array = [| 3; 2; 1 |] }
+  let%test _ = t_of_sexp sexp = t
+  let%test _ = sexp_of_t t = sexp
+end
+
+module Boolean = struct
+  type t = { no_arg : bool [@sexp.bool] } [@@deriving sexp, sexp_grammar]
+
+  let sexp = Sexplib.Sexp.of_string "()"
+  let t = { no_arg = false }
+  let%test _ = t_of_sexp sexp = t
+  let%test _ = sexp_of_t t = sexp
+  let sexp = Sexplib.Sexp.of_string "((no_arg))"
+  let t = { no_arg = true }
+  let%test _ = t_of_sexp sexp = t
+  let%test _ = sexp_of_t t = sexp
+
+  type t_allow_extra_fields = { no_arg : bool [@sexp.bool] }
+  [@@deriving sexp, sexp_grammar] [@@sexp.allow_extra_fields]
+
+  let%expect_test _ =
+    Expect_test_helpers_core.require_does_raise ~cr:CR_soon [%here] (fun () ->
+      let r = t_allow_extra_fields_of_sexp (Sexplib.Sexp.of_string "((no_arg true))") in
+      print_endline (Bool.to_string r.no_arg));
+    [%expect
+      {|
+      (Of_sexp_error
+       "ppx_sexp_test.ml.Boolean.t_allow_extra_fields_of_sexp: record conversion: a [sexp.bool] field was given a payload."
+       (invalid_sexp ((no_arg true))))
+      |}]
+  ;;
+end
+
+module Inline = struct
+  type t = A of int list [@sexp.list] [@@deriving sexp, sexp_grammar]
+
+  let sexp = Sexplib.Sexp.of_string "(A 1 2 3)"
+  let t = A [ 1; 2; 3 ]
+  let%test _ = t_of_sexp sexp = t
+  let%test _ = sexp_of_t t = sexp
+
+  type u = [ `A of int list [@sexp.list] ] [@@deriving sexp, sexp_grammar]
+
+  let sexp = Sexplib.Sexp.of_string "(A 1 2 3)"
+  let u = `A [ 1; 2; 3 ]
+  let%test _ = u_of_sexp sexp = u
+  let%test _ = sexp_of_u u = sexp
+end
+
+module Variance = struct
+  type (+'a, -'b, 'c, +_, -_, _) t [@@deriving sexp, sexp_grammar]
+end
+
+module Clash = struct
+  (* Same name for type-var and type-name; must be careful when introducing rigid type names. *)
+  type 'hey hey = Hey of 'hey [@@deriving sexp, sexp_grammar]
+  type 'hey rigid_hey = Hey of 'hey [@@deriving sexp, sexp_grammar]
+  type ('foo, 'rigid_foo) foo = Foo of 'foo [@@deriving sexp, sexp_grammar]
+  type 'rigid_bar rigid_rigid_bar = Bar [@@deriving sexp, sexp_grammar]
+end
+
+module Applicative_functor_types = struct
+  module Bidirectional_map = struct
+    type ('k1, 'k2) t
+
+    module S (K1 : sig
+      type t
+    end) (K2 : sig
+      type t
+    end) =
+    struct
+      type nonrec t = (K1.t, K2.t) t
+    end
+
+    module type Of_sexpable = sig
+      type t [@@deriving of_sexp, sexp_grammar]
+    end
+
+    let s__t_of_sexp
+      (type k1 k2)
+      (module K1 : Of_sexpable with type t = k1)
+      (module K2 : Of_sexpable with type t = k2)
+      (_ : Sexp.t)
+      : (k1, k2) t
+      =
+      assert false
+    ;;
+
+    (* You would actually have to write this manually for functors. *)
+    let s__t_sexp_grammar
+      (type k1 k2)
+      (module K1 : Of_sexpable with type t = k1)
+      (module K2 : Of_sexpable with type t = k2)
+      =
+      [%sexp_grammar: (K1.t * K2.t) list]
+    ;;
+  end
+
+  module Int = struct
+    type t = int [@@deriving of_sexp, sexp_grammar]
+  end
+
+  module String = struct
+    type t = string [@@deriving of_sexp, sexp_grammar]
+  end
+
+  module M : sig
+    type t = Bidirectional_map.S(String)(Int).t [@@deriving of_sexp, sexp_grammar]
+  end = struct
+    type t = Bidirectional_map.S(String)(Int).t [@@deriving of_sexp, sexp_grammar]
+  end
+end
+
+module Type_extensions = struct
+  let _ = ([%sexp_of: int] : [%sexp_of: int])
+  let _ = ([%of_sexp: int] : [%of_sexp: int])
+end
+
+module Allow_extra_fields = struct
+  let should_raise f x =
+    try
+      ignore (f x);
+      false
+    with
+    | _ -> true
+  ;;
+
+  module M1 = struct
+    type t1 = { a : int } [@@deriving sexp]
+    type t2 = t1 = { a : int } [@@deriving sexp, sexp_grammar] [@@sexp.allow_extra_fields]
+
+    let sexp = Sexplib.Sexp.of_string "((a 1))"
+    let sexp_extra = Sexplib.Sexp.of_string "((a 1)(b 2))"
+    let%test _ = t2_of_sexp sexp = t2_of_sexp sexp_extra
+    let%test _ = t1_of_sexp sexp = t2_of_sexp sexp
+    let%test _ = should_raise t1_of_sexp sexp_extra
+
+    let%expect_test _ =
+      Expect_test_helpers_core.require_does_raise ~cr:CR_soon [%here] (fun () ->
+        t2_of_sexp (Sexplib.Sexp.of_string "((a 1)(a))"));
+      [%expect
+        {|
+        (Of_sexp_error
+         "ppx_sexp_test.ml.Allow_extra_fields.M1.t2_of_sexp: duplicate fields: a"
+         (invalid_sexp ((a 1) (a))))
+        |}]
+    ;;
+  end
+
+  module M2 = struct
+    type t1 = A of { a : int list } [@@deriving sexp]
+
+    type t2 = t1 = A of { a : int list } [@sexp.allow_extra_fields]
+    [@@deriving sexp, sexp_grammar]
+
+    let sexp = Sexplib.Sexp.of_string "(A (a (0)))"
+    let sexp_extra = Sexplib.Sexp.of_string "(A (a (0))(b 2))"
+    let%test _ = t2_of_sexp sexp = t2_of_sexp sexp_extra
+    let%test _ = t1_of_sexp sexp = t2_of_sexp sexp
+    let%test _ = should_raise t1_of_sexp sexp_extra
+  end
+end
+
+module Default_values_and_polymorphism = struct
+  type t =
+    { a : int list [@sexp.list]
+    ; b : 'b. 'b -> int
+    }
+  [@@deriving of_sexp]
+end

unikernel/duniverse/ppx_sexp_conv/test/sexp_grammar/dune

@@ -0,0 +1,18 @@
+(library
+ (name ppx_sexp_conv_test_sexp_grammar)
+ (libraries base expect_test_helpers_core.expect_test_helpers_base
+   sexp_grammar)
+ (preprocess
+  (pps ppx_sexp_conv ppx_expect ppx_here)))
+
+(rule
+ (targets regular_vs_polymorphic_variants.diff)
+ (deps test_regular_variants.ml test_polymorphic_variants.ml)
+ (mode promote)
+ (action
+  (bash
+    "%{bin:patdiff-for-review} %{bin:patdiff} %{deps} > %{targets} || true")))
+
+(alias
+ (name DEFAULT)
+ (deps regular_vs_polymorphic_variants.diff))

unikernel/duniverse/ppx_sexp_conv/test/sexp_grammar/test_allow_extra_fields.ml

@@ -0,0 +1,119 @@
+open! Base
+
+module _ = struct
+  type t = { a : int } [@@sexp.allow_extra_fields] [@@deriving_inline sexp_grammar]
+
+  let _ = fun (_ : t) -> ()
+
+  let (t_sexp_grammar : t Sexplib0.Sexp_grammar.t) =
+    { untyped =
+        Lazy
+          (lazy
+            (List
+               (Fields
+                  { allow_extra_fields = true
+                  ; fields =
+                      [ No_tag
+                          { name = "a"
+                          ; required = true
+                          ; args = Cons (int_sexp_grammar.untyped, Empty)
+                          }
+                      ]
+                  })))
+    }
+  ;;
+
+  let _ = t_sexp_grammar
+
+  [@@@end]
+end
+
+module _ = struct
+  type t = { a : int } [@@deriving_inline sexp_grammar]
+
+  let _ = fun (_ : t) -> ()
+
+  let (t_sexp_grammar : t Sexplib0.Sexp_grammar.t) =
+    { untyped =
+        Lazy
+          (lazy
+            (List
+               (Fields
+                  { allow_extra_fields = false
+                  ; fields =
+                      [ No_tag
+                          { name = "a"
+                          ; required = true
+                          ; args = Cons (int_sexp_grammar.untyped, Empty)
+                          }
+                      ]
+                  })))
+    }
+  ;;
+
+  let _ = t_sexp_grammar
+
+  [@@@end]
+end
+
+module _ = struct
+  type t =
+    | Allow_extra_fields of { foo : int } [@sexp.allow_extra_fields]
+    | Forbid_extra_fields of { bar : int }
+  [@@deriving_inline sexp_grammar]
+
+  let _ = fun (_ : t) -> ()
+
+  let (t_sexp_grammar : t Sexplib0.Sexp_grammar.t) =
+    { untyped =
+        Lazy
+          (lazy
+            (Variant
+               { case_sensitivity = Case_sensitive_except_first_character
+               ; clauses =
+                   [ No_tag
+                       { name = "Allow_extra_fields"
+                       ; clause_kind =
+                           List_clause
+                             { args =
+                                 Fields
+                                   { allow_extra_fields = true
+                                   ; fields =
+                                       [ No_tag
+                                           { name = "foo"
+                                           ; required = true
+                                           ; args = Cons (int_sexp_grammar.untyped, Empty)
+                                           }
+                                       ]
+                                   }
+                             }
+                       }
+                   ; No_tag
+                       { name = "Forbid_extra_fields"
+                       ; clause_kind =
+                           List_clause
+                             { args =
+                                 Fields
+                                   { allow_extra_fields = false
+                                   ; fields =
+                                       [ No_tag
+                                           { name = "bar"
+                                           ; required = true
+                                           ; args = Cons (int_sexp_grammar.untyped, Empty)
+                                           }
+                                       ]
+                                   }
+                             }
+                       }
+                   ]
+               }))
+    }
+  ;;
+
+  let _ = t_sexp_grammar
+
+  [@@@end]
+
+  let _ = Allow_extra_fields { foo = 1 }
+  let _ = Forbid_extra_fields { bar = 1 }
+end

unikernel/duniverse/ppx_sexp_conv/test/sexp_grammar/test_allow_extra_fields.mli

@@ -0,0 +1 @@
+(*_ This signature is deliberately empty. *)

unikernel/duniverse/ppx_sexp_conv/test/sexp_grammar/test_attributes.ml

@@ -0,0 +1,117 @@
+open! Base
+
+module type S = sig
+  type t [@@deriving sexp_grammar]
+end
+
+let show_grammar (module M : S) =
+  Expect_test_helpers_base.print_s ([%sexp_of: _ Sexp_grammar.t] [%sexp_grammar: M.t])
+;;
+
+module Grammarless = struct
+  type t =
+    [ `A
+    | `B of string
+    ]
+end
+
+let the_grammar = [%sexp_grammar: [ `A | `B of string ]]
+
+let%expect_test "[@sexp_grammar.custom] in [@@deriving]" =
+  show_grammar
+    (module struct
+      type t = (Grammarless.t[@sexp_grammar.custom the_grammar]) * int
+      [@@deriving_inline sexp_grammar]
+
+      let _ = fun (_ : t) -> ()
+
+      let (t_sexp_grammar : t Sexplib0.Sexp_grammar.t) =
+        { untyped =
+            Lazy
+              (lazy
+                (List
+                   (Cons
+                      ( (the_grammar : Grammarless.t Sexplib0.Sexp_grammar.t).untyped
+                      , Cons (int_sexp_grammar.untyped, Empty) ))))
+        }
+      ;;
+
+      let _ = t_sexp_grammar
+
+      [@@@end]
+    end);
+  [%expect
+    {|
+    (List (
+      Cons
+      (Variant (
+        (case_sensitivity Case_sensitive)
+        (clauses (
+          (No_tag (
+            (name        A)
+            (clause_kind Atom_clause)))
+          (No_tag (
+            (name B) (clause_kind (List_clause (args (Cons String Empty))))))))))
+      (Cons Integer Empty)))
+    |}]
+;;
+
+let%expect_test "[@sexp_grammar.custom] in [%sexp_grammar]" =
+  show_grammar
+    (module struct
+      type t = Grammarless.t * int
+
+      let t_sexp_grammar =
+        [%sexp_grammar: (Grammarless.t[@sexp_grammar.custom the_grammar]) * int]
+      ;;
+    end);
+  [%expect
+    {|
+    (List (
+      Cons
+      (Variant (
+        (case_sensitivity Case_sensitive)
+        (clauses (
+          (No_tag (
+            (name        A)
+            (clause_kind Atom_clause)))
+          (No_tag (
+            (name B) (clause_kind (List_clause (args (Cons String Empty))))))))))
+      (Cons Integer Empty)))
+    |}]
+;;
+
+let%expect_test "[@sexp_grammar.any] in [@@deriving]" =
+  show_grammar
+    (module struct
+      type t =
+        (Grammarless.t[@sexp_grammar.any "GRAMMARLESS"])
+        * (Grammarless.t[@sexp_grammar.any])
+      [@@deriving_inline sexp_grammar]
+
+      let _ = fun (_ : t) -> ()
+
+      let (t_sexp_grammar : t Sexplib0.Sexp_grammar.t) =
+        { untyped = List (Cons (Any "GRAMMARLESS", Cons (Any "ANY", Empty))) }
+      ;;
+
+      let _ = t_sexp_grammar
+
+      [@@@end]
+    end);
+  [%expect {| (List (Cons (Any GRAMMARLESS) (Cons (Any ANY) Empty))) |}]
+;;
+
+let%expect_test "[@sexp_grammar.any] in [%sexp_grammar]" =
+  show_grammar
+    (module struct
+      type t = Grammarless.t * Grammarless.t
+
+      let t_sexp_grammar =
+        [%sexp_grammar:
+          (Grammarless.t[@sexp_grammar.any "GRAMMARLESS"])
+          * (Grammarless.t[@sexp_grammar.any])]
+      ;;
+    end);
+  [%expect {| (List (Cons (Any GRAMMARLESS) (Cons (Any ANY) Empty))) |}]
+;;

unikernel/duniverse/ppx_sexp_conv/test/sexp_grammar/test_attributes.mli

@@ -0,0 +1 @@
+(*_ This signature is deliberately empty. *)

unikernel/duniverse/ppx_sexp_conv/test/sexp_grammar/test_base_map.ml

@@ -0,0 +1,35 @@
+open! Base
+
+module type S = sig
+  type t [@@deriving sexp_grammar]
+end
+
+module Key = struct
+  type t = int [@@deriving sexp_grammar]
+end
+
+module Pair = struct
+  type ('a, 'b) t = 'a * 'b [@@deriving sexp_grammar]
+
+  module M (A : T) = struct
+    type 'b t = A.t * 'b
+  end
+
+  let m__t_sexp_grammar (type a) (module Key : S with type t = a) v_sexp_grammar =
+    t_sexp_grammar Key.t_sexp_grammar v_sexp_grammar
+  ;;
+end
+
+type t = string Pair.M(Key).t [@@deriving_inline sexp_grammar]
+
+let _ = fun (_ : t) -> ()
+
+let (t_sexp_grammar : t Sexplib0.Sexp_grammar.t) =
+  { untyped =
+      Lazy (lazy (Pair.m__t_sexp_grammar (module Key) string_sexp_grammar).untyped)
+  }
+;;
+
+let _ = t_sexp_grammar
+
+[@@@end]

unikernel/duniverse/ppx_sexp_conv/test/sexp_grammar/test_base_map.mli

@@ -0,0 +1 @@
+(*_ This signature is deliberately empty. *)

unikernel/duniverse/ppx_sexp_conv/test/sexp_grammar/test_coverage_for_deriving.ml

@@ -0,0 +1,616 @@
+open Ppx_sexp_conv_lib.Conv
+
+[@@@warning "-37"] (* allow unused constructors *)
+
+type abstract_a [@@deriving sexp] [@@deriving_inline sexp_grammar]
+
+let _ = fun (_ : abstract_a) -> ()
+
+let (abstract_a_sexp_grammar : abstract_a Sexplib0.Sexp_grammar.t) =
+  { untyped = Any "Test_coverage_for_deriving.abstract_a" }
+;;
+
+let _ = abstract_a_sexp_grammar
+
+[@@@end]
+
+type abstract_b [@@deriving sexp] [@@deriving_inline sexp_grammar]
+
+let _ = fun (_ : abstract_b) -> ()
+
+let (abstract_b_sexp_grammar : abstract_b Sexplib0.Sexp_grammar.t) =
+  { untyped = Any "Test_coverage_for_deriving.abstract_b" }
+;;
+
+let _ = abstract_b_sexp_grammar
+
+[@@@end]
+
+type integer = int [@@deriving sexp] [@@deriving_inline sexp_grammar]
+
+let _ = fun (_ : integer) -> ()
+let (integer_sexp_grammar : integer Sexplib0.Sexp_grammar.t) = int_sexp_grammar
+let _ = integer_sexp_grammar
+
+[@@@end]
+
+type tuple = int * string [@@deriving sexp] [@@deriving_inline sexp_grammar]
+
+let _ = fun (_ : tuple) -> ()
+
+let (tuple_sexp_grammar : tuple Sexplib0.Sexp_grammar.t) =
+  { untyped =
+      Lazy
+        (lazy
+          (List
+             (Cons (int_sexp_grammar.untyped, Cons (string_sexp_grammar.untyped, Empty)))))
+  }
+;;
+
+let _ = tuple_sexp_grammar
+
+[@@@end]
+
+type pos =
+  { x : float
+  ; y : float
+  }
+[@@deriving sexp] [@@deriving_inline sexp_grammar]
+
+let _ = fun (_ : pos) -> ()
+
+let (pos_sexp_grammar : pos Sexplib0.Sexp_grammar.t) =
+  { untyped =
+      Lazy
+        (lazy
+          (List
+             (Fields
+                { allow_extra_fields = false
+                ; fields =
+                    [ No_tag
+                        { name = "x"
+                        ; required = true
+                        ; args = Cons (float_sexp_grammar.untyped, Empty)
+                        }
+                    ; No_tag
+                        { name = "y"
+                        ; required = true
+                        ; args = Cons (float_sexp_grammar.untyped, Empty)
+                        }
+                    ]
+                })))
+  }
+;;
+
+let _ = pos_sexp_grammar
+
+[@@@end]
+
+type 'a unary = 'a list [@@deriving sexp] [@@deriving_inline sexp_grammar]
+
+let _ = fun (_ : 'a unary) -> ()
+
+let unary_sexp_grammar :
+      'a. 'a Sexplib0.Sexp_grammar.t -> 'a unary Sexplib0.Sexp_grammar.t
+  =
+  fun _'a_sexp_grammar -> list_sexp_grammar _'a_sexp_grammar
+;;
+
+let _ = unary_sexp_grammar
+
+[@@@end]
+
+type enum =
+  | One
+  | Two
+  | Three
+[@@deriving sexp] [@@deriving_inline sexp_grammar]
+
+let _ = fun (_ : enum) -> ()
+
+let (enum_sexp_grammar : enum Sexplib0.Sexp_grammar.t) =
+  { untyped =
+      Variant
+        { case_sensitivity = Case_sensitive_except_first_character
+        ; clauses =
+            [ No_tag { name = "One"; clause_kind = Atom_clause }
+            ; No_tag { name = "Two"; clause_kind = Atom_clause }
+            ; No_tag { name = "Three"; clause_kind = Atom_clause }
+            ]
+        }
+  }
+;;
+
+let _ = enum_sexp_grammar
+
+[@@@end]
+
+type ('a, 'b) which =
+  | This of 'a
+  | That of 'b
+[@@deriving sexp] [@@deriving_inline sexp_grammar]
+
+let _ = fun (_ : ('a, 'b) which) -> ()
+
+let which_sexp_grammar :
+      'a 'b.
+      'a Sexplib0.Sexp_grammar.t
+      -> 'b Sexplib0.Sexp_grammar.t
+      -> ('a, 'b) which Sexplib0.Sexp_grammar.t
+  =
+  fun _'a_sexp_grammar _'b_sexp_grammar ->
+  { untyped =
+      Variant
+        { case_sensitivity = Case_sensitive_except_first_character
+        ; clauses =
+            [ No_tag
+                { name = "This"
+                ; clause_kind =
+                    List_clause { args = Cons (_'a_sexp_grammar.untyped, Empty) }
+                }
+            ; No_tag
+                { name = "That"
+                ; clause_kind =
+                    List_clause { args = Cons (_'b_sexp_grammar.untyped, Empty) }
+                }
+            ]
+        }
+  }
+;;
+
+let _ = which_sexp_grammar
+
+[@@@end]
+
+type 'a optional =
+  | No
+  | Yes of 'a
+[@@deriving sexp] [@@deriving_inline sexp_grammar]
+
+let _ = fun (_ : 'a optional) -> ()
+
+let optional_sexp_grammar :
+      'a. 'a Sexplib0.Sexp_grammar.t -> 'a optional Sexplib0.Sexp_grammar.t
+  =
+  fun _'a_sexp_grammar ->
+  { untyped =
+      Variant
+        { case_sensitivity = Case_sensitive_except_first_character
+        ; clauses =
+            [ No_tag { name = "No"; clause_kind = Atom_clause }
+            ; No_tag
+                { name = "Yes"
+                ; clause_kind =
+                    List_clause { args = Cons (_'a_sexp_grammar.untyped, Empty) }
+                }
+            ]
+        }
+  }
+;;
+
+let _ = optional_sexp_grammar
+
+[@@@end]
+
+type empty = | [@@deriving sexp] [@@deriving_inline sexp_grammar]
+
+let _ = fun (_ : empty) -> ()
+let (empty_sexp_grammar : empty Sexplib0.Sexp_grammar.t) = { untyped = Union [] }
+let _ = empty_sexp_grammar
+
+[@@@end]
+
+type _ phantom = int [@@deriving sexp] [@@deriving_inline sexp_grammar]
+
+let _ = fun (_ : _ phantom) -> ()
+
+let phantom_sexp_grammar :
+      'a__086_.
+      'a__086_ Sexplib0.Sexp_grammar.t -> 'a__086_ phantom Sexplib0.Sexp_grammar.t
+  =
+  fun _'a__086__sexp_grammar -> int_sexp_grammar
+;;
+
+let _ = phantom_sexp_grammar
+
+[@@@end]
+
+type color =
+  [ `Red
+  | `Blue
+  ]
+[@@deriving sexp] [@@deriving_inline sexp_grammar]
+
+let _ = fun (_ : color) -> ()
+
+let (color_sexp_grammar : color Sexplib0.Sexp_grammar.t) =
+  { untyped =
+      Variant
+        { case_sensitivity = Case_sensitive
+        ; clauses =
+            [ No_tag { name = "Red"; clause_kind = Atom_clause }
+            ; No_tag { name = "Blue"; clause_kind = Atom_clause }
+            ]
+        }
+  }
+;;
+
+let _ = color_sexp_grammar
+
+[@@@end]
+
+type adjective =
+  [ color
+  | `Fast
+  | `Slow
+  | `Count of int
+  ]
+[@@deriving sexp] [@@deriving_inline sexp_grammar]
+
+let _ = fun (_ : adjective) -> ()
+
+let (adjective_sexp_grammar : adjective Sexplib0.Sexp_grammar.t) =
+  { untyped =
+      Lazy
+        (lazy
+          (Union
+             [ color_sexp_grammar.untyped
+             ; Variant
+                 { case_sensitivity = Case_sensitive
+                 ; clauses =
+                     [ No_tag { name = "Fast"; clause_kind = Atom_clause }
+                     ; No_tag { name = "Slow"; clause_kind = Atom_clause }
+                     ; No_tag
+                         { name = "Count"
+                         ; clause_kind =
+                             List_clause { args = Cons (int_sexp_grammar.untyped, Empty) }
+                         }
+                     ]
+                 }
+             ]))
+  }
+;;
+
+let _ = adjective_sexp_grammar
+
+[@@@end]
+
+type 'a tree =
+  { data : 'a
+  ; children : 'a tree list
+  }
+[@@deriving sexp] [@@deriving_inline sexp_grammar]
+
+let _ = fun (_ : 'a tree) -> ()
+
+include struct
+  open struct
+    let (grammars__118_ : Sexplib0.Sexp_grammar.defn Stdlib.List.t Stdlib.Lazy.t) =
+      lazy
+        (let tree_sexp_grammar
+               : 'a. 'a Sexplib0.Sexp_grammar.t -> 'a tree Sexplib0.Sexp_grammar.t
+           =
+           fun _'a_sexp_grammar ->
+           { untyped = Recursive ("tree", [ _'a_sexp_grammar.untyped ]) }
+         in
+         [ { tycon = "tree"
+           ; tyvars = [ "a" ]
+           ; grammar =
+               List
+                 (Fields
+                    { allow_extra_fields = false
+                    ; fields =
+                        [ No_tag
+                            { name = "data"
+                            ; required = true
+                            ; args = Cons (Tyvar "a", Empty)
+                            }
+                        ; No_tag
+                            { name = "children"
+                            ; required = true
+                            ; args =
+                                Cons
+                                  ( (list_sexp_grammar
+                                       (tree_sexp_grammar { untyped = Tyvar "a" }))
+                                      .untyped
+                                  , Empty )
+                            }
+                        ]
+                    })
+           }
+         ])
+    ;;
+
+    let _ = grammars__118_
+  end
+
+  let tree_sexp_grammar :
+        'a. 'a Sexplib0.Sexp_grammar.t -> 'a tree Sexplib0.Sexp_grammar.t
+    =
+    fun _'a_sexp_grammar ->
+    { untyped =
+        Tycon ("tree", [ _'a_sexp_grammar.untyped ], Stdlib.Lazy.force grammars__118_)
+    }
+  ;;
+
+  let _ = tree_sexp_grammar
+end
+
+[@@@end]
+
+type alpha = int
+
+and beta =
+  { alpha : alpha
+  ; betas : beta list
+  }
+
+and gamma = beta list [@@deriving sexp] [@@deriving_inline sexp_grammar]
+
+let _ = fun (_ : alpha) -> ()
+let _ = fun (_ : beta) -> ()
+let _ = fun (_ : gamma) -> ()
+
+include struct
+  open struct
+    let (grammars__131_ : Sexplib0.Sexp_grammar.defn Stdlib.List.t Stdlib.Lazy.t) =
+      lazy
+        (let (alpha_sexp_grammar : alpha Sexplib0.Sexp_grammar.t) =
+           { untyped = Recursive ("alpha", []) }
+         and (beta_sexp_grammar : beta Sexplib0.Sexp_grammar.t) =
+           { untyped = Recursive ("beta", []) }
+         in
+         [ { tycon = "alpha"; tyvars = []; grammar = int_sexp_grammar.untyped }
+         ; { tycon = "beta"
+           ; tyvars = []
+           ; grammar =
+               List
+                 (Fields
+                    { allow_extra_fields = false
+                    ; fields =
+                        [ No_tag
+                            { name = "alpha"
+                            ; required = true
+                            ; args = Cons (alpha_sexp_grammar.untyped, Empty)
+                            }
+                        ; No_tag
+                            { name = "betas"
+                            ; required = true
+                            ; args =
+                                Cons ((list_sexp_grammar beta_sexp_grammar).untyped, Empty)
+                            }
+                        ]
+                    })
+           }
+         ])
+    ;;
+
+    let _ = grammars__131_
+  end
+
+  let (alpha_sexp_grammar : alpha Sexplib0.Sexp_grammar.t) =
+    { untyped = Lazy (lazy (Tycon ("alpha", [], Stdlib.Lazy.force grammars__131_))) }
+
+  and (beta_sexp_grammar : beta Sexplib0.Sexp_grammar.t) =
+    { untyped = Lazy (lazy (Tycon ("beta", [], Stdlib.Lazy.force grammars__131_))) }
+  ;;
+
+  let _ = alpha_sexp_grammar
+  and _ = beta_sexp_grammar
+end
+
+let (gamma_sexp_grammar : gamma Sexplib0.Sexp_grammar.t) =
+  { untyped = Lazy (lazy (list_sexp_grammar beta_sexp_grammar).untyped) }
+;;
+
+let _ = gamma_sexp_grammar
+
+[@@@end]
+
+type record_attributes =
+  { a : int [@default 0]
+  ; b : bool [@sexp.bool]
+  ; c : float option [@sexp.option]
+  ; d : string list [@sexp.list]
+  ; e : bytes array [@sexp.array]
+  ; f : Ppx_sexp_conv_lib.Sexp.t [@sexp.omit_nil]
+  }
+[@@sexp.allow_extra_fields] [@@deriving sexp] [@@deriving_inline sexp_grammar]
+
+let _ = fun (_ : record_attributes) -> ()
+
+let (record_attributes_sexp_grammar : record_attributes Sexplib0.Sexp_grammar.t) =
+  { untyped =
+      Lazy
+        (lazy
+          (List
+             (Fields
+                { allow_extra_fields = true
+                ; fields =
+                    [ No_tag
+                        { name = "a"
+                        ; required = false
+                        ; args = Cons (int_sexp_grammar.untyped, Empty)
+                        }
+                    ; No_tag { name = "b"; required = false; args = Empty }
+                    ; No_tag
+                        { name = "c"
+                        ; required = false
+                        ; args = Cons (float_sexp_grammar.untyped, Empty)
+                        }
+                    ; No_tag
+                        { name = "d"
+                        ; required = false
+                        ; args = Cons (List (Many string_sexp_grammar.untyped), Empty)
+                        }
+                    ; No_tag
+                        { name = "e"
+                        ; required = false
+                        ; args = Cons (List (Many bytes_sexp_grammar.untyped), Empty)
+                        }
+                    ; No_tag
+                        { name = "f"
+                        ; required = false
+                        ; args =
+                            Cons (Ppx_sexp_conv_lib.Sexp.t_sexp_grammar.untyped, Empty)
+                        }
+                    ]
+                })))
+  }
+;;
+
+let _ = record_attributes_sexp_grammar
+
+[@@@end]
+
+type variant_attributes =
+  | A
+  | B of int list [@sexp.list]
+  | C of
+      { a : int [@default 0]
+      ; b : bool [@sexp.bool]
+      ; c : float option [@sexp.option]
+      ; d : string list [@sexp.list]
+      ; e : bytes array [@sexp.array]
+      ; f : Ppx_sexp_conv_lib.Sexp.t [@sexp.omit_nil]
+      } [@sexp.allow_extra_fields]
+[@@deriving sexp] [@@deriving_inline sexp_grammar]
+
+let _ = fun (_ : variant_attributes) -> ()
+
+let (variant_attributes_sexp_grammar : variant_attributes Sexplib0.Sexp_grammar.t) =
+  { untyped =
+      Lazy
+        (lazy
+          (Variant
+             { case_sensitivity = Case_sensitive_except_first_character
+             ; clauses =
+                 [ No_tag { name = "A"; clause_kind = Atom_clause }
+                 ; No_tag
+                     { name = "B"
+                     ; clause_kind = List_clause { args = Many int_sexp_grammar.untyped }
+                     }
+                 ; No_tag
+                     { name = "C"
+                     ; clause_kind =
+                         List_clause
+                           { args =
+                               Fields
+                                 { allow_extra_fields = true
+                                 ; fields =
+                                     [ No_tag
+                                         { name = "a"
+                                         ; required = false
+                                         ; args = Cons (int_sexp_grammar.untyped, Empty)
+                                         }
+                                     ; No_tag
+                                         { name = "b"; required = false; args = Empty }
+                                     ; No_tag
+                                         { name = "c"
+                                         ; required = false
+                                         ; args = Cons (float_sexp_grammar.untyped, Empty)
+                                         }
+                                     ; No_tag
+                                         { name = "d"
+                                         ; required = false
+                                         ; args =
+                                             Cons
+                                               ( List (Many string_sexp_grammar.untyped)
+                                               , Empty )
+                                         }
+                                     ; No_tag
+                                         { name = "e"
+                                         ; required = false
+                                         ; args =
+                                             Cons
+                                               ( List (Many bytes_sexp_grammar.untyped)
+                                               , Empty )
+                                         }
+                                     ; No_tag
+                                         { name = "f"
+                                         ; required = false
+                                         ; args =
+                                             Cons
+                                               ( Ppx_sexp_conv_lib.Sexp.t_sexp_grammar
+                                                   .untyped
+                                               , Empty )
+                                         }
+                                     ]
+                                 }
+                           }
+                     }
+                 ]
+             }))
+  }
+;;
+
+let _ = variant_attributes_sexp_grammar
+
+[@@@end]
+
+type polymorphic_variant_attributes =
+  [ `A
+  | `B of int list [@sexp.list]
+  ]
+[@@deriving sexp] [@@deriving_inline sexp_grammar]
+
+let _ = fun (_ : polymorphic_variant_attributes) -> ()
+
+let (polymorphic_variant_attributes_sexp_grammar :
+      polymorphic_variant_attributes Sexplib0.Sexp_grammar.t)
+  =
+  { untyped =
+      Lazy
+        (lazy
+          (Variant
+             { case_sensitivity = Case_sensitive
+             ; clauses =
+                 [ No_tag { name = "A"; clause_kind = Atom_clause }
+                 ; No_tag
+                     { name = "B"
+                     ; clause_kind = List_clause { args = Many int_sexp_grammar.untyped }
+                     }
+                 ]
+             }))
+  }
+;;
+
+let _ = polymorphic_variant_attributes_sexp_grammar
+
+[@@@end]
+
+type opaque =
+  { x : (string[@sexp.opaque])
+  ; y : int -> int
+  }
+[@@deriving sexp] [@@deriving_inline sexp_grammar]
+
+let _ = fun (_ : opaque) -> ()
+
+let (opaque_sexp_grammar : opaque Sexplib0.Sexp_grammar.t) =
+  { untyped =
+      Lazy
+        (lazy
+          (List
+             (Fields
+                { allow_extra_fields = false
+                ; fields =
+                    [ No_tag
+                        { name = "x"
+                        ; required = true
+                        ; args =
+                            Cons (Sexplib0.Sexp_conv.opaque_sexp_grammar.untyped, Empty)
+                        }
+                    ; No_tag
+                        { name = "y"
+                        ; required = true
+                        ; args = Cons (Sexplib0.Sexp_conv.fun_sexp_grammar.untyped, Empty)
+                        }
+                    ]
+                })))
+  }
+;;
+
+let _ = opaque_sexp_grammar
+
+[@@@end]

unikernel/duniverse/ppx_sexp_conv/test/sexp_grammar/test_coverage_for_deriving.mli

@@ -0,0 +1,283 @@
+(** This file covers a lot of cases for [@@deriving], for both interface and
+    implementation. They are also exported for validation. *)
+
+type abstract_a [@@deriving sexp] [@@deriving_inline sexp_grammar]
+
+include sig
+  [@@@ocaml.warning "-32"]
+
+  val abstract_a_sexp_grammar : abstract_a Sexplib0.Sexp_grammar.t
+end
+[@@ocaml.doc "@inline"]
+
+[@@@end]
+
+type abstract_b [@@deriving sexp] [@@deriving_inline sexp_grammar]
+
+include sig
+  [@@@ocaml.warning "-32"]
+
+  val abstract_b_sexp_grammar : abstract_b Sexplib0.Sexp_grammar.t
+end
+[@@ocaml.doc "@inline"]
+
+[@@@end]
+
+type integer = int [@@deriving sexp] [@@deriving_inline sexp_grammar]
+
+include sig
+  [@@@ocaml.warning "-32"]
+
+  val integer_sexp_grammar : integer Sexplib0.Sexp_grammar.t
+end
+[@@ocaml.doc "@inline"]
+
+[@@@end]
+
+type tuple = int * string [@@deriving sexp] [@@deriving_inline sexp_grammar]
+
+include sig
+  [@@@ocaml.warning "-32"]
+
+  val tuple_sexp_grammar : tuple Sexplib0.Sexp_grammar.t
+end
+[@@ocaml.doc "@inline"]
+
+[@@@end]
+
+type pos =
+  { x : float
+  ; y : float
+  }
+[@@deriving sexp] [@@deriving_inline sexp_grammar]
+
+include sig
+  [@@@ocaml.warning "-32"]
+
+  val pos_sexp_grammar : pos Sexplib0.Sexp_grammar.t
+end
+[@@ocaml.doc "@inline"]
+
+[@@@end]
+
+type 'a unary = 'a list [@@deriving sexp] [@@deriving_inline sexp_grammar]
+
+include sig
+  [@@@ocaml.warning "-32"]
+
+  val unary_sexp_grammar : 'a Sexplib0.Sexp_grammar.t -> 'a unary Sexplib0.Sexp_grammar.t
+end
+[@@ocaml.doc "@inline"]
+
+[@@@end]
+
+type enum =
+  | One
+  | Two
+  | Three
+[@@deriving sexp] [@@deriving_inline sexp_grammar]
+
+include sig
+  [@@@ocaml.warning "-32"]
+
+  val enum_sexp_grammar : enum Sexplib0.Sexp_grammar.t
+end
+[@@ocaml.doc "@inline"]
+
+[@@@end]
+
+type ('a, 'b) which =
+  | This of 'a
+  | That of 'b
+[@@deriving sexp] [@@deriving_inline sexp_grammar]
+
+include sig
+  [@@@ocaml.warning "-32"]
+
+  val which_sexp_grammar
+    :  'a Sexplib0.Sexp_grammar.t
+    -> 'b Sexplib0.Sexp_grammar.t
+    -> ('a, 'b) which Sexplib0.Sexp_grammar.t
+end
+[@@ocaml.doc "@inline"]
+
+[@@@end]
+
+type 'a optional =
+  | No
+  | Yes of 'a
+[@@deriving sexp] [@@deriving_inline sexp_grammar]
+
+include sig
+  [@@@ocaml.warning "-32"]
+
+  val optional_sexp_grammar
+    :  'a Sexplib0.Sexp_grammar.t
+    -> 'a optional Sexplib0.Sexp_grammar.t
+end
+[@@ocaml.doc "@inline"]
+
+[@@@end]
+
+type empty = | [@@deriving sexp] [@@deriving_inline sexp_grammar]
+
+include sig
+  [@@@ocaml.warning "-32"]
+
+  val empty_sexp_grammar : empty Sexplib0.Sexp_grammar.t
+end
+[@@ocaml.doc "@inline"]
+
+[@@@end]
+
+type _ phantom = int [@@deriving sexp] [@@deriving_inline sexp_grammar]
+
+include sig
+  [@@@ocaml.warning "-32"]
+
+  val phantom_sexp_grammar
+    :  'a__003_ Sexplib0.Sexp_grammar.t
+    -> 'a__003_ phantom Sexplib0.Sexp_grammar.t
+end
+[@@ocaml.doc "@inline"]
+
+[@@@end]
+
+type color =
+  [ `Red
+  | `Blue
+  ]
+[@@deriving sexp] [@@deriving_inline sexp_grammar]
+
+include sig
+  [@@@ocaml.warning "-32"]
+
+  val color_sexp_grammar : color Sexplib0.Sexp_grammar.t
+end
+[@@ocaml.doc "@inline"]
+
+[@@@end]
+
+type adjective =
+  [ color
+  | `Fast
+  | `Slow
+  | `Count of int
+  ]
+[@@deriving sexp] [@@deriving_inline sexp_grammar]
+
+include sig
+  [@@@ocaml.warning "-32"]
+
+  val adjective_sexp_grammar : adjective Sexplib0.Sexp_grammar.t
+end
+[@@ocaml.doc "@inline"]
+
+[@@@end]
+
+type 'a tree =
+  { data : 'a
+  ; children : 'a tree list
+  }
+[@@deriving sexp] [@@deriving_inline sexp_grammar]
+
+include sig
+  [@@@ocaml.warning "-32"]
+
+  val tree_sexp_grammar : 'a Sexplib0.Sexp_grammar.t -> 'a tree Sexplib0.Sexp_grammar.t
+end
+[@@ocaml.doc "@inline"]
+
+[@@@end]
+
+type alpha = int
+
+and beta =
+  { alpha : alpha
+  ; betas : beta list
+  }
+
+and gamma = beta list [@@deriving sexp] [@@deriving_inline sexp_grammar]
+
+include sig
+  [@@@ocaml.warning "-32"]
+
+  val alpha_sexp_grammar : alpha Sexplib0.Sexp_grammar.t
+  val beta_sexp_grammar : beta Sexplib0.Sexp_grammar.t
+  val gamma_sexp_grammar : gamma Sexplib0.Sexp_grammar.t
+end
+[@@ocaml.doc "@inline"]
+
+[@@@end]
+
+type record_attributes =
+  { a : int
+  ; b : bool
+  ; c : float option
+  ; d : string list
+  ; e : bytes array
+  ; f : Ppx_sexp_conv_lib.Sexp.t
+  }
+[@@deriving sexp] [@@deriving_inline sexp_grammar]
+
+include sig
+  [@@@ocaml.warning "-32"]
+
+  val record_attributes_sexp_grammar : record_attributes Sexplib0.Sexp_grammar.t
+end
+[@@ocaml.doc "@inline"]
+
+[@@@end]
+
+type variant_attributes =
+  | A
+  | B of int list
+  | C of
+      { a : int
+      ; b : bool
+      ; c : float option
+      ; d : string list
+      ; e : bytes array
+      ; f : Ppx_sexp_conv_lib.Sexp.t
+      }
+[@@deriving sexp] [@@deriving_inline sexp_grammar]
+
+include sig
+  [@@@ocaml.warning "-32"]
+
+  val variant_attributes_sexp_grammar : variant_attributes Sexplib0.Sexp_grammar.t
+end
+[@@ocaml.doc "@inline"]
+
+[@@@end]
+
+type polymorphic_variant_attributes =
+  [ `A
+  | `B of int list
+  ]
+[@@deriving sexp] [@@deriving_inline sexp_grammar]
+
+include sig
+  [@@@ocaml.warning "-32"]
+
+  val polymorphic_variant_attributes_sexp_grammar
+    : polymorphic_variant_attributes Sexplib0.Sexp_grammar.t
+end
+[@@ocaml.doc "@inline"]
+
+[@@@end]
+
+type opaque =
+  { x : string
+  ; y : int -> int
+  }
+[@@deriving sexp] [@@deriving_inline sexp_grammar]
+
+include sig
+  [@@@ocaml.warning "-32"]
+
+  val opaque_sexp_grammar : opaque Sexplib0.Sexp_grammar.t
+end
+[@@ocaml.doc "@inline"]
+
+[@@@end]

unikernel/duniverse/ppx_sexp_conv/test/sexp_grammar/test_extension.ml

@@ -0,0 +1,19 @@
+open! Base
+
+(* Not sure how much people will want to use this, considering that the input is more
+   complicated and specific than the output, but they have it. *)
+module type S = sig
+  val t_sexp_grammar : [%sexp_grammar: int Map.M(String).t]
+end
+
+module _ (M : S) : sig
+  val t_sexp_grammar : int Map.M(String).t Sexplib0.Sexp_grammar.t [@@warning "-32"]
+end =
+  M
+
+(* The grammar is illegible, so just make sure it builds. *)
+
+let (_ : _ Sexplib0.Sexp_grammar.t) = [%sexp_grammar: int Map.M(String).t]
+
+(* This used to give a compilation error. *)
+let (_ : _ Sexplib0.Sexp_grammar.t) = [%sexp_grammar: _ list]

unikernel/duniverse/ppx_sexp_conv/test/sexp_grammar/test_extension.mli

@@ -0,0 +1 @@
+(*_ This signature is deliberately empty. *)

unikernel/duniverse/ppx_sexp_conv/test/sexp_grammar/test_functors.ml

@@ -0,0 +1,158 @@
+open! Base
+
+module Maybe = struct
+  type 'a t = 'a option [@@deriving_inline sexp_grammar]
+
+  let _ = fun (_ : 'a t) -> ()
+
+  let t_sexp_grammar : 'a. 'a Sexplib0.Sexp_grammar.t -> 'a t Sexplib0.Sexp_grammar.t =
+    fun _'a_sexp_grammar -> option_sexp_grammar _'a_sexp_grammar
+  ;;
+
+  let _ = t_sexp_grammar
+
+  [@@@end]
+end
+
+module Make (T : sig
+  type 'a t [@@deriving sexp_grammar]
+end) =
+struct
+  [@@@warning "-37"]
+
+  type 'a t = T of 'a T.t u
+  and 'a u = U of 'a T.t t Maybe.t [@@deriving_inline sexp_grammar]
+
+  let _ = fun (_ : 'a t) -> ()
+  let _ = fun (_ : 'a u) -> ()
+
+  include struct
+    open struct
+      let (grammars__001_ : Sexplib0.Sexp_grammar.defn Stdlib.List.t Stdlib.Lazy.t) =
+        lazy
+          (let t_sexp_grammar
+                 : 'a. 'a Sexplib0.Sexp_grammar.t -> 'a t Sexplib0.Sexp_grammar.t
+             =
+             fun _'a_sexp_grammar ->
+             { untyped = Recursive ("t", [ _'a_sexp_grammar.untyped ]) }
+           and u_sexp_grammar
+                 : 'a. 'a Sexplib0.Sexp_grammar.t -> 'a u Sexplib0.Sexp_grammar.t
+             =
+             fun _'a_sexp_grammar ->
+             { untyped = Recursive ("u", [ _'a_sexp_grammar.untyped ]) }
+           in
+           [ { tycon = "t"
+             ; tyvars = [ "a" ]
+             ; grammar =
+                 Variant
+                   { case_sensitivity = Case_sensitive_except_first_character
+                   ; clauses =
+                       [ No_tag
+                           { name = "T"
+                           ; clause_kind =
+                               List_clause
+                                 { args =
+                                     Cons
+                                       ( (u_sexp_grammar
+                                            (T.t_sexp_grammar { untyped = Tyvar "a" }))
+                                           .untyped
+                                       , Empty )
+                                 }
+                           }
+                       ]
+                   }
+             }
+           ; { tycon = "u"
+             ; tyvars = [ "a" ]
+             ; grammar =
+                 Variant
+                   { case_sensitivity = Case_sensitive_except_first_character
+                   ; clauses =
+                       [ No_tag
+                           { name = "U"
+                           ; clause_kind =
+                               List_clause
+                                 { args =
+                                     Cons
+                                       ( (Maybe.t_sexp_grammar
+                                            (t_sexp_grammar
+                                               (T.t_sexp_grammar { untyped = Tyvar "a" })))
+                                           .untyped
+                                       , Empty )
+                                 }
+                           }
+                       ]
+                   }
+             }
+           ])
+      ;;
+
+      let _ = grammars__001_
+    end
+
+    let t_sexp_grammar : 'a. 'a Sexplib0.Sexp_grammar.t -> 'a t Sexplib0.Sexp_grammar.t =
+      fun _'a_sexp_grammar ->
+      { untyped =
+          Tycon ("t", [ _'a_sexp_grammar.untyped ], Stdlib.Lazy.force grammars__001_)
+      }
+
+    and u_sexp_grammar : 'a. 'a Sexplib0.Sexp_grammar.t -> 'a u Sexplib0.Sexp_grammar.t =
+      fun _'a_sexp_grammar ->
+      { untyped =
+          Tycon ("u", [ _'a_sexp_grammar.untyped ], Stdlib.Lazy.force grammars__001_)
+      }
+    ;;
+
+    let _ = t_sexp_grammar
+    and _ = u_sexp_grammar
+  end
+
+  [@@@end]
+
+  type 'a v = V of 'a t [@@deriving_inline sexp_grammar]
+
+  let _ = fun (_ : 'a v) -> ()
+
+  let v_sexp_grammar : 'a. 'a Sexplib0.Sexp_grammar.t -> 'a v Sexplib0.Sexp_grammar.t =
+    fun _'a_sexp_grammar ->
+    { untyped =
+        Variant
+          { case_sensitivity = Case_sensitive_except_first_character
+          ; clauses =
+              [ No_tag
+                  { name = "V"
+                  ; clause_kind =
+                      List_clause
+                        { args = Cons ((t_sexp_grammar _'a_sexp_grammar).untyped, Empty) }
+                  }
+              ]
+          }
+    }
+  ;;
+
+  let _ = v_sexp_grammar
+
+  [@@@end]
+end
+
+module T1 = Make (Maybe)
+module T2 = Make (T1)
+
+type t = int T2.t * int T1.t [@@deriving_inline sexp_grammar]
+
+let _ = fun (_ : t) -> ()
+
+let (t_sexp_grammar : t Sexplib0.Sexp_grammar.t) =
+  { untyped =
+      Lazy
+        (lazy
+          (List
+             (Cons
+                ( (T2.t_sexp_grammar int_sexp_grammar).untyped
+                , Cons ((T1.t_sexp_grammar int_sexp_grammar).untyped, Empty) ))))
+  }
+;;
+
+let _ = t_sexp_grammar
+
+[@@@end]

unikernel/duniverse/ppx_sexp_conv/test/sexp_grammar/test_functors.mli

@@ -0,0 +1 @@
+(*_ This signature is deliberately empty. *)

unikernel/duniverse/ppx_sexp_conv/test/sexp_grammar/test_gadt.ml

@@ -0,0 +1,75 @@
+open! Base
+
+type t = T : ('a[@sexp.opaque]) -> t [@@deriving sexp] [@@deriving_inline sexp_grammar]
+
+let _ = fun (_ : t) -> ()
+
+let (t_sexp_grammar : t Sexplib0.Sexp_grammar.t) =
+  { untyped =
+      Lazy
+        (lazy
+          (Variant
+             { case_sensitivity = Case_sensitive_except_first_character
+             ; clauses =
+                 [ No_tag
+                     { name = "T"
+                     ; clause_kind =
+                         List_clause
+                           { args =
+                               Cons (Sexplib0.Sexp_conv.opaque_sexp_grammar.untyped, Empty)
+                           }
+                     }
+                 ]
+             }))
+  }
+;;
+
+let _ = t_sexp_grammar
+
+[@@@end]
+
+type nullary = Nullary : nullary [@@deriving sexp] [@@deriving_inline sexp_grammar]
+
+let _ = fun (_ : nullary) -> ()
+
+let (nullary_sexp_grammar : nullary Sexplib0.Sexp_grammar.t) =
+  { untyped =
+      Variant
+        { case_sensitivity = Case_sensitive_except_first_character
+        ; clauses = [ No_tag { name = "Nullary"; clause_kind = Atom_clause } ]
+        }
+  }
+;;
+
+let _ = nullary_sexp_grammar
+
+[@@@end]
+
+(* We can't derive [of_sexp], but we can derive a sensible grammar for this type. *)
+type _ grammar_only = Grammar_only : int -> string grammar_only
+[@@warning "-37"] [@@deriving_inline sexp_grammar]
+
+let _ = fun (_ : _ grammar_only) -> ()
+
+let grammar_only_sexp_grammar :
+      'a__016_.
+      'a__016_ Sexplib0.Sexp_grammar.t -> 'a__016_ grammar_only Sexplib0.Sexp_grammar.t
+  =
+  fun _'a__016__sexp_grammar ->
+  { untyped =
+      Variant
+        { case_sensitivity = Case_sensitive_except_first_character
+        ; clauses =
+            [ No_tag
+                { name = "Grammar_only"
+                ; clause_kind =
+                    List_clause { args = Cons (int_sexp_grammar.untyped, Empty) }
+                }
+            ]
+        }
+  }
+;;
+
+let _ = grammar_only_sexp_grammar
+
+[@@@end]

unikernel/duniverse/ppx_sexp_conv/test/sexp_grammar/test_gadt.mli

@@ -0,0 +1 @@
+(*_ This signature is deliberately empty. *)

unikernel/duniverse/ppx_sexp_conv/test/sexp_grammar/test_nonrec.ml

@@ -0,0 +1,19 @@
+open! Base
+
+open struct
+  type t = int [@@deriving_inline sexp_grammar]
+
+  let _ = fun (_ : t) -> ()
+  let (t_sexp_grammar : t Sexplib0.Sexp_grammar.t) = int_sexp_grammar
+  let _ = t_sexp_grammar
+
+  [@@@end]
+end
+
+type nonrec t = t [@@deriving_inline sexp_grammar]
+
+let _ = fun (_ : t) -> ()
+let (t_sexp_grammar : t Sexplib0.Sexp_grammar.t) = t_sexp_grammar
+let _ = t_sexp_grammar
+
+[@@@end]

unikernel/duniverse/ppx_sexp_conv/test/sexp_grammar/test_nonrec.mli

@@ -0,0 +1 @@
+(*_ This signature is deliberately empty. *)

unikernel/duniverse/ppx_sexp_conv/test/sexp_grammar/test_opaque.ml

@@ -0,0 +1,15 @@
+open! Base
+
+type t = (int[@sexp.opaque]) list [@@deriving_inline sexp_grammar]
+
+let _ = fun (_ : t) -> ()
+
+let (t_sexp_grammar : t Sexplib0.Sexp_grammar.t) =
+  { untyped =
+      Lazy (lazy (list_sexp_grammar Sexplib0.Sexp_conv.opaque_sexp_grammar).untyped)
+  }
+;;
+
+let _ = t_sexp_grammar
+
+[@@@end]

unikernel/duniverse/ppx_sexp_conv/test/sexp_grammar/test_opaque.mli

@@ -0,0 +1 @@
+(*_ This signature is deliberately empty. *)

unikernel/duniverse/ppx_sexp_conv/test/sexp_grammar/test_polymorphic_variants.ml

@@ -0,0 +1,171 @@
+open Base
+
+[@@@warning "-37"]
+
+module _ = struct
+  type 'a t =
+    [ `A
+    | `B
+    ]
+  [@@deriving_inline sexp_grammar]
+
+  let _ = fun (_ : 'a t) -> ()
+
+  let t_sexp_grammar : 'a. 'a Sexplib0.Sexp_grammar.t -> 'a t Sexplib0.Sexp_grammar.t =
+    fun _'a_sexp_grammar ->
+    { untyped =
+        Variant
+          { case_sensitivity = Case_sensitive
+          ; clauses =
+              [ No_tag { name = "A"; clause_kind = Atom_clause }
+              ; No_tag { name = "B"; clause_kind = Atom_clause }
+              ]
+          }
+    }
+  ;;
+
+  let _ = t_sexp_grammar
+
+  [@@@end]
+end
+
+module _ = struct
+  module With_sexp = struct
+    type t =
+      [ `A of int * int
+      | `B of string
+      ]
+    [@@deriving sexp_of]
+  end
+
+  type t =
+    [ `A of int * int
+    | `B of string
+    ]
+  [@@deriving_inline sexp_grammar]
+
+  let _ = fun (_ : t) -> ()
+
+  let (t_sexp_grammar : t Sexplib0.Sexp_grammar.t) =
+    { untyped =
+        Lazy
+          (lazy
+            (Variant
+               { case_sensitivity = Case_sensitive
+               ; clauses =
+                   [ No_tag
+                       { name = "A"
+                       ; clause_kind =
+                           List_clause
+                             { args =
+                                 Cons
+                                   ( List
+                                       (Cons
+                                          ( int_sexp_grammar.untyped
+                                          , Cons (int_sexp_grammar.untyped, Empty) ))
+                                   , Empty )
+                             }
+                       }
+                   ; No_tag
+                       { name = "B"
+                       ; clause_kind =
+                           List_clause
+                             { args = Cons (string_sexp_grammar.untyped, Empty) }
+                       }
+                   ]
+               }))
+    }
+  ;;
+
+  let _ = t_sexp_grammar
+
+  [@@@end]
+
+  open Expect_test_helpers_base
+
+  let%expect_test _ =
+    print_s (With_sexp.sexp_of_t (`A (1, 2)));
+    print_s (With_sexp.sexp_of_t (`B "foo"));
+    [%expect {|
+      (A (1 2))
+      (B foo)
+      |}]
+  ;;
+end
+
+module _ = struct
+  module With_sexp = struct
+    type t =
+      [ `Int of int
+      | `List of int list
+      | `Sexp_dot_list of int list [@sexp.list]
+      ]
+    [@@deriving sexp]
+  end
+
+  type t =
+    [ `Int of int
+    | `List of int list
+    | `Sexp_dot_list of int list [@sexp.list]
+    ]
+  [@@deriving_inline sexp_grammar]
+
+  let _ = fun (_ : t) -> ()
+
+  let (t_sexp_grammar : t Sexplib0.Sexp_grammar.t) =
+    { untyped =
+        Lazy
+          (lazy
+            (Variant
+               { case_sensitivity = Case_sensitive
+               ; clauses =
+                   [ No_tag
+                       { name = "Int"
+                       ; clause_kind =
+                           List_clause { args = Cons (int_sexp_grammar.untyped, Empty) }
+                       }
+                   ; No_tag
+                       { name = "List"
+                       ; clause_kind =
+                           List_clause
+                             { args =
+                                 Cons ((list_sexp_grammar int_sexp_grammar).untyped, Empty)
+                             }
+                       }
+                   ; No_tag
+                       { name = "Sexp_dot_list"
+                       ; clause_kind =
+                           List_clause { args = Many int_sexp_grammar.untyped }
+                       }
+                   ]
+               }))
+    }
+  ;;
+
+  let _ = t_sexp_grammar
+
+  [@@@end]
+
+  let (T : (With_sexp.t, t) Type_equal.t) = T
+
+  open Expect_test_helpers_base
+
+  let%expect_test _ =
+    print_s (With_sexp.sexp_of_t (`Int 1));
+    List.iter
+      [ []; [ 1 ]; [ 1; 2 ] ]
+      ~f:(fun l ->
+        print_s (With_sexp.sexp_of_t (`List l));
+        print_s (With_sexp.sexp_of_t (`Sexp_dot_list l)));
+    [%expect
+      {|
+      (Int 1)
+      (List ())
+      (Sexp_dot_list)
+      (List (1))
+      (Sexp_dot_list 1)
+      (List (1 2))
+      (Sexp_dot_list 1 2)
+      |}]
+  ;;
+end

unikernel/duniverse/ppx_sexp_conv/test/sexp_grammar/test_polymorphic_variants.mli

@@ -0,0 +1 @@
+(*_ This signature is deliberately empty. *)

unikernel/duniverse/ppx_sexp_conv/test/sexp_grammar/test_polymorphic_variants.mlt

@@ -0,0 +1,115 @@
+(* This toplevel test exercises some polymorphic variants that sexp_grammar rejects. We
+   show that in each case, the compiler or sexp would have given an error anyway. *)
+
+open Base
+
+type t = [ `A of int & string ] [@@deriving sexp]
+
+[%%expect
+  {|
+Line _, characters _-_:
+Error: unsupported: polymorphic variant intersection type
+|}]
+
+type t = [ `A of int & string ] [@@deriving sexp_grammar]
+
+[%%expect
+  {|
+Line _, characters _-_:
+Error: sexp_grammar: intersection types are unsupported
+|}]
+
+type t = [> `A ] [@@deriving sexp]
+
+[%%expect
+  {|
+Line _, characters _-_:
+Error: Type unsupported for ppx [of_sexp] conversion
+|}]
+
+type t = [> `A ] [@@deriving sexp_grammar]
+
+[%%expect
+  {|
+Line _, characters _-_:
+Error: sexp_grammar: open polymorphic variant types are unsupported
+|}]
+
+type t = [< `A ] [@@deriving sexp]
+
+[%%expect
+  {|
+Line _, characters _-_:
+Error: A type variable is unbound in this type declaration.
+       In type [< `A ] as 'a the variable 'a is unbound
+|}]
+
+type t = [< `A ] [@@deriving sexp_grammar]
+
+[%%expect
+  {|
+Line _, characters _-_:
+Error: A type variable is unbound in this type declaration.
+       In type [< `A ] as 'a the variable 'a is unbound
+|}]
+
+type 'a t = [< `A ] as 'a [@@deriving sexp]
+
+[%%expect
+  {|
+Line _, characters _-_:
+Error: Type unsupported for ppx [of_sexp] conversion
+|}]
+
+type 'a t = [< `A ] as 'a [@@deriving sexp_grammar]
+
+[%%expect
+  {|
+Line _, characters _-_:
+Error: sexp_grammar: type aliases are unsupported
+|}]
+
+type a = A : [> ] -> a [@@deriving sexp]
+
+[%%expect
+  {|
+Line _, characters _-_:
+Error: Type unsupported for ppx [of_sexp] conversion
+|}]
+
+type a = A : [> ] -> a [@@deriving sexp_of]
+
+[%%expect
+  {|
+Line _, characters _-_:
+Error: Type unsupported for ppx [sexp_of] conversion
+|}]
+
+type a = [ `A ] [@@deriving sexp];;
+
+#verbose true
+
+let f = [%sexp_of: [< a ]]
+
+[%%expect
+  {|
+val f : [< a ] -> Sexp.t = <fun>
+|}]
+
+let f = [%of_sexp: [> a ]]
+
+[%%expect
+  {|
+Line _, characters _-_:
+Error: Type unsupported for ppx [of_sexp] conversion
+|}]
+
+let f = [%of_sexp: [ | a ]]
+
+[%%expect
+  {|
+val f : Sexp.t -> a = <fun>
+|}]
+;;
+
+#verbose false

unikernel/duniverse/ppx_sexp_conv/test/sexp_grammar/test_polymorphism.ml

@@ -0,0 +1,34 @@
+open! Base
+
+type ('a, _, 'b) t = 'a * 'b
+and u = (string, int, float) t [@@deriving_inline sexp_grammar]
+
+let _ = fun (_ : ('a, _, 'b) t) -> ()
+let _ = fun (_ : u) -> ()
+
+let t_sexp_grammar :
+      'a 'b__001_ 'b.
+      'a Sexplib0.Sexp_grammar.t
+      -> 'b__001_ Sexplib0.Sexp_grammar.t
+      -> 'b Sexplib0.Sexp_grammar.t
+      -> ('a, 'b__001_, 'b) t Sexplib0.Sexp_grammar.t
+  =
+  fun _'a_sexp_grammar _'b__001__sexp_grammar _'b_sexp_grammar ->
+  { untyped =
+      List (Cons (_'a_sexp_grammar.untyped, Cons (_'b_sexp_grammar.untyped, Empty)))
+  }
+;;
+
+let _ = t_sexp_grammar
+
+let (u_sexp_grammar : u Sexplib0.Sexp_grammar.t) =
+  { untyped =
+      Lazy
+        (lazy
+          (t_sexp_grammar string_sexp_grammar int_sexp_grammar float_sexp_grammar).untyped)
+  }
+;;
+
+let _ = u_sexp_grammar
+
+[@@@end]

unikernel/duniverse/ppx_sexp_conv/test/sexp_grammar/test_polymorphism.mli

@@ -0,0 +1 @@
+(*_ This signature is deliberately empty. *)

unikernel/duniverse/ppx_sexp_conv/test/sexp_grammar/test_recursive_groups.ml

@@ -0,0 +1,112 @@
+open Base
+
+[@@@warning "-37"]
+
+module _ = struct
+  type t = T of int [@@deriving_inline sexp_grammar]
+
+  let _ = fun (_ : t) -> ()
+
+  let (t_sexp_grammar : t Sexplib0.Sexp_grammar.t) =
+    { untyped =
+        Lazy
+          (lazy
+            (Variant
+               { case_sensitivity = Case_sensitive_except_first_character
+               ; clauses =
+                   [ No_tag
+                       { name = "T"
+                       ; clause_kind =
+                           List_clause { args = Cons (int_sexp_grammar.untyped, Empty) }
+                       }
+                   ]
+               }))
+    }
+  ;;
+
+  let _ = t_sexp_grammar
+
+  [@@@end]
+end
+
+module _ = struct
+  type t =
+    | T_int of int
+    | T_u of u
+
+  and u =
+    | U_int of int
+    | U_t of t
+  [@@deriving_inline sexp_grammar]
+
+  let _ = fun (_ : t) -> ()
+  let _ = fun (_ : u) -> ()
+
+  include struct
+    open struct
+      let (grammars__001_ : Sexplib0.Sexp_grammar.defn Stdlib.List.t Stdlib.Lazy.t) =
+        lazy
+          (let (t_sexp_grammar : t Sexplib0.Sexp_grammar.t) =
+             { untyped = Recursive ("t", []) }
+           and (u_sexp_grammar : u Sexplib0.Sexp_grammar.t) =
+             { untyped = Recursive ("u", []) }
+           in
+           [ { tycon = "t"
+             ; tyvars = []
+             ; grammar =
+                 Variant
+                   { case_sensitivity = Case_sensitive_except_first_character
+                   ; clauses =
+                       [ No_tag
+                           { name = "T_int"
+                           ; clause_kind =
+                               List_clause
+                                 { args = Cons (int_sexp_grammar.untyped, Empty) }
+                           }
+                       ; No_tag
+                           { name = "T_u"
+                           ; clause_kind =
+                               List_clause { args = Cons (u_sexp_grammar.untyped, Empty) }
+                           }
+                       ]
+                   }
+             }
+           ; { tycon = "u"
+             ; tyvars = []
+             ; grammar =
+                 Variant
+                   { case_sensitivity = Case_sensitive_except_first_character
+                   ; clauses =
+                       [ No_tag
+                           { name = "U_int"
+                           ; clause_kind =
+                               List_clause
+                                 { args = Cons (int_sexp_grammar.untyped, Empty) }
+                           }
+                       ; No_tag
+                           { name = "U_t"
+                           ; clause_kind =
+                               List_clause { args = Cons (t_sexp_grammar.untyped, Empty) }
+                           }
+                       ]
+                   }
+             }
+           ])
+      ;;
+
+      let _ = grammars__001_
+    end
+
+    let (t_sexp_grammar : t Sexplib0.Sexp_grammar.t) =
+      { untyped = Lazy (lazy (Tycon ("t", [], Stdlib.Lazy.force grammars__001_))) }
+
+    and (u_sexp_grammar : u Sexplib0.Sexp_grammar.t) =
+      { untyped = Lazy (lazy (Tycon ("u", [], Stdlib.Lazy.force grammars__001_))) }
+    ;;
+
+    let _ = t_sexp_grammar
+    and _ = u_sexp_grammar
+  end
+
+  [@@@end]
+end

unikernel/duniverse/ppx_sexp_conv/test/sexp_grammar/test_recursive_groups.mli

@@ -0,0 +1 @@
+(*_ This signature is deliberately empty. *)

unikernel/duniverse/ppx_sexp_conv/test/sexp_grammar/test_regular_variants.ml

@@ -0,0 +1,163 @@
+open Base
+
+[@@@warning "-37"]
+
+module _ = struct
+  type 'a t =
+    | A
+    | B
+  [@@deriving_inline sexp_grammar]
+
+  let _ = fun (_ : 'a t) -> ()
+
+  let t_sexp_grammar : 'a. 'a Sexplib0.Sexp_grammar.t -> 'a t Sexplib0.Sexp_grammar.t =
+    fun _'a_sexp_grammar ->
+    { untyped =
+        Variant
+          { case_sensitivity = Case_sensitive_except_first_character
+          ; clauses =
+              [ No_tag { name = "A"; clause_kind = Atom_clause }
+              ; No_tag { name = "B"; clause_kind = Atom_clause }
+              ]
+          }
+    }
+  ;;
+
+  let _ = t_sexp_grammar
+
+  [@@@end]
+end
+
+module _ = struct
+  module With_sexp = struct
+    type t =
+      | A of int * int
+      | B of string
+    [@@deriving sexp_of]
+  end
+
+  type t = With_sexp.t =
+    | A of int * int
+    | B of string
+  [@@deriving_inline sexp_grammar]
+
+  let _ = fun (_ : t) -> ()
+
+  let (t_sexp_grammar : t Sexplib0.Sexp_grammar.t) =
+    { untyped =
+        Lazy
+          (lazy
+            (Variant
+               { case_sensitivity = Case_sensitive_except_first_character
+               ; clauses =
+                   [ No_tag
+                       { name = "A"
+                       ; clause_kind =
+                           List_clause
+                             { args =
+                                 Cons
+                                   ( int_sexp_grammar.untyped
+                                   , Cons (int_sexp_grammar.untyped, Empty) )
+                             }
+                       }
+                   ; No_tag
+                       { name = "B"
+                       ; clause_kind =
+                           List_clause
+                             { args = Cons (string_sexp_grammar.untyped, Empty) }
+                       }
+                   ]
+               }))
+    }
+  ;;
+
+  let _ = t_sexp_grammar
+
+  [@@@end]
+
+  open Expect_test_helpers_base
+
+  let%expect_test _ =
+    print_s (With_sexp.sexp_of_t (A (1, 2)));
+    print_s (With_sexp.sexp_of_t (B "foo"));
+    [%expect {|
+      (A 1 2)
+      (B foo)
+      |}]
+  ;;
+end
+
+module _ = struct
+  module With_sexp = struct
+    type t =
+      | Int of int
+      | List of int list
+      | Sexp_dot_list of int list [@sexp.list]
+    [@@deriving sexp]
+  end
+
+  type t = With_sexp.t =
+    | Int of int
+    | List of int list
+    | Sexp_dot_list of int list [@sexp.list]
+  [@@deriving_inline sexp_grammar]
+
+  let _ = fun (_ : t) -> ()
+
+  let (t_sexp_grammar : t Sexplib0.Sexp_grammar.t) =
+    { untyped =
+        Lazy
+          (lazy
+            (Variant
+               { case_sensitivity = Case_sensitive_except_first_character
+               ; clauses =
+                   [ No_tag
+                       { name = "Int"
+                       ; clause_kind =
+                           List_clause { args = Cons (int_sexp_grammar.untyped, Empty) }
+                       }
+                   ; No_tag
+                       { name = "List"
+                       ; clause_kind =
+                           List_clause
+                             { args =
+                                 Cons ((list_sexp_grammar int_sexp_grammar).untyped, Empty)
+                             }
+                       }
+                   ; No_tag
+                       { name = "Sexp_dot_list"
+                       ; clause_kind =
+                           List_clause { args = Many int_sexp_grammar.untyped }
+                       }
+                   ]
+               }))
+    }
+  ;;
+
+  let _ = t_sexp_grammar
+
+  [@@@end]
+
+  let (T : (With_sexp.t, t) Type_equal.t) = T
+
+  open Expect_test_helpers_base
+
+  let%expect_test _ =
+    print_s (With_sexp.sexp_of_t (Int 1));
+    List.iter
+      [ []; [ 1 ]; [ 1; 2 ] ]
+      ~f:(fun l ->
+        print_s (With_sexp.sexp_of_t (List l));
+        print_s (With_sexp.sexp_of_t (Sexp_dot_list l)));
+    [%expect
+      {|
+      (Int 1)
+      (List ())
+      (Sexp_dot_list)
+      (List (1))
+      (Sexp_dot_list 1)
+      (List (1 2))
+      (Sexp_dot_list 1 2)
+      |}]
+  ;;
+end

unikernel/duniverse/ppx_sexp_conv/test/sexp_grammar/test_regular_variants.mli

@@ -0,0 +1 @@
+(*_ This signature is deliberately empty. *)

unikernel/duniverse/ppx_sexp_conv/test/sexp_grammar/test_tag_type_names.ml

@@ -0,0 +1,179 @@
+open! Base
+
+module _ = struct
+  (* Nonrecursive constant *)
+  type t = [ `T of int ] [@@deriving_inline sexp_grammar]
+
+  let _ = fun (_ : t) -> ()
+
+  let (t_sexp_grammar : t Sexplib0.Sexp_grammar.t) =
+    { untyped =
+        Lazy
+          (lazy
+            (Variant
+               { case_sensitivity = Case_sensitive
+               ; clauses =
+                   [ No_tag
+                       { name = "T"
+                       ; clause_kind =
+                           List_clause { args = Cons (int_sexp_grammar.untyped, Empty) }
+                       }
+                   ]
+               }))
+    }
+  ;;
+
+  let _ = t_sexp_grammar
+
+  [@@@end]
+end
+
+module _ = struct
+  (* Recursive constant *)
+  type t = [ `T of t ] [@@deriving_inline sexp_grammar]
+
+  let _ = fun (_ : t) -> ()
+
+  include struct
+    open struct
+      let (grammars__001_ : Sexplib0.Sexp_grammar.defn Stdlib.List.t Stdlib.Lazy.t) =
+        lazy
+          (let (t_sexp_grammar : t Sexplib0.Sexp_grammar.t) =
+             { untyped = Recursive ("t", []) }
+           in
+           [ { tycon = "t"
+             ; tyvars = []
+             ; grammar =
+                 Variant
+                   { case_sensitivity = Case_sensitive
+                   ; clauses =
+                       [ No_tag
+                           { name = "T"
+                           ; clause_kind =
+                               List_clause { args = Cons (t_sexp_grammar.untyped, Empty) }
+                           }
+                       ]
+                   }
+             }
+           ])
+      ;;
+
+      let _ = grammars__001_
+    end
+
+    let (t_sexp_grammar : t Sexplib0.Sexp_grammar.t) =
+      { untyped = Lazy (lazy (Tycon ("t", [], Stdlib.Lazy.force grammars__001_))) }
+    ;;
+
+    let _ = t_sexp_grammar
+  end
+
+  [@@@end]
+end
+
+module _ = struct
+  (* Nonrecursive parameterized *)
+  type 'a t = [ `T of 'a ] [@@deriving_inline sexp_grammar]
+
+  let _ = fun (_ : 'a t) -> ()
+
+  let t_sexp_grammar : 'a. 'a Sexplib0.Sexp_grammar.t -> 'a t Sexplib0.Sexp_grammar.t =
+    fun _'a_sexp_grammar ->
+    { untyped =
+        Variant
+          { case_sensitivity = Case_sensitive
+          ; clauses =
+              [ No_tag
+                  { name = "T"
+                  ; clause_kind =
+                      List_clause { args = Cons (_'a_sexp_grammar.untyped, Empty) }
+                  }
+              ]
+          }
+    }
+  ;;
+
+  let _ = t_sexp_grammar
+
+  [@@@end]
+end
+
+module _ = struct
+  (* Recursive parameterized *)
+  type 'a t = [ `T of 'a t ] [@@deriving_inline sexp_grammar]
+
+  let _ = fun (_ : 'a t) -> ()
+
+  include struct
+    open struct
+      let (grammars__002_ : Sexplib0.Sexp_grammar.defn Stdlib.List.t Stdlib.Lazy.t) =
+        lazy
+          (let t_sexp_grammar
+                 : 'a. 'a Sexplib0.Sexp_grammar.t -> 'a t Sexplib0.Sexp_grammar.t
+             =
+             fun _'a_sexp_grammar ->
+             { untyped = Recursive ("t", [ _'a_sexp_grammar.untyped ]) }
+           in
+           [ { tycon = "t"
+             ; tyvars = [ "a" ]
+             ; grammar =
+                 Variant
+                   { case_sensitivity = Case_sensitive
+                   ; clauses =
+                       [ No_tag
+                           { name = "T"
+                           ; clause_kind =
+                               List_clause
+                                 { args =
+                                     Cons
+                                       ( (t_sexp_grammar { untyped = Tyvar "a" }).untyped
+                                       , Empty )
+                                 }
+                           }
+                       ]
+                   }
+             }
+           ])
+      ;;
+
+      let _ = grammars__002_
+    end
+
+    let t_sexp_grammar : 'a. 'a Sexplib0.Sexp_grammar.t -> 'a t Sexplib0.Sexp_grammar.t =
+      fun _'a_sexp_grammar ->
+      { untyped =
+          Tycon ("t", [ _'a_sexp_grammar.untyped ], Stdlib.Lazy.force grammars__002_)
+      }
+    ;;
+
+    let _ = t_sexp_grammar
+  end
+
+  [@@@end]
+end
+
+module _ = struct
+  (* Aliasing of non-parameterized type *)
+  type t = int [@@deriving_inline sexp_grammar]
+
+  let _ = fun (_ : t) -> ()
+  let (t_sexp_grammar : t Sexplib0.Sexp_grammar.t) = int_sexp_grammar
+  let _ = t_sexp_grammar
+
+  [@@@end]
+end
+
+module _ = struct
+  (* Aliasing of parameterized type *)
+  type 'a t = 'a list [@@deriving_inline sexp_grammar]
+
+  let _ = fun (_ : 'a t) -> ()
+
+  let t_sexp_grammar : 'a. 'a Sexplib0.Sexp_grammar.t -> 'a t Sexplib0.Sexp_grammar.t =
+    fun _'a_sexp_grammar -> list_sexp_grammar _'a_sexp_grammar
+  ;;
+
+  let _ = t_sexp_grammar
+
+  [@@@end]
+end

unikernel/duniverse/ppx_sexp_conv/test/sexp_grammar/test_tag_type_names.mli

@@ -0,0 +1 @@
+(*_ This signature is deliberately empty. *)

unikernel/duniverse/ppx_sexp_conv/test/sexp_grammar/test_tags.ml

@@ -0,0 +1,493 @@
+open Base
+
+module _ = struct
+  module type S = sig
+    type t [@@deriving sexp_grammar]
+  end
+
+  let show_grammar (module M : S) =
+    Expect_test_helpers_base.print_s ([%sexp_of: _ Sexp_grammar.t] [%sexp_grammar: M.t])
+  ;;
+
+  let%expect_test "basic" =
+    show_grammar
+      (module struct
+        type nonrec t = (unit[@tag "key" = Atom "value"]) [@@deriving sexp_grammar]
+      end);
+    [%expect
+      {|
+      (Tagged (
+        (key   key)
+        (value value)
+        (grammar (List Empty))))
+      |}]
+  ;;
+
+  let%expect_test "tag ordering" =
+    show_grammar
+      (module struct
+        type nonrec t =
+          (unit
+          [@tag
+            "key1" = Atom "value1";
+            "key2" = Atom "value2"])
+        [@@deriving sexp_grammar]
+      end);
+    [%expect
+      {|
+      (Tagged (
+        (key   key1)
+        (value value1)
+        (grammar (
+          Tagged (
+            (key   key2)
+            (value value2)
+            (grammar (List Empty)))))))
+      |}]
+  ;;
+
+  let%expect_test "tag idents/expressions" =
+    show_grammar
+      (module struct
+        let k = "key"
+        let v = Sexp.Atom "value"
+        let kf () = k
+        let vf () = v
+
+        type nonrec t =
+          (unit
+          [@tag
+            k = v;
+            kf () = vf ()])
+        [@@deriving sexp_grammar]
+      end);
+    [%expect
+      {|
+      (Tagged (
+        (key   key)
+        (value value)
+        (grammar (
+          Tagged (
+            (key   key)
+            (value value)
+            (grammar (List Empty)))))))
+      |}]
+  ;;
+
+  let%expect_test "tag nesting" =
+    show_grammar
+      (module struct
+        type nonrec t' = (unit[@sexp_grammar.tag "inner" = Atom "inner value"])
+        [@@deriving sexp_grammar]
+
+        type nonrec t = (t'[@sexp_grammar.tag "outer" = Atom "outer value"])
+        [@@deriving sexp_grammar]
+      end);
+    [%expect
+      {|
+      (Tagged (
+        (key   outer)
+        (value "outer value")
+        (grammar (
+          Tagged (
+            (key   inner)
+            (value "inner value")
+            (grammar (List Empty)))))))
+      |}]
+  ;;
+
+  let%expect_test "@tags attribute" =
+    (* literal constant *)
+    show_grammar
+      (module struct
+        type t = (unit[@tags [ "y", Atom "Y"; "z", Atom "Z" ]]) [@@deriving sexp_grammar]
+      end);
+    [%expect
+      {|
+      (Tagged (
+        (key   y)
+        (value Y)
+        (grammar (
+          Tagged (
+            (key   z)
+            (value Z)
+            (grammar (List Empty)))))))
+      |}];
+    (* non-constant expression *)
+    show_grammar
+      (module struct
+        type t =
+          (unit
+          [@tags List.concat [ [ "x", Sexp.Atom "X" ]; [ "y", Atom "Y"; "z", Atom "Z" ] ]])
+        [@@deriving sexp_grammar]
+      end);
+    [%expect
+      {|
+      (Tagged (
+        (key   x)
+        (value X)
+        (grammar (
+          Tagged (
+            (key   y)
+            (value Y)
+            (grammar (
+              Tagged (
+                (key   z)
+                (value Z)
+                (grammar (List Empty))))))))))
+      |}];
+    (* cons onto non-constant expression *)
+    show_grammar
+      (module struct
+        type t =
+          (unit
+          [@tags
+            ("w", Sexp.Atom "W")
+            :: List.concat [ [ "x", Sexp.Atom "X" ]; [ "y", Atom "Y"; "z", Atom "Z" ] ]])
+        [@@deriving sexp_grammar]
+      end);
+    [%expect
+      {|
+      (Tagged (
+        (key   w)
+        (value W)
+        (grammar (
+          Tagged (
+            (key   x)
+            (value X)
+            (grammar (
+              Tagged (
+                (key   y)
+                (value Y)
+                (grammar (
+                  Tagged (
+                    (key   z)
+                    (value Z)
+                    (grammar (List Empty)))))))))))))
+      |}];
+    (* empty *)
+    show_grammar
+      (module struct
+        type t = (unit[@tags List.concat []]) [@@deriving sexp_grammar]
+      end);
+    [%expect {| (List Empty) |}];
+    (* with [@tag] *)
+    show_grammar
+      (module struct
+        type t = (unit[@tag "a" = Atom "A"] [@tags [ "b", Atom "B" ]])
+        [@@deriving sexp_grammar]
+      end);
+    [%expect
+      {|
+      (Tagged (
+        (key   a)
+        (value A)
+        (grammar (
+          Tagged (
+            (key   b)
+            (value B)
+            (grammar (List Empty)))))))
+      |}]
+  ;;
+
+  let%expect_test "doc comments - variant clauses" =
+    show_grammar
+      (module struct
+        [@@@ocaml.warning "-37"]
+
+        (** IGNORED *)
+        type t =
+          | Clause0 of (unit[@tag "k0" = Atom "v0"]) (** first clause *)
+          | Clause1 [@tag "k1" = Atom "v1"] (** second clause *)
+        [@@deriving sexp_grammar ~tags_of_doc_comments]
+        (** IGNORED *)
+      end);
+    [%expect
+      {|
+      (Variant (
+        (case_sensitivity Case_sensitive_except_first_character)
+        (clauses (
+          (Tag (
+            (key   sexp_grammar.doc_comment)
+            (value " first clause ")
+            (grammar (
+              No_tag (
+                (name Clause0)
+                (clause_kind (
+                  List_clause (
+                    args (
+                      Cons
+                      (Tagged (
+                        (key   k0)
+                        (value v0)
+                        (grammar (List Empty))))
+                      Empty)))))))))
+          (Tag (
+            (key   sexp_grammar.doc_comment)
+            (value " second clause ")
+            (grammar (
+              Tag (
+                (key   k1)
+                (value v1)
+                (grammar (
+                  No_tag (
+                    (name        Clause1)
+                    (clause_kind Atom_clause)))))))))))))
+      |}]
+  ;;
+
+  let%expect_test "doc comments - poly variant clauses" =
+    show_grammar
+      (module struct
+        [@@@ocaml.warning "-37"]
+
+        (** IGNORED *)
+        type t =
+          ([ `Clause0 of (unit[@tag "k0" = Atom "v0"]) (** first clause *)
+           | `Clause1 [@tag "k1" = Atom "v1"] (** second clause *)
+           ]
+          [@tag "kouter" = Atom "vouter"])
+        [@@deriving sexp_grammar ~tags_of_doc_comments]
+        (** IGNORED *)
+      end);
+    [%expect
+      {|
+      (Tagged (
+        (key   kouter)
+        (value vouter)
+        (grammar (
+          Variant (
+            (case_sensitivity Case_sensitive)
+            (clauses (
+              (Tag (
+                (key   sexp_grammar.doc_comment)
+                (value " first clause ")
+                (grammar (
+                  No_tag (
+                    (name Clause0)
+                    (clause_kind (
+                      List_clause (
+                        args (
+                          Cons
+                          (Tagged (
+                            (key   k0)
+                            (value v0)
+                            (grammar (List Empty))))
+                          Empty)))))))))
+              (Tag (
+                (key   sexp_grammar.doc_comment)
+                (value " second clause ")
+                (grammar (
+                  Tag (
+                    (key   k1)
+                    (value v1)
+                    (grammar (
+                      No_tag (
+                        (name        Clause1)
+                        (clause_kind Atom_clause))))))))))))))))
+      |}]
+  ;;
+
+  let%expect_test "doc comments - record fields" =
+    show_grammar
+      (module struct
+        (** IGNORED *)
+        type t =
+          { field0 : (unit[@tag "k0" = Atom "v0"]) (** first field *)
+          ; field1 : unit [@tag "k1" = Atom "v1"] (** second field *)
+          }
+        [@@deriving sexp_grammar ~tags_of_doc_comments]
+        (** IGNORED *)
+      end);
+    [%expect
+      {|
+      (List (
+        Fields (
+          (allow_extra_fields false)
+          (fields (
+            (Tag (
+              (key   sexp_grammar.doc_comment)
+              (value " first field ")
+              (grammar (
+                No_tag (
+                  (name     field0)
+                  (required true)
+                  (args (
+                    Cons
+                    (Tagged (
+                      (key   k0)
+                      (value v0)
+                      (grammar (List Empty))))
+                    Empty)))))))
+            (Tag (
+              (key   sexp_grammar.doc_comment)
+              (value " second field ")
+              (grammar (
+                Tag (
+                  (key   k1)
+                  (value v1)
+                  (grammar (
+                    No_tag (
+                      (name     field1)
+                      (required true)
+                      (args (Cons (List Empty) Empty)))))))))))))))
+      |}]
+  ;;
+
+  let%expect_test "deriving sexp_grammar without tags_of_doc_comments" =
+    show_grammar
+      (module struct
+        type t = { field : unit (** IGNORED *) } [@@deriving sexp_grammar]
+      end);
+    [%expect
+      {|
+      (List (
+        Fields (
+          (allow_extra_fields false)
+          (fields ((
+            No_tag (
+              (name     field)
+              (required true)
+              (args (Cons (List Empty) Empty)))))))))
+      |}]
+  ;;
+
+  let%expect_test "doc comments on subexpressions" =
+    show_grammar
+      (module struct
+        [@@@ocaml.warning "-37"]
+
+        type t = Foo of { bar : int (** inner *) } (** outer *)
+        [@@deriving sexp_grammar ~tags_of_doc_comments]
+      end);
+    [%expect
+      {|
+      (Variant (
+        (case_sensitivity Case_sensitive_except_first_character)
+        (clauses ((
+          Tag (
+            (key   sexp_grammar.doc_comment)
+            (value " outer ")
+            (grammar (
+              No_tag (
+                (name Foo)
+                (clause_kind (
+                  List_clause (
+                    args (
+                      Fields (
+                        (allow_extra_fields false)
+                        (fields ((
+                          Tag (
+                            (key   sexp_grammar.doc_comment)
+                            (value " inner ")
+                            (grammar (
+                              No_tag (
+                                (name     bar)
+                                (required true)
+                                (args (Cons Integer Empty)))))))))))))))))))))))
+      |}];
+    show_grammar
+      (module struct
+        [@@@ocaml.warning "-37"]
+
+        type t = [ `A of [ `B (** inner *) ] (** outer *) ]
+        [@@deriving sexp_grammar ~tags_of_doc_comments]
+      end);
+    [%expect
+      {|
+      (Variant (
+        (case_sensitivity Case_sensitive)
+        (clauses ((
+          Tag (
+            (key   sexp_grammar.doc_comment)
+            (value " outer ")
+            (grammar (
+              No_tag (
+                (name A)
+                (clause_kind (
+                  List_clause (
+                    args (
+                      Cons
+                      (Variant (
+                        (case_sensitivity Case_sensitive)
+                        (clauses ((
+                          Tag (
+                            (key   sexp_grammar.doc_comment)
+                            (value " inner ")
+                            (grammar (
+                              No_tag (
+                                (name        B)
+                                (clause_kind Atom_clause))))))))))
+                      Empty)))))))))))))
+      |}];
+    show_grammar
+      (module struct
+        [@@@ocaml.warning "-37"]
+
+        type t = { a : [ `B of int (** inner *) ] (** outer *) }
+        [@@deriving sexp_grammar ~tags_of_doc_comments]
+      end);
+    [%expect
+      {|
+      (List (
+        Fields (
+          (allow_extra_fields false)
+          (fields ((
+            Tag (
+              (key   sexp_grammar.doc_comment)
+              (value " outer ")
+              (grammar (
+                No_tag (
+                  (name     a)
+                  (required true)
+                  (args (
+                    Cons
+                    (Variant (
+                      (case_sensitivity Case_sensitive)
+                      (clauses ((
+                        Tag (
+                          (key   sexp_grammar.doc_comment)
+                          (value " inner ")
+                          (grammar (
+                            No_tag (
+                              (name B)
+                              (clause_kind (List_clause (args (Cons Integer Empty)))))))))))))
+                    Empty))))))))))))
+      |}];
+    show_grammar
+      (module struct
+        [@@@ocaml.warning "-37"]
+
+        type t = [ `A of [ `B (** inner *) ] option (** outer *) ]
+        [@@deriving sexp_grammar ~tags_of_doc_comments]
+      end);
+    [%expect
+      {|
+      (Variant (
+        (case_sensitivity Case_sensitive)
+        (clauses ((
+          Tag (
+            (key   sexp_grammar.doc_comment)
+            (value " outer ")
+            (grammar (
+              No_tag (
+                (name A)
+                (clause_kind (
+                  List_clause (
+                    args (
+                      Cons
+                      (Option (
+                        Variant (
+                          (case_sensitivity Case_sensitive)
+                          (clauses ((
+                            Tag (
+                              (key   sexp_grammar.doc_comment)
+                              (value " inner ")
+                              (grammar (
+                                No_tag (
+                                  (name        B)
+                                  (clause_kind Atom_clause)))))))))))
+                      Empty)))))))))))))
+      |}]
+  ;;
+end

unikernel/duniverse/ppx_sexp_conv/test/sexp_grammar/test_tags.mli

@@ -0,0 +1 @@
+(* This interface intentionally left empty. *)

unikernel/duniverse/ppx_sexp_conv/test/sexp_grammar/test_tags.mlt

@@ -0,0 +1,62 @@
+open Ppx_sexp_conv_lib
+open Conv;;
+
+#verbose true
+
+module No_keys = struct
+  type t = (unit[@sexp_grammar.tag]) [@@deriving sexp_grammar]
+end
+
+[%%expect
+  {|
+Line _, characters _-_:
+Error: :: expected
+|}]
+
+module Key_literal_is_not_string = struct
+  type t = (unit[@sexp_grammar.tag 1 = [%sexp ""]]) [@@deriving sexp_grammar]
+end
+
+[%%expect
+  {|
+Line _, characters _-_:
+Error: This expression has type int but an expression was expected of type
+         string
+|}]
+
+module Key_ident_is_not_string = struct
+  let k = 1
+
+  type t = (unit[@sexp_grammar.tag k = [%sexp ""]]) [@@deriving sexp_grammar]
+end
+
+[%%expect
+  {|
+Line _, characters _-_:
+Error: This expression has type int but an expression was expected of type
+         string
+|}]
+
+module Value_literal_is_not_sexp = struct
+  type t = (unit[@sexp_grammar.tag "key" = 1]) [@@deriving sexp_grammar]
+end
+
+[%%expect
+  {|
+Line _, characters _-_:
+Error: This expression has type int but an expression was expected of type
+         Sexp.t
+|}]
+
+module Value_ident_is_not_sexp = struct
+  let v = 1
+
+  type t = (unit[@sexp_grammar.tag "key" = v]) [@@deriving sexp_grammar]
+end
+
+[%%expect
+  {|
+Line _, characters _-_:
+Error: This expression has type int but an expression was expected of type
+         Sexp.t
+|}]

unikernel/duniverse/ppx_sexp_conv/test/sexp_grammar/test_test.ml

@@ -0,0 +1,86 @@
+open! Base
+
+module _ = struct
+  type t = int [@@deriving_inline sexp_grammar]
+
+  let _ = fun (_ : t) -> ()
+  let (t_sexp_grammar : t Sexplib0.Sexp_grammar.t) = int_sexp_grammar
+  let _ = t_sexp_grammar
+
+  [@@@deriving.end]
+end
+
+module _ = struct
+  type 'a t = T of 'a
+  and 'a u = U of 'a t option [@@deriving_inline sexp_grammar]
+
+  let _ = fun (_ : 'a t) -> ()
+  let _ = fun (_ : 'a u) -> ()
+
+  let t_sexp_grammar : 'a. 'a Sexplib0.Sexp_grammar.t -> 'a t Sexplib0.Sexp_grammar.t =
+    fun _'a_sexp_grammar ->
+    { untyped =
+        Variant
+          { case_sensitivity = Case_sensitive_except_first_character
+          ; clauses =
+              [ No_tag
+                  { name = "T"
+                  ; clause_kind =
+                      List_clause { args = Cons (_'a_sexp_grammar.untyped, Empty) }
+                  }
+              ]
+          }
+    }
+  ;;
+
+  let _ = t_sexp_grammar
+
+  let u_sexp_grammar : 'a. 'a Sexplib0.Sexp_grammar.t -> 'a u Sexplib0.Sexp_grammar.t =
+    fun _'a_sexp_grammar ->
+    { untyped =
+        Variant
+          { case_sensitivity = Case_sensitive_except_first_character
+          ; clauses =
+              [ No_tag
+                  { name = "U"
+                  ; clause_kind =
+                      List_clause
+                        { args =
+                            Cons
+                              ( (option_sexp_grammar (t_sexp_grammar _'a_sexp_grammar))
+                                  .untyped
+                              , Empty )
+                        }
+                  }
+              ]
+          }
+    }
+  ;;
+
+  let _ = u_sexp_grammar
+
+  [@@@deriving.end]
+
+  (* Avoid unused constructor warnings. *)
+  let _ = T ()
+  let _ = U None
+end
+
+module _ = struct
+  type ('a, 'b) t = 'a -> 'b [@@deriving_inline sexp_grammar]
+
+  let _ = fun (_ : ('a, 'b) t) -> ()
+
+  let t_sexp_grammar :
+        'a 'b.
+        'a Sexplib0.Sexp_grammar.t
+        -> 'b Sexplib0.Sexp_grammar.t
+        -> ('a, 'b) t Sexplib0.Sexp_grammar.t
+    =
+    fun _'a_sexp_grammar _'b_sexp_grammar -> Sexplib0.Sexp_conv.fun_sexp_grammar
+  ;;
+
+  let _ = t_sexp_grammar
+
+  [@@@end]
+end

unikernel/duniverse/ppx_sexp_conv/test/sexp_grammar/test_test.mli

@@ -0,0 +1 @@
+(*_ This signature is deliberately empty. *)

unikernel/duniverse/ppx_sexp_conv/test/sexp_grammar/test_variants_more.ml

@@ -0,0 +1,93 @@
+open Base
+
+[@@@warning "-37"]
+
+module _ = struct
+  type t = A of [ `A of int ] [@@deriving_inline sexp_grammar]
+
+  let _ = fun (_ : t) -> ()
+
+  let (t_sexp_grammar : t Sexplib0.Sexp_grammar.t) =
+    { untyped =
+        Lazy
+          (lazy
+            (Variant
+               { case_sensitivity = Case_sensitive_except_first_character
+               ; clauses =
+                   [ No_tag
+                       { name = "A"
+                       ; clause_kind =
+                           List_clause
+                             { args =
+                                 Cons
+                                   ( Variant
+                                       { case_sensitivity = Case_sensitive
+                                       ; clauses =
+                                           [ No_tag
+                                               { name = "A"
+                                               ; clause_kind =
+                                                   List_clause
+                                                     { args =
+                                                         Cons
+                                                           ( int_sexp_grammar.untyped
+                                                           , Empty )
+                                                     }
+                                               }
+                                           ]
+                                       }
+                                   , Empty )
+                             }
+                       }
+                   ]
+               }))
+    }
+  ;;
+
+  let _ = t_sexp_grammar
+
+  [@@@end]
+end
+
+module _ = struct
+  type t = { a : [ `A of int ] } [@@deriving_inline sexp_grammar]
+
+  let _ = fun (_ : t) -> ()
+
+  let (t_sexp_grammar : t Sexplib0.Sexp_grammar.t) =
+    { untyped =
+        Lazy
+          (lazy
+            (List
+               (Fields
+                  { allow_extra_fields = false
+                  ; fields =
+                      [ No_tag
+                          { name = "a"
+                          ; required = true
+                          ; args =
+                              Cons
+                                ( Variant
+                                    { case_sensitivity = Case_sensitive
+                                    ; clauses =
+                                        [ No_tag
+                                            { name = "A"
+                                            ; clause_kind =
+                                                List_clause
+                                                  { args =
+                                                      Cons
+                                                        (int_sexp_grammar.untyped, Empty)
+                                                  }
+                                            }
+                                        ]
+                                    }
+                                , Empty )
+                          }
+                      ]
+                  })))
+    }
+  ;;
+
+  let _ = t_sexp_grammar
+
+  [@@@end]
+end

unikernel/duniverse/ppx_sexp_conv/test/test.sexp

@@ -0,0 +1,34 @@
+(this is a list)
+
+(this is another list and (this is a nested list))
+
+(
+  "\
+    This is a multi-line \
+    string with embedded
+
+    newlines."
+
+  "This string contains decimal \255, hex \xff codes, \
+   and other \\ \n escapes."
+
+  A# # ## #x|
+)
+
+; Line comment
+
+#; (
+  S-expression comment
+)
+
+#| #| Nested |# block comment "|#" |#
+
+#| "" |#
+#| ""|#
+#|"" |#
+#|""|#
+
+#| "asdf" "asdf" |#
+
+(something #| ; |# () "something else")
+