Skip to content

Commit

Permalink
Cherry-picking stronger type equalities into pre-ppxlib
Browse files Browse the repository at this point in the history
This pull-request cherry-picks
#223 into pre-ppxlib.
  • Loading branch information
thierry-martinez committed May 24, 2020
1 parent 3b3b1e4 commit eb3e3b7
Show file tree
Hide file tree
Showing 2 changed files with 62 additions and 80 deletions.
31 changes: 19 additions & 12 deletions src/runtime/ppx_deriving_runtime.cppo.ml
Original file line number Diff line number Diff line change
Expand Up @@ -14,22 +14,25 @@ type nonrec int64 = int64
type nonrec 'a lazy_t = 'a lazy_t
type nonrec bytes = bytes

#if OCAML_VERSION >= (4, 08, 0)
(* We require 4.08 while 4.07 already has a Stdlib module.
In 4.07, the type equalities on Stdlib.Pervasives
are not strong enough for the 'include Stdlib'
below to satisfy the signature constraints on
Ppx_deriving_runtime.Pervasives. *)
#if OCAML_VERSION >= (4, 07, 0)
module Stdlib = Stdlib

include Stdlib

module Result = struct
type ('a, 'b) t = ('a, 'b) Result.t =
(* Type manifest shoud be [('a, 'b) result]:
- it can't be [Result.t] because [Result] is not defined in 4.07 std-lib
and the result package just exposes [Result.t] as an alias to [result]
without re-exporting the constructors
- it can't be [Result.result] because the [include Stdlib] above makes
[Result] be [Stdlib.Result] (shadowing the [Result] module from the
result package), and [Stdlib.Result] does not define [result] (that's
why we override the [Result] module as the first place. *)
type ('a, 'b) t = ('a, 'b) result =
| Ok of 'a
| Error of 'b

type ('a, 'b) result = ('a, 'b) Result.t =
type ('a, 'b) result = ('a, 'b) t =
| Ok of 'a
| Error of 'b
end
Expand Down Expand Up @@ -58,9 +61,12 @@ module Weak = Weak
module Printf = Printf
module Format = Format
module Buffer = Buffer

include Pervasives

module Result = struct
(* the "result" compatibility module defines Result.result,
not Result.t as the 4.08 stdlib *)
(* the "result" compatibility module defines Result.result as a variant
and Result.t as an alias *)
type ('a, 'b) t = ('a, 'b) Result.result =
| Ok of 'a
| Error of 'b
Expand All @@ -70,6 +76,9 @@ module Result = struct
| Ok of 'a
| Error of 'b
end
#endif

#if OCAML_VERSION < (4, 08, 0)
module Option = struct
type 'a t = 'a option

Expand All @@ -83,6 +92,4 @@ module Option = struct
| None -> Result.Error none
| Some x -> Result.Ok x
end

include Pervasives
#endif
111 changes: 43 additions & 68 deletions src/runtime/ppx_deriving_runtime.cppo.mli
Original file line number Diff line number Diff line change
Expand Up @@ -21,105 +21,80 @@ type nonrec bytes = bytes

(** {2 Predefined modules}
{3 Operations on predefined types} *)

#if OCAML_VERSION >= (4, 08, 0)
include (module type of Stdlib with
type fpclass = Stdlib.fpclass and
type in_channel = Stdlib.in_channel and
type out_channel = Stdlib.out_channel and
type open_flag = Stdlib.open_flag and
type 'a ref = 'a Stdlib.ref and
type ('a, 'b, 'c, 'd, 'e, 'f) format6 = ('a, 'b, 'c, 'd, 'e, 'f) Stdlib.format6 and
type ('a, 'b, 'c, 'd) format4 = ('a, 'b, 'c, 'd) Stdlib.format4 and
type ('a, 'b, 'c) format = ('a, 'b, 'c) Stdlib.format
)
#if OCAML_VERSION >= (4, 07, 0)
include module type of struct
include Stdlib
end

module Result : sig
type ('a, 'b) t = ('a, 'b) Result.t =
(* Type manifest shoud be [('a, 'b) result]:
- it can't be [Result.t] because [Result] is not defined in 4.07 std-lib
and the result package just exposes [Result.t] as an alias to [result]
without re-exporting the constructors
- it can't be [Result.result] because the [include Stdlib] above makes
[Result] be [Stdlib.Result] (shadowing the [Result] module from the
result package), and [Stdlib.Result] does not define [result] (that's
why we override the [Result] module as the first place. *)
type ('a, 'b) t = ('a, 'b) result =
| Ok of 'a
| Error of 'b

(* we also expose Result.result for backward-compatibility
with the Result package! *)
type ('a, 'b) result = ('a, 'b) Result.t =
type ('a, 'b) result = ('a, 'b) t =
| Ok of 'a
| Error of 'b
end
#else
module Pervasives : (module type of Pervasives with
type fpclass = Pervasives.fpclass and
type in_channel = Pervasives.in_channel and
type out_channel = Pervasives.out_channel and
type open_flag = Pervasives.open_flag and
type 'a ref = 'a Pervasives.ref and
type ('a, 'b, 'c, 'd, 'e, 'f) format6 = ('a, 'b, 'c, 'd, 'e, 'f) Pervasives.format6 and
type ('a, 'b, 'c, 'd) format4 = ('a, 'b, 'c, 'd) Pervasives.format4 and
type ('a, 'b, 'c) format = ('a, 'b, 'c) Pervasives.format)
module Pervasives = Pervasives

module Stdlib = Pervasives

include (module type of Pervasives with
type fpclass = Pervasives.fpclass and
type in_channel = Pervasives.in_channel and
type out_channel = Pervasives.out_channel and
type open_flag = Pervasives.open_flag and
type 'a ref = 'a Pervasives.ref and
type ('a, 'b, 'c, 'd, 'e, 'f) format6 = ('a, 'b, 'c, 'd, 'e, 'f) Pervasives.format6 and
type ('a, 'b, 'c, 'd) format4 = ('a, 'b, 'c, 'd) Pervasives.format4 and
type ('a, 'b, 'c) format = ('a, 'b, 'c) Pervasives.format)
include module type of struct
include Pervasives
end

module Char : (module type of Char)
module String : (module type of String)
module Printexc : (module type of Printexc with
type raw_backtrace = Printexc.raw_backtrace and
type backtrace_slot = Printexc.backtrace_slot and
type location = Printexc.location)
module Array : (module type of Array)
module List : (module type of List)
module Nativeint : (module type of Nativeint)
module Int32 : (module type of Int32)
module Int64 : (module type of Int64)
module Lazy : (module type of Lazy)
module Bytes : (module type of Bytes)
module Char = Char
module String = String
module Printexc = Printexc
module Array = Array
module List = List
module Nativeint = Nativeint
module Int32 = Int32
module Int64 = Int64
module Lazy = Lazy
module Bytes = Bytes

(** {3 Data structures} *)
module Hashtbl = Hashtbl
module Queue = Queue
module Stack = Stack
module Set = Set
module Map = Map
module Weak = Weak

module Printf = Printf
module Format = Format
module Buffer = Buffer

module Hashtbl : (module type of Hashtbl with
type ('a, 'b) t = ('a, 'b) Hashtbl.t and
type statistics = Hashtbl.statistics)
module Queue : (module type of Queue with
type 'a t = 'a Queue.t)
module Stack : (module type of Stack with
type 'a t = 'a Stack.t)
module Set : (module type of Set)
module Map : (module type of Map)
module Weak : (module type of Weak with
type 'a t = 'a Weak.t)
module Buffer : (module type of Buffer with
type t = Buffer.t)
module Result : sig
type ('a, 'b) t = ('a, 'b) Result.result =
| Ok of 'a
| Error of 'b

(* we also expose Result.result for backward-compatibility *)
(* we also expose Result.result for backward-compatibility
with the Result package! *)
type ('a, 'b) result = ('a, 'b) Result.result =
| Ok of 'a
| Error of 'b
end
#endif

#if OCAML_VERSION < (4, 08, 0)
module Option : sig
type 'a t = 'a option

val get : 'a t -> 'a

val to_result : none:'e -> 'a option -> ('a, 'e) Result.result
end

(** {3 Formatting} *)

module Printf : (module type of Printf)
module Format : (module type of Format with
type formatter_out_functions = Format.formatter_out_functions and
type formatter_tag_functions = Format.formatter_tag_functions and
type formatter = Format.formatter)
#endif

0 comments on commit eb3e3b7

Please sign in to comment.