├── dune ├── dune-project ├── .ocamlformat ├── .gitignore ├── test ├── test_monad.mli ├── higher_kinded_tests.mli ├── dune ├── test_monad.ml └── higher_kinded_tests.ml ├── src ├── higher_kinded.mli ├── dune ├── cinaps │ ├── dune │ ├── higher_kinded_cinaps.mli │ └── higher_kinded_cinaps.ml ├── higher_kinded.ml └── higher_kinded_intf.ml ├── Makefile ├── higher_kinded.opam ├── LICENSE.md ├── CONTRIBUTING.md └── README.mdx /dune: -------------------------------------------------------------------------------- 1 | -------------------------------------------------------------------------------- /dune-project: -------------------------------------------------------------------------------- 1 | (lang dune 3.17) 2 | -------------------------------------------------------------------------------- /.ocamlformat: -------------------------------------------------------------------------------- 1 | profile=janestreet 2 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | _build 2 | *.install 3 | *.merlin 4 | _opam 5 | 6 | -------------------------------------------------------------------------------- /test/test_monad.mli: -------------------------------------------------------------------------------- 1 | (*_ This signature is deliberately empty. *) 2 | -------------------------------------------------------------------------------- /test/higher_kinded_tests.mli: -------------------------------------------------------------------------------- 1 | (*_ This signature is deliberately empty. *) 2 | -------------------------------------------------------------------------------- /src/higher_kinded.mli: -------------------------------------------------------------------------------- 1 | include Higher_kinded_intf.Higher_kinded (** @inline *) 2 | -------------------------------------------------------------------------------- /src/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name higher_kinded) 3 | (public_name higher_kinded) 4 | (libraries base) 5 | (preprocess 6 | (pps ppx_jane))) 7 | -------------------------------------------------------------------------------- /src/cinaps/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name higher_kinded_cinaps) 3 | (libraries base cinaps_helpers ppxlib) 4 | (preprocess 5 | (pps ppx_jane))) 6 | -------------------------------------------------------------------------------- /test/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name higher_kinded_tests) 3 | (libraries base_quickcheck core 4 | expect_test_helpers_core.expect_test_helpers_base higher_kinded) 5 | (preprocess 6 | (pps ppx_jane))) 7 | -------------------------------------------------------------------------------- /src/cinaps/higher_kinded_cinaps.mli: -------------------------------------------------------------------------------- 1 | open! Base 2 | 3 | val print_module_type_monad : unit -> unit 4 | val print_module_type_s : unit -> unit 5 | val print_functor_implementations : unit -> unit 6 | val print_functor_types : unit -> unit 7 | val print_type_aliases : include_comments:bool -> unit 8 | -------------------------------------------------------------------------------- /Makefile: -------------------------------------------------------------------------------- 1 | INSTALL_ARGS := $(if $(PREFIX),--prefix $(PREFIX),) 2 | 3 | default: 4 | dune build 5 | 6 | install: 7 | dune install $(INSTALL_ARGS) 8 | 9 | uninstall: 10 | dune uninstall $(INSTALL_ARGS) 11 | 12 | reinstall: uninstall install 13 | 14 | clean: 15 | dune clean 16 | 17 | .PHONY: default install uninstall reinstall clean 18 | -------------------------------------------------------------------------------- /higher_kinded.opam: -------------------------------------------------------------------------------- 1 | opam-version: "2.0" 2 | maintainer: "Jane Street developers" 3 | authors: ["Jane Street Group, LLC"] 4 | homepage: "https://github.com/janestreet/higher_kinded" 5 | bug-reports: "https://github.com/janestreet/higher_kinded/issues" 6 | dev-repo: "git+https://github.com/janestreet/higher_kinded.git" 7 | doc: "https://ocaml.janestreet.com/ocaml-core/latest/doc/higher_kinded/index.html" 8 | license: "MIT" 9 | build: [ 10 | ["dune" "build" "-p" name "-j" jobs] 11 | ] 12 | depends: [ 13 | "ocaml" {>= "5.1.0"} 14 | "base" 15 | "ppx_jane" 16 | "dune" {>= "3.17.0"} 17 | ] 18 | available: arch != "arm32" & arch != "x86_32" 19 | synopsis: "A library with an encoding of higher kinded types in OCaml" 20 | description: " 21 | OCaml natively supports parameterized type constructors, such as =option=. The parameters 22 | of a type constructor may only be types, not arbitrary type constructors. This library 23 | makes it possible to parameterize a type with a witness that represents a type 24 | constructor. 25 | " 26 | -------------------------------------------------------------------------------- /LICENSE.md: -------------------------------------------------------------------------------- 1 | The MIT License 2 | 3 | Copyright (c) 2020--2025 Jane Street Group, LLC 4 | 5 | Permission is hereby granted, free of charge, to any person obtaining a copy 6 | of this software and associated documentation files (the "Software"), to deal 7 | in the Software without restriction, including without limitation the rights 8 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 9 | copies of the Software, and to permit persons to whom the Software is 10 | furnished to do so, subject to the following conditions: 11 | 12 | The above copyright notice and this permission notice shall be included in all 13 | copies or substantial portions of the Software. 14 | 15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 16 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 17 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 18 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 19 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 20 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 21 | SOFTWARE. 22 | -------------------------------------------------------------------------------- /CONTRIBUTING.md: -------------------------------------------------------------------------------- 1 | This repository contains open source software that is developed and 2 | maintained by [Jane Street][js]. 3 | 4 | Contributions to this project are welcome and should be submitted via 5 | GitHub pull requests. 6 | 7 | Signing contributions 8 | --------------------- 9 | 10 | We require that you sign your contributions. Your signature certifies 11 | that you wrote the patch or otherwise have the right to pass it on as 12 | an open-source patch. The rules are pretty simple: if you can certify 13 | the below (from [developercertificate.org][dco]): 14 | 15 | ``` 16 | Developer Certificate of Origin 17 | Version 1.1 18 | 19 | Copyright (C) 2004, 2006 The Linux Foundation and its contributors. 20 | 1 Letterman Drive 21 | Suite D4700 22 | San Francisco, CA, 94129 23 | 24 | Everyone is permitted to copy and distribute verbatim copies of this 25 | license document, but changing it is not allowed. 26 | 27 | 28 | Developer's Certificate of Origin 1.1 29 | 30 | By making a contribution to this project, I certify that: 31 | 32 | (a) The contribution was created in whole or in part by me and I 33 | have the right to submit it under the open source license 34 | indicated in the file; or 35 | 36 | (b) The contribution is based upon previous work that, to the best 37 | of my knowledge, is covered under an appropriate open source 38 | license and I have the right under that license to submit that 39 | work with modifications, whether created in whole or in part 40 | by me, under the same open source license (unless I am 41 | permitted to submit under a different license), as indicated 42 | in the file; or 43 | 44 | (c) The contribution was provided directly to me by some other 45 | person who certified (a), (b) or (c) and I have not modified 46 | it. 47 | 48 | (d) I understand and agree that this project and the contribution 49 | are public and that a record of the contribution (including all 50 | personal information I submit with it, including my sign-off) is 51 | maintained indefinitely and may be redistributed consistent with 52 | this project or the open source license(s) involved. 53 | ``` 54 | 55 | Then you just add a line to every git commit message: 56 | 57 | ``` 58 | Signed-off-by: Joe Smith 59 | ``` 60 | 61 | Use your real name (sorry, no pseudonyms or anonymous contributions.) 62 | 63 | If you set your `user.name` and `user.email` git configs, you can sign 64 | your commit automatically with git commit -s. 65 | 66 | [dco]: http://developercertificate.org/ 67 | [js]: https://opensource.janestreet.com/ 68 | -------------------------------------------------------------------------------- /test/test_monad.ml: -------------------------------------------------------------------------------- 1 | open! Core 2 | open! Expect_test_helpers_base 3 | 4 | (* Given a monad [M], [Make_monad] returns a monad [H] s.t. 5 | 6 | 1. [H.return] is [M.return], modulo [inject]/[project]. 7 | 2. [H.bind] is [M.bind], modulo [inject]/[project]. *) 8 | 9 | module type S = sig 10 | type 'a t [@@deriving equal, quickcheck, sexp_of] 11 | 12 | include Monad.S with type 'a t := 'a t 13 | end 14 | 15 | module Test (M : S) : sig end = struct 16 | module H = Higher_kinded.Make_monad (M) 17 | 18 | module type Bisimulation = sig 19 | type t [@@deriving quickcheck, sexp_of] 20 | 21 | module Output : sig 22 | type t [@@deriving equal, sexp_of] 23 | end 24 | 25 | val f1 : t -> Output.t 26 | val f2 : t -> Output.t 27 | end 28 | 29 | let bisimulate (module M : Bisimulation) = 30 | require_does_not_raise (fun () -> 31 | Base_quickcheck.Test.run_exn (module M) ~f:(fun x -> 32 | require_equal (module M.Output) (M.f1 x) (M.f2 x))) 33 | ;; 34 | 35 | let%expect_test "[H.return] is [M.return] modulo [inject]/[project]" = 36 | bisimulate 37 | (module struct 38 | type t = int [@@deriving quickcheck, sexp_of] 39 | 40 | module Output = struct 41 | type t = int M.t [@@deriving equal, sexp_of] 42 | end 43 | 44 | let f1 = M.return 45 | let f2 a = H.return a |> H.project 46 | end); 47 | [%expect {| |}] 48 | ;; 49 | 50 | let%expect_test "[H.bind] is [M.bind] modulo [inject]/[project]" = 51 | bisimulate 52 | (module struct 53 | type t = 54 | { m : int M.t 55 | ; f : int -> string M.t 56 | } 57 | [@@deriving quickcheck, sexp_of] 58 | 59 | module Output = struct 60 | type t = string M.t [@@deriving equal, sexp_of] 61 | end 62 | 63 | let f1 { m; f } = 64 | let open M in 65 | m >>= f 66 | ;; 67 | 68 | let f2 { m; f } = 69 | let open H in 70 | inject m >>= Fn.id (fun x -> inject (f x)) |> project 71 | ;; 72 | end); 73 | [%expect {| |}] 74 | ;; 75 | end 76 | 77 | module%test Option = Test (Option) 78 | 79 | module Short_list = struct 80 | include List 81 | 82 | let quickcheck_generator generate_a = 83 | let%bind.Base_quickcheck.Generator length = 84 | Base_quickcheck.Generator.int_inclusive 0 5 85 | in 86 | Base_quickcheck.Generator.list_with_length generate_a ~length 87 | ;; 88 | end 89 | 90 | (* js_of_ocaml is too slow to test with long lists. *) 91 | module%test [@tags "no-js"] List = Test (List) 92 | module%test [@tags "js-only"] List = Test (Short_list) 93 | -------------------------------------------------------------------------------- /src/cinaps/higher_kinded_cinaps.ml: -------------------------------------------------------------------------------- 1 | open! Base 2 | open! Ppxlib 3 | open! Cinaps_helpers 4 | 5 | let tyvars n = Core_type.var "a" :: Core_type.vars_n (Int.neg (n - 1)) 6 | 7 | let witness name vars = 8 | [ Core_type.arrow vars (Core_type.constr "higher_kinded" []) ] 9 | |> Core_type.constr name 10 | |> Core_type.to_string 11 | ;; 12 | 13 | let print_module_type_s () = 14 | print_n ~first:1 ~last:8 ~f:(fun n -> 15 | let nth = numbered n ~unless:1 in 16 | let type_ name = Core_type.constr name (tyvars n) |> Core_type.to_string in 17 | [%string 18 | {| 19 | module type S%{nth} = sig @@ portable 20 | type %{type_ "t"} 21 | type higher_kinded 22 | val inject : %{type_ "t"} -> %{witness "Higher_kinded.t" (tyvars n)} 23 | val project : %{witness "Higher_kinded.t" (tyvars n)} -> %{type_ "t"} 24 | end 25 | |}]) 26 | ;; 27 | 28 | let print_module_type_monad () = 29 | print_n ~first:1 ~last:3 ~f:(fun n -> 30 | let type_ name = Core_type.constr_n name n |> Core_type.to_string in 31 | let nth = numbered n ~unless:1 in 32 | [%string 33 | {| 34 | module type Monad%{nth} = sig 35 | include S%{nth} 36 | include Monad.S%{nth} with type %{type_ "t"} := %{witness "Higher_kinded.t" (Core_type.vars_n n)} 37 | end 38 | |}]) 39 | ;; 40 | 41 | let module_type_T n = 42 | [%string 43 | {| 44 | sig 45 | type %{Core_type.constr "t" (tyvars n)#Core_type} 46 | end 47 | |}] 48 | ;; 49 | 50 | let print_functor_types () = 51 | print_n ~first:1 ~last:8 ~f:(fun n -> 52 | let vars = tyvars n in 53 | let nth = numbered n ~unless:1 in 54 | [%string 55 | {| 56 | module Make%{nth} 57 | (X : %{module_type_T n}) 58 | : S%{nth} 59 | with type %{Core_type.constr "t" vars#Core_type} 60 | := %{Core_type.constr "X.t" vars#Core_type} 61 | |}]); 62 | let type_ name n = Core_type.constr_n name n |> Core_type.to_string in 63 | print_n ~first:1 ~last:3 ~f:(fun n -> 64 | let nth = numbered n ~unless:1 in 65 | [%string 66 | {| 67 | module Make_monad%{nth} 68 | (M : Monad.S%{nth}) 69 | : Monad%{nth} with type %{type_ "t" n} := %{type_ "M.t" n} 70 | |}]); 71 | print_n ~first:1 ~last:3 ~f:(fun n -> 72 | let nth = numbered n ~unless:1 in 73 | [%string 74 | {| 75 | module Make_monad_using_witness%{nth} 76 | (M : Monad.S%{nth}) 77 | (X : S%{nth} with type %{type_ "t" n} := %{type_ "M.t" n}) 78 | : Monad%{nth} 79 | with type %{type_ "t" n} := %{type_ "M.t" n} 80 | with type higher_kinded := X.higher_kinded 81 | |}]) 82 | ;; 83 | 84 | let print_functor_implementations () = 85 | print_n ~first:1 ~last:8 ~f:(fun n -> 86 | let nth = numbered n ~unless:1 in 87 | let type_ name = Core_type.constr name (tyvars n) |> Core_type.to_string in 88 | [%string 89 | {| 90 | module Make%{nth} (X : %{module_type_T n}) 91 | : S%{nth} with type %{type_ "t"} := %{type_ "X.t"} 92 | = struct 93 | type higher_kinded 94 | external inject : %{type_ "X.t"} -> %{witness "t" (tyvars n) } @@ portable = "%identity" 95 | external project : %{witness "t" (tyvars n)} -> %{type_ "X.t"} @@ portable = "%identity" 96 | end 97 | |}]); 98 | let type_ name n = Core_type.constr_n name n |> Core_type.to_string in 99 | print_n ~first:1 ~last:3 ~f:(fun n -> 100 | let nth = numbered n ~unless:1 in 101 | [%string 102 | {| 103 | module Make_monad_using_witness%{nth} 104 | (M : Monad.S%{nth}) 105 | (X : S%{nth} with type %{type_ "t" n} := %{type_ "M.t" n}) 106 | = struct 107 | include X 108 | 109 | include Monad_of_monad%{nth} (M) (struct 110 | type nonrec %{type_ "t" n} = %{witness "t" (Core_type.vars_n n)} 111 | 112 | let to_monad = project 113 | let of_monad = inject 114 | end) 115 | end 116 | |}]); 117 | print_n ~first:1 ~last:3 ~f:(fun n -> 118 | let nth = numbered n ~unless:1 in 119 | [%string 120 | {| 121 | module Make_monad%{nth} (M : Monad.S%{nth}) = 122 | Make_monad_using_witness%{nth} (M) (Make%{nth} (M)) 123 | |}]) 124 | ;; 125 | 126 | let print_type_aliases ~include_comments = 127 | print_n ~first:1 ~last:8 ~f:(fun n -> 128 | let nth = numbered n ~unless:1 in 129 | let t k witness = 130 | let kth = numbered k ~unless:0 in 131 | Core_type.constr [%string "t%{kth}"] (Core_type.vars_n k @ [ witness ]) 132 | in 133 | let a_t = t n (Core_type.constr "A.higher_kinded" []) in 134 | let a = Core_type.constr_n "A.t" n in 135 | let witness = Core_type.var "witness" in 136 | let this_t = t n witness in 137 | let prev_t = 138 | t (n - 1) (Core_type.arrow [ List.last_exn (Core_type.vars_n n) ] witness) 139 | in 140 | let comment = 141 | match include_comments with 142 | | false -> "" 143 | | true -> 144 | [%string 145 | {| 146 | (** If [A] implements the signature [S%{nth}], 147 | [%{a_t#Core_type}] 148 | is equivalent to 149 | [%{a#Core_type}]. *) 150 | |}] 151 | in 152 | [%string 153 | {| 154 | 155 | %{comment} 156 | type %{this_t#Core_type} = %{prev_t#Core_type} 157 | 158 | |}]) 159 | ;; 160 | -------------------------------------------------------------------------------- /README.mdx: -------------------------------------------------------------------------------- 1 | "Higher kinded types" 2 | ===================== 3 | 4 | OCaml natively supports parameterized type constructors, such as 5 | `option`. The parameters of a type constructor may only be types, not 6 | arbitrary type constructors. 7 | 8 | The following is not legal syntax: 9 | 10 | ``` 11 | type 'a person = 12 | { name : string 'a 13 | ; age : int 'a 14 | } 15 | ``` 16 | 17 | It is not possible to define such a type where `'a` can be replaced 18 | with something like `option` or `ref`, because you can't apply `'a` to 19 | other types like `string` or `int`. In other words, although `int 20 | option` is a valid type expression, `int 'a` is not. 21 | 22 | The `Higher_kinded` library makes something similar possible. The 23 | above example would be defined like this: 24 | 25 | ```ocaml 26 | type 'a person = 27 | { name : (string -> 'a) Higher_kinded.t 28 | ; age : (int -> 'a) Higher_kinded.t 29 | } 30 | ``` 31 | 32 | The fundamental concept of `Higher_kinded` is that a value of type `(a 33 | -> ... -> z -> C.higher_kinded) Higher_kinded.t` is equivalent to a 34 | value of type `(a, ..., z) C.t`. The only reason it is rendered as a 35 | function is that `->` is the only right associative type operator, 36 | which is useful for reasons that will be explained later. 37 | 38 | A signature defining a type constructor can include one of the 39 | `Higher_kinded.S` signatures, and its implementation should use one of 40 | the `Higher_kinded.Make` functors. For example, `Option` could look 41 | something like this: 42 | 43 | ```ocaml 44 | # module Option : sig 45 | type 'a t = 'a option 46 | 47 | include Higher_kinded.S with type 'a t := 'a t 48 | end = struct 49 | type 'a t = 'a option 50 | 51 | include Higher_kinded.Make (Base.Option) 52 | end 53 | module Option : 54 | sig 55 | type 'a t = 'a option 56 | type higher_kinded 57 | val inject : 'a t -> ('a -> higher_kinded) Higher_kinded.t @@ portable 58 | val project : ('a -> higher_kinded) Higher_kinded.t -> 'a t @@ portable 59 | end 60 | ``` 61 | 62 | Now it is possible to define values of type `(int -> 63 | Option.higher_kinded) Higher_kinded.t`: 64 | 65 | ```ocaml 66 | # let a = Option.inject (None : int option) 67 | val a : (int -> Option.higher_kinded) Higher_kinded.t = 68 | # let b = Option.inject (Some 42) 69 | val b : (int -> Option.higher_kinded) Higher_kinded.t = 70 | ``` 71 | 72 | Here is how to observe them: 73 | 74 | ```ocaml 75 | # Option.project b 76 | - : int option = Some 42 77 | ``` 78 | 79 | Now that `Option` can be used this way, we can express the `person` 80 | example from earlier: 81 | 82 | ```ocaml 83 | # let alice = { name = Option.inject (Some "alice doe"); age = Option.inject None } 84 | val alice : Option.higher_kinded person = {name = ; age = } 85 | ``` 86 | 87 | If we did the same thing with refs: 88 | 89 | ```ocaml 90 | module Ref : sig 91 | type 'a t = 'a ref 92 | 93 | include Higher_kinded.S with type 'a t := 'a t 94 | end = struct 95 | type 'a t = 'a ref 96 | 97 | include Higher_kinded.Make (Base.Ref) 98 | end 99 | ``` 100 | 101 | we could write: 102 | 103 | ```ocaml 104 | # let secret_agent = 105 | { name = Ref.inject (ref "alice"); age = Ref.inject (ref 55) } 106 | val secret_agent : Ref.higher_kinded person = {name = ; age = } 107 | ``` 108 | 109 | Here's how we could modify the references: 110 | 111 | ```ocaml 112 | Ref.project secret_agent.name := "Austin Powers"; 113 | Ref.project secret_agent.age := 35 114 | ``` 115 | 116 | The `inject` and `project` functions have no runtime cost; they only 117 | change the type. 118 | 119 | You can also use `Higher_kinded` for types that have multiple type 120 | parameters. Here is an example using `Result`: 121 | 122 | ```ocaml 123 | # module Result : sig 124 | type ('a, 'e) t = ('a, 'e) result 125 | 126 | include Higher_kinded.S2 with type ('a, 'e) t := ('a, 'e) t 127 | end = struct 128 | type ('a, 'e) t = ('a, 'e) result 129 | 130 | include Higher_kinded.Make2 (Base.Result) 131 | end 132 | module Result : 133 | sig 134 | type ('a, 'e) t = ('a, 'e) result 135 | type higher_kinded 136 | val inject : ('a, 'z) t -> ('a -> 'z -> higher_kinded) Higher_kinded.t @@ 137 | portable 138 | val project : ('a -> 'z -> higher_kinded) Higher_kinded.t -> ('a, 'z) t 139 | @@ portable 140 | end 141 | ``` 142 | 143 | You can even use multi-parameter higher kinded witnesses in positions 144 | expecting lower arity types. For example, suppose that you had an 145 | error type defined: 146 | 147 | ```ocaml 148 | type error = 149 | | Integer_overflow 150 | ``` 151 | 152 | Then you could write: 153 | 154 | ```ocaml 155 | # let immortal = 156 | { name = Result.inject (Ok "Keanu") 157 | ; age = Result.inject (Error Integer_overflow) 158 | } 159 | val immortal : (error -> Result.higher_kinded) person = 160 | {name = ; age = } 161 | ``` 162 | 163 | The resulting type uses a partially applied witness (in the above 164 | example, `error -> Result.higher_kinded`) that explains how to fill in 165 | the remaining arguments. 166 | 167 | This library is a variation on Jeremy Yallop and Leo White's 168 | "Lightweight higher-kinded polymorphism". 169 | -------------------------------------------------------------------------------- /test/higher_kinded_tests.ml: -------------------------------------------------------------------------------- 1 | open Core 2 | 3 | module%test [@name "documentation examples"] _ = struct 4 | module Option : sig 5 | type 'a t = 6 | | None 7 | | Some of 'a 8 | 9 | include Higher_kinded.S with type 'a t := 'a t 10 | end = struct 11 | module T = struct 12 | type 'a t = 13 | | None 14 | | Some of 'a 15 | end 16 | 17 | include T 18 | include Higher_kinded.Make (T) 19 | end 20 | 21 | type 't mytype = (unit -> 't) Higher_kinded.t 22 | 23 | let none0 : unit Option.t = Option.None 24 | and some0 : unit Option.t = Option.Some () 25 | 26 | let none1 : (unit -> Option.higher_kinded) Higher_kinded.t = Option.inject none0 27 | and some1 : (unit -> Option.higher_kinded) Higher_kinded.t = Option.inject some0 28 | 29 | let none2 : unit Option.t = Option.project none1 30 | and some2 : unit Option.t = Option.project some1 31 | 32 | let none1 : Option.higher_kinded mytype = none1 33 | and some1 : Option.higher_kinded mytype = some1 34 | 35 | let none1 : (unit -> Option.higher_kinded) Higher_kinded.t = none1 36 | and some1 : (unit -> Option.higher_kinded) Higher_kinded.t = some1 37 | 38 | let%test_unit "equalities" = 39 | assert (phys_same none0 none1); 40 | assert (phys_equal none0 none2); 41 | assert (phys_same some0 some1); 42 | assert (phys_equal some0 some2) 43 | ;; 44 | end 45 | 46 | module%test [@name "tests"] _ = struct 47 | type ('a, 'b, 'c, 'd, 'e, 'f, 'g, 'h) t = 48 | | Immediate 49 | | Allocated of 50 | { a : 'a 51 | ; b : 'b 52 | ; c : 'c 53 | ; d : 'd 54 | ; e : 'e 55 | ; f : 'f 56 | ; g : 'g 57 | ; h : 'h 58 | } 59 | [@@deriving compare, quickcheck, sexp_of] 60 | 61 | module type S = sig 62 | type injected 63 | 64 | val inject : (int, int, int, int, int, int, int, int) t -> injected 65 | val project : injected -> (int, int, int, int, int, int, int, int) t 66 | end 67 | 68 | let test (type injected) (module M : S with type injected = injected) = 69 | Quickcheck.test 70 | [%generator: (int, int, int, int, int, int, int, int) t] 71 | ~sexp_of:[%sexp_of: (int, int, int, int, int, int, int, int) t] 72 | ~shrinker:[%shrinker: (int, int, int, int, int, int, int, int) t] 73 | ~f:(fun orig -> 74 | let injected = M.inject orig in 75 | assert (phys_same orig injected); 76 | let projected = M.project injected in 77 | assert (phys_same injected projected); 78 | assert ( 79 | [%compare.equal: (int, int, int, int, int, int, int, int) t] orig projected)) 80 | ;; 81 | 82 | module T1 = struct 83 | include Higher_kinded.Make (struct 84 | type nonrec 'a t = ('a, int, int, int, int, int, int, int) t 85 | end) 86 | 87 | type injected = (int -> higher_kinded) Higher_kinded.t 88 | end 89 | 90 | module T2 = struct 91 | include Higher_kinded.Make2 (struct 92 | type nonrec ('a, 'b) t = ('a, 'b, int, int, int, int, int, int) t 93 | end) 94 | 95 | type injected = (int -> int -> higher_kinded) Higher_kinded.t 96 | end 97 | 98 | module T3 = struct 99 | include Higher_kinded.Make3 (struct 100 | type nonrec ('a, 'b, 'c) t = ('a, 'b, 'c, int, int, int, int, int) t 101 | end) 102 | 103 | type injected = (int -> int -> int -> higher_kinded) Higher_kinded.t 104 | end 105 | 106 | module T4 = struct 107 | include Higher_kinded.Make4 (struct 108 | type nonrec ('a, 'b, 'c, 'd) t = ('a, 'b, 'c, 'd, int, int, int, int) t 109 | end) 110 | 111 | type injected = (int -> int -> int -> int -> higher_kinded) Higher_kinded.t 112 | end 113 | 114 | module T5 = struct 115 | include Higher_kinded.Make5 (struct 116 | type nonrec ('a, 'b, 'c, 'd, 'e) t = ('a, 'b, 'c, 'd, 'e, int, int, int) t 117 | end) 118 | 119 | type injected = (int -> int -> int -> int -> int -> higher_kinded) Higher_kinded.t 120 | end 121 | 122 | module T6 = struct 123 | include Higher_kinded.Make6 (struct 124 | type nonrec ('a, 'b, 'c, 'd, 'e, 'f) t = ('a, 'b, 'c, 'd, 'e, 'f, int, int) t 125 | end) 126 | 127 | type injected = 128 | (int -> int -> int -> int -> int -> int -> higher_kinded) Higher_kinded.t 129 | end 130 | 131 | module T7 = struct 132 | include Higher_kinded.Make7 (struct 133 | type nonrec ('a, 'b, 'c, 'd, 'e, 'f, 'g) t = ('a, 'b, 'c, 'd, 'e, 'f, 'g, int) t 134 | end) 135 | 136 | type injected = 137 | (int -> int -> int -> int -> int -> int -> int -> higher_kinded) Higher_kinded.t 138 | end 139 | 140 | module T8 = struct 141 | include Higher_kinded.Make8 (struct 142 | type nonrec ('a, 'b, 'c, 'd, 'e, 'f, 'g, 'h) t = 143 | ('a, 'b, 'c, 'd, 'e, 'f, 'g, 'h) t 144 | end) 145 | 146 | type injected = 147 | (int -> int -> int -> int -> int -> int -> int -> int -> higher_kinded) 148 | Higher_kinded.t 149 | end 150 | 151 | let%test_unit "Make" = test (module T1) 152 | let%test_unit "Make2" = test (module T2) 153 | let%test_unit "Make3" = test (module T3) 154 | let%test_unit "Make4" = test (module T4) 155 | let%test_unit "Make5" = test (module T5) 156 | let%test_unit "Make6" = test (module T6) 157 | let%test_unit "Make7" = test (module T7) 158 | let%test_unit "Make8" = test (module T8) 159 | end 160 | -------------------------------------------------------------------------------- /src/higher_kinded.ml: -------------------------------------------------------------------------------- 1 | open Base 2 | open Higher_kinded_intf 3 | 4 | type 'a t 5 | 6 | (*$ Higher_kinded_cinaps.print_type_aliases ~include_comments:false *) 7 | 8 | type ('a, 'witness) t1 = ('a -> 'witness) t 9 | type ('a, 'b, 'witness) t2 = ('a, 'b -> 'witness) t1 10 | type ('a, 'b, 'c, 'witness) t3 = ('a, 'b, 'c -> 'witness) t2 11 | type ('a, 'b, 'c, 'd, 'witness) t4 = ('a, 'b, 'c, 'd -> 'witness) t3 12 | type ('a, 'b, 'c, 'd, 'e, 'witness) t5 = ('a, 'b, 'c, 'd, 'e -> 'witness) t4 13 | type ('a, 'b, 'c, 'd, 'e, 'f, 'witness) t6 = ('a, 'b, 'c, 'd, 'e, 'f -> 'witness) t5 14 | 15 | type ('a, 'b, 'c, 'd, 'e, 'f, 'g, 'witness) t7 = 16 | ('a, 'b, 'c, 'd, 'e, 'f, 'g -> 'witness) t6 17 | 18 | type ('a, 'b, 'c, 'd, 'e, 'f, 'g, 'h, 'witness) t8 = 19 | ('a, 'b, 'c, 'd, 'e, 'f, 'g, 'h -> 'witness) t7 20 | 21 | (*$*) 22 | 23 | include Higher_kinded_module_types (struct 24 | type nonrec 'a t = 'a t 25 | end) 26 | 27 | module Monad_of_monad3 28 | (M : Monad.S3) 29 | (T : sig 30 | type ('a, 'b, 'c) t 31 | 32 | val to_monad : ('a, 'b, 'c) t -> ('a, 'b, 'c) M.t 33 | val of_monad : ('a, 'b, 'c) M.t -> ('a, 'b, 'c) t 34 | end) = 35 | Monad.Make3 (struct 36 | type ('a, 'b, 'c) t = ('a, 'b, 'c) T.t 37 | 38 | let return a = T.of_monad (M.return a) 39 | let bind t ~f = M.bind (T.to_monad t) ~f:(fun a -> T.to_monad (f a)) |> T.of_monad 40 | let map = `Custom (fun t ~f -> M.map (T.to_monad t) ~f |> T.of_monad) 41 | end) 42 | 43 | module Monad_of_monad2 44 | (M : Monad.S2) 45 | (T : sig 46 | type ('a, 'b) t 47 | 48 | val to_monad : ('a, 'b) t -> ('a, 'b) M.t 49 | val of_monad : ('a, 'b) M.t -> ('a, 'b) t 50 | end) = 51 | Monad_of_monad3 52 | (struct 53 | type ('a, 'b, 'c) t = ('a, 'b) M.t 54 | 55 | include (M : module type of M with type ('a, 'b) t := ('a, 'b) M.t) 56 | end) 57 | (struct 58 | type ('a, 'b, 'c) t = ('a, 'b) T.t 59 | 60 | include (T : module type of T with type ('a, 'b) t := ('a, 'b) T.t) 61 | end) 62 | 63 | module Monad_of_monad 64 | (M : Monad.S) 65 | (T : sig 66 | type 'a t 67 | 68 | val to_monad : 'a t -> 'a M.t 69 | val of_monad : 'a M.t -> 'a t 70 | end) = 71 | Monad_of_monad2 72 | (struct 73 | type ('a, 'b) t = 'a M.t 74 | 75 | include (M : module type of M with type 'a t := 'a M.t) 76 | end) 77 | (struct 78 | type ('a, 'b) t = 'a T.t 79 | 80 | include (T : module type of T with type 'a t := 'a T.t) 81 | end) 82 | 83 | (*$ Higher_kinded_cinaps.print_functor_implementations () *) 84 | module Make (X : sig 85 | type 'a t 86 | end) : S with type 'a t := 'a X.t = struct 87 | type higher_kinded 88 | 89 | external inject : 'a X.t -> ('a -> higher_kinded) t = "%identity" 90 | external project : ('a -> higher_kinded) t -> 'a X.t = "%identity" 91 | end 92 | 93 | module Make2 (X : sig 94 | type ('a, 'z) t 95 | end) : S2 with type ('a, 'z) t := ('a, 'z) X.t = struct 96 | type higher_kinded 97 | 98 | external inject : ('a, 'z) X.t -> ('a -> 'z -> higher_kinded) t = "%identity" 99 | external project : ('a -> 'z -> higher_kinded) t -> ('a, 'z) X.t = "%identity" 100 | end 101 | 102 | module Make3 (X : sig 103 | type ('a, 'y, 'z) t 104 | end) : S3 with type ('a, 'y, 'z) t := ('a, 'y, 'z) X.t = struct 105 | type higher_kinded 106 | 107 | external inject : ('a, 'y, 'z) X.t -> ('a -> 'y -> 'z -> higher_kinded) t = "%identity" 108 | external project : ('a -> 'y -> 'z -> higher_kinded) t -> ('a, 'y, 'z) X.t = "%identity" 109 | end 110 | 111 | module Make4 (X : sig 112 | type ('a, 'x, 'y, 'z) t 113 | end) : S4 with type ('a, 'x, 'y, 'z) t := ('a, 'x, 'y, 'z) X.t = struct 114 | type higher_kinded 115 | 116 | external inject 117 | : ('a, 'x, 'y, 'z) X.t 118 | -> ('a -> 'x -> 'y -> 'z -> higher_kinded) t 119 | = "%identity" 120 | 121 | external project 122 | : ('a -> 'x -> 'y -> 'z -> higher_kinded) t 123 | -> ('a, 'x, 'y, 'z) X.t 124 | = "%identity" 125 | end 126 | 127 | module Make5 (X : sig 128 | type ('a, 'w, 'x, 'y, 'z) t 129 | end) : S5 with type ('a, 'w, 'x, 'y, 'z) t := ('a, 'w, 'x, 'y, 'z) X.t = struct 130 | type higher_kinded 131 | 132 | external inject 133 | : ('a, 'w, 'x, 'y, 'z) X.t 134 | -> ('a -> 'w -> 'x -> 'y -> 'z -> higher_kinded) t 135 | = "%identity" 136 | 137 | external project 138 | : ('a -> 'w -> 'x -> 'y -> 'z -> higher_kinded) t 139 | -> ('a, 'w, 'x, 'y, 'z) X.t 140 | = "%identity" 141 | end 142 | 143 | module Make6 (X : sig 144 | type ('a, 'v, 'w, 'x, 'y, 'z) t 145 | end) : S6 with type ('a, 'v, 'w, 'x, 'y, 'z) t := ('a, 'v, 'w, 'x, 'y, 'z) X.t = struct 146 | type higher_kinded 147 | 148 | external inject 149 | : ('a, 'v, 'w, 'x, 'y, 'z) X.t 150 | -> ('a -> 'v -> 'w -> 'x -> 'y -> 'z -> higher_kinded) t 151 | = "%identity" 152 | 153 | external project 154 | : ('a -> 'v -> 'w -> 'x -> 'y -> 'z -> higher_kinded) t 155 | -> ('a, 'v, 'w, 'x, 'y, 'z) X.t 156 | = "%identity" 157 | end 158 | 159 | module Make7 (X : sig 160 | type ('a, 'u, 'v, 'w, 'x, 'y, 'z) t 161 | end) : S7 with type ('a, 'u, 'v, 'w, 'x, 'y, 'z) t := ('a, 'u, 'v, 'w, 'x, 'y, 'z) X.t = 162 | struct 163 | type higher_kinded 164 | 165 | external inject 166 | : ('a, 'u, 'v, 'w, 'x, 'y, 'z) X.t 167 | -> ('a -> 'u -> 'v -> 'w -> 'x -> 'y -> 'z -> higher_kinded) t 168 | = "%identity" 169 | 170 | external project 171 | : ('a -> 'u -> 'v -> 'w -> 'x -> 'y -> 'z -> higher_kinded) t 172 | -> ('a, 'u, 'v, 'w, 'x, 'y, 'z) X.t 173 | = "%identity" 174 | end 175 | 176 | module Make8 (X : sig 177 | type ('a, 't, 'u, 'v, 'w, 'x, 'y, 'z) t 178 | end) : 179 | S8 with type ('a, 't, 'u, 'v, 'w, 'x, 'y, 'z) t := ('a, 't, 'u, 'v, 'w, 'x, 'y, 'z) X.t = 180 | struct 181 | type higher_kinded 182 | 183 | external inject 184 | : ('a, 't, 'u, 'v, 'w, 'x, 'y, 'z) X.t 185 | -> ('a -> 't -> 'u -> 'v -> 'w -> 'x -> 'y -> 'z -> higher_kinded) t 186 | = "%identity" 187 | 188 | external project 189 | : ('a -> 't -> 'u -> 'v -> 'w -> 'x -> 'y -> 'z -> higher_kinded) t 190 | -> ('a, 't, 'u, 'v, 'w, 'x, 'y, 'z) X.t 191 | = "%identity" 192 | end 193 | 194 | module Make_monad_using_witness (M : Monad.S) (X : S with type 'a t := 'a M.t) = struct 195 | include X 196 | 197 | include 198 | Monad_of_monad 199 | (M) 200 | (struct 201 | type nonrec 'a t = ('a -> higher_kinded) t 202 | 203 | let to_monad = project 204 | let of_monad = inject 205 | end) 206 | end 207 | 208 | module Make_monad_using_witness2 209 | (M : Monad.S2) 210 | (X : S2 with type ('a, 'b) t := ('a, 'b) M.t) = 211 | struct 212 | include X 213 | 214 | include 215 | Monad_of_monad2 216 | (M) 217 | (struct 218 | type nonrec ('a, 'b) t = ('a -> 'b -> higher_kinded) t 219 | 220 | let to_monad = project 221 | let of_monad = inject 222 | end) 223 | end 224 | 225 | module Make_monad_using_witness3 226 | (M : Monad.S3) 227 | (X : S3 with type ('a, 'b, 'c) t := ('a, 'b, 'c) M.t) = 228 | struct 229 | include X 230 | 231 | include 232 | Monad_of_monad3 233 | (M) 234 | (struct 235 | type nonrec ('a, 'b, 'c) t = ('a -> 'b -> 'c -> higher_kinded) t 236 | 237 | let to_monad = project 238 | let of_monad = inject 239 | end) 240 | end 241 | 242 | module Make_monad (M : Monad.S) = Make_monad_using_witness (M) (Make (M)) 243 | module Make_monad2 (M : Monad.S2) = Make_monad_using_witness2 (M) (Make2 (M)) 244 | module Make_monad3 (M : Monad.S3) = Make_monad_using_witness3 (M) (Make3 (M)) 245 | 246 | (*$*) 247 | include Make (struct 248 | type nonrec 'a t = 'a t 249 | end) 250 | 251 | module Array = Make (Array) 252 | module Either = Make2 (Either) 253 | module Hash_set = Make (Hash_set) 254 | module Hashtbl = Make2 (Hashtbl) 255 | module Ident = Make (Monad.Ident) 256 | module Lazy = Make (Lazy) 257 | module List = Make (List) 258 | module Map = Make3 (Map) 259 | module Option = Make (Option) 260 | module Queue = Make (Queue) 261 | module Ref = Make (Ref) 262 | module Result = Make2 (Result) 263 | module Set = Make2 (Set) 264 | module Sequence = Make (Sequence) 265 | module Type_equal = Make2 (Type_equal) 266 | -------------------------------------------------------------------------------- /src/higher_kinded_intf.ml: -------------------------------------------------------------------------------- 1 | open Base 2 | 3 | module Higher_kinded_module_types (Higher_kinded : T1) = struct 4 | (** These are the signatures implemented by the [Make] family of functors. *) 5 | 6 | (*$ Higher_kinded_cinaps.print_module_type_s () *) 7 | module type S = sig 8 | type 'a t 9 | type higher_kinded 10 | 11 | val inject : 'a t -> ('a -> higher_kinded) Higher_kinded.t 12 | val project : ('a -> higher_kinded) Higher_kinded.t -> 'a t 13 | end 14 | 15 | module type S2 = sig 16 | type ('a, 'z) t 17 | type higher_kinded 18 | 19 | val inject : ('a, 'z) t -> ('a -> 'z -> higher_kinded) Higher_kinded.t 20 | val project : ('a -> 'z -> higher_kinded) Higher_kinded.t -> ('a, 'z) t 21 | end 22 | 23 | module type S3 = sig 24 | type ('a, 'y, 'z) t 25 | type higher_kinded 26 | 27 | val inject : ('a, 'y, 'z) t -> ('a -> 'y -> 'z -> higher_kinded) Higher_kinded.t 28 | val project : ('a -> 'y -> 'z -> higher_kinded) Higher_kinded.t -> ('a, 'y, 'z) t 29 | end 30 | 31 | module type S4 = sig 32 | type ('a, 'x, 'y, 'z) t 33 | type higher_kinded 34 | 35 | val inject 36 | : ('a, 'x, 'y, 'z) t 37 | -> ('a -> 'x -> 'y -> 'z -> higher_kinded) Higher_kinded.t 38 | 39 | val project 40 | : ('a -> 'x -> 'y -> 'z -> higher_kinded) Higher_kinded.t 41 | -> ('a, 'x, 'y, 'z) t 42 | end 43 | 44 | module type S5 = sig 45 | type ('a, 'w, 'x, 'y, 'z) t 46 | type higher_kinded 47 | 48 | val inject 49 | : ('a, 'w, 'x, 'y, 'z) t 50 | -> ('a -> 'w -> 'x -> 'y -> 'z -> higher_kinded) Higher_kinded.t 51 | 52 | val project 53 | : ('a -> 'w -> 'x -> 'y -> 'z -> higher_kinded) Higher_kinded.t 54 | -> ('a, 'w, 'x, 'y, 'z) t 55 | end 56 | 57 | module type S6 = sig 58 | type ('a, 'v, 'w, 'x, 'y, 'z) t 59 | type higher_kinded 60 | 61 | val inject 62 | : ('a, 'v, 'w, 'x, 'y, 'z) t 63 | -> ('a -> 'v -> 'w -> 'x -> 'y -> 'z -> higher_kinded) Higher_kinded.t 64 | 65 | val project 66 | : ('a -> 'v -> 'w -> 'x -> 'y -> 'z -> higher_kinded) Higher_kinded.t 67 | -> ('a, 'v, 'w, 'x, 'y, 'z) t 68 | end 69 | 70 | module type S7 = sig 71 | type ('a, 'u, 'v, 'w, 'x, 'y, 'z) t 72 | type higher_kinded 73 | 74 | val inject 75 | : ('a, 'u, 'v, 'w, 'x, 'y, 'z) t 76 | -> ('a -> 'u -> 'v -> 'w -> 'x -> 'y -> 'z -> higher_kinded) Higher_kinded.t 77 | 78 | val project 79 | : ('a -> 'u -> 'v -> 'w -> 'x -> 'y -> 'z -> higher_kinded) Higher_kinded.t 80 | -> ('a, 'u, 'v, 'w, 'x, 'y, 'z) t 81 | end 82 | 83 | module type S8 = sig 84 | type ('a, 't, 'u, 'v, 'w, 'x, 'y, 'z) t 85 | type higher_kinded 86 | 87 | val inject 88 | : ('a, 't, 'u, 'v, 'w, 'x, 'y, 'z) t 89 | -> ('a -> 't -> 'u -> 'v -> 'w -> 'x -> 'y -> 'z -> higher_kinded) Higher_kinded.t 90 | 91 | val project 92 | : ('a -> 't -> 'u -> 'v -> 'w -> 'x -> 'y -> 'z -> higher_kinded) Higher_kinded.t 93 | -> ('a, 't, 'u, 'v, 'w, 'x, 'y, 'z) t 94 | end 95 | (*$*) 96 | 97 | (** These are the signatures implemented by the [Make_monad] and 98 | [Make_monad_using_witness] families of functors. *) 99 | 100 | (*$ Higher_kinded_cinaps.print_module_type_monad () *) 101 | module type Monad = sig 102 | include S 103 | include Monad.S with type 'a t := ('a -> higher_kinded) Higher_kinded.t 104 | end 105 | 106 | module type Monad2 = sig 107 | include S2 108 | include Monad.S2 with type ('a, 'b) t := ('a -> 'b -> higher_kinded) Higher_kinded.t 109 | end 110 | 111 | module type Monad3 = sig 112 | include S3 113 | 114 | include 115 | Monad.S3 116 | with type ('a, 'b, 'c) t := ('a -> 'b -> 'c -> higher_kinded) Higher_kinded.t 117 | end 118 | (*$*) 119 | end 120 | 121 | module type Higher_kinded = sig 122 | (** This library allows you to use higher-kinded types in OCaml. See the README for a 123 | short tutorial on what that means and how to use it. *) 124 | 125 | (** {2 Types} *) 126 | 127 | (** If [A] implements the signature [S], [(a, A.witness1) t] is equivalent to [a A.t]. *) 128 | type 'a t 129 | 130 | (*$ Higher_kinded_cinaps.print_type_aliases ~include_comments:true *) 131 | 132 | (** If [A] implements the signature [S], [('a, A.higher_kinded) t1] is equivalent to 133 | ['a A.t]. *) 134 | 135 | type ('a, 'witness) t1 = ('a -> 'witness) t 136 | 137 | (** If [A] implements the signature [S2], [('a, 'b, A.higher_kinded) t2] is equivalent 138 | to [('a, 'b) A.t]. *) 139 | 140 | type ('a, 'b, 'witness) t2 = ('a, 'b -> 'witness) t1 141 | 142 | (** If [A] implements the signature [S3], [('a, 'b, 'c, A.higher_kinded) t3] is 143 | equivalent to [('a, 'b, 'c) A.t]. *) 144 | 145 | type ('a, 'b, 'c, 'witness) t3 = ('a, 'b, 'c -> 'witness) t2 146 | 147 | (** If [A] implements the signature [S4], [('a, 'b, 'c, 'd, A.higher_kinded) t4] is 148 | equivalent to [('a, 'b, 'c, 'd) A.t]. *) 149 | 150 | type ('a, 'b, 'c, 'd, 'witness) t4 = ('a, 'b, 'c, 'd -> 'witness) t3 151 | 152 | (** If [A] implements the signature [S5], [('a, 'b, 'c, 'd, 'e, A.higher_kinded) t5] is 153 | equivalent to [('a, 'b, 'c, 'd, 'e) A.t]. *) 154 | 155 | type ('a, 'b, 'c, 'd, 'e, 'witness) t5 = ('a, 'b, 'c, 'd, 'e -> 'witness) t4 156 | 157 | (** If [A] implements the signature [S6], [('a, 'b, 'c, 'd, 'e, 'f, A.higher_kinded) t6] 158 | is equivalent to [('a, 'b, 'c, 'd, 'e, 'f) A.t]. *) 159 | 160 | type ('a, 'b, 'c, 'd, 'e, 'f, 'witness) t6 = ('a, 'b, 'c, 'd, 'e, 'f -> 'witness) t5 161 | 162 | (** If [A] implements the signature [S7], 163 | [('a, 'b, 'c, 'd, 'e, 'f, 'g, A.higher_kinded) t7] is equivalent to 164 | [('a, 'b, 'c, 'd, 'e, 'f, 'g) A.t]. *) 165 | 166 | type ('a, 'b, 'c, 'd, 'e, 'f, 'g, 'witness) t7 = 167 | ('a, 'b, 'c, 'd, 'e, 'f, 'g -> 'witness) t6 168 | 169 | (** If [A] implements the signature [S8], 170 | [('a, 'b, 'c, 'd, 'e, 'f, 'g, 'h, A.higher_kinded) t8] is equivalent to 171 | [('a, 'b, 'c, 'd, 'e, 'f, 'g, 'h) A.t]. *) 172 | 173 | type ('a, 'b, 'c, 'd, 'e, 'f, 'g, 'h, 'witness) t8 = 174 | ('a, 'b, 'c, 'd, 'e, 'f, 'g, 'h -> 'witness) t7 175 | 176 | (*$*) 177 | 178 | (** {2 Signatures} *) 179 | 180 | include module type of Higher_kinded_module_types (struct 181 | type nonrec 'a t = 'a t 182 | end) 183 | 184 | (** {2 Functors} *) 185 | 186 | (** This is the meat of the library. Use these functors to implement the higher_kinded 187 | interface. *) 188 | 189 | (*$ Higher_kinded_cinaps.print_functor_types () *) 190 | module Make (X : sig 191 | type 'a t 192 | end) : S with type 'a t := 'a X.t 193 | 194 | module Make2 (X : sig 195 | type ('a, 'z) t 196 | end) : S2 with type ('a, 'z) t := ('a, 'z) X.t 197 | 198 | module Make3 (X : sig 199 | type ('a, 'y, 'z) t 200 | end) : S3 with type ('a, 'y, 'z) t := ('a, 'y, 'z) X.t 201 | 202 | module Make4 (X : sig 203 | type ('a, 'x, 'y, 'z) t 204 | end) : S4 with type ('a, 'x, 'y, 'z) t := ('a, 'x, 'y, 'z) X.t 205 | 206 | module Make5 (X : sig 207 | type ('a, 'w, 'x, 'y, 'z) t 208 | end) : S5 with type ('a, 'w, 'x, 'y, 'z) t := ('a, 'w, 'x, 'y, 'z) X.t 209 | 210 | module Make6 (X : sig 211 | type ('a, 'v, 'w, 'x, 'y, 'z) t 212 | end) : S6 with type ('a, 'v, 'w, 'x, 'y, 'z) t := ('a, 'v, 'w, 'x, 'y, 'z) X.t 213 | 214 | module Make7 (X : sig 215 | type ('a, 'u, 'v, 'w, 'x, 'y, 'z) t 216 | end) : S7 with type ('a, 'u, 'v, 'w, 'x, 'y, 'z) t := ('a, 'u, 'v, 'w, 'x, 'y, 'z) X.t 217 | 218 | module Make8 (X : sig 219 | type ('a, 't, 'u, 'v, 'w, 'x, 'y, 'z) t 220 | end) : 221 | S8 222 | with type ('a, 't, 'u, 'v, 'w, 'x, 'y, 'z) t := ('a, 't, 'u, 'v, 'w, 'x, 'y, 'z) X.t 223 | 224 | module Make_monad (M : Monad.S) : Monad with type 'a t := 'a M.t 225 | module Make_monad2 (M : Monad.S2) : Monad2 with type ('a, 'b) t := ('a, 'b) M.t 226 | module Make_monad3 (M : Monad.S3) : Monad3 with type ('a, 'b, 'c) t := ('a, 'b, 'c) M.t 227 | 228 | module Make_monad_using_witness (M : Monad.S) (X : S with type 'a t := 'a M.t) : 229 | Monad with type 'a t := 'a M.t with type higher_kinded := X.higher_kinded 230 | 231 | module Make_monad_using_witness2 232 | (M : Monad.S2) 233 | (X : S2 with type ('a, 'b) t := ('a, 'b) M.t) : 234 | Monad2 with type ('a, 'b) t := ('a, 'b) M.t with type higher_kinded := X.higher_kinded 235 | 236 | module Make_monad_using_witness3 237 | (M : Monad.S3) 238 | (X : S3 with type ('a, 'b, 'c) t := ('a, 'b, 'c) M.t) : 239 | Monad3 240 | with type ('a, 'b, 'c) t := ('a, 'b, 'c) M.t 241 | with type higher_kinded := X.higher_kinded 242 | (*$*) 243 | 244 | (** {2 Implementations} *) 245 | 246 | (** [Base], [Core], and [Async] don't depend on [Higher_kinded], so we put these 247 | implementations here instead of in the respective modules where they might have been 248 | a nicer fit. *) 249 | 250 | module Ident : S with type 'a t := 'a 251 | module Array : S with type 'a t := 'a Array.t 252 | module Either : S2 with type ('a, 'b) t := ('a, 'b) Either.t 253 | module Hash_set : S with type 'a t := 'a Hash_set.t 254 | module Hashtbl : S2 with type ('a, 'b) t := ('a, 'b) Hashtbl.t 255 | module Lazy : S with type 'a t := 'a Lazy.t 256 | module List : S with type 'a t := 'a List.t 257 | module Map : S3 with type ('a, 'b, 'c) t := ('a, 'b, 'c) Map.t 258 | module Option : S with type 'a t := 'a Option.t 259 | module Queue : S with type 'a t := 'a Queue.t 260 | module Ref : S with type 'a t := 'a Ref.t 261 | module Result : S2 with type ('a, 'e) t := ('a, 'e) Result.t 262 | module Set : S2 with type ('a, 'b) t := ('a, 'b) Set.t 263 | module Sequence : S with type 'a t := 'a Sequence.t 264 | module Type_equal : S2 with type ('a, 'b) t := ('a, 'b) Type_equal.t 265 | 266 | (** [t] itself has one type parameter, so we might as well implement [S] right here. *) 267 | include S with type 'a t := 'a t 268 | end 269 | --------------------------------------------------------------------------------