unikernel/duniverse/ppxlib/bench/bench.ml

@@ -0,0 +1,223 @@
+(* Driver Benchmark Runner
+
+   Assumes the existence of a directory named "drivers" next to the benchmark
+   runner executable whose hierarchy is:
+
+   drivers
+   ├── <driver1>
+   │   ├── driver.ml
+   │   ├── dune
+   │   └── inputs
+   │       ├── <input1>
+   │       ├── <input2>
+   │       └── ...
+   ├── <driver2>
+   │   ├── driver.ml
+   │   ├── dune
+   │   └── inputs
+   │       ├── <input1>
+   │       ├── <input2>
+   │       └── ...
+   └── ...
+
+   This benchmark runner will invoke each driver on each of the input files
+   associated with it (ie. the files in its "inputs" directory).
+*)
+
+(* Run a program on a list of arguments, sending its output to /dev/null,
+   returning the wallclock duration of the program in seconds. *)
+let time_run_blocking program args =
+  let args_arr = Array.of_list (program :: args) in
+  let dev_null = Unix.openfile "/dev/null" [ Unix.O_RDWR ] 0 in
+  let timestamp_before = Unix.gettimeofday () in
+  let child_pid =
+    Unix.create_process program args_arr dev_null dev_null dev_null
+  in
+  let got_pid, status = Unix.waitpid [] child_pid in
+  let timestamp_after = Unix.gettimeofday () in
+  Unix.close dev_null;
+  if got_pid <> child_pid then failwith "wait returned unexpected pid";
+  let () =
+    match status with
+    | Unix.WEXITED 0 -> ()
+    | _ ->
+        let command_string = String.concat " " (program :: args) in
+        failwith
+          (Printf.sprintf "`%s` did not exit successfully" command_string)
+  in
+  timestamp_after -. timestamp_before
+
+(* Takes the path of a directory and returns a list of the full paths of the
+   files contained within it. Filters dot files and folders. *)
+let readdir_full_paths dir =
+  Sys.readdir dir |> Array.to_list |> List.sort String.compare
+  |> List.filter (fun path -> path.[0] <> '.')
+  |> List.map (Filename.concat dir)
+
+module Input = struct
+  type t = { path : string }
+
+  let name { path } = Filename.basename path
+end
+
+module Driver = struct
+  type t = { path : string }
+
+  let name { path } = Filename.basename (Filename.dirname path)
+end
+
+module Output = struct
+  module Metric = struct
+    type t = { name : string; value : Yojson.t; units : string }
+
+    let create ~name ~value ~units = { name; value; units }
+
+    let to_json { name; value; units } : Yojson.t =
+      `Assoc
+        [ ("name", `String name); ("value", value); ("units", `String units) ]
+  end
+
+  module Result = struct
+    type t = { name : string; metrics : Metric.t list }
+
+    let create ~name ~metrics = { name; metrics }
+
+    let to_json { name; metrics } : Yojson.t =
+      `Assoc
+        [
+          ("name", `String name);
+          ("metrics", `List (List.map Metric.to_json metrics));
+        ]
+  end
+
+  module Benchmark = struct
+    type t = { name : string; results : Result.t list }
+
+    let create ~name ~results = { name; results }
+
+    let to_json { name; results } : Yojson.t =
+      `Assoc
+        [
+          ("name", `String name);
+          ("results", `List (List.map Result.to_json results));
+        ]
+  end
+end
+
+module Stats = struct
+  let sum xs = List.fold_left ( +. ) 0.0 xs
+  let mean xs = sum xs /. Int.to_float (List.length xs)
+
+  let variance xs =
+    let xs_mean = mean xs in
+    List.map (fun x -> Float.pow (x -. xs_mean) 2.) xs |> mean
+
+  let stddev xs = Float.sqrt (variance xs)
+end
+
+module Benchmark = struct
+  type t = { driver : Driver.t; input : Input.t }
+
+  let create ~driver ~input = { driver; input }
+
+  let name { driver; input } =
+    Printf.sprintf "%s %s" (Driver.name driver) (Input.name input)
+
+  let time_run_blocking { driver; input } =
+    time_run_blocking driver.path [ input.path ]
+
+  let repeat n f = List.init n (fun _ -> f ())
+
+  let run_blocking t ~n_warmup ~n =
+    let run () = time_run_blocking t in
+    let _warmup = repeat n_warmup run in
+    let times = repeat n run in
+    let mean = Stats.mean times in
+    let stddev = Stats.stddev times in
+    let metrics =
+      [
+        Output.Metric.create ~name:"time mean" ~value:(`Float mean)
+          ~units:"seconds";
+        Output.Metric.create ~name:"time stddev" ~value:(`Float stddev)
+          ~units:"seconds";
+      ]
+    in
+    Output.Result.create ~name:(name t) ~metrics
+end
+
+module Driver_dir = struct
+  type t = { path : string }
+
+  let driver_name = "driver.exe"
+  let inputs_dir_name = "inputs"
+  let driver_path { path } = Filename.concat path driver_name
+  let driver t = { Driver.path = driver_path t }
+  let inputs_path { path } = Filename.concat path inputs_dir_name
+
+  let of_path path =
+    let t = { path } in
+    if not (Sys.file_exists (driver_path t)) then
+      failwith (Printf.sprintf "failed to find %s in %s" driver_name path);
+    if not (Sys.file_exists (inputs_path t)) then
+      failwith (Printf.sprintf "failed to find %s in %s" inputs_dir_name path);
+    t
+
+  let inputs t =
+    readdir_full_paths (inputs_path t) |> List.map (fun path -> { Input.path })
+
+  let benchmarks t =
+    let driver = driver t in
+    inputs t |> List.map (fun input -> Benchmark.create ~driver ~input)
+end
+
+module Path_to_current_exe = struct
+  let via_procfs () =
+    (* Look up the current executable's path in the proc filesystem. *)
+    let pid = Unix.getpid () in
+    let proc_exe_path = Printf.sprintf "/proc/%d/exe" pid in
+    if Sys.file_exists proc_exe_path then Some (Unix.readlink proc_exe_path)
+    else None
+
+  let via_cwd () =
+    (* Assume the current working directory is the root of the project (as it
+       would be if this was run via `make bench`) and find the path to the
+       current exe relative to the project root *)
+    let cwd = Unix.getcwd () in
+    let relative_path = "_build/default/bench/bench.exe" in
+    let absolute_path = Filename.concat cwd relative_path in
+    if Sys.file_exists absolute_path then Some absolute_path else None
+
+  let methods = [ via_procfs; via_cwd ]
+
+  let get () =
+    let maybe_path = List.find_map (fun m -> m ()) methods in
+    match maybe_path with
+    | Some path -> path
+    | None -> failwith "couldn't determine the path to the current exe"
+end
+
+module Benchmark_suite = struct
+  let get_bench_dir () = Filename.dirname (Path_to_current_exe.get ())
+  let drivers_dir_name = "drivers"
+
+  (* Returns the list of ppxlib drivers that will be benchmarked *)
+  let get_driver_dirs () =
+    let bench_dir = get_bench_dir () in
+    readdir_full_paths (Filename.concat bench_dir drivers_dir_name)
+    |> List.map Driver_dir.of_path
+
+  let get_benchmarks () =
+    get_driver_dirs () |> List.concat_map Driver_dir.benchmarks
+
+  let run_benchmarks ~n_warmup ~n =
+    let benchmarks = get_benchmarks () in
+    let results = List.map (Benchmark.run_blocking ~n_warmup ~n) benchmarks in
+    Output.Benchmark.create ~name:"benchmarks" ~results
+    |> Output.Benchmark.to_json
+end
+
+let () =
+  let n_warmup = 10 in
+  let n = 100 in
+  Benchmark_suite.run_benchmarks ~n_warmup ~n
+  |> Yojson.pretty_to_string |> print_endline

unikernel/duniverse/ppxlib/bench/drivers/identity/driver.ml

@@ -0,0 +1 @@
+Ppxlib.Driver.standalone ()

unikernel/duniverse/ppxlib/bench/drivers/identity/dune

@@ -0,0 +1,7 @@
+; A driver with no plugins
+
+(executable
+ (name driver)
+ (enabled_if
+  (>= %{ocaml_version} "4.10.0"))
+ (libraries ppxlib))

unikernel/duniverse/ppxlib/bench/drivers/identity/inputs/market_data.ml

@@ -0,0 +1,451 @@
+(* Taken from ocaml-gemini (https://github.com/struktured/ocaml-gemini) which is
+   under the MIT license:
+   https://github.com/struktured/ocaml-gemini/blob/8dc095edcdc02c3090f7fd9da8cc940ecded32d6/lib/market_data.ml
+*)
+
+open Common
+
+module Side = struct
+  module Bid_ask = struct
+    module T = struct
+      type t = [ `Bid | `Ask ] [@@deriving sexp, enumerate]
+
+      let to_string : [< t ] -> string = function
+        | `Bid -> "bid"
+        | `Ask -> "ask"
+    end
+
+    include T
+    include (Json.Make (T) : Json.S with type t := t)
+  end
+
+  module Auction = struct
+    module T = struct
+      type t = [ `Auction ] [@@deriving sexp, enumerate]
+
+      let to_string = function `Auction -> "auction"
+    end
+
+    include T
+    include (Json.Make (T) : Json.S with type t := t)
+  end
+
+  module T = struct
+    type t = [ Bid_ask.t | Auction.t ] [@@deriving sexp, enumerate]
+
+    let to_string : [< t ] -> string = function
+      | #Bid_ask.t as bid_ask -> Bid_ask.to_string bid_ask
+      | #Auction.t as auction -> Auction.to_string auction
+  end
+
+  include T
+  include (Json.Make (T) : Json.S with type t := t)
+end
+
+module T = struct
+  let name = "marketdata"
+  let version = "v1"
+  let path = v1 :: [ "marketdata" ]
+
+  type uri_args = Symbol.t [@@deriving sexp, yojson, enumerate]
+
+  let authentication = `Public
+  let default_uri_args = Some `Ethusd
+  let encode_uri_args = Symbol.to_string
+
+  type query = unit [@@deriving sexp]
+
+  let encode_query _ = failwith "queries not supported"
+
+  module Message_type = struct
+    module T = struct
+      type t = [ `Update | `Heartbeat ] [@@deriving sexp, enumerate]
+
+      let to_string = function `Update -> "update" | `Heartbeat -> "heartbeat"
+    end
+
+    include T
+    include (Json.Make (T) : Json.S with type t := t)
+  end
+
+  module Event_type = struct
+    module T = struct
+      type t = [ `Trade | `Change | `Auction | `Auction_open | `Block_trade ]
+      [@@deriving sexp, enumerate, compare]
+
+      let to_string = function
+        | `Trade -> "trade"
+        | `Change -> "change"
+        | `Auction -> "auction"
+        | `Auction_open -> "auction_open"
+        | `Block_trade -> "block_trade"
+    end
+
+    include T
+    include Comparable.Make (T)
+    include (Json.Make (T) : Json.S with type t := t)
+  end
+
+  type heartbeat = unit [@@deriving sexp, of_yojson]
+
+  (*
+  let _with_common_headers (type t) ~event_id ~timestamp
+      (module T : Csvfields.Csv.Csvable with type t = t) =
+    let module TT = struct
+      include T
+      let csv_header = ["event_id";"timestamp"]@csv_header
+      let row_of_t t =
+        [
+          (Int64.to_string event_id);
+          (Timestamp.to_string timestamp)
+        ] @ (row_of_t t)
+
+      let csv_header_spec =
+        [(Leaf "event_id" : Csvfields.Csv.Spec.t);Leaf "timestamp"] @ csv_header_spec
+
+    end in
+    (module TT : Csvfields.Csv.Csvable with type t = t)
+*)
+
+  module Reason = struct
+    module T = struct
+      type t = [ `Place | `Trade | `Cancel | `Initial ]
+      [@@deriving sexp, enumerate]
+
+      let to_string = function
+        | `Place -> "place"
+        | `Trade -> "trade"
+        | `Cancel -> "cancel"
+        | `Initial -> "initial"
+    end
+
+    include T
+    include (Json.Make (T) : Json.S with type t := t)
+  end
+
+  module Change_event = struct
+    module T = struct
+      type t = {
+        price : Decimal_string.t;
+        side : Side.Bid_ask.t;
+        reason : Reason.t;
+        remaining : Decimal_string.t;
+        delta : Decimal_string.t;
+      }
+      [@@deriving sexp, of_yojson, fields, csv]
+    end
+
+    module Decorated = struct
+      type t = {
+        event_id : Int_number.t;
+        timestamp : Timestamp.t;
+        price : Decimal_string.t;
+        side : Side.Bid_ask.t;
+        reason : Reason.t;
+        remaining : Decimal_string.t;
+        delta : Decimal_string.t;
+      }
+      [@@deriving sexp, of_yojson, fields, csv]
+
+      let create ~event_id ~timestamp
+          ({ reason; side; price; remaining; delta } : T.t) =
+        { event_id; timestamp; side; reason; remaining; price; delta }
+    end
+
+    let to_decorated = Decorated.create
+
+    include T
+  end
+
+  module Trade_event = struct
+    module T = struct
+      type t = {
+        tid : Int_number.t;
+        price : Decimal_string.t;
+        amount : Decimal_string.t;
+        maker_side : Side.t; [@key "makerSide"]
+      }
+      [@@deriving of_yojson, sexp, fields, csv]
+    end
+
+    module Decorated = struct
+      type t = {
+        timestamp : Timestamp.t;
+        tid : Int_number.t;
+        price : Decimal_string.t;
+        amount : Decimal_string.t;
+        maker_side : Side.t; [@key "makerSide"]
+      }
+      [@@deriving of_yojson, sexp, fields, csv]
+
+      let create ~event_id ~timestamp ({ tid; price; amount; maker_side } : T.t)
+          =
+        match Int64.equal event_id tid with
+        | true -> { timestamp; tid; price; amount; maker_side }
+        | false ->
+            failwith
+              "logical error: event_id and trade id (tid) should be equal"
+    end
+
+    let to_decorated = Decorated.create
+
+    include T
+  end
+
+  module Block_trade_event = struct
+    module T = struct
+      type t = { price : Decimal_string.t; amount : Decimal_string.t }
+      [@@deriving of_yojson, sexp, fields, csv]
+    end
+
+    module Decorated = struct
+      type t = {
+        event_id : Int_number.t;
+        timestamp : Timestamp.t;
+        price : Decimal_string.t;
+        amount : Decimal_string.t;
+      }
+      [@@deriving of_yojson, sexp, fields, csv]
+
+      let create ~event_id ~timestamp ({ price; amount } : T.t) =
+        { event_id; timestamp; price; amount }
+    end
+
+    let to_decorated = Decorated.create
+
+    include T
+  end
+
+  module Auction_open_event = struct
+    type t = {
+      auction_open_ms : Timestamp.Ms.t;
+      auction_time_ms : Timestamp.Ms.t;
+      first_indicative_ms : Timestamp.Ms.t;
+      last_cancel_time_ms : Timestamp.Ms.t;
+    }
+    [@@deriving sexp, of_yojson, fields, csv]
+  end
+
+  module Auction_result = struct
+    module T = struct
+      type t = [ `Success | `Failure ] [@@deriving sexp, enumerate]
+
+      let to_string = function `Success -> "success" | `Failure -> "failure"
+    end
+
+    include T
+    include (Json.Make (T) : Json.S with type t := t)
+  end
+
+  module Auction_indicative_price_event = struct
+    type t = {
+      eid : Int_number.t;
+      result : Auction_result.t;
+      time_ms : Timestamp.Ms.t;
+      highest_bid_price : Decimal_string.t;
+      lowest_ask_price : Decimal_string.t;
+      collar_price : Decimal_string.t;
+      indicative_price : Decimal_string.t;
+      indicative_quantity : Decimal_string.t;
+    }
+    [@@deriving sexp, of_yojson, fields, csv]
+  end
+
+  module Auction_outcome_event = struct
+    type t = {
+      eid : Int_number.t;
+      result : Auction_result.t;
+      time_ms : Timestamp.Ms.t;
+      highest_bid_price : Decimal_string.t;
+      lowest_ask_price : Decimal_string.t;
+      collar_price : Decimal_string.t;
+      auction_price : Decimal_string.t;
+      auction_quantity : Decimal_string.t;
+    }
+    [@@deriving sexp, of_yojson, fields, csv]
+  end
+
+  module Auction_event_type = struct
+    module T = struct
+      type t = [ `Auction_open | `Auction_indicative_price | `Auction_outcome ]
+      [@@deriving sexp, enumerate]
+
+      let to_string = function
+        | `Auction_open -> "auction_open"
+        | `Auction_indicative_price -> "auction_indicative_price"
+        | `Auction_outcome -> "auction_outcome"
+    end
+
+    include T
+    include (Json.Make (T) : Json.S with type t := t)
+  end
+
+  module Auction_event = struct
+    type t =
+      [ `Auction_open of Auction_open_event.t
+      | `Auction_indicative_price of Auction_indicative_price_event.t
+      | `Auction_outcome of Auction_outcome_event.t ]
+    [@@deriving sexp]
+
+    let of_yojson : Yojson.Safe.t -> (t, string) Result.t = function
+      | `Assoc assoc as json -> (
+          List.Assoc.find assoc ~equal:String.equal "type" |> function
+          | None ->
+              Result.failf "no auction event type in json payload: %s"
+                (Yojson.Safe.to_string json)
+          | Some event_type -> (
+              Auction_event_type.of_yojson event_type |> function
+              | Result.Error _ as e -> e
+              | Result.Ok event_type -> (
+                  let json' =
+                    `Assoc (List.Assoc.remove ~equal:String.equal assoc "type")
+                  in
+                  match event_type with
+                  | `Auction_open ->
+                      Auction_open_event.of_yojson json'
+                      |> Result.map ~f:(fun event -> `Auction_open event)
+                  | `Auction_indicative_price ->
+                      Auction_indicative_price_event.of_yojson json'
+                      |> Result.map ~f:(fun event ->
+                             `Auction_indicative_price event)
+                  | `Auction_outcome ->
+                      Auction_outcome_event.of_yojson json'
+                      |> Result.map ~f:(fun event -> `Auction_outcome event))))
+      | #Yojson.Safe.t as json ->
+          Result.failf "expected association type in json payload: %s"
+            (Yojson.Safe.to_string json)
+  end
+
+  type event =
+    [ `Change of Change_event.t
+    | `Trade of Trade_event.t
+    | `Auction of Auction_event.t
+    | `Auction_open of Auction_open_event.t
+    | `Block_trade of Block_trade_event.t ]
+  [@@deriving sexp]
+
+  let event_of_yojson : Yojson.Safe.t -> (event, string) Result.t = function
+    | `Assoc assoc as json -> (
+        List.Assoc.find assoc ~equal:String.equal "type" |> function
+        | None ->
+            Result.failf "no event type in json payload: %s"
+              (Yojson.Safe.to_string json)
+        | Some event_type -> (
+            Event_type.of_yojson event_type |> function
+            | Result.Error _ as e -> e
+            | Result.Ok event_type -> (
+                let json' =
+                  `Assoc (List.Assoc.remove ~equal:String.equal assoc "type")
+                in
+                match event_type with
+                | `Change ->
+                    Change_event.of_yojson json'
+                    |> Result.map ~f:(fun event -> `Change event)
+                | `Trade ->
+                    Trade_event.of_yojson json'
+                    |> Result.map ~f:(fun event -> `Trade event)
+                | `Auction ->
+                    Auction_event.of_yojson json'
+                    |> Result.map ~f:(fun event -> `Auction event)
+                | `Auction_open ->
+                    Auction_open_event.of_yojson json'
+                    |> Result.map ~f:(fun event -> `Auction_open event)
+                | `Block_trade ->
+                    Block_trade_event.of_yojson json'
+                    |> Result.map ~f:(fun event -> `Block_trade event))))
+    | #Yojson.Safe.t as json ->
+        Result.failf "expected association type in json payload: %s"
+          (Yojson.Safe.to_string json)
+
+  module Update = struct
+    type t = {
+      event_id : Int_number.t; [@key "eventId"]
+      events : event array; [@default [||]]
+      timestamp : Timestamp.Sec.t option; [@default None]
+      timestampms : Timestamp.Ms.t option; [@default None]
+    }
+    [@@deriving sexp, of_yojson]
+  end
+
+  type message = [ `Heartbeat of heartbeat | `Update of Update.t ]
+  [@@deriving sexp]
+
+  type response = { socket_sequence : Int_number.t; message : message }
+  [@@deriving sexp]
+
+  let response_of_yojson : Yojson.Safe.t -> (response, string) Result.t =
+    function
+    | `Assoc assoc as json -> (
+        ( List.Assoc.find ~equal:String.equal assoc "socket_sequence",
+          List.Assoc.find ~equal:String.equal assoc "type" )
+        |> function
+        | None, _ ->
+            Result.failf "no sequence number in json payload: %s"
+              (Yojson.Safe.to_string json)
+        | _, None ->
+            Result.failf "no message type in json payload: %s"
+              (Yojson.Safe.to_string json)
+        | Some socket_sequence, Some message_type -> (
+            Result.both
+              (Int_number.of_yojson socket_sequence)
+              (Message_type.of_yojson message_type)
+            |> function
+            | Result.Error _ as e -> e
+            | Result.Ok (socket_sequence, message_type) ->
+                let json' =
+                  `Assoc
+                    ( List.Assoc.remove ~equal:String.equal assoc "type"
+                    |> fun assoc ->
+                      List.Assoc.remove ~equal:String.equal assoc
+                        "socket_sequence" )
+                in
+                (match message_type with
+                | `Heartbeat ->
+                    heartbeat_of_yojson json'
+                    |> Result.map ~f:(fun event -> `Heartbeat event)
+                | `Update ->
+                    Update.of_yojson json'
+                    |> Result.map ~f:(fun event -> `Update event))
+                |> Result.map ~f:(fun message -> { socket_sequence; message })))
+    | #Yojson.Safe.t as json ->
+        Result.failf
+          "response_of_yojson:expected association type in json payload: %s"
+          (Yojson.Safe.to_string json)
+
+  module Csv_of_event = Ws.Csv_of_event (Event_type)
+
+  let events_of_response (response : response) =
+    let csv_of_events = Csv_of_event.empty in
+    match response.message with
+    | `Heartbeat _ -> csv_of_events
+    | `Update (update : Update.t) ->
+        let event_id = update.event_id in
+        let timestamp =
+          Option.(
+            first_some update.timestamp update.timestamp
+            |> value ~default:(Time.now ()))
+        in
+        Array.fold ~init:csv_of_events update.events
+          ~f:(fun csv_of_events (event : event) ->
+            match event with
+            | `Change change ->
+                Csv_of_event.add' csv_of_events `Change
+                  (module Change_event.Decorated)
+                  [ Change_event.to_decorated ~event_id ~timestamp change ]
+            | `Trade trade ->
+                Csv_of_event.add' csv_of_events `Trade
+                  (module Trade_event.Decorated)
+                  [ Trade_event.to_decorated ~event_id ~timestamp trade ]
+            | `Auction _auction -> csv_of_events
+            | `Auction_open _auction -> csv_of_events
+            | `Block_trade block_trade ->
+                Csv_of_event.add' csv_of_events `Block_trade
+                  (module Block_trade_event.Decorated)
+                  [
+                    Block_trade_event.to_decorated ~event_id ~timestamp
+                      block_trade;
+                  ])
+end
+
+include T
+include Ws.Make_no_request (T)

unikernel/duniverse/ppxlib/bench/drivers/ppx_sexp_conv/driver.ml

@@ -0,0 +1 @@
+Ppxlib.Driver.standalone ()

unikernel/duniverse/ppxlib/bench/drivers/ppx_sexp_conv/dune

@@ -0,0 +1,7 @@
+; A driver with the ppx_sexp_conv plugin
+
+(executable
+ (name driver)
+ (enabled_if
+  (>= %{ocaml_version} "4.10.0"))
+ (libraries ppxlib ppx_sexp_conv))

unikernel/duniverse/ppxlib/bench/drivers/ppx_sexp_conv/inputs/market_data.ml

@@ -0,0 +1,451 @@
+(* Taken from ocaml-gemini (https://github.com/struktured/ocaml-gemini) which is
+   under the MIT license:
+   https://github.com/struktured/ocaml-gemini/blob/8dc095edcdc02c3090f7fd9da8cc940ecded32d6/lib/market_data.ml
+*)
+
+open Common
+
+module Side = struct
+  module Bid_ask = struct
+    module T = struct
+      type t = [ `Bid | `Ask ] [@@deriving sexp, enumerate]
+
+      let to_string : [< t ] -> string = function
+        | `Bid -> "bid"
+        | `Ask -> "ask"
+    end
+
+    include T
+    include (Json.Make (T) : Json.S with type t := t)
+  end
+
+  module Auction = struct
+    module T = struct
+      type t = [ `Auction ] [@@deriving sexp, enumerate]
+
+      let to_string = function `Auction -> "auction"
+    end
+
+    include T
+    include (Json.Make (T) : Json.S with type t := t)
+  end
+
+  module T = struct
+    type t = [ Bid_ask.t | Auction.t ] [@@deriving sexp, enumerate]
+
+    let to_string : [< t ] -> string = function
+      | #Bid_ask.t as bid_ask -> Bid_ask.to_string bid_ask
+      | #Auction.t as auction -> Auction.to_string auction
+  end
+
+  include T
+  include (Json.Make (T) : Json.S with type t := t)
+end
+
+module T = struct
+  let name = "marketdata"
+  let version = "v1"
+  let path = v1 :: [ "marketdata" ]
+
+  type uri_args = Symbol.t [@@deriving sexp, yojson, enumerate]
+
+  let authentication = `Public
+  let default_uri_args = Some `Ethusd
+  let encode_uri_args = Symbol.to_string
+
+  type query = unit [@@deriving sexp]
+
+  let encode_query _ = failwith "queries not supported"
+
+  module Message_type = struct
+    module T = struct
+      type t = [ `Update | `Heartbeat ] [@@deriving sexp, enumerate]
+
+      let to_string = function `Update -> "update" | `Heartbeat -> "heartbeat"
+    end
+
+    include T
+    include (Json.Make (T) : Json.S with type t := t)
+  end
+
+  module Event_type = struct
+    module T = struct
+      type t = [ `Trade | `Change | `Auction | `Auction_open | `Block_trade ]
+      [@@deriving sexp, enumerate, compare]
+
+      let to_string = function
+        | `Trade -> "trade"
+        | `Change -> "change"
+        | `Auction -> "auction"
+        | `Auction_open -> "auction_open"
+        | `Block_trade -> "block_trade"
+    end
+
+    include T
+    include Comparable.Make (T)
+    include (Json.Make (T) : Json.S with type t := t)
+  end
+
+  type heartbeat = unit [@@deriving sexp, of_yojson]
+
+  (*
+  let _with_common_headers (type t) ~event_id ~timestamp
+      (module T : Csvfields.Csv.Csvable with type t = t) =
+    let module TT = struct
+      include T
+      let csv_header = ["event_id";"timestamp"]@csv_header
+      let row_of_t t =
+        [
+          (Int64.to_string event_id);
+          (Timestamp.to_string timestamp)
+        ] @ (row_of_t t)
+
+      let csv_header_spec =
+        [(Leaf "event_id" : Csvfields.Csv.Spec.t);Leaf "timestamp"] @ csv_header_spec
+
+    end in
+    (module TT : Csvfields.Csv.Csvable with type t = t)
+*)
+
+  module Reason = struct
+    module T = struct
+      type t = [ `Place | `Trade | `Cancel | `Initial ]
+      [@@deriving sexp, enumerate]
+
+      let to_string = function
+        | `Place -> "place"
+        | `Trade -> "trade"
+        | `Cancel -> "cancel"
+        | `Initial -> "initial"
+    end
+
+    include T
+    include (Json.Make (T) : Json.S with type t := t)
+  end
+
+  module Change_event = struct
+    module T = struct
+      type t = {
+        price : Decimal_string.t;
+        side : Side.Bid_ask.t;
+        reason : Reason.t;
+        remaining : Decimal_string.t;
+        delta : Decimal_string.t;
+      }
+      [@@deriving sexp, of_yojson, fields, csv]
+    end
+
+    module Decorated = struct
+      type t = {
+        event_id : Int_number.t;
+        timestamp : Timestamp.t;
+        price : Decimal_string.t;
+        side : Side.Bid_ask.t;
+        reason : Reason.t;
+        remaining : Decimal_string.t;
+        delta : Decimal_string.t;
+      }
+      [@@deriving sexp, of_yojson, fields, csv]
+
+      let create ~event_id ~timestamp
+          ({ reason; side; price; remaining; delta } : T.t) =
+        { event_id; timestamp; side; reason; remaining; price; delta }
+    end
+
+    let to_decorated = Decorated.create
+
+    include T
+  end
+
+  module Trade_event = struct
+    module T = struct
+      type t = {
+        tid : Int_number.t;
+        price : Decimal_string.t;
+        amount : Decimal_string.t;
+        maker_side : Side.t; [@key "makerSide"]
+      }
+      [@@deriving of_yojson, sexp, fields, csv]
+    end
+
+    module Decorated = struct
+      type t = {
+        timestamp : Timestamp.t;
+        tid : Int_number.t;
+        price : Decimal_string.t;
+        amount : Decimal_string.t;
+        maker_side : Side.t; [@key "makerSide"]
+      }
+      [@@deriving of_yojson, sexp, fields, csv]
+
+      let create ~event_id ~timestamp ({ tid; price; amount; maker_side } : T.t)
+          =
+        match Int64.equal event_id tid with
+        | true -> { timestamp; tid; price; amount; maker_side }
+        | false ->
+            failwith
+              "logical error: event_id and trade id (tid) should be equal"
+    end
+
+    let to_decorated = Decorated.create
+
+    include T
+  end
+
+  module Block_trade_event = struct
+    module T = struct
+      type t = { price : Decimal_string.t; amount : Decimal_string.t }
+      [@@deriving of_yojson, sexp, fields, csv]
+    end
+
+    module Decorated = struct
+      type t = {
+        event_id : Int_number.t;
+        timestamp : Timestamp.t;
+        price : Decimal_string.t;
+        amount : Decimal_string.t;
+      }
+      [@@deriving of_yojson, sexp, fields, csv]
+
+      let create ~event_id ~timestamp ({ price; amount } : T.t) =
+        { event_id; timestamp; price; amount }
+    end
+
+    let to_decorated = Decorated.create
+
+    include T
+  end
+
+  module Auction_open_event = struct
+    type t = {
+      auction_open_ms : Timestamp.Ms.t;
+      auction_time_ms : Timestamp.Ms.t;
+      first_indicative_ms : Timestamp.Ms.t;
+      last_cancel_time_ms : Timestamp.Ms.t;
+    }
+    [@@deriving sexp, of_yojson, fields, csv]
+  end
+
+  module Auction_result = struct
+    module T = struct
+      type t = [ `Success | `Failure ] [@@deriving sexp, enumerate]
+
+      let to_string = function `Success -> "success" | `Failure -> "failure"
+    end
+
+    include T
+    include (Json.Make (T) : Json.S with type t := t)
+  end
+
+  module Auction_indicative_price_event = struct
+    type t = {
+      eid : Int_number.t;
+      result : Auction_result.t;
+      time_ms : Timestamp.Ms.t;
+      highest_bid_price : Decimal_string.t;
+      lowest_ask_price : Decimal_string.t;
+      collar_price : Decimal_string.t;
+      indicative_price : Decimal_string.t;
+      indicative_quantity : Decimal_string.t;
+    }
+    [@@deriving sexp, of_yojson, fields, csv]
+  end
+
+  module Auction_outcome_event = struct
+    type t = {
+      eid : Int_number.t;
+      result : Auction_result.t;
+      time_ms : Timestamp.Ms.t;
+      highest_bid_price : Decimal_string.t;
+      lowest_ask_price : Decimal_string.t;
+      collar_price : Decimal_string.t;
+      auction_price : Decimal_string.t;
+      auction_quantity : Decimal_string.t;
+    }
+    [@@deriving sexp, of_yojson, fields, csv]
+  end
+
+  module Auction_event_type = struct
+    module T = struct
+      type t = [ `Auction_open | `Auction_indicative_price | `Auction_outcome ]
+      [@@deriving sexp, enumerate]
+
+      let to_string = function
+        | `Auction_open -> "auction_open"
+        | `Auction_indicative_price -> "auction_indicative_price"
+        | `Auction_outcome -> "auction_outcome"
+    end
+
+    include T
+    include (Json.Make (T) : Json.S with type t := t)
+  end
+
+  module Auction_event = struct
+    type t =
+      [ `Auction_open of Auction_open_event.t
+      | `Auction_indicative_price of Auction_indicative_price_event.t
+      | `Auction_outcome of Auction_outcome_event.t ]
+    [@@deriving sexp]
+
+    let of_yojson : Yojson.Safe.t -> (t, string) Result.t = function
+      | `Assoc assoc as json -> (
+          List.Assoc.find assoc ~equal:String.equal "type" |> function
+          | None ->
+              Result.failf "no auction event type in json payload: %s"
+                (Yojson.Safe.to_string json)
+          | Some event_type -> (
+              Auction_event_type.of_yojson event_type |> function
+              | Result.Error _ as e -> e
+              | Result.Ok event_type -> (
+                  let json' =
+                    `Assoc (List.Assoc.remove ~equal:String.equal assoc "type")
+                  in
+                  match event_type with
+                  | `Auction_open ->
+                      Auction_open_event.of_yojson json'
+                      |> Result.map ~f:(fun event -> `Auction_open event)
+                  | `Auction_indicative_price ->
+                      Auction_indicative_price_event.of_yojson json'
+                      |> Result.map ~f:(fun event ->
+                             `Auction_indicative_price event)
+                  | `Auction_outcome ->
+                      Auction_outcome_event.of_yojson json'
+                      |> Result.map ~f:(fun event -> `Auction_outcome event))))
+      | #Yojson.Safe.t as json ->
+          Result.failf "expected association type in json payload: %s"
+            (Yojson.Safe.to_string json)
+  end
+
+  type event =
+    [ `Change of Change_event.t
+    | `Trade of Trade_event.t
+    | `Auction of Auction_event.t
+    | `Auction_open of Auction_open_event.t
+    | `Block_trade of Block_trade_event.t ]
+  [@@deriving sexp]
+
+  let event_of_yojson : Yojson.Safe.t -> (event, string) Result.t = function
+    | `Assoc assoc as json -> (
+        List.Assoc.find assoc ~equal:String.equal "type" |> function
+        | None ->
+            Result.failf "no event type in json payload: %s"
+              (Yojson.Safe.to_string json)
+        | Some event_type -> (
+            Event_type.of_yojson event_type |> function
+            | Result.Error _ as e -> e
+            | Result.Ok event_type -> (
+                let json' =
+                  `Assoc (List.Assoc.remove ~equal:String.equal assoc "type")
+                in
+                match event_type with
+                | `Change ->
+                    Change_event.of_yojson json'
+                    |> Result.map ~f:(fun event -> `Change event)
+                | `Trade ->
+                    Trade_event.of_yojson json'
+                    |> Result.map ~f:(fun event -> `Trade event)
+                | `Auction ->
+                    Auction_event.of_yojson json'
+                    |> Result.map ~f:(fun event -> `Auction event)
+                | `Auction_open ->
+                    Auction_open_event.of_yojson json'
+                    |> Result.map ~f:(fun event -> `Auction_open event)
+                | `Block_trade ->
+                    Block_trade_event.of_yojson json'
+                    |> Result.map ~f:(fun event -> `Block_trade event))))
+    | #Yojson.Safe.t as json ->
+        Result.failf "expected association type in json payload: %s"
+          (Yojson.Safe.to_string json)
+
+  module Update = struct
+    type t = {
+      event_id : Int_number.t; [@key "eventId"]
+      events : event array; [@default [||]]
+      timestamp : Timestamp.Sec.t option; [@default None]
+      timestampms : Timestamp.Ms.t option; [@default None]
+    }
+    [@@deriving sexp, of_yojson]
+  end
+
+  type message = [ `Heartbeat of heartbeat | `Update of Update.t ]
+  [@@deriving sexp]
+
+  type response = { socket_sequence : Int_number.t; message : message }
+  [@@deriving sexp]
+
+  let response_of_yojson : Yojson.Safe.t -> (response, string) Result.t =
+    function
+    | `Assoc assoc as json -> (
+        ( List.Assoc.find ~equal:String.equal assoc "socket_sequence",
+          List.Assoc.find ~equal:String.equal assoc "type" )
+        |> function
+        | None, _ ->
+            Result.failf "no sequence number in json payload: %s"
+              (Yojson.Safe.to_string json)
+        | _, None ->
+            Result.failf "no message type in json payload: %s"
+              (Yojson.Safe.to_string json)
+        | Some socket_sequence, Some message_type -> (
+            Result.both
+              (Int_number.of_yojson socket_sequence)
+              (Message_type.of_yojson message_type)
+            |> function
+            | Result.Error _ as e -> e
+            | Result.Ok (socket_sequence, message_type) ->
+                let json' =
+                  `Assoc
+                    ( List.Assoc.remove ~equal:String.equal assoc "type"
+                    |> fun assoc ->
+                      List.Assoc.remove ~equal:String.equal assoc
+                        "socket_sequence" )
+                in
+                (match message_type with
+                | `Heartbeat ->
+                    heartbeat_of_yojson json'
+                    |> Result.map ~f:(fun event -> `Heartbeat event)
+                | `Update ->
+                    Update.of_yojson json'
+                    |> Result.map ~f:(fun event -> `Update event))
+                |> Result.map ~f:(fun message -> { socket_sequence; message })))
+    | #Yojson.Safe.t as json ->
+        Result.failf
+          "response_of_yojson:expected association type in json payload: %s"
+          (Yojson.Safe.to_string json)
+
+  module Csv_of_event = Ws.Csv_of_event (Event_type)
+
+  let events_of_response (response : response) =
+    let csv_of_events = Csv_of_event.empty in
+    match response.message with
+    | `Heartbeat _ -> csv_of_events
+    | `Update (update : Update.t) ->
+        let event_id = update.event_id in
+        let timestamp =
+          Option.(
+            first_some update.timestamp update.timestamp
+            |> value ~default:(Time.now ()))
+        in
+        Array.fold ~init:csv_of_events update.events
+          ~f:(fun csv_of_events (event : event) ->
+            match event with
+            | `Change change ->
+                Csv_of_event.add' csv_of_events `Change
+                  (module Change_event.Decorated)
+                  [ Change_event.to_decorated ~event_id ~timestamp change ]
+            | `Trade trade ->
+                Csv_of_event.add' csv_of_events `Trade
+                  (module Trade_event.Decorated)
+                  [ Trade_event.to_decorated ~event_id ~timestamp trade ]
+            | `Auction _auction -> csv_of_events
+            | `Auction_open _auction -> csv_of_events
+            | `Block_trade block_trade ->
+                Csv_of_event.add' csv_of_events `Block_trade
+                  (module Block_trade_event.Decorated)
+                  [
+                    Block_trade_event.to_decorated ~event_id ~timestamp
+                      block_trade;
+                  ])
+end
+
+include T
+include Ws.Make_no_request (T)

unikernel/duniverse/ppxlib/bench/dune

@@ -0,0 +1,11 @@
+(executable
+ (name bench)
+ (enabled_if
+  (>= %{ocaml_version} "4.10.0"))
+ (libraries unix yojson))
+
+(alias
+ (name default)
+ (package ppxlib-bench)
+ (deps
+  (source_tree drivers)))

unikernel/duniverse/ppxlib/bench/vendored/ppx_sexp_conv.v0.15.1/.gitignore

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

unikernel/duniverse/ppxlib/bench/vendored/ppx_sexp_conv.v0.15.1/.ocamlformat-ignore

@@ -0,0 +1 @@
+**

unikernel/duniverse/ppxlib/bench/vendored/ppx_sexp_conv.v0.15.1/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/ppxlib/bench/vendored/ppx_sexp_conv.v0.15.1/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/ppxlib/bench/vendored/ppx_sexp_conv.v0.15.1/LICENSE.md

@@ -0,0 +1,21 @@
+The MIT License
+
+Copyright (c) 2015--2022 Jane Street Group, LLC <opensource@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/ppxlib/bench/vendored/ppx_sexp_conv.v0.15.1/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/ppxlib/bench/vendored/ppx_sexp_conv.v0.15.1/README.org

@@ -0,0 +1,557 @@
+#+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.
+
+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
+
+* 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, /e.g./:
+
+#+begin_src ocaml
+  type foo = int * (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/ppxlib/bench/vendored/ppx_sexp_conv.v0.15.1/expander/attrs.ml

@@ -0,0 +1,203 @@
+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 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 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/ppxlib/bench/vendored/ppx_sexp_conv.v0.15.1/expander/attrs.mli

@@ -0,0 +1,34 @@
+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 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

unikernel/duniverse/ppxlib/bench/vendored/ppx_sexp_conv.v0.15.1/expander/conversion.ml

@@ -0,0 +1,170 @@
+open! Base
+open! Ppxlib
+open Ast_builder.Default
+open Helpers
+
+module Reference = struct
+  type t =
+    { binds : value_binding list list
+    ; ident : longident_loc
+    ; args : (arg_label * expression) list
+    }
+
+  let bind t binds = { t with binds = binds :: t.binds }
+
+  let maybe_apply { 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_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 =
+    match t with
+    | { binds = []; ident; args = [] } -> pexp_ident ~loc ident
+    | _ -> fresh_lambda ~loc (fun ~arg -> apply t ~loc arg)
+  ;;
+end
+
+module Lambda = struct
+  type t =
+    { binds : value_binding list list
+    ; cases : cases
+    }
+
+  let bind t binds = { t with binds = binds :: t.binds }
+
+  (* generic case: use [function] or [match] *)
+  let maybe_apply_generic ~loc ~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_let ~loc ~binds expr
+  ;;
+
+  (* zero cases: synthesize an "impossible" case, i.e. [| _ -> .] *)
+  let maybe_apply_impossible ~loc ~binds maybe_arg =
+    maybe_apply_generic
+      ~loc
+      ~binds
+      maybe_arg
+      [ case ~lhs:(ppat_any ~loc) ~guard:None ~rhs:(pexp_unreachable ~loc) ]
+  ;;
+
+  (* one case without guard: use [fun] or [let] *)
+  let maybe_apply_simple ~loc ~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_let ~loc ~binds expr
+  ;;
+
+  (* shared special-casing logic for [apply] and [to_expression] *)
+  let maybe_apply t ~loc maybe_arg =
+    match t with
+    | { binds; cases = [] } -> maybe_apply_impossible ~loc ~binds maybe_arg
+    | { binds; cases = [ { pc_lhs; pc_guard = None; pc_rhs } ] } ->
+      maybe_apply_simple ~loc ~binds maybe_arg pc_lhs pc_rhs
+    | { binds; cases } -> maybe_apply_generic ~loc ~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
+    | { 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 { binds = []; cases }
+
+let of_reference_exn expr =
+  match expr.pexp_desc with
+  | Pexp_ident ident -> Reference { binds = []; ident; args = [] }
+  | Pexp_apply ({ pexp_desc = Pexp_ident ident; _ }, args) ->
+    Reference { 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 =
+  match t with
+  | Reference reference -> Reference.to_value_expression ~loc 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)
+;;
+
+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/ppxlib/bench/vendored/ppx_sexp_conv.v0.15.1/expander/conversion.mli

@@ -0,0 +1,45 @@
+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]
+    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 -> 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
+
+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/ppxlib/bench/vendored/ppx_sexp_conv.v0.15.1/expander/dune

@@ -0,0 +1,8 @@
+(library
+ (name ppx_sexp_conv_expander)
+ (enabled_if
+  (>= %{ocaml_version} "4.10.0"))
+ (libraries base ppxlib ppxlib.astlib ppxlib.metaquot_lifters)
+ (ppx_runtime_libraries ppx_sexp_conv.runtime-lib sexplib0)
+ (preprocess
+  (pps ppxlib.metaquot ppxlib.traverse)))

unikernel/duniverse/ppxlib/bench/vendored/ppx_sexp_conv.v0.15.1/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/ppxlib/bench/vendored/ppx_sexp_conv.v0.15.1/expander/expand_sexp_of.ml

@@ -0,0 +1,767 @@
+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
+    ;;
+  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 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_open _; _ }
+    | { ptyp_desc = Ptyp_extension _; _ } ->
+      Location.raise_errorf ~loc "Type unsupported for ppx [sexp_of] conversion"
+
+  (* Conversion of 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 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: sexp_of_variant/Rtag/&"
+      | 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: sexp_of_variant/Rinherit/non-id"
+      (* impossible? *)
+      | Rtag (_, false, []) -> assert false
+    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])]
+            | 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])]]
+        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]
+            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])
+              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]]
+        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]]
+        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] = [] 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 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.concat_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
+    |> Merlin_helpers.hide_expression
+  ;;
+end

unikernel/duniverse/ppxlib/bench/vendored/ppx_sexp_conv.v0.15.1/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/ppxlib/bench/vendored/ppx_sexp_conv.v0.15.1/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/ppxlib/bench/vendored/ppx_sexp_conv.v0.15.1/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/ppxlib/bench/vendored/ppx_sexp_conv.v0.15.1/expander/helpers.ml

@@ -0,0 +1,195 @@
+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:(pexp_let ~loc Nonrecursive)
+;;
+
+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
+    ()
+;;

unikernel/duniverse/ppxlib/bench/vendored/ppx_sexp_conv.v0.15.1/expander/helpers.mli

@@ -0,0 +1,36 @@
+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
+
+(** 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

unikernel/duniverse/ppxlib/bench/vendored/ppx_sexp_conv.v0.15.1/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/ppxlib/bench/vendored/ppx_sexp_conv.v0.15.1/expander/lifted.mli

@@ -0,0 +1,22 @@
+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/ppxlib/bench/vendored/ppx_sexp_conv.v0.15.1/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/ppxlib/bench/vendored/ppx_sexp_conv.v0.15.1/expander/ppx_sexp_conv_expander.mli

@@ -0,0 +1,73 @@
+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/ppxlib/bench/vendored/ppx_sexp_conv.v0.15.1/expander/ppx_sexp_conv_grammar.ml

@@ -0,0 +1,609 @@
+open! Base
+open! Ppxlib
+open Ast_builder.Default
+
+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]] )
+;;
+
+let with_tags grammar ~f ~loc ~tags ~comments =
+  let tags = List.concat [ List.map comments ~f:(tag_of_doc_comment ~loc); tags ] in
+  List.fold_right tags ~init:grammar ~f:(fun (key, value) grammar ->
+    f ~loc (ewith_tag ~loc ~key ~value grammar))
+;;
+
+let with_tags_as_list grammar ~loc ~tags ~comments =
+  with_tags (eno_tag ~loc grammar) ~f:etag ~loc ~tags ~comments
+;;
+
+let with_tags_as_grammar grammar ~loc ~tags ~comments =
+  with_tags grammar ~f:etagged ~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 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 wildcard_grammar ~loc = [%expr Any "_"]
+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 tycon_grammar ~loc name args = [%expr Tycon ([%e name], [%e args])]
+let recursive_grammar ~loc grammar defns = [%expr Recursive ([%e grammar], [%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 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 : (expression * expression) list
+    ; 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
+  ;;
+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 = Attribute.get Attrs.tag_type core_type |> Option.value ~default:[] 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 = Attribute.get Attrs.tag_ld field |> Option.value ~default:[] 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
+;;
+
+let rec grammar_of_type core_type ~rec_flag ~tags_of_doc_comments =
+  let loc = core_type.ptyp_loc in
+  let grammar =
+    match Attribute.get Attrs.opaque core_type with
+    | Some () -> opaque_grammar ~loc
+    | None ->
+      (match core_type.ptyp_desc with
+       | Ptyp_any -> wildcard_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_open _ -> unsupported ~loc "locally opened modules"
+       | Ptyp_extension _ -> unsupported ~loc "unexpanded ppx extensions")
+  in
+  grammar_of_type_tags core_type grammar ~tags_of_doc_comments
+
+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 = Attribute.get Attrs.tag_poly row |> Option.value ~default:[] 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 = Attribute.get Attrs.tag_cd clause |> Option.value ~default:[] 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))
+    (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 =
+      tycon_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
+    recursive_grammar
+      ~loc
+      (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/ppxlib/bench/vendored/ppx_sexp_conv.v0.15.1/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/ppxlib/bench/vendored/ppx_sexp_conv.v0.15.1/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/ppxlib/bench/vendored/ppx_sexp_conv.v0.15.1/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/ppxlib/bench/vendored/ppx_sexp_conv.v0.15.1/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/ppxlib/bench/vendored/ppx_sexp_conv.v0.15.1/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/ppxlib/bench/vendored/ppx_sexp_conv.v0.15.1/runtime-lib/dune

@@ -0,0 +1,4 @@
+(library
+ (name ppx_sexp_conv_lib)
+ (libraries sexplib0)
+ (preprocess no_preprocessing))

unikernel/duniverse/ppxlib/bench/vendored/ppx_sexp_conv.v0.15.1/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/ppxlib/bench/vendored/ppx_sexp_conv.v0.15.1/src/dune

@@ -0,0 +1,7 @@
+(library
+ (name ppx_sexp_conv)
+ (kind ppx_deriver)
+ (enabled_if
+  (>= %{ocaml_version} "4.10.0"))
+ (libraries ppxlib ppx_sexp_conv_expander)
+ (preprocess no_preprocessing))

unikernel/duniverse/ppxlib/bench/vendored/ppx_sexp_conv.v0.15.1/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/ppxlib/bench/vendored/ppx_sexp_conv.v0.15.1/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