unikernel/duniverse/ppx_compare/.gitignore

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

unikernel/duniverse/ppx_compare/.ocamlformat

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

unikernel/duniverse/ppx_compare/CHANGES.md

@@ -0,0 +1,33 @@
+## Release v0.17.0
+
+* Support comparing locally-allocated values via `[@@deriving compare ~localize]`.
+
+
+## git version
+
+- Optimized comparison for sum types when all constructors are constant.
+
+## v0.11
+
+Depend on ppxlib instead of (now deprecated) ppx\_core, ppx\_driver,
+ppx\_metaquot and ppx\_type\_conv.
+
+## v0.10
+
+- Disallowed `[%equal]`; use `[%compare.equal]`
+
+- Added `@compare.ignore` record-field attribute; `ppx_compare` and `ppx_hash`
+  skip record fields annotated with `@compare.ignore`.
+
+- Added support to `%compare` syntax for underscore (`_`) as meaning a
+  comparison function that ignores both its arguments and returns zero.
+
+## v0.9
+
+## 113.43.00
+
+- use the new context-free API
+
+## 113.24.00
+
+- Follow evolution of `Ppx_core` and `Type_conv`.

unikernel/duniverse/ppx_compare/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_compare/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_compare/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_compare/README.md

@@ -0,0 +1,189 @@
+ppx_compare
+===========
+
+Generation of fast comparison and equality functions from type
+expressions and definitions.
+
+Ppx_compare is a ppx rewriter that derives comparison and equality
+functions from type representations. The scaffolded functions are
+usually much faster than ocaml's `Pervasives.compare` and
+`Pervasives.(=)`. Scaffolding functions also gives you more
+flexibility by allowing you to override them for a specific type and
+more safety by making sure that you only compare comparable values.
+
+Syntax
+------
+
+Type definitions: `[@@deriving compare, equal]`
+Expressions: `[%compare: TYPE]`, `[%equal: TYPE]` and `[%compare.equal: TYPE]`
+Types, record fields: `[@compare.ignore]`, `[@equal.ignore]`
+
+Basic usage
+-----------
+
+We use `ppx_deriving`/`ppx_type_conv`, so type definitions are annotated this way:
+
+```ocaml
+type s = v * w [@@deriving compare]
+```
+
+This will generate `compare_s : s -> s -> int` function that relies on
+`compare_v : v -> v -> int` and `compare_w : w -> w -> int`.
+
+Compare is not DWIM (do what I mean): it will scaffold a fast well behaved comparison
+(reflexive, transitive, symmetric...) function however it does not try to follow any
+"natural ordering". For instance arrays of characters are not sorted lexicographically.
+
+Base types (options,int,array,lists,char,floats...) have the same comparison order as
+Pervasives.compare (provided their type parameters also do for the polymorphic ones).
+Comparisons for these types must be brought in scope with `open Base`, `open Core`, or
+`open Ppx_compare_lib.Builtin`.
+
+Records fields are compared in the order they are defined (left to right); tuples fields
+are compared left to right. When we compare two branches of a sum whichever ones comes
+first in the definition is considered lowest. Variants compare in the order they are
+listed (increasing top-to-bottom). Polymorphic variants use the same ordering as the
+ocaml runtime.
+
+The same applies to equality functions.
+
+### Float equality
+
+The functions derived by `[@@deriving equal]` are consistent with the
+compare functions derived by `[@@deriving compare]` and in particular
+do not respect IEEE float comparison.
+
+Calling `compare` for type `t`s
+-------------------------------
+
+In compliance (or conformance) with Janestreet's coding standard we assume that
+type named `t` are the main types in a module and
+
+```ocaml
+type t = S.t * T.t [@@deriving compare]
+```
+
+will call the functions `S.compare` and `T.compare` instead of calling `S.compare_t` and
+`T.compare_t`. This will also generate a `compare : t -> t -> int` function.
+
+The same applies to equality functions.
+
+Signature
+---------
+
+`type t [@@deriving compare]` in a module signature will add `val compare : t -> t -> int`
+in the signature.
+
+The same applies to equality functions.
+
+Comparison without a type definition
+------------------------------------
+
+Sometimes you just want a comparison without having to create a new type. You can create
+such a comparison function using the `[%compare: ..]` extension point:
+
+```ocaml
+let gt x y = [%compare: float * int * [`A | `B | `C] ] x y
+```
+
+You can use the type `_`, in which case the corresponding values will be
+ignored (i.e. compared using `fun _ _ -> 0`). For instance:
+
+```ocaml
+assert ([%compare: _ list] [ true ] [ false ] = 0);
+assert ([%compare: _ list] [] [ false ] <> 0);
+```
+
+The same applies to equality functions.
+
+You can also check for equality using `[%compare.equal: ..]`, which
+produces a function that returns `true` precisely when `[%compare:
+..]` returns `0`. `[%equal: ..]` is preferred over `[%compare.equal:
+..]` and in particular is expected to be slightly faster. However,
+`[%compare.equal: ..]` can come in handy for types that only have
+`[@@deriving compare]`. In particular, support for `[@@deriving
+equal]` was added long after the project started, which means that
+many types out there only support `[@deriving compare]`.
+
+Ignoring part of types
+----------------------
+
+The comparison ignores any part of the type declaration that is under
+a `[@compare.ignore]` annotation:
+
+```ocaml
+    type t = (float [@compare.ignore]) * string
+    [@@deriving compare]
+```
+
+The same applies for `[@@deriving equal]` by using
+`[@equal.ignore]`. In order to ignore part of a type for both
+comparison and equality, you can simply use `[@ignore]`. However, be
+aware that the general `[@ignore]` attribute will apply to any deriver
+that recognize it, not just `compare` and `equal`.
+
+Note that if you use both the `compare` and `equal` derivers, you need
+to use either both `[@compare.ignore]` and `[@equal.ignore]` or
+`[@ignore]`. However, you cannot use only one of them.
+
+For convenience, you can also ignore record fields instead of the
+type of record field. In other words,
+
+```ocaml
+    type t =
+      { a : (float [@compare.ignore])
+      ; b : string
+      }
+    [@@deriving compare]
+```
+
+can be abbreviated:
+
+```ocaml
+    type t =
+      { a : float [@compare.ignore]
+      ; b : string
+      }
+    [@@deriving compare]
+```
+
+Local-accepting compare functions
+----------------------------
+
+This ppx includes the option to support local allocation, a nonstandard OCaml extension
+available at: https://github.com/ocaml-flambda/ocaml-jst
+
+In both structures and signatures, `[@@deriving compare ~localize]` (and similarly for
+`equal`) generates definitions with the following types, in addition to the usual
+definitions:
+
+```
+(* Monomorphic types *)
+val compare__local : local_ t -> local_ t -> int
+val equal__local : local_ t  -> local_ t -> bool
+
+(* Parameterized types *)
+val compare__local
+    : (local_ 'a -> local_ 'a -> int)
+    -> local_ 'a t
+    -> local_ 'a t
+    -> int
+val equal__local
+    : (local_ 'a -> local_ 'a -> bool)
+    -> local_ 'a t
+    -> local_ 'a t
+    -> bool
+```
+
+You can also use the `[%compare_local: _]`, `[%equal_local: _]` and
+`[%compare_local.equal: _]` extension points to generate the corresponding
+types and functions.
+
+For types named something other than `t`, the naming pattern is similar
+to the non-local versions:
+
+```ocaml
+type foo
+
+val compare_foo__local : local_ foo -> local_ foo -> int
+```

unikernel/duniverse/ppx_compare/dune-project

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

unikernel/duniverse/ppx_compare/expander/dune

@@ -0,0 +1,7 @@
+(library
+ (name ppx_compare_expander)
+ (public_name ppx_compare.expander)
+ (libraries base compiler-libs.common ppxlib ppxlib_jane)
+ (ppx_runtime_libraries ppx_compare.runtime-lib)
+ (preprocess
+  (pps ppxlib.metaquot)))

unikernel/duniverse/ppx_compare/expander/ppx_compare_expander.ml

@@ -0,0 +1,694 @@
+(* Generated code should depend on the environment in scope as little as possible.
+   E.g. rather than [foo = []] do [match foo with [] ->], to eliminate the use of [=].  It
+   is especially important to not use polymorphic comparisons, since we are moving more
+   and more to code that doesn't have them in scope. *)
+
+(* Note: I am introducing a few unnecessary explicit closures, (not all of them some are
+   unnecessary due to the value restriction).
+*)
+
+open Base
+open Ppxlib
+open Ast_builder.Default
+include Ppx_compare_expander_intf
+
+(* Two-argument function, possibly with [local_] arguments *)
+let ptyp_arrow2 ~loc ~local_args arg1 arg2 res =
+  if local_args
+  then [%type: [%t arg1] -> [%t arg2] -> [%t res]]
+  else [%type: [%t arg1] -> [%t arg2] -> [%t res]]
+;;
+
+type kind =
+  | Compare
+  | Equal
+
+module type Params = sig
+  val name : string
+  val kind : kind
+  val chain : expression -> expression -> expression
+  val const : loc:Location.t -> Ordering.t -> expression
+  val result_type : loc:Location.t -> core_type
+  val poly : loc:Location.t -> expression -> expression -> expression
+
+  val abstract
+    :  loc:Location.t
+    -> type_name:string
+    -> expression
+    -> expression
+    -> expression
+
+  module Attrs : Attrs
+end
+
+module Make_attrs (Name : sig
+  val name : string
+end) : Attrs = struct
+  let ignore_label_declaration =
+    Attribute.declare
+      (Name.name ^ ".ignore")
+      Attribute.Context.label_declaration
+      Ast_pattern.(pstr nil)
+      ()
+  ;;
+
+  let ignore_core_type =
+    Attribute.declare
+      (Name.name ^ ".ignore")
+      Attribute.Context.core_type
+      Ast_pattern.(pstr nil)
+      ()
+  ;;
+end
+
+module Compare_params : Params = struct
+  let name = "compare"
+  let kind = Compare
+
+  let chain a b =
+    let loc = a.pexp_loc in
+    [%expr
+      match [%e a] with
+      | 0 -> [%e b]
+      | n -> n]
+  ;;
+
+  let const ~loc (ord : Ordering.t) =
+    eint
+      ~loc
+      (match ord with
+       | Less -> -1
+       | Equal -> 0
+       | Greater -> 1)
+  ;;
+
+  let result_type ~loc = [%type: int]
+  let poly ~loc a b = [%expr Stdlib.compare [%e a] [%e b]]
+
+  let abstract ~loc ~type_name a b =
+    [%expr
+      Ppx_compare_lib.compare_abstract
+        ~type_name:[%e estring ~loc type_name]
+        [%e a]
+        [%e b]]
+  ;;
+
+  module Attrs = Make_attrs (struct
+    let name = name
+  end)
+end
+
+module Equal_params : Params = struct
+  let name = "equal"
+  let kind = Equal
+
+  let chain a b =
+    let loc = a.pexp_loc in
+    [%expr Stdlib.( && ) [%e a] [%e b]]
+  ;;
+
+  let const ~loc (ord : Ordering.t) =
+    match ord with
+    | Equal -> [%expr true]
+    | Less | Greater -> [%expr false]
+  ;;
+
+  let result_type ~loc = [%type: bool]
+  let poly ~loc a b = [%expr Stdlib.( = ) [%e a] [%e b]]
+
+  let abstract ~loc ~type_name a b =
+    [%expr
+      Ppx_compare_lib.equal_abstract ~type_name:[%e estring ~loc type_name] [%e a] [%e b]]
+  ;;
+
+  module Attrs = Make_attrs (struct
+    let name = name
+  end)
+end
+
+module Make (Params : Params) = struct
+  open Params
+  module Attrs = Attrs
+
+  let str_attributes =
+    [ Attribute.T Attrs.ignore_label_declaration; Attribute.T Attrs.ignore_core_type ]
+  ;;
+
+  let is_ignored_gen ~loc ~compare_attr ~equal_attr ast =
+    match kind, Attribute.get compare_attr ast, Attribute.get equal_attr ast with
+    | _, Some (), Some () | Compare, Some (), None | Equal, None, Some () -> true
+    | _, None, None -> false
+    | Compare, None, Some () ->
+      Location.raise_errorf
+        ~loc
+        "Cannot use [@@equal.ignore] with [@@@@deriving compare]."
+    | Equal, Some (), None ->
+      Location.raise_errorf ~loc "Cannot use [@@compare.ignore] with [@@@@deriving equal]"
+  ;;
+
+  let core_type_is_ignored ty =
+    is_ignored_gen
+      ~loc:ty.ptyp_loc
+      ~compare_attr:Compare_params.Attrs.ignore_core_type
+      ~equal_attr:Equal_params.Attrs.ignore_core_type
+      ty
+  ;;
+
+  let label_is_ignored ld =
+    is_ignored_gen
+      ~loc:ld.pld_loc
+      ~compare_attr:Compare_params.Attrs.ignore_label_declaration
+      ~equal_attr:Equal_params.Attrs.ignore_label_declaration
+      ld
+  ;;
+
+  let with_tuple loc ~value ~ltys f =
+    (* generate
+       let id_1, id_2, id_3, ... id_n = value in expr
+       where expr is the result of (f [id_1, ty_1 ; id_2, ty_2; ...])
+    *)
+    let names_types =
+      List.map ltys ~f:(fun (lbl, t) -> gen_symbol ~prefix:"t" (), lbl, t)
+    in
+    let pattern =
+      let l = List.map names_types ~f:(fun (n, lbl, _) -> lbl, pvar ~loc n) in
+      Ppxlib_jane.Jane_syntax.Pattern.pat_of ~loc ~attrs:[] (Jpat_tuple (l, Closed))
+    in
+    let e = f (List.map names_types ~f:(fun (n, _, t) -> evar ~loc n, t)) in
+    let binding = value_binding ~loc ~pat:pattern ~expr:value in
+    pexp_let ~loc Nonrecursive [ binding ] e
+  ;;
+
+  let phys_equal_first a b cmp =
+    let loc = cmp.pexp_loc in
+    [%expr if Stdlib.( == ) [%e a] [%e b] then [%e const ~loc Equal] else [%e cmp]]
+  ;;
+
+  let rec chain_if ~loc = function
+    | [] -> const ~loc Equal
+    | [ x ] -> x
+    | x :: xs -> chain x (chain_if ~loc:x.pexp_loc xs)
+  ;;
+
+  let tp_name n = Printf.sprintf "_cmp__%s" n
+
+  let type_ ~with_local ~hide ~loc ty =
+    let loc = { loc with loc_ghost = true } in
+    let ptyp_attributes =
+      if hide
+      then Merlin_helpers.hide_attribute :: ty.ptyp_attributes
+      else ty.ptyp_attributes
+    in
+    let hty = { ty with ptyp_attributes } in
+    ptyp_arrow2 ~loc ~local_args:with_local ty hty (result_type ~loc)
+  ;;
+
+  let function_name ~with_local typename =
+    let name =
+      match typename with
+      | "t" -> name
+      | s -> name ^ "_" ^ s
+    in
+    if with_local then name ^ "__local" else name
+  ;;
+
+  let compare_ignore ~loc value1 value2 =
+    [%expr
+      let (_ : _) = [%e value1]
+      and (_ : _) = [%e value2] in
+      [%e const ~loc Equal]]
+  ;;
+
+  let rec compare_applied ~hide ~with_local ~constructor ~args value1 value2 =
+    let args =
+      List.map args ~f:(compare_of_ty_fun ~hide ~with_local ~type_constraint:false)
+      @ [ value1; value2 ]
+    in
+    type_constr_conv
+      ~loc:(Located.loc constructor)
+      constructor
+      args
+      ~f:(function_name ~with_local)
+
+  and compare_of_tuple ~hide ~with_local loc ltys value1 value2 =
+    with_tuple loc ~value:value1 ~ltys (fun elems1 ->
+      with_tuple loc ~value:value2 ~ltys (fun elems2 ->
+        let exprs =
+          List.map2_exn elems1 elems2 ~f:(fun (v1, t) (v2, _) ->
+            compare_of_ty ~hide ~with_local t v1 v2)
+        in
+        chain_if ~loc exprs))
+
+  and compare_variant ~hide ~with_local loc row_fields value1 value2 =
+    let map row =
+      match row.prf_desc with
+      | Rtag ({ txt = cnstr; _ }, true, _) | Rtag ({ txt = cnstr; _ }, _, []) ->
+        case
+          ~guard:None
+          ~lhs:
+            (ppat_tuple
+               ~loc
+               [ ppat_variant ~loc cnstr None; ppat_variant ~loc cnstr None ])
+          ~rhs:(const ~loc Equal)
+      | Rtag ({ txt = cnstr; _ }, false, tp :: _) ->
+        let v1 = gen_symbol ~prefix:"_left" ()
+        and v2 = gen_symbol ~prefix:"_right" () in
+        let body = compare_of_ty ~hide ~with_local tp (evar ~loc v1) (evar ~loc v2) in
+        case
+          ~guard:None
+          ~lhs:
+            (ppat_tuple
+               ~loc
+               [ ppat_variant ~loc cnstr (Some (pvar ~loc v1))
+               ; ppat_variant ~loc cnstr (Some (pvar ~loc v2))
+               ])
+          ~rhs:body
+      | Rinherit { ptyp_desc = Ptyp_constr (id, args); _ } ->
+        (* quite sadly, this code doesn't handle:
+           type 'a id = 'a with compare
+           type t = [ `a | [ `b ] id ] with compare
+           because it will generate a pattern #id, when id is not even a polymorphic
+           variant in the first place.
+           The culprit is caml though, since it only allows #id but not #([`b] id)
+        *)
+        let v1 = gen_symbol ~prefix:"_left" ()
+        and v2 = gen_symbol ~prefix:"_right" () in
+        case
+          ~guard:None
+          ~lhs:
+            (ppat_tuple
+               ~loc
+               [ ppat_alias ~loc (ppat_type ~loc id) (Located.mk ~loc v1)
+               ; ppat_alias ~loc (ppat_type ~loc id) (Located.mk ~loc v2)
+               ])
+          ~rhs:
+            (compare_applied
+               ~hide
+               ~with_local
+               ~constructor:id
+               ~args
+               (evar ~loc v1)
+               (evar ~loc v2))
+      | Rinherit ty ->
+        Location.raise_errorf ~loc:ty.ptyp_loc "Ppx_compare.compare_variant: unknown type"
+    in
+    let e =
+      let matched = pexp_tuple ~loc [ value1; value2 ] in
+      match List.map ~f:map row_fields with
+      | [ v ] -> pexp_match ~loc matched [ v ]
+      | l ->
+        pexp_match
+          ~loc
+          matched
+          (l
+           @ (* Providing we didn't screw up badly we now know that the tags of the variants
+                are different. We let pervasive do its magic. *)
+           [ case ~guard:None ~lhs:[%pat? x, y] ~rhs:(poly ~loc [%expr x] [%expr y]) ])
+    in
+    phys_equal_first value1 value2 e
+
+  and branches_of_sum ~hide ~with_local cds =
+    let rightmost_index = List.length cds - 1 in
+    List.concat
+      (List.mapi cds ~f:(fun i cd ->
+         let rightmost = i = rightmost_index in
+         let loc = cd.pcd_loc in
+         if Option.is_some cd.pcd_res
+         then
+           (* If we get GADTs support, fix the constant sum type optimization for them *)
+           Location.raise_errorf ~loc "GADTs are not supported by comparelib";
+         match cd.pcd_args with
+         | Pcstr_record lds ->
+           let value1 = gen_symbol ~prefix:"_a" () in
+           let value2 = gen_symbol ~prefix:"_b" () in
+           let res =
+             case
+               ~guard:None
+               ~lhs:
+                 (ppat_tuple
+                    ~loc
+                    [ pconstruct cd (Some (pvar ~loc value1))
+                    ; pconstruct cd (Some (pvar ~loc value2))
+                    ])
+               ~rhs:
+                 (compare_of_record_no_phys_equal
+                    ~hide
+                    ~with_local
+                    loc
+                    lds
+                    (evar ~loc value1)
+                    (evar ~loc value2))
+           in
+           if rightmost
+           then [ res ]
+           else (
+             let pany = ppat_any ~loc in
+             let pcnstr = pconstruct cd (Some pany) in
+             let case l r ord =
+               case ~guard:None ~lhs:(ppat_tuple ~loc [ l; r ]) ~rhs:(const ~loc ord)
+             in
+             [ res; case pcnstr pany Less; case pany pcnstr Greater ])
+         | Pcstr_tuple pcd_args ->
+           (match pcd_args with
+            | [] ->
+              let pcnstr = pconstruct cd None in
+              let pany = ppat_any ~loc in
+              let case l r ord =
+                case ~guard:None ~lhs:(ppat_tuple ~loc [ l; r ]) ~rhs:(const ~loc ord)
+              in
+              if rightmost
+              then [ case pcnstr pcnstr Equal ]
+              else
+                [ case pcnstr pcnstr Equal
+                ; case pcnstr pany Less
+                ; case pany pcnstr Greater
+                ]
+            | tps ->
+              let ids_ty =
+                List.map tps ~f:(fun ty ->
+                  let a = gen_symbol ~prefix:"_a" () in
+                  let b = gen_symbol ~prefix:"_b" () in
+                  a, b, ty)
+              in
+              let lpatt =
+                List.map ids_ty ~f:(fun (l, _r, _ty) -> pvar ~loc l) |> ppat_tuple ~loc
+              and rpatt =
+                List.map ids_ty ~f:(fun (_l, r, _ty) -> pvar ~loc r) |> ppat_tuple ~loc
+              and body =
+                List.map ids_ty ~f:(fun (l, r, ty) ->
+                  compare_of_ty ~hide ~with_local ty (evar ~loc l) (evar ~loc r))
+                |> chain_if ~loc
+              in
+              let res =
+                case
+                  ~guard:None
+                  ~lhs:
+                    (ppat_tuple
+                       ~loc
+                       [ pconstruct cd (Some lpatt); pconstruct cd (Some rpatt) ])
+                  ~rhs:body
+              in
+              if rightmost
+              then [ res ]
+              else (
+                let pany = ppat_any ~loc in
+                let pcnstr = pconstruct cd (Some pany) in
+                let case l r ord =
+                  case ~guard:None ~lhs:(ppat_tuple ~loc [ l; r ]) ~rhs:(const ~loc ord)
+                in
+                [ res; case pcnstr pany Less; case pany pcnstr Greater ]))))
+
+  and compare_sum ~hide ~with_local loc cds value1 value2 =
+    let is_sum_type_with_all_constant_constructors =
+      List.for_all cds ~f:(fun cd ->
+        Option.is_none cd.pcd_res
+        &&
+        (* we could support GADTs, but the general case
+           doesn't, so let's hold off *)
+        match cd.pcd_args with
+        | Pcstr_tuple l -> List.is_empty l
+        | Pcstr_record l -> List.is_empty l)
+    in
+    if is_sum_type_with_all_constant_constructors
+    then
+      (* the compiler will optimize the polymorphic comparison to an integer one *)
+      poly ~loc value1 value2
+    else (
+      let mcs = branches_of_sum ~hide ~with_local cds in
+      let e = pexp_match ~loc (pexp_tuple ~loc [ value1; value2 ]) mcs in
+      phys_equal_first value1 value2 e)
+
+  and compare_of_ty ~hide ~with_local ty value1 value2 =
+    let loc = ty.ptyp_loc in
+    if core_type_is_ignored ty
+    then compare_ignore ~loc value1 value2
+    else (
+      match Ppxlib_jane.Jane_syntax.Core_type.of_ast ty with
+      | Some (Jtyp_tuple ltps, _attrs) ->
+        compare_of_tuple ~hide ~with_local loc ltps value1 value2
+      | Some (Jtyp_layout _, _) ->
+        Location.raise_errorf
+          ~loc
+          "Layout annotations are not currently supported with [ppx_compare]."
+      | None ->
+        (match ty.ptyp_desc with
+         | Ptyp_constr (constructor, args) ->
+           compare_applied ~hide ~with_local ~constructor ~args value1 value2
+         | Ptyp_tuple tys ->
+           compare_of_tuple
+             ~hide
+             ~with_local
+             loc
+             (List.map ~f:(fun ty -> None, ty) tys)
+             value1
+             value2
+         | Ptyp_var name -> eapply ~loc (evar ~loc (tp_name name)) [ value1; value2 ]
+         | Ptyp_arrow _ ->
+           Location.raise_errorf ~loc "ppx_compare: Functions can not be compared."
+         | Ptyp_variant (row_fields, Closed, None) ->
+           compare_variant ~hide ~with_local loc row_fields value1 value2
+         | Ptyp_any -> compare_ignore ~loc value1 value2
+         | _ -> Location.raise_errorf ~loc "ppx_compare: unknown type"))
+
+  and compare_of_ty_fun ~hide ~with_local ~type_constraint ty =
+    let loc = { ty.ptyp_loc with loc_ghost = true } in
+    let do_hide hide_fun x = if hide then hide_fun x else x in
+    let a = gen_symbol ~prefix:"a" () in
+    let b = gen_symbol ~prefix:"b" () in
+    let e_a = evar ~loc a in
+    let e_b = evar ~loc b in
+    let mk_pat x =
+      if type_constraint then ppat_constraint ~loc (pvar ~loc x) ty else pvar ~loc x
+    in
+    let body =
+      do_hide Merlin_helpers.hide_expression (compare_of_ty ~hide ~with_local ty e_a e_b)
+    in
+    eta_reduce_if_possible
+      [%expr
+        fun [%p mk_pat a] [%p do_hide Merlin_helpers.hide_pattern (mk_pat b)] -> [%e body]]
+
+  and compare_of_record_no_phys_equal ~hide ~with_local loc lds value1 value2 =
+    let is_evar = function
+      | { pexp_desc = Pexp_ident _; _ } -> true
+      | _ -> false
+    in
+    assert (is_evar value1);
+    assert (is_evar value2);
+    List.filter lds ~f:(fun ld -> not (label_is_ignored ld))
+    |> List.map ~f:(fun ld ->
+         let loc = ld.pld_loc in
+         let label = Located.map lident ld.pld_name in
+         compare_of_ty
+           ~hide
+           ~with_local
+           ld.pld_type
+           (pexp_field ~loc value1 label)
+           (pexp_field ~loc value2 label))
+    |> chain_if ~loc
+  ;;
+
+  let compare_of_record ~hide ~with_local loc lds value1 value2 =
+    compare_of_record_no_phys_equal ~hide ~with_local loc lds value1 value2
+    |> phys_equal_first value1 value2
+  ;;
+
+  let compare_abstract loc type_name v_a v_b = abstract ~loc ~type_name v_a v_b
+
+  let scheme_of_td ~hide ~with_local td =
+    let loc = td.ptype_loc in
+    let type_ = combinator_type_of_type_declaration td ~f:(type_ ~hide ~with_local) in
+    match td.ptype_params with
+    | [] -> type_
+    | l ->
+      let vars = List.map l ~f:get_type_param_name in
+      ptyp_poly ~loc vars type_
+  ;;
+
+  let compare_of_td ~hide ~with_local td ~rec_flag =
+    let loc = td.ptype_loc in
+    let a = gen_symbol ~prefix:"a" () in
+    let b = gen_symbol ~prefix:"b" () in
+    let v_a = evar ~loc a in
+    let v_b = evar ~loc b in
+    let function_body =
+      match td.ptype_kind with
+      | Ptype_variant cds -> compare_sum ~hide ~with_local loc cds v_a v_b
+      | Ptype_record lds -> compare_of_record ~hide ~with_local loc lds v_a v_b
+      | Ptype_open ->
+        Location.raise_errorf ~loc "ppx_compare: open types are not yet supported"
+      | Ptype_abstract ->
+        (match td.ptype_manifest with
+         | None -> compare_abstract loc td.ptype_name.txt v_a v_b
+         | Some ty ->
+           (match ty.ptyp_desc with
+            | Ptyp_variant (_, Open, _) | Ptyp_variant (_, Closed, Some (_ :: _)) ->
+              Location.raise_errorf
+                ~loc:ty.ptyp_loc
+                "ppx_compare: cannot compare open polymorphic variant types"
+            | Ptyp_variant (row_fields, _, _) ->
+              compare_variant ~hide ~with_local loc row_fields v_a v_b
+            | _ -> compare_of_ty ~hide ~with_local ty v_a v_b))
+    in
+    let extra_names =
+      List.map td.ptype_params ~f:(fun p -> tp_name (get_type_param_name p).txt)
+    in
+    let patts = List.map (extra_names @ [ a; b ]) ~f:(pvar ~loc)
+    and bnd = pvar ~loc (function_name ~with_local td.ptype_name.txt) in
+    let poly_scheme =
+      match extra_names with
+      | [] -> false
+      | _ :: _ -> true
+    in
+    let body =
+      eta_reduce_if_possible_and_nonrec ~rec_flag (eabstract ~loc patts function_body)
+    in
+    if poly_scheme
+    then
+      value_binding
+        ~loc
+        ~pat:(ppat_constraint ~loc bnd (scheme_of_td ~hide ~with_local td))
+        ~expr:body
+    else
+      value_binding
+        ~loc
+        ~pat:bnd
+        ~expr:(pexp_constraint ~loc body (scheme_of_td ~hide ~with_local td))
+  ;;
+
+  let bindings_of_tds tds ~hide ~with_local ~rec_flag =
+    List.map tds ~f:(fun td -> compare_of_td td ~hide ~with_local ~rec_flag)
+  ;;
+
+  let eta_expand2 ~loc f =
+    eabstract
+      ~loc
+      [ pvar ~loc "a"; pvar ~loc "b" ]
+      (eapply ~loc f [ evar ~loc "a"; evar ~loc "b" ])
+  ;;
+
+  let aliases_of_tds tds ~hide =
+    (* So that ~localize doesn't double the size of the generated code, we define the non
+       local_ function as an alias to the local_ function. This only works for ground
+       types, as [('a -> 'a -> int) -> 'a list -> 'a list -> int] is a type that is
+       neither stronger nor weaker than the same type with local_ on the 'a and 'a
+       list. If the compiler supports polymorphism over locality one day, we may be able
+       to only generate one version of the code, the local version. *)
+    if List.for_all tds ~f:(fun td -> List.is_empty td.ptype_params)
+    then
+      Some
+        (List.map tds ~f:(fun td ->
+           let loc = td.ptype_name.loc in
+           value_binding
+             ~loc
+             ~pat:(pvar ~loc (function_name ~with_local:false td.ptype_name.txt))
+             ~expr:
+               (pexp_constraint
+                  ~loc
+                  (eta_expand2
+                     ~loc
+                     (evar ~loc (function_name ~with_local:true td.ptype_name.txt)))
+                  (scheme_of_td ~hide ~with_local:false td))))
+    else None
+  ;;
+
+  let str_type_decl ~ctxt (rec_flag, tds) localize =
+    let loc = Expansion_context.Deriver.derived_item_loc ctxt in
+    let hide = not (Expansion_context.Deriver.inline ctxt) in
+    let tds = List.map tds ~f:name_type_params_in_td in
+    let rec_flag =
+      (object
+         inherit type_is_recursive rec_flag tds as super
+
+         method! label_declaration ld =
+           if not (label_is_ignored ld) then super#label_declaration ld
+
+         method! core_type ty = if not (core_type_is_ignored ty) then super#core_type ty
+      end)
+        #go
+        ()
+    in
+    if localize
+    then
+      [ pstr_value ~loc rec_flag (bindings_of_tds tds ~hide ~with_local:true ~rec_flag)
+      ; (match aliases_of_tds tds ~hide with
+         | Some values -> pstr_value ~loc Nonrecursive values
+         | None ->
+           pstr_value
+             ~loc
+             rec_flag
+             (bindings_of_tds tds ~hide ~with_local:false ~rec_flag))
+      ]
+    else
+      [ pstr_value ~loc rec_flag (bindings_of_tds tds ~hide ~with_local:false ~rec_flag) ]
+  ;;
+
+  let mk_sig ~ctxt ~localize (_rec_flag, tds) =
+    let hide = not (Expansion_context.Deriver.inline ctxt) in
+    let tds = List.map tds ~f:name_type_params_in_td in
+    List.concat_map tds ~f:(fun td ->
+      let generate ~with_local =
+        let compare_of =
+          combinator_type_of_type_declaration td ~f:(type_ ~hide ~with_local)
+        in
+        let name = function_name ~with_local td.ptype_name.txt in
+        let loc = td.ptype_loc in
+        psig_value
+          ~loc
+          (value_description
+             ~loc
+             ~name:{ td.ptype_name with txt = name }
+             ~type_:compare_of
+             ~prim:[])
+      in
+      if localize
+      then [ generate ~with_local:false; generate ~with_local:true ]
+      else [ generate ~with_local:false ])
+  ;;
+
+  let sig_type_decl ~ctxt (rec_flag, tds) localize =
+    let loc = Expansion_context.Deriver.derived_item_loc ctxt in
+    let module_name =
+      match kind with
+      | Compare -> "Comparable"
+      | Equal -> "Equal"
+    in
+    let mk_named_sig ~with_local =
+      let module_type_name = if with_local then "S_local" else "S" in
+      let sg_name = Printf.sprintf "Ppx_compare_lib.%s.%s" module_name module_type_name in
+      mk_named_sig ~loc ~sg_name ~handle_polymorphic_variant:false tds
+    in
+    match mk_named_sig ~with_local:false, mk_named_sig ~with_local:true with
+    | Some include_infos, _ when not localize -> [ psig_include ~loc include_infos ]
+    | Some include_infos, Some include_infos_local when localize ->
+      [ psig_include ~loc include_infos; psig_include ~loc include_infos_local ]
+    | _ -> mk_sig ~ctxt ~localize (rec_flag, tds)
+  ;;
+
+  let compare_core_type ~with_local ty =
+    compare_of_ty_fun ~hide:true ~with_local ~type_constraint:true ty
+  ;;
+
+  let core_type ~with_local = compare_core_type ~with_local
+end
+
+module Compare = struct
+  include Make (Compare_params)
+
+  let equal_core_type ~with_local ty =
+    let loc = { ty.ptyp_loc with loc_ghost = true } in
+    let arg1 = gen_symbol () in
+    let arg2 = gen_symbol () in
+    let body =
+      Merlin_helpers.hide_expression
+        [%expr
+          match
+            [%e compare_core_type ~with_local ty] [%e evar ~loc arg1] [%e evar ~loc arg2]
+          with
+          | 0 -> true
+          | _ -> false]
+    in
+    [%expr fun ([%p pvar ~loc arg1] : [%t ty]) [%p pvar ~loc arg2] -> [%e body]]
+  ;;
+end
+
+module Equal = Make (Equal_params)

unikernel/duniverse/ppx_compare/expander/ppx_compare_expander.mli

@@ -0,0 +1,15 @@
+open Ppxlib
+
+module type S = Ppx_compare_expander_intf.S
+
+module Compare : sig
+  include S
+
+  (** [equal_core_type ~with_local ty] is an expression of type [ty -> ty -> bool],
+      using the comparison function generated by [core_type]
+
+      [~with_local:true] will make the arguments local *)
+  val equal_core_type : with_local:bool -> core_type -> expression
+end
+
+module Equal : S

unikernel/duniverse/ppx_compare/expander/ppx_compare_expander_intf.ml

@@ -0,0 +1,50 @@
+open Ppxlib
+
+module type Attrs = sig
+  val ignore_label_declaration : (label_declaration, unit) Attribute.t
+  val ignore_core_type : (core_type, unit) Attribute.t
+end
+
+module type S = sig
+  (** [type_ ~with_local ~hide ty] is [ty -> ty -> result_type] where [result_type]
+      is [int] for [compare] and [bool] for [equal].
+
+      [hide] controls whether some [[@merlin.hide]] attributes should be added.
+
+      [with_local] adds local_ annotation around the input types.
+  *)
+  val type_ : with_local:bool -> hide:bool -> loc:Location.t -> core_type -> core_type
+
+  (** [core_type ~with_local ty] is an expression of type [ty -> ty -> result_type]
+
+      [~with_local:true] will make the arguments local *)
+  val core_type : with_local:bool -> core_type -> expression
+
+  (** In [str_type_decl] and [sig_type_decl], passing [true] for the third argument
+      generates additional functions that take local arguments. We generate, e.g.
+      [val compare__local : local_ t -> local_ t -> int] in addition to [compare]
+      in order to incrementally grow the portion of the tree which supports local
+      comparison.
+
+      We need both [compare] and [compare__local] since neither has a stronger type than
+      the other. In the case of polymorphic types, this is due to the fact that
+      [compare__local] requires local compare functions for each of its type arguments,
+      and in the case of monomorphic types, this is due to the possibility of partial
+      application producing a local closure. *)
+
+  val str_type_decl
+    :  ctxt:Expansion_context.Deriver.t
+    -> rec_flag * type_declaration list
+    -> bool (** [true] means generate a definition with local arguments *)
+    -> structure
+
+  val sig_type_decl
+    :  ctxt:Expansion_context.Deriver.t
+    -> rec_flag * type_declaration list
+    -> bool (** [true] means generate a signature with local arguments *)
+    -> signature
+
+  module Attrs : Attrs
+
+  val str_attributes : Attribute.packed list
+end

unikernel/duniverse/ppx_compare/ppx_compare.opam

@@ -0,0 +1,24 @@
+opam-version: "2.0"
+version: "v0.17.0"
+maintainer: "Jane Street developers"
+authors: ["Jane Street Group, LLC"]
+homepage: "https://github.com/janestreet/ppx_compare"
+bug-reports: "https://github.com/janestreet/ppx_compare/issues"
+dev-repo: "git+https://github.com/janestreet/ppx_compare.git"
+doc: "https://ocaml.janestreet.com/ocaml-core/latest/doc/ppx_compare/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"}
+  "dune"        {>= "3.11.0"}
+  "ppxlib"      {>= "0.28.0"}
+]
+available: arch != "arm32" & arch != "x86_32"
+synopsis: "Generation of comparison functions from types"
+description: "
+Part of the Jane Street's PPX rewriters collection.
+"

unikernel/duniverse/ppx_compare/runtime-lib/dune

@@ -0,0 +1,5 @@
+(library
+ (name ppx_compare_lib)
+ (public_name ppx_compare.runtime-lib)
+ (libraries base)
+ (preprocess no_preprocessing))

unikernel/duniverse/ppx_compare/runtime-lib/ppx_compare_lib.ml

@@ -0,0 +1 @@
+include Base.Exported_for_specific_uses.Ppx_compare_lib

unikernel/duniverse/ppx_compare/src/dune

@@ -0,0 +1,7 @@
+(library
+ (name ppx_compare)
+ (public_name ppx_compare)
+ (kind ppx_deriver)
+ (ppx_runtime_libraries ppx_compare.runtime-lib)
+ (libraries base ppxlib ppx_compare_expander)
+ (preprocess no_preprocessing))

unikernel/duniverse/ppx_compare/src/ppx_compare.ml

@@ -0,0 +1,58 @@
+open Base
+open Ppxlib
+open Ppx_compare_expander
+
+let add_deriver name (module E : Ppx_compare_expander.S) =
+  let flags () = Deriving.Args.(empty +> flag "localize") in
+  let str_type_decl =
+    Deriving.Generator.V2.make (flags ()) E.str_type_decl ~attributes:E.str_attributes
+  in
+  let sig_type_decl = Deriving.Generator.V2.make (flags ()) E.sig_type_decl in
+  Deriving.add name ~str_type_decl ~sig_type_decl
+;;
+
+let compare = add_deriver "compare" (module Compare)
+let equal = add_deriver "equal" (module Equal)
+
+let replace_underscores_by_variables =
+  let map =
+    object
+      inherit Ast_traverse.map as super
+
+      method! core_type_desc =
+        function
+        | Ptyp_any -> Ptyp_var (gen_symbol ~prefix:"a" ())
+        | t -> super#core_type_desc t
+    end
+  in
+  map#core_type
+;;
+
+let () =
+  [ "compare", "compare_local", Compare.type_, Compare.core_type
+  ; "equal", "equal_local", Equal.type_, Equal.core_type
+  ; "@compare.equal", "@compare_local.equal", Equal.type_, Compare.equal_core_type
+  ]
+  |> List.concat_map ~f:(fun (name, local_name, type_, core_type) ->
+       [ name, type_ ~with_local:false, core_type ~with_local:false
+       ; local_name, type_ ~with_local:true, core_type ~with_local:true
+       ])
+  |> List.iter ~f:(fun (name, type_, core_type) ->
+       Driver.register_transformation
+         (String.strip name ~drop:(Char.equal '@'))
+         ~rules:
+           [ Context_free.Rule.extension
+               (Extension.declare
+                  name
+                  Core_type
+                  Ast_pattern.(ptyp __)
+                  (fun ~loc ~path:_ ty ->
+                    type_ ~hide:true ~loc (replace_underscores_by_variables ty)))
+           ; Context_free.Rule.extension
+               (Extension.declare
+                  name
+                  Expression
+                  Ast_pattern.(ptyp __)
+                  (fun ~loc:_ ~path:_ ty -> core_type ty))
+           ])
+;;

unikernel/duniverse/ppx_compare/src/ppx_compare.mli

@@ -0,0 +1,4 @@
+open Ppxlib
+
+val compare : Deriving.t
+val equal : Deriving.t

unikernel/duniverse/ppx_compare/test/check_optims.ml

@@ -0,0 +1,40 @@
+open Ppx_compare_lib
+
+type enum =
+  | A
+  | B
+  | C
+
+module Compare = struct
+  let optim_bool : bool compare = Stdlib.compare
+  let optim_char : char compare = Stdlib.compare
+  let optim_float : float compare = Stdlib.compare
+  let optim_int : int compare = Stdlib.compare
+  let optim_int32 : int32 compare = Stdlib.compare
+  let optim_int64 : int64 compare = Stdlib.compare
+  let optim_nativeint : nativeint compare = Stdlib.compare
+  let optim_string : string compare = Stdlib.compare
+  let optim_unit : unit compare = Stdlib.compare
+  let optim_enum : enum compare = Stdlib.compare
+end
+
+module Equal = struct
+  let optim_bool : bool equal = Stdlib.( = )
+  let optim_char : char equal = Stdlib.( = )
+  let optim_float : float equal = Stdlib.( = )
+  let optim_int : int equal = Stdlib.( = )
+  let optim_int32 : int32 equal = Stdlib.( = )
+  let optim_nativeint : nativeint equal = Stdlib.( = )
+  let optim_string : string equal = Stdlib.( = )
+  let optim_unit : unit equal = Stdlib.( = )
+  let optim_enum : enum equal = Stdlib.( = )
+
+  let optim_int64 =
+    if Sys.word_size = 32
+    then
+      (* On 32bits, polymmorphic comparison of int64 values is not specialized *)
+      fun _ _ ->
+      false
+    else (Stdlib.( = ) : int64 equal)
+  ;;
+end

unikernel/duniverse/ppx_compare/test/compare_test.mlt

@@ -0,0 +1,12 @@
+open Base
+
+module No_comparing2 = struct
+  (* Checks that we don't trigger an 'unused rec' warning. *)
+  type t =
+    { a : t [@compare.ignore]
+    ; b : (t[@compare.ignore]) * int
+    }
+  [@@deriving compare]
+end
+
+[%%expect {| |}]

unikernel/duniverse/ppx_compare/test/dune

@@ -0,0 +1,8 @@
+(library
+ (name comparelib_test)
+ (preprocess
+  (pps ppxlib ppx_compare ppx_inline_test)))
+
+(alias
+ (name DEFAULT)
+ (deps test.ml.pp))

unikernel/duniverse/ppx_compare/test/errors.mlt

@@ -0,0 +1,43 @@
+open Ppx_compare_lib.Builtin
+
+type t =
+  { x : int [@compare.ignore]
+  ; y : int
+  }
+[@@deriving equal]
+
+[%%expect
+  {|
+Line _, characters _-_:
+Error: Cannot use [@compare.ignore] with [@@deriving equal]
+|}]
+
+type t =
+  { x : int [@equal.ignore]
+  ; y : int
+  }
+[@@deriving compare, equal]
+
+[%%expect
+  {|
+Line _, characters _-_:
+Error: Cannot use [@equal.ignore] with [@@deriving compare].
+|}]
+
+(* The following ones are OK: *)
+
+type t =
+  { x : int [@compare.ignore] [@equal.ignore]
+  ; y : int
+  }
+[@@deriving compare, equal]
+
+[%%expect {| |}]
+
+type t =
+  { x : int [@ignore]
+  ; y : int
+  }
+[@@deriving compare, equal]
+
+[%%expect {| |}]

unikernel/duniverse/ppx_compare/test/test.ml

@@ -0,0 +1,746 @@
+open Ppx_compare_lib.Builtin
+
+let failwith = `Should_refer_to_runtime_lib
+let ignore = `Should_refer_to_runtime_lib
+let ( = ) = `Should_refer_to_runtime_lib
+let ( <> ) = `Should_refer_to_runtime_lib
+let ( == ) = `Should_refer_to_runtime_lib
+let ( != ) = `Should_refer_to_runtime_lib
+let ( > ) = `Should_refer_to_runtime_lib
+let ( < ) = `Should_refer_to_runtime_lib
+let ( >= ) = `Should_refer_to_runtime_lib
+let ( <= ) = `Should_refer_to_runtime_lib
+let max = `Should_refer_to_runtime_lib
+let min = `Should_refer_to_runtime_lib
+let equal = `Should_refer_to_runtime_lib
+let compare = `Should_refer_to_runtime_lib
+
+module type M1_sig = sig
+  type t [@@deriving_inline compare, equal, compare ~localize, equal ~localize]
+
+  include sig
+    [@@@ocaml.warning "-32"]
+
+    include Ppx_compare_lib.Comparable.S with type t := t
+    include Ppx_compare_lib.Equal.S with type t := t
+    include Ppx_compare_lib.Comparable.S with type t := t
+    include Ppx_compare_lib.Comparable.S_local with type t := t
+    include Ppx_compare_lib.Equal.S with type t := t
+    include Ppx_compare_lib.Equal.S_local with type t := t
+  end
+  [@@ocaml.doc "@inline"]
+
+  [@@@end]
+end
+
+module type M1_sig_wrong_name = sig
+  type t1 [@@deriving_inline compare, equal, compare ~localize, equal ~localize]
+
+  include sig
+    [@@@ocaml.warning "-32"]
+
+    val compare_t1 : t1 -> t1 -> int
+    val equal_t1 : t1 -> t1 -> bool
+    val compare_t1 : t1 -> t1 -> int
+    val compare_t1__local : t1 -> t1 -> int
+    val equal_t1 : t1 -> t1 -> bool
+    val equal_t1__local : t1 -> t1 -> bool
+  end
+  [@@ocaml.doc "@inline"]
+
+  [@@@end]
+end
+
+module type M2_sig = sig
+  type 'a t [@@deriving_inline compare, equal, compare ~localize, equal ~localize]
+
+  include sig
+    [@@@ocaml.warning "-32"]
+
+    include Ppx_compare_lib.Comparable.S1 with type 'a t := 'a t
+    include Ppx_compare_lib.Equal.S1 with type 'a t := 'a t
+    include Ppx_compare_lib.Comparable.S1 with type 'a t := 'a t
+    include Ppx_compare_lib.Comparable.S_local1 with type 'a t := 'a t
+    include Ppx_compare_lib.Equal.S1 with type 'a t := 'a t
+    include Ppx_compare_lib.Equal.S_local1 with type 'a t := 'a t
+  end
+  [@@ocaml.doc "@inline"]
+
+  [@@@end]
+end
+
+module type M2_sig_wrong_name = sig
+  type 'a t1 [@@deriving_inline compare, equal, compare ~localize, equal ~localize]
+
+  include sig
+    [@@@ocaml.warning "-32"]
+
+    val compare_t1 : ('a -> 'a -> int) -> 'a t1 -> 'a t1 -> int
+    val equal_t1 : ('a -> 'a -> bool) -> 'a t1 -> 'a t1 -> bool
+    val compare_t1 : ('a -> 'a -> int) -> 'a t1 -> 'a t1 -> int
+    val compare_t1__local : ('a -> 'a -> int) -> 'a t1 -> 'a t1 -> int
+    val equal_t1 : ('a -> 'a -> bool) -> 'a t1 -> 'a t1 -> bool
+    val equal_t1__local : ('a -> 'a -> bool) -> 'a t1 -> 'a t1 -> bool
+  end
+  [@@ocaml.doc "@inline"]
+
+  [@@@end]
+end
+
+module M1 = struct
+  type t = unit [@@deriving compare, equal, compare ~localize, equal ~localize]
+end
+
+module M2 = struct
+  type t = int [@@deriving compare, equal, compare ~localize, equal ~localize]
+end
+
+module M3 = struct
+  type t = bool [@@deriving compare, equal, compare ~localize, equal ~localize]
+end
+
+module M4 = struct
+  type t = int32 [@@deriving compare, equal, compare ~localize, equal ~localize]
+end
+
+module M5 = struct
+  type t = nativeint [@@deriving compare, equal, compare ~localize, equal ~localize]
+end
+
+module M6 = struct
+  type t = int64 [@@deriving compare, equal, compare ~localize, equal ~localize]
+end
+
+module M7 = struct
+  type t = float [@@deriving compare, equal, compare ~localize, equal ~localize]
+end
+
+module M8 = struct
+  type t = bool * float [@@deriving compare, equal, compare ~localize, equal ~localize]
+end
+
+module M9 = struct
+  type t = bool * float * int
+  [@@deriving compare, equal, compare ~localize, equal ~localize]
+end
+
+module M10 = struct
+  type t = bool * float * int * string
+  [@@deriving compare, equal, compare ~localize, equal ~localize]
+end
+
+module M11 = struct
+  type t = int ref [@@deriving compare, equal, compare ~localize, equal ~localize]
+end
+
+module M12 = struct
+  type t = (float * float) option
+  [@@deriving compare, equal, compare ~localize, equal ~localize]
+end
+
+module M13 = struct
+  type t = float array [@@deriving compare, equal, compare ~localize, equal ~localize]
+end
+
+module M14 = struct
+  type t = (int * int) array
+  [@@deriving compare, equal, compare ~localize, equal ~localize]
+end
+
+module M15 = struct
+  type t = float array array
+  [@@deriving compare, equal, compare ~localize, equal ~localize]
+end
+
+module M16 = struct
+  type t = int list [@@deriving compare, equal, compare ~localize, equal ~localize]
+end
+
+module M17 = struct
+  type t =
+    { s : string
+    ; b : float array list
+    ; mutable c : int * int64 option
+    }
+  [@@deriving compare, equal, compare ~localize, equal ~localize]
+end
+
+module M18 = struct
+  type t =
+    { a : float
+    ; b : float
+    ; c : float
+    }
+  [@@deriving compare, equal, compare ~localize, equal ~localize]
+end
+
+module M19 = struct
+  type t = Foo [@@deriving compare, equal, compare ~localize, equal ~localize]
+end
+
+module M20 = struct
+  type t = Foo of int [@@deriving compare, equal, compare ~localize, equal ~localize]
+end
+
+module M21 = struct
+  type t = Foo of int * float
+  [@@deriving compare, equal, compare ~localize, equal ~localize]
+end
+
+module M22 = struct
+  type t =
+    | Foo
+    | Bar of int
+    | Baz of string option
+  [@@deriving compare, equal, compare ~localize, equal ~localize]
+end
+
+module M23 = struct
+  type t =
+    [ `Foo
+    | `Bar of string * string
+    ]
+  [@@deriving compare, equal, compare ~localize, equal ~localize]
+end
+
+module M24 = struct
+  type t = int * string * [ `Foo | `Bar ]
+  [@@deriving compare, equal, compare ~localize, equal ~localize]
+end
+
+module M25 = struct
+  (* no local comparison for String.t, only for string, so we don't test that *)
+  type t = String.t [@@deriving compare, equal]
+end
+
+module type M26_sig = sig
+  type 'a t [@@deriving_inline compare, equal, compare ~localize, equal ~localize]
+
+  include sig
+    [@@@ocaml.warning "-32"]
+
+    include Ppx_compare_lib.Comparable.S1 with type 'a t := 'a t
+    include Ppx_compare_lib.Equal.S1 with type 'a t := 'a t
+    include Ppx_compare_lib.Comparable.S1 with type 'a t := 'a t
+    include Ppx_compare_lib.Comparable.S_local1 with type 'a t := 'a t
+    include Ppx_compare_lib.Equal.S1 with type 'a t := 'a t
+    include Ppx_compare_lib.Equal.S_local1 with type 'a t := 'a t
+  end
+  [@@ocaml.doc "@inline"]
+
+  [@@@end]
+end
+
+module M26 = struct
+  type 'a t = 'a array [@@deriving compare, equal, compare ~localize, equal ~localize]
+end
+
+module MyList = struct
+  type 'a t =
+    | Nil
+    | Node of 'a * 'a t
+  [@@deriving compare, equal, compare ~localize, equal ~localize]
+end
+
+module M27 = struct
+  type t = int [@@deriving compare, equal, compare ~localize, equal ~localize]
+
+  module Inner = struct
+    type nonrec t = t list [@@deriving compare, equal, compare ~localize, equal ~localize]
+
+    let _ = ((compare : int list -> int list -> int) : t -> t -> int)
+  end
+end
+
+module M28 = struct
+  (* making sure that nobody is reversing the type parameters *)
+  type ('a, 'b) t = ('a * 'b) list
+  [@@deriving compare, equal, compare ~localize, equal ~localize]
+
+  let (_ : (int, float) t -> int) = [%compare: (int, float) t] [ 1, nan ]
+end
+
+module M29 = struct
+  type t =
+    | A of
+        { a : float
+        ; b : float
+        ; c : float
+        }
+    | B of float * float * float
+  [@@deriving compare, equal, compare ~localize, equal ~localize]
+end
+
+module M30 = struct
+  type ('a, 'b) t =
+    | A of
+        { a : 'a
+        ; b : 'b
+        ; c : float
+        }
+    | B of 'a * 'b
+  [@@deriving compare, equal, compare ~localize, equal ~localize]
+end
+
+module type Polyrec_sig = sig
+  type ('a, 'b) t = T of ('a option, 'b) t [@@deriving_inline compare, equal]
+
+  include sig
+    [@@@ocaml.warning "-32"]
+
+    include Ppx_compare_lib.Comparable.S2 with type ('a, 'b) t := ('a, 'b) t
+    include Ppx_compare_lib.Equal.S2 with type ('a, 'b) t := ('a, 'b) t
+  end
+  [@@ocaml.doc "@inline"]
+
+  [@@@end]
+
+  type ('a, 'b) t1 = T of ('a option, 'b) t2
+
+  and ('a, 'b) t2 =
+    | T1 of ('a list, 'b) t1
+    | T2 of ('a, 'b list) t2
+  [@@deriving_inline compare, equal]
+
+  include sig
+    [@@@ocaml.warning "-32"]
+
+    val compare_t1
+      :  ('a -> 'a -> int)
+      -> ('b -> 'b -> int)
+      -> ('a, 'b) t1
+      -> ('a, 'b) t1
+      -> int
+
+    val compare_t2
+      :  ('a -> 'a -> int)
+      -> ('b -> 'b -> int)
+      -> ('a, 'b) t2
+      -> ('a, 'b) t2
+      -> int
+
+    val equal_t1
+      :  ('a -> 'a -> bool)
+      -> ('b -> 'b -> bool)
+      -> ('a, 'b) t1
+      -> ('a, 'b) t1
+      -> bool
+
+    val equal_t2
+      :  ('a -> 'a -> bool)
+      -> ('b -> 'b -> bool)
+      -> ('a, 'b) t2
+      -> ('a, 'b) t2
+      -> bool
+  end
+  [@@ocaml.doc "@inline"]
+
+  [@@@end]
+end
+
+module Polyrec = struct
+  type ('a, 'b) t = T of ('a option, 'b) t
+  [@@deriving compare, equal, compare ~localize, equal ~localize]
+
+  type ('a, 'b) t1 = T of ('a option, 'b) t2
+
+  and ('a, 'b) t2 =
+    | T1 of ('a list, 'b) t1
+    | T2 of ('a, 'b list) t2
+  [@@deriving compare, equal, compare ~localize, equal ~localize]
+end
+
+module type Variance_sig = sig
+  type +'a t [@@deriving compare, equal, compare ~localize, equal ~localize]
+end
+
+module Variance = struct
+  type -'a t [@@deriving compare, equal, compare ~localize, equal ~localize]
+
+  type (-'a, +'b) u = 'a t * 'b
+  [@@deriving compare, equal, compare ~localize, equal ~localize]
+end
+
+module Test = struct
+  let ( = ) : int -> int -> bool = Base.Poly.( = )
+
+  (* checking that for the types mentioned in the readme, we compare structurally  *)
+  let%test _ = [%compare: unit option] None (Some ()) = Base.Poly.compare None (Some ())
+  let%test _ = [%compare: unit list] [] [ () ] = Base.Poly.compare [] [ () ]
+
+  let%test _ =
+    [%compare: int array] [| 0; 1 |] [| 1 |] = Base.Poly.compare [| 0; 1 |] [| 1 |]
+  ;;
+
+  let%test _ =
+    Base.Poly.( = )
+      (List.sort [%compare: int option] [ Some 3; None; Some 2; Some 1 ])
+      [ None; Some 1; Some 2; Some 3 ]
+  ;;
+end
+
+module Variant_inclusion = struct
+  type 'a type1 = [ `T1 of 'a ]
+  [@@deriving compare, equal, compare ~localize, equal ~localize]
+
+  type 'a type2 =
+    [ 'a type1
+    | `T2
+    ]
+  [@@deriving compare, equal, compare ~localize, equal ~localize]
+
+  type 'a type3 =
+    [ `T3
+    | 'a type1
+    ]
+  [@@deriving compare, equal, compare ~localize, equal ~localize]
+
+  type 'a type4 =
+    [ 'a type2
+    | `T4
+    | 'a type3
+    ]
+  [@@deriving compare, equal, compare ~localize, equal ~localize]
+
+  type 'a id = 'a [@@deriving compare, equal, compare ~localize, equal ~localize]
+
+  type ('a, 'b) u = [ `u of 'a * 'b ]
+  [@@deriving compare, equal, compare ~localize, equal ~localize]
+
+  type t = [ | (int, int) u ]
+  [@@deriving compare, equal, compare ~localize, equal ~localize]
+end
+
+module Equal = struct
+  let%test _ = [%compare.equal: int list] [ 7; 8; 9 ] [ 7; 8; 9 ]
+  let%test _ = not ([%compare.equal: int list] [ 7; 8 ] [ 7; 8; 9 ])
+
+  let%test _ =
+    match [%compare: int * int] (1, 2) (1, 3) with
+    | -1 -> true
+    | _ -> false
+  ;;
+
+  let%test _ =
+    match [%compare: int * int] (1, 3) (1, 2) with
+    | 1 -> true
+    | _ -> false
+  ;;
+
+  let%test _ = [%compare.equal: string option] None None
+  let%test _ = not ([%compare.equal: string option] (Some "foo") None)
+  let%test _ = [%compare.equal: string] "hello" "hello"
+  let%test _ = not ([%compare.equal: string] "hello" "goodbye")
+end
+
+module Equal_local = struct
+  let%test _ = [%compare_local.equal: int list] [ 7; 8; 9 ] [ 7; 8; 9 ]
+  let%test _ = not ([%compare_local.equal: int list] [ 7; 8 ] [ 7; 8; 9 ])
+
+  let%test _ =
+    match [%compare_local: int * int] (1, 2) (1, 3) with
+    | -1 -> true
+    | _ -> false
+  ;;
+
+  let%test _ =
+    match [%compare_local: int * int] (1, 3) (1, 2) with
+    | 1 -> true
+    | _ -> false
+  ;;
+
+  let%test _ = [%compare_local.equal: string option] None None
+  let%test _ = not ([%compare_local.equal: string option] (Some "foo") None)
+  let%test _ = [%compare_local.equal: string] "hello" "hello"
+  let%test _ = not ([%compare_local.equal: string] "hello" "goodbye")
+end
+
+module Type_extensions : sig
+  (* Making sure we don't generate [_ t -> _ t -> int], as
+     that's too general. *)
+  module type S = sig
+    type 'a t
+
+    val compare : [%compare: _ t]
+    val equal : [%compare.equal: _ t]
+    val compare__local : [%compare_local: _ t]
+    val equal__local : [%compare_local.equal: _ t]
+  end
+end = struct
+  module type S = sig
+    type 'a t
+
+    val compare : 'a t -> 'a t -> int
+    val equal : 'a t -> 'a t -> bool
+    val compare__local : 'a t -> 'a t -> int
+    val equal__local : 'a t -> 'a t -> bool
+  end
+end
+
+module Ignoring_field = struct
+  type t =
+    { a : int [@ignore]
+    ; b : int
+    ; c : int
+    }
+  [@@deriving_inline compare, equal]
+
+  let _ = fun (_ : t) -> ()
+
+  let compare =
+    (fun a__1375_ b__1376_ ->
+       if Stdlib.( == ) a__1375_ b__1376_
+       then 0
+       else (
+         match compare_int a__1375_.b b__1376_.b with
+         | 0 -> compare_int a__1375_.c b__1376_.c
+         | n -> n)
+      : t -> t -> int)
+  ;;
+
+  let _ = compare
+
+  let equal =
+    (fun a__1377_ b__1378_ ->
+       if Stdlib.( == ) a__1377_ b__1378_
+       then true
+       else
+         Stdlib.( && ) (equal_int a__1377_.b b__1378_.b) (equal_int a__1377_.c b__1378_.c)
+      : t -> t -> bool)
+  ;;
+
+  let _ = equal
+
+  [@@@deriving.end]
+
+  let equal = [%compare.equal: t]
+end
+
+module Ignoring_inline = struct
+  type t = int * int * int
+
+  let compare = [%compare: _ * (int[@ignore]) * int]
+  let _ = compare
+  let equal = [%compare.equal: t]
+  let%test _ = equal (0, 1, 2) (9, 1, 2)
+  let%test _ = equal (0, 1, 2) (0, 9, 2)
+  let%test _ = not (equal (0, 1, 2) (0, 1, 9))
+end
+
+module Ignoring = struct
+  type t = { a : (int[@ignore]) * string } [@@deriving_inline compare, equal]
+
+  let _ = fun (_ : t) -> ()
+
+  let compare =
+    (fun a__1395_ b__1396_ ->
+       if Stdlib.( == ) a__1395_ b__1396_
+       then 0
+       else (
+         let t__1397_, t__1398_ = a__1395_.a in
+         let t__1399_, t__1400_ = b__1396_.a in
+         match
+           let (_ : _) = t__1397_
+           and (_ : _) = t__1399_ in
+           0
+         with
+         | 0 -> compare_string t__1398_ t__1400_
+         | n -> n)
+      : t -> t -> int)
+  ;;
+
+  let _ = compare
+
+  let equal =
+    (fun a__1401_ b__1402_ ->
+       if Stdlib.( == ) a__1401_ b__1402_
+       then true
+       else (
+         let t__1403_, t__1404_ = a__1401_.a in
+         let t__1405_, t__1406_ = b__1402_.a in
+         Stdlib.( && )
+           (let (_ : _) = t__1403_
+            and (_ : _) = t__1405_ in
+            true)
+           (equal_string t__1404_ t__1406_))
+      : t -> t -> bool)
+  ;;
+
+  let _ = equal
+
+  [@@@deriving.end]
+
+  let%test _ = equal { a = 1, "hi" } { a = 2, "hi" }
+  let%test _ = not (equal { a = 1, "hi" } { a = 1, "ho" })
+end
+
+module Ignoring_with_type = struct
+  type t =
+    { a : int
+    ; b : (int[@compare.ignore])
+    }
+  [@@deriving_inline compare]
+
+  let _ = fun (_ : t) -> ()
+
+  let compare =
+    (fun a__1407_ b__1408_ ->
+       if Stdlib.( == ) a__1407_ b__1408_
+       then 0
+       else (
+         match compare_int a__1407_.a b__1408_.a with
+         | 0 ->
+           let (_ : _) = a__1407_.b
+           and (_ : _) = b__1408_.b in
+           0
+         | n -> n)
+      : t -> t -> int)
+  ;;
+
+  let _ = compare
+
+  [@@@deriving.end]
+end
+
+module Enum_optim = struct
+  type t =
+    | A
+    | B
+    | C
+  [@@deriving_inline compare, equal]
+
+  let _ = fun (_ : t) -> ()
+  let compare = (Stdlib.compare : t -> t -> int)
+  let _ = compare
+  let equal = (Stdlib.( = ) : t -> t -> bool)
+  let _ = equal
+
+  [@@@deriving.end]
+end
+
+module Lazy_behavior = struct
+  (* Test that the generated functions don't evaluate more than necessary *)
+  type a = unit
+
+  let equal_a () () = assert false
+  let equal_a__local () () = assert false
+  let compare_a () () = assert false
+  let compare_a__local () () = assert false
+
+  type b = int * a [@@deriving compare, equal, compare ~localize, equal ~localize]
+
+  let%test _ = not (equal_b (0, ()) (1, ()))
+  let%test _ = Base.Poly.( < ) (compare_b (0, ()) (1, ())) 0
+end
+
+module Not_ieee_compliant = struct
+  type t = float [@@deriving compare, equal, compare ~localize, equal ~localize]
+
+  let%test _ = [%equal: t] nan nan
+  let%test _ = Base.Poly.( = ) ([%compare: t] nan nan) 0
+end
+
+module Wildcard : sig
+  type _ transparent = int [@@deriving compare, equal, compare ~localize, equal ~localize]
+  type _ opaque [@@deriving compare, equal, compare ~localize, equal ~localize]
+end = struct
+  type _ transparent = int [@@deriving compare, equal, compare ~localize, equal ~localize]
+
+  let%test _ = [%equal: string transparent] 1 1
+  let%test _ = not ([%equal: string transparent] 1 2)
+  let%test _ = Base.Poly.( < ) ([%compare: string transparent] 1 2) 0
+  let%test _ = Base.Poly.( = ) ([%compare: string transparent] 1 1) 0
+  let%test _ = Base.Poly.( > ) ([%compare: string transparent] 2 1) 0
+
+  type 'a opaque = 'a option
+  [@@deriving compare, equal, compare ~localize, equal ~localize]
+
+  let%test _ = [%equal: int opaque] (Some 1) (Some 1)
+  let%test _ = not ([%equal: int opaque] None (Some 1))
+  let%test _ = not ([%equal: int opaque] (Some 1) (Some 2))
+  let%test _ = Base.Poly.( < ) ([%compare: int opaque] None (Some 1)) 0
+  let%test _ = Base.Poly.( = ) ([%compare: int opaque] (Some 1) (Some 1)) 0
+  let%test _ = Base.Poly.( > ) ([%compare: int opaque] (Some 2) (Some 1)) 0
+end
+
+module Local_with_aliased_comparisons : sig
+  type t =
+    | Int of int
+    | Add of t * t
+    | Sub of t * t
+  [@@deriving_inline compare ~localize, equal ~localize]
+
+  include sig
+    [@@@ocaml.warning "-32"]
+
+    include Ppx_compare_lib.Comparable.S with type t := t
+    include Ppx_compare_lib.Comparable.S_local with type t := t
+    include Ppx_compare_lib.Equal.S with type t := t
+    include Ppx_compare_lib.Equal.S_local with type t := t
+  end
+  [@@ocaml.doc "@inline"]
+
+  [@@@end]
+end = struct
+  type t =
+    | Int of int
+    | Add of t * t
+    | Sub of t * t
+  [@@deriving_inline compare ~localize, equal ~localize]
+
+  let _ = fun (_ : t) -> ()
+
+  let rec compare__local =
+    (fun a__1541_ b__1542_ ->
+       if Stdlib.( == ) a__1541_ b__1542_
+       then 0
+       else (
+         match a__1541_, b__1542_ with
+         | Int _a__1543_, Int _b__1544_ -> compare_int__local _a__1543_ _b__1544_
+         | Int _, _ -> -1
+         | _, Int _ -> 1
+         | Add (_a__1545_, _a__1547_), Add (_b__1546_, _b__1548_) ->
+           (match compare__local _a__1545_ _b__1546_ with
+            | 0 -> compare__local _a__1547_ _b__1548_
+            | n -> n)
+         | Add _, _ -> -1
+         | _, Add _ -> 1
+         | Sub (_a__1549_, _a__1551_), Sub (_b__1550_, _b__1552_) ->
+           (match compare__local _a__1549_ _b__1550_ with
+            | 0 -> compare__local _a__1551_ _b__1552_
+            | n -> n))
+      : t -> t -> int)
+  ;;
+
+  let _ = compare__local
+  let compare = (fun a b -> compare__local a b : t -> t -> int)
+  let _ = compare
+
+  let rec equal__local =
+    (fun a__1553_ b__1554_ ->
+       if Stdlib.( == ) a__1553_ b__1554_
+       then true
+       else (
+         match a__1553_, b__1554_ with
+         | Int _a__1555_, Int _b__1556_ -> equal_int__local _a__1555_ _b__1556_
+         | Int _, _ -> false
+         | _, Int _ -> false
+         | Add (_a__1557_, _a__1559_), Add (_b__1558_, _b__1560_) ->
+           Stdlib.( && )
+             (equal__local _a__1557_ _b__1558_)
+             (equal__local _a__1559_ _b__1560_)
+         | Add _, _ -> false
+         | _, Add _ -> false
+         | Sub (_a__1561_, _a__1563_), Sub (_b__1562_, _b__1564_) ->
+           Stdlib.( && )
+             (equal__local _a__1561_ _b__1562_)
+             (equal__local _a__1563_ _b__1564_))
+      : t -> t -> bool)
+  ;;
+
+  let _ = equal__local
+  let equal = (fun a b -> equal__local a b : t -> t -> bool)
+  let _ = equal
+
+  [@@@end]
+end