Script 'mail_helper' called by obssrc
Hello community,
here is the log from the commit of package ocaml-sexplib0 for openSUSE:Factory
checked in at 2023-05-12 20:38:37
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Comparing /work/SRC/openSUSE:Factory/ocaml-sexplib0 (Old)
and /work/SRC/openSUSE:Factory/.ocaml-sexplib0.new.1533 (New)
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Package is "ocaml-sexplib0"
Fri May 12 20:38:37 2023 rev:7 rq:1086722 version:0.16.0
Changes:
--------
--- /work/SRC/openSUSE:Factory/ocaml-sexplib0/ocaml-sexplib0.changes
2023-01-05 15:01:19.581170026 +0100
+++ /work/SRC/openSUSE:Factory/.ocaml-sexplib0.new.1533/ocaml-sexplib0.changes
2023-05-12 20:41:14.355170487 +0200
@@ -1,0 +2,6 @@
+Fri May 5 05:05:05 UTC 2023 - oher...@suse.de
+
+- Update to version 0.16.0
+ No changelog provided
+
+-------------------------------------------------------------------
Old:
----
ocaml-sexplib0-0.15.1.tar.xz
New:
----
ocaml-sexplib0-0.16.0.tar.xz
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Other differences:
------------------
++++++ ocaml-sexplib0.spec ++++++
--- /var/tmp/diff_new_pack.NFAIwI/_old 2023-05-12 20:41:14.827173081 +0200
+++ /var/tmp/diff_new_pack.NFAIwI/_new 2023-05-12 20:41:14.835173125 +0200
@@ -17,18 +17,19 @@
Name: ocaml-sexplib0
-Version: 0.15.1
+Version: 0.16.0
Release: 0
%{?ocaml_preserve_bytecode}
Summary: Library containing the definition of S-expressions and some
base converters
License: MIT
+ExclusiveArch: aarch64 ppc64 ppc64le riscv64 s390x x86_64
Group: Development/Languages/OCaml
BuildRoot: %_tmppath/%name-%version-build
URL: https://opam.ocaml.org/packages/sexplib0
Source0: %name-%version.tar.xz
BuildRequires: ocaml-dune
BuildRequires: ocaml-rpm-macros >= 20230101
-BuildRequires: ocaml(ocaml_base_version) >= 4.04
+BuildRequires: ocaml(ocaml_base_version) >= 4.08
%description
Library containing the definition of S-expressions and some base converters.
++++++ _service ++++++
--- /var/tmp/diff_new_pack.NFAIwI/_old 2023-05-12 20:41:14.895173455 +0200
+++ /var/tmp/diff_new_pack.NFAIwI/_new 2023-05-12 20:41:14.899173477 +0200
@@ -1,7 +1,7 @@
<services>
<service name="tar_scm" mode="disabled">
<param name="filename">ocaml-sexplib0</param>
- <param name="revision">4c3387b5890ed7f27d761d4926022efef5710463</param>
+ <param name="revision">df916dfe8d0538a0dbfcdcb35c6e933ac9fc8130</param>
<param name="scm">git</param>
<param name="submodules">disable</param>
<param name="url">https://github.com/janestreet/sexplib0.git</param>
++++++ ocaml-sexplib0-0.15.1.tar.xz -> ocaml-sexplib0-0.16.0.tar.xz ++++++
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/ocaml-sexplib0-0.15.1/CHANGES.md
new/ocaml-sexplib0-0.16.0/CHANGES.md
--- old/ocaml-sexplib0-0.15.1/CHANGES.md 1970-01-01 01:00:00.000000000
+0100
+++ new/ocaml-sexplib0-0.16.0/CHANGES.md 2023-04-25 15:12:25.000000000
+0200
@@ -0,0 +1,7 @@
+## Release v0.16.0
+
+* Added `Sexp_conv_record`. Supports improvements to `ppx_sexp_conv` for
deriving
+ `of_sexp` on record types. Provides a GADT-based generic interface to
parsing record
+ sexps. This avoids having to generate the same field-parsing code over and
over.
+
+* Added `sexp_grammar_with_tags` and `sexp_grammar_with_tag_list` to
`Sexp_conv_grammar`.
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/ocaml-sexplib0-0.15.1/LICENSE.md
new/ocaml-sexplib0-0.16.0/LICENSE.md
--- old/ocaml-sexplib0-0.15.1/LICENSE.md 2022-06-15 18:57:16.000000000
+0200
+++ new/ocaml-sexplib0-0.16.0/LICENSE.md 2023-04-25 15:12:25.000000000
+0200
@@ -1,6 +1,6 @@
The MIT License
-Copyright (c) 2005--2022 Jane Street Group, LLC <opensou...@janestreet.com>
+Copyright (c) 2005--2023 Jane Street Group, LLC
<opensource-conta...@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
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/ocaml-sexplib0-0.15.1/bench/bench_record.ml
new/ocaml-sexplib0-0.16.0/bench/bench_record.ml
--- old/ocaml-sexplib0-0.15.1/bench/bench_record.ml 1970-01-01
01:00:00.000000000 +0100
+++ new/ocaml-sexplib0-0.16.0/bench/bench_record.ml 2023-04-25
15:12:25.000000000 +0200
@@ -0,0 +1,105 @@
+open Sexplib0.Sexp_conv
+
+let bench_t_of_sexp ~t_of_sexp string =
+ let sexp = Sys.opaque_identity (Parsexp.Single.parse_string_exn string) in
+ fun () -> t_of_sexp sexp
+;;
+
+type t =
+ { a : int
+ ; b : int option
+ ; c : bool
+ ; d : int array
+ ; e : int list
+ ; f : int option
+ ; g : int
+ ; h : 'a. 'a list
+ }
+
+let t_of_sexp =
+ let open struct
+ type poly = { h : 'a. 'a list } [@@unboxed]
+ end in
+ Sexplib0.Sexp_conv_record.record_of_sexp
+ ~caller:"Record.t"
+ ~fields:
+ (Field
+ { name = "a"
+ ; kind = Required
+ ; conv = int_of_sexp
+ ; rest =
+ Field
+ { name = "b"
+ ; kind = Omit_nil
+ ; conv = option_of_sexp int_of_sexp
+ ; rest =
+ Field
+ { name = "c"
+ ; kind = Sexp_bool
+ ; conv = ()
+ ; rest =
+ Field
+ { name = "d"
+ ; kind = Sexp_array
+ ; conv = int_of_sexp
+ ; rest =
+ Field
+ { name = "e"
+ ; kind = Sexp_list
+ ; conv = int_of_sexp
+ ; rest =
+ Field
+ { name = "f"
+ ; kind = Sexp_option
+ ; conv = int_of_sexp
+ ; rest =
+ Field
+ { name = "g"
+ ; kind = Default (fun () -> 0)
+ ; conv = int_of_sexp
+ ; rest =
+ Field
+ { name = "h"
+ ; kind = Required
+ ; conv =
+ (fun sexp ->
+ { h =
+ list_of_sexp
+
(Sexplib0.Sexp_conv_error
+
.record_poly_field_value
+ "Record.t")
+ sexp
+ })
+ ; rest = Empty
+ }
+ }
+ }
+ }
+ }
+ }
+ }
+ })
+ ~index_of_field:(function
+ | "a" -> 0
+ | "b" -> 1
+ | "c" -> 2
+ | "d" -> 3
+ | "e" -> 4
+ | "f" -> 5
+ | "g" -> 6
+ | "h" -> 7
+ | _ -> -1)
+ ~allow_extra_fields:false
+ ~create:(fun (a, (b, (c, (d, (e, (f, (g, ({ h }, ())))))))) ->
+ { a; b; c; d; e; f; g; h })
+;;
+
+let%bench_fun "t_of_sexp, full, in order" =
+ bench_t_of_sexp ~t_of_sexp "((a 1) (b (2)) (c) (d (3 4)) (e (5 6)) (f 7) (g
8) (h ()))"
+;;
+
+let%bench_fun "t_of_sexp, full, reverse order" =
+ bench_t_of_sexp ~t_of_sexp "((h ()) (g 8) (f 7) (e (5 6)) (d (3 4)) (c) (b
(2)) (a 1))"
+;;
+
+let%bench_fun "t_of_sexp, empty" = bench_t_of_sexp ~t_of_sexp "((a 0) (h ()))"
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/ocaml-sexplib0-0.15.1/bench/bench_record.mli
new/ocaml-sexplib0-0.16.0/bench/bench_record.mli
--- old/ocaml-sexplib0-0.15.1/bench/bench_record.mli 1970-01-01
01:00:00.000000000 +0100
+++ new/ocaml-sexplib0-0.16.0/bench/bench_record.mli 2023-04-25
15:12:25.000000000 +0200
@@ -0,0 +1 @@
+(*_ This signature is deliberately empty. *)
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/ocaml-sexplib0-0.15.1/bench/dune
new/ocaml-sexplib0-0.16.0/bench/dune
--- old/ocaml-sexplib0-0.15.1/bench/dune 1970-01-01 01:00:00.000000000
+0100
+++ new/ocaml-sexplib0-0.16.0/bench/dune 2023-04-25 15:12:25.000000000
+0200
@@ -0,0 +1,2 @@
+(library (name sexplib0_bench) (libraries parsexp sexplib0)
+ (preprocess (pps ppx_bench)))
\ No newline at end of file
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/ocaml-sexplib0-0.15.1/bench/sexplib0_bench.ml
new/ocaml-sexplib0-0.16.0/bench/sexplib0_bench.ml
--- old/ocaml-sexplib0-0.15.1/bench/sexplib0_bench.ml 1970-01-01
01:00:00.000000000 +0100
+++ new/ocaml-sexplib0-0.16.0/bench/sexplib0_bench.ml 2023-04-25
15:12:25.000000000 +0200
@@ -0,0 +1 @@
+(*_ Deliberately empty. *)
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/ocaml-sexplib0-0.15.1/sexplib0.opam
new/ocaml-sexplib0-0.16.0/sexplib0.opam
--- old/ocaml-sexplib0-0.15.1/sexplib0.opam 2022-06-15 18:57:16.000000000
+0200
+++ new/ocaml-sexplib0-0.16.0/sexplib0.opam 2023-04-25 15:12:25.000000000
+0200
@@ -1,5 +1,5 @@
opam-version: "2.0"
-version: "v0.15.0"
+version: "v0.16.0"
maintainer: "Jane Street developers"
authors: ["Jane Street Group, LLC"]
homepage: "https://github.com/janestreet/sexplib0";
@@ -11,9 +11,10 @@
["dune" "build" "-p" name "-j" jobs]
]
depends: [
- "ocaml" {>= "4.04.2"}
+ "ocaml" {>= "4.08.0"}
"dune" {>= "2.0.0"}
]
+available: arch != "arm32" & arch != "x86_32"
synopsis: "Library containing the definition of S-expressions and some base
converters"
description: "
Part of Jane Street's Core library
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/ocaml-sexplib0-0.15.1/src/sexp.ml
new/ocaml-sexplib0-0.16.0/src/sexp.ml
--- old/ocaml-sexplib0-0.15.1/src/sexp.ml 2022-06-15 18:57:16.000000000
+0200
+++ new/ocaml-sexplib0-0.16.0/src/sexp.ml 2023-04-25 15:12:25.000000000
+0200
@@ -134,10 +134,7 @@
Bytes.unsafe_to_string res
;;
- let index_of_newline str start =
- try Some (String.index_from str start '\n') with
- | Not_found -> None
- ;;
+ let index_of_newline str start = String.index_from_opt str start '\n'
let get_substring str index end_pos_opt =
let end_pos =
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/ocaml-sexplib0-0.15.1/src/sexp_conv.mli
new/ocaml-sexplib0-0.16.0/src/sexp_conv.mli
--- old/ocaml-sexplib0-0.15.1/src/sexp_conv.mli 2022-06-15 18:57:16.000000000
+0200
+++ new/ocaml-sexplib0-0.16.0/src/sexp_conv.mli 2023-04-25 15:12:25.000000000
+0200
@@ -277,6 +277,7 @@
-> (exn -> Sexp.t)
-> unit
+
module For_unit_tests_only : sig
val size : unit -> int
end
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/ocaml-sexplib0-0.15.1/src/sexp_conv_grammar.ml
new/ocaml-sexplib0-0.16.0/src/sexp_conv_grammar.ml
--- old/ocaml-sexplib0-0.15.1/src/sexp_conv_grammar.ml 2022-06-15
18:57:16.000000000 +0200
+++ new/ocaml-sexplib0-0.16.0/src/sexp_conv_grammar.ml 2023-04-25
15:12:25.000000000 +0200
@@ -1,3 +1,15 @@
+open StdLabels
+
+let sexp_grammar_with_tags grammar ~tags =
+ List.fold_right tags ~init:grammar ~f:(fun (key, value) grammar ->
+ Sexp_grammar.Tagged { key; value; grammar })
+;;
+
+let sexp_grammar_with_tag_list x ~tags =
+ List.fold_right tags ~init:x ~f:(fun (key, value) grammar ->
+ Sexp_grammar.Tag { key; value; grammar })
+;;
+
let unit_sexp_grammar : unit Sexp_grammar.t = { untyped = List Empty }
let bool_sexp_grammar : bool Sexp_grammar.t = { untyped = Bool }
let string_sexp_grammar : string Sexp_grammar.t = { untyped = String }
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/ocaml-sexplib0-0.15.1/src/sexp_conv_grammar.mli
new/ocaml-sexplib0-0.16.0/src/sexp_conv_grammar.mli
--- old/ocaml-sexplib0-0.15.1/src/sexp_conv_grammar.mli 2022-06-15
18:57:16.000000000 +0200
+++ new/ocaml-sexplib0-0.16.0/src/sexp_conv_grammar.mli 2023-04-25
15:12:25.000000000 +0200
@@ -1,3 +1,15 @@
+(** Grammar constructors. *)
+
+val sexp_grammar_with_tags
+ : Sexp_grammar.grammar
+ -> tags:(string * Sexp.t) list
+ -> Sexp_grammar.grammar
+
+val sexp_grammar_with_tag_list
+ : 'a Sexp_grammar.with_tag_list
+ -> tags:(string * Sexp.t) list
+ -> 'a Sexp_grammar.with_tag_list
+
(** Sexp grammar definitions. *)
val unit_sexp_grammar : unit Sexp_grammar.t
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/ocaml-sexplib0-0.15.1/src/sexp_conv_record.ml
new/ocaml-sexplib0-0.16.0/src/sexp_conv_record.ml
--- old/ocaml-sexplib0-0.15.1/src/sexp_conv_record.ml 1970-01-01
01:00:00.000000000 +0100
+++ new/ocaml-sexplib0-0.16.0/src/sexp_conv_record.ml 2023-04-25
15:12:25.000000000 +0200
@@ -0,0 +1,297 @@
+open! StdLabels
+open! Sexp_conv
+open! Sexp_conv_error
+
+module Kind = struct
+ type (_, _) t =
+ | Default : (unit -> 'a) -> ('a, Sexp.t -> 'a) t
+ | Omit_nil : ('a, Sexp.t -> 'a) t
+ | Required : ('a, Sexp.t -> 'a) t
+ | Sexp_array : ('a array, Sexp.t -> 'a) t
+ | Sexp_bool : (bool, unit) t
+ | Sexp_list : ('a list, Sexp.t -> 'a) t
+ | Sexp_option : ('a option, Sexp.t -> 'a) t
+end
+
+module Fields = struct
+ type _ t =
+ | Empty : unit t
+ | Field :
+ { name : string
+ ; kind : ('a, 'conv) Kind.t
+ ; conv : 'conv
+ ; rest : 'b t
+ }
+ -> ('a * 'b) t
+
+ let length =
+ let rec length_loop : type a. a t -> int -> int =
+ fun t acc ->
+ match t with
+ | Field { rest; _ } -> length_loop rest (acc + 1)
+ | Empty -> acc
+ in
+ fun t -> length_loop t 0
+ ;;
+end
+
+module Malformed = struct
+ (* Represents errors that can occur due to malformed record sexps.
Accumulated as a
+ value so we can report multiple names at once for extra fields, duplicate
fields, or
+ missing fields. *)
+ type t =
+ | Bool_payload
+ | Extras of string list
+ | Dups of string list
+ | Missing of string list
+ | Non_pair of Sexp.t option
+
+ let combine a b =
+ match a, b with
+ (* choose the first bool-payload or non-pair error that occurs *)
+ | ((Bool_payload | Non_pair _) as t), _ -> t
+ | _, ((Bool_payload | Non_pair _) as t) -> t
+ (* combine lists of similar errors *)
+ | Extras a, Extras b -> Extras (a @ b)
+ | Dups a, Dups b -> Dups (a @ b)
+ | Missing a, Missing b -> Missing (a @ b)
+ (* otherwise, dups > extras > missing *)
+ | (Dups _ as t), _ | _, (Dups _ as t) -> t
+ | (Extras _ as t), _ | _, (Extras _ as t) -> t
+ ;;
+
+ let raise t ~caller ~context =
+ match t with
+ | Bool_payload -> record_sexp_bool_with_payload caller context
+ | Extras names -> record_extra_fields caller (List.rev names) context
+ | Dups names -> record_duplicate_fields caller (List.rev names) context
+ | Missing names ->
+ List.map names ~f:(fun name -> true, name)
+ |> record_undefined_elements caller context
+ | Non_pair maybe_context ->
+ let context = Option.value maybe_context ~default:context in
+ record_only_pairs_expected caller context
+ ;;
+end
+
+exception Malformed of Malformed.t
+
+module State = struct
+ (* Stores sexps corresponding to record fields, in the order the fields were
declared.
+ Excludes fields already parsed in the fast path.
+
+ List sexps represent a field that is present, such as (x 1) for a field
named "x".
+ Atom sexps represent a field that is absent, or at least not yet seen. *)
+ type t = { state : Sexp.t array } [@@unboxed]
+
+ let unsafe_get t pos = Array.unsafe_get t.state pos
+ let unsafe_set t pos sexp = Array.unsafe_set t.state pos sexp
+ let absent = Sexp.Atom ""
+ let create len = { state = Array.make len absent }
+end
+
+(* Parsing field values from state. *)
+
+let rec parse_value_malformed
+ : type a b. Malformed.t -> fields:(a * b) Fields.t -> state:State.t ->
pos:int -> a
+ =
+ fun malformed ~fields ~state ~pos ->
+ let (Field field) = fields in
+ let malformed =
+ match parse_values ~fields:field.rest ~state ~pos:(pos + 1) with
+ | (_ : b) -> malformed
+ | exception Malformed other -> Malformed.combine malformed other
+ in
+ raise (Malformed malformed)
+
+and parse_value : type a b. fields:(a * b) Fields.t -> state:State.t ->
pos:int -> a * b =
+ fun ~fields ~state ~pos ->
+ let (Field { name; kind; conv; rest }) = fields in
+ let value : a =
+ match kind, State.unsafe_get state pos with
+ (* well-formed *)
+ | Required, List [ _; sexp ] -> conv sexp
+ | Default _, List [ _; sexp ] -> conv sexp
+ | Omit_nil, List [ _; sexp ] -> conv sexp
+ | Sexp_option, List [ _; sexp ] -> Some (conv sexp)
+ | Sexp_list, List [ _; sexp ] -> list_of_sexp conv sexp
+ | Sexp_array, List [ _; sexp ] -> array_of_sexp conv sexp
+ | Sexp_bool, List [ _ ] -> true
+ (* ill-formed *)
+ | ( (Required | Default _ | Omit_nil | Sexp_option | Sexp_list |
Sexp_array)
+ , (List (_ :: _ :: _ :: _) as sexp) ) ->
+ parse_value_malformed (Non_pair (Some sexp)) ~fields ~state ~pos
+ | ( (Required | Default _ | Omit_nil | Sexp_option | Sexp_list |
Sexp_array)
+ , List ([] | [ _ ]) ) -> parse_value_malformed (Non_pair None) ~fields
~state ~pos
+ | Sexp_bool, List ([] | _ :: _ :: _) ->
+ parse_value_malformed Bool_payload ~fields ~state ~pos
+ (* absent *)
+ | Required, Atom _ -> parse_value_malformed (Missing [ name ]) ~fields
~state ~pos
+ | Default default, Atom _ -> default ()
+ | Omit_nil, Atom _ -> conv (List [])
+ | Sexp_option, Atom _ -> None
+ | Sexp_list, Atom _ -> []
+ | Sexp_array, Atom _ -> [||]
+ | Sexp_bool, Atom _ -> false
+ in
+ value, parse_values ~fields:rest ~state ~pos:(pos + 1)
+
+and parse_values : type a. fields:a Fields.t -> state:State.t -> pos:int -> a =
+ fun ~fields ~state ~pos ->
+ match fields with
+ | Field _ -> parse_value ~fields ~state ~pos
+ | Empty -> ()
+;;
+
+(* Populating state. Handles slow path cases where there may be reordered,
duplicated,
+ missing, or extra fields. *)
+
+let rec parse_spine_malformed malformed ~index ~extra ~seen ~state ~len sexps =
+ let malformed =
+ match parse_spine_slow ~index ~extra ~seen ~state ~len sexps with
+ | () -> malformed
+ | exception Malformed other -> Malformed.combine malformed other
+ in
+ raise (Malformed malformed)
+
+and parse_spine_slow ~index ~extra ~seen ~state ~len sexps =
+ match (sexps : Sexp.t list) with
+ | [] -> ()
+ | (List (Atom name :: _) as field) :: sexps ->
+ let i = index name in
+ (match seen <= i && i < len with
+ | true ->
+ (* valid field for slow-path parsing *)
+ let pos = i - seen in
+ (match State.unsafe_get state pos with
+ | Atom _ ->
+ (* field not seen yet *)
+ State.unsafe_set state pos field;
+ parse_spine_slow ~index ~extra ~seen ~state ~len sexps
+ | List _ ->
+ (* field already seen *)
+ parse_spine_malformed (Dups [ name ]) ~index ~extra ~seen ~state
~len sexps)
+ | false ->
+ (match 0 <= i && i < seen with
+ | true ->
+ (* field seen in fast path *)
+ parse_spine_malformed (Dups [ name ]) ~index ~extra ~seen ~state
~len sexps
+ | false ->
+ (* extra field *)
+ (match extra with
+ | true -> parse_spine_slow ~index ~extra ~seen ~state ~len sexps
+ | false ->
+ parse_spine_malformed (Extras [ name ]) ~index ~extra ~seen
~state ~len sexps)))
+ | sexp :: sexps ->
+ parse_spine_malformed (Non_pair (Some sexp)) ~index ~extra ~seen ~state
~len sexps
+;;
+
+(* Slow path for record parsing. Uses state to store fields as they are
discovered. *)
+
+let parse_record_slow ~fields ~index ~extra ~seen sexps =
+ let unseen = Fields.length fields in
+ let state = State.create unseen in
+ let len = seen + unseen in
+ (* populate state *)
+ parse_spine_slow ~index ~extra ~seen ~state ~len sexps;
+ (* parse values from state *)
+ parse_values ~fields ~state ~pos:0
+;;
+
+(* Fast path for record parsing. Directly parses and returns fields in the
order they are
+ declared. Falls back on slow path if any fields are absent, reordered, or
malformed. *)
+
+let rec parse_field_fast
+ : type a b.
+ fields:(a * b) Fields.t
+ -> index:(string -> int)
+ -> extra:bool
+ -> seen:int
+ -> Sexp.t list
+ -> a * b
+ =
+ fun ~fields ~index ~extra ~seen sexps ->
+ let (Field { name; kind; conv; rest }) = fields in
+ match sexps with
+ | List (Atom atom :: args) :: others when String.equal atom name ->
+ (match kind, args with
+ | Required, [ sexp ] ->
+ conv sexp, parse_spine_fast ~fields:rest ~index ~extra ~seen:(seen + 1)
others
+ | Default _, [ sexp ] ->
+ conv sexp, parse_spine_fast ~fields:rest ~index ~extra ~seen:(seen + 1)
others
+ | Omit_nil, [ sexp ] ->
+ conv sexp, parse_spine_fast ~fields:rest ~index ~extra ~seen:(seen + 1)
others
+ | Sexp_option, [ sexp ] ->
+ ( Some (conv sexp)
+ , parse_spine_fast ~fields:rest ~index ~extra ~seen:(seen + 1) others )
+ | Sexp_list, [ sexp ] ->
+ ( list_of_sexp conv sexp
+ , parse_spine_fast ~fields:rest ~index ~extra ~seen:(seen + 1) others )
+ | Sexp_array, [ sexp ] ->
+ ( array_of_sexp conv sexp
+ , parse_spine_fast ~fields:rest ~index ~extra ~seen:(seen + 1) others )
+ | Sexp_bool, [] ->
+ true, parse_spine_fast ~fields:rest ~index ~extra ~seen:(seen + 1)
others
+ (* malformed field of some kind, dispatch to slow path *)
+ | _, _ -> parse_record_slow ~fields ~index ~extra ~seen sexps)
+ (* malformed or out-of-order field, dispatch to slow path *)
+ | _ -> parse_record_slow ~fields ~index ~extra ~seen sexps
+
+and parse_spine_fast
+ : type a.
+ fields:a Fields.t
+ -> index:(string -> int)
+ -> extra:bool
+ -> seen:int
+ -> Sexp.t list
+ -> a
+ =
+ fun ~fields ~index ~extra ~seen sexps ->
+ match fields with
+ | Field _ -> parse_field_fast ~fields ~index ~extra ~seen sexps
+ | Empty ->
+ (match sexps with
+ | [] -> ()
+ | _ :: _ ->
+ (* extra sexps, dispatch to slow path *)
+ parse_record_slow ~fields ~index ~extra ~seen sexps)
+;;
+
+let parse_record_fast ~fields ~index ~extra sexps =
+ parse_spine_fast ~fields ~index ~extra ~seen:0 sexps
+;;
+
+(* Entry points. *)
+
+let record_of_sexps
+ ~caller
+ ~context
+ ~fields
+ ~index_of_field
+ ~allow_extra_fields
+ ~create
+ sexps
+ =
+ let allow_extra_fields =
+ allow_extra_fields || not !Sexp_conv.record_check_extra_fields
+ in
+ match
+ parse_record_fast ~fields ~index:index_of_field ~extra:allow_extra_fields
sexps
+ with
+ | value -> create value
+ | exception Malformed malformed -> Malformed.raise malformed ~caller ~context
+;;
+
+let record_of_sexp ~caller ~fields ~index_of_field ~allow_extra_fields ~create
sexp =
+ match (sexp : Sexp.t) with
+ | Atom _ as context -> record_list_instead_atom caller context
+ | List sexps as context ->
+ record_of_sexps
+ ~caller
+ ~context
+ ~fields
+ ~index_of_field
+ ~allow_extra_fields
+ ~create
+ sexps
+;;
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/ocaml-sexplib0-0.15.1/src/sexp_conv_record.mli
new/ocaml-sexplib0-0.16.0/src/sexp_conv_record.mli
--- old/ocaml-sexplib0-0.15.1/src/sexp_conv_record.mli 1970-01-01
01:00:00.000000000 +0100
+++ new/ocaml-sexplib0-0.16.0/src/sexp_conv_record.mli 2023-04-25
15:12:25.000000000 +0200
@@ -0,0 +1,54 @@
+module Kind : sig
+ (** A GADT specifying how to parse a record field. See documentation for
+ [ppx_sexp_conv]. *)
+ type (_, _) t =
+ | Default : (unit -> 'a) -> ('a, Sexp.t -> 'a) t
+ | Omit_nil : ('a, Sexp.t -> 'a) t
+ | Required : ('a, Sexp.t -> 'a) t
+ | Sexp_array : ('a array, Sexp.t -> 'a) t
+ | Sexp_bool : (bool, unit) t
+ | Sexp_list : ('a list, Sexp.t -> 'a) t
+ | Sexp_option : ('a option, Sexp.t -> 'a) t
+end
+
+module Fields : sig
+ (** A GADT specifying record fields. *)
+ type _ t =
+ | Empty : unit t
+ | Field :
+ { name : string
+ ; kind : ('a, 'conv) Kind.t
+ ; conv : 'conv
+ ; rest : 'b t
+ }
+ -> ('a * 'b) t
+end
+
+(** Parses a record from a sexp that must be a list of fields.
+
+ Uses [caller] as the source for error messages. Parses using the given
[field]s. Uses
+ [index_of_field] to look up field names found in sexps. If
[allow_extra_fields] is
+ true, extra fields are allowed and discarded without error. [create] is
used to
+ construct the final returned value.
+*)
+val record_of_sexp
+ : caller:string
+ -> fields:'a Fields.t
+ -> index_of_field:(string -> int)
+ -> allow_extra_fields:bool
+ -> create:('a -> 'b)
+ -> Sexp.t
+ -> 'b
+
+(** Like [record_of_sexp], but for a list of sexps with no [List] wrapper.
Used, for
+ example, to parse arguments to a variant constructor with an inlined
record argument.
+ Reports [context] for parse errors when no more specific sexp is
applicable. *)
+val record_of_sexps
+ : caller:string
+ -> context:Sexp.t
+ -> fields:'a Fields.t
+ -> index_of_field:(string -> int)
+ -> allow_extra_fields:bool
+ -> create:('a -> 'b)
+ -> Sexp.t list
+ -> 'b
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/ocaml-sexplib0-0.15.1/src/sexp_grammar.ml
new/ocaml-sexplib0-0.16.0/src/sexp_grammar.ml
--- old/ocaml-sexplib0-0.15.1/src/sexp_grammar.ml 2022-06-15
18:57:16.000000000 +0200
+++ new/ocaml-sexplib0-0.16.0/src/sexp_grammar.ml 2023-04-25
15:12:25.000000000 +0200
@@ -33,20 +33,12 @@
| Tyvar of string
(** Name of a type variable, e.g. [Tyvar "a"] for ['a]. Only meaningful when
the body of
the innermost enclosing [defn] defines a corresponding type variable. *)
- | Tycon of string * grammar list
- (** Type constructor applied to arguments. For example, [Tycon ("list", [
Integer ])]
- represents [int list]. Only meaningful when the innermost enclosing
[Recursive]
- grammar defines a corresponding type constructor. *)
- | Recursive of grammar * defn list
- (** [Recursive (grammar, definitions)] allows [grammar] to refer to type
constructors
- from the mutually recursive [definitions]. The definitions may also
refer to each
- others' type constructors.
+ | Tycon of string * grammar list * defn list
+ (** Type constructor applied to arguments, and its definition.
- Ordinarily, [grammar] itself is just a [Tycon] argument, although
technically it can
- be any grammar.
-
- For example, the following definitions define a binary tree
parameterized by a type
- stored at its leaves.
+ For example, writing [Tycon ("tree", [ Integer ], defns)] represents
[int tree], for
+ whatever [tree] is defined as in [defns]. The following defines [tree]
as a binary
+ tree with the parameter type stored at the leaves.
{[
let defns =
@@ -57,17 +49,17 @@
{ name_kind = Capitalized
; clauses =
[ { name = "Node"
- ; args = Cons (Tycon ("node", [Tyvar "a"]), Empty)
+ ; args = Cons (Recursive ("node", [Tyvar "a"]), Empty)
}
- ; { name = "Tree"
- ; args = Cons (Tycon ("leaf", [Tyvar "a"]), Empty)
+ ; { name = "Leaf"
+ ; args = Cons (Recursive ("leaf", [Tyvar "a"]), Empty)
}
]
}
}
; { tycon = "node"
; tyvars = ["a"]
- ; grammar = List (Many (Tycon "tree", [Tyvar "a"]))
+ ; grammar = List (Many (Recursive "tree", [Tyvar "a"]))
}
; { tycon = "leaf"
; tyvars = ["a"]
@@ -77,31 +69,32 @@
;;
]}
- Normally, the type of a tree storing integers would be written like this:
+ To illustrate the meaning of [Tycon] with respect to [defns], and to
demonstrate one
+ way to access them, it is equivalent to expand the definition of "tree"
one level
+ and move the [defns] to enclosed recursive references:
{[
- Recursive (Tycon ("tree", [ Integer ]), defns)
+ Tycon ("tree", [ Integer ], defns)
+ -->
+ Variant
+ { name_kind = Capitalized
+ ; clauses =
+ [ { name = "Node"
+ ; args = Cons (Tycon ("node", [Tyvar "a"], defns), Empty)
+ }
+ ; { name = "Leaf"
+ ; args = Cons (Tycon ("leaf", [Tyvar "a"], defns), Empty)
+ }
+ ]
+ }
]}
- It is equivalent, though needlessly verbose, to replace the [Tycon]
reference with
- the grammar of ["tree"], substituting [Integer] for [Tyvar "a"]:
-
- {[
- Recursive
- ( Variant
- { name_kind = Capitalized
- ; clauses =
- [ { name = "Node"
- ; args = Cons (Tycon ("node", [Tyvar "a"]), Empty)
- }
- ; { name = "Tree"
- ; args = Cons (Tycon ("leaf", [Tyvar "a"]), Empty)
- }
- ]
- }
- , defns )
- ]}
- *)
+ This transformation exposes the structure of a grammar with recursive
references,
+ while preserving the meaning of recursively-defined elements. *)
+ | Recursive of string * grammar list
+ (** Type constructor applied to arguments. Used to denote recursive type
references.
+ Only meaningful when used inside the [defn]s of a [Tycon] grammar, to
refer to a
+ type constructor in the nearest enclosing [defn] list. *)
| Lazy of grammar lazy_t
(** Lazily computed grammar. Use [Lazy] to avoid top-level side effects. To
define
recursive grammars, use [Recursive] instead. *)
@@ -187,5 +180,28 @@
let coerce (type a b) ({ untyped = _ } as t : a t) : b t = t
+let tag (type a) ({ untyped = grammar } : a t) ~key ~value : a t =
+ { untyped = Tagged { key; value; grammar } }
+;;
+
(** This reserved key is used for all tags generated from doc comments. *)
let doc_comment_tag = "sexp_grammar.doc_comment"
+
+(** This reserved key can be used to associate a type name with a grammar. *)
+let type_name_tag = "sexp_grammar.type_name"
+
+(** This reserved key indicates that a sexp represents a key/value
association. The tag's
+ value is ignored. *)
+let assoc_tag = "sexp_grammar.assoc"
+
+(** This reserved key indicates that a sexp is a key in a key/value
association. The tag's
+ value is ignored. *)
+let assoc_key_tag = "sexp_grammar.assoc.key"
+
+(** This reserved key indicates that a sexp is a value in a key/value
association. The
+ tag's value is ignored. *)
+let assoc_value_tag = "sexp_grammar.assoc.value"
+
+(** When the key is set to [Atom "false"] for a variant clause, that clause
should not be
+ suggested in auto-completion based on the sexp grammar. *)
+let completion_suggested = "sexp_grammar.completion-suggested"
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/ocaml-sexplib0-0.15.1/src/sexplib0.ml
new/ocaml-sexplib0-0.16.0/src/sexplib0.ml
--- old/ocaml-sexplib0-0.15.1/src/sexplib0.ml 2022-06-15 18:57:16.000000000
+0200
+++ new/ocaml-sexplib0-0.16.0/src/sexplib0.ml 2023-04-25 15:12:25.000000000
+0200
@@ -1,5 +1,6 @@
module Sexp = Sexp
module Sexp_conv = Sexp_conv
module Sexp_conv_error = Sexp_conv_error
+module Sexp_conv_record = Sexp_conv_record
module Sexp_grammar = Sexp_grammar
module Sexpable = Sexpable
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/ocaml-sexplib0-0.15.1/test/dune
new/ocaml-sexplib0-0.16.0/test/dune
--- old/ocaml-sexplib0-0.15.1/test/dune 1970-01-01 01:00:00.000000000 +0100
+++ new/ocaml-sexplib0-0.16.0/test/dune 2023-04-25 15:12:25.000000000 +0200
@@ -0,0 +1,4 @@
+(library (name sexplib0_test)
+ (libraries base expect_test_helpers_core.expect_test_helpers_base sexplib0)
+ (preprocess
+ (pps ppx_compare ppx_expect ppx_here ppx_sexp_conv ppx_sexp_value)))
\ No newline at end of file
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/ocaml-sexplib0-0.15.1/test/sexplib0_test.ml
new/ocaml-sexplib0-0.16.0/test/sexplib0_test.ml
--- old/ocaml-sexplib0-0.15.1/test/sexplib0_test.ml 1970-01-01
01:00:00.000000000 +0100
+++ new/ocaml-sexplib0-0.16.0/test/sexplib0_test.ml 2023-04-25
15:12:25.000000000 +0200
@@ -0,0 +1,452 @@
+open! Base
+open Expect_test_helpers_base
+open Sexplib0
+
+let () = sexp_style := Sexp_style.simple_pretty
+
+module type S = sig
+ type t [@@deriving equal, sexp]
+end
+
+let test (type a) (module M : S with type t = a) string =
+ let sexp = Parsexp.Single.parse_string_exn string in
+ let result = Or_error.try_with (fun () -> M.t_of_sexp sexp) in
+ print_s [%sexp (result : M.t Or_error.t)]
+;;
+
+let%expect_test "simple record" =
+ let module M = struct
+ type t =
+ { x : int
+ ; y : int
+ }
+ [@@deriving equal, sexp_of]
+
+ let t_of_sexp =
+ Sexp_conv_record.record_of_sexp
+ ~caller:"M.t"
+ ~fields:
+ (Field
+ { name = "x"
+ ; kind = Required
+ ; conv = int_of_sexp
+ ; rest =
+ Field { name = "y"; kind = Required; conv = int_of_sexp; rest
= Empty }
+ })
+ ~index_of_field:(function
+ | "x" -> 0
+ | "y" -> 1
+ | _ -> -1)
+ ~allow_extra_fields:false
+ ~create:(fun (x, (y, ())) -> { x; y })
+ ;;
+ end
+ in
+ let test = test (module M) in
+ (* in order *)
+ test "((x 1) (y 2))";
+ [%expect {| (Ok ((x 1) (y 2))) |}];
+ (* reverse order *)
+ test "((y 2) (x 1))";
+ [%expect {| (Ok ((x 1) (y 2))) |}];
+ (* duplicate fields *)
+ test "((x 1) (x 2) (y 3) (y 4))";
+ [%expect
+ {|
+ (Error
+ (Of_sexp_error
+ "M.t_of_sexp: duplicate fields: x y"
+ (invalid_sexp ((x 1) (x 2) (y 3) (y 4))))) |}];
+ (* extra fields *)
+ test "((a 1) (b 2) (c 3))";
+ [%expect
+ {|
+ (Error
+ (Of_sexp_error
+ "M.t_of_sexp: extra fields: a b c"
+ (invalid_sexp ((a 1) (b 2) (c 3))))) |}];
+ (* missing field *)
+ test "((x 1))";
+ [%expect
+ {|
+ (Error
+ (Of_sexp_error
+ "M.t_of_sexp: the following record elements were undefined: y"
+ (invalid_sexp ((x 1))))) |}];
+ (* other missing field *)
+ test "((y 2))";
+ [%expect
+ {|
+ (Error
+ (Of_sexp_error
+ "M.t_of_sexp: the following record elements were undefined: x"
+ (invalid_sexp ((y 2))))) |}];
+ (* multiple missing fields *)
+ test "()";
+ [%expect
+ {|
+ (Error
+ (Of_sexp_error
+ "M.t_of_sexp: the following record elements were undefined: x y"
+ (invalid_sexp ()))) |}];
+ ()
+;;
+
+let%expect_test "record with extra fields" =
+ let module M = struct
+ type t =
+ { x : int
+ ; y : int
+ }
+ [@@deriving equal, sexp_of]
+
+ let t_of_sexp =
+ Sexp_conv_record.record_of_sexp
+ ~caller:"M.t"
+ ~fields:
+ (Field
+ { name = "x"
+ ; kind = Required
+ ; conv = int_of_sexp
+ ; rest =
+ Field { name = "y"; kind = Required; conv = int_of_sexp; rest
= Empty }
+ })
+ ~index_of_field:(function
+ | "x" -> 0
+ | "y" -> 1
+ | _ -> -1)
+ ~allow_extra_fields:true
+ ~create:(fun (x, (y, ())) -> { x; y })
+ ;;
+ end
+ in
+ let test = test (module M) in
+ (* in order *)
+ test "((x 1) (y 2))";
+ [%expect {| (Ok ((x 1) (y 2))) |}];
+ (* reversed order *)
+ test "((y 2) (x 1))";
+ [%expect {| (Ok ((x 1) (y 2))) |}];
+ (* extra field *)
+ test "((x 1) (y 2) (z 3))";
+ [%expect {| (Ok ((x 1) (y 2))) |}];
+ (* missing field *)
+ test "((x 1))";
+ [%expect
+ {|
+ (Error
+ (Of_sexp_error
+ "M.t_of_sexp: the following record elements were undefined: y"
+ (invalid_sexp ((x 1))))) |}];
+ (* other missing field *)
+ test "((y 2))";
+ [%expect
+ {|
+ (Error
+ (Of_sexp_error
+ "M.t_of_sexp: the following record elements were undefined: x"
+ (invalid_sexp ((y 2))))) |}];
+ (* multiple missing fields *)
+ test "()";
+ [%expect
+ {|
+ (Error
+ (Of_sexp_error
+ "M.t_of_sexp: the following record elements were undefined: x y"
+ (invalid_sexp ()))) |}];
+ ()
+;;
+
+let%expect_test "record with defaults" =
+ let module M = struct
+ type t =
+ { x : int
+ ; y : int
+ }
+ [@@deriving equal, sexp_of]
+
+ let t_of_sexp =
+ Sexp_conv_record.record_of_sexp
+ ~caller:"M.t"
+ ~fields:
+ (Field
+ { name = "x"
+ ; kind = Default (fun () -> 0)
+ ; conv = int_of_sexp
+ ; rest =
+ Field
+ { name = "y"
+ ; kind = Default (fun () -> 0)
+ ; conv = int_of_sexp
+ ; rest = Empty
+ }
+ })
+ ~index_of_field:(function
+ | "x" -> 0
+ | "y" -> 1
+ | _ -> -1)
+ ~allow_extra_fields:false
+ ~create:(fun (x, (y, ())) -> { x; y })
+ ;;
+ end
+ in
+ let test = test (module M) in
+ (* in order *)
+ test "((x 1) (y 2))";
+ [%expect {| (Ok ((x 1) (y 2))) |}];
+ (* reverse order *)
+ test "((y 2) (x 1))";
+ [%expect {| (Ok ((x 1) (y 2))) |}];
+ (* extra field *)
+ test "((x 1) (y 2) (z 3))";
+ [%expect
+ {|
+ (Error
+ (Of_sexp_error
+ "M.t_of_sexp: extra fields: z"
+ (invalid_sexp ((x 1) (y 2) (z 3))))) |}];
+ (* missing field *)
+ test "((x 1))";
+ [%expect {| (Ok ((x 1) (y 0))) |}];
+ (* other missing field *)
+ test "((y 2))";
+ [%expect {| (Ok ((x 0) (y 2))) |}];
+ (* multiple missing fields *)
+ test "()";
+ [%expect {| (Ok ((x 0) (y 0))) |}];
+ ()
+;;
+
+let%expect_test "record with omit nil" =
+ let module M = struct
+ type t =
+ { a : int option
+ ; b : int list
+ }
+ [@@deriving equal, sexp_of]
+
+ let t_of_sexp =
+ Sexp_conv_record.record_of_sexp
+ ~caller:"M.t"
+ ~fields:
+ (Field
+ { name = "a"
+ ; kind = Omit_nil
+ ; conv = option_of_sexp int_of_sexp
+ ; rest =
+ Field
+ { name = "b"
+ ; kind = Omit_nil
+ ; conv = list_of_sexp int_of_sexp
+ ; rest = Empty
+ }
+ })
+ ~index_of_field:(function
+ | "a" -> 0
+ | "b" -> 1
+ | _ -> -1)
+ ~allow_extra_fields:false
+ ~create:(fun (a, (b, ())) -> { a; b })
+ ;;
+ end
+ in
+ let test = test (module M) in
+ (* in order *)
+ test "((a (1)) (b (2 3)))";
+ [%expect {| (Ok ((a (1)) (b (2 3)))) |}];
+ (* reverse order *)
+ test "((b ()) (a ()))";
+ [%expect {| (Ok ((a ()) (b ()))) |}];
+ (* extra field *)
+ test "((a (1)) (b (2 3)) (z ()))";
+ [%expect
+ {|
+ (Error
+ (Of_sexp_error
+ "M.t_of_sexp: extra fields: z"
+ (invalid_sexp ((a (1)) (b (2 3)) (z ()))))) |}];
+ (* missing field *)
+ test "((a (1)))";
+ [%expect {| (Ok ((a (1)) (b ()))) |}];
+ (* other missing field *)
+ test "((b (2 3)))";
+ [%expect {| (Ok ((a ()) (b (2 3)))) |}];
+ (* multiple missing fields *)
+ test "()";
+ [%expect {| (Ok ((a ()) (b ()))) |}];
+ ()
+;;
+
+let%expect_test "record with sexp types" =
+ let module M = struct
+ type t =
+ { a : int option
+ ; b : int list
+ ; c : int array
+ ; d : bool
+ }
+ [@@deriving equal, sexp_of]
+
+ let t_of_sexp =
+ Sexp_conv_record.record_of_sexp
+ ~caller:"M.t"
+ ~fields:
+ (Field
+ { name = "a"
+ ; kind = Sexp_option
+ ; conv = int_of_sexp
+ ; rest =
+ Field
+ { name = "b"
+ ; kind = Sexp_list
+ ; conv = int_of_sexp
+ ; rest =
+ Field
+ { name = "c"
+ ; kind = Sexp_array
+ ; conv = int_of_sexp
+ ; rest =
+ Field
+ { name = "d"; kind = Sexp_bool; conv = (); rest
= Empty }
+ }
+ }
+ })
+ ~index_of_field:(function
+ | "a" -> 0
+ | "b" -> 1
+ | "c" -> 2
+ | "d" -> 3
+ | _ -> -1)
+ ~allow_extra_fields:false
+ ~create:(fun (a, (b, (c, (d, ())))) -> { a; b; c; d })
+ ;;
+ end
+ in
+ let test = test (module M) in
+ (* in order *)
+ test "((a 1) (b (2 3)) (c (4 5)) (d))";
+ [%expect {| (Ok ((a (1)) (b (2 3)) (c (4 5)) (d true))) |}];
+ (* reverse order *)
+ test "((d) (c ()) (b ()) (a 1))";
+ [%expect {| (Ok ((a (1)) (b ()) (c ()) (d true))) |}];
+ (* missing field d *)
+ test "((a 1) (b (2 3)) (c (4 5)))";
+ [%expect {| (Ok ((a (1)) (b (2 3)) (c (4 5)) (d false))) |}];
+ (* missing field c *)
+ test "((a 1) (b (2 3)) (d))";
+ [%expect {| (Ok ((a (1)) (b (2 3)) (c ()) (d true))) |}];
+ (* missing field b *)
+ test "((a 1) (c (2 3)) (d))";
+ [%expect {| (Ok ((a (1)) (b ()) (c (2 3)) (d true))) |}];
+ (* missing field a *)
+ test "((b (1 2)) (c (3 4)) (d))";
+ [%expect {| (Ok ((a ()) (b (1 2)) (c (3 4)) (d true))) |}];
+ (* extra field *)
+ test "((a 1) (b (2 3)) (c (4 5)) (d) (e (6 7)))";
+ [%expect
+ {|
+ (Error
+ (Of_sexp_error
+ "M.t_of_sexp: extra fields: e"
+ (invalid_sexp ((a 1) (b (2 3)) (c (4 5)) (d) (e (6 7)))))) |}];
+ (* all fields missing *)
+ test "()";
+ [%expect {| (Ok ((a ()) (b ()) (c ()) (d false))) |}];
+ ()
+;;
+
+let%expect_test "record with polymorphic fields" =
+ let module M = struct
+ type t =
+ { a : 'a. 'a list
+ ; b : 'a 'b. ('a, 'b) Result.t option
+ }
+ [@@deriving sexp_of]
+
+ let equal = Poly.equal
+
+ let t_of_sexp =
+ let open struct
+ type a = { a : 'a. 'a list } [@@unboxed]
+ type b = { b : 'a 'b. ('a, 'b) Result.t option } [@@unboxed]
+ end in
+ let caller = "M.t" in
+ Sexp_conv_record.record_of_sexp
+ ~caller
+ ~fields:
+ (Field
+ { name = "a"
+ ; kind = Required
+ ; conv =
+ (fun sexp ->
+ { a =
+ list_of_sexp
+ (Sexplib.Conv_error.record_poly_field_value caller)
+ sexp
+ })
+ ; rest =
+ Field
+ { name = "b"
+ ; kind = Required
+ ; conv =
+ (fun sexp ->
+ { b =
+ Option.t_of_sexp
+ (Result.t_of_sexp
+ (Sexplib.Conv_error.record_poly_field_value
caller)
+ (Sexplib.Conv_error.record_poly_field_value
caller))
+ sexp
+ })
+ ; rest = Empty
+ }
+ })
+ ~index_of_field:(function
+ | "a" -> 0
+ | "b" -> 1
+ | _ -> -1)
+ ~allow_extra_fields:false
+ ~create:(fun ({ a }, ({ b }, ())) -> { a; b })
+ ;;
+ end
+ in
+ let test = test (module M) in
+ (* in order *)
+ test "((a ()) (b ()))";
+ [%expect {| (Ok ((a ()) (b ()))) |}];
+ (* reverse order *)
+ test "((b ()) (a ()))";
+ [%expect {| (Ok ((a ()) (b ()))) |}];
+ (* attempt to deserialize paramter to [a] *)
+ test "((a (_)) (b ()))";
+ [%expect
+ {|
+ (Error
+ (Of_sexp_error
+ "M.t_of_sexp: cannot convert values of types resulting from polymorphic
record fields"
+ (invalid_sexp _))) |}];
+ (* attempt to deserialize first parameter to [b] *)
+ test "((a ()) (b ((Ok _))))";
+ [%expect
+ {|
+ (Error
+ (Of_sexp_error
+ "M.t_of_sexp: cannot convert values of types resulting from polymorphic
record fields"
+ (invalid_sexp _))) |}];
+ (* attempt to deserialize second parameter to [b] *)
+ test "((a ()) (b ((Error _))))";
+ [%expect
+ {|
+ (Error
+ (Of_sexp_error
+ "M.t_of_sexp: cannot convert values of types resulting from polymorphic
record fields"
+ (invalid_sexp _))) |}];
+ (* multiple missing fields *)
+ test "()";
+ [%expect
+ {|
+ (Error
+ (Of_sexp_error
+ "M.t_of_sexp: the following record elements were undefined: a b"
+ (invalid_sexp ()))) |}];
+ ()
+;;
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/ocaml-sexplib0-0.15.1/test/sexplib0_test.mli
new/ocaml-sexplib0-0.16.0/test/sexplib0_test.mli
--- old/ocaml-sexplib0-0.15.1/test/sexplib0_test.mli 1970-01-01
01:00:00.000000000 +0100
+++ new/ocaml-sexplib0-0.16.0/test/sexplib0_test.mli 2023-04-25
15:12:25.000000000 +0200
@@ -0,0 +1 @@
+(*_ This signature is deliberately empty. *)
