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 2026-07-17 01:39:11 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Comparing /work/SRC/openSUSE:Factory/ocaml-sexplib0 (Old) and /work/SRC/openSUSE:Factory/.ocaml-sexplib0.new.24530 (New) ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Package is "ocaml-sexplib0" Fri Jul 17 01:39:11 2026 rev:8 rq:1365580 version:0.17.0 Changes: -------- --- /work/SRC/openSUSE:Factory/ocaml-sexplib0/ocaml-sexplib0.changes 2023-05-12 20:41:14.355170487 +0200 +++ /work/SRC/openSUSE:Factory/.ocaml-sexplib0.new.24530/ocaml-sexplib0.changes 2026-07-17 01:41:19.000862691 +0200 @@ -1,0 +2,6 @@ +Tue Jul 7 07:07:07 UTC 2026 - [email protected] + +- Update to version 0.17.0 + see included CHANGES.md file for details + +------------------------------------------------------------------- Old: ---- ocaml-sexplib0-0.16.0.tar.xz New: ---- ocaml-sexplib0-0.17.0.tar.xz ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Other differences: ------------------ ++++++ ocaml-sexplib0.spec ++++++ --- /var/tmp/diff_new_pack.5rBSkk/_old 2026-07-17 01:41:21.032931302 +0200 +++ /var/tmp/diff_new_pack.5rBSkk/_new 2026-07-17 01:41:21.044931708 +0200 @@ -1,7 +1,7 @@ # # spec file for package ocaml-sexplib0 # -# Copyright (c) 2023 SUSE LLC +# Copyright (c) 2026 SUSE LLC and contributors # # All modifications and additions to the file contributed by third parties # remain the property of their copyright owners, unless otherwise agreed @@ -17,27 +17,24 @@ Name: ocaml-sexplib0 -Version: 0.16.0 +Version: 0.17.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 +ExclusiveArch: aarch64 ppc64le riscv64 s390x x86_64 +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.08 +BuildRequires: ocaml(ocaml_base_version) >= 5.1 +BuildRequires: ocaml-dune >= 3.11 +BuildRequires: ocaml-rpm-macros >= 20260707 %description Library containing the definition of S-expressions and some base converters. %package devel Summary: Development files for %name -Group: Development/Languages/OCaml -Requires: %name = %version +Requires: %name = %version-%release %description devel The %name-devel package contains libraries and signature files for @@ -59,8 +56,6 @@ %ocaml_dune_test %files -f %name.files -%defattr(-,root,root,-) %files devel -f %name.files.devel -%defattr(-,root,root,-) ++++++ _service ++++++ --- /var/tmp/diff_new_pack.5rBSkk/_old 2026-07-17 01:41:21.472946159 +0200 +++ /var/tmp/diff_new_pack.5rBSkk/_new 2026-07-17 01:41:21.508947375 +0200 @@ -1,7 +1,7 @@ <services> - <service name="tar_scm" mode="disabled"> + <service name="tar_scm" mode="manual"> <param name="filename">ocaml-sexplib0</param> - <param name="revision">df916dfe8d0538a0dbfcdcb35c6e933ac9fc8130</param> + <param name="revision">787368c6c76dcbc002f151e8f4c0752a78552cac</param> <param name="scm">git</param> <param name="submodules">disable</param> <param name="url">https://github.com/janestreet/sexplib0.git</param> @@ -9,10 +9,10 @@ <param name="versionrewrite-pattern">[v]?([^+]+)(.*)</param> <param name="versionrewrite-replacement">\1</param> </service> - <service name="recompress" mode="disabled"> + <service name="recompress" mode="manual"> <param name="file">*.tar</param> <param name="compression">xz</param> </service> - <service name="set_version" mode="disabled"/> + <service name="set_version" mode="manual"/> </services> ++++++ ocaml-sexplib0-0.16.0.tar.xz -> ocaml-sexplib0-0.17.0.tar.xz ++++++ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/ocaml-sexplib0-0.16.0/.ocamlformat new/ocaml-sexplib0-0.17.0/.ocamlformat --- old/ocaml-sexplib0-0.16.0/.ocamlformat 1970-01-01 01:00:00.000000000 +0100 +++ new/ocaml-sexplib0-0.17.0/.ocamlformat 2024-04-29 17:42:10.000000000 +0200 @@ -0,0 +1 @@ +profile=janestreet diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/ocaml-sexplib0-0.16.0/CHANGES.md new/ocaml-sexplib0-0.17.0/CHANGES.md --- old/ocaml-sexplib0-0.16.0/CHANGES.md 2023-04-25 15:12:25.000000000 +0200 +++ new/ocaml-sexplib0-0.17.0/CHANGES.md 2024-04-29 17:42:10.000000000 +0200 @@ -1,3 +1,14 @@ +## Release v0.17.0 + +* Add a test that `Sexp.to_string` works on large input. + +* Improve error messages produced by `Sexp_conv` + +* Use `[@tail_mod_cons]` in `sexp_of_list`. + +* Add support for labeled tuples, a compiler extension available at: + https://github.com/ocaml-flambda/flambda-backend + ## Release v0.16.0 * Added `Sexp_conv_record`. Supports improvements to `ppx_sexp_conv` for deriving diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/ocaml-sexplib0-0.16.0/LICENSE.md new/ocaml-sexplib0-0.17.0/LICENSE.md --- old/ocaml-sexplib0-0.16.0/LICENSE.md 2023-04-25 15:12:25.000000000 +0200 +++ new/ocaml-sexplib0-0.17.0/LICENSE.md 2024-04-29 17:42:10.000000000 +0200 @@ -1,6 +1,6 @@ The MIT License -Copyright (c) 2005--2023 Jane Street Group, LLC <[email protected]> +Copyright (c) 2005--2024 Jane Street Group, LLC <[email protected]> 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.16.0/bench/bench_record.ml new/ocaml-sexplib0-0.17.0/bench/bench_record.ml --- old/ocaml-sexplib0-0.16.0/bench/bench_record.ml 2023-04-25 15:12:25.000000000 +0200 +++ new/ocaml-sexplib0-0.17.0/bench/bench_record.ml 2024-04-29 17:42:10.000000000 +0200 @@ -63,13 +63,13 @@ ; kind = Required ; conv = (fun sexp -> - { h = - list_of_sexp - (Sexplib0.Sexp_conv_error - .record_poly_field_value - "Record.t") - sexp - }) + { h = + list_of_sexp + (Sexplib0.Sexp_conv_error + .record_poly_field_value + "Record.t") + sexp + }) ; rest = Empty } } diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/ocaml-sexplib0-0.16.0/bench/dune new/ocaml-sexplib0-0.17.0/bench/dune --- old/ocaml-sexplib0-0.16.0/bench/dune 2023-04-25 15:12:25.000000000 +0200 +++ new/ocaml-sexplib0-0.17.0/bench/dune 2024-04-29 17:42:10.000000000 +0200 @@ -1,2 +1,5 @@ -(library (name sexplib0_bench) (libraries parsexp sexplib0) - (preprocess (pps ppx_bench))) \ No newline at end of file +(library + (name sexplib0_bench) + (libraries parsexp sexplib0) + (preprocess + (pps ppx_bench))) diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/ocaml-sexplib0-0.16.0/dune-project new/ocaml-sexplib0-0.17.0/dune-project --- old/ocaml-sexplib0-0.16.0/dune-project 2023-04-25 15:12:25.000000000 +0200 +++ new/ocaml-sexplib0-0.17.0/dune-project 2024-04-29 17:42:10.000000000 +0200 @@ -1 +1 @@ -(lang dune 1.10) \ No newline at end of file +(lang dune 3.11) diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/ocaml-sexplib0-0.16.0/sexplib0.opam new/ocaml-sexplib0-0.17.0/sexplib0.opam --- old/ocaml-sexplib0-0.16.0/sexplib0.opam 2023-04-25 15:12:25.000000000 +0200 +++ new/ocaml-sexplib0-0.17.0/sexplib0.opam 2024-04-29 17:42:10.000000000 +0200 @@ -1,5 +1,5 @@ opam-version: "2.0" -version: "v0.16.0" +version: "v0.17.0" maintainer: "Jane Street developers" authors: ["Jane Street Group, LLC"] homepage: "https://github.com/janestreet/sexplib0"; @@ -11,8 +11,8 @@ ["dune" "build" "-p" name "-j" jobs] ] depends: [ - "ocaml" {>= "4.08.0"} - "dune" {>= "2.0.0"} + "ocaml" {>= "4.14.0"} + "dune" {>= "3.11.0"} ] available: arch != "arm32" & arch != "x86_32" synopsis: "Library containing the definition of S-expressions and some base converters" diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/ocaml-sexplib0-0.16.0/src/dune new/ocaml-sexplib0-0.17.0/src/dune --- old/ocaml-sexplib0-0.16.0/src/dune 2023-04-25 15:12:25.000000000 +0200 +++ new/ocaml-sexplib0-0.17.0/src/dune 2024-04-29 17:42:10.000000000 +0200 @@ -1,2 +1,5 @@ -(library (name sexplib0) (public_name sexplib0) - (preprocess no_preprocessing)) \ No newline at end of file +(library + (name sexplib0) + (public_name sexplib0) + (preprocess no_preprocessing) + (ocamlopt_flags :standard -O3)) diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/ocaml-sexplib0-0.16.0/src/sexp.ml new/ocaml-sexplib0-0.17.0/src/sexp.ml --- old/ocaml-sexplib0-0.16.0/src/sexp.ml 2023-04-25 15:12:25.000000000 +0200 +++ new/ocaml-sexplib0-0.17.0/src/sexp.ml 2024-04-29 17:42:10.000000000 +0200 @@ -36,7 +36,14 @@ | List a, List b -> compare_list a b) ;; -let equal a b = compare a b = 0 +let rec equal a b = + a == b + || + match a, b with + | Atom a, Atom b -> String.equal a b + | Atom _, _ | _, Atom _ -> false + | List a, List b -> List.equal ~eq:equal a b +;; exception Not_found_s of t exception Of_sexp_error of exn * t @@ -75,12 +82,12 @@ let n = ref 0 in for i = 0 to String.length s - 1 do n - := !n - + - match String.unsafe_get s i with - | '\"' | '\\' | '\n' | '\t' | '\r' | '\b' -> 2 - | ' ' .. '~' -> 1 - | _ -> 4 + := !n + + + match String.unsafe_get s i with + | '\"' | '\\' | '\n' | '\t' | '\r' | '\b' -> 2 + | ' ' .. '~' -> 1 + | _ -> 4 done; if !n = String.length s then s @@ -314,8 +321,8 @@ let to_string_hum ?indent = function | Atom str when match index_of_newline str 0 with - | None -> true - | Some _ -> false -> mach_maybe_esc_str str + | None -> true + | Some _ -> false -> mach_maybe_esc_str str | sexp -> let buf = buffer () in to_buffer_hum ?indent sexp ~buf; diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/ocaml-sexplib0-0.16.0/src/sexp_conv.ml new/ocaml-sexplib0-0.17.0/src/sexp_conv.ml --- old/ocaml-sexplib0-0.16.0/src/sexp_conv.ml 2023-04-25 15:12:25.000000000 +0200 +++ new/ocaml-sexplib0-0.17.0/src/sexp_conv.ml 2024-04-29 17:42:10.000000000 +0200 @@ -24,7 +24,7 @@ let read_old_option_format = ref true let write_old_option_format = ref true -let list_map f l = List.rev (List.rev_map l ~f) +let list_map f l = List.map l ~f let sexp_of_unit () = List [] let sexp_of_bool b = Atom (string_of_bool b) let sexp_of_string str = Atom str @@ -51,9 +51,7 @@ List [ sexp_of__a a; sexp_of__b b; sexp_of__c c ] ;; -(* List.rev (List.rev_map ...) is tail recursive, the OCaml standard - library List.map is NOT. *) -let sexp_of_list sexp_of__a lst = List (List.rev (List.rev_map lst ~f:sexp_of__a)) +let sexp_of_list sexp_of__a lst = List (List.map lst ~f:sexp_of__a) let sexp_of_array sexp_of__a ar = let lst_ref = ref [] in @@ -90,11 +88,11 @@ end module Exn_table = Ephemeron.K1.Make (struct - type t = extension_constructor + type t = extension_constructor - let equal = ( == ) - let hash = Obj.Extension_constructor.id - end) + let equal = ( == ) + let hash = Obj.Extension_constructor.id + end) let the_exn_table : Registration.t Exn_table.t = Exn_table.create 17 @@ -274,9 +272,7 @@ let list_of_sexp a__of_sexp sexp = match sexp with - | List lst -> - let rev_lst = List.rev_map lst ~f:a__of_sexp in - List.rev rev_lst + | List lst -> List.map lst ~f:a__of_sexp | Atom _ -> of_sexp_error "list_of_sexp: list needed" sexp ;; diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/ocaml-sexplib0-0.16.0/src/sexp_conv.mli new/ocaml-sexplib0-0.17.0/src/sexp_conv.mli --- old/ocaml-sexplib0-0.16.0/src/sexp_conv.mli 2023-04-25 15:12:25.000000000 +0200 +++ new/ocaml-sexplib0-0.17.0/src/sexp_conv.mli 2024-04-29 17:42:10.000000000 +0200 @@ -37,11 +37,11 @@ S-expression. *) val sexp_of_bool : bool -> Sexp.t -(** [sexp_of_bool str] converts the value [str] of type [string] to an +(** [sexp_of_string str] converts the value [str] of type [string] to an S-expression. *) val sexp_of_string : string -> Sexp.t -(** [sexp_of_bool str] converts the value [str] of type [bytes] to an +(** [sexp_of_bytes str] converts the value [str] of type [bytes] to an S-expression. *) val sexp_of_bytes : bytes -> Sexp.t @@ -277,7 +277,6 @@ -> (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.16.0/src/sexp_conv_error.ml new/ocaml-sexplib0-0.17.0/src/sexp_conv_error.ml --- old/ocaml-sexplib0-0.16.0/src/sexp_conv_error.ml 2023-04-25 15:12:25.000000000 +0200 +++ new/ocaml-sexplib0-0.17.0/src/sexp_conv_error.ml 2024-04-29 17:42:10.000000000 +0200 @@ -7,69 +7,62 @@ exception Of_sexp_error = Of_sexp_error +let error ~loc ~sexp msg = of_sexp_error (sprintf "%s_of_sexp: %s" loc msg) sexp +let simple_error msg loc sexp = error ~loc ~sexp msg + (* Errors concerning tuples *) let tuple_of_size_n_expected loc n sexp = - of_sexp_error (sprintf "%s_of_sexp: tuple of size %d expected" loc n) sexp + error ~loc ~sexp (sprintf "tuple of size %d expected" n) ;; -(* Errors concerning sum types *) - -let stag_no_args loc sexp = - of_sexp_error (loc ^ "_of_sexp: this constructor does not take arguments") sexp +let tuple_pair_expected loc name sexp = + let msg = sprintf "%s_of_sexp: expected a pair beginning with label %s" loc name in + of_sexp_error msg sexp ;; -let stag_incorrect_n_args loc tag sexp = - let msg = sprintf "%s_of_sexp: sum tag %S has incorrect number of arguments" loc tag in +let tuple_incorrect_label loc name pos sexp = + let msg = + sprintf "%s_of_sexp: incorrect label for element %s at position %i" loc name pos + in of_sexp_error msg sexp ;; -let stag_takes_args loc sexp = - of_sexp_error (loc ^ "_of_sexp: this constructor requires arguments") sexp -;; +(* Errors concerning sum types *) -let nested_list_invalid_sum loc sexp = - of_sexp_error (loc ^ "_of_sexp: expected a variant type, saw a nested list") sexp -;; +let stag_no_args = simple_error "this constructor does not take arguments" -let empty_list_invalid_sum loc sexp = - of_sexp_error (loc ^ "_of_sexp: expected a variant type, saw an empty list") sexp +let stag_incorrect_n_args loc tag sexp = + error ~loc ~sexp (sprintf "sum tag %S has incorrect number of arguments" tag) ;; -let unexpected_stag loc sexp = - of_sexp_error (loc ^ "_of_sexp: unexpected variant constructor") sexp -;; +let stag_takes_args = simple_error "this constructor requires arguments" +let nested_list_invalid_sum = simple_error "expected a variant type, saw a nested list" +let empty_list_invalid_sum = simple_error "expected a variant type, saw an empty list" +let unexpected_stag = simple_error "unexpected variant constructor" (* Errors concerning records *) -let record_sexp_bool_with_payload loc sexp = - let msg = - loc ^ "_of_sexp: record conversion: a [sexp.bool] field was given a payload." - in - of_sexp_error msg sexp +let record_sexp_bool_with_payload = + simple_error "record conversion: a [sexp.bool] field was given a payload." ;; -let record_only_pairs_expected loc sexp = - let msg = - loc - ^ "_of_sexp: record conversion: only pairs expected, their first element must be an \ - atom" - in - of_sexp_error msg sexp +let record_only_pairs_expected = + simple_error + "record conversion: only pairs expected, their first element must be an atom" ;; -let record_superfluous_fields ~what ~loc rev_fld_names sexp = - let fld_names_str = String.concat (List.rev rev_fld_names) ~sep:" " in - let msg = sprintf "%s_of_sexp: %s: %s" loc what fld_names_str in - of_sexp_error msg sexp +let record_invalid_fields ~what ~loc fld_names sexp = + let fld_names_str = String.concat fld_names ~sep:" " in + error ~loc ~sexp (sprintf "%s: %s" what fld_names_str) ;; -let record_duplicate_fields loc rev_fld_names sexp = - record_superfluous_fields ~what:"duplicate fields" ~loc rev_fld_names sexp +let record_duplicate_fields loc fld_names sexp = + record_invalid_fields ~what:"duplicate fields" ~loc fld_names sexp ;; -let record_extra_fields loc rev_fld_names sexp = - record_superfluous_fields ~what:"extra fields" ~loc rev_fld_names sexp +let record_extra_fields loc fld_names sexp = + record_invalid_fields ~what:"extra fields" ~loc fld_names sexp ;; let rec record_get_undefined_loop fields = function @@ -80,23 +73,14 @@ let record_undefined_elements loc sexp lst = let undefined = record_get_undefined_loop [] lst in - let msg = - sprintf "%s_of_sexp: the following record elements were undefined: %s" loc undefined - in - of_sexp_error msg sexp + let msg = sprintf "the following record elements were undefined: %s" undefined in + error ~loc ~sexp msg ;; -let record_list_instead_atom loc sexp = - let msg = loc ^ "_of_sexp: list instead of atom for record expected" in - of_sexp_error msg sexp -;; +let record_list_instead_atom = simple_error "list instead of atom for record expected" -let record_poly_field_value loc sexp = - let msg = - loc - ^ "_of_sexp: cannot convert values of types resulting from polymorphic record fields" - in - of_sexp_error msg sexp +let record_poly_field_value = + simple_error "cannot convert values of types resulting from polymorphic record fields" ;; (* Errors concerning polymorphic variants *) @@ -104,37 +88,24 @@ exception No_variant_match let no_variant_match () = raise No_variant_match - -let no_matching_variant_found loc sexp = - of_sexp_error (loc ^ "_of_sexp: no matching variant found") sexp -;; - -let ptag_no_args loc sexp = - of_sexp_error (loc ^ "_of_sexp: polymorphic variant does not take arguments") sexp -;; +let no_matching_variant_found = simple_error "no matching variant found" +let ptag_no_args = simple_error "polymorphic variant does not take arguments" let ptag_incorrect_n_args loc cnstr sexp = - let msg = - sprintf - "%s_of_sexp: polymorphic variant tag %S has incorrect number of arguments" - loc - cnstr - in - of_sexp_error msg sexp + error + ~loc + ~sexp + (sprintf "polymorphic variant tag %S has incorrect number of arguments" cnstr) ;; -let ptag_takes_args loc sexp = - of_sexp_error (loc ^ "_of_sexp: polymorphic variant tag takes an argument") sexp -;; +let ptag_takes_args = simple_error "polymorphic variant tag takes an argument" -let nested_list_invalid_poly_var loc sexp = - of_sexp_error (loc ^ "_of_sexp: a nested list is an invalid polymorphic variant") sexp +let nested_list_invalid_poly_var = + simple_error "a nested list is an invalid polymorphic variant" ;; -let empty_list_invalid_poly_var loc sexp = - of_sexp_error (loc ^ "_of_sexp: the empty list is an invalid polymorphic variant") sexp +let empty_list_invalid_poly_var = + simple_error "the empty list is an invalid polymorphic variant" ;; -let empty_type loc sexp = - of_sexp_error (loc ^ "_of_sexp: trying to convert an empty type") sexp -;; +let empty_type = simple_error "trying to convert an empty type" diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/ocaml-sexplib0-0.16.0/src/sexp_conv_labeled_tuple.ml new/ocaml-sexplib0-0.17.0/src/sexp_conv_labeled_tuple.ml --- old/ocaml-sexplib0-0.16.0/src/sexp_conv_labeled_tuple.ml 1970-01-01 01:00:00.000000000 +0100 +++ new/ocaml-sexplib0-0.17.0/src/sexp_conv_labeled_tuple.ml 2024-04-29 17:42:10.000000000 +0200 @@ -0,0 +1,56 @@ +module Fields = struct + type _ t = + | Field : + { name : string + ; conv : Sexp.t -> 'a + ; rest : 'b t + } + -> ('a * 'b) t + | Empty : unit t + + let rec length_loop : type a. a t -> int -> int = + fun t acc -> + match t with + | Empty -> acc + | Field field -> length_loop field.rest (acc + 1) + ;; + + let length t = length_loop t 0 +end + +let[@tail_mod_cons] rec of_list + : type a. + caller:string + -> fields:a Fields.t + -> len:int + -> original_sexp:Sexp.t + -> pos:int + -> Sexp.t list + -> a + = + fun ~caller ~fields ~len ~original_sexp ~pos list -> + match fields with + | Empty -> + (match list with + | [] -> () + | _ :: _ -> Sexp_conv_error.tuple_of_size_n_expected caller len original_sexp) + | Field { name; conv; rest } -> + (match list with + | [] -> Sexp_conv_error.tuple_of_size_n_expected caller len original_sexp + | sexp :: list -> + (match sexp with + | List [ Atom atom; sexp ] -> + if String.equal atom name + then + ( conv sexp + , of_list ~caller ~fields:rest ~len ~original_sexp ~pos:(pos + 1) list ) + else Sexp_conv_error.tuple_incorrect_label caller name pos original_sexp + | _ -> Sexp_conv_error.tuple_pair_expected caller name sexp)) +;; + +let labeled_tuple_of_sexp ~caller ~fields ~create original_sexp = + let len = Fields.length fields in + match (original_sexp : Sexp.t) with + | Atom _ -> Sexp_conv_error.tuple_of_size_n_expected caller len original_sexp + | List list -> create (of_list ~caller ~fields ~len ~original_sexp ~pos:0 list) +;; diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/ocaml-sexplib0-0.16.0/src/sexp_conv_labeled_tuple.mli new/ocaml-sexplib0-0.17.0/src/sexp_conv_labeled_tuple.mli --- old/ocaml-sexplib0-0.16.0/src/sexp_conv_labeled_tuple.mli 1970-01-01 01:00:00.000000000 +0100 +++ new/ocaml-sexplib0-0.17.0/src/sexp_conv_labeled_tuple.mli 2024-04-29 17:42:10.000000000 +0200 @@ -0,0 +1,21 @@ +(* Parses sexps for labeled tuples, a language feature currently only implemented in Jane + Street's experimental branch of the compiler + (https://github.com/ocaml-flambda/flambda-backend/). *) + +module Fields : sig + type _ t = + | Field : + { name : string + ; conv : Sexp.t -> 'a + ; rest : 'b t + } + -> ('a * 'b) t + | Empty : unit t +end + +val labeled_tuple_of_sexp + : caller:string + -> fields:'a Fields.t + -> create:('a -> 'b) + -> Sexp.t + -> 'b diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/ocaml-sexplib0-0.16.0/src/sexp_conv_record.ml new/ocaml-sexplib0-0.17.0/src/sexp_conv_record.ml --- old/ocaml-sexplib0-0.16.0/src/sexp_conv_record.ml 2023-04-25 15:12:25.000000000 +0200 +++ new/ocaml-sexplib0-0.17.0/src/sexp_conv_record.ml 2024-04-29 17:42:10.000000000 +0200 @@ -27,9 +27,9 @@ 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 + match t with + | Field { rest; _ } -> length_loop rest (acc + 1) + | Empty -> acc in fun t -> length_loop t 0 ;; @@ -63,8 +63,8 @@ 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 + | Extras names -> record_extra_fields caller names context + | Dups names -> record_duplicate_fields caller names context | Missing names -> List.map names ~f:(fun name -> true, name) |> record_undefined_elements caller context @@ -264,13 +264,13 @@ (* Entry points. *) let record_of_sexps - ~caller - ~context - ~fields - ~index_of_field - ~allow_extra_fields - ~create - 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 diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/ocaml-sexplib0-0.16.0/src/sexp_grammar.ml new/ocaml-sexplib0-0.17.0/src/sexp_grammar.ml --- old/ocaml-sexplib0-0.16.0/src/sexp_grammar.ml 2023-04-25 15:12:25.000000000 +0200 +++ new/ocaml-sexplib0-0.17.0/src/sexp_grammar.ml 2024-04-29 17:42:10.000000000 +0200 @@ -29,12 +29,12 @@ | Variant of variant (** accepts clauses keyed by a leading or sole atom *) | Union of grammar list (** accepts a sexp if any of the listed grammars accepts it *) | Tagged of grammar with_tag - (** annotates a grammar with a client-specific key/value pair *) + (** annotates a grammar with a client-specific key/value pair *) | Tyvar of string - (** Name of a type variable, e.g. [Tyvar "a"] for ['a]. Only meaningful when the body of + (** 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 * defn list - (** Type constructor applied to arguments, and its definition. + (** Type constructor applied to arguments, and its definition. 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 @@ -92,18 +92,18 @@ 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. + (** 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 + (** Lazily computed grammar. Use [Lazy] to avoid top-level side effects. To define recursive grammars, use [Recursive] instead. *) (** Grammar of a list of sexps. *) and list_grammar = | Empty (** accepts an empty list of sexps *) | Cons of grammar * list_grammar - (** accepts a non-empty list with head and tail matching the given grammars *) + (** accepts a non-empty list with head and tail matching the given grammars *) | Many of grammar (** accepts zero or more sexps, each matching the given grammar *) | Fields of record (** accepts sexps representing fields of a record *) @@ -112,7 +112,7 @@ | Case_insensitive (** Comparison is case insensitive. Used for custom parsers. *) | Case_sensitive (** Comparison is case sensitive. Used for polymorphic variants. *) | Case_sensitive_except_first_character - (** Comparison is case insensitive for the first character and case sensitive afterward. + (** Comparison is case insensitive for the first character and case sensitive afterward. Used for regular variants. *) (** Grammar of variants. Accepts any sexp matching one of the clauses. *) diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/ocaml-sexplib0-0.16.0/src/sexplib0.ml new/ocaml-sexplib0-0.17.0/src/sexplib0.ml --- old/ocaml-sexplib0-0.16.0/src/sexplib0.ml 2023-04-25 15:12:25.000000000 +0200 +++ new/ocaml-sexplib0-0.17.0/src/sexplib0.ml 2024-04-29 17:42:10.000000000 +0200 @@ -2,5 +2,6 @@ module Sexp_conv = Sexp_conv module Sexp_conv_error = Sexp_conv_error module Sexp_conv_record = Sexp_conv_record +module Sexp_conv_labeled_tuple = Sexp_conv_labeled_tuple module Sexp_grammar = Sexp_grammar module Sexpable = Sexpable diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/ocaml-sexplib0-0.16.0/test/dune new/ocaml-sexplib0-0.17.0/test/dune --- old/ocaml-sexplib0-0.16.0/test/dune 2023-04-25 15:12:25.000000000 +0200 +++ new/ocaml-sexplib0-0.17.0/test/dune 2024-04-29 17:42:10.000000000 +0200 @@ -1,4 +1,5 @@ -(library (name sexplib0_test) +(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 + (pps ppx_compare ppx_expect ppx_here ppx_sexp_conv ppx_sexp_value))) diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/ocaml-sexplib0-0.16.0/test/sexplib0_test.ml new/ocaml-sexplib0-0.17.0/test/sexplib0_test.ml --- old/ocaml-sexplib0-0.16.0/test/sexplib0_test.ml 2023-04-25 15:12:25.000000000 +0200 +++ new/ocaml-sexplib0-0.17.0/test/sexplib0_test.ml 2024-04-29 17:42:10.000000000 +0200 @@ -56,7 +56,8 @@ (Error (Of_sexp_error "M.t_of_sexp: duplicate fields: x y" - (invalid_sexp ((x 1) (x 2) (y 3) (y 4))))) |}]; + (invalid_sexp ((x 1) (x 2) (y 3) (y 4))))) + |}]; (* extra fields *) test "((a 1) (b 2) (c 3))"; [%expect @@ -64,7 +65,8 @@ (Error (Of_sexp_error "M.t_of_sexp: extra fields: a b c" - (invalid_sexp ((a 1) (b 2) (c 3))))) |}]; + (invalid_sexp ((a 1) (b 2) (c 3))))) + |}]; (* missing field *) test "((x 1))"; [%expect @@ -72,7 +74,8 @@ (Error (Of_sexp_error "M.t_of_sexp: the following record elements were undefined: y" - (invalid_sexp ((x 1))))) |}]; + (invalid_sexp ((x 1))))) + |}]; (* other missing field *) test "((y 2))"; [%expect @@ -80,7 +83,8 @@ (Error (Of_sexp_error "M.t_of_sexp: the following record elements were undefined: x" - (invalid_sexp ((y 2))))) |}]; + (invalid_sexp ((y 2))))) + |}]; (* multiple missing fields *) test "()"; [%expect @@ -88,7 +92,8 @@ (Error (Of_sexp_error "M.t_of_sexp: the following record elements were undefined: x y" - (invalid_sexp ()))) |}]; + (invalid_sexp ()))) + |}]; () ;; @@ -137,7 +142,8 @@ (Error (Of_sexp_error "M.t_of_sexp: the following record elements were undefined: y" - (invalid_sexp ((x 1))))) |}]; + (invalid_sexp ((x 1))))) + |}]; (* other missing field *) test "((y 2))"; [%expect @@ -145,7 +151,8 @@ (Error (Of_sexp_error "M.t_of_sexp: the following record elements were undefined: x" - (invalid_sexp ((y 2))))) |}]; + (invalid_sexp ((y 2))))) + |}]; (* multiple missing fields *) test "()"; [%expect @@ -153,7 +160,8 @@ (Error (Of_sexp_error "M.t_of_sexp: the following record elements were undefined: x y" - (invalid_sexp ()))) |}]; + (invalid_sexp ()))) + |}]; () ;; @@ -204,7 +212,8 @@ (Error (Of_sexp_error "M.t_of_sexp: extra fields: z" - (invalid_sexp ((x 1) (y 2) (z 3))))) |}]; + (invalid_sexp ((x 1) (y 2) (z 3))))) + |}]; (* missing field *) test "((x 1))"; [%expect {| (Ok ((x 1) (y 0))) |}]; @@ -264,7 +273,8 @@ (Error (Of_sexp_error "M.t_of_sexp: extra fields: z" - (invalid_sexp ((a (1)) (b (2 3)) (z ()))))) |}]; + (invalid_sexp ((a (1)) (b (2 3)) (z ()))))) + |}]; (* missing field *) test "((a (1)))"; [%expect {| (Ok ((a (1)) (b ()))) |}]; @@ -348,7 +358,8 @@ (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)))))) |}]; + (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))) |}]; @@ -379,24 +390,24 @@ ; kind = Required ; conv = (fun sexp -> - { a = - list_of_sexp - (Sexplib.Conv_error.record_poly_field_value caller) - 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 - }) + { 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 } }) @@ -423,7 +434,8 @@ (Error (Of_sexp_error "M.t_of_sexp: cannot convert values of types resulting from polymorphic record fields" - (invalid_sexp _))) |}]; + (invalid_sexp _))) + |}]; (* attempt to deserialize first parameter to [b] *) test "((a ()) (b ((Ok _))))"; [%expect @@ -431,7 +443,8 @@ (Error (Of_sexp_error "M.t_of_sexp: cannot convert values of types resulting from polymorphic record fields" - (invalid_sexp _))) |}]; + (invalid_sexp _))) + |}]; (* attempt to deserialize second parameter to [b] *) test "((a ()) (b ((Error _))))"; [%expect @@ -439,7 +452,8 @@ (Error (Of_sexp_error "M.t_of_sexp: cannot convert values of types resulting from polymorphic record fields" - (invalid_sexp _))) |}]; + (invalid_sexp _))) + |}]; (* multiple missing fields *) test "()"; [%expect @@ -447,6 +461,18 @@ (Error (Of_sexp_error "M.t_of_sexp: the following record elements were undefined: a b" - (invalid_sexp ()))) |}]; + (invalid_sexp ()))) + |}]; () ;; + +let%expect_test _ = + let big_string = String.init 5_000_000 ~f:(fun i -> String.get (Int.to_string i) 0) in + let sexp = [%sexp (big_string : string)] in + let sexp_string = + (* In an experimental compiler version, this would overflow the stack. *) + Sexp.to_string sexp + in + print_endline (Int.to_string_hum (String.length sexp_string)); + [%expect {| 5_000_000 |}] +;;
