├── .gitignore ├── LICENSE ├── Makefile ├── Readme.md ├── descr ├── dune-project ├── orec.opam └── src ├── bijection.ml ├── bijection.mli ├── default.ml ├── default.mli ├── dune ├── index.mld ├── namespace.ml ├── namespace.mli ├── type_data.ml ├── type_data.mli ├── univ.ml └── univ.mli /.gitignore: -------------------------------------------------------------------------------- 1 | .merlin 2 | *~ 3 | *.install 4 | _build/ 5 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | GNU LESSER GENERAL PUBLIC LICENSE 2 | Version 3, 29 June 2007 3 | 4 | Copyright (C) 2007 Free Software Foundation, Inc. 5 | Everyone is permitted to copy and distribute verbatim copies 6 | of this license document, but changing it is not allowed. 7 | 8 | 9 | This version of the GNU Lesser General Public License incorporates 10 | the terms and conditions of version 3 of the GNU General Public 11 | License, supplemented by the additional permissions listed below. 12 | 13 | 0. Additional Definitions. 14 | 15 | As used herein, "this License" refers to version 3 of the GNU Lesser 16 | General Public License, and the "GNU GPL" refers to version 3 of the GNU 17 | General Public License. 18 | 19 | "The Library" refers to a covered work governed by this License, 20 | other than an Application or a Combined Work as defined below. 21 | 22 | An "Application" is any work that makes use of an interface provided 23 | by the Library, but which is not otherwise based on the Library. 24 | Defining a subclass of a class defined by the Library is deemed a mode 25 | of using an interface provided by the Library. 26 | 27 | A "Combined Work" is a work produced by combining or linking an 28 | Application with the Library. The particular version of the Library 29 | with which the Combined Work was made is also called the "Linked 30 | Version". 31 | 32 | The "Minimal Corresponding Source" for a Combined Work means the 33 | Corresponding Source for the Combined Work, excluding any source code 34 | for portions of the Combined Work that, considered in isolation, are 35 | based on the Application, and not on the Linked Version. 36 | 37 | The "Corresponding Application Code" for a Combined Work means the 38 | object code and/or source code for the Application, including any data 39 | and utility programs needed for reproducing the Combined Work from the 40 | Application, but excluding the System Libraries of the Combined Work. 41 | 42 | 1. Exception to Section 3 of the GNU GPL. 43 | 44 | You may convey a covered work under sections 3 and 4 of this License 45 | without being bound by section 3 of the GNU GPL. 46 | 47 | 2. Conveying Modified Versions. 48 | 49 | If you modify a copy of the Library, and, in your modifications, a 50 | facility refers to a function or data to be supplied by an Application 51 | that uses the facility (other than as an argument passed when the 52 | facility is invoked), then you may convey a copy of the modified 53 | version: 54 | 55 | a) under this License, provided that you make a good faith effort to 56 | ensure that, in the event an Application does not supply the 57 | function or data, the facility still operates, and performs 58 | whatever part of its purpose remains meaningful, or 59 | 60 | b) under the GNU GPL, with none of the additional permissions of 61 | this License applicable to that copy. 62 | 63 | 3. Object Code Incorporating Material from Library Header Files. 64 | 65 | The object code form of an Application may incorporate material from 66 | a header file that is part of the Library. You may convey such object 67 | code under terms of your choice, provided that, if the incorporated 68 | material is not limited to numerical parameters, data structure 69 | layouts and accessors, or small macros, inline functions and templates 70 | (ten or fewer lines in length), you do both of the following: 71 | 72 | a) Give prominent notice with each copy of the object code that the 73 | Library is used in it and that the Library and its use are 74 | covered by this License. 75 | 76 | b) Accompany the object code with a copy of the GNU GPL and this license 77 | document. 78 | 79 | 4. Combined Works. 80 | 81 | You may convey a Combined Work under terms of your choice that, 82 | taken together, effectively do not restrict modification of the 83 | portions of the Library contained in the Combined Work and reverse 84 | engineering for debugging such modifications, if you also do each of 85 | the following: 86 | 87 | a) Give prominent notice with each copy of the Combined Work that 88 | the Library is used in it and that the Library and its use are 89 | covered by this License. 90 | 91 | b) Accompany the Combined Work with a copy of the GNU GPL and this license 92 | document. 93 | 94 | c) For a Combined Work that displays copyright notices during 95 | execution, include the copyright notice for the Library among 96 | these notices, as well as a reference directing the user to the 97 | copies of the GNU GPL and this license document. 98 | 99 | d) Do one of the following: 100 | 101 | 0) Convey the Minimal Corresponding Source under the terms of this 102 | License, and the Corresponding Application Code in a form 103 | suitable for, and under terms that permit, the user to 104 | recombine or relink the Application with a modified version of 105 | the Linked Version to produce a modified Combined Work, in the 106 | manner specified by section 6 of the GNU GPL for conveying 107 | Corresponding Source. 108 | 109 | 1) Use a suitable shared library mechanism for linking with the 110 | Library. A suitable mechanism is one that (a) uses at run time 111 | a copy of the Library already present on the user's computer 112 | system, and (b) will operate properly with a modified version 113 | of the Library that is interface-compatible with the Linked 114 | Version. 115 | 116 | e) Provide Installation Information, but only if you would otherwise 117 | be required to provide such information under section 6 of the 118 | GNU GPL, and only to the extent that such information is 119 | necessary to install and execute a modified version of the 120 | Combined Work produced by recombining or relinking the 121 | Application with a modified version of the Linked Version. (If 122 | you use option 4d0, the Installation Information must accompany 123 | the Minimal Corresponding Source and Corresponding Application 124 | Code. If you use option 4d1, you must provide the Installation 125 | Information in the manner specified by section 6 of the GNU GPL 126 | for conveying Corresponding Source.) 127 | 128 | 5. Combined Libraries. 129 | 130 | You may place library facilities that are a work based on the 131 | Library side by side in a single library together with other library 132 | facilities that are not Applications and are not covered by this 133 | License, and convey such a combined library under terms of your 134 | choice, if you do both of the following: 135 | 136 | a) Accompany the combined library with a copy of the same work based 137 | on the Library, uncombined with any other library facilities, 138 | conveyed under the terms of this License. 139 | 140 | b) Give prominent notice with the combined library that part of it 141 | is a work based on the Library, and explaining where to find the 142 | accompanying uncombined form of the same work. 143 | 144 | 6. Revised Versions of the GNU Lesser General Public License. 145 | 146 | The Free Software Foundation may publish revised and/or new versions 147 | of the GNU Lesser General Public License from time to time. Such new 148 | versions will be similar in spirit to the present version, but may 149 | differ in detail to address new problems or concerns. 150 | 151 | Each version is given a distinguishing version number. If the 152 | Library as you received it specifies that a certain numbered version 153 | of the GNU Lesser General Public License "or any later version" 154 | applies to it, you have the option of following the terms and 155 | conditions either of that published version or of any later version 156 | published by the Free Software Foundation. If the Library as you 157 | received it does not specify a version number of the GNU Lesser 158 | General Public License, you may choose any version of the GNU Lesser 159 | General Public License ever published by the Free Software Foundation. 160 | 161 | If the Library as you received it specifies that a proxy can decide 162 | whether future versions of the GNU Lesser General Public License shall 163 | apply, that proxy's public statement of acceptance of any version is 164 | permanent authorization for you to choose that version for the 165 | Library. 166 | GNU LESSER GENERAL PUBLIC LICENSE 167 | Version 3, 29 June 2007 168 | 169 | Copyright (C) 2007 Free Software Foundation, Inc. 170 | Everyone is permitted to copy and distribute verbatim copies 171 | of this license document, but changing it is not allowed. 172 | 173 | 174 | This version of the GNU Lesser General Public License incorporates 175 | the terms and conditions of version 3 of the GNU General Public 176 | License, supplemented by the additional permissions listed below. 177 | 178 | 0. Additional Definitions. 179 | 180 | As used herein, "this License" refers to version 3 of the GNU Lesser 181 | General Public License, and the "GNU GPL" refers to version 3 of the GNU 182 | General Public License. 183 | 184 | "The Library" refers to a covered work governed by this License, 185 | other than an Application or a Combined Work as defined below. 186 | 187 | An "Application" is any work that makes use of an interface provided 188 | by the Library, but which is not otherwise based on the Library. 189 | Defining a subclass of a class defined by the Library is deemed a mode 190 | of using an interface provided by the Library. 191 | 192 | A "Combined Work" is a work produced by combining or linking an 193 | Application with the Library. The particular version of the Library 194 | with which the Combined Work was made is also called the "Linked 195 | Version". 196 | 197 | The "Minimal Corresponding Source" for a Combined Work means the 198 | Corresponding Source for the Combined Work, excluding any source code 199 | for portions of the Combined Work that, considered in isolation, are 200 | based on the Application, and not on the Linked Version. 201 | 202 | The "Corresponding Application Code" for a Combined Work means the 203 | object code and/or source code for the Application, including any data 204 | and utility programs needed for reproducing the Combined Work from the 205 | Application, but excluding the System Libraries of the Combined Work. 206 | 207 | 1. Exception to Section 3 of the GNU GPL. 208 | 209 | You may convey a covered work under sections 3 and 4 of this License 210 | without being bound by section 3 of the GNU GPL. 211 | 212 | 2. Conveying Modified Versions. 213 | 214 | If you modify a copy of the Library, and, in your modifications, a 215 | facility refers to a function or data to be supplied by an Application 216 | that uses the facility (other than as an argument passed when the 217 | facility is invoked), then you may convey a copy of the modified 218 | version: 219 | 220 | a) under this License, provided that you make a good faith effort to 221 | ensure that, in the event an Application does not supply the 222 | function or data, the facility still operates, and performs 223 | whatever part of its purpose remains meaningful, or 224 | 225 | b) under the GNU GPL, with none of the additional permissions of 226 | this License applicable to that copy. 227 | 228 | 3. Object Code Incorporating Material from Library Header Files. 229 | 230 | The object code form of an Application may incorporate material from 231 | a header file that is part of the Library. You may convey such object 232 | code under terms of your choice, provided that, if the incorporated 233 | material is not limited to numerical parameters, data structure 234 | layouts and accessors, or small macros, inline functions and templates 235 | (ten or fewer lines in length), you do both of the following: 236 | 237 | a) Give prominent notice with each copy of the object code that the 238 | Library is used in it and that the Library and its use are 239 | covered by this License. 240 | 241 | b) Accompany the object code with a copy of the GNU GPL and this license 242 | document. 243 | 244 | 4. Combined Works. 245 | 246 | You may convey a Combined Work under terms of your choice that, 247 | taken together, effectively do not restrict modification of the 248 | portions of the Library contained in the Combined Work and reverse 249 | engineering for debugging such modifications, if you also do each of 250 | the following: 251 | 252 | a) Give prominent notice with each copy of the Combined Work that 253 | the Library is used in it and that the Library and its use are 254 | covered by this License. 255 | 256 | b) Accompany the Combined Work with a copy of the GNU GPL and this license 257 | document. 258 | 259 | c) For a Combined Work that displays copyright notices during 260 | execution, include the copyright notice for the Library among 261 | these notices, as well as a reference directing the user to the 262 | copies of the GNU GPL and this license document. 263 | 264 | d) Do one of the following: 265 | 266 | 0) Convey the Minimal Corresponding Source under the terms of this 267 | License, and the Corresponding Application Code in a form 268 | suitable for, and under terms that permit, the user to 269 | recombine or relink the Application with a modified version of 270 | the Linked Version to produce a modified Combined Work, in the 271 | manner specified by section 6 of the GNU GPL for conveying 272 | Corresponding Source. 273 | 274 | 1) Use a suitable shared library mechanism for linking with the 275 | Library. A suitable mechanism is one that (a) uses at run time 276 | a copy of the Library already present on the user's computer 277 | system, and (b) will operate properly with a modified version 278 | of the Library that is interface-compatible with the Linked 279 | Version. 280 | 281 | e) Provide Installation Information, but only if you would otherwise 282 | be required to provide such information under section 6 of the 283 | GNU GPL, and only to the extent that such information is 284 | necessary to install and execute a modified version of the 285 | Combined Work produced by recombining or relinking the 286 | Application with a modified version of the Linked Version. (If 287 | you use option 4d0, the Installation Information must accompany 288 | the Minimal Corresponding Source and Corresponding Application 289 | Code. If you use option 4d1, you must provide the Installation 290 | Information in the manner specified by section 6 of the GNU GPL 291 | for conveying Corresponding Source.) 292 | 293 | 5. Combined Libraries. 294 | 295 | You may place library facilities that are a work based on the 296 | Library side by side in a single library together with other library 297 | facilities that are not Applications and are not covered by this 298 | License, and convey such a combined library under terms of your 299 | choice, if you do both of the following: 300 | 301 | a) Accompany the combined library with a copy of the same work based 302 | on the Library, uncombined with any other library facilities, 303 | conveyed under the terms of this License. 304 | 305 | b) Give prominent notice with the combined library that part of it 306 | is a work based on the Library, and explaining where to find the 307 | accompanying uncombined form of the same work. 308 | 309 | 6. Revised Versions of the GNU Lesser General Public License. 310 | 311 | The Free Software Foundation may publish revised and/or new versions 312 | of the GNU Lesser General Public License from time to time. Such new 313 | versions will be similar in spirit to the present version, but may 314 | differ in detail to address new problems or concerns. 315 | 316 | Each version is given a distinguishing version number. If the 317 | Library as you received it specifies that a certain numbered version 318 | of the GNU Lesser General Public License "or any later version" 319 | applies to it, you have the option of following the terms and 320 | conditions either of that published version or of any later version 321 | published by the Free Software Foundation. If the Library as you 322 | received it does not specify a version number of the GNU Lesser 323 | General Public License, you may choose any version of the GNU Lesser 324 | General Public License ever published by the Free Software Foundation. 325 | 326 | If the Library as you received it specifies that a proxy can decide 327 | whether future versions of the GNU Lesser General Public License shall 328 | apply, that proxy's public statement of acceptance of any version is 329 | permanent authorization for you to choose that version for the 330 | Library. 331 | 332 | -------------------------------------------------------------------------------- /Makefile: -------------------------------------------------------------------------------- 1 | all: 2 | jbuilder build -p orec 3 | clean: 4 | jbuilder clean 5 | 6 | doc: 7 | jbuilder build @doc 8 | 9 | -------------------------------------------------------------------------------- /Readme.md: -------------------------------------------------------------------------------- 1 | 2 | Orec provides an implementation of "open records" as an interface over universal map. 3 | 4 | To start using this library, the first step is to chose which namespace to use. 5 | The default namespace can be used with 6 | 7 | ```Ocaml 8 | (* Use the default namespace for record field *) 9 | open Orec.Default 10 | ``` 11 | 12 | or it is possible to define a new namespace with 13 | 14 | ```OCaml 15 | module N = Orec.Namespace.Make() 16 | open N 17 | ``` 18 | 19 | We can then create dynamically a new field 20 | ```Ocaml 21 | let age : int field = new_field () 22 | ``` 23 | Field are immutable by default, but mutable fields are also available 24 | ```Ocaml 25 | let position : float mut_field = new_field_mut () 26 | ``` 27 | 28 | Creating a new record is as simple as 29 | ```Ocaml 30 | let r = create [ age ^= 10; position ^= 100. ]. 31 | ``` 32 | 33 | Fields can then be accessed using the `record.%{field}` syntax 34 | ```Ocaml 35 | assert ( r.%{age} = Some 10 );; 36 | ``` 37 | Unfortunately, the fields presents in `r` are not tracked by the type system. 38 | For a field of type `'a field`, `record.%{field}` returns an `'a option `. 39 | 40 | Functional update can be performed using `record.%{ field ^= value }` 41 | ```Ocaml 42 | let r2 = r.%{age ^= 20} 43 | assert ( r.%{age} = Some 10 && r2.%{age} = Some 20 && 44 | r2.%{position} = r.%{position} );; 45 | ``` 46 | 47 | Note that field can still be added after creation 48 | ```Ocaml 49 | let tags : 'string list field = new_field() 50 | let r = r.%{ tags ^= ["a tag"] } 51 | ``` 52 | 53 | Assignment for mutable field follows the natural syntax `r.%{field}<- value` 54 | ```Ocaml 55 | let () = r.%{position} <- 20. 56 | assert( r.%{position} = Some 20. && r2.%{position} = Some 20. );; 57 | ``` 58 | 59 | Mutable fields are shared during functional update. To avoid this behavior, copy the field 60 | ```Ocaml 61 | let r3= r.%{copy position} 62 | let () = r3.%{position} <- 10. 63 | assert ( r2.%{position} <> Some 10. );; 64 | ``` 65 | It is also possible to delete a field, 66 | ```Ocaml 67 | let r4= r.%{delete position} 68 | assert ( r4.%{position} = None ) 69 | ``` 70 | or apply a transformation to a field, if the field exists: 71 | ```Ocaml 72 | let f age = age + 1 73 | let r5= r.%{ fmap f age } 74 | let r5= r.%{ age |= f } 75 | assert ( r5.%{age} = Some 40 ) 76 | ``` 77 | All these different field updates can be potentially mixed together with the 78 | `&` operator 79 | ```Ocaml 80 | let r6 = r.%{ age |= f & position ^= 5. & delete tags } 81 | ``` 82 | 83 | Given a bijection between type `'a` and `'b`, it is possible to transmute an `'a field` to an `'b field` 84 | ```Ocaml 85 | let age_str: string field = transmute age {to_ = string_of_int; from = int_of_string } 86 | assert (r.%{age_str} = "10" );; 87 | ``` 88 | 89 | In some cases, accessing fields through an option type might be unpractical, 90 | for instance, external invariants might enforce that a given field is always present. 91 | In these situations, it is possible to use exception based fields rather than 92 | option based field 93 | ```Ocaml 94 | let name : int exn_field = new_field_exn () 95 | let error : unit exn_field = new_field_exn () 96 | let no_one = create [ name ^= "Ulysse" ] 97 | assert( no_one.name = "Ulysse" ) 98 | let raise_exception = 99 | try no_one.%{error} with Not_found -> () 100 | ``` 101 | An exception-based field `'a exn_field` returns directly the core type `'a` of 102 | the field if the field is present and will raise a `Not_found` exception otherwise. 103 | The behavior of all functions and operators defined in `orec` is independent from 104 | the access mode. In particular, the `fmap` function always update the record if and 105 | only if the underlying field is present in the record. 106 | 107 | It is possible to switch from an option-based field to an exception-based by using 108 | the `tranmute_exn` function. 109 | -------------------------------------------------------------------------------- /descr: -------------------------------------------------------------------------------- 1 | Open records implemented using map over universal type 2 | -------------------------------------------------------------------------------- /dune-project: -------------------------------------------------------------------------------- 1 | (lang dune 1.0) 2 | (name orec) 3 | -------------------------------------------------------------------------------- /orec.opam: -------------------------------------------------------------------------------- 1 | name: "orec" 2 | version:"1.0.1" 3 | opam-version: "2.0" 4 | maintainer: "octa@polychoron.fr" 5 | authors: "octa@polychoron.fr" 6 | dev-repo: "git+https://github.com/Octachron/orec" 7 | homepage: "https://github.com/Octachron/orec" 8 | bug-reports: "https://github.com/Octachron/orec/issues" 9 | synopsis: "Open record implementation based on heterogeneous map" 10 | build:[ 11 | ["dune" "build" "-p" name "-j" jobs] 12 | [ "dune" "build" "-p" name "-j" jobs "@doc" ] {with-doc} 13 | ] 14 | 15 | depends: [ 16 | "dune" {>= "1.0" } 17 | ] 18 | -------------------------------------------------------------------------------- /src/bijection.ml: -------------------------------------------------------------------------------- 1 | module type S = sig 2 | 3 | (** Bijection record *) 4 | type ('a, 'b) bijection = { to_ : 'a -> 'b; from : 'b -> 'a; } 5 | 6 | (** Bijection inversion *) 7 | val flip : ('a, 'b) bijection -> ('b, 'a) bijection 8 | 9 | (** Bijection composition *) 10 | val ( % ) : ('a, 'b) bijection -> ('c, 'a) bijection -> ('c, 'b) bijection 11 | end 12 | 13 | type ('a,'b) bijection = { to_ : 'a -> 'b ; from : 'b -> 'a } 14 | 15 | let flip iso = { to_ = iso.from; from = iso.to_ } 16 | 17 | let ( % ) {to_; from} source = 18 | { 19 | to_ = (fun x -> to_ @@ source.to_ x) ; 20 | from = (fun x -> source.from @@ from x ) 21 | } 22 | -------------------------------------------------------------------------------- /src/bijection.mli: -------------------------------------------------------------------------------- 1 | (** Bijection type and composition *) 2 | 3 | module type S = sig 4 | 5 | (** Bijection record *) 6 | type ('a, 'b) bijection = { to_ : 'a -> 'b; from : 'b -> 'a; } 7 | 8 | (** Bijection inversion *) 9 | val flip : ('a, 'b) bijection -> ('b, 'a) bijection 10 | 11 | (** Bijection composition *) 12 | val ( % ) : 13 | ('a, 'b) bijection -> ('c, 'a) bijection -> ('c, 'b) bijection 14 | end 15 | 16 | include S 17 | -------------------------------------------------------------------------------- /src/default.ml: -------------------------------------------------------------------------------- 1 | include Namespace.Make() 2 | -------------------------------------------------------------------------------- /src/default.mli: -------------------------------------------------------------------------------- 1 | (** Default namespace for record fields *) 2 | 3 | include Namespace.S 4 | -------------------------------------------------------------------------------- /src/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name orec) (public_name orec) 3 | (synopsis "open record implementation based on heterogeneous maps") 4 | ) 5 | (documentation) 6 | -------------------------------------------------------------------------------- /src/index.mld: -------------------------------------------------------------------------------- 1 | {1 Orec } 2 | 3 | Orec provides an implementation of "open records" as an interface over universal map. 4 | To start using this library, the first step is to chose which namespace to use. 5 | The default namespace can be used with 6 | 7 | {[ 8 | (* Use the default namespace for record field *) 9 | open Orec.Default 10 | ]} 11 | 12 | or it is possible to define a new namespace with 13 | 14 | {[ 15 | (* create a new namespace N for record fields *) 16 | module N = Orec.Namespace.Make() 17 | open N 18 | ]} 19 | 20 | 21 | We can then create dynamically a new field 22 | {[ 23 | let age : int field = new_field () 24 | ]} 25 | 26 | Field are immutable by default, but mutable fields are also available 27 | 28 | {[ 29 | let position : float mut_field = new_field_mut () 30 | ]} 31 | 32 | 33 | Creating a new record is as simple as 34 | 35 | {[ 36 | let r = create [ age ^= 10; position ^= 100. ]. 37 | ]} 38 | 39 | Fields can then be accessed using the [record.%{field}] syntax 40 | {[ 41 | assert ( r.%{age} = Some 10 );; 42 | ]} 43 | 44 | Unfortunately, the fields presents in [r] are not tracked by the type system 45 | at the moment. 46 | For a field of type ['a field], [record.%{field}] returns an ['a option]. 47 | 48 | Functional update can be performed using [ record.%{ field ^= value } ] 49 | {[ 50 | let r2 = r.%{age ^= 20} 51 | assert ( r.%{age} = Some 10 && r2.%{age} = Some 20 && 52 | r2.%{position} = r.%{position} );; 53 | ]} 54 | 55 | Note that field can still be added after creation 56 | {[ 57 | let tags : 'string list field = new_field() 58 | let r = r.%{ tags ^= ["a tag"] } 59 | ]} 60 | 61 | Assignment for mutable field follows the natural syntax [r.%{field}<- value] 62 | {[ 63 | let () = r.%{position} <- 20. 64 | assert( r.%{position} = Some 20. && r2.%{position} = Some 20. );; 65 | ]} 66 | 67 | Mutable fields are shared during functional update. To avoid this behavior, 68 | copy the field 69 | {[ 70 | let r3= r.%{copy position} 71 | let () = r3.%{position} <- 10. 72 | assert ( r2.%{position} <> Some 10. );; 73 | ]} 74 | It is also possible to delete a field, 75 | {[ 76 | let r4= r.%{delete position} 77 | assert ( r4.%{position} = None ) 78 | ]} 79 | or apply a transformation to a field, if the field exists: 80 | {[ 81 | let f age = age + 1 82 | let r5= r.%{ fmap f age } 83 | let r5= r.%{ age |= f } 84 | assert ( r5.%{age} = Some 40 ) 85 | ]} 86 | 87 | All these different field updates can be potentially mixed together with 88 | the [&] operator 89 | {[ 90 | let r6 = r.%{ age |= f & position ^= 5. & delete tags } 91 | ]} 92 | 93 | Given a bijection between type ['a] and ['b], it is possible to transmute an 94 | ['a field] to an ['b field] 95 | {[ 96 | let age_str: string field = 97 | transmute age {to_ = string_of_int; from = int_of_string } 98 | assert (r.%{age_str} = "10" );; 99 | ]} 100 | 101 | In some cases, accessing fields through an option type might be unpractical, 102 | for instance, external invariants might enforce that a given field is always present. 103 | In these situations, it is possible to use exception based fields rather than 104 | option-based fields 105 | {[ 106 | let name : int exn_field = new_field_exn () 107 | let error : unit exn_field = new_field_exn () 108 | let no_one = create [ name ^= "Ulysse" ] 109 | assert( no_one.name = "Ulysse" ) 110 | let raise_exception = 111 | try no_one.%{error} with Not_found -> () 112 | ]} 113 | An exception-based field ['a exn_field] returns directly the core type 114 | ['a] of the field if the field is present and will raise a 115 | [Not_found] exception otherwise. The behavior of all functions and operators 116 | defined in {!Orec} is independent from this access mode. 117 | In particular, the [fmap] function always update the record if and only if 118 | the underlying field is present in the record. 119 | 120 | It is possible to switch from an option-based field to an exception-based by using 121 | the {!tranmute_exn} function. 122 | See 123 | - {!Orec.Default } 124 | - {!Orec.Namespace} 125 | 126 | for the full API 127 | -------------------------------------------------------------------------------- /src/namespace.ml: -------------------------------------------------------------------------------- 1 | 2 | module U = Univ 3 | type 'a witness = 'a U.witness 4 | type elt = U.binding 5 | 6 | (* Key type : 7 | * 'ty the type of the key 8 | * 'tys the type of the stored value 9 | * 'mut : storage brand either imm or mut 10 | *) 11 | 12 | open Type_data 13 | type 'data key = { 14 | witness : 'tys witness; 15 | storage: ('ty,'tys,'m) storage; 16 | access: ('ty,'tya) access 17 | } 18 | constraint 'data = 19 | 20 | module type S = sig 21 | open Type_data 22 | include Bijection.S 23 | 24 | (** The type of record within the namespace *) 25 | type t 26 | 27 | (** The type of a field getter or updater *) 28 | type 'info field_action 29 | 30 | (** Aliases for the type of fields *) 31 | type 'info get = ( ('a,'mut) getter * 'res) field_action 32 | constraint 'info = 33 | type 'a field = get 34 | type 'a mut_field = get 35 | type 'a exn_field= get 36 | type 'a exn_mut_field = get 37 | 38 | type ('param,'t) update = ('param updater * 't) field_action 39 | 40 | (** The empty record *) 41 | val empty: t 42 | 43 | (** Create a new open record from a list of field updater : 44 | [create [ field1 ^= value1; field2 ^= value2; ... ] ] 45 | Only const updater make sense in this context, 46 | since there is no fields present. 47 | *) 48 | val create: (only const, t) update list -> t 49 | 50 | (** Creation of a new fields. 51 | Note that the type 'ty would be weakly polymorphic once the field created. 52 | However, in this specific use case, it seems reasonable to annotate the 53 | field type by using one of the field type aliases. 54 | *) 55 | val new_field: unit -> 'ty field 56 | val new_field_mut: unit -> 'ty mut_field 57 | val new_field_exn: unit -> 'ty exn_field 58 | val new_field_exn_mut: unit -> 'ty exn_mut_field 59 | 60 | (** Constant field updater: 61 | [record.{ field ^= v }] sets the value of [field] to [v] 62 | and is equivalent to [record.{ put field v }] *) 63 | val put: 64 | get -> 'ty -> (_ const, t) update 65 | val ( ^= ): 66 | get -> 'ty -> (_ const, t) update 67 | 68 | (** Field map: 69 | [ record.{field |= f } ] or [record.{ fmap field f }] are equivalent to 70 | [record.{ field ^= fmap f record.{field} }] if the field exists, and do 71 | nothing otherwise 72 | *) 73 | val fmap: 74 | get -> ('ty->'ty) -> ('a fn, t) update 75 | val ( |= ) : 76 | get -> ('ty->'ty) -> ('a fn, t) update 77 | 78 | 79 | (** Field combinator 80 | [ orec.%{ x & y }] is [ orec.%{x}.%{y}] 81 | *) 82 | 83 | val (&): (any, t) update -> (any, t) update -> (any, t) update 84 | val and_then: (any, t) update -> (any, t) update -> (any, t) update 85 | 86 | (** Copy a mutable field *) 87 | val copy: get -> ('a fn, t) update 88 | 89 | (** Delete a field, if the field does not exist, do nothing *) 90 | val delete: < .. > get -> ('a del, t) update 91 | 92 | (** getter, updater and setter for t *) 93 | val get: < ret:'ret; .. > get -> t -> 'ret 94 | val update: ( any, t) update -> t -> t 95 | val set: get -> 'ty -> t -> unit 96 | 97 | (** Operator version of get+update and set *) 98 | 99 | (** [(.%{} )] operator: 100 | - [ record.%{field} ] returns the value of the field 101 | - [record.%{field ^= value}] returns a functional update of record 102 | - [ record.%{field |= f} ] is equivalent to 103 | [ record.{ field ^= f record.{field} } ] 104 | - [ record.%{delete field}] returns an updated version of record 105 | without this field *) 106 | val (.%{}): t -> (_ * 'ret) field_action -> 'ret 107 | val (.%{}<-): t -> < x:'ty; mut:mut; .. > get -> 'ty -> unit 108 | 109 | (** Use the type equality implied by the bijection ['a⟺'b] to create 110 | a new ['b] field getter from a ['a] field getter. 111 | The new field getter uses option access *) 112 | val transmute : 113 | (< x:'a; mut:'m; ..> as 'x) get 114 | -> ('a,'b) bijection 115 | -> < x:'b; mut:'m; ret:'b option > get 116 | 117 | (** Operator version of [transmute] *) 118 | val ( @: ) : 119 | (< x:'a; mut:'m; ..> as 'x) get 120 | -> ('a,'b) bijection 121 | -> < x:'b; mut:'m; ret:'b option > get 122 | 123 | (** exception based version of transmute *) 124 | val transmute_exn: 125 | (< x:'a; mut:'m; ..> as 'x) get 126 | -> ('a,'b) bijection 127 | -> < x:'b; mut:'m; ret:'b> get 128 | 129 | (** Operator version of [transmute_exn] *) 130 | val ( @:! ) : 131 | (< x:'a; mut:'m; ..> as 'x) get 132 | -> ('a,'b) bijection 133 | -> < x:'b; mut:'m; ret:'b> get 134 | 135 | end 136 | 137 | 138 | 139 | (* Namespace() generates a new module with abstract open record *) 140 | module Make(): S = 141 | struct 142 | (* Including bijection function to lighten use of the namespace *) 143 | include(Bijection) 144 | 145 | (* Underlying type of the open record *) 146 | module M= Map.Make( 147 | struct 148 | type t=U.key 149 | let compare:U.key-> U.key-> int = compare 150 | end) 151 | 152 | 153 | (** The type of record within the namespace *) 154 | type t= elt M.t 155 | 156 | (** The empty record *) 157 | let empty : t = M.empty 158 | 159 | let find_exn witness orec = 160 | M.find (U.id witness) orec |> U.extract_exn witness 161 | 162 | let add key val_ orec = M.add (U.id key) (U.B (key,val_) ) orec 163 | let delete_key key orec= M.remove (U.id key.witness) orec 164 | 165 | (* Field action : either getter or updater associated to a given key *) 166 | type 'info field_action = 167 | | Get: 168 | key -> 169 | ( ('ty,'m) getter * 'tya ) field_action 170 | | Indirect_get : 171 | key * ('ty, 'ty2) bijection * ('ty2,'tya2) access 172 | -> ( ('ty2,'m) getter * 'tya2 ) field_action 173 | | Update: 174 | key * 'ty -> ('a const updater * t) field_action 175 | | Fn_update: 176 | key * ('ty->'ty) -> ('a fn updater * t) field_action 177 | | And : 178 | ('any updater * t) field_action * ('any updater * t) field_action -> 179 | ('any updater * t) field_action 180 | | Delete: 181 | < .. > key -> ('a del updater * t) field_action 182 | 183 | 184 | (** Alias for the type of fields *) 185 | type 'info get = ( ('a,'mut) getter * 'res) field_action 186 | constraint 'info = 187 | type 'a field = get 188 | type 'a mut_field = get 189 | type 'a exn_field= get 190 | type 'a exn_mut_field = get 191 | type ('param,'t) update = ('param updater * 't) field_action 192 | 193 | (** Creation of a new field *) 194 | let new_field_generic = 195 | fun storage access-> 196 | Get { witness = U.create () ; storage; access} 197 | 198 | let new_field ()= new_field_generic Imm Opt 199 | let new_field_mut () = new_field_generic Mut Opt 200 | let new_field_exn ()= new_field_generic Imm Exn 201 | let new_field_exn_mut () = new_field_generic Mut Exn 202 | 203 | (** Transform a field getter into a field updater *) 204 | let put : type ty m ret. 205 | get -> ty -> ('a const, t) update = 206 | fun field_action x -> match field_action with 207 | | Get key -> Update(key,x) 208 | | Indirect_get (key,bij,_access) -> Update(key, bij.from x) 209 | 210 | let ( ^= ) field x = put field x 211 | 212 | (** Field fmap: [ record.{field |= f } ] is equivalent to 213 | [record.{ field ^= fmap f record.{field} }], if the field exists *) 214 | let fmap : type ty m ret. 215 | get -> (ty->ty) -> ('a fn,t) update = 216 | fun field_action f -> match field_action with 217 | | Get key -> Fn_update(key,f) 218 | | Indirect_get (key,bij,_access) -> 219 | Fn_update(key,fun x -> x |> bij.to_ |> f |> bij.from ) 220 | 221 | let ( |= ) field f = fmap field f 222 | 223 | (* Perform a copy of a mutable field. Copying an immutable would be pointless *) 224 | let copy field = field |= (fun x -> x) 225 | 226 | (* Delete a field *) 227 | let delete = function 228 | | Get key -> Delete key 229 | | Indirect_get (key,_bij,_access) -> Delete key 230 | 231 | (* Convert from the stored type 'tys to the core type 'ty *) 232 | let deref: type ty tys brand. (ty,tys,brand) storage -> tys -> ty = 233 | fun storage val_ -> 234 | match storage with 235 | | Mut -> !val_ 236 | | Imm -> val_ 237 | 238 | (* ref_ st · deref st = identity *) 239 | let ref_: type ty tys brand. (ty,tys,brand) storage -> ty -> tys = 240 | fun storage val_ -> 241 | match storage with 242 | | Mut -> ref val_ 243 | | Imm -> val_ 244 | 245 | let find_key_exn key orec = find_exn key.witness orec |> deref key.storage 246 | 247 | let find_key: type ty tya. key -> t -> tya = 248 | fun key orec -> match key.access with 249 | | Opt -> 250 | begin 251 | try Some (find_key_exn key orec) with Not_found -> None 252 | end 253 | | Exn -> find_key_exn key orec 254 | 255 | let find_key_with: 256 | type ty2 tya2. (ty2,tya2) access -> key 257 | -> ('ty->ty2) -> t -> tya2 = 258 | fun access key f orec -> match access with 259 | | Exn -> find_key_exn key orec |> f 260 | | Opt -> 261 | begin 262 | try Some(find_key_exn key orec |> f) with Not_found -> None 263 | end 264 | 265 | let add_key key val_ orec = add key.witness (ref_ key.storage val_) orec 266 | 267 | let update_key key f orec = 268 | match find_key_exn key orec with 269 | | x -> add_key key (f x) orec 270 | | exception Not_found -> orec 271 | 272 | (* get, update and set functions *) 273 | let get : get -> t -> 'tya = fun field orec -> 274 | match field with 275 | | Get key -> find_key key orec 276 | | Indirect_get (key, bijection,access) -> 277 | find_key_with access key bijection.to_ orec 278 | 279 | let rec update :(any, t) update -> t -> t = fun field_action orec -> 280 | match field_action with 281 | | Update (key,x) -> add_key key x orec 282 | | Fn_update(key,f) -> update_key key f orec 283 | | Delete key -> delete_key key orec 284 | | And (l, r) -> 285 | update r (update l orec) 286 | 287 | let and_then l r = And(l,r) 288 | let (&) = and_then 289 | 290 | let set : type ty r. get -> ty -> t -> unit = 291 | fun field x orec -> 292 | match field with 293 | | Get {witness; storage=Mut; access=_ } -> 294 | (try find_exn witness orec := x with Not_found -> () ) 295 | | Indirect_get({witness; storage=Mut; access=_ }, bijection, _access ) -> 296 | (try find_exn witness orec := bijection.from x with Not_found -> () ) 297 | 298 | 299 | (** Operator version of get+update and set *) 300 | 301 | (** (.{} ) operator: 302 | - [ record.{field} ] returns the value of the field 303 | - [record.{field ^= value}] returns a functional update of record 304 | - [ record.{field |= f} is equivalent to record.{ field ^= f record.{field} } 305 | - [ record.{delete field} returns an updated version of record 306 | without this field *) 307 | let rec (.%{}): type kind ret. 308 | t -> (kind * ret) field_action -> ret = 309 | fun orec -> 310 | function 311 | | Get key -> find_key key orec 312 | | Indirect_get (key, bijection,access) -> 313 | find_key_with access key bijection.to_ orec 314 | | Update (key,x) -> add_key key x orec 315 | | Fn_update(key,f) -> update_key key f orec 316 | | And(l,r) -> orec.%{l}.%{r} 317 | | Delete key -> delete_key key orec 318 | 319 | (** The expressions record.{ field ^= value, field2 ^= value2, ... } are 320 | shortcuts for record.{ field ^= value }.{ field2 ^= value2 }... *) 321 | let (.%{}<-) : type ty. 322 | t -> get -> ty -> unit = 323 | fun orec field x -> set field x orec 324 | 325 | (** Create a new open record from a list of field updater : 326 | [create [ field1 ^= value1; field2 ^= value2; ... ] ] *) 327 | let create l = List.fold_left ( 328 | fun orec field_action -> orec.%{field_action} ) empty l 329 | 330 | (** Use the type equality implied by the bijection 'a<->'b to create a 331 | new ['b] field getter from a ['a] field getter. The new field getter uses 332 | the provided access type *) 333 | let transmute_gen: type ty. 334 | ('ty2,'ty2a) access -> 335 | get -> (ty,'ty2) bijection -> 336 | get = 337 | fun access action_field bijection -> 338 | match action_field with 339 | | Get witness -> Indirect_get (witness,bijection,access) 340 | | Indirect_get (witness, bijection',_) -> 341 | Indirect_get (witness, bijection % bijection',access) 342 | 343 | let transmute field bijection = transmute_gen Opt field bijection 344 | let ( @: ) field bijection = transmute field bijection 345 | 346 | let transmute_exn field bijection = transmute_gen Exn field bijection 347 | let ( @:! ) field bijection = transmute_exn field bijection 348 | 349 | end 350 | -------------------------------------------------------------------------------- /src/namespace.mli: -------------------------------------------------------------------------------- 1 | (** Creation of new namespace for open record fields *) 2 | 3 | 4 | (** Key storage type *) 5 | type 'data key 6 | constraint 'data = 7 | 8 | module type S = sig 9 | open Type_data 10 | include Bijection.S 11 | 12 | (** The type of record within the namespace *) 13 | type t 14 | 15 | (** The type of a field getter or updater *) 16 | type 'info field_action 17 | 18 | (** Aliases for the field types *) 19 | type 'info get = ( ('a,'mut) getter * 'res) field_action 20 | constraint 'info = 21 | 22 | type 'a field = get 23 | type 'a mut_field = get 24 | type 'a exn_field= get 25 | type 'a exn_mut_field = get 26 | 27 | type ('param,'t) update = ('param updater * 't) field_action 28 | 29 | (** The empty record *) 30 | val empty: t 31 | 32 | (** Create a new open record from a list of field updater : 33 | [create [ field1 ^= value1; field2 ^= value2; ... ] ] 34 | Only const updater make sense in this context, 35 | since there is no fields present. 36 | *) 37 | val create: (only const, t) update list -> t 38 | 39 | (** Creation of a new fields. 40 | Note that the type 'ty is weakly polymorphic once the field created. 41 | However, in this specific use case, it seems reasonable to annotate the 42 | field type by using one of the field type aliases. 43 | *) 44 | val new_field: unit -> 'ty field 45 | val new_field_mut: unit -> 'ty mut_field 46 | val new_field_exn: unit -> 'ty exn_field 47 | val new_field_exn_mut: unit -> 'ty exn_mut_field 48 | 49 | (** Constant field updater: 50 | [record.%{ field ^= v }] sets the value of [field] to [v] 51 | and is equivalent to [record.%{ put field v }] *) 52 | val put: 53 | get -> 'ty -> (_ const, t) update 54 | val ( ^= ): 55 | get -> 'ty -> (_ const, t) update 56 | 57 | (** Field map: 58 | [ record.%{field |= f } ] or [record.%{ fmap field f }] are equivalent to 59 | [record.%{ field ^= f record.%{field} }] if the field exists, and do 60 | nothing otherwise 61 | *) 62 | val fmap: 63 | get -> ('ty->'ty) -> ('a fn, t) update 64 | val ( |= ) : 65 | get -> ('ty->'ty) -> ('a fn, t) update 66 | 67 | 68 | (** Field combinator 69 | [ orec.%{ x & y }] is [ orec.%{x}.%{y}] 70 | *) 71 | 72 | val (&): (any, t) update -> (any, t) update -> (any, t) update 73 | val and_then: (any, t) update -> (any, t) update -> (any, t) update 74 | 75 | (** Copy a mutable field *) 76 | val copy: get -> ('a fn, t) update 77 | 78 | (** Delete a field, if the field does not exist, do nothing *) 79 | val delete: < .. > get -> ('a del, t) update 80 | 81 | (** getter, updater and setter for t *) 82 | val get: < ret:'ret; .. > get -> t -> 'ret 83 | val update: ( any, t) update -> t -> t 84 | val set: get -> 'ty -> t -> unit 85 | 86 | (** Operator version of get+update and set *) 87 | 88 | (** [(.%{} )] operator: 89 | - [ record.%{field} ] returns the value of the field 90 | - [record.%{field ^= value}] returns a functional update of record 91 | - [ record.%{field |= f} ] is equivalent to 92 | [ record.{ field ^= f record.{field} } ] 93 | - [ record.%{delete field}] returns an updated version of record 94 | without this field *) 95 | val (.%{}): t -> (_ * 'ret) field_action -> 'ret 96 | val (.%{}<-): t -> < x:'ty; mut:mut; .. > get -> 'ty -> unit 97 | 98 | (** Use the type equality implied by the bijection ['a⟺'b] to create 99 | a new ['b] field getter from an ['a] field getter. 100 | The new field getter uses option access *) 101 | val transmute : 102 | (< x:'a; mut:'m; ..> as 'x) get 103 | -> ('a,'b) bijection 104 | -> < x:'b; mut:'m; ret:'b option > get 105 | 106 | (** Operator version of [transmute] *) 107 | val ( @: ) : 108 | (< x:'a; mut:'m; ..> as 'x) get 109 | -> ('a,'b) bijection 110 | -> < x:'b; mut:'m; ret:'b option > get 111 | 112 | (** exception based version of transmute *) 113 | val transmute_exn: 114 | (< x:'a; mut:'m; ..> as 'x) get 115 | -> ('a,'b) bijection 116 | -> < x:'b; mut:'m; ret:'b> get 117 | 118 | (** Operator version of [transmute_exn] *) 119 | val ( @:! ) : 120 | (< x:'a; mut:'m; ..> as 'x) get 121 | -> ('a,'b) bijection 122 | -> < x:'b; mut:'m; ret:'b> get 123 | 124 | end 125 | 126 | (** Create a new namespace *) 127 | module Make: functor () -> S 128 | -------------------------------------------------------------------------------- /src/type_data.ml: -------------------------------------------------------------------------------- 1 | (** Type level data *) 2 | 3 | (** Type brand for getter field *) 4 | type mut = Nil_mutable 5 | type imm = Nil_immutable 6 | 7 | 8 | (** Phantom type info carrier for updater and getter *) 9 | type ('core_type,'brand) getter = Nil_getter 10 | type +'kind updater = Nil_updater 11 | 12 | (** Phantom type brand for const updater ( field ^= const ), function updater 13 | field |= f (field value) and delete updater *) 14 | type top = Nil_top 15 | type only = Nil_bottom 16 | 17 | type 'a fn = top * 'a *'a 18 | type 'a const ='a * top *'a 19 | type 'a del = 'a *'a * top 20 | 21 | (** A type 'a [fn|const|del] can be unified to [any] or only [fn|const|del], 22 | whereas a type only [fn|const|del] is fixed *) 23 | type any =top*top*top 24 | 25 | 26 | (** Storage type-level function *) 27 | type ('ty, 'fy, 'brand) storage = 28 | | Imm: ('a, 'a, imm) storage 29 | | Mut: ('a, 'a ref, mut) storage 30 | 31 | (** Failure handling phantom type : either exception or option *) 32 | type ('ty_arg,'ty_res ) access = 33 | | Opt: ('a,'a option) access 34 | | Exn: ('a,'a) access 35 | -------------------------------------------------------------------------------- /src/type_data.mli: -------------------------------------------------------------------------------- 1 | (** Type level data *) 2 | 3 | (** Type brand for getter field *) 4 | type mut = Nil_mutable 5 | type imm = Nil_immutable 6 | 7 | 8 | (** Phantom type info carrier for updater and getter *) 9 | type ('core_type,'brand) getter = Nil_getter 10 | type +'kind updater = Nil_updater 11 | 12 | (** Phantom type brand for const updater ( field ^= const ), function updater 13 | field |= f (field value) and delete updater *) 14 | type top = Nil_top 15 | type only = Nil_bottom 16 | 17 | type 'a fn = top * 'a *'a 18 | type 'a const ='a * top *'a 19 | type 'a del = 'a *'a * top 20 | 21 | (** A type 'a [fn|const|del] can be unified to [any] or only [fn|const|del], 22 | whereas a type only [fn|const|del] is fixed *) 23 | type any =top*top*top 24 | 25 | 26 | (** Storage type-level function *) 27 | type ('ty, 'fy, 'brand) storage = 28 | | Imm: ('a, 'a, imm) storage 29 | | Mut: ('a, 'a ref, mut) storage 30 | 31 | (** Failure handling phantom type : either exception or option *) 32 | type ('ty_arg,'ty_res ) access = 33 | | Opt: ('a,'a option) access 34 | | Exn: ('a,'a) access 35 | -------------------------------------------------------------------------------- /src/univ.ml: -------------------------------------------------------------------------------- 1 | (* Open type for unique type identifier *) 2 | type _ type_id = .. 3 | exception Type_non_equal 4 | 5 | (* Module type for type-level identifier *) 6 | module type Id = sig 7 | type t 8 | type _ type_id += Id : t type_id 9 | end 10 | 11 | (* Helper type *) 12 | type 'a type_carrier = T 13 | 14 | (* Type witness for type equality *) 15 | type 'a witness = ( module Id with type t = 'a ) 16 | 17 | type key = extension_constructor 18 | 19 | type (_,_) eq = Proof : ('a,'a) eq 20 | 21 | (* Test type equality and, if true, return a proof *) 22 | let ( =? ) (type u) (type v) : u witness -> v witness -> (u,v) eq option = 23 | fun (module U) (module V) -> 24 | match U.Id with 25 | | V.Id -> Some Proof 26 | | _ -> None 27 | 28 | (* Compute the term identifier associated to a type level identifier *) 29 | let id (type a) (module M : Id with type t = a ) = [%extension_constructor M.Id] (* Obj.extension? Brittle or not? *) 30 | 31 | (* Binding: pair an 'a value with an 'a witness and hides the type 'a *) 32 | type binding = B : 'a witness * 'a -> binding 33 | 34 | (* extract back an 'a value from a binding, if the witness is equal to the bound witness *) 35 | let extract: type a. a witness -> binding -> a option= fun witness (B (witness',x) ) -> 36 | match witness =? witness' with 37 | | Some Proof -> Some x 38 | | None -> None 39 | 40 | (* Same thing with an exception rather than an option *) 41 | let extract_exn: type a. a witness -> binding -> a = fun witness (B (witness',x) ) -> 42 | match witness =? witness' with 43 | | Some Proof -> x 44 | | None -> raise Type_non_equal 45 | 46 | (* Create a new type witness *) 47 | let create (type u) () : u witness = 48 | let module K = struct 49 | type t = u 50 | type _ type_id += Id : t type_id 51 | end in 52 | (module K : Id with type t = u ) 53 | 54 | -------------------------------------------------------------------------------- /src/univ.mli: -------------------------------------------------------------------------------- 1 | (** Helper type *) 2 | type 'a type_carrier = T 3 | 4 | (** Unique type identifier with equality*) 5 | type 'a witness 6 | 7 | (** key type *) 8 | type key 9 | 10 | (** Compute the value-level identifier associated to a type-level identifier*) 11 | val id : 'a witness -> key 12 | 13 | (** Bind together an 'a type-identifier with an 'a value *) 14 | type binding = B : 'a witness * 'a -> binding 15 | 16 | (** Try to extract an 'a value from a binding using the given type identifier*) 17 | val extract : 'a witness -> binding -> 'a option 18 | val extract_exn : 'a witness -> binding -> 'a 19 | 20 | (** Create a new type identifier*) 21 | val create : unit -> 'a witness 22 | --------------------------------------------------------------------------------