This commit is contained in:
parent
aa2ff7b2f0
commit
2f3113f55d
11742 changed files with 1223940 additions and 0 deletions
6
unikernel/duniverse/ppx_sexp_conv/test/dune
Normal file
6
unikernel/duniverse/ppx_sexp_conv/test/dune
Normal file
|
|
@ -0,0 +1,6 @@
|
|||
(library
|
||||
(name ppx_sexp_conv_test)
|
||||
(libraries base expect_test_helpers_core sexplib)
|
||||
(flags :standard -w -30)
|
||||
(preprocess
|
||||
(pps ppxlib ppx_sexp_conv ppx_compare ppx_here ppx_inline_test ppx_expect)))
|
||||
284
unikernel/duniverse/ppx_sexp_conv/test/errors.mlt
Normal file
284
unikernel/duniverse/ppx_sexp_conv/test/errors.mlt
Normal file
|
|
@ -0,0 +1,284 @@
|
|||
type t = { a : int [@sexp_drop_default] [@sexp.omit_nil] } [@@deriving sexp_of]
|
||||
|
||||
[%%expect
|
||||
{|
|
||||
Line _, characters _-_:
|
||||
Error: The following elements are mutually exclusive: sexp.sexp_drop_default sexp.omit_nil
|
||||
|}]
|
||||
|
||||
type t = { a : int list [@sexp.list] [@sexp.omit_nil] } [@@deriving sexp_of]
|
||||
|
||||
[%%expect
|
||||
{|
|
||||
Line _, characters _-_:
|
||||
Error: The following elements are mutually exclusive: sexp.omit_nil [@sexp.list]
|
||||
|}]
|
||||
|
||||
type t = { a : int [@default 0] [@sexp.omit_nil] } [@@deriving of_sexp]
|
||||
|
||||
[%%expect
|
||||
{|
|
||||
Line _, characters _-_:
|
||||
Error: The following elements are mutually exclusive: sexp.default sexp.omit_nil
|
||||
|}]
|
||||
|
||||
type t = int [@@deriving sexp] [@@sexp.allow_extra_fields]
|
||||
|
||||
[%%expect
|
||||
{|
|
||||
Line _, characters _-_:
|
||||
Error: ppx_sexp_conv: [@@allow_extra_fields] is only allowed on records.
|
||||
|}]
|
||||
|
||||
type 'a t = 'a option =
|
||||
| None
|
||||
| Some of 'a
|
||||
[@@deriving sexp] [@@sexp.allow_extra_fields]
|
||||
|
||||
[%%expect
|
||||
{|
|
||||
Line _, characters _-_:
|
||||
Error: ppx_sexp_conv: [@@allow_extra_fields] is only allowed on records.
|
||||
|}]
|
||||
|
||||
type 'a t = Some of { a : int } [@@deriving sexp] [@@sexp.allow_extra_fields]
|
||||
|
||||
[%%expect
|
||||
{|
|
||||
Line _, characters _-_:
|
||||
Error: ppx_sexp_conv: [@@allow_extra_fields] only works on records. For inline records, do: type t = A of { a : int } [@allow_extra_fields] | B [@@deriving sexp]
|
||||
|}]
|
||||
|
||||
type 'a t =
|
||||
| Some of { a : int }
|
||||
| None [@sexp.allow_extra_fields]
|
||||
[@@deriving sexp]
|
||||
|
||||
[%%expect
|
||||
{|
|
||||
Line _, characters _-_:
|
||||
Error: ppx_sexp_conv: [@allow_extra_fields] is only allowed on inline records.
|
||||
|}]
|
||||
|
||||
type t =
|
||||
| Non
|
||||
| Som of { next : t [@default Non] [@sexp_drop_default.equal] }
|
||||
[@@deriving sexp]
|
||||
|
||||
[%%expect
|
||||
{|
|
||||
Line _, characters _-_:
|
||||
Error: [@sexp_drop_default.equal] was used, but the type of the field contains a type defined in the current recursive block: t.
|
||||
This is not supported.
|
||||
Consider using [@sexp_drop_if _] or [@sexp_drop_default.sexp] instead.
|
||||
|}]
|
||||
|
||||
type nonrec 'a t = { foo : 'a option [@default None] [@sexp_drop_default.equal] }
|
||||
[@@deriving sexp]
|
||||
|
||||
[%%expect
|
||||
{|
|
||||
Line _, characters _-_:
|
||||
Error: [@sexp_drop_default.equal] was used, but the type of the field contains a type variable: 'a.
|
||||
Comparison is not avaiable for type variables.
|
||||
Consider using [@sexp_drop_if _] or [@sexp_drop_default.sexp] instead.
|
||||
|}]
|
||||
|
||||
open Base
|
||||
|
||||
type t = { a : int [@default 8] [@sexp_drop_default] } [@@deriving sexp_of]
|
||||
|
||||
[%%expect
|
||||
{|
|
||||
Line _, characters _-_:
|
||||
Error (warning 22 [preprocessor]): [@sexp_drop_default] is deprecated: please use one of:
|
||||
- [@sexp_drop_default f] and give an explicit equality function ([f = Poly.(=)] corresponds to the old behavior)
|
||||
- [@sexp_drop_default.compare] if the type supports [%compare]
|
||||
- [@sexp_drop_default.equal] if the type supports [%equal]
|
||||
- [@sexp_drop_default.sexp] if you want to compare the sexp representations
|
||||
|}]
|
||||
|
||||
type t = { x : unit [@sexp.opaque] } [@@deriving sexp_of]
|
||||
type t = { x : unit [@sexp.opaque] } [@@deriving of_sexp]
|
||||
type t = { x : unit [@sexp.opaque] } [@@deriving sexp_grammar]
|
||||
|
||||
[%%expect
|
||||
{|
|
||||
Line _, characters _-_:
|
||||
Error: Attribute `sexp.opaque' was not used.
|
||||
Hint: `sexp.opaque' is available for core types but is used here in
|
||||
the
|
||||
context of a label declaration.
|
||||
Did you put it at the wrong level?
|
||||
|
||||
Line _, characters _-_:
|
||||
Error: Attribute `sexp.opaque' was not used.
|
||||
Hint: `sexp.opaque' is available for core types but is used here in
|
||||
the
|
||||
context of a label declaration.
|
||||
Did you put it at the wrong level?
|
||||
|
||||
Line _, characters _-_:
|
||||
Error: Attribute `sexp.opaque' was not used.
|
||||
Hint: `sexp.opaque' is available for core types but is used here in
|
||||
the
|
||||
context of a label declaration.
|
||||
Did you put it at the wrong level?
|
||||
|}]
|
||||
|
||||
type t = { x : unit [@sexp.option] } [@@deriving sexp_of]
|
||||
type t = { x : unit [@sexp.option] } [@@deriving of_sexp]
|
||||
type t = { x : unit [@sexp.option] } [@@deriving sexp_grammar]
|
||||
|
||||
[%%expect
|
||||
{|
|
||||
Line _, characters _-_:
|
||||
Error: ppx_sexp_conv: [@sexp.option] is only allowed on type [_ option].
|
||||
|
||||
Line _, characters _-_:
|
||||
Error: ppx_sexp_conv: [@sexp.option] is only allowed on type [_ option].
|
||||
|
||||
Line _, characters _-_:
|
||||
Error: ppx_sexp_conv: [@sexp.option] is only allowed on type [_ option].
|
||||
|}]
|
||||
|
||||
type t = { x : unit [@sexp.list] } [@@deriving sexp_of]
|
||||
type t = { x : unit [@sexp.list] } [@@deriving of_sexp]
|
||||
type t = { x : unit [@sexp.list] } [@@deriving sexp_grammar]
|
||||
|
||||
[%%expect
|
||||
{|
|
||||
Line _, characters _-_:
|
||||
Error: ppx_sexp_conv: [@sexp.list] is only allowed on type [_ list].
|
||||
|
||||
Line _, characters _-_:
|
||||
Error: ppx_sexp_conv: [@sexp.list] is only allowed on type [_ list].
|
||||
|
||||
Line _, characters _-_:
|
||||
Error: ppx_sexp_conv: [@sexp.list] is only allowed on type [_ list].
|
||||
|}]
|
||||
|
||||
type t = { x : unit [@sexp.array] } [@@deriving sexp_of]
|
||||
type t = { x : unit [@sexp.array] } [@@deriving of_sexp]
|
||||
type t = { x : unit [@sexp.array] } [@@deriving sexp_grammar]
|
||||
|
||||
[%%expect
|
||||
{|
|
||||
Line _, characters _-_:
|
||||
Error: ppx_sexp_conv: [@sexp.array] is only allowed on type [_ array].
|
||||
|
||||
Line _, characters _-_:
|
||||
Error: ppx_sexp_conv: [@sexp.array] is only allowed on type [_ array].
|
||||
|
||||
Line _, characters _-_:
|
||||
Error: ppx_sexp_conv: [@sexp.array] is only allowed on type [_ array].
|
||||
|}]
|
||||
|
||||
type t = { x : unit [@sexp.bool] } [@@deriving sexp_of]
|
||||
type t = { x : unit [@sexp.bool] } [@@deriving of_sexp]
|
||||
type t = { x : unit [@sexp.bool] } [@@deriving sexp_grammar]
|
||||
|
||||
[%%expect
|
||||
{|
|
||||
Line _, characters _-_:
|
||||
Error: ppx_sexp_conv: [@sexp.bool] is only allowed on type [bool].
|
||||
|
||||
Line _, characters _-_:
|
||||
Error: ppx_sexp_conv: [@sexp.bool] is only allowed on type [bool].
|
||||
|
||||
Line _, characters _-_:
|
||||
Error: ppx_sexp_conv: [@sexp.bool] is only allowed on type [bool].
|
||||
|}]
|
||||
|
||||
type t = A of unit [@sexp.list] [@@deriving sexp_of]
|
||||
type t = A of unit [@sexp.list] [@@deriving of_sexp]
|
||||
type t = A of unit [@sexp.list] [@@deriving sexp_grammar]
|
||||
|
||||
[%%expect
|
||||
{|
|
||||
Line _, characters _-_:
|
||||
Error: ppx_sexp_conv: [@sexp.list] is only allowed on type [_ list].
|
||||
|
||||
Line _, characters _-_:
|
||||
Error: ppx_sexp_conv: [@sexp.list] is only allowed on type [_ list].
|
||||
|
||||
Line _, characters _-_:
|
||||
Error: ppx_sexp_conv: [@sexp.list] is only allowed on type [_ list].
|
||||
|}]
|
||||
|
||||
type t = [ `A of unit [@sexp.list] ] [@@deriving sexp_of]
|
||||
type t = [ `A of unit [@sexp.list] ] [@@deriving of_sexp]
|
||||
type t = [ `A of unit [@sexp.list] ] [@@deriving sexp_grammar]
|
||||
|
||||
[%%expect
|
||||
{|
|
||||
Line _, characters _-_:
|
||||
Error: ppx_sexp_conv: [@sexp.list] is only allowed on type [_ list].
|
||||
|
||||
Line _, characters _-_:
|
||||
Error: ppx_sexp_conv: [@sexp.list] is only allowed on type [_ list].
|
||||
|
||||
Line _, characters _-_:
|
||||
Error: ppx_sexp_conv: [@sexp.list] is only allowed on type [_ list].
|
||||
|}]
|
||||
|
||||
let (_ : _) = [%sexp_grammar: 'k -> 'v -> ('k * 'v) list]
|
||||
|
||||
[%%expect {| |}]
|
||||
|
||||
let (_ : _) = [%sexp_grammar: < for_all : 'k 'v. ('k * 'v) list > ]
|
||||
|
||||
[%%expect
|
||||
{|
|
||||
Line _, characters _-_:
|
||||
Error: sexp_grammar: object types are unsupported
|
||||
|}]
|
||||
|
||||
let (_ : _) = [%sexp_grammar: < other : 'k 'v. ('k * 'v) list > ]
|
||||
|
||||
[%%expect
|
||||
{|
|
||||
Line _, characters _-_:
|
||||
Error: sexp_grammar: object types are unsupported
|
||||
|}]
|
||||
|
||||
type t = < for_all : 'k 'v. ('k * 'v) list > [@@deriving sexp_grammar]
|
||||
|
||||
[%%expect
|
||||
{|
|
||||
Line _, characters _-_:
|
||||
Error: sexp_grammar: object types are unsupported
|
||||
|}]
|
||||
|
||||
type t = < other : 'k 'v. ('k * 'v) list > [@@deriving sexp_grammar]
|
||||
|
||||
[%%expect
|
||||
{|
|
||||
Line _, characters _-_:
|
||||
Error: sexp_grammar: object types are unsupported
|
||||
|}]
|
||||
|
||||
type t = T : 'a -> t [@@deriving sexp_grammar]
|
||||
|
||||
[%%expect
|
||||
{|
|
||||
Line _, characters _-_:
|
||||
Error: Unbound value _'a_sexp_grammar
|
||||
Hint: Did you mean char_sexp_grammar, int_sexp_grammar or ref_sexp_grammar?
|
||||
|}]
|
||||
|
||||
(* If we can sensibly derive [sexp_grammar], we might as well, because the user might
|
||||
still be able to pair it with a consistent hand-written [t_of_sexp]. *)
|
||||
type _ t = T : int -> string t [@@deriving sexp_grammar]
|
||||
|
||||
[%%expect {| |}]
|
||||
|
||||
type _ t = T : int -> string t [@@deriving of_sexp]
|
||||
|
||||
[%%expect
|
||||
{|
|
||||
Line _, characters _-_:
|
||||
Error: This expression has type string t
|
||||
but an expression was expected of type a__098_ t
|
||||
Type string is not compatible with type a__098_
|
||||
|}]
|
||||
67
unikernel/duniverse/ppx_sexp_conv/test/examples.mlt
Normal file
67
unikernel/duniverse/ppx_sexp_conv/test/examples.mlt
Normal file
|
|
@ -0,0 +1,67 @@
|
|||
module Position_for_polymorphic_variant_errors = struct
|
||||
type t1 = [ `A ] [@@deriving of_sexp]
|
||||
type t2 = [ `B ] [@@deriving of_sexp]
|
||||
type t3 = A of [ t1 | t2 ] [@@deriving of_sexp]
|
||||
|
||||
let (_ : t3) = t3_of_sexp (List [ Atom "A"; Atom "C" ])
|
||||
end
|
||||
|
||||
[%%expect
|
||||
{|
|
||||
Exception:
|
||||
(Of_sexp_error
|
||||
"examples.mlt.Position_for_polymorphic_variant_errors.t3_of_sexp: no matching variant found"
|
||||
(invalid_sexp C))
|
||||
|}]
|
||||
|
||||
let _ = [%sexp_of: 'a]
|
||||
|
||||
[%%expect
|
||||
{|
|
||||
Line _, characters _-_:
|
||||
Error: ppx_sexp_conv: unbound type variable 'a
|
||||
|}]
|
||||
|
||||
let _ = [%of_sexp: 'a]
|
||||
|
||||
[%%expect
|
||||
{|
|
||||
Line _, characters _-_:
|
||||
Error: ppx_sexp_conv: unbound type variable 'a
|
||||
|}]
|
||||
|
||||
let _ = [%sexp (() : 'a)]
|
||||
|
||||
[%%expect
|
||||
{|
|
||||
Line _, characters _-_:
|
||||
Error: ppx_sexp_conv: unbound type variable 'a
|
||||
|}]
|
||||
|
||||
type 'a t =
|
||||
| None
|
||||
| Something_else of { value : 'a }
|
||||
[@@deriving sexp]
|
||||
|
||||
[%%expect {| |}]
|
||||
|
||||
module Record_with_defaults = struct
|
||||
open Sexplib0.Sexp_conv
|
||||
|
||||
let a_field = "a_field"
|
||||
let b_field = "b_field"
|
||||
|
||||
type record_with_defaults =
|
||||
{ a : string [@default a_field]
|
||||
; b : string [@default b_field]
|
||||
}
|
||||
[@@deriving of_sexp]
|
||||
end
|
||||
|
||||
[%%expect {| |}]
|
||||
|
||||
module Polymorphic_recursion = struct
|
||||
type 'a t = T of 'a t t [@@deriving sexp_grammar]
|
||||
end
|
||||
|
||||
[%%expect {| |}]
|
||||
1696
unikernel/duniverse/ppx_sexp_conv/test/expansion.ml
Normal file
1696
unikernel/duniverse/ppx_sexp_conv/test/expansion.ml
Normal file
File diff suppressed because it is too large
Load diff
450
unikernel/duniverse/ppx_sexp_conv/test/expansion.mli
Normal file
450
unikernel/duniverse/ppx_sexp_conv/test/expansion.mli
Normal file
|
|
@ -0,0 +1,450 @@
|
|||
open! Base
|
||||
|
||||
module Abstract : sig
|
||||
type t [@@deriving_inline sexp]
|
||||
|
||||
include sig
|
||||
[@@@ocaml.warning "-32"]
|
||||
|
||||
include Sexplib0.Sexpable.S with type t := t
|
||||
end
|
||||
[@@ocaml.doc "@inline"]
|
||||
|
||||
[@@@end]
|
||||
end
|
||||
|
||||
module Tuple : sig
|
||||
type t = int * int * int [@@deriving_inline sexp]
|
||||
|
||||
include sig
|
||||
[@@@ocaml.warning "-32"]
|
||||
|
||||
include Sexplib0.Sexpable.S with type t := t
|
||||
end
|
||||
[@@ocaml.doc "@inline"]
|
||||
|
||||
[@@@end]
|
||||
end
|
||||
|
||||
module Record : sig
|
||||
type t =
|
||||
{ a : int
|
||||
; b : int
|
||||
; c : int
|
||||
}
|
||||
[@@deriving_inline sexp]
|
||||
|
||||
include sig
|
||||
[@@@ocaml.warning "-32"]
|
||||
|
||||
include Sexplib0.Sexpable.S with type t := t
|
||||
end
|
||||
[@@ocaml.doc "@inline"]
|
||||
|
||||
[@@@end]
|
||||
end
|
||||
|
||||
module Mutable_record : sig
|
||||
type t =
|
||||
{ mutable a : int
|
||||
; mutable b : int
|
||||
; mutable c : int
|
||||
}
|
||||
[@@deriving_inline sexp]
|
||||
|
||||
include sig
|
||||
[@@@ocaml.warning "-32"]
|
||||
|
||||
include Sexplib0.Sexpable.S with type t := t
|
||||
end
|
||||
[@@ocaml.doc "@inline"]
|
||||
|
||||
[@@@end]
|
||||
end
|
||||
|
||||
module Variant : sig
|
||||
type t =
|
||||
| A
|
||||
| B of int * int
|
||||
| C of
|
||||
{ a : int
|
||||
; b : int
|
||||
; d : int
|
||||
}
|
||||
| D of
|
||||
{ mutable a : int
|
||||
; mutable b : int
|
||||
; mutable t : int
|
||||
}
|
||||
[@@deriving_inline sexp]
|
||||
|
||||
include sig
|
||||
[@@@ocaml.warning "-32"]
|
||||
|
||||
include Sexplib0.Sexpable.S with type t := t
|
||||
end
|
||||
[@@ocaml.doc "@inline"]
|
||||
|
||||
[@@@end]
|
||||
end
|
||||
|
||||
module Poly_variant : sig
|
||||
type t =
|
||||
[ `A
|
||||
| `B of int
|
||||
]
|
||||
[@@deriving_inline sexp]
|
||||
|
||||
include sig
|
||||
[@@@ocaml.warning "-32"]
|
||||
|
||||
val sexp_of_t : t -> Sexplib0.Sexp.t
|
||||
val t_of_sexp : Sexplib0.Sexp.t -> t
|
||||
val __t_of_sexp__ : Sexplib0.Sexp.t -> t
|
||||
end
|
||||
[@@ocaml.doc "@inline"]
|
||||
|
||||
[@@@end]
|
||||
end
|
||||
|
||||
module Inline_poly_variant : sig
|
||||
type t =
|
||||
[ Poly_variant.t
|
||||
| `C of int * int
|
||||
]
|
||||
[@@deriving_inline sexp]
|
||||
|
||||
include sig
|
||||
[@@@ocaml.warning "-32"]
|
||||
|
||||
val sexp_of_t : t -> Sexplib0.Sexp.t
|
||||
val t_of_sexp : Sexplib0.Sexp.t -> t
|
||||
val __t_of_sexp__ : Sexplib0.Sexp.t -> t
|
||||
end
|
||||
[@@ocaml.doc "@inline"]
|
||||
|
||||
[@@@end]
|
||||
end
|
||||
|
||||
module Recursive : sig
|
||||
type t =
|
||||
| Banana of t
|
||||
| Orange
|
||||
[@@deriving_inline sexp]
|
||||
|
||||
include sig
|
||||
[@@@ocaml.warning "-32"]
|
||||
|
||||
include Sexplib0.Sexpable.S with type t := t
|
||||
end
|
||||
[@@ocaml.doc "@inline"]
|
||||
|
||||
[@@@end]
|
||||
end
|
||||
|
||||
module Nonrecursive : sig
|
||||
open Recursive
|
||||
|
||||
type nonrec t = t [@@deriving_inline sexp]
|
||||
|
||||
include sig
|
||||
[@@@ocaml.warning "-32"]
|
||||
|
||||
include Sexplib0.Sexpable.S with type t := t
|
||||
end
|
||||
[@@ocaml.doc "@inline"]
|
||||
|
||||
[@@@end]
|
||||
end
|
||||
|
||||
module Mutually_recursive : sig
|
||||
type a =
|
||||
| A
|
||||
| B of b
|
||||
| C of
|
||||
{ a : a
|
||||
; b : b
|
||||
; c : c
|
||||
}
|
||||
|
||||
and b =
|
||||
{ a : a
|
||||
; b : b
|
||||
}
|
||||
|
||||
and c = a [@@deriving_inline sexp]
|
||||
|
||||
include sig
|
||||
[@@@ocaml.warning "-32"]
|
||||
|
||||
val sexp_of_a : a -> Sexplib0.Sexp.t
|
||||
val sexp_of_b : b -> Sexplib0.Sexp.t
|
||||
val sexp_of_c : c -> Sexplib0.Sexp.t
|
||||
val a_of_sexp : Sexplib0.Sexp.t -> a
|
||||
val b_of_sexp : Sexplib0.Sexp.t -> b
|
||||
val c_of_sexp : Sexplib0.Sexp.t -> c
|
||||
end
|
||||
[@@ocaml.doc "@inline"]
|
||||
|
||||
[@@@end]
|
||||
end
|
||||
|
||||
module Alias : sig
|
||||
type t = Recursive.t [@@deriving_inline sexp]
|
||||
|
||||
include sig
|
||||
[@@@ocaml.warning "-32"]
|
||||
|
||||
include Sexplib0.Sexpable.S with type t := t
|
||||
end
|
||||
[@@ocaml.doc "@inline"]
|
||||
|
||||
[@@@end]
|
||||
end
|
||||
|
||||
module Re_export : sig
|
||||
type t = Recursive.t =
|
||||
| Banana of t
|
||||
| Orange
|
||||
[@@deriving_inline sexp]
|
||||
|
||||
include sig
|
||||
[@@@ocaml.warning "-32"]
|
||||
|
||||
include Sexplib0.Sexpable.S with type t := t
|
||||
end
|
||||
[@@ocaml.doc "@inline"]
|
||||
|
||||
[@@@end]
|
||||
end
|
||||
|
||||
module Unary : sig
|
||||
type 'a t = 'a list option [@@deriving_inline sexp]
|
||||
|
||||
include sig
|
||||
[@@@ocaml.warning "-32"]
|
||||
|
||||
include Sexplib0.Sexpable.S1 with type 'a t := 'a t
|
||||
end
|
||||
[@@ocaml.doc "@inline"]
|
||||
|
||||
[@@@end]
|
||||
end
|
||||
|
||||
module Binary : sig
|
||||
type ('a, 'b) t = ('a, 'b) Either.t [@@deriving_inline sexp]
|
||||
|
||||
include sig
|
||||
[@@@ocaml.warning "-32"]
|
||||
|
||||
include Sexplib0.Sexpable.S2 with type ('a, 'b) t := ('a, 'b) t
|
||||
end
|
||||
[@@ocaml.doc "@inline"]
|
||||
|
||||
[@@@end]
|
||||
end
|
||||
|
||||
module First_order : sig
|
||||
type 'a t = 'a -> 'a [@@deriving_inline sexp]
|
||||
|
||||
include sig
|
||||
[@@@ocaml.warning "-32"]
|
||||
|
||||
include Sexplib0.Sexpable.S1 with type 'a t := 'a t
|
||||
end
|
||||
[@@ocaml.doc "@inline"]
|
||||
|
||||
[@@@end]
|
||||
end
|
||||
|
||||
module Second_order : sig
|
||||
type ('a, 'b) t = ('a -> 'a) -> ('a -> 'b) -> ('b -> 'b) -> 'a -> 'b
|
||||
[@@deriving_inline sexp]
|
||||
|
||||
include sig
|
||||
[@@@ocaml.warning "-32"]
|
||||
|
||||
include Sexplib0.Sexpable.S2 with type ('a, 'b) t := ('a, 'b) t
|
||||
end
|
||||
[@@ocaml.doc "@inline"]
|
||||
|
||||
[@@@end]
|
||||
end
|
||||
|
||||
module Named_arguments : sig
|
||||
type t = ?a:int -> b:int -> int -> int [@@deriving_inline sexp]
|
||||
|
||||
include sig
|
||||
[@@@ocaml.warning "-32"]
|
||||
|
||||
include Sexplib0.Sexpable.S with type t := t
|
||||
end
|
||||
[@@ocaml.doc "@inline"]
|
||||
|
||||
[@@@end]
|
||||
end
|
||||
|
||||
module Gadt : sig
|
||||
type _ t =
|
||||
| A : _ option t
|
||||
| B : int -> int t
|
||||
| C : 'a list -> unit t
|
||||
[@@deriving_inline sexp_of]
|
||||
|
||||
include sig
|
||||
[@@@ocaml.warning "-32"]
|
||||
|
||||
val sexp_of_t : ('a__001_ -> Sexplib0.Sexp.t) -> 'a__001_ t -> Sexplib0.Sexp.t
|
||||
end
|
||||
[@@ocaml.doc "@inline"]
|
||||
|
||||
[@@@end]
|
||||
end
|
||||
|
||||
module Recursive_record_containing_variant : sig
|
||||
type t =
|
||||
{ a : [ `A of t ]
|
||||
; b : [ `B ]
|
||||
}
|
||||
[@@deriving_inline sexp]
|
||||
|
||||
include sig
|
||||
[@@@ocaml.warning "-32"]
|
||||
|
||||
include Sexplib0.Sexpable.S with type t := t
|
||||
end
|
||||
[@@ocaml.doc "@inline"]
|
||||
|
||||
[@@@end]
|
||||
end
|
||||
|
||||
module Poly_record : sig
|
||||
type t =
|
||||
{ a : 'a. 'a list
|
||||
; b : 'b. 'b option
|
||||
; c : 'c. 'c
|
||||
}
|
||||
[@@deriving_inline sexp]
|
||||
|
||||
include sig
|
||||
[@@@ocaml.warning "-32"]
|
||||
|
||||
include Sexplib0.Sexpable.S with type t := t
|
||||
end
|
||||
[@@ocaml.doc "@inline"]
|
||||
|
||||
[@@@end]
|
||||
end
|
||||
|
||||
module Record_with_defaults : sig
|
||||
type t =
|
||||
{ a : int
|
||||
; b : int
|
||||
; c : int
|
||||
; d : int
|
||||
; e : int
|
||||
; f : int
|
||||
}
|
||||
[@@deriving_inline sexp]
|
||||
|
||||
include sig
|
||||
[@@@ocaml.warning "-32"]
|
||||
|
||||
include Sexplib0.Sexpable.S with type t := t
|
||||
end
|
||||
[@@ocaml.doc "@inline"]
|
||||
|
||||
[@@@end]
|
||||
end
|
||||
|
||||
module Record_with_special_types : sig
|
||||
type t =
|
||||
{ a : int option
|
||||
; b : int list
|
||||
; c : int array
|
||||
; d : bool
|
||||
}
|
||||
[@@deriving_inline sexp]
|
||||
|
||||
include sig
|
||||
[@@@ocaml.warning "-32"]
|
||||
|
||||
include Sexplib0.Sexpable.S with type t := t
|
||||
end
|
||||
[@@ocaml.doc "@inline"]
|
||||
|
||||
[@@@end]
|
||||
end
|
||||
|
||||
module Record_with_omit_nil : sig
|
||||
type t =
|
||||
{ a : int option
|
||||
; b : int list
|
||||
; c : unit
|
||||
; d : int
|
||||
}
|
||||
[@@deriving_inline sexp]
|
||||
|
||||
include sig
|
||||
[@@@ocaml.warning "-32"]
|
||||
|
||||
include Sexplib0.Sexpable.S with type t := t
|
||||
end
|
||||
[@@ocaml.doc "@inline"]
|
||||
|
||||
[@@@end]
|
||||
end
|
||||
|
||||
module Variant_with_sexp_list : sig
|
||||
type t = A of int list [@@deriving_inline sexp]
|
||||
|
||||
include sig
|
||||
[@@@ocaml.warning "-32"]
|
||||
|
||||
include Sexplib0.Sexpable.S with type t := t
|
||||
end
|
||||
[@@ocaml.doc "@inline"]
|
||||
|
||||
[@@@end]
|
||||
end
|
||||
|
||||
module Poly_variant_with_sexp_list : sig
|
||||
type t = [ `A of int list ] [@@deriving_inline sexp]
|
||||
|
||||
include sig
|
||||
[@@@ocaml.warning "-32"]
|
||||
|
||||
val sexp_of_t : t -> Sexplib0.Sexp.t
|
||||
val t_of_sexp : Sexplib0.Sexp.t -> t
|
||||
val __t_of_sexp__ : Sexplib0.Sexp.t -> t
|
||||
end
|
||||
[@@ocaml.doc "@inline"]
|
||||
|
||||
[@@@end]
|
||||
end
|
||||
|
||||
module Record_allowing_extra_fields : sig
|
||||
type t = { a : int } [@@deriving_inline sexp]
|
||||
|
||||
include sig
|
||||
[@@@ocaml.warning "-32"]
|
||||
|
||||
include Sexplib0.Sexpable.S with type t := t
|
||||
end
|
||||
[@@ocaml.doc "@inline"]
|
||||
|
||||
[@@@end]
|
||||
end
|
||||
|
||||
module Opaque : sig
|
||||
type t = int list [@@deriving_inline sexp]
|
||||
|
||||
include sig
|
||||
[@@@ocaml.warning "-32"]
|
||||
|
||||
include Sexplib0.Sexpable.S with type t := t
|
||||
end
|
||||
[@@ocaml.doc "@inline"]
|
||||
|
||||
[@@@end]
|
||||
end
|
||||
63
unikernel/duniverse/ppx_sexp_conv/test/lib/conv_test.ml
Normal file
63
unikernel/duniverse/ppx_sexp_conv/test/lib/conv_test.ml
Normal file
|
|
@ -0,0 +1,63 @@
|
|||
open Ppx_sexp_conv_lib
|
||||
open Conv
|
||||
|
||||
let%test_module "Exceptions" =
|
||||
(module struct
|
||||
let check_sexp exn string =
|
||||
match sexp_of_exn_opt exn with
|
||||
| None -> raise exn
|
||||
| Some sexp ->
|
||||
let sexp_as_string = Ppx_sexp_conv_lib.Sexp.to_string sexp in
|
||||
if sexp_as_string <> string then failwith sexp_as_string
|
||||
;;
|
||||
|
||||
(* first global exceptions, checking different arities since they
|
||||
don't have the same representation *)
|
||||
exception Arg0 [@@deriving sexp]
|
||||
exception Arg1 of int [@@deriving sexp]
|
||||
exception Arg2 of int * int [@@deriving sexp]
|
||||
|
||||
let%test_unit _ = check_sexp Arg0 "conv_test.ml.Arg0"
|
||||
let%test_unit _ = check_sexp (Arg1 1) "(conv_test.ml.Arg1 1)"
|
||||
let%test_unit _ = check_sexp (Arg2 (2, 3)) "(conv_test.ml.Arg2 2 3)"
|
||||
|
||||
(* now local exceptions *)
|
||||
let exn (type a) a sexp_of_a =
|
||||
let module M = struct
|
||||
exception E of a [@@deriving sexp]
|
||||
end
|
||||
in
|
||||
M.E a
|
||||
;;
|
||||
|
||||
let%test_unit "incompatible exceptions with the same name" =
|
||||
let e_int = exn 1 sexp_of_int in
|
||||
let e_string = exn "a" sexp_of_string in
|
||||
check_sexp e_int "(conv_test.ml.E 1)";
|
||||
check_sexp e_string "(conv_test.ml.E a)"
|
||||
;;
|
||||
|
||||
let%test_unit "sexp converters are finalized properly for local exceptions" =
|
||||
Gc.compact ();
|
||||
Gc.compact ();
|
||||
let size_before =
|
||||
Ppx_sexp_conv_lib.Conv.Exn_converter.For_unit_tests_only.size ()
|
||||
in
|
||||
let e = exn 2.5 sexp_of_float in
|
||||
let size_after_local_exn =
|
||||
Ppx_sexp_conv_lib.Conv.Exn_converter.For_unit_tests_only.size ()
|
||||
in
|
||||
let e_finalized = ref false in
|
||||
Gc.finalise (fun _ -> e_finalized := true) e;
|
||||
check_sexp e "(conv_test.ml.E 2.5)";
|
||||
Gc.compact ();
|
||||
Gc.compact ();
|
||||
assert !e_finalized;
|
||||
let size_after_gc =
|
||||
Ppx_sexp_conv_lib.Conv.Exn_converter.For_unit_tests_only.size ()
|
||||
in
|
||||
assert (size_before + 1 = size_after_local_exn);
|
||||
assert (size_before = size_after_gc)
|
||||
;;
|
||||
end)
|
||||
;;
|
||||
1
unikernel/duniverse/ppx_sexp_conv/test/lib/conv_test.mli
Normal file
1
unikernel/duniverse/ppx_sexp_conv/test/lib/conv_test.mli
Normal file
|
|
@ -0,0 +1 @@
|
|||
(*_ This signature is deliberately empty. *)
|
||||
5
unikernel/duniverse/ppx_sexp_conv/test/lib/dune
Normal file
5
unikernel/duniverse/ppx_sexp_conv/test/lib/dune
Normal file
|
|
@ -0,0 +1,5 @@
|
|||
(library
|
||||
(name ppx_sexp_conv_lib_test)
|
||||
(libraries ppx_sexp_conv_lib)
|
||||
(preprocess
|
||||
(pps ppxlib ppx_sexp_conv ppx_here ppx_inline_test)))
|
||||
118
unikernel/duniverse/ppx_sexp_conv/test/nonrec_test.ml
Normal file
118
unikernel/duniverse/ppx_sexp_conv/test/nonrec_test.ml
Normal file
|
|
@ -0,0 +1,118 @@
|
|||
open Ppx_sexp_conv_lib.Conv
|
||||
|
||||
type t = float [@@deriving sexp]
|
||||
|
||||
module M : sig
|
||||
type t = float list [@@deriving sexp]
|
||||
end = struct
|
||||
type nonrec t = t list [@@deriving sexp]
|
||||
end
|
||||
|
||||
type 'a u = 'a [@@deriving sexp]
|
||||
|
||||
module M2 : sig
|
||||
type 'a u = 'a list [@@deriving sexp]
|
||||
end = struct
|
||||
type nonrec 'a u = 'a u list [@@deriving sexp]
|
||||
end
|
||||
|
||||
type 'a v = 'a w
|
||||
and 'a w = A of 'a v [@@deriving sexp]
|
||||
|
||||
type 'a v_ = 'a v [@@deriving sexp]
|
||||
type 'a w_ = 'a w [@@deriving sexp]
|
||||
|
||||
module M3 : sig
|
||||
type 'a v = 'a w_ [@@deriving sexp]
|
||||
type 'a w = 'a v_ [@@deriving sexp]
|
||||
end = struct
|
||||
type nonrec 'a v = 'a w
|
||||
and 'a w = 'a v [@@deriving sexp]
|
||||
end
|
||||
|
||||
type t0 = A of t0 [@@deriving sexp]
|
||||
|
||||
module B : sig
|
||||
type nonrec t0 = t0 [@@deriving sexp]
|
||||
end = struct
|
||||
type nonrec t0 = t0 = A of t0 [@@deriving sexp]
|
||||
end
|
||||
|
||||
type t1 = A of t2
|
||||
and t2 = B of t1 [@@deriving sexp]
|
||||
|
||||
module C : sig
|
||||
type nonrec t1 = t1 [@@deriving sexp]
|
||||
type nonrec t2 = t2 [@@deriving sexp]
|
||||
end = struct
|
||||
type nonrec t1 = t1 = A of t2
|
||||
and t2 = t2 = B of t1 [@@deriving sexp]
|
||||
end
|
||||
|
||||
type 'a v1 = A of 'a v2
|
||||
and 'a v2 = B of 'a v1 [@@deriving sexp]
|
||||
|
||||
module D : sig
|
||||
type nonrec 'a v1 = 'a v1 [@@deriving sexp]
|
||||
type nonrec 'a v2 = 'a v2 [@@deriving sexp]
|
||||
end = struct
|
||||
type nonrec 'a v1 = 'a v1 = A of 'a v2
|
||||
and 'a v2 = 'a v2 = B of 'a v1 [@@deriving sexp]
|
||||
end
|
||||
|
||||
type +'a w1
|
||||
|
||||
module E = struct
|
||||
type nonrec +'a w1 = 'a w1
|
||||
end
|
||||
|
||||
type 'a y1 = A of 'a y2
|
||||
and 'a y2 = B of 'a y1
|
||||
|
||||
module F : sig
|
||||
type nonrec 'a y2 = B of 'a y1
|
||||
type nonrec 'a y1 = 'a y1
|
||||
end = struct
|
||||
type nonrec 'a y1 = 'a y1 = A of 'a y2
|
||||
and 'a y2 = B of 'a y1
|
||||
end
|
||||
|
||||
type z1 = A of z1
|
||||
|
||||
module G : sig
|
||||
module A : sig
|
||||
type z2 = A of z2
|
||||
end
|
||||
|
||||
module B : sig
|
||||
type z2 = A of z2
|
||||
end
|
||||
|
||||
module C : sig
|
||||
type z2 = A of z2
|
||||
end
|
||||
end = struct
|
||||
type z2 = z1 = A of z1
|
||||
|
||||
module A = struct
|
||||
type nonrec z2 = z1 = A of z2
|
||||
end
|
||||
|
||||
module B = struct
|
||||
type nonrec z2 = z2 = A of z2
|
||||
end
|
||||
|
||||
module C = struct
|
||||
type nonrec z2 = z2 = A of z1
|
||||
end
|
||||
end
|
||||
|
||||
type ('a, 'b) zz = A of 'a * 'b
|
||||
|
||||
module H = struct
|
||||
type nonrec ('a, 'b) zz = ('a, 'b) zz = A of 'a * 'b
|
||||
end
|
||||
|
||||
module I = struct
|
||||
type nonrec 'a zz = ('a, 'a) zz
|
||||
end
|
||||
889
unikernel/duniverse/ppx_sexp_conv/test/ppx_sexp_test.ml
Normal file
889
unikernel/duniverse/ppx_sexp_conv/test/ppx_sexp_test.ml
Normal file
|
|
@ -0,0 +1,889 @@
|
|||
open Ppx_sexp_conv_lib
|
||||
open Conv
|
||||
|
||||
(* Module names below are used in error messages being tested. *)
|
||||
[@@@warning "-unused-module"]
|
||||
|
||||
module Sum_and_polymorphic_variants = struct
|
||||
type poly =
|
||||
[ `No_arg
|
||||
| `One_arg of int
|
||||
| `One_tuple of int * string
|
||||
| `Two_args of int * string
|
||||
]
|
||||
[@@deriving sexp, sexp_grammar]
|
||||
|
||||
let%test_unit _ =
|
||||
List.iter
|
||||
(fun (value, sexp) ->
|
||||
assert (sexp_of_poly value = sexp);
|
||||
assert (poly_of_sexp sexp = value))
|
||||
[ `No_arg, Sexp.Atom "No_arg"
|
||||
; (`One_arg 1, Sexp.(List [ Atom "One_arg"; Atom "1" ]))
|
||||
; ( `One_tuple (1, "a")
|
||||
, Sexp.(List [ Atom "One_tuple"; List [ Atom "1"; Atom "a" ] ]) )
|
||||
; (`Two_args (1, "a"), Sexp.(List [ Atom "Two_args"; List [ Atom "1"; Atom "a" ] ]))
|
||||
]
|
||||
;;
|
||||
|
||||
type nominal =
|
||||
| No_arg
|
||||
| One_arg of int
|
||||
| One_tuple of (int * string)
|
||||
| Two_args of int * string
|
||||
[@@deriving sexp, sexp_grammar]
|
||||
|
||||
let%test_unit _ =
|
||||
List.iter
|
||||
(fun (value, sexp) ->
|
||||
assert (sexp_of_nominal value = sexp);
|
||||
assert (nominal_of_sexp sexp = value))
|
||||
[ No_arg, Sexp.Atom "No_arg"
|
||||
; (One_arg 1, Sexp.(List [ Atom "One_arg"; Atom "1" ]))
|
||||
; (One_tuple (1, "a"), Sexp.(List [ Atom "One_tuple"; List [ Atom "1"; Atom "a" ] ]))
|
||||
; (Two_args (1, "a"), Sexp.(List [ Atom "Two_args"; Atom "1"; Atom "a" ]))
|
||||
]
|
||||
;;
|
||||
end
|
||||
|
||||
module Records = struct
|
||||
type t =
|
||||
{ a : int
|
||||
; b : (float * string) list option
|
||||
}
|
||||
[@@deriving sexp, sexp_grammar]
|
||||
|
||||
let%test_unit _ =
|
||||
let t = { a = 2; b = Some [ 1., "a"; 2.3, "b" ] } in
|
||||
let sexp = Sexplib.Sexp.of_string "((a 2)(b (((1 a)(2.3 b)))))" in
|
||||
assert (t_of_sexp sexp = t);
|
||||
assert (sexp_of_t t = sexp)
|
||||
;;
|
||||
|
||||
let%expect_test _ =
|
||||
let sexp = Sexplib.Sexp.of_string "((a)(b ()))" in
|
||||
Expect_test_helpers_core.show_raise (fun () -> t_of_sexp sexp);
|
||||
[%expect
|
||||
{|
|
||||
(raised (
|
||||
Of_sexp_error
|
||||
"ppx_sexp_test.ml.Records.t_of_sexp: record conversion: only pairs expected, their first element must be an atom"
|
||||
(invalid_sexp ((a) (b ())))))
|
||||
|}]
|
||||
;;
|
||||
|
||||
let%expect_test _ =
|
||||
let sexp = Sexplib.Sexp.of_string "((a 1)(a))" in
|
||||
Expect_test_helpers_core.show_raise (fun () -> t_of_sexp sexp);
|
||||
[%expect
|
||||
{|
|
||||
(raised (
|
||||
Of_sexp_error
|
||||
"ppx_sexp_test.ml.Records.t_of_sexp: duplicate fields: a"
|
||||
(invalid_sexp ((a 1) (a)))))
|
||||
|}]
|
||||
;;
|
||||
|
||||
let%expect_test _ =
|
||||
let sexp = Sexplib.Sexp.of_string "((a 3 4))" in
|
||||
Expect_test_helpers_core.show_raise (fun () -> t_of_sexp sexp);
|
||||
[%expect
|
||||
{|
|
||||
(raised (
|
||||
Of_sexp_error
|
||||
"ppx_sexp_test.ml.Records.t_of_sexp: record conversion: only pairs expected, their first element must be an atom"
|
||||
(invalid_sexp (a 3 4))))
|
||||
|}]
|
||||
;;
|
||||
|
||||
let%expect_test _ =
|
||||
let sexp = Sexplib.Sexp.of_string "((c 3))" in
|
||||
Expect_test_helpers_core.show_raise (fun () -> t_of_sexp sexp);
|
||||
[%expect
|
||||
{|
|
||||
(raised (
|
||||
Of_sexp_error
|
||||
"ppx_sexp_test.ml.Records.t_of_sexp: extra fields: c"
|
||||
(invalid_sexp ((c 3)))))
|
||||
|}]
|
||||
;;
|
||||
end
|
||||
|
||||
module Inline_records = struct
|
||||
type t =
|
||||
| A of
|
||||
{ a : int
|
||||
; b : (float * string) list option
|
||||
}
|
||||
| B of int
|
||||
[@@deriving sexp, sexp_grammar]
|
||||
|
||||
let%test_unit _ =
|
||||
let t = A { a = 2; b = Some [ 1., "a"; 2.3, "b" ] } in
|
||||
let sexp = Sexplib.Sexp.of_string "(A (a 2)(b (((1 a)(2.3 b)))))" in
|
||||
assert (t_of_sexp sexp = t);
|
||||
assert (sexp_of_t t = sexp)
|
||||
;;
|
||||
end
|
||||
|
||||
module User_specified_conversion = struct
|
||||
type my_float = float
|
||||
|
||||
let sexp_of_my_float n = Sexp.Atom (Printf.sprintf "%.4f" n)
|
||||
let my_float_of_sexp = float_of_sexp
|
||||
|
||||
let%test_unit _ =
|
||||
let my_float : my_float = 1.2 in
|
||||
let sexp = Sexp.Atom "1.2000" in
|
||||
assert (my_float_of_sexp sexp = my_float);
|
||||
assert (sexp_of_my_float my_float = sexp)
|
||||
;;
|
||||
end
|
||||
|
||||
module Exceptions : sig
|
||||
(* no sexp_grammars for exceptions, as they can't be parsed *)
|
||||
exception E0 [@@deriving sexp]
|
||||
exception E1 of string [@@deriving sexp]
|
||||
exception E2 of string * int [@@deriving sexp]
|
||||
exception E_tuple of (string * int) [@@deriving sexp]
|
||||
|
||||
exception
|
||||
E_record of
|
||||
{ a : string
|
||||
; b : int
|
||||
}
|
||||
[@@deriving sexp]
|
||||
end = struct
|
||||
exception E0 [@@deriving sexp]
|
||||
exception E1 of string [@@deriving sexp]
|
||||
exception E2 of string * int [@@deriving sexp]
|
||||
exception E_tuple of (string * int) [@@deriving sexp]
|
||||
|
||||
exception
|
||||
E_record of
|
||||
{ a : string
|
||||
; b : int
|
||||
}
|
||||
[@@deriving sexp]
|
||||
|
||||
let%test_unit _ =
|
||||
let cases =
|
||||
[ E0, "ppx_sexp_test.ml.Exceptions.E0"
|
||||
; E1 "a", "(ppx_sexp_test.ml.Exceptions.E1 a)"
|
||||
; E2 ("b", 2), "(ppx_sexp_test.ml.Exceptions.E2 b 2)"
|
||||
; E_tuple ("c", 3), "(ppx_sexp_test.ml.Exceptions.E_tuple(c 3))"
|
||||
; E_record { a = "c"; b = 3 }, "(ppx_sexp_test.ml.Exceptions.E_record(a c)(b 3))"
|
||||
]
|
||||
in
|
||||
List.iter
|
||||
(fun (exn, sexp_as_str) ->
|
||||
let sexp = Sexplib.Sexp.of_string sexp_as_str in
|
||||
assert ([%sexp_of: exn] exn = sexp))
|
||||
cases
|
||||
;;
|
||||
end
|
||||
|
||||
module Abstract_types_are_allowed_in_structures : sig
|
||||
type t [@@deriving sexp, sexp_grammar]
|
||||
end = struct
|
||||
type t [@@deriving sexp, sexp_grammar]
|
||||
end
|
||||
|
||||
module Manifest_types = struct
|
||||
type a = { t : int }
|
||||
type b = a = { t : int } [@@deriving sexp, sexp_grammar]
|
||||
end
|
||||
|
||||
module Uses_of_exn = struct
|
||||
type t = int * exn [@@deriving sexp_of]
|
||||
end
|
||||
|
||||
module Function_types : sig
|
||||
type t1 = int -> unit [@@deriving sexp, sexp_grammar]
|
||||
type t2 = label:int -> ?optional:int -> unit -> unit [@@deriving sexp, sexp_grammar]
|
||||
end = struct
|
||||
type t1 = int -> unit [@@deriving sexp, sexp_grammar]
|
||||
type t2 = label:int -> ?optional:int -> unit -> unit [@@deriving sexp, sexp_grammar]
|
||||
end
|
||||
|
||||
module No_unused_rec = struct
|
||||
type r = { r : int } [@@deriving sexp, sexp_grammar]
|
||||
end
|
||||
|
||||
module Field_name_should_not_be_rewritten = struct
|
||||
open No_unused_rec
|
||||
|
||||
type nonrec r = { r : r }
|
||||
|
||||
let _ = fun (r : r) -> r.r
|
||||
end
|
||||
|
||||
module Polymorphic_variant_inclusion = struct
|
||||
type sub1 =
|
||||
[ `C1
|
||||
| `C2
|
||||
]
|
||||
[@@deriving sexp, sexp_grammar]
|
||||
|
||||
type 'b sub2 =
|
||||
[ `C4
|
||||
| `C5 of 'b
|
||||
]
|
||||
[@@deriving sexp, sexp_grammar]
|
||||
|
||||
type ('a, 'b) t = [ sub1 | `C3 of [ `Nested of 'a ] | 'b sub2 | `C6 ] option
|
||||
[@@deriving sexp, sexp_grammar]
|
||||
|
||||
let%test_unit _ =
|
||||
let cases : ((string * string, float) t * _) list =
|
||||
[ None, "()"
|
||||
; Some `C1, "(C1)"
|
||||
; Some `C2, "(C2)"
|
||||
; Some (`C3 (`Nested ("a", "b"))), "((C3 (Nested (a b))))"
|
||||
; Some `C4, "(C4)"
|
||||
; Some (`C5 1.5), "((C5 1.5))"
|
||||
; Some `C6, "(C6)"
|
||||
]
|
||||
in
|
||||
List.iter
|
||||
(fun (t, sexp_as_str) ->
|
||||
let sexp = Sexplib.Sexp.of_string sexp_as_str in
|
||||
assert ([%of_sexp: (string * string, float) t] sexp = t);
|
||||
assert ([%sexp_of: (string * string, float) t] t = sexp))
|
||||
cases
|
||||
;;
|
||||
|
||||
type sub1_alias = sub1 [@@deriving sexp_poly, sexp_grammar]
|
||||
|
||||
type u =
|
||||
[ `A
|
||||
| sub1_alias
|
||||
| `D
|
||||
]
|
||||
[@@deriving sexp, sexp_grammar]
|
||||
|
||||
let%test_unit _ =
|
||||
let cases : (u * _) list = [ `A, "A"; `C1, "C1"; `C2, "C2"; `D, "D" ] in
|
||||
List.iter
|
||||
(fun (u, sexp_as_str) ->
|
||||
let sexp = Sexplib.Sexp.of_string sexp_as_str in
|
||||
assert ([%of_sexp: u] sexp = u);
|
||||
assert ([%sexp_of: u] u = sexp))
|
||||
cases
|
||||
;;
|
||||
end
|
||||
|
||||
module Polymorphic_record_field = struct
|
||||
type 'x t =
|
||||
{ poly : 'a 'b. 'a list
|
||||
; maybe_x : 'x option
|
||||
}
|
||||
[@@deriving sexp]
|
||||
|
||||
let%test_unit _ =
|
||||
let t x = { poly = []; maybe_x = Some x } in
|
||||
let sexp = Sexplib.Sexp.of_string "((poly ())(maybe_x (1)))" in
|
||||
assert (t_of_sexp int_of_sexp sexp = t 1);
|
||||
assert (sexp_of_t sexp_of_int (t 1) = sexp)
|
||||
;;
|
||||
end
|
||||
|
||||
module No_unused_value_warnings : sig end = struct
|
||||
module No_warning : sig
|
||||
type t = [ `A ] [@@deriving sexp, sexp_grammar]
|
||||
end = struct
|
||||
type t = [ `A ] [@@deriving sexp, sexp_grammar]
|
||||
end
|
||||
|
||||
module Empty = struct end
|
||||
|
||||
module No_warning2 (X : sig
|
||||
type t [@@deriving sexp, sexp_grammar]
|
||||
end) =
|
||||
struct end
|
||||
|
||||
(* this one can't be handled (what if Empty was a functor, huh?) *)
|
||||
(* module No_warning3(X : sig type t with sexp end) = Empty *)
|
||||
module type S = sig
|
||||
type t = [ `A ] [@@deriving sexp, sexp_grammar]
|
||||
end
|
||||
|
||||
module No_warning4 : S = struct
|
||||
type t = [ `A ] [@@deriving sexp, sexp_grammar]
|
||||
end
|
||||
|
||||
module No_warning5 : S = (
|
||||
(
|
||||
struct
|
||||
type t = [ `A ] [@@deriving sexp, sexp_grammar]
|
||||
end :
|
||||
S) :
|
||||
S)
|
||||
|
||||
module Nested_functors (M1 : sig
|
||||
type t [@@deriving sexp, sexp_grammar]
|
||||
end) (M2 : sig
|
||||
type t [@@deriving sexp, sexp_grammar]
|
||||
end) =
|
||||
struct end
|
||||
|
||||
let () =
|
||||
let module M : sig
|
||||
type t [@@deriving sexp, sexp_grammar]
|
||||
end = struct
|
||||
type t [@@deriving sexp, sexp_grammar]
|
||||
end
|
||||
in
|
||||
()
|
||||
;;
|
||||
|
||||
module Include = struct
|
||||
include (
|
||||
struct
|
||||
type t = int [@@deriving sexp, sexp_grammar]
|
||||
end :
|
||||
sig
|
||||
type t [@@deriving sexp, sexp_grammar]
|
||||
end
|
||||
with type t := int)
|
||||
end
|
||||
end
|
||||
|
||||
module Default = struct
|
||||
type t = { a : int [@default 2] } [@@deriving sexp, sexp_grammar]
|
||||
|
||||
let%test _ = Sexp.(List [ List [ Atom "a"; Atom "1" ] ]) = sexp_of_t { a = 1 }
|
||||
let%test _ = Sexp.(List [ List [ Atom "a"; Atom "2" ] ]) = sexp_of_t { a = 2 }
|
||||
let%test _ = t_of_sexp Sexp.(List [ List [ Atom "a"; Atom "1" ] ]) = { a = 1 }
|
||||
let%test _ = t_of_sexp Sexp.(List [ List [ Atom "a"; Atom "2" ] ]) = { a = 2 }
|
||||
let%test _ = t_of_sexp Sexp.(List []) = { a = 2 }
|
||||
end
|
||||
|
||||
module Type_alias = struct
|
||||
(* checking that the [as 'a] is supported and ignored in signatures, that it still
|
||||
exports the sexp_of_t__ when needed *)
|
||||
module B : sig
|
||||
type a = [ `A ]
|
||||
type t = [ `A ] as 'a constraint 'a = a [@@deriving sexp, sexp_grammar]
|
||||
end = struct
|
||||
type a = [ `A ] [@@deriving sexp, sexp_grammar]
|
||||
type t = [ `A ] [@@deriving sexp, sexp_grammar]
|
||||
end
|
||||
|
||||
let%test _ = Sexp.to_string (B.sexp_of_t `A) = "A"
|
||||
let%test _ = `A = B.t_of_sexp (Sexplib.Sexp.of_string "A")
|
||||
|
||||
module B2 = struct
|
||||
type t =
|
||||
[ B.t
|
||||
| `B
|
||||
]
|
||||
[@@deriving sexp, sexp_grammar]
|
||||
end
|
||||
|
||||
module C : sig
|
||||
type t = int as 'a [@@deriving sexp, sexp_grammar]
|
||||
end = struct
|
||||
type t = int [@@deriving sexp, sexp_grammar]
|
||||
end
|
||||
|
||||
module D : sig
|
||||
type t = 'a constraint 'a = int [@@deriving sexp, sexp_grammar]
|
||||
end = struct
|
||||
type t = int [@@deriving sexp, sexp_grammar]
|
||||
end
|
||||
end
|
||||
|
||||
module Tricky_variants = struct
|
||||
(* Checking that the generated code compiles (there used to be a problem with subtyping
|
||||
constraints preventing proper generalization). *)
|
||||
type t = [ `a ] [@@deriving sexp, sexp_grammar]
|
||||
type 'a u = [ t | `b of 'a ] * int [@@deriving sexp, sexp_grammar]
|
||||
end
|
||||
|
||||
module Drop_default = struct
|
||||
open! Base
|
||||
open Expect_test_helpers_core
|
||||
|
||||
type t = { a : int } [@@deriving equal]
|
||||
|
||||
let test ?cr t_of_sexp sexp_of_t =
|
||||
let ( = ) = Sexp.( = ) in
|
||||
require ?cr [%here] (Sexp.(List [ List [ Atom "a"; Atom "1" ] ]) = sexp_of_t { a = 1 });
|
||||
require ?cr [%here] (Sexp.(List []) = sexp_of_t { a = 2 });
|
||||
let ( = ) = equal in
|
||||
require ?cr [%here] (t_of_sexp Sexp.(List [ List [ Atom "a"; Atom "1" ] ]) = { a = 1 });
|
||||
require ?cr [%here] (t_of_sexp Sexp.(List [ List [ Atom "a"; Atom "2" ] ]) = { a = 2 });
|
||||
require ?cr [%here] (t_of_sexp Sexp.(List []) = { a = 2 })
|
||||
;;
|
||||
|
||||
type my_int = int [@@deriving sexp, sexp_grammar]
|
||||
|
||||
module Poly = struct
|
||||
type nonrec t = t = { a : my_int [@default 2] [@sexp_drop_default Poly.( = )] }
|
||||
[@@deriving sexp, sexp_grammar]
|
||||
|
||||
let%test_unit _ = test t_of_sexp sexp_of_t
|
||||
end
|
||||
|
||||
module Equal = struct
|
||||
let equal_my_int = equal_int
|
||||
|
||||
type nonrec t = t = { a : my_int [@default 2] [@sexp_drop_default.equal] }
|
||||
[@@deriving sexp, sexp_grammar]
|
||||
|
||||
let%test_unit _ = test t_of_sexp sexp_of_t
|
||||
end
|
||||
|
||||
module Compare = struct
|
||||
let compare_my_int = compare_int
|
||||
|
||||
type nonrec t = t = { a : my_int [@default 2] [@sexp_drop_default.compare] }
|
||||
[@@deriving sexp, sexp_grammar]
|
||||
|
||||
let%test_unit _ = test t_of_sexp sexp_of_t
|
||||
end
|
||||
|
||||
module Sexp = struct
|
||||
type nonrec t = t = { a : my_int [@default 2] [@sexp_drop_default.sexp] }
|
||||
[@@deriving sexp, sexp_grammar]
|
||||
|
||||
let%test_unit _ = test t_of_sexp sexp_of_t
|
||||
end
|
||||
end
|
||||
|
||||
module Drop_if = struct
|
||||
type t = { a : int [@default 2] [@sexp_drop_if fun x -> x mod 2 = 0] }
|
||||
[@@deriving sexp, sexp_grammar]
|
||||
|
||||
let%test _ = Sexp.(List [ List [ Atom "a"; Atom "1" ] ]) = sexp_of_t { a = 1 }
|
||||
let%test _ = Sexp.(List []) = sexp_of_t { a = 2 }
|
||||
let%test _ = Sexp.(List [ List [ Atom "a"; Atom "3" ] ]) = sexp_of_t { a = 3 }
|
||||
let%test _ = Sexp.(List []) = sexp_of_t { a = 4 }
|
||||
let%test _ = t_of_sexp Sexp.(List [ List [ Atom "a"; Atom "1" ] ]) = { a = 1 }
|
||||
let%test _ = t_of_sexp Sexp.(List [ List [ Atom "a"; Atom "2" ] ]) = { a = 2 }
|
||||
let%test _ = t_of_sexp Sexp.(List [ List [ Atom "a"; Atom "3" ] ]) = { a = 3 }
|
||||
let%test _ = t_of_sexp Sexp.(List [ List [ Atom "a"; Atom "4" ] ]) = { a = 4 }
|
||||
let%test _ = t_of_sexp Sexp.(List []) = { a = 2 }
|
||||
|
||||
type u =
|
||||
{ a : int
|
||||
[@sexp_drop_if
|
||||
fun x ->
|
||||
(* pa_type_conv used to drop parens altogether, causing type errors in the
|
||||
following code *)
|
||||
let pair = x, 2 in
|
||||
match Some pair with
|
||||
| None -> true
|
||||
| Some (x, y) -> x = y]
|
||||
}
|
||||
[@@deriving sexp, sexp_grammar]
|
||||
end
|
||||
|
||||
module Omit_nil = struct
|
||||
type natural_option = int
|
||||
|
||||
let sexp_of_natural_option i = if i >= 0 then sexp_of_int i else sexp_of_unit ()
|
||||
|
||||
let natural_option_of_sexp = function
|
||||
| Sexp.List [] -> -1
|
||||
| sexp -> int_of_sexp sexp
|
||||
;;
|
||||
|
||||
let natural_option_sexp_grammar : natural_option Sexplib0.Sexp_grammar.t =
|
||||
{ untyped = Union [ List Empty; Integer ] }
|
||||
;;
|
||||
|
||||
let check sexp_of_t t_of_sexp str t =
|
||||
let sexp = Sexplib.Sexp.of_string str in
|
||||
assert (sexp = sexp_of_t t);
|
||||
assert (t_of_sexp sexp = t)
|
||||
;;
|
||||
|
||||
type t = { a : natural_option [@sexp.omit_nil] } [@@deriving sexp, sexp_grammar]
|
||||
|
||||
let%test_unit _ = check sexp_of_t t_of_sexp "()" { a = -1 }
|
||||
let%test_unit _ = check sexp_of_t t_of_sexp "((a 1))" { a = 1 }
|
||||
|
||||
type t2 = A of { a : int list [@sexp.omit_nil] } [@@deriving sexp, sexp_grammar]
|
||||
|
||||
let%test_unit _ = check sexp_of_t2 t2_of_sexp "(A)" (A { a = [] })
|
||||
let%test_unit _ = check sexp_of_t2 t2_of_sexp "(A (a (1)))" (A { a = [ 1 ] })
|
||||
end
|
||||
|
||||
module No_unused_rec_warning = struct
|
||||
type r = { field : r -> unit } [@@deriving sexp_of]
|
||||
end
|
||||
|
||||
module True_and_false = struct
|
||||
type t =
|
||||
| True
|
||||
| False
|
||||
[@@deriving sexp, sexp_grammar]
|
||||
|
||||
let%test _ = Sexp.to_string (sexp_of_t True) = "True"
|
||||
let%test _ = Sexp.to_string (sexp_of_t False) = "False"
|
||||
let%test _ = True = t_of_sexp (Sexplib.Sexp.of_string "True")
|
||||
let%test _ = False = t_of_sexp (Sexplib.Sexp.of_string "False")
|
||||
let%test _ = True = t_of_sexp (Sexplib.Sexp.of_string "true")
|
||||
let%test _ = False = t_of_sexp (Sexplib.Sexp.of_string "false")
|
||||
|
||||
type u =
|
||||
| True of int
|
||||
| False of int
|
||||
[@@deriving sexp, sexp_grammar]
|
||||
|
||||
let%test _ = Sexp.to_string (sexp_of_u (True 1)) = "(True 1)"
|
||||
let%test _ = Sexp.to_string (sexp_of_u (False 2)) = "(False 2)"
|
||||
let%test _ = True 1 = u_of_sexp (Sexplib.Sexp.of_string "(True 1)")
|
||||
let%test _ = False 2 = u_of_sexp (Sexplib.Sexp.of_string "(False 2)")
|
||||
let%test _ = True 1 = u_of_sexp (Sexplib.Sexp.of_string "(true 1)")
|
||||
let%test _ = False 2 = u_of_sexp (Sexplib.Sexp.of_string "(false 2)")
|
||||
|
||||
exception True [@@deriving sexp]
|
||||
|
||||
let%test _ = "ppx_sexp_test.ml.True_and_false.True" = Sexp.to_string (sexp_of_exn True)
|
||||
|
||||
exception False of int [@@deriving sexp]
|
||||
|
||||
let%test _ =
|
||||
"(ppx_sexp_test.ml.True_and_false.False 1)" = Sexp.to_string (sexp_of_exn (False 1))
|
||||
;;
|
||||
|
||||
type v =
|
||||
[ `True
|
||||
| `False of int
|
||||
]
|
||||
[@@deriving sexp, sexp_grammar]
|
||||
|
||||
let%test _ = Sexp.to_string (sexp_of_v `True) = "True"
|
||||
let%test _ = Sexp.to_string (sexp_of_v (`False 2)) = "(False 2)"
|
||||
end
|
||||
|
||||
module Gadt = struct
|
||||
let is_eq sexp str =
|
||||
let sexp2 = Sexplib.Sexp.of_string str in
|
||||
if sexp <> sexp2
|
||||
then (
|
||||
Printf.printf "%S vs %S\n%!" (Sexp.to_string sexp) str;
|
||||
assert false)
|
||||
;;
|
||||
|
||||
(* plain type without argument *)
|
||||
type 'a s = Packed : 'a s [@@deriving sexp_of]
|
||||
|
||||
let%test_unit _ = is_eq ([%sexp_of: int s] Packed) "Packed"
|
||||
|
||||
(* two kind of existential variables *)
|
||||
type 'a t = Packed : 'a * _ * ('b[@sexp.opaque]) -> 'a t [@warning "-3"]
|
||||
[@@deriving sexp_of]
|
||||
|
||||
let%test_unit _ =
|
||||
is_eq ([%sexp_of: int t] (Packed (2, "asd", 1.))) "(Packed 2 _ <opaque>)"
|
||||
;;
|
||||
|
||||
(* plain type with argument *)
|
||||
type 'a u = A : 'a -> 'a u [@@deriving sexp_of]
|
||||
|
||||
let%test_unit _ = is_eq ([%sexp_of: int u] (A 2)) "(A 2)"
|
||||
|
||||
(* recursive *)
|
||||
type v = A : v option -> v [@@deriving sexp_of]
|
||||
|
||||
let%test_unit _ = is_eq ([%sexp_of: v] (A (Some (A None)))) "(A((A())))"
|
||||
|
||||
(* implicit existential variable *)
|
||||
type w = A : 'a * int * ('a -> string) -> w [@@deriving sexp_of]
|
||||
|
||||
let%test_unit _ = is_eq ([%sexp_of: w] (A (1., 2, string_of_float))) "(A _ 2 <fun>)"
|
||||
|
||||
(* tricky variable naming *)
|
||||
type 'a x = A : 'a -> 'b x [@@deriving sexp_of]
|
||||
|
||||
let%test_unit _ = is_eq ([%sexp_of: int x] (A 1.)) "(A _)"
|
||||
|
||||
(* interaction with inline record *)
|
||||
type _ x2 = A : { x : 'c } -> 'c x2 [@@deriving sexp_of]
|
||||
|
||||
let%test_unit _ = is_eq ([%sexp_of: int x2] (A { x = 1 })) "(A (x 1))"
|
||||
|
||||
(* unused but colliding variables *)
|
||||
type (_, _) y = A : ('a, 'a) y [@@deriving sexp_of]
|
||||
|
||||
let%test_unit _ = is_eq ([%sexp_of: (int, int) y] A) "A"
|
||||
|
||||
(* making sure we're not reversing parameters *)
|
||||
type (_, _) z = A : ('a * 'b) -> ('a, 'b) z [@@deriving sexp_of]
|
||||
|
||||
let%test_unit _ = is_eq ([%sexp_of: (int, string) z] (A (1, "a"))) "(A (1 a))"
|
||||
|
||||
(* interaction with universal quantifiers *)
|
||||
type _ z2 = A : { x : 'c. 'c option } -> 'c z2 [@@deriving sexp_of]
|
||||
|
||||
let%test_unit _ = is_eq ([%sexp_of: unit z2] (A { x = None })) "(A (x ()))"
|
||||
end
|
||||
|
||||
module Anonymous_variable = struct
|
||||
type _ t = int [@@deriving sexp, sexp_grammar]
|
||||
|
||||
let%test _ = Sexp.to_string ([%sexp_of: _ t] 2) = "2"
|
||||
let%test _ = [%of_sexp: _ t] (Sexplib.Sexp.of_string "2") = 2
|
||||
|
||||
(* making sure we don't generate signatures like (_ -> Sexp.t) -> _ t -> Sexp.t which
|
||||
are too general *)
|
||||
module M : sig
|
||||
type _ t [@@deriving sexp, sexp_grammar]
|
||||
end = struct
|
||||
type 'a t = 'a [@@deriving sexp, sexp_grammar]
|
||||
end
|
||||
end
|
||||
|
||||
module Record_field_disambiguation = struct
|
||||
type a =
|
||||
{ fl : float
|
||||
; b : b
|
||||
}
|
||||
|
||||
and b = { fl : int } [@@deriving sexp, sexp_grammar]
|
||||
end
|
||||
|
||||
module Private = struct
|
||||
type t = private int [@@deriving sexp_of]
|
||||
type ('a, 'b) u = private t [@@deriving sexp_of]
|
||||
type ('a, 'b, 'c) v = private ('a, 'b) u [@@deriving sexp_of]
|
||||
end
|
||||
|
||||
module Nonregular_types = struct
|
||||
type 'a nonregular =
|
||||
| Leaf of 'a
|
||||
| Branch of ('a * 'a) nonregular
|
||||
[@@deriving sexp, sexp_grammar]
|
||||
|
||||
type 'a variant = [ `A of 'a ] [@@deriving sexp, sexp_grammar]
|
||||
|
||||
type ('a, 'b) nonregular_with_variant =
|
||||
| Branch of ([ | 'a list variant ], 'b) nonregular_with_variant
|
||||
[@@deriving sexp, sexp_grammar]
|
||||
end
|
||||
|
||||
module Opaque = struct
|
||||
type t = (int[@sexp.opaque]) list [@@deriving sexp, sexp_grammar]
|
||||
|
||||
let sexp = Sexplib.Sexp.of_string "(<opaque> <opaque>)"
|
||||
let t = [ 1; 2 ]
|
||||
let%test _ = sexp_of_t t = sexp
|
||||
|
||||
let%test _ =
|
||||
match t_of_sexp sexp with
|
||||
| _ -> false
|
||||
| exception _ -> true
|
||||
;;
|
||||
|
||||
type u = ([ `A of int ][@sexp.opaque]) [@@deriving sexp, sexp_grammar]
|
||||
|
||||
let sexp = Sexplib.Sexp.of_string "<opaque>"
|
||||
let u = `A 1
|
||||
let%test _ = sexp_of_u u = sexp
|
||||
|
||||
let%test _ =
|
||||
match u_of_sexp sexp with
|
||||
| _ -> false
|
||||
| exception _ -> true
|
||||
;;
|
||||
end
|
||||
|
||||
module Optional = struct
|
||||
type t = { optional : int option [@sexp.option] } [@@deriving sexp, sexp_grammar]
|
||||
|
||||
let sexp = Sexplib.Sexp.of_string "()"
|
||||
let t = { optional = None }
|
||||
let%test _ = t_of_sexp sexp = t
|
||||
let%test _ = sexp_of_t t = sexp
|
||||
let sexp = Sexplib.Sexp.of_string "((optional 5))"
|
||||
let t = { optional = Some 5 }
|
||||
let%test _ = t_of_sexp sexp = t
|
||||
let%test _ = sexp_of_t t = sexp
|
||||
end
|
||||
|
||||
module Nonempty = struct
|
||||
type t =
|
||||
{ list : int list [@sexp.list]
|
||||
; array : int array [@sexp.array]
|
||||
}
|
||||
[@@deriving sexp, sexp_grammar]
|
||||
|
||||
let sexp = Sexplib.Sexp.of_string "()"
|
||||
let t = { list = []; array = [||] }
|
||||
let%test _ = t_of_sexp sexp = t
|
||||
let%test _ = sexp_of_t t = sexp
|
||||
let sexp = Sexplib.Sexp.of_string "((list (1 2 3)) (array (3 2 1)))"
|
||||
let t = { list = [ 1; 2; 3 ]; array = [| 3; 2; 1 |] }
|
||||
let%test _ = t_of_sexp sexp = t
|
||||
let%test _ = sexp_of_t t = sexp
|
||||
end
|
||||
|
||||
module Boolean = struct
|
||||
type t = { no_arg : bool [@sexp.bool] } [@@deriving sexp, sexp_grammar]
|
||||
|
||||
let sexp = Sexplib.Sexp.of_string "()"
|
||||
let t = { no_arg = false }
|
||||
let%test _ = t_of_sexp sexp = t
|
||||
let%test _ = sexp_of_t t = sexp
|
||||
let sexp = Sexplib.Sexp.of_string "((no_arg))"
|
||||
let t = { no_arg = true }
|
||||
let%test _ = t_of_sexp sexp = t
|
||||
let%test _ = sexp_of_t t = sexp
|
||||
|
||||
type t_allow_extra_fields = { no_arg : bool [@sexp.bool] }
|
||||
[@@deriving sexp, sexp_grammar] [@@sexp.allow_extra_fields]
|
||||
|
||||
let%expect_test _ =
|
||||
Expect_test_helpers_core.require_does_raise ~cr:CR_soon [%here] (fun () ->
|
||||
let r = t_allow_extra_fields_of_sexp (Sexplib.Sexp.of_string "((no_arg true))") in
|
||||
print_endline (Bool.to_string r.no_arg));
|
||||
[%expect
|
||||
{|
|
||||
(Of_sexp_error
|
||||
"ppx_sexp_test.ml.Boolean.t_allow_extra_fields_of_sexp: record conversion: a [sexp.bool] field was given a payload."
|
||||
(invalid_sexp ((no_arg true))))
|
||||
|}]
|
||||
;;
|
||||
end
|
||||
|
||||
module Inline = struct
|
||||
type t = A of int list [@sexp.list] [@@deriving sexp, sexp_grammar]
|
||||
|
||||
let sexp = Sexplib.Sexp.of_string "(A 1 2 3)"
|
||||
let t = A [ 1; 2; 3 ]
|
||||
let%test _ = t_of_sexp sexp = t
|
||||
let%test _ = sexp_of_t t = sexp
|
||||
|
||||
type u = [ `A of int list [@sexp.list] ] [@@deriving sexp, sexp_grammar]
|
||||
|
||||
let sexp = Sexplib.Sexp.of_string "(A 1 2 3)"
|
||||
let u = `A [ 1; 2; 3 ]
|
||||
let%test _ = u_of_sexp sexp = u
|
||||
let%test _ = sexp_of_u u = sexp
|
||||
end
|
||||
|
||||
module Variance = struct
|
||||
type (+'a, -'b, 'c, +_, -_, _) t [@@deriving sexp, sexp_grammar]
|
||||
end
|
||||
|
||||
module Clash = struct
|
||||
(* Same name for type-var and type-name; must be careful when introducing rigid type names. *)
|
||||
type 'hey hey = Hey of 'hey [@@deriving sexp, sexp_grammar]
|
||||
type 'hey rigid_hey = Hey of 'hey [@@deriving sexp, sexp_grammar]
|
||||
type ('foo, 'rigid_foo) foo = Foo of 'foo [@@deriving sexp, sexp_grammar]
|
||||
type 'rigid_bar rigid_rigid_bar = Bar [@@deriving sexp, sexp_grammar]
|
||||
end
|
||||
|
||||
module Applicative_functor_types = struct
|
||||
module Bidirectional_map = struct
|
||||
type ('k1, 'k2) t
|
||||
|
||||
module S (K1 : sig
|
||||
type t
|
||||
end) (K2 : sig
|
||||
type t
|
||||
end) =
|
||||
struct
|
||||
type nonrec t = (K1.t, K2.t) t
|
||||
end
|
||||
|
||||
module type Of_sexpable = sig
|
||||
type t [@@deriving of_sexp, sexp_grammar]
|
||||
end
|
||||
|
||||
let s__t_of_sexp
|
||||
(type k1 k2)
|
||||
(module K1 : Of_sexpable with type t = k1)
|
||||
(module K2 : Of_sexpable with type t = k2)
|
||||
(_ : Sexp.t)
|
||||
: (k1, k2) t
|
||||
=
|
||||
assert false
|
||||
;;
|
||||
|
||||
(* You would actually have to write this manually for functors. *)
|
||||
let s__t_sexp_grammar
|
||||
(type k1 k2)
|
||||
(module K1 : Of_sexpable with type t = k1)
|
||||
(module K2 : Of_sexpable with type t = k2)
|
||||
=
|
||||
[%sexp_grammar: (K1.t * K2.t) list]
|
||||
;;
|
||||
end
|
||||
|
||||
module Int = struct
|
||||
type t = int [@@deriving of_sexp, sexp_grammar]
|
||||
end
|
||||
|
||||
module String = struct
|
||||
type t = string [@@deriving of_sexp, sexp_grammar]
|
||||
end
|
||||
|
||||
module M : sig
|
||||
type t = Bidirectional_map.S(String)(Int).t [@@deriving of_sexp, sexp_grammar]
|
||||
end = struct
|
||||
type t = Bidirectional_map.S(String)(Int).t [@@deriving of_sexp, sexp_grammar]
|
||||
end
|
||||
end
|
||||
|
||||
module Type_extensions = struct
|
||||
let _ = ([%sexp_of: int] : [%sexp_of: int])
|
||||
let _ = ([%of_sexp: int] : [%of_sexp: int])
|
||||
end
|
||||
|
||||
module Allow_extra_fields = struct
|
||||
let should_raise f x =
|
||||
try
|
||||
ignore (f x);
|
||||
false
|
||||
with
|
||||
| _ -> true
|
||||
;;
|
||||
|
||||
module M1 = struct
|
||||
type t1 = { a : int } [@@deriving sexp]
|
||||
type t2 = t1 = { a : int } [@@deriving sexp, sexp_grammar] [@@sexp.allow_extra_fields]
|
||||
|
||||
let sexp = Sexplib.Sexp.of_string "((a 1))"
|
||||
let sexp_extra = Sexplib.Sexp.of_string "((a 1)(b 2))"
|
||||
let%test _ = t2_of_sexp sexp = t2_of_sexp sexp_extra
|
||||
let%test _ = t1_of_sexp sexp = t2_of_sexp sexp
|
||||
let%test _ = should_raise t1_of_sexp sexp_extra
|
||||
|
||||
let%expect_test _ =
|
||||
Expect_test_helpers_core.require_does_raise ~cr:CR_soon [%here] (fun () ->
|
||||
t2_of_sexp (Sexplib.Sexp.of_string "((a 1)(a))"));
|
||||
[%expect
|
||||
{|
|
||||
(Of_sexp_error
|
||||
"ppx_sexp_test.ml.Allow_extra_fields.M1.t2_of_sexp: duplicate fields: a"
|
||||
(invalid_sexp ((a 1) (a))))
|
||||
|}]
|
||||
;;
|
||||
end
|
||||
|
||||
module M2 = struct
|
||||
type t1 = A of { a : int list } [@@deriving sexp]
|
||||
|
||||
type t2 = t1 = A of { a : int list } [@sexp.allow_extra_fields]
|
||||
[@@deriving sexp, sexp_grammar]
|
||||
|
||||
let sexp = Sexplib.Sexp.of_string "(A (a (0)))"
|
||||
let sexp_extra = Sexplib.Sexp.of_string "(A (a (0))(b 2))"
|
||||
let%test _ = t2_of_sexp sexp = t2_of_sexp sexp_extra
|
||||
let%test _ = t1_of_sexp sexp = t2_of_sexp sexp
|
||||
let%test _ = should_raise t1_of_sexp sexp_extra
|
||||
end
|
||||
end
|
||||
|
||||
module Default_values_and_polymorphism = struct
|
||||
type t =
|
||||
{ a : int list [@sexp.list]
|
||||
; b : 'b. 'b -> int
|
||||
}
|
||||
[@@deriving of_sexp]
|
||||
end
|
||||
0
unikernel/duniverse/ppx_sexp_conv/test/ppx_sexp_test.mli
Normal file
0
unikernel/duniverse/ppx_sexp_conv/test/ppx_sexp_test.mli
Normal file
18
unikernel/duniverse/ppx_sexp_conv/test/sexp_grammar/dune
Normal file
18
unikernel/duniverse/ppx_sexp_conv/test/sexp_grammar/dune
Normal file
|
|
@ -0,0 +1,18 @@
|
|||
(library
|
||||
(name ppx_sexp_conv_test_sexp_grammar)
|
||||
(libraries base expect_test_helpers_core.expect_test_helpers_base
|
||||
sexp_grammar)
|
||||
(preprocess
|
||||
(pps ppx_sexp_conv ppx_expect ppx_here)))
|
||||
|
||||
(rule
|
||||
(targets regular_vs_polymorphic_variants.diff)
|
||||
(deps test_regular_variants.ml test_polymorphic_variants.ml)
|
||||
(mode promote)
|
||||
(action
|
||||
(bash
|
||||
"%{bin:patdiff-for-review} %{bin:patdiff} %{deps} > %{targets} || true")))
|
||||
|
||||
(alias
|
||||
(name DEFAULT)
|
||||
(deps regular_vs_polymorphic_variants.diff))
|
||||
|
|
@ -0,0 +1,119 @@
|
|||
open! Base
|
||||
|
||||
module _ = struct
|
||||
type t = { a : int } [@@sexp.allow_extra_fields] [@@deriving_inline sexp_grammar]
|
||||
|
||||
let _ = fun (_ : t) -> ()
|
||||
|
||||
let (t_sexp_grammar : t Sexplib0.Sexp_grammar.t) =
|
||||
{ untyped =
|
||||
Lazy
|
||||
(lazy
|
||||
(List
|
||||
(Fields
|
||||
{ allow_extra_fields = true
|
||||
; fields =
|
||||
[ No_tag
|
||||
{ name = "a"
|
||||
; required = true
|
||||
; args = Cons (int_sexp_grammar.untyped, Empty)
|
||||
}
|
||||
]
|
||||
})))
|
||||
}
|
||||
;;
|
||||
|
||||
let _ = t_sexp_grammar
|
||||
|
||||
[@@@end]
|
||||
end
|
||||
|
||||
module _ = struct
|
||||
type t = { a : int } [@@deriving_inline sexp_grammar]
|
||||
|
||||
let _ = fun (_ : t) -> ()
|
||||
|
||||
let (t_sexp_grammar : t Sexplib0.Sexp_grammar.t) =
|
||||
{ untyped =
|
||||
Lazy
|
||||
(lazy
|
||||
(List
|
||||
(Fields
|
||||
{ allow_extra_fields = false
|
||||
; fields =
|
||||
[ No_tag
|
||||
{ name = "a"
|
||||
; required = true
|
||||
; args = Cons (int_sexp_grammar.untyped, Empty)
|
||||
}
|
||||
]
|
||||
})))
|
||||
}
|
||||
;;
|
||||
|
||||
let _ = t_sexp_grammar
|
||||
|
||||
[@@@end]
|
||||
end
|
||||
|
||||
module _ = struct
|
||||
type t =
|
||||
| Allow_extra_fields of { foo : int } [@sexp.allow_extra_fields]
|
||||
| Forbid_extra_fields of { bar : int }
|
||||
[@@deriving_inline sexp_grammar]
|
||||
|
||||
let _ = fun (_ : t) -> ()
|
||||
|
||||
let (t_sexp_grammar : t Sexplib0.Sexp_grammar.t) =
|
||||
{ untyped =
|
||||
Lazy
|
||||
(lazy
|
||||
(Variant
|
||||
{ case_sensitivity = Case_sensitive_except_first_character
|
||||
; clauses =
|
||||
[ No_tag
|
||||
{ name = "Allow_extra_fields"
|
||||
; clause_kind =
|
||||
List_clause
|
||||
{ args =
|
||||
Fields
|
||||
{ allow_extra_fields = true
|
||||
; fields =
|
||||
[ No_tag
|
||||
{ name = "foo"
|
||||
; required = true
|
||||
; args = Cons (int_sexp_grammar.untyped, Empty)
|
||||
}
|
||||
]
|
||||
}
|
||||
}
|
||||
}
|
||||
; No_tag
|
||||
{ name = "Forbid_extra_fields"
|
||||
; clause_kind =
|
||||
List_clause
|
||||
{ args =
|
||||
Fields
|
||||
{ allow_extra_fields = false
|
||||
; fields =
|
||||
[ No_tag
|
||||
{ name = "bar"
|
||||
; required = true
|
||||
; args = Cons (int_sexp_grammar.untyped, Empty)
|
||||
}
|
||||
]
|
||||
}
|
||||
}
|
||||
}
|
||||
]
|
||||
}))
|
||||
}
|
||||
;;
|
||||
|
||||
let _ = t_sexp_grammar
|
||||
|
||||
[@@@end]
|
||||
|
||||
let _ = Allow_extra_fields { foo = 1 }
|
||||
let _ = Forbid_extra_fields { bar = 1 }
|
||||
end
|
||||
|
|
@ -0,0 +1 @@
|
|||
(*_ This signature is deliberately empty. *)
|
||||
|
|
@ -0,0 +1,117 @@
|
|||
open! Base
|
||||
|
||||
module type S = sig
|
||||
type t [@@deriving sexp_grammar]
|
||||
end
|
||||
|
||||
let show_grammar (module M : S) =
|
||||
Expect_test_helpers_base.print_s ([%sexp_of: _ Sexp_grammar.t] [%sexp_grammar: M.t])
|
||||
;;
|
||||
|
||||
module Grammarless = struct
|
||||
type t =
|
||||
[ `A
|
||||
| `B of string
|
||||
]
|
||||
end
|
||||
|
||||
let the_grammar = [%sexp_grammar: [ `A | `B of string ]]
|
||||
|
||||
let%expect_test "[@sexp_grammar.custom] in [@@deriving]" =
|
||||
show_grammar
|
||||
(module struct
|
||||
type t = (Grammarless.t[@sexp_grammar.custom the_grammar]) * int
|
||||
[@@deriving_inline sexp_grammar]
|
||||
|
||||
let _ = fun (_ : t) -> ()
|
||||
|
||||
let (t_sexp_grammar : t Sexplib0.Sexp_grammar.t) =
|
||||
{ untyped =
|
||||
Lazy
|
||||
(lazy
|
||||
(List
|
||||
(Cons
|
||||
( (the_grammar : Grammarless.t Sexplib0.Sexp_grammar.t).untyped
|
||||
, Cons (int_sexp_grammar.untyped, Empty) ))))
|
||||
}
|
||||
;;
|
||||
|
||||
let _ = t_sexp_grammar
|
||||
|
||||
[@@@end]
|
||||
end);
|
||||
[%expect
|
||||
{|
|
||||
(List (
|
||||
Cons
|
||||
(Variant (
|
||||
(case_sensitivity Case_sensitive)
|
||||
(clauses (
|
||||
(No_tag (
|
||||
(name A)
|
||||
(clause_kind Atom_clause)))
|
||||
(No_tag (
|
||||
(name B) (clause_kind (List_clause (args (Cons String Empty))))))))))
|
||||
(Cons Integer Empty)))
|
||||
|}]
|
||||
;;
|
||||
|
||||
let%expect_test "[@sexp_grammar.custom] in [%sexp_grammar]" =
|
||||
show_grammar
|
||||
(module struct
|
||||
type t = Grammarless.t * int
|
||||
|
||||
let t_sexp_grammar =
|
||||
[%sexp_grammar: (Grammarless.t[@sexp_grammar.custom the_grammar]) * int]
|
||||
;;
|
||||
end);
|
||||
[%expect
|
||||
{|
|
||||
(List (
|
||||
Cons
|
||||
(Variant (
|
||||
(case_sensitivity Case_sensitive)
|
||||
(clauses (
|
||||
(No_tag (
|
||||
(name A)
|
||||
(clause_kind Atom_clause)))
|
||||
(No_tag (
|
||||
(name B) (clause_kind (List_clause (args (Cons String Empty))))))))))
|
||||
(Cons Integer Empty)))
|
||||
|}]
|
||||
;;
|
||||
|
||||
let%expect_test "[@sexp_grammar.any] in [@@deriving]" =
|
||||
show_grammar
|
||||
(module struct
|
||||
type t =
|
||||
(Grammarless.t[@sexp_grammar.any "GRAMMARLESS"])
|
||||
* (Grammarless.t[@sexp_grammar.any])
|
||||
[@@deriving_inline sexp_grammar]
|
||||
|
||||
let _ = fun (_ : t) -> ()
|
||||
|
||||
let (t_sexp_grammar : t Sexplib0.Sexp_grammar.t) =
|
||||
{ untyped = List (Cons (Any "GRAMMARLESS", Cons (Any "ANY", Empty))) }
|
||||
;;
|
||||
|
||||
let _ = t_sexp_grammar
|
||||
|
||||
[@@@end]
|
||||
end);
|
||||
[%expect {| (List (Cons (Any GRAMMARLESS) (Cons (Any ANY) Empty))) |}]
|
||||
;;
|
||||
|
||||
let%expect_test "[@sexp_grammar.any] in [%sexp_grammar]" =
|
||||
show_grammar
|
||||
(module struct
|
||||
type t = Grammarless.t * Grammarless.t
|
||||
|
||||
let t_sexp_grammar =
|
||||
[%sexp_grammar:
|
||||
(Grammarless.t[@sexp_grammar.any "GRAMMARLESS"])
|
||||
* (Grammarless.t[@sexp_grammar.any])]
|
||||
;;
|
||||
end);
|
||||
[%expect {| (List (Cons (Any GRAMMARLESS) (Cons (Any ANY) Empty))) |}]
|
||||
;;
|
||||
|
|
@ -0,0 +1 @@
|
|||
(*_ This signature is deliberately empty. *)
|
||||
|
|
@ -0,0 +1,35 @@
|
|||
open! Base
|
||||
|
||||
module type S = sig
|
||||
type t [@@deriving sexp_grammar]
|
||||
end
|
||||
|
||||
module Key = struct
|
||||
type t = int [@@deriving sexp_grammar]
|
||||
end
|
||||
|
||||
module Pair = struct
|
||||
type ('a, 'b) t = 'a * 'b [@@deriving sexp_grammar]
|
||||
|
||||
module M (A : T) = struct
|
||||
type 'b t = A.t * 'b
|
||||
end
|
||||
|
||||
let m__t_sexp_grammar (type a) (module Key : S with type t = a) v_sexp_grammar =
|
||||
t_sexp_grammar Key.t_sexp_grammar v_sexp_grammar
|
||||
;;
|
||||
end
|
||||
|
||||
type t = string Pair.M(Key).t [@@deriving_inline sexp_grammar]
|
||||
|
||||
let _ = fun (_ : t) -> ()
|
||||
|
||||
let (t_sexp_grammar : t Sexplib0.Sexp_grammar.t) =
|
||||
{ untyped =
|
||||
Lazy (lazy (Pair.m__t_sexp_grammar (module Key) string_sexp_grammar).untyped)
|
||||
}
|
||||
;;
|
||||
|
||||
let _ = t_sexp_grammar
|
||||
|
||||
[@@@end]
|
||||
|
|
@ -0,0 +1 @@
|
|||
(*_ This signature is deliberately empty. *)
|
||||
|
|
@ -0,0 +1,616 @@
|
|||
open Ppx_sexp_conv_lib.Conv
|
||||
|
||||
[@@@warning "-37"] (* allow unused constructors *)
|
||||
|
||||
type abstract_a [@@deriving sexp] [@@deriving_inline sexp_grammar]
|
||||
|
||||
let _ = fun (_ : abstract_a) -> ()
|
||||
|
||||
let (abstract_a_sexp_grammar : abstract_a Sexplib0.Sexp_grammar.t) =
|
||||
{ untyped = Any "Test_coverage_for_deriving.abstract_a" }
|
||||
;;
|
||||
|
||||
let _ = abstract_a_sexp_grammar
|
||||
|
||||
[@@@end]
|
||||
|
||||
type abstract_b [@@deriving sexp] [@@deriving_inline sexp_grammar]
|
||||
|
||||
let _ = fun (_ : abstract_b) -> ()
|
||||
|
||||
let (abstract_b_sexp_grammar : abstract_b Sexplib0.Sexp_grammar.t) =
|
||||
{ untyped = Any "Test_coverage_for_deriving.abstract_b" }
|
||||
;;
|
||||
|
||||
let _ = abstract_b_sexp_grammar
|
||||
|
||||
[@@@end]
|
||||
|
||||
type integer = int [@@deriving sexp] [@@deriving_inline sexp_grammar]
|
||||
|
||||
let _ = fun (_ : integer) -> ()
|
||||
let (integer_sexp_grammar : integer Sexplib0.Sexp_grammar.t) = int_sexp_grammar
|
||||
let _ = integer_sexp_grammar
|
||||
|
||||
[@@@end]
|
||||
|
||||
type tuple = int * string [@@deriving sexp] [@@deriving_inline sexp_grammar]
|
||||
|
||||
let _ = fun (_ : tuple) -> ()
|
||||
|
||||
let (tuple_sexp_grammar : tuple Sexplib0.Sexp_grammar.t) =
|
||||
{ untyped =
|
||||
Lazy
|
||||
(lazy
|
||||
(List
|
||||
(Cons (int_sexp_grammar.untyped, Cons (string_sexp_grammar.untyped, Empty)))))
|
||||
}
|
||||
;;
|
||||
|
||||
let _ = tuple_sexp_grammar
|
||||
|
||||
[@@@end]
|
||||
|
||||
type pos =
|
||||
{ x : float
|
||||
; y : float
|
||||
}
|
||||
[@@deriving sexp] [@@deriving_inline sexp_grammar]
|
||||
|
||||
let _ = fun (_ : pos) -> ()
|
||||
|
||||
let (pos_sexp_grammar : pos Sexplib0.Sexp_grammar.t) =
|
||||
{ untyped =
|
||||
Lazy
|
||||
(lazy
|
||||
(List
|
||||
(Fields
|
||||
{ allow_extra_fields = false
|
||||
; fields =
|
||||
[ No_tag
|
||||
{ name = "x"
|
||||
; required = true
|
||||
; args = Cons (float_sexp_grammar.untyped, Empty)
|
||||
}
|
||||
; No_tag
|
||||
{ name = "y"
|
||||
; required = true
|
||||
; args = Cons (float_sexp_grammar.untyped, Empty)
|
||||
}
|
||||
]
|
||||
})))
|
||||
}
|
||||
;;
|
||||
|
||||
let _ = pos_sexp_grammar
|
||||
|
||||
[@@@end]
|
||||
|
||||
type 'a unary = 'a list [@@deriving sexp] [@@deriving_inline sexp_grammar]
|
||||
|
||||
let _ = fun (_ : 'a unary) -> ()
|
||||
|
||||
let unary_sexp_grammar :
|
||||
'a. 'a Sexplib0.Sexp_grammar.t -> 'a unary Sexplib0.Sexp_grammar.t
|
||||
=
|
||||
fun _'a_sexp_grammar -> list_sexp_grammar _'a_sexp_grammar
|
||||
;;
|
||||
|
||||
let _ = unary_sexp_grammar
|
||||
|
||||
[@@@end]
|
||||
|
||||
type enum =
|
||||
| One
|
||||
| Two
|
||||
| Three
|
||||
[@@deriving sexp] [@@deriving_inline sexp_grammar]
|
||||
|
||||
let _ = fun (_ : enum) -> ()
|
||||
|
||||
let (enum_sexp_grammar : enum Sexplib0.Sexp_grammar.t) =
|
||||
{ untyped =
|
||||
Variant
|
||||
{ case_sensitivity = Case_sensitive_except_first_character
|
||||
; clauses =
|
||||
[ No_tag { name = "One"; clause_kind = Atom_clause }
|
||||
; No_tag { name = "Two"; clause_kind = Atom_clause }
|
||||
; No_tag { name = "Three"; clause_kind = Atom_clause }
|
||||
]
|
||||
}
|
||||
}
|
||||
;;
|
||||
|
||||
let _ = enum_sexp_grammar
|
||||
|
||||
[@@@end]
|
||||
|
||||
type ('a, 'b) which =
|
||||
| This of 'a
|
||||
| That of 'b
|
||||
[@@deriving sexp] [@@deriving_inline sexp_grammar]
|
||||
|
||||
let _ = fun (_ : ('a, 'b) which) -> ()
|
||||
|
||||
let which_sexp_grammar :
|
||||
'a 'b.
|
||||
'a Sexplib0.Sexp_grammar.t
|
||||
-> 'b Sexplib0.Sexp_grammar.t
|
||||
-> ('a, 'b) which Sexplib0.Sexp_grammar.t
|
||||
=
|
||||
fun _'a_sexp_grammar _'b_sexp_grammar ->
|
||||
{ untyped =
|
||||
Variant
|
||||
{ case_sensitivity = Case_sensitive_except_first_character
|
||||
; clauses =
|
||||
[ No_tag
|
||||
{ name = "This"
|
||||
; clause_kind =
|
||||
List_clause { args = Cons (_'a_sexp_grammar.untyped, Empty) }
|
||||
}
|
||||
; No_tag
|
||||
{ name = "That"
|
||||
; clause_kind =
|
||||
List_clause { args = Cons (_'b_sexp_grammar.untyped, Empty) }
|
||||
}
|
||||
]
|
||||
}
|
||||
}
|
||||
;;
|
||||
|
||||
let _ = which_sexp_grammar
|
||||
|
||||
[@@@end]
|
||||
|
||||
type 'a optional =
|
||||
| No
|
||||
| Yes of 'a
|
||||
[@@deriving sexp] [@@deriving_inline sexp_grammar]
|
||||
|
||||
let _ = fun (_ : 'a optional) -> ()
|
||||
|
||||
let optional_sexp_grammar :
|
||||
'a. 'a Sexplib0.Sexp_grammar.t -> 'a optional Sexplib0.Sexp_grammar.t
|
||||
=
|
||||
fun _'a_sexp_grammar ->
|
||||
{ untyped =
|
||||
Variant
|
||||
{ case_sensitivity = Case_sensitive_except_first_character
|
||||
; clauses =
|
||||
[ No_tag { name = "No"; clause_kind = Atom_clause }
|
||||
; No_tag
|
||||
{ name = "Yes"
|
||||
; clause_kind =
|
||||
List_clause { args = Cons (_'a_sexp_grammar.untyped, Empty) }
|
||||
}
|
||||
]
|
||||
}
|
||||
}
|
||||
;;
|
||||
|
||||
let _ = optional_sexp_grammar
|
||||
|
||||
[@@@end]
|
||||
|
||||
type empty = | [@@deriving sexp] [@@deriving_inline sexp_grammar]
|
||||
|
||||
let _ = fun (_ : empty) -> ()
|
||||
let (empty_sexp_grammar : empty Sexplib0.Sexp_grammar.t) = { untyped = Union [] }
|
||||
let _ = empty_sexp_grammar
|
||||
|
||||
[@@@end]
|
||||
|
||||
type _ phantom = int [@@deriving sexp] [@@deriving_inline sexp_grammar]
|
||||
|
||||
let _ = fun (_ : _ phantom) -> ()
|
||||
|
||||
let phantom_sexp_grammar :
|
||||
'a__086_.
|
||||
'a__086_ Sexplib0.Sexp_grammar.t -> 'a__086_ phantom Sexplib0.Sexp_grammar.t
|
||||
=
|
||||
fun _'a__086__sexp_grammar -> int_sexp_grammar
|
||||
;;
|
||||
|
||||
let _ = phantom_sexp_grammar
|
||||
|
||||
[@@@end]
|
||||
|
||||
type color =
|
||||
[ `Red
|
||||
| `Blue
|
||||
]
|
||||
[@@deriving sexp] [@@deriving_inline sexp_grammar]
|
||||
|
||||
let _ = fun (_ : color) -> ()
|
||||
|
||||
let (color_sexp_grammar : color Sexplib0.Sexp_grammar.t) =
|
||||
{ untyped =
|
||||
Variant
|
||||
{ case_sensitivity = Case_sensitive
|
||||
; clauses =
|
||||
[ No_tag { name = "Red"; clause_kind = Atom_clause }
|
||||
; No_tag { name = "Blue"; clause_kind = Atom_clause }
|
||||
]
|
||||
}
|
||||
}
|
||||
;;
|
||||
|
||||
let _ = color_sexp_grammar
|
||||
|
||||
[@@@end]
|
||||
|
||||
type adjective =
|
||||
[ color
|
||||
| `Fast
|
||||
| `Slow
|
||||
| `Count of int
|
||||
]
|
||||
[@@deriving sexp] [@@deriving_inline sexp_grammar]
|
||||
|
||||
let _ = fun (_ : adjective) -> ()
|
||||
|
||||
let (adjective_sexp_grammar : adjective Sexplib0.Sexp_grammar.t) =
|
||||
{ untyped =
|
||||
Lazy
|
||||
(lazy
|
||||
(Union
|
||||
[ color_sexp_grammar.untyped
|
||||
; Variant
|
||||
{ case_sensitivity = Case_sensitive
|
||||
; clauses =
|
||||
[ No_tag { name = "Fast"; clause_kind = Atom_clause }
|
||||
; No_tag { name = "Slow"; clause_kind = Atom_clause }
|
||||
; No_tag
|
||||
{ name = "Count"
|
||||
; clause_kind =
|
||||
List_clause { args = Cons (int_sexp_grammar.untyped, Empty) }
|
||||
}
|
||||
]
|
||||
}
|
||||
]))
|
||||
}
|
||||
;;
|
||||
|
||||
let _ = adjective_sexp_grammar
|
||||
|
||||
[@@@end]
|
||||
|
||||
type 'a tree =
|
||||
{ data : 'a
|
||||
; children : 'a tree list
|
||||
}
|
||||
[@@deriving sexp] [@@deriving_inline sexp_grammar]
|
||||
|
||||
let _ = fun (_ : 'a tree) -> ()
|
||||
|
||||
include struct
|
||||
open struct
|
||||
let (grammars__118_ : Sexplib0.Sexp_grammar.defn Stdlib.List.t Stdlib.Lazy.t) =
|
||||
lazy
|
||||
(let tree_sexp_grammar
|
||||
: 'a. 'a Sexplib0.Sexp_grammar.t -> 'a tree Sexplib0.Sexp_grammar.t
|
||||
=
|
||||
fun _'a_sexp_grammar ->
|
||||
{ untyped = Recursive ("tree", [ _'a_sexp_grammar.untyped ]) }
|
||||
in
|
||||
[ { tycon = "tree"
|
||||
; tyvars = [ "a" ]
|
||||
; grammar =
|
||||
List
|
||||
(Fields
|
||||
{ allow_extra_fields = false
|
||||
; fields =
|
||||
[ No_tag
|
||||
{ name = "data"
|
||||
; required = true
|
||||
; args = Cons (Tyvar "a", Empty)
|
||||
}
|
||||
; No_tag
|
||||
{ name = "children"
|
||||
; required = true
|
||||
; args =
|
||||
Cons
|
||||
( (list_sexp_grammar
|
||||
(tree_sexp_grammar { untyped = Tyvar "a" }))
|
||||
.untyped
|
||||
, Empty )
|
||||
}
|
||||
]
|
||||
})
|
||||
}
|
||||
])
|
||||
;;
|
||||
|
||||
let _ = grammars__118_
|
||||
end
|
||||
|
||||
let tree_sexp_grammar :
|
||||
'a. 'a Sexplib0.Sexp_grammar.t -> 'a tree Sexplib0.Sexp_grammar.t
|
||||
=
|
||||
fun _'a_sexp_grammar ->
|
||||
{ untyped =
|
||||
Tycon ("tree", [ _'a_sexp_grammar.untyped ], Stdlib.Lazy.force grammars__118_)
|
||||
}
|
||||
;;
|
||||
|
||||
let _ = tree_sexp_grammar
|
||||
end
|
||||
|
||||
[@@@end]
|
||||
|
||||
type alpha = int
|
||||
|
||||
and beta =
|
||||
{ alpha : alpha
|
||||
; betas : beta list
|
||||
}
|
||||
|
||||
and gamma = beta list [@@deriving sexp] [@@deriving_inline sexp_grammar]
|
||||
|
||||
let _ = fun (_ : alpha) -> ()
|
||||
let _ = fun (_ : beta) -> ()
|
||||
let _ = fun (_ : gamma) -> ()
|
||||
|
||||
include struct
|
||||
open struct
|
||||
let (grammars__131_ : Sexplib0.Sexp_grammar.defn Stdlib.List.t Stdlib.Lazy.t) =
|
||||
lazy
|
||||
(let (alpha_sexp_grammar : alpha Sexplib0.Sexp_grammar.t) =
|
||||
{ untyped = Recursive ("alpha", []) }
|
||||
and (beta_sexp_grammar : beta Sexplib0.Sexp_grammar.t) =
|
||||
{ untyped = Recursive ("beta", []) }
|
||||
in
|
||||
[ { tycon = "alpha"; tyvars = []; grammar = int_sexp_grammar.untyped }
|
||||
; { tycon = "beta"
|
||||
; tyvars = []
|
||||
; grammar =
|
||||
List
|
||||
(Fields
|
||||
{ allow_extra_fields = false
|
||||
; fields =
|
||||
[ No_tag
|
||||
{ name = "alpha"
|
||||
; required = true
|
||||
; args = Cons (alpha_sexp_grammar.untyped, Empty)
|
||||
}
|
||||
; No_tag
|
||||
{ name = "betas"
|
||||
; required = true
|
||||
; args =
|
||||
Cons ((list_sexp_grammar beta_sexp_grammar).untyped, Empty)
|
||||
}
|
||||
]
|
||||
})
|
||||
}
|
||||
])
|
||||
;;
|
||||
|
||||
let _ = grammars__131_
|
||||
end
|
||||
|
||||
let (alpha_sexp_grammar : alpha Sexplib0.Sexp_grammar.t) =
|
||||
{ untyped = Lazy (lazy (Tycon ("alpha", [], Stdlib.Lazy.force grammars__131_))) }
|
||||
|
||||
and (beta_sexp_grammar : beta Sexplib0.Sexp_grammar.t) =
|
||||
{ untyped = Lazy (lazy (Tycon ("beta", [], Stdlib.Lazy.force grammars__131_))) }
|
||||
;;
|
||||
|
||||
let _ = alpha_sexp_grammar
|
||||
and _ = beta_sexp_grammar
|
||||
end
|
||||
|
||||
let (gamma_sexp_grammar : gamma Sexplib0.Sexp_grammar.t) =
|
||||
{ untyped = Lazy (lazy (list_sexp_grammar beta_sexp_grammar).untyped) }
|
||||
;;
|
||||
|
||||
let _ = gamma_sexp_grammar
|
||||
|
||||
[@@@end]
|
||||
|
||||
type record_attributes =
|
||||
{ a : int [@default 0]
|
||||
; b : bool [@sexp.bool]
|
||||
; c : float option [@sexp.option]
|
||||
; d : string list [@sexp.list]
|
||||
; e : bytes array [@sexp.array]
|
||||
; f : Ppx_sexp_conv_lib.Sexp.t [@sexp.omit_nil]
|
||||
}
|
||||
[@@sexp.allow_extra_fields] [@@deriving sexp] [@@deriving_inline sexp_grammar]
|
||||
|
||||
let _ = fun (_ : record_attributes) -> ()
|
||||
|
||||
let (record_attributes_sexp_grammar : record_attributes Sexplib0.Sexp_grammar.t) =
|
||||
{ untyped =
|
||||
Lazy
|
||||
(lazy
|
||||
(List
|
||||
(Fields
|
||||
{ allow_extra_fields = true
|
||||
; fields =
|
||||
[ No_tag
|
||||
{ name = "a"
|
||||
; required = false
|
||||
; args = Cons (int_sexp_grammar.untyped, Empty)
|
||||
}
|
||||
; No_tag { name = "b"; required = false; args = Empty }
|
||||
; No_tag
|
||||
{ name = "c"
|
||||
; required = false
|
||||
; args = Cons (float_sexp_grammar.untyped, Empty)
|
||||
}
|
||||
; No_tag
|
||||
{ name = "d"
|
||||
; required = false
|
||||
; args = Cons (List (Many string_sexp_grammar.untyped), Empty)
|
||||
}
|
||||
; No_tag
|
||||
{ name = "e"
|
||||
; required = false
|
||||
; args = Cons (List (Many bytes_sexp_grammar.untyped), Empty)
|
||||
}
|
||||
; No_tag
|
||||
{ name = "f"
|
||||
; required = false
|
||||
; args =
|
||||
Cons (Ppx_sexp_conv_lib.Sexp.t_sexp_grammar.untyped, Empty)
|
||||
}
|
||||
]
|
||||
})))
|
||||
}
|
||||
;;
|
||||
|
||||
let _ = record_attributes_sexp_grammar
|
||||
|
||||
[@@@end]
|
||||
|
||||
type variant_attributes =
|
||||
| A
|
||||
| B of int list [@sexp.list]
|
||||
| C of
|
||||
{ a : int [@default 0]
|
||||
; b : bool [@sexp.bool]
|
||||
; c : float option [@sexp.option]
|
||||
; d : string list [@sexp.list]
|
||||
; e : bytes array [@sexp.array]
|
||||
; f : Ppx_sexp_conv_lib.Sexp.t [@sexp.omit_nil]
|
||||
} [@sexp.allow_extra_fields]
|
||||
[@@deriving sexp] [@@deriving_inline sexp_grammar]
|
||||
|
||||
let _ = fun (_ : variant_attributes) -> ()
|
||||
|
||||
let (variant_attributes_sexp_grammar : variant_attributes Sexplib0.Sexp_grammar.t) =
|
||||
{ untyped =
|
||||
Lazy
|
||||
(lazy
|
||||
(Variant
|
||||
{ case_sensitivity = Case_sensitive_except_first_character
|
||||
; clauses =
|
||||
[ No_tag { name = "A"; clause_kind = Atom_clause }
|
||||
; No_tag
|
||||
{ name = "B"
|
||||
; clause_kind = List_clause { args = Many int_sexp_grammar.untyped }
|
||||
}
|
||||
; No_tag
|
||||
{ name = "C"
|
||||
; clause_kind =
|
||||
List_clause
|
||||
{ args =
|
||||
Fields
|
||||
{ allow_extra_fields = true
|
||||
; fields =
|
||||
[ No_tag
|
||||
{ name = "a"
|
||||
; required = false
|
||||
; args = Cons (int_sexp_grammar.untyped, Empty)
|
||||
}
|
||||
; No_tag
|
||||
{ name = "b"; required = false; args = Empty }
|
||||
; No_tag
|
||||
{ name = "c"
|
||||
; required = false
|
||||
; args = Cons (float_sexp_grammar.untyped, Empty)
|
||||
}
|
||||
; No_tag
|
||||
{ name = "d"
|
||||
; required = false
|
||||
; args =
|
||||
Cons
|
||||
( List (Many string_sexp_grammar.untyped)
|
||||
, Empty )
|
||||
}
|
||||
; No_tag
|
||||
{ name = "e"
|
||||
; required = false
|
||||
; args =
|
||||
Cons
|
||||
( List (Many bytes_sexp_grammar.untyped)
|
||||
, Empty )
|
||||
}
|
||||
; No_tag
|
||||
{ name = "f"
|
||||
; required = false
|
||||
; args =
|
||||
Cons
|
||||
( Ppx_sexp_conv_lib.Sexp.t_sexp_grammar
|
||||
.untyped
|
||||
, Empty )
|
||||
}
|
||||
]
|
||||
}
|
||||
}
|
||||
}
|
||||
]
|
||||
}))
|
||||
}
|
||||
;;
|
||||
|
||||
let _ = variant_attributes_sexp_grammar
|
||||
|
||||
[@@@end]
|
||||
|
||||
type polymorphic_variant_attributes =
|
||||
[ `A
|
||||
| `B of int list [@sexp.list]
|
||||
]
|
||||
[@@deriving sexp] [@@deriving_inline sexp_grammar]
|
||||
|
||||
let _ = fun (_ : polymorphic_variant_attributes) -> ()
|
||||
|
||||
let (polymorphic_variant_attributes_sexp_grammar :
|
||||
polymorphic_variant_attributes Sexplib0.Sexp_grammar.t)
|
||||
=
|
||||
{ untyped =
|
||||
Lazy
|
||||
(lazy
|
||||
(Variant
|
||||
{ case_sensitivity = Case_sensitive
|
||||
; clauses =
|
||||
[ No_tag { name = "A"; clause_kind = Atom_clause }
|
||||
; No_tag
|
||||
{ name = "B"
|
||||
; clause_kind = List_clause { args = Many int_sexp_grammar.untyped }
|
||||
}
|
||||
]
|
||||
}))
|
||||
}
|
||||
;;
|
||||
|
||||
let _ = polymorphic_variant_attributes_sexp_grammar
|
||||
|
||||
[@@@end]
|
||||
|
||||
type opaque =
|
||||
{ x : (string[@sexp.opaque])
|
||||
; y : int -> int
|
||||
}
|
||||
[@@deriving sexp] [@@deriving_inline sexp_grammar]
|
||||
|
||||
let _ = fun (_ : opaque) -> ()
|
||||
|
||||
let (opaque_sexp_grammar : opaque Sexplib0.Sexp_grammar.t) =
|
||||
{ untyped =
|
||||
Lazy
|
||||
(lazy
|
||||
(List
|
||||
(Fields
|
||||
{ allow_extra_fields = false
|
||||
; fields =
|
||||
[ No_tag
|
||||
{ name = "x"
|
||||
; required = true
|
||||
; args =
|
||||
Cons (Sexplib0.Sexp_conv.opaque_sexp_grammar.untyped, Empty)
|
||||
}
|
||||
; No_tag
|
||||
{ name = "y"
|
||||
; required = true
|
||||
; args = Cons (Sexplib0.Sexp_conv.fun_sexp_grammar.untyped, Empty)
|
||||
}
|
||||
]
|
||||
})))
|
||||
}
|
||||
;;
|
||||
|
||||
let _ = opaque_sexp_grammar
|
||||
|
||||
[@@@end]
|
||||
|
|
@ -0,0 +1,283 @@
|
|||
(** This file covers a lot of cases for [@@deriving], for both interface and
|
||||
implementation. They are also exported for validation. *)
|
||||
|
||||
type abstract_a [@@deriving sexp] [@@deriving_inline sexp_grammar]
|
||||
|
||||
include sig
|
||||
[@@@ocaml.warning "-32"]
|
||||
|
||||
val abstract_a_sexp_grammar : abstract_a Sexplib0.Sexp_grammar.t
|
||||
end
|
||||
[@@ocaml.doc "@inline"]
|
||||
|
||||
[@@@end]
|
||||
|
||||
type abstract_b [@@deriving sexp] [@@deriving_inline sexp_grammar]
|
||||
|
||||
include sig
|
||||
[@@@ocaml.warning "-32"]
|
||||
|
||||
val abstract_b_sexp_grammar : abstract_b Sexplib0.Sexp_grammar.t
|
||||
end
|
||||
[@@ocaml.doc "@inline"]
|
||||
|
||||
[@@@end]
|
||||
|
||||
type integer = int [@@deriving sexp] [@@deriving_inline sexp_grammar]
|
||||
|
||||
include sig
|
||||
[@@@ocaml.warning "-32"]
|
||||
|
||||
val integer_sexp_grammar : integer Sexplib0.Sexp_grammar.t
|
||||
end
|
||||
[@@ocaml.doc "@inline"]
|
||||
|
||||
[@@@end]
|
||||
|
||||
type tuple = int * string [@@deriving sexp] [@@deriving_inline sexp_grammar]
|
||||
|
||||
include sig
|
||||
[@@@ocaml.warning "-32"]
|
||||
|
||||
val tuple_sexp_grammar : tuple Sexplib0.Sexp_grammar.t
|
||||
end
|
||||
[@@ocaml.doc "@inline"]
|
||||
|
||||
[@@@end]
|
||||
|
||||
type pos =
|
||||
{ x : float
|
||||
; y : float
|
||||
}
|
||||
[@@deriving sexp] [@@deriving_inline sexp_grammar]
|
||||
|
||||
include sig
|
||||
[@@@ocaml.warning "-32"]
|
||||
|
||||
val pos_sexp_grammar : pos Sexplib0.Sexp_grammar.t
|
||||
end
|
||||
[@@ocaml.doc "@inline"]
|
||||
|
||||
[@@@end]
|
||||
|
||||
type 'a unary = 'a list [@@deriving sexp] [@@deriving_inline sexp_grammar]
|
||||
|
||||
include sig
|
||||
[@@@ocaml.warning "-32"]
|
||||
|
||||
val unary_sexp_grammar : 'a Sexplib0.Sexp_grammar.t -> 'a unary Sexplib0.Sexp_grammar.t
|
||||
end
|
||||
[@@ocaml.doc "@inline"]
|
||||
|
||||
[@@@end]
|
||||
|
||||
type enum =
|
||||
| One
|
||||
| Two
|
||||
| Three
|
||||
[@@deriving sexp] [@@deriving_inline sexp_grammar]
|
||||
|
||||
include sig
|
||||
[@@@ocaml.warning "-32"]
|
||||
|
||||
val enum_sexp_grammar : enum Sexplib0.Sexp_grammar.t
|
||||
end
|
||||
[@@ocaml.doc "@inline"]
|
||||
|
||||
[@@@end]
|
||||
|
||||
type ('a, 'b) which =
|
||||
| This of 'a
|
||||
| That of 'b
|
||||
[@@deriving sexp] [@@deriving_inline sexp_grammar]
|
||||
|
||||
include sig
|
||||
[@@@ocaml.warning "-32"]
|
||||
|
||||
val which_sexp_grammar
|
||||
: 'a Sexplib0.Sexp_grammar.t
|
||||
-> 'b Sexplib0.Sexp_grammar.t
|
||||
-> ('a, 'b) which Sexplib0.Sexp_grammar.t
|
||||
end
|
||||
[@@ocaml.doc "@inline"]
|
||||
|
||||
[@@@end]
|
||||
|
||||
type 'a optional =
|
||||
| No
|
||||
| Yes of 'a
|
||||
[@@deriving sexp] [@@deriving_inline sexp_grammar]
|
||||
|
||||
include sig
|
||||
[@@@ocaml.warning "-32"]
|
||||
|
||||
val optional_sexp_grammar
|
||||
: 'a Sexplib0.Sexp_grammar.t
|
||||
-> 'a optional Sexplib0.Sexp_grammar.t
|
||||
end
|
||||
[@@ocaml.doc "@inline"]
|
||||
|
||||
[@@@end]
|
||||
|
||||
type empty = | [@@deriving sexp] [@@deriving_inline sexp_grammar]
|
||||
|
||||
include sig
|
||||
[@@@ocaml.warning "-32"]
|
||||
|
||||
val empty_sexp_grammar : empty Sexplib0.Sexp_grammar.t
|
||||
end
|
||||
[@@ocaml.doc "@inline"]
|
||||
|
||||
[@@@end]
|
||||
|
||||
type _ phantom = int [@@deriving sexp] [@@deriving_inline sexp_grammar]
|
||||
|
||||
include sig
|
||||
[@@@ocaml.warning "-32"]
|
||||
|
||||
val phantom_sexp_grammar
|
||||
: 'a__003_ Sexplib0.Sexp_grammar.t
|
||||
-> 'a__003_ phantom Sexplib0.Sexp_grammar.t
|
||||
end
|
||||
[@@ocaml.doc "@inline"]
|
||||
|
||||
[@@@end]
|
||||
|
||||
type color =
|
||||
[ `Red
|
||||
| `Blue
|
||||
]
|
||||
[@@deriving sexp] [@@deriving_inline sexp_grammar]
|
||||
|
||||
include sig
|
||||
[@@@ocaml.warning "-32"]
|
||||
|
||||
val color_sexp_grammar : color Sexplib0.Sexp_grammar.t
|
||||
end
|
||||
[@@ocaml.doc "@inline"]
|
||||
|
||||
[@@@end]
|
||||
|
||||
type adjective =
|
||||
[ color
|
||||
| `Fast
|
||||
| `Slow
|
||||
| `Count of int
|
||||
]
|
||||
[@@deriving sexp] [@@deriving_inline sexp_grammar]
|
||||
|
||||
include sig
|
||||
[@@@ocaml.warning "-32"]
|
||||
|
||||
val adjective_sexp_grammar : adjective Sexplib0.Sexp_grammar.t
|
||||
end
|
||||
[@@ocaml.doc "@inline"]
|
||||
|
||||
[@@@end]
|
||||
|
||||
type 'a tree =
|
||||
{ data : 'a
|
||||
; children : 'a tree list
|
||||
}
|
||||
[@@deriving sexp] [@@deriving_inline sexp_grammar]
|
||||
|
||||
include sig
|
||||
[@@@ocaml.warning "-32"]
|
||||
|
||||
val tree_sexp_grammar : 'a Sexplib0.Sexp_grammar.t -> 'a tree Sexplib0.Sexp_grammar.t
|
||||
end
|
||||
[@@ocaml.doc "@inline"]
|
||||
|
||||
[@@@end]
|
||||
|
||||
type alpha = int
|
||||
|
||||
and beta =
|
||||
{ alpha : alpha
|
||||
; betas : beta list
|
||||
}
|
||||
|
||||
and gamma = beta list [@@deriving sexp] [@@deriving_inline sexp_grammar]
|
||||
|
||||
include sig
|
||||
[@@@ocaml.warning "-32"]
|
||||
|
||||
val alpha_sexp_grammar : alpha Sexplib0.Sexp_grammar.t
|
||||
val beta_sexp_grammar : beta Sexplib0.Sexp_grammar.t
|
||||
val gamma_sexp_grammar : gamma Sexplib0.Sexp_grammar.t
|
||||
end
|
||||
[@@ocaml.doc "@inline"]
|
||||
|
||||
[@@@end]
|
||||
|
||||
type record_attributes =
|
||||
{ a : int
|
||||
; b : bool
|
||||
; c : float option
|
||||
; d : string list
|
||||
; e : bytes array
|
||||
; f : Ppx_sexp_conv_lib.Sexp.t
|
||||
}
|
||||
[@@deriving sexp] [@@deriving_inline sexp_grammar]
|
||||
|
||||
include sig
|
||||
[@@@ocaml.warning "-32"]
|
||||
|
||||
val record_attributes_sexp_grammar : record_attributes Sexplib0.Sexp_grammar.t
|
||||
end
|
||||
[@@ocaml.doc "@inline"]
|
||||
|
||||
[@@@end]
|
||||
|
||||
type variant_attributes =
|
||||
| A
|
||||
| B of int list
|
||||
| C of
|
||||
{ a : int
|
||||
; b : bool
|
||||
; c : float option
|
||||
; d : string list
|
||||
; e : bytes array
|
||||
; f : Ppx_sexp_conv_lib.Sexp.t
|
||||
}
|
||||
[@@deriving sexp] [@@deriving_inline sexp_grammar]
|
||||
|
||||
include sig
|
||||
[@@@ocaml.warning "-32"]
|
||||
|
||||
val variant_attributes_sexp_grammar : variant_attributes Sexplib0.Sexp_grammar.t
|
||||
end
|
||||
[@@ocaml.doc "@inline"]
|
||||
|
||||
[@@@end]
|
||||
|
||||
type polymorphic_variant_attributes =
|
||||
[ `A
|
||||
| `B of int list
|
||||
]
|
||||
[@@deriving sexp] [@@deriving_inline sexp_grammar]
|
||||
|
||||
include sig
|
||||
[@@@ocaml.warning "-32"]
|
||||
|
||||
val polymorphic_variant_attributes_sexp_grammar
|
||||
: polymorphic_variant_attributes Sexplib0.Sexp_grammar.t
|
||||
end
|
||||
[@@ocaml.doc "@inline"]
|
||||
|
||||
[@@@end]
|
||||
|
||||
type opaque =
|
||||
{ x : string
|
||||
; y : int -> int
|
||||
}
|
||||
[@@deriving sexp] [@@deriving_inline sexp_grammar]
|
||||
|
||||
include sig
|
||||
[@@@ocaml.warning "-32"]
|
||||
|
||||
val opaque_sexp_grammar : opaque Sexplib0.Sexp_grammar.t
|
||||
end
|
||||
[@@ocaml.doc "@inline"]
|
||||
|
||||
[@@@end]
|
||||
|
|
@ -0,0 +1,19 @@
|
|||
open! Base
|
||||
|
||||
(* Not sure how much people will want to use this, considering that the input is more
|
||||
complicated and specific than the output, but they have it. *)
|
||||
module type S = sig
|
||||
val t_sexp_grammar : [%sexp_grammar: int Map.M(String).t]
|
||||
end
|
||||
|
||||
module _ (M : S) : sig
|
||||
val t_sexp_grammar : int Map.M(String).t Sexplib0.Sexp_grammar.t [@@warning "-32"]
|
||||
end =
|
||||
M
|
||||
|
||||
(* The grammar is illegible, so just make sure it builds. *)
|
||||
|
||||
let (_ : _ Sexplib0.Sexp_grammar.t) = [%sexp_grammar: int Map.M(String).t]
|
||||
|
||||
(* This used to give a compilation error. *)
|
||||
let (_ : _ Sexplib0.Sexp_grammar.t) = [%sexp_grammar: _ list]
|
||||
|
|
@ -0,0 +1 @@
|
|||
(*_ This signature is deliberately empty. *)
|
||||
|
|
@ -0,0 +1,158 @@
|
|||
open! Base
|
||||
|
||||
module Maybe = struct
|
||||
type 'a t = 'a option [@@deriving_inline sexp_grammar]
|
||||
|
||||
let _ = fun (_ : 'a t) -> ()
|
||||
|
||||
let t_sexp_grammar : 'a. 'a Sexplib0.Sexp_grammar.t -> 'a t Sexplib0.Sexp_grammar.t =
|
||||
fun _'a_sexp_grammar -> option_sexp_grammar _'a_sexp_grammar
|
||||
;;
|
||||
|
||||
let _ = t_sexp_grammar
|
||||
|
||||
[@@@end]
|
||||
end
|
||||
|
||||
module Make (T : sig
|
||||
type 'a t [@@deriving sexp_grammar]
|
||||
end) =
|
||||
struct
|
||||
[@@@warning "-37"]
|
||||
|
||||
type 'a t = T of 'a T.t u
|
||||
and 'a u = U of 'a T.t t Maybe.t [@@deriving_inline sexp_grammar]
|
||||
|
||||
let _ = fun (_ : 'a t) -> ()
|
||||
let _ = fun (_ : 'a u) -> ()
|
||||
|
||||
include struct
|
||||
open struct
|
||||
let (grammars__001_ : Sexplib0.Sexp_grammar.defn Stdlib.List.t Stdlib.Lazy.t) =
|
||||
lazy
|
||||
(let t_sexp_grammar
|
||||
: 'a. 'a Sexplib0.Sexp_grammar.t -> 'a t Sexplib0.Sexp_grammar.t
|
||||
=
|
||||
fun _'a_sexp_grammar ->
|
||||
{ untyped = Recursive ("t", [ _'a_sexp_grammar.untyped ]) }
|
||||
and u_sexp_grammar
|
||||
: 'a. 'a Sexplib0.Sexp_grammar.t -> 'a u Sexplib0.Sexp_grammar.t
|
||||
=
|
||||
fun _'a_sexp_grammar ->
|
||||
{ untyped = Recursive ("u", [ _'a_sexp_grammar.untyped ]) }
|
||||
in
|
||||
[ { tycon = "t"
|
||||
; tyvars = [ "a" ]
|
||||
; grammar =
|
||||
Variant
|
||||
{ case_sensitivity = Case_sensitive_except_first_character
|
||||
; clauses =
|
||||
[ No_tag
|
||||
{ name = "T"
|
||||
; clause_kind =
|
||||
List_clause
|
||||
{ args =
|
||||
Cons
|
||||
( (u_sexp_grammar
|
||||
(T.t_sexp_grammar { untyped = Tyvar "a" }))
|
||||
.untyped
|
||||
, Empty )
|
||||
}
|
||||
}
|
||||
]
|
||||
}
|
||||
}
|
||||
; { tycon = "u"
|
||||
; tyvars = [ "a" ]
|
||||
; grammar =
|
||||
Variant
|
||||
{ case_sensitivity = Case_sensitive_except_first_character
|
||||
; clauses =
|
||||
[ No_tag
|
||||
{ name = "U"
|
||||
; clause_kind =
|
||||
List_clause
|
||||
{ args =
|
||||
Cons
|
||||
( (Maybe.t_sexp_grammar
|
||||
(t_sexp_grammar
|
||||
(T.t_sexp_grammar { untyped = Tyvar "a" })))
|
||||
.untyped
|
||||
, Empty )
|
||||
}
|
||||
}
|
||||
]
|
||||
}
|
||||
}
|
||||
])
|
||||
;;
|
||||
|
||||
let _ = grammars__001_
|
||||
end
|
||||
|
||||
let t_sexp_grammar : 'a. 'a Sexplib0.Sexp_grammar.t -> 'a t Sexplib0.Sexp_grammar.t =
|
||||
fun _'a_sexp_grammar ->
|
||||
{ untyped =
|
||||
Tycon ("t", [ _'a_sexp_grammar.untyped ], Stdlib.Lazy.force grammars__001_)
|
||||
}
|
||||
|
||||
and u_sexp_grammar : 'a. 'a Sexplib0.Sexp_grammar.t -> 'a u Sexplib0.Sexp_grammar.t =
|
||||
fun _'a_sexp_grammar ->
|
||||
{ untyped =
|
||||
Tycon ("u", [ _'a_sexp_grammar.untyped ], Stdlib.Lazy.force grammars__001_)
|
||||
}
|
||||
;;
|
||||
|
||||
let _ = t_sexp_grammar
|
||||
and _ = u_sexp_grammar
|
||||
end
|
||||
|
||||
[@@@end]
|
||||
|
||||
type 'a v = V of 'a t [@@deriving_inline sexp_grammar]
|
||||
|
||||
let _ = fun (_ : 'a v) -> ()
|
||||
|
||||
let v_sexp_grammar : 'a. 'a Sexplib0.Sexp_grammar.t -> 'a v Sexplib0.Sexp_grammar.t =
|
||||
fun _'a_sexp_grammar ->
|
||||
{ untyped =
|
||||
Variant
|
||||
{ case_sensitivity = Case_sensitive_except_first_character
|
||||
; clauses =
|
||||
[ No_tag
|
||||
{ name = "V"
|
||||
; clause_kind =
|
||||
List_clause
|
||||
{ args = Cons ((t_sexp_grammar _'a_sexp_grammar).untyped, Empty) }
|
||||
}
|
||||
]
|
||||
}
|
||||
}
|
||||
;;
|
||||
|
||||
let _ = v_sexp_grammar
|
||||
|
||||
[@@@end]
|
||||
end
|
||||
|
||||
module T1 = Make (Maybe)
|
||||
module T2 = Make (T1)
|
||||
|
||||
type t = int T2.t * int T1.t [@@deriving_inline sexp_grammar]
|
||||
|
||||
let _ = fun (_ : t) -> ()
|
||||
|
||||
let (t_sexp_grammar : t Sexplib0.Sexp_grammar.t) =
|
||||
{ untyped =
|
||||
Lazy
|
||||
(lazy
|
||||
(List
|
||||
(Cons
|
||||
( (T2.t_sexp_grammar int_sexp_grammar).untyped
|
||||
, Cons ((T1.t_sexp_grammar int_sexp_grammar).untyped, Empty) ))))
|
||||
}
|
||||
;;
|
||||
|
||||
let _ = t_sexp_grammar
|
||||
|
||||
[@@@end]
|
||||
|
|
@ -0,0 +1 @@
|
|||
(*_ This signature is deliberately empty. *)
|
||||
|
|
@ -0,0 +1,75 @@
|
|||
open! Base
|
||||
|
||||
type t = T : ('a[@sexp.opaque]) -> t [@@deriving sexp] [@@deriving_inline sexp_grammar]
|
||||
|
||||
let _ = fun (_ : t) -> ()
|
||||
|
||||
let (t_sexp_grammar : t Sexplib0.Sexp_grammar.t) =
|
||||
{ untyped =
|
||||
Lazy
|
||||
(lazy
|
||||
(Variant
|
||||
{ case_sensitivity = Case_sensitive_except_first_character
|
||||
; clauses =
|
||||
[ No_tag
|
||||
{ name = "T"
|
||||
; clause_kind =
|
||||
List_clause
|
||||
{ args =
|
||||
Cons (Sexplib0.Sexp_conv.opaque_sexp_grammar.untyped, Empty)
|
||||
}
|
||||
}
|
||||
]
|
||||
}))
|
||||
}
|
||||
;;
|
||||
|
||||
let _ = t_sexp_grammar
|
||||
|
||||
[@@@end]
|
||||
|
||||
type nullary = Nullary : nullary [@@deriving sexp] [@@deriving_inline sexp_grammar]
|
||||
|
||||
let _ = fun (_ : nullary) -> ()
|
||||
|
||||
let (nullary_sexp_grammar : nullary Sexplib0.Sexp_grammar.t) =
|
||||
{ untyped =
|
||||
Variant
|
||||
{ case_sensitivity = Case_sensitive_except_first_character
|
||||
; clauses = [ No_tag { name = "Nullary"; clause_kind = Atom_clause } ]
|
||||
}
|
||||
}
|
||||
;;
|
||||
|
||||
let _ = nullary_sexp_grammar
|
||||
|
||||
[@@@end]
|
||||
|
||||
(* We can't derive [of_sexp], but we can derive a sensible grammar for this type. *)
|
||||
type _ grammar_only = Grammar_only : int -> string grammar_only
|
||||
[@@warning "-37"] [@@deriving_inline sexp_grammar]
|
||||
|
||||
let _ = fun (_ : _ grammar_only) -> ()
|
||||
|
||||
let grammar_only_sexp_grammar :
|
||||
'a__016_.
|
||||
'a__016_ Sexplib0.Sexp_grammar.t -> 'a__016_ grammar_only Sexplib0.Sexp_grammar.t
|
||||
=
|
||||
fun _'a__016__sexp_grammar ->
|
||||
{ untyped =
|
||||
Variant
|
||||
{ case_sensitivity = Case_sensitive_except_first_character
|
||||
; clauses =
|
||||
[ No_tag
|
||||
{ name = "Grammar_only"
|
||||
; clause_kind =
|
||||
List_clause { args = Cons (int_sexp_grammar.untyped, Empty) }
|
||||
}
|
||||
]
|
||||
}
|
||||
}
|
||||
;;
|
||||
|
||||
let _ = grammar_only_sexp_grammar
|
||||
|
||||
[@@@end]
|
||||
|
|
@ -0,0 +1 @@
|
|||
(*_ This signature is deliberately empty. *)
|
||||
|
|
@ -0,0 +1,19 @@
|
|||
open! Base
|
||||
|
||||
open struct
|
||||
type t = int [@@deriving_inline sexp_grammar]
|
||||
|
||||
let _ = fun (_ : t) -> ()
|
||||
let (t_sexp_grammar : t Sexplib0.Sexp_grammar.t) = int_sexp_grammar
|
||||
let _ = t_sexp_grammar
|
||||
|
||||
[@@@end]
|
||||
end
|
||||
|
||||
type nonrec t = t [@@deriving_inline sexp_grammar]
|
||||
|
||||
let _ = fun (_ : t) -> ()
|
||||
let (t_sexp_grammar : t Sexplib0.Sexp_grammar.t) = t_sexp_grammar
|
||||
let _ = t_sexp_grammar
|
||||
|
||||
[@@@end]
|
||||
|
|
@ -0,0 +1 @@
|
|||
(*_ This signature is deliberately empty. *)
|
||||
|
|
@ -0,0 +1,15 @@
|
|||
open! Base
|
||||
|
||||
type t = (int[@sexp.opaque]) list [@@deriving_inline sexp_grammar]
|
||||
|
||||
let _ = fun (_ : t) -> ()
|
||||
|
||||
let (t_sexp_grammar : t Sexplib0.Sexp_grammar.t) =
|
||||
{ untyped =
|
||||
Lazy (lazy (list_sexp_grammar Sexplib0.Sexp_conv.opaque_sexp_grammar).untyped)
|
||||
}
|
||||
;;
|
||||
|
||||
let _ = t_sexp_grammar
|
||||
|
||||
[@@@end]
|
||||
|
|
@ -0,0 +1 @@
|
|||
(*_ This signature is deliberately empty. *)
|
||||
|
|
@ -0,0 +1,171 @@
|
|||
open Base
|
||||
|
||||
[@@@warning "-37"]
|
||||
|
||||
module _ = struct
|
||||
type 'a t =
|
||||
[ `A
|
||||
| `B
|
||||
]
|
||||
[@@deriving_inline sexp_grammar]
|
||||
|
||||
let _ = fun (_ : 'a t) -> ()
|
||||
|
||||
let t_sexp_grammar : 'a. 'a Sexplib0.Sexp_grammar.t -> 'a t Sexplib0.Sexp_grammar.t =
|
||||
fun _'a_sexp_grammar ->
|
||||
{ untyped =
|
||||
Variant
|
||||
{ case_sensitivity = Case_sensitive
|
||||
; clauses =
|
||||
[ No_tag { name = "A"; clause_kind = Atom_clause }
|
||||
; No_tag { name = "B"; clause_kind = Atom_clause }
|
||||
]
|
||||
}
|
||||
}
|
||||
;;
|
||||
|
||||
let _ = t_sexp_grammar
|
||||
|
||||
[@@@end]
|
||||
end
|
||||
|
||||
module _ = struct
|
||||
module With_sexp = struct
|
||||
type t =
|
||||
[ `A of int * int
|
||||
| `B of string
|
||||
]
|
||||
[@@deriving sexp_of]
|
||||
end
|
||||
|
||||
type t =
|
||||
[ `A of int * int
|
||||
| `B of string
|
||||
]
|
||||
[@@deriving_inline sexp_grammar]
|
||||
|
||||
let _ = fun (_ : t) -> ()
|
||||
|
||||
let (t_sexp_grammar : t Sexplib0.Sexp_grammar.t) =
|
||||
{ untyped =
|
||||
Lazy
|
||||
(lazy
|
||||
(Variant
|
||||
{ case_sensitivity = Case_sensitive
|
||||
; clauses =
|
||||
[ No_tag
|
||||
{ name = "A"
|
||||
; clause_kind =
|
||||
List_clause
|
||||
{ args =
|
||||
Cons
|
||||
( List
|
||||
(Cons
|
||||
( int_sexp_grammar.untyped
|
||||
, Cons (int_sexp_grammar.untyped, Empty) ))
|
||||
, Empty )
|
||||
}
|
||||
}
|
||||
; No_tag
|
||||
{ name = "B"
|
||||
; clause_kind =
|
||||
List_clause
|
||||
{ args = Cons (string_sexp_grammar.untyped, Empty) }
|
||||
}
|
||||
]
|
||||
}))
|
||||
}
|
||||
;;
|
||||
|
||||
let _ = t_sexp_grammar
|
||||
|
||||
[@@@end]
|
||||
|
||||
open Expect_test_helpers_base
|
||||
|
||||
let%expect_test _ =
|
||||
print_s (With_sexp.sexp_of_t (`A (1, 2)));
|
||||
print_s (With_sexp.sexp_of_t (`B "foo"));
|
||||
[%expect {|
|
||||
(A (1 2))
|
||||
(B foo)
|
||||
|}]
|
||||
;;
|
||||
end
|
||||
|
||||
module _ = struct
|
||||
module With_sexp = struct
|
||||
type t =
|
||||
[ `Int of int
|
||||
| `List of int list
|
||||
| `Sexp_dot_list of int list [@sexp.list]
|
||||
]
|
||||
[@@deriving sexp]
|
||||
end
|
||||
|
||||
type t =
|
||||
[ `Int of int
|
||||
| `List of int list
|
||||
| `Sexp_dot_list of int list [@sexp.list]
|
||||
]
|
||||
[@@deriving_inline sexp_grammar]
|
||||
|
||||
let _ = fun (_ : t) -> ()
|
||||
|
||||
let (t_sexp_grammar : t Sexplib0.Sexp_grammar.t) =
|
||||
{ untyped =
|
||||
Lazy
|
||||
(lazy
|
||||
(Variant
|
||||
{ case_sensitivity = Case_sensitive
|
||||
; clauses =
|
||||
[ No_tag
|
||||
{ name = "Int"
|
||||
; clause_kind =
|
||||
List_clause { args = Cons (int_sexp_grammar.untyped, Empty) }
|
||||
}
|
||||
; No_tag
|
||||
{ name = "List"
|
||||
; clause_kind =
|
||||
List_clause
|
||||
{ args =
|
||||
Cons ((list_sexp_grammar int_sexp_grammar).untyped, Empty)
|
||||
}
|
||||
}
|
||||
; No_tag
|
||||
{ name = "Sexp_dot_list"
|
||||
; clause_kind =
|
||||
List_clause { args = Many int_sexp_grammar.untyped }
|
||||
}
|
||||
]
|
||||
}))
|
||||
}
|
||||
;;
|
||||
|
||||
let _ = t_sexp_grammar
|
||||
|
||||
[@@@end]
|
||||
|
||||
let (T : (With_sexp.t, t) Type_equal.t) = T
|
||||
|
||||
open Expect_test_helpers_base
|
||||
|
||||
let%expect_test _ =
|
||||
print_s (With_sexp.sexp_of_t (`Int 1));
|
||||
List.iter
|
||||
[ []; [ 1 ]; [ 1; 2 ] ]
|
||||
~f:(fun l ->
|
||||
print_s (With_sexp.sexp_of_t (`List l));
|
||||
print_s (With_sexp.sexp_of_t (`Sexp_dot_list l)));
|
||||
[%expect
|
||||
{|
|
||||
(Int 1)
|
||||
(List ())
|
||||
(Sexp_dot_list)
|
||||
(List (1))
|
||||
(Sexp_dot_list 1)
|
||||
(List (1 2))
|
||||
(Sexp_dot_list 1 2)
|
||||
|}]
|
||||
;;
|
||||
end
|
||||
|
|
@ -0,0 +1 @@
|
|||
(*_ This signature is deliberately empty. *)
|
||||
|
|
@ -0,0 +1,115 @@
|
|||
(* This toplevel test exercises some polymorphic variants that sexp_grammar rejects. We
|
||||
show that in each case, the compiler or sexp would have given an error anyway. *)
|
||||
|
||||
open Base
|
||||
|
||||
type t = [ `A of int & string ] [@@deriving sexp]
|
||||
|
||||
[%%expect
|
||||
{|
|
||||
Line _, characters _-_:
|
||||
Error: unsupported: polymorphic variant intersection type
|
||||
|}]
|
||||
|
||||
type t = [ `A of int & string ] [@@deriving sexp_grammar]
|
||||
|
||||
[%%expect
|
||||
{|
|
||||
Line _, characters _-_:
|
||||
Error: sexp_grammar: intersection types are unsupported
|
||||
|}]
|
||||
|
||||
type t = [> `A ] [@@deriving sexp]
|
||||
|
||||
[%%expect
|
||||
{|
|
||||
Line _, characters _-_:
|
||||
Error: Type unsupported for ppx [of_sexp] conversion
|
||||
|}]
|
||||
|
||||
type t = [> `A ] [@@deriving sexp_grammar]
|
||||
|
||||
[%%expect
|
||||
{|
|
||||
Line _, characters _-_:
|
||||
Error: sexp_grammar: open polymorphic variant types are unsupported
|
||||
|}]
|
||||
|
||||
type t = [< `A ] [@@deriving sexp]
|
||||
|
||||
[%%expect
|
||||
{|
|
||||
Line _, characters _-_:
|
||||
Error: A type variable is unbound in this type declaration.
|
||||
In type [< `A ] as 'a the variable 'a is unbound
|
||||
|}]
|
||||
|
||||
type t = [< `A ] [@@deriving sexp_grammar]
|
||||
|
||||
[%%expect
|
||||
{|
|
||||
Line _, characters _-_:
|
||||
Error: A type variable is unbound in this type declaration.
|
||||
In type [< `A ] as 'a the variable 'a is unbound
|
||||
|}]
|
||||
|
||||
type 'a t = [< `A ] as 'a [@@deriving sexp]
|
||||
|
||||
[%%expect
|
||||
{|
|
||||
Line _, characters _-_:
|
||||
Error: Type unsupported for ppx [of_sexp] conversion
|
||||
|}]
|
||||
|
||||
type 'a t = [< `A ] as 'a [@@deriving sexp_grammar]
|
||||
|
||||
[%%expect
|
||||
{|
|
||||
Line _, characters _-_:
|
||||
Error: sexp_grammar: type aliases are unsupported
|
||||
|}]
|
||||
|
||||
type a = A : [> ] -> a [@@deriving sexp]
|
||||
|
||||
[%%expect
|
||||
{|
|
||||
Line _, characters _-_:
|
||||
Error: Type unsupported for ppx [of_sexp] conversion
|
||||
|}]
|
||||
|
||||
type a = A : [> ] -> a [@@deriving sexp_of]
|
||||
|
||||
[%%expect
|
||||
{|
|
||||
Line _, characters _-_:
|
||||
Error: Type unsupported for ppx [sexp_of] conversion
|
||||
|}]
|
||||
|
||||
type a = [ `A ] [@@deriving sexp];;
|
||||
|
||||
#verbose true
|
||||
|
||||
let f = [%sexp_of: [< a ]]
|
||||
|
||||
[%%expect
|
||||
{|
|
||||
val f : [< a ] -> Sexp.t = <fun>
|
||||
|}]
|
||||
|
||||
let f = [%of_sexp: [> a ]]
|
||||
|
||||
[%%expect
|
||||
{|
|
||||
Line _, characters _-_:
|
||||
Error: Type unsupported for ppx [of_sexp] conversion
|
||||
|}]
|
||||
|
||||
let f = [%of_sexp: [ | a ]]
|
||||
|
||||
[%%expect
|
||||
{|
|
||||
val f : Sexp.t -> a = <fun>
|
||||
|}]
|
||||
;;
|
||||
|
||||
#verbose false
|
||||
|
|
@ -0,0 +1,34 @@
|
|||
open! Base
|
||||
|
||||
type ('a, _, 'b) t = 'a * 'b
|
||||
and u = (string, int, float) t [@@deriving_inline sexp_grammar]
|
||||
|
||||
let _ = fun (_ : ('a, _, 'b) t) -> ()
|
||||
let _ = fun (_ : u) -> ()
|
||||
|
||||
let t_sexp_grammar :
|
||||
'a 'b__001_ 'b.
|
||||
'a Sexplib0.Sexp_grammar.t
|
||||
-> 'b__001_ Sexplib0.Sexp_grammar.t
|
||||
-> 'b Sexplib0.Sexp_grammar.t
|
||||
-> ('a, 'b__001_, 'b) t Sexplib0.Sexp_grammar.t
|
||||
=
|
||||
fun _'a_sexp_grammar _'b__001__sexp_grammar _'b_sexp_grammar ->
|
||||
{ untyped =
|
||||
List (Cons (_'a_sexp_grammar.untyped, Cons (_'b_sexp_grammar.untyped, Empty)))
|
||||
}
|
||||
;;
|
||||
|
||||
let _ = t_sexp_grammar
|
||||
|
||||
let (u_sexp_grammar : u Sexplib0.Sexp_grammar.t) =
|
||||
{ untyped =
|
||||
Lazy
|
||||
(lazy
|
||||
(t_sexp_grammar string_sexp_grammar int_sexp_grammar float_sexp_grammar).untyped)
|
||||
}
|
||||
;;
|
||||
|
||||
let _ = u_sexp_grammar
|
||||
|
||||
[@@@end]
|
||||
|
|
@ -0,0 +1 @@
|
|||
(*_ This signature is deliberately empty. *)
|
||||
|
|
@ -0,0 +1,112 @@
|
|||
open Base
|
||||
|
||||
[@@@warning "-37"]
|
||||
|
||||
module _ = struct
|
||||
type t = T of int [@@deriving_inline sexp_grammar]
|
||||
|
||||
let _ = fun (_ : t) -> ()
|
||||
|
||||
let (t_sexp_grammar : t Sexplib0.Sexp_grammar.t) =
|
||||
{ untyped =
|
||||
Lazy
|
||||
(lazy
|
||||
(Variant
|
||||
{ case_sensitivity = Case_sensitive_except_first_character
|
||||
; clauses =
|
||||
[ No_tag
|
||||
{ name = "T"
|
||||
; clause_kind =
|
||||
List_clause { args = Cons (int_sexp_grammar.untyped, Empty) }
|
||||
}
|
||||
]
|
||||
}))
|
||||
}
|
||||
;;
|
||||
|
||||
let _ = t_sexp_grammar
|
||||
|
||||
[@@@end]
|
||||
end
|
||||
|
||||
module _ = struct
|
||||
type t =
|
||||
| T_int of int
|
||||
| T_u of u
|
||||
|
||||
and u =
|
||||
| U_int of int
|
||||
| U_t of t
|
||||
[@@deriving_inline sexp_grammar]
|
||||
|
||||
let _ = fun (_ : t) -> ()
|
||||
let _ = fun (_ : u) -> ()
|
||||
|
||||
include struct
|
||||
open struct
|
||||
let (grammars__001_ : Sexplib0.Sexp_grammar.defn Stdlib.List.t Stdlib.Lazy.t) =
|
||||
lazy
|
||||
(let (t_sexp_grammar : t Sexplib0.Sexp_grammar.t) =
|
||||
{ untyped = Recursive ("t", []) }
|
||||
and (u_sexp_grammar : u Sexplib0.Sexp_grammar.t) =
|
||||
{ untyped = Recursive ("u", []) }
|
||||
in
|
||||
[ { tycon = "t"
|
||||
; tyvars = []
|
||||
; grammar =
|
||||
Variant
|
||||
{ case_sensitivity = Case_sensitive_except_first_character
|
||||
; clauses =
|
||||
[ No_tag
|
||||
{ name = "T_int"
|
||||
; clause_kind =
|
||||
List_clause
|
||||
{ args = Cons (int_sexp_grammar.untyped, Empty) }
|
||||
}
|
||||
; No_tag
|
||||
{ name = "T_u"
|
||||
; clause_kind =
|
||||
List_clause { args = Cons (u_sexp_grammar.untyped, Empty) }
|
||||
}
|
||||
]
|
||||
}
|
||||
}
|
||||
; { tycon = "u"
|
||||
; tyvars = []
|
||||
; grammar =
|
||||
Variant
|
||||
{ case_sensitivity = Case_sensitive_except_first_character
|
||||
; clauses =
|
||||
[ No_tag
|
||||
{ name = "U_int"
|
||||
; clause_kind =
|
||||
List_clause
|
||||
{ args = Cons (int_sexp_grammar.untyped, Empty) }
|
||||
}
|
||||
; No_tag
|
||||
{ name = "U_t"
|
||||
; clause_kind =
|
||||
List_clause { args = Cons (t_sexp_grammar.untyped, Empty) }
|
||||
}
|
||||
]
|
||||
}
|
||||
}
|
||||
])
|
||||
;;
|
||||
|
||||
let _ = grammars__001_
|
||||
end
|
||||
|
||||
let (t_sexp_grammar : t Sexplib0.Sexp_grammar.t) =
|
||||
{ untyped = Lazy (lazy (Tycon ("t", [], Stdlib.Lazy.force grammars__001_))) }
|
||||
|
||||
and (u_sexp_grammar : u Sexplib0.Sexp_grammar.t) =
|
||||
{ untyped = Lazy (lazy (Tycon ("u", [], Stdlib.Lazy.force grammars__001_))) }
|
||||
;;
|
||||
|
||||
let _ = t_sexp_grammar
|
||||
and _ = u_sexp_grammar
|
||||
end
|
||||
|
||||
[@@@end]
|
||||
end
|
||||
|
|
@ -0,0 +1 @@
|
|||
(*_ This signature is deliberately empty. *)
|
||||
|
|
@ -0,0 +1,163 @@
|
|||
open Base
|
||||
|
||||
[@@@warning "-37"]
|
||||
|
||||
module _ = struct
|
||||
type 'a t =
|
||||
| A
|
||||
| B
|
||||
[@@deriving_inline sexp_grammar]
|
||||
|
||||
let _ = fun (_ : 'a t) -> ()
|
||||
|
||||
let t_sexp_grammar : 'a. 'a Sexplib0.Sexp_grammar.t -> 'a t Sexplib0.Sexp_grammar.t =
|
||||
fun _'a_sexp_grammar ->
|
||||
{ untyped =
|
||||
Variant
|
||||
{ case_sensitivity = Case_sensitive_except_first_character
|
||||
; clauses =
|
||||
[ No_tag { name = "A"; clause_kind = Atom_clause }
|
||||
; No_tag { name = "B"; clause_kind = Atom_clause }
|
||||
]
|
||||
}
|
||||
}
|
||||
;;
|
||||
|
||||
let _ = t_sexp_grammar
|
||||
|
||||
[@@@end]
|
||||
end
|
||||
|
||||
module _ = struct
|
||||
module With_sexp = struct
|
||||
type t =
|
||||
| A of int * int
|
||||
| B of string
|
||||
[@@deriving sexp_of]
|
||||
end
|
||||
|
||||
type t = With_sexp.t =
|
||||
| A of int * int
|
||||
| B of string
|
||||
[@@deriving_inline sexp_grammar]
|
||||
|
||||
let _ = fun (_ : t) -> ()
|
||||
|
||||
let (t_sexp_grammar : t Sexplib0.Sexp_grammar.t) =
|
||||
{ untyped =
|
||||
Lazy
|
||||
(lazy
|
||||
(Variant
|
||||
{ case_sensitivity = Case_sensitive_except_first_character
|
||||
; clauses =
|
||||
[ No_tag
|
||||
{ name = "A"
|
||||
; clause_kind =
|
||||
List_clause
|
||||
{ args =
|
||||
Cons
|
||||
( int_sexp_grammar.untyped
|
||||
, Cons (int_sexp_grammar.untyped, Empty) )
|
||||
}
|
||||
}
|
||||
; No_tag
|
||||
{ name = "B"
|
||||
; clause_kind =
|
||||
List_clause
|
||||
{ args = Cons (string_sexp_grammar.untyped, Empty) }
|
||||
}
|
||||
]
|
||||
}))
|
||||
}
|
||||
;;
|
||||
|
||||
let _ = t_sexp_grammar
|
||||
|
||||
[@@@end]
|
||||
|
||||
open Expect_test_helpers_base
|
||||
|
||||
let%expect_test _ =
|
||||
print_s (With_sexp.sexp_of_t (A (1, 2)));
|
||||
print_s (With_sexp.sexp_of_t (B "foo"));
|
||||
[%expect {|
|
||||
(A 1 2)
|
||||
(B foo)
|
||||
|}]
|
||||
;;
|
||||
end
|
||||
|
||||
module _ = struct
|
||||
module With_sexp = struct
|
||||
type t =
|
||||
| Int of int
|
||||
| List of int list
|
||||
| Sexp_dot_list of int list [@sexp.list]
|
||||
[@@deriving sexp]
|
||||
end
|
||||
|
||||
type t = With_sexp.t =
|
||||
| Int of int
|
||||
| List of int list
|
||||
| Sexp_dot_list of int list [@sexp.list]
|
||||
[@@deriving_inline sexp_grammar]
|
||||
|
||||
let _ = fun (_ : t) -> ()
|
||||
|
||||
let (t_sexp_grammar : t Sexplib0.Sexp_grammar.t) =
|
||||
{ untyped =
|
||||
Lazy
|
||||
(lazy
|
||||
(Variant
|
||||
{ case_sensitivity = Case_sensitive_except_first_character
|
||||
; clauses =
|
||||
[ No_tag
|
||||
{ name = "Int"
|
||||
; clause_kind =
|
||||
List_clause { args = Cons (int_sexp_grammar.untyped, Empty) }
|
||||
}
|
||||
; No_tag
|
||||
{ name = "List"
|
||||
; clause_kind =
|
||||
List_clause
|
||||
{ args =
|
||||
Cons ((list_sexp_grammar int_sexp_grammar).untyped, Empty)
|
||||
}
|
||||
}
|
||||
; No_tag
|
||||
{ name = "Sexp_dot_list"
|
||||
; clause_kind =
|
||||
List_clause { args = Many int_sexp_grammar.untyped }
|
||||
}
|
||||
]
|
||||
}))
|
||||
}
|
||||
;;
|
||||
|
||||
let _ = t_sexp_grammar
|
||||
|
||||
[@@@end]
|
||||
|
||||
let (T : (With_sexp.t, t) Type_equal.t) = T
|
||||
|
||||
open Expect_test_helpers_base
|
||||
|
||||
let%expect_test _ =
|
||||
print_s (With_sexp.sexp_of_t (Int 1));
|
||||
List.iter
|
||||
[ []; [ 1 ]; [ 1; 2 ] ]
|
||||
~f:(fun l ->
|
||||
print_s (With_sexp.sexp_of_t (List l));
|
||||
print_s (With_sexp.sexp_of_t (Sexp_dot_list l)));
|
||||
[%expect
|
||||
{|
|
||||
(Int 1)
|
||||
(List ())
|
||||
(Sexp_dot_list)
|
||||
(List (1))
|
||||
(Sexp_dot_list 1)
|
||||
(List (1 2))
|
||||
(Sexp_dot_list 1 2)
|
||||
|}]
|
||||
;;
|
||||
end
|
||||
|
|
@ -0,0 +1 @@
|
|||
(*_ This signature is deliberately empty. *)
|
||||
|
|
@ -0,0 +1,179 @@
|
|||
open! Base
|
||||
|
||||
module _ = struct
|
||||
(* Nonrecursive constant *)
|
||||
type t = [ `T of int ] [@@deriving_inline sexp_grammar]
|
||||
|
||||
let _ = fun (_ : t) -> ()
|
||||
|
||||
let (t_sexp_grammar : t Sexplib0.Sexp_grammar.t) =
|
||||
{ untyped =
|
||||
Lazy
|
||||
(lazy
|
||||
(Variant
|
||||
{ case_sensitivity = Case_sensitive
|
||||
; clauses =
|
||||
[ No_tag
|
||||
{ name = "T"
|
||||
; clause_kind =
|
||||
List_clause { args = Cons (int_sexp_grammar.untyped, Empty) }
|
||||
}
|
||||
]
|
||||
}))
|
||||
}
|
||||
;;
|
||||
|
||||
let _ = t_sexp_grammar
|
||||
|
||||
[@@@end]
|
||||
end
|
||||
|
||||
module _ = struct
|
||||
(* Recursive constant *)
|
||||
type t = [ `T of t ] [@@deriving_inline sexp_grammar]
|
||||
|
||||
let _ = fun (_ : t) -> ()
|
||||
|
||||
include struct
|
||||
open struct
|
||||
let (grammars__001_ : Sexplib0.Sexp_grammar.defn Stdlib.List.t Stdlib.Lazy.t) =
|
||||
lazy
|
||||
(let (t_sexp_grammar : t Sexplib0.Sexp_grammar.t) =
|
||||
{ untyped = Recursive ("t", []) }
|
||||
in
|
||||
[ { tycon = "t"
|
||||
; tyvars = []
|
||||
; grammar =
|
||||
Variant
|
||||
{ case_sensitivity = Case_sensitive
|
||||
; clauses =
|
||||
[ No_tag
|
||||
{ name = "T"
|
||||
; clause_kind =
|
||||
List_clause { args = Cons (t_sexp_grammar.untyped, Empty) }
|
||||
}
|
||||
]
|
||||
}
|
||||
}
|
||||
])
|
||||
;;
|
||||
|
||||
let _ = grammars__001_
|
||||
end
|
||||
|
||||
let (t_sexp_grammar : t Sexplib0.Sexp_grammar.t) =
|
||||
{ untyped = Lazy (lazy (Tycon ("t", [], Stdlib.Lazy.force grammars__001_))) }
|
||||
;;
|
||||
|
||||
let _ = t_sexp_grammar
|
||||
end
|
||||
|
||||
[@@@end]
|
||||
end
|
||||
|
||||
module _ = struct
|
||||
(* Nonrecursive parameterized *)
|
||||
type 'a t = [ `T of 'a ] [@@deriving_inline sexp_grammar]
|
||||
|
||||
let _ = fun (_ : 'a t) -> ()
|
||||
|
||||
let t_sexp_grammar : 'a. 'a Sexplib0.Sexp_grammar.t -> 'a t Sexplib0.Sexp_grammar.t =
|
||||
fun _'a_sexp_grammar ->
|
||||
{ untyped =
|
||||
Variant
|
||||
{ case_sensitivity = Case_sensitive
|
||||
; clauses =
|
||||
[ No_tag
|
||||
{ name = "T"
|
||||
; clause_kind =
|
||||
List_clause { args = Cons (_'a_sexp_grammar.untyped, Empty) }
|
||||
}
|
||||
]
|
||||
}
|
||||
}
|
||||
;;
|
||||
|
||||
let _ = t_sexp_grammar
|
||||
|
||||
[@@@end]
|
||||
end
|
||||
|
||||
module _ = struct
|
||||
(* Recursive parameterized *)
|
||||
type 'a t = [ `T of 'a t ] [@@deriving_inline sexp_grammar]
|
||||
|
||||
let _ = fun (_ : 'a t) -> ()
|
||||
|
||||
include struct
|
||||
open struct
|
||||
let (grammars__002_ : Sexplib0.Sexp_grammar.defn Stdlib.List.t Stdlib.Lazy.t) =
|
||||
lazy
|
||||
(let t_sexp_grammar
|
||||
: 'a. 'a Sexplib0.Sexp_grammar.t -> 'a t Sexplib0.Sexp_grammar.t
|
||||
=
|
||||
fun _'a_sexp_grammar ->
|
||||
{ untyped = Recursive ("t", [ _'a_sexp_grammar.untyped ]) }
|
||||
in
|
||||
[ { tycon = "t"
|
||||
; tyvars = [ "a" ]
|
||||
; grammar =
|
||||
Variant
|
||||
{ case_sensitivity = Case_sensitive
|
||||
; clauses =
|
||||
[ No_tag
|
||||
{ name = "T"
|
||||
; clause_kind =
|
||||
List_clause
|
||||
{ args =
|
||||
Cons
|
||||
( (t_sexp_grammar { untyped = Tyvar "a" }).untyped
|
||||
, Empty )
|
||||
}
|
||||
}
|
||||
]
|
||||
}
|
||||
}
|
||||
])
|
||||
;;
|
||||
|
||||
let _ = grammars__002_
|
||||
end
|
||||
|
||||
let t_sexp_grammar : 'a. 'a Sexplib0.Sexp_grammar.t -> 'a t Sexplib0.Sexp_grammar.t =
|
||||
fun _'a_sexp_grammar ->
|
||||
{ untyped =
|
||||
Tycon ("t", [ _'a_sexp_grammar.untyped ], Stdlib.Lazy.force grammars__002_)
|
||||
}
|
||||
;;
|
||||
|
||||
let _ = t_sexp_grammar
|
||||
end
|
||||
|
||||
[@@@end]
|
||||
end
|
||||
|
||||
module _ = struct
|
||||
(* Aliasing of non-parameterized type *)
|
||||
type t = int [@@deriving_inline sexp_grammar]
|
||||
|
||||
let _ = fun (_ : t) -> ()
|
||||
let (t_sexp_grammar : t Sexplib0.Sexp_grammar.t) = int_sexp_grammar
|
||||
let _ = t_sexp_grammar
|
||||
|
||||
[@@@end]
|
||||
end
|
||||
|
||||
module _ = struct
|
||||
(* Aliasing of parameterized type *)
|
||||
type 'a t = 'a list [@@deriving_inline sexp_grammar]
|
||||
|
||||
let _ = fun (_ : 'a t) -> ()
|
||||
|
||||
let t_sexp_grammar : 'a. 'a Sexplib0.Sexp_grammar.t -> 'a t Sexplib0.Sexp_grammar.t =
|
||||
fun _'a_sexp_grammar -> list_sexp_grammar _'a_sexp_grammar
|
||||
;;
|
||||
|
||||
let _ = t_sexp_grammar
|
||||
|
||||
[@@@end]
|
||||
end
|
||||
|
|
@ -0,0 +1 @@
|
|||
(*_ This signature is deliberately empty. *)
|
||||
493
unikernel/duniverse/ppx_sexp_conv/test/sexp_grammar/test_tags.ml
Normal file
493
unikernel/duniverse/ppx_sexp_conv/test/sexp_grammar/test_tags.ml
Normal file
|
|
@ -0,0 +1,493 @@
|
|||
open Base
|
||||
|
||||
module _ = struct
|
||||
module type S = sig
|
||||
type t [@@deriving sexp_grammar]
|
||||
end
|
||||
|
||||
let show_grammar (module M : S) =
|
||||
Expect_test_helpers_base.print_s ([%sexp_of: _ Sexp_grammar.t] [%sexp_grammar: M.t])
|
||||
;;
|
||||
|
||||
let%expect_test "basic" =
|
||||
show_grammar
|
||||
(module struct
|
||||
type nonrec t = (unit[@tag "key" = Atom "value"]) [@@deriving sexp_grammar]
|
||||
end);
|
||||
[%expect
|
||||
{|
|
||||
(Tagged (
|
||||
(key key)
|
||||
(value value)
|
||||
(grammar (List Empty))))
|
||||
|}]
|
||||
;;
|
||||
|
||||
let%expect_test "tag ordering" =
|
||||
show_grammar
|
||||
(module struct
|
||||
type nonrec t =
|
||||
(unit
|
||||
[@tag
|
||||
"key1" = Atom "value1";
|
||||
"key2" = Atom "value2"])
|
||||
[@@deriving sexp_grammar]
|
||||
end);
|
||||
[%expect
|
||||
{|
|
||||
(Tagged (
|
||||
(key key1)
|
||||
(value value1)
|
||||
(grammar (
|
||||
Tagged (
|
||||
(key key2)
|
||||
(value value2)
|
||||
(grammar (List Empty)))))))
|
||||
|}]
|
||||
;;
|
||||
|
||||
let%expect_test "tag idents/expressions" =
|
||||
show_grammar
|
||||
(module struct
|
||||
let k = "key"
|
||||
let v = Sexp.Atom "value"
|
||||
let kf () = k
|
||||
let vf () = v
|
||||
|
||||
type nonrec t =
|
||||
(unit
|
||||
[@tag
|
||||
k = v;
|
||||
kf () = vf ()])
|
||||
[@@deriving sexp_grammar]
|
||||
end);
|
||||
[%expect
|
||||
{|
|
||||
(Tagged (
|
||||
(key key)
|
||||
(value value)
|
||||
(grammar (
|
||||
Tagged (
|
||||
(key key)
|
||||
(value value)
|
||||
(grammar (List Empty)))))))
|
||||
|}]
|
||||
;;
|
||||
|
||||
let%expect_test "tag nesting" =
|
||||
show_grammar
|
||||
(module struct
|
||||
type nonrec t' = (unit[@sexp_grammar.tag "inner" = Atom "inner value"])
|
||||
[@@deriving sexp_grammar]
|
||||
|
||||
type nonrec t = (t'[@sexp_grammar.tag "outer" = Atom "outer value"])
|
||||
[@@deriving sexp_grammar]
|
||||
end);
|
||||
[%expect
|
||||
{|
|
||||
(Tagged (
|
||||
(key outer)
|
||||
(value "outer value")
|
||||
(grammar (
|
||||
Tagged (
|
||||
(key inner)
|
||||
(value "inner value")
|
||||
(grammar (List Empty)))))))
|
||||
|}]
|
||||
;;
|
||||
|
||||
let%expect_test "@tags attribute" =
|
||||
(* literal constant *)
|
||||
show_grammar
|
||||
(module struct
|
||||
type t = (unit[@tags [ "y", Atom "Y"; "z", Atom "Z" ]]) [@@deriving sexp_grammar]
|
||||
end);
|
||||
[%expect
|
||||
{|
|
||||
(Tagged (
|
||||
(key y)
|
||||
(value Y)
|
||||
(grammar (
|
||||
Tagged (
|
||||
(key z)
|
||||
(value Z)
|
||||
(grammar (List Empty)))))))
|
||||
|}];
|
||||
(* non-constant expression *)
|
||||
show_grammar
|
||||
(module struct
|
||||
type t =
|
||||
(unit
|
||||
[@tags List.concat [ [ "x", Sexp.Atom "X" ]; [ "y", Atom "Y"; "z", Atom "Z" ] ]])
|
||||
[@@deriving sexp_grammar]
|
||||
end);
|
||||
[%expect
|
||||
{|
|
||||
(Tagged (
|
||||
(key x)
|
||||
(value X)
|
||||
(grammar (
|
||||
Tagged (
|
||||
(key y)
|
||||
(value Y)
|
||||
(grammar (
|
||||
Tagged (
|
||||
(key z)
|
||||
(value Z)
|
||||
(grammar (List Empty))))))))))
|
||||
|}];
|
||||
(* cons onto non-constant expression *)
|
||||
show_grammar
|
||||
(module struct
|
||||
type t =
|
||||
(unit
|
||||
[@tags
|
||||
("w", Sexp.Atom "W")
|
||||
:: List.concat [ [ "x", Sexp.Atom "X" ]; [ "y", Atom "Y"; "z", Atom "Z" ] ]])
|
||||
[@@deriving sexp_grammar]
|
||||
end);
|
||||
[%expect
|
||||
{|
|
||||
(Tagged (
|
||||
(key w)
|
||||
(value W)
|
||||
(grammar (
|
||||
Tagged (
|
||||
(key x)
|
||||
(value X)
|
||||
(grammar (
|
||||
Tagged (
|
||||
(key y)
|
||||
(value Y)
|
||||
(grammar (
|
||||
Tagged (
|
||||
(key z)
|
||||
(value Z)
|
||||
(grammar (List Empty)))))))))))))
|
||||
|}];
|
||||
(* empty *)
|
||||
show_grammar
|
||||
(module struct
|
||||
type t = (unit[@tags List.concat []]) [@@deriving sexp_grammar]
|
||||
end);
|
||||
[%expect {| (List Empty) |}];
|
||||
(* with [@tag] *)
|
||||
show_grammar
|
||||
(module struct
|
||||
type t = (unit[@tag "a" = Atom "A"] [@tags [ "b", Atom "B" ]])
|
||||
[@@deriving sexp_grammar]
|
||||
end);
|
||||
[%expect
|
||||
{|
|
||||
(Tagged (
|
||||
(key a)
|
||||
(value A)
|
||||
(grammar (
|
||||
Tagged (
|
||||
(key b)
|
||||
(value B)
|
||||
(grammar (List Empty)))))))
|
||||
|}]
|
||||
;;
|
||||
|
||||
let%expect_test "doc comments - variant clauses" =
|
||||
show_grammar
|
||||
(module struct
|
||||
[@@@ocaml.warning "-37"]
|
||||
|
||||
(** IGNORED *)
|
||||
type t =
|
||||
| Clause0 of (unit[@tag "k0" = Atom "v0"]) (** first clause *)
|
||||
| Clause1 [@tag "k1" = Atom "v1"] (** second clause *)
|
||||
[@@deriving sexp_grammar ~tags_of_doc_comments]
|
||||
(** IGNORED *)
|
||||
end);
|
||||
[%expect
|
||||
{|
|
||||
(Variant (
|
||||
(case_sensitivity Case_sensitive_except_first_character)
|
||||
(clauses (
|
||||
(Tag (
|
||||
(key sexp_grammar.doc_comment)
|
||||
(value " first clause ")
|
||||
(grammar (
|
||||
No_tag (
|
||||
(name Clause0)
|
||||
(clause_kind (
|
||||
List_clause (
|
||||
args (
|
||||
Cons
|
||||
(Tagged (
|
||||
(key k0)
|
||||
(value v0)
|
||||
(grammar (List Empty))))
|
||||
Empty)))))))))
|
||||
(Tag (
|
||||
(key sexp_grammar.doc_comment)
|
||||
(value " second clause ")
|
||||
(grammar (
|
||||
Tag (
|
||||
(key k1)
|
||||
(value v1)
|
||||
(grammar (
|
||||
No_tag (
|
||||
(name Clause1)
|
||||
(clause_kind Atom_clause)))))))))))))
|
||||
|}]
|
||||
;;
|
||||
|
||||
let%expect_test "doc comments - poly variant clauses" =
|
||||
show_grammar
|
||||
(module struct
|
||||
[@@@ocaml.warning "-37"]
|
||||
|
||||
(** IGNORED *)
|
||||
type t =
|
||||
([ `Clause0 of (unit[@tag "k0" = Atom "v0"]) (** first clause *)
|
||||
| `Clause1 [@tag "k1" = Atom "v1"] (** second clause *)
|
||||
]
|
||||
[@tag "kouter" = Atom "vouter"])
|
||||
[@@deriving sexp_grammar ~tags_of_doc_comments]
|
||||
(** IGNORED *)
|
||||
end);
|
||||
[%expect
|
||||
{|
|
||||
(Tagged (
|
||||
(key kouter)
|
||||
(value vouter)
|
||||
(grammar (
|
||||
Variant (
|
||||
(case_sensitivity Case_sensitive)
|
||||
(clauses (
|
||||
(Tag (
|
||||
(key sexp_grammar.doc_comment)
|
||||
(value " first clause ")
|
||||
(grammar (
|
||||
No_tag (
|
||||
(name Clause0)
|
||||
(clause_kind (
|
||||
List_clause (
|
||||
args (
|
||||
Cons
|
||||
(Tagged (
|
||||
(key k0)
|
||||
(value v0)
|
||||
(grammar (List Empty))))
|
||||
Empty)))))))))
|
||||
(Tag (
|
||||
(key sexp_grammar.doc_comment)
|
||||
(value " second clause ")
|
||||
(grammar (
|
||||
Tag (
|
||||
(key k1)
|
||||
(value v1)
|
||||
(grammar (
|
||||
No_tag (
|
||||
(name Clause1)
|
||||
(clause_kind Atom_clause))))))))))))))))
|
||||
|}]
|
||||
;;
|
||||
|
||||
let%expect_test "doc comments - record fields" =
|
||||
show_grammar
|
||||
(module struct
|
||||
(** IGNORED *)
|
||||
type t =
|
||||
{ field0 : (unit[@tag "k0" = Atom "v0"]) (** first field *)
|
||||
; field1 : unit [@tag "k1" = Atom "v1"] (** second field *)
|
||||
}
|
||||
[@@deriving sexp_grammar ~tags_of_doc_comments]
|
||||
(** IGNORED *)
|
||||
end);
|
||||
[%expect
|
||||
{|
|
||||
(List (
|
||||
Fields (
|
||||
(allow_extra_fields false)
|
||||
(fields (
|
||||
(Tag (
|
||||
(key sexp_grammar.doc_comment)
|
||||
(value " first field ")
|
||||
(grammar (
|
||||
No_tag (
|
||||
(name field0)
|
||||
(required true)
|
||||
(args (
|
||||
Cons
|
||||
(Tagged (
|
||||
(key k0)
|
||||
(value v0)
|
||||
(grammar (List Empty))))
|
||||
Empty)))))))
|
||||
(Tag (
|
||||
(key sexp_grammar.doc_comment)
|
||||
(value " second field ")
|
||||
(grammar (
|
||||
Tag (
|
||||
(key k1)
|
||||
(value v1)
|
||||
(grammar (
|
||||
No_tag (
|
||||
(name field1)
|
||||
(required true)
|
||||
(args (Cons (List Empty) Empty)))))))))))))))
|
||||
|}]
|
||||
;;
|
||||
|
||||
let%expect_test "deriving sexp_grammar without tags_of_doc_comments" =
|
||||
show_grammar
|
||||
(module struct
|
||||
type t = { field : unit (** IGNORED *) } [@@deriving sexp_grammar]
|
||||
end);
|
||||
[%expect
|
||||
{|
|
||||
(List (
|
||||
Fields (
|
||||
(allow_extra_fields false)
|
||||
(fields ((
|
||||
No_tag (
|
||||
(name field)
|
||||
(required true)
|
||||
(args (Cons (List Empty) Empty)))))))))
|
||||
|}]
|
||||
;;
|
||||
|
||||
let%expect_test "doc comments on subexpressions" =
|
||||
show_grammar
|
||||
(module struct
|
||||
[@@@ocaml.warning "-37"]
|
||||
|
||||
type t = Foo of { bar : int (** inner *) } (** outer *)
|
||||
[@@deriving sexp_grammar ~tags_of_doc_comments]
|
||||
end);
|
||||
[%expect
|
||||
{|
|
||||
(Variant (
|
||||
(case_sensitivity Case_sensitive_except_first_character)
|
||||
(clauses ((
|
||||
Tag (
|
||||
(key sexp_grammar.doc_comment)
|
||||
(value " outer ")
|
||||
(grammar (
|
||||
No_tag (
|
||||
(name Foo)
|
||||
(clause_kind (
|
||||
List_clause (
|
||||
args (
|
||||
Fields (
|
||||
(allow_extra_fields false)
|
||||
(fields ((
|
||||
Tag (
|
||||
(key sexp_grammar.doc_comment)
|
||||
(value " inner ")
|
||||
(grammar (
|
||||
No_tag (
|
||||
(name bar)
|
||||
(required true)
|
||||
(args (Cons Integer Empty)))))))))))))))))))))))
|
||||
|}];
|
||||
show_grammar
|
||||
(module struct
|
||||
[@@@ocaml.warning "-37"]
|
||||
|
||||
type t = [ `A of [ `B (** inner *) ] (** outer *) ]
|
||||
[@@deriving sexp_grammar ~tags_of_doc_comments]
|
||||
end);
|
||||
[%expect
|
||||
{|
|
||||
(Variant (
|
||||
(case_sensitivity Case_sensitive)
|
||||
(clauses ((
|
||||
Tag (
|
||||
(key sexp_grammar.doc_comment)
|
||||
(value " outer ")
|
||||
(grammar (
|
||||
No_tag (
|
||||
(name A)
|
||||
(clause_kind (
|
||||
List_clause (
|
||||
args (
|
||||
Cons
|
||||
(Variant (
|
||||
(case_sensitivity Case_sensitive)
|
||||
(clauses ((
|
||||
Tag (
|
||||
(key sexp_grammar.doc_comment)
|
||||
(value " inner ")
|
||||
(grammar (
|
||||
No_tag (
|
||||
(name B)
|
||||
(clause_kind Atom_clause))))))))))
|
||||
Empty)))))))))))))
|
||||
|}];
|
||||
show_grammar
|
||||
(module struct
|
||||
[@@@ocaml.warning "-37"]
|
||||
|
||||
type t = { a : [ `B of int (** inner *) ] (** outer *) }
|
||||
[@@deriving sexp_grammar ~tags_of_doc_comments]
|
||||
end);
|
||||
[%expect
|
||||
{|
|
||||
(List (
|
||||
Fields (
|
||||
(allow_extra_fields false)
|
||||
(fields ((
|
||||
Tag (
|
||||
(key sexp_grammar.doc_comment)
|
||||
(value " outer ")
|
||||
(grammar (
|
||||
No_tag (
|
||||
(name a)
|
||||
(required true)
|
||||
(args (
|
||||
Cons
|
||||
(Variant (
|
||||
(case_sensitivity Case_sensitive)
|
||||
(clauses ((
|
||||
Tag (
|
||||
(key sexp_grammar.doc_comment)
|
||||
(value " inner ")
|
||||
(grammar (
|
||||
No_tag (
|
||||
(name B)
|
||||
(clause_kind (List_clause (args (Cons Integer Empty)))))))))))))
|
||||
Empty))))))))))))
|
||||
|}];
|
||||
show_grammar
|
||||
(module struct
|
||||
[@@@ocaml.warning "-37"]
|
||||
|
||||
type t = [ `A of [ `B (** inner *) ] option (** outer *) ]
|
||||
[@@deriving sexp_grammar ~tags_of_doc_comments]
|
||||
end);
|
||||
[%expect
|
||||
{|
|
||||
(Variant (
|
||||
(case_sensitivity Case_sensitive)
|
||||
(clauses ((
|
||||
Tag (
|
||||
(key sexp_grammar.doc_comment)
|
||||
(value " outer ")
|
||||
(grammar (
|
||||
No_tag (
|
||||
(name A)
|
||||
(clause_kind (
|
||||
List_clause (
|
||||
args (
|
||||
Cons
|
||||
(Option (
|
||||
Variant (
|
||||
(case_sensitivity Case_sensitive)
|
||||
(clauses ((
|
||||
Tag (
|
||||
(key sexp_grammar.doc_comment)
|
||||
(value " inner ")
|
||||
(grammar (
|
||||
No_tag (
|
||||
(name B)
|
||||
(clause_kind Atom_clause)))))))))))
|
||||
Empty)))))))))))))
|
||||
|}]
|
||||
;;
|
||||
end
|
||||
|
|
@ -0,0 +1 @@
|
|||
(* This interface intentionally left empty. *)
|
||||
|
|
@ -0,0 +1,62 @@
|
|||
open Ppx_sexp_conv_lib
|
||||
open Conv;;
|
||||
|
||||
#verbose true
|
||||
|
||||
module No_keys = struct
|
||||
type t = (unit[@sexp_grammar.tag]) [@@deriving sexp_grammar]
|
||||
end
|
||||
|
||||
[%%expect
|
||||
{|
|
||||
Line _, characters _-_:
|
||||
Error: :: expected
|
||||
|}]
|
||||
|
||||
module Key_literal_is_not_string = struct
|
||||
type t = (unit[@sexp_grammar.tag 1 = [%sexp ""]]) [@@deriving sexp_grammar]
|
||||
end
|
||||
|
||||
[%%expect
|
||||
{|
|
||||
Line _, characters _-_:
|
||||
Error: This expression has type int but an expression was expected of type
|
||||
string
|
||||
|}]
|
||||
|
||||
module Key_ident_is_not_string = struct
|
||||
let k = 1
|
||||
|
||||
type t = (unit[@sexp_grammar.tag k = [%sexp ""]]) [@@deriving sexp_grammar]
|
||||
end
|
||||
|
||||
[%%expect
|
||||
{|
|
||||
Line _, characters _-_:
|
||||
Error: This expression has type int but an expression was expected of type
|
||||
string
|
||||
|}]
|
||||
|
||||
module Value_literal_is_not_sexp = struct
|
||||
type t = (unit[@sexp_grammar.tag "key" = 1]) [@@deriving sexp_grammar]
|
||||
end
|
||||
|
||||
[%%expect
|
||||
{|
|
||||
Line _, characters _-_:
|
||||
Error: This expression has type int but an expression was expected of type
|
||||
Sexp.t
|
||||
|}]
|
||||
|
||||
module Value_ident_is_not_sexp = struct
|
||||
let v = 1
|
||||
|
||||
type t = (unit[@sexp_grammar.tag "key" = v]) [@@deriving sexp_grammar]
|
||||
end
|
||||
|
||||
[%%expect
|
||||
{|
|
||||
Line _, characters _-_:
|
||||
Error: This expression has type int but an expression was expected of type
|
||||
Sexp.t
|
||||
|}]
|
||||
|
|
@ -0,0 +1,86 @@
|
|||
open! Base
|
||||
|
||||
module _ = struct
|
||||
type t = int [@@deriving_inline sexp_grammar]
|
||||
|
||||
let _ = fun (_ : t) -> ()
|
||||
let (t_sexp_grammar : t Sexplib0.Sexp_grammar.t) = int_sexp_grammar
|
||||
let _ = t_sexp_grammar
|
||||
|
||||
[@@@deriving.end]
|
||||
end
|
||||
|
||||
module _ = struct
|
||||
type 'a t = T of 'a
|
||||
and 'a u = U of 'a t option [@@deriving_inline sexp_grammar]
|
||||
|
||||
let _ = fun (_ : 'a t) -> ()
|
||||
let _ = fun (_ : 'a u) -> ()
|
||||
|
||||
let t_sexp_grammar : 'a. 'a Sexplib0.Sexp_grammar.t -> 'a t Sexplib0.Sexp_grammar.t =
|
||||
fun _'a_sexp_grammar ->
|
||||
{ untyped =
|
||||
Variant
|
||||
{ case_sensitivity = Case_sensitive_except_first_character
|
||||
; clauses =
|
||||
[ No_tag
|
||||
{ name = "T"
|
||||
; clause_kind =
|
||||
List_clause { args = Cons (_'a_sexp_grammar.untyped, Empty) }
|
||||
}
|
||||
]
|
||||
}
|
||||
}
|
||||
;;
|
||||
|
||||
let _ = t_sexp_grammar
|
||||
|
||||
let u_sexp_grammar : 'a. 'a Sexplib0.Sexp_grammar.t -> 'a u Sexplib0.Sexp_grammar.t =
|
||||
fun _'a_sexp_grammar ->
|
||||
{ untyped =
|
||||
Variant
|
||||
{ case_sensitivity = Case_sensitive_except_first_character
|
||||
; clauses =
|
||||
[ No_tag
|
||||
{ name = "U"
|
||||
; clause_kind =
|
||||
List_clause
|
||||
{ args =
|
||||
Cons
|
||||
( (option_sexp_grammar (t_sexp_grammar _'a_sexp_grammar))
|
||||
.untyped
|
||||
, Empty )
|
||||
}
|
||||
}
|
||||
]
|
||||
}
|
||||
}
|
||||
;;
|
||||
|
||||
let _ = u_sexp_grammar
|
||||
|
||||
[@@@deriving.end]
|
||||
|
||||
(* Avoid unused constructor warnings. *)
|
||||
let _ = T ()
|
||||
let _ = U None
|
||||
end
|
||||
|
||||
module _ = struct
|
||||
type ('a, 'b) t = 'a -> 'b [@@deriving_inline sexp_grammar]
|
||||
|
||||
let _ = fun (_ : ('a, 'b) t) -> ()
|
||||
|
||||
let t_sexp_grammar :
|
||||
'a 'b.
|
||||
'a Sexplib0.Sexp_grammar.t
|
||||
-> 'b Sexplib0.Sexp_grammar.t
|
||||
-> ('a, 'b) t Sexplib0.Sexp_grammar.t
|
||||
=
|
||||
fun _'a_sexp_grammar _'b_sexp_grammar -> Sexplib0.Sexp_conv.fun_sexp_grammar
|
||||
;;
|
||||
|
||||
let _ = t_sexp_grammar
|
||||
|
||||
[@@@end]
|
||||
end
|
||||
|
|
@ -0,0 +1 @@
|
|||
(*_ This signature is deliberately empty. *)
|
||||
|
|
@ -0,0 +1,93 @@
|
|||
open Base
|
||||
|
||||
[@@@warning "-37"]
|
||||
|
||||
module _ = struct
|
||||
type t = A of [ `A of int ] [@@deriving_inline sexp_grammar]
|
||||
|
||||
let _ = fun (_ : t) -> ()
|
||||
|
||||
let (t_sexp_grammar : t Sexplib0.Sexp_grammar.t) =
|
||||
{ untyped =
|
||||
Lazy
|
||||
(lazy
|
||||
(Variant
|
||||
{ case_sensitivity = Case_sensitive_except_first_character
|
||||
; clauses =
|
||||
[ No_tag
|
||||
{ name = "A"
|
||||
; clause_kind =
|
||||
List_clause
|
||||
{ args =
|
||||
Cons
|
||||
( Variant
|
||||
{ case_sensitivity = Case_sensitive
|
||||
; clauses =
|
||||
[ No_tag
|
||||
{ name = "A"
|
||||
; clause_kind =
|
||||
List_clause
|
||||
{ args =
|
||||
Cons
|
||||
( int_sexp_grammar.untyped
|
||||
, Empty )
|
||||
}
|
||||
}
|
||||
]
|
||||
}
|
||||
, Empty )
|
||||
}
|
||||
}
|
||||
]
|
||||
}))
|
||||
}
|
||||
;;
|
||||
|
||||
let _ = t_sexp_grammar
|
||||
|
||||
[@@@end]
|
||||
end
|
||||
|
||||
module _ = struct
|
||||
type t = { a : [ `A of int ] } [@@deriving_inline sexp_grammar]
|
||||
|
||||
let _ = fun (_ : t) -> ()
|
||||
|
||||
let (t_sexp_grammar : t Sexplib0.Sexp_grammar.t) =
|
||||
{ untyped =
|
||||
Lazy
|
||||
(lazy
|
||||
(List
|
||||
(Fields
|
||||
{ allow_extra_fields = false
|
||||
; fields =
|
||||
[ No_tag
|
||||
{ name = "a"
|
||||
; required = true
|
||||
; args =
|
||||
Cons
|
||||
( Variant
|
||||
{ case_sensitivity = Case_sensitive
|
||||
; clauses =
|
||||
[ No_tag
|
||||
{ name = "A"
|
||||
; clause_kind =
|
||||
List_clause
|
||||
{ args =
|
||||
Cons
|
||||
(int_sexp_grammar.untyped, Empty)
|
||||
}
|
||||
}
|
||||
]
|
||||
}
|
||||
, Empty )
|
||||
}
|
||||
]
|
||||
})))
|
||||
}
|
||||
;;
|
||||
|
||||
let _ = t_sexp_grammar
|
||||
|
||||
[@@@end]
|
||||
end
|
||||
34
unikernel/duniverse/ppx_sexp_conv/test/test.sexp
Normal file
34
unikernel/duniverse/ppx_sexp_conv/test/test.sexp
Normal file
|
|
@ -0,0 +1,34 @@
|
|||
(this is a list)
|
||||
|
||||
(this is another list and (this is a nested list))
|
||||
|
||||
(
|
||||
"\
|
||||
This is a multi-line \
|
||||
string with embedded
|
||||
|
||||
newlines."
|
||||
|
||||
"This string contains decimal \255, hex \xff codes, \
|
||||
and other \\ \n escapes."
|
||||
|
||||
A# # ## #x|
|
||||
)
|
||||
|
||||
; Line comment
|
||||
|
||||
#; (
|
||||
S-expression comment
|
||||
)
|
||||
|
||||
#| #| Nested |# block comment "|#" |#
|
||||
|
||||
#| "" |#
|
||||
#| ""|#
|
||||
#|"" |#
|
||||
#|""|#
|
||||
|
||||
#| "asdf" "asdf" |#
|
||||
|
||||
(something #| ; |# () "something else")
|
||||
|
||||
Loading…
Add table
Add a link
Reference in a new issue