├── .gitignore ├── CHANGES.md ├── COPYING ├── README.md ├── api ├── dune └── ocaml_in_python_api.ml ├── dune-project ├── ocaml-in-python.opam ├── ocaml-in-python.opam.template ├── ocaml ├── __init__.py ├── dune ├── ocaml_in_python.ml ├── pyproject.toml └── setup.cfg ├── python3-command ├── python3-command.in └── tests ├── aliases ├── aliases.py └── dune ├── dict ├── dict.ml ├── dict.py └── dune ├── examples ├── dune ├── examples.ml └── examples.py ├── exceptions ├── dune ├── exceptions.ml └── exceptions.py ├── extension_constructors ├── dune ├── extension_constructors.ml ├── extension_constructors.py └── extension_constructors_3_10.py ├── irregular ├── dune ├── irregular.ml └── irregular.py ├── nested_modules ├── dune ├── nested_modules.ml └── nested_modules.py ├── simple ├── dune ├── simple.ml ├── simple.py └── simple_3_10.py └── stdlib ├── dune └── stdlib.py /.gitignore: -------------------------------------------------------------------------------- 1 | *~ 2 | __pycache__/ 3 | /_build -------------------------------------------------------------------------------- /CHANGES.md: -------------------------------------------------------------------------------- 1 | # Development version 2 | 3 | - Fix #1: Port to ppxlib 0.26.0 (suggested by @nilsbecker) 4 | https://github.com/thierry-martinez/ocaml-in-python/issues/1 5 | 6 | - Fix #2: Bindings generation failed when converters span between 7 | multiple compilation units (reported by @nilsbecker) 8 | https://github.com/thierry-martinez/ocaml-in-python/issues/2 9 | 10 | - Fix #2: Better behavior with respect to code completion in Python REPL 11 | (suggested by @nilsbecker) 12 | https://github.com/thierry-martinez/ocaml-in-python/issues/2 13 | 14 | # v0.1.0, 2022-03-24 15 | 16 | Initial release 17 | -------------------------------------------------------------------------------- /COPYING: -------------------------------------------------------------------------------- 1 | BSD 2-Clause License 2 | 3 | Copyright (c) 2019-2021, Thierry Martinez. 4 | All rights reserved. 5 | 6 | Redistribution and use in source and binary forms, with or without 7 | modification, are permitted provided that the following conditions are met: 8 | 9 | 1. Redistributions of source code must retain the above copyright notice, this 10 | list of conditions and the following disclaimer. 11 | 2. Redistributions in binary form must reproduce the above copyright notice, 12 | this list of conditions and the following disclaimer in the documentation 13 | and/or other materials provided with the distribution. 14 | 15 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND 16 | ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED 17 | WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE 18 | DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR 19 | ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES 20 | (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; 21 | LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND 22 | ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 23 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS 24 | SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 25 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # Effortless Python bindings for OCaml modules 2 | 3 | This library exposes all OCaml modules as Python modules, generating 4 | bindings on the fly. 5 | 6 | ## Requirements 7 | 8 | - `OCaml` >= 4.13 9 | 10 | - `Python` >= 3.7 (and >= 3.10 for pattern-matching support) 11 | 12 | ## Setup 13 | 14 | The package can be installed via `opam`: 15 | 16 | - `opam install ocaml-in-python` installs the latest release, 17 | 18 | - `opam pin add -k path . && opam install ocaml-in-python` 19 | executed in a clone of this repository installs the latest development version. 20 | 21 | Once installed via `opam`, the package should be registered in the Python environment. 22 | There are two options: 23 | 24 | - either you register the package with `pip` using the following command (requires Python >=3.8): 25 | ```bash 26 | pip install --editable "`opam var ocaml-in-python:lib`" 27 | ``` 28 | 29 | - or you add the following definition to your environment: 30 | ```bash 31 | export PYTHONPATH="`opam var share`/python/:$PYTHONPATH" 32 | ``` 33 | 34 | ## Examples 35 | 36 | ### Standard library 37 | 38 | A very simple mean to test that the bindings are working properly is to invoke 39 | the OCaml standard library from Python. 40 | 41 | ```python 42 | import ocaml 43 | print(ocaml.List.map((lambda x : x + 1), [1, 2, 3])) 44 | # => output: [2;3;4] 45 | ``` 46 | 47 | In the following example, we invoke the `ref` function from the OCaml 48 | standard library to create a value of type `int ref` (a mutable 49 | reference to an integer), and the following commands show that the 50 | reference can be mutated from Python (a reference is a record with a 51 | mutable field `contents`) and from OCaml (here by invoking the OCaml 52 | function `incr`). 53 | 54 | ```python 55 | >>> x = ocaml.ref(1, type=int) 56 | >>> x 57 | {'contents':1} 58 | >>> x.contents = 2 59 | >>> x 60 | {'contents':2} 61 | >>> ocaml.incr(x) 62 | >>> x 63 | {'contents':3} 64 | ``` 65 | 66 | ### OCaml module compiled on the fly 67 | 68 | In the following example, we compile an OCaml module on the fly from Python. 69 | 70 | ```python 71 | import ocaml 72 | 73 | m = ocaml.compile(r''' 74 | let hello x = Printf.printf "Hello, %s!\n%!" x 75 | 76 | type 'a tree = Node of { label : 'a; children : 'a tree list } 77 | 78 | let rec height (Node { label = _; children }) = 79 | 1 + List.fold_left (fun accu tree -> max accu (height tree)) 0 children 80 | 81 | let rec of_list nodes = 82 | match nodes with 83 | | [] -> invalid_arg "of_list" 84 | | [last] -> Node { label = last; children = [] } 85 | | hd :: tl -> Node { label = hd; children = [of_list tl] } 86 | ''') 87 | 88 | m.hello("world") 89 | # => output: Hello, world! 90 | 91 | print(m.height( 92 | m.Node(label=1, children=[m.Node(label=2, children=[])]))) 93 | # => output: 2 94 | 95 | print(m.of_list(["a", "b", "c"])) 96 | # => output: Node {label="a";children=[Node {label="b";children=[Node {label="c";children=[]}]}]} 97 | 98 | try: 99 | print(m.of_list([])) 100 | except ocaml.Invalid_argument as e: 101 | print(e) 102 | # => output: Stdlib.Invalid_argument("of_list") 103 | ``` 104 | 105 | It is worth noticing that there is no need for type annotations: 106 | bindings are generated with respect to the interface obtained 107 | by type inference. 108 | 109 | ### Requiring a library with `findlib` 110 | 111 | In the following example, we call the OCaml library 112 | [`parmap`](https://github.com/rdicosmo/parmap) from Python. 113 | 114 | ```python 115 | import ocaml 116 | 117 | ocaml.require("parmap") 118 | 119 | from ocaml import Parmap 120 | 121 | print(Parmap.parmap( 122 | (lambda x : x + 1), Parmap.A([1, 2, 3]), ncores=2)) 123 | # => output: [2, 3, 4] 124 | ``` 125 | 126 | The function `ocaml.require` uses 127 | [`ocamlfind`](https://github.com/ocaml/ocamlfind) to load `parmap`. 128 | Bindings are generated as soon as `ocaml.Parmap` is accessed 129 | (in the example, at line `from ocaml import Parmap`). 130 | `Parmap.A` is one of the two constructors of the type `Parmap.sequence`. 131 | 132 | ## Conversion rules 133 | 134 | The generation of bindings is driven by the types exposed by the 135 | compiled module interfaces (`*.cmi` files): relying on the `*.cmi` 136 | files allows the bindings to cover most of the OCaml definitions 137 | (there are some limitations though, see below) and to use the inferred 138 | types for modules whose interface is not explicitly specified by a 139 | `.mli` file. 140 | 141 | ### Built-in types 142 | 143 | The following conversions are defined for built-in types: 144 | 145 | - OCaml `int`, `nativeint` `int32`, `int64` are mapped to Python `int`; 146 | 147 | ```python 148 | import ocaml 149 | 150 | ocaml.print_endline(ocaml.string_of_int(42)) 151 | # => output: 42 152 | print(ocaml.int_of_string("5") + 1) 153 | # => output: 6 154 | ``` 155 | 156 | - OCaml `string` is mapped to Python `str` 157 | 158 | ```python 159 | import ocaml 160 | 161 | ocaml.print_endline("Hello, World!") 162 | # => output: Hello, World! 163 | print(ocaml.String.make(3, "a") + "b") 164 | # => output: aaab 165 | ``` 166 | 167 | - OCaml `char` is mapped to Python `str` with a single character 168 | 169 | ```python 170 | import ocaml 171 | 172 | print(ocaml.int_of_char("a")) 173 | # => output: 97 174 | print(ocaml.char_of_int(65)) 175 | # => output: A 176 | ``` 177 | 178 | - OCaml `bool` is mapped to Python `bool` (beware of different case convention: 179 | OCaml values `false` and `true` are mapped to Python values 180 | `False` and `True` respectively) 181 | 182 | ```python 183 | import ocaml 184 | 185 | print(ocaml.Sys.interactive.contents) 186 | # => output: False 187 | print(ocaml.string_of_bool(True)) 188 | # => output: true 189 | ``` 190 | 191 | - OCaml `float` is mapped to Python `float`, and functions taking 192 | floats as arguments can take benefit from the Python automatic 193 | coercion from `int` to `float` 194 | 195 | ```python 196 | import ocaml 197 | 198 | print(ocaml.float_of_int(1)) 199 | # => output: 1.0 200 | print(ocaml.cos(0)) 201 | # => output: 1.0 202 | ``` 203 | 204 | - OCaml `array` is mapped to a dedicated class `ocaml.array`, which 205 | supports indexing, enumeration, pattern-matching (with Python >= 3.10) 206 | and in-place modification. When an OCaml array is converted to a Python 207 | object, the elements are converted on demand. 208 | There is an implicit coercion to array from all Python iterable types 209 | such as Python lists (but in-place modification is lost). 210 | 211 | ```python 212 | import ocaml 213 | 214 | arr = ocaml.Array.make(3, 0) 215 | arr[1] = 1 216 | print(ocaml.Array.fold_left((lambda x,y : x + y), 0, arr)) 217 | # => output: 1 218 | ocaml.Array.sort(ocaml.compare, arr) 219 | print(list(arr)) 220 | # => output: [0, 0, 1] 221 | print(ocaml.Array.map((lambda x: x + 1), range(0, 4))) 222 | # => output: [|1;2;3;4|] 223 | 224 | # With Python 3.10: 225 | match arr: 226 | case [0, 0, 1]: 227 | print("Here") 228 | # => output: Here 229 | ``` 230 | 231 | It is worth noticing that `Array.make` is a polymorphic function 232 | parameterized in the type of the elements of the constructed array, 233 | and by default the type parameter for polymorphic function with 234 | `ocaml-in-python` is `Py.Object.t`, the type of all Python objects. 235 | As such, the cells of the array `arr` defined above can contain any 236 | Python objects, not only integers. 237 | 238 | ```python 239 | arr[0] = "Test" 240 | print(arr) 241 | # => output: [|"Test";0;1|] 242 | ``` 243 | 244 | We can create an array with a specific types for cells by 245 | expliciting the type parameter of `Array.make`, by using the keyword 246 | parameter `type`. 247 | 248 | ```python 249 | arr = ocaml.Array.make(3, 0, type=int) 250 | arr[0] = "Test" 251 | # TypeError: 'str' object cannot be interpreted as an integer 252 | ``` 253 | 254 | - OCaml `list` is mapped to a dedicated class `ocaml.list`, which 255 | supports indexing, enumeration and pattern-matching (with Python >= 3.10). 256 | When an OCaml list is converted to a Python 257 | object, the elements are converted on demand. 258 | There is an implicit coercion to list from all Python iterable types 259 | such as Python lists. 260 | 261 | - OCaml `bytes` is mapped to a dedicated class `ocaml.bytes`, which 262 | behaves as a mutable collection of characters. 263 | 264 | - OCaml `option` is mapped to a dedicated class `ocaml.option`, only 265 | for values of the form `Some x` where the type of `x` allows the 266 | value `None`. If the type of `x` does not contain a value `None`, 267 | the OCaml value `Some x` is mapped directly to the conversion of `x`. 268 | Conversely, the value `Some x` can be constructed 269 | with `ocaml.Some(x)`. 270 | The OCaml value `None` is mapped to the Python value `None`. 271 | 272 | ```python 273 | print(ocaml.List.find_opt((lambda x : x > 1), [0,1], type=int)) 274 | # => output: None 275 | print(ocaml.List.find_opt((lambda x : x > 1), [0,1,2], type=int)) 276 | # => output: 2 277 | print(ocaml.List.find_opt((lambda x : x > 1), [0,1,2])) 278 | # => output: Some(2) 279 | ``` 280 | 281 | In the last call to `find_opt`, the default type parameter is `Py.Object.t` 282 | which contains the value `None`. 283 | 284 | - OCaml `exn` is mapped to a dedicated class `ocaml.exn`, which is a 285 | sub-class of Python `Error` class, and exceptions are converted as 286 | other extension constructors: each exception is a sub-class of `ocaml.exn`, 287 | and values can be indexed (if the exception constructor takes parameters), 288 | accessed by field name (for inline records) and supports 289 | pattern-matching (with Python >= 3.10). 290 | There is an implicit coercion from other sub-classes of Python `Error` class 291 | to `Py.E`, the OCaml exception defined in `pyml` for Python exceptions. 292 | If an exception is raised between OCaml and Python code, the exception is 293 | converted and raised from one side to the other. 294 | 295 | ```python 296 | try: 297 | ocaml.failwith("Test") 298 | except ocaml.Failure as e: 299 | print(e[0]) 300 | # => output: Test 301 | ``` 302 | 303 | - OCaml `in_channel` and `out_channel` are mapped to `FileIO` objects. 304 | In the following example, the OCaml function `open_out` is used to create 305 | a new file `test`, and the string `Hello` is written in this file through 306 | the Python method `write`. Then, the file `test` is opened for reading 307 | with the Python built-in `open`, and the channel is read with the OCaml 308 | function `really_input_string`. 309 | 310 | ```python 311 | with ocaml.open_out("test") as f: 312 | f.write(b"Hello") 313 | with open("test", "r") as f: 314 | print(ocaml.really_input_string(f, 5)) 315 | # => ouput: Hello 316 | ``` 317 | 318 | - OCaml `floatarray` is mapped to a dedicated class `ocamlarray`, 319 | which derives from `numpy` array (`numpy` is required for the 320 | support of `floatarray`). 321 | 322 | ### Type constructors 323 | 324 | - OCaml functions of type `'t_1 -> ... -> 't_n -> 'r` 325 | are mapped to Python callable objects with `n` arguments. 326 | Labelled arguments are mapped to mandatory keyword arguments, 327 | and optional arguments are mapped to optional keyword arguments. 328 | For polymorphic functions, the type parameters are assumed to be 329 | `Py.Object.t`, except if there is a keyword argument `type`: 330 | the associated value can either be a single type if there is 331 | a single type parameter, or a tuple of types giving the type 332 | parameters in the order of their apparition in the function signature, 333 | or a dictionary whose keys are the names of the type parameters 334 | (e.g., `"a"` for `'a`). 335 | 336 | - OCaml tuples of type `'t_1 * ... * 't_n` 337 | are mapped to OCaml tuples with `n` components. 338 | 339 | ### Type definitions 340 | 341 | Each OCaml type definition introduces a new Python class, except for 342 | type aliases, that are exposed as other names for the same class. 343 | 344 | Records are accessible by field name or index (in the order of the 345 | field declarations), and the values of the fields are converted on 346 | demand. Mutable fields can be set in Python. In particular, the `ref` 347 | type defined in the OCaml standard library is mapped to the Python 348 | class `ocaml.ref` with a mutable field `content`. 349 | Records support pattern-matching (with Python >= 3.10). 350 | There is an implicit coercion from Python dictionaries with matching 351 | field names. 352 | 353 | For variants, there is a sub-class by constructor, which behaves 354 | either as a tuple or as a record. 355 | The values of the arguments are converted on demand. 356 | Variants support pattern-matching (with Python >= 3.10). 357 | 358 | ### Sub-module definitions 359 | 360 | Sub-modules are mapped to classes, which are constructed on demand. 361 | For instance, the module `Array.Floatarray` is exposed as 362 | `ocaml.Array.Floatarray`, and, in particular, the function 363 | `Array.Floatarray.create` is available as 364 | `ocaml.Array.Floatarray.create`. 365 | 366 | ## Limitations 367 | 368 | The following traits of the OCaml type system are not supported (yet): 369 | 370 | - records with polymorphic fields, 371 | - polymorphic variants, 372 | - objects, 373 | - functors, 374 | - first class modules. 375 | -------------------------------------------------------------------------------- /api/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name ocaml_in_python_api) 3 | (public_name ocaml-in-python.api) 4 | (preprocess (pps metapp.ppx metaquot.ppx)) 5 | (libraries compiler-libs pyml ppxlib metapp)) 6 | -------------------------------------------------------------------------------- /api/ocaml_in_python_api.ml: -------------------------------------------------------------------------------- 1 | module ExtensibleArray = struct 2 | type 'a t = { 3 | mutable array : 'a array; 4 | mutable length : int; 5 | dummy : 'a; 6 | } 7 | 8 | let create dummy capacity = 9 | assert (capacity >= 1); 10 | { 11 | array = Array.make capacity dummy; 12 | length = 0; 13 | dummy; 14 | } 15 | 16 | let length ext = 17 | ext.length 18 | 19 | let get ext index = 20 | assert (index >= 0 && index < ext.length); 21 | ext.array.(index) 22 | 23 | let set ext index value = 24 | assert (index >= 0 && index < ext.length); 25 | ext.array.(index) <- value 26 | 27 | let push_f ext f = 28 | let index = ext.length in 29 | let new_length = succ index in 30 | ext.length <- new_length; 31 | let old_capacity = Array.length ext.array in 32 | let array = 33 | if new_length < old_capacity then 34 | ext.array 35 | else 36 | begin 37 | let new_capacity = old_capacity * 2 in 38 | let new_array = Array.make new_capacity ext.dummy in 39 | Array.blit ext.array 0 new_array 0 old_capacity; 40 | ext.array <- new_array; 41 | new_array 42 | end in 43 | array.(index) <- f index; 44 | index 45 | 46 | let push ext value = 47 | push_f ext (fun _ -> value) 48 | 49 | let to_list_map f ext = 50 | List.init ext.length (fun i -> f (get ext i)) 51 | end 52 | 53 | let rec hash_path seed (p : Path.t) = 54 | match p with 55 | | Pident ident -> Hashtbl.seeded_hash seed (0, Ident.hash ident) 56 | | Pdot (p, s) -> Hashtbl.seeded_hash seed (1, hash_path seed p, s) 57 | | Papply (p, q) -> 58 | Hashtbl.seeded_hash seed (2, hash_path seed p, hash_path seed q) 59 | 60 | let format_label (fmt : Format.formatter) (l : Ppxlib.arg_label) = 61 | match l with 62 | | Nolabel -> () 63 | | Labelled s -> Format.fprintf fmt "~%s:" s 64 | | Optional s -> Format.fprintf fmt "?%s:" s 65 | 66 | module Function = struct 67 | type t = 68 | | Implicit of Ppxlib.expression 69 | | ImplicitDelayed of (unit -> Ppxlib.expression) 70 | | Explicit of (Ppxlib.expression -> Ppxlib.expression) 71 | 72 | let apply (f : t) (e : Ppxlib.expression) = 73 | match f with 74 | | Implicit f -> [%expr [%e f] [%e e]] 75 | | ImplicitDelayed f -> [%expr [%e f ()] [%e e]] 76 | | Explicit f -> f e 77 | 78 | let to_expression (f : t) = 79 | match f with 80 | | Implicit f -> f 81 | | ImplicitDelayed f -> f () 82 | | Explicit f -> [%expr fun v -> [%e f [%expr v]]] 83 | end 84 | 85 | type value_converter = { 86 | python_of_ocaml : Function.t; 87 | ocaml_of_python : Function.t; 88 | } 89 | 90 | type converters_of_arity = { 91 | python_args : Ppxlib.expression; 92 | python_dict : Ppxlib.expression; 93 | ocaml_pats : (Ppxlib.arg_label * Ppxlib.pattern) list; 94 | ocaml_exps : (Ppxlib.arg_label * (unit -> Ppxlib.expression)) list; 95 | } 96 | 97 | module Type = struct 98 | module Self = struct 99 | type t = 100 | | Any 101 | | Var of int 102 | | Arrow of param * t 103 | | Tuple of t list 104 | | Constr of Path.t * t list 105 | and param = { 106 | label : Ppxlib.arg_label; 107 | ty : t; 108 | } 109 | 110 | 111 | let rec hash seed t = 112 | match t with 113 | | Any -> Hashtbl.seeded_hash seed (-1) 114 | | Var x -> Hashtbl.seeded_hash seed (0, x) 115 | | Arrow ({ label; ty }, r) -> 116 | Hashtbl.seeded_hash seed (1, label, hash seed ty, hash seed r) 117 | | Tuple args -> 118 | Hashtbl.seeded_hash seed (2, List.map (hash seed) args) 119 | | Constr (p, args) -> 120 | Hashtbl.seeded_hash seed 121 | (3, hash_path seed p, List.map (hash seed) args) 122 | 123 | let rec equal t t' = 124 | match t, t' with 125 | | Any, Any -> true 126 | | Var x, Var y -> x = y 127 | | Arrow (p, r), Arrow (p', r') -> 128 | p.label = p'.label && equal p.ty p'.ty && equal r r' 129 | | Tuple args, Tuple args' -> 130 | List.equal equal args args' 131 | | Constr (p, args), Constr (p', args') -> 132 | Path.same p p' && List.equal equal args args' 133 | | _ -> false 134 | end 135 | 136 | include Self 137 | 138 | let rec subst f ty = 139 | match ty with 140 | | Any -> Any 141 | | Var index -> f index 142 | | Arrow ({ label; ty }, result) -> 143 | Arrow ({ label; ty = subst f ty }, subst f result) 144 | | Tuple list -> Tuple (List.map (subst f) list) 145 | | Constr (constr, args) -> Constr (constr, List.map (subst f) args) 146 | 147 | let map_param f param = { param with ty = f param.ty } 148 | 149 | type arity = { 150 | params : param list; 151 | result : t; 152 | } 153 | 154 | let map_arity f arity = { 155 | params = List.map (map_param f) arity.params; 156 | result = f arity.result; 157 | } 158 | 159 | let wrap, unwrap = Py.Capsule.make "ocaml.Type" 160 | 161 | let of_python (py_type : Py.Object.t) : t = 162 | let ocaml = Py.Import.import_module "ocaml" in 163 | if py_type = Py.Module.get (Py.Module.builtins ()) "object" then 164 | Any 165 | else if py_type = Py.Module.get ocaml "int" then 166 | Constr (Predef.path_int, []) 167 | else if py_type = Py.Module.get ocaml "float" then 168 | Constr (Predef.path_float, []) 169 | else if py_type = Py.Module.get ocaml "string" then 170 | Constr (Predef.path_string, []) 171 | else if py_type = Py.Module.get ocaml "bool" then 172 | Constr (Predef.path_bool, []) 173 | else 174 | unwrap ( 175 | Py.Callable.to_function_as_tuple 176 | (Py.Object.find_attr_string py_type "_get_type") 177 | (Py.Tuple.singleton py_type)) 178 | 179 | let rec arity_of_type (ty : t) : arity = 180 | match ty with 181 | | Arrow (param, result) -> 182 | let { params; result } = arity_of_type result in 183 | { params = param :: params; result } 184 | | _ -> 185 | { params = []; result = ty } 186 | 187 | let rec format (fmt : Format.formatter) (ty : t) = 188 | match ty with 189 | | Any -> Format.fprintf fmt "_" 190 | | Var i -> Format.fprintf fmt "'_%d" i 191 | | Arrow ({ label; ty }, r) -> 192 | Format.fprintf fmt "(%a%a -> %a)" format_label label format ty format r 193 | | Tuple args -> 194 | Format.fprintf fmt "(%a)" 195 | (Format.pp_print_list ~pp_sep:(fun fmt () -> Format.fprintf fmt " * ") 196 | format) args 197 | | Constr (p, []) -> 198 | Format.fprintf fmt "%a" Path.print p 199 | | Constr (p, args) -> 200 | Format.fprintf fmt "(%a) %a" 201 | (Format.pp_print_list ~pp_sep:(fun fmt () -> Format.fprintf fmt ", ") 202 | format) args Path.print p 203 | 204 | let to_string (ty : t) = 205 | Format.asprintf "%a" format ty 206 | 207 | let rec to_core_type (ty : t) : Ppxlib.Parsetree.core_type = 208 | match ty with 209 | | Any -> [%type: Py.Object.t] 210 | | Var _ -> assert false 211 | | Arrow ({ label; ty }, r) -> 212 | Ppxlib.Ast_helper.Typ.arrow label (to_core_type ty) (to_core_type r) 213 | | Tuple args -> 214 | Ppxlib.Ast_helper.Typ.tuple (List.map to_core_type args) 215 | | Constr (p, args) -> 216 | let p = Untypeast.lident_of_path p in 217 | let args = List.map to_core_type args in 218 | Ppxlib.Ast_helper.Typ.constr (Metapp.mkloc p) args 219 | 220 | module Hashtbl = Hashtbl.MakeSeeded (Self) 221 | 222 | let to_value_converter_ref = ref (fun ?(name : string option) (_ : Env.t) (_ : Path.t Path.Map.t) (_ : t) : 223 | value_converter -> ignore name; failwith "Not yet available to_value_converter") 224 | 225 | let to_value_converter ?name env expansions ty = 226 | !to_value_converter_ref ?name env expansions ty 227 | 228 | let converters_of_arity_ref = ref (fun (_ : Env.t) (_ : Path.t Path.Map.t) (_ : arity) : 229 | converters_of_arity -> failwith "Not yet available converters_of_arity") 230 | 231 | let converters_of_arity env expansions arity = 232 | !converters_of_arity_ref env expansions arity 233 | 234 | let value_converter_of_function_ref = ref (fun ?(name : string option) (_ : Env.t) (_ : Path.t Path.Map.t) (_ : arity) : 235 | value_converter -> ignore name; failwith "Not yet available value_converter_of_function") 236 | 237 | let value_converter_of_function ?name env expansions arity = 238 | !value_converter_of_function_ref ?name env expansions arity 239 | 240 | let types : t ExtensibleArray.t = 241 | ExtensibleArray.create Any 16 242 | 243 | let type_table = Hashtbl.create 16 244 | 245 | let to_index ty = 246 | try 247 | Hashtbl.find type_table ty 248 | with Not_found -> 249 | let index = ExtensibleArray.push types ty in 250 | Hashtbl.add type_table ty index; 251 | index 252 | 253 | let of_index index = 254 | ExtensibleArray.get types index 255 | end 256 | 257 | module TypeList = struct 258 | module Self = struct 259 | type t = Type.t list 260 | 261 | let hash seed l = 262 | Hashtbl.seeded_hash seed (List.map (Type.hash seed) l) 263 | 264 | let equal l l' = 265 | List.equal Type.equal l l' 266 | end 267 | 268 | include Self 269 | 270 | module Hashtbl = Hashtbl.MakeSeeded (Self) 271 | end 272 | 273 | module Paths = struct 274 | type path_cell = { 275 | path : Path.t; 276 | class_ : Py.Object.t; 277 | } 278 | 279 | type index_cell = { 280 | index : int; 281 | class_ : Py.Object.t; 282 | } 283 | 284 | let dummy = { path = Predef.path_int; class_ = Py.null } 285 | 286 | let store : path_cell ExtensibleArray.t = 287 | ExtensibleArray.create dummy 16 288 | 289 | let converted_map_ref = ref Path.Map.empty 290 | 291 | let find_opt path = 292 | Path.Map.find_opt path !converted_map_ref 293 | 294 | let get index = 295 | ExtensibleArray.get store index 296 | 297 | let register path class_ = 298 | let converted_map = !converted_map_ref in 299 | let index = ExtensibleArray.push store { path; class_ } in 300 | converted_map_ref := Path.Map.add path { index; class_ } converted_map; 301 | index 302 | end 303 | 304 | type variable_index = { 305 | module_index : int; 306 | local_index : int; 307 | } 308 | 309 | let array_capsules : variable_index Type.Hashtbl.t = Type.Hashtbl.create 16 310 | 311 | let array_api : Py.Object.t Type.Hashtbl.t = Type.Hashtbl.create 16 312 | 313 | let list_capsules : variable_index Type.Hashtbl.t = Type.Hashtbl.create 16 314 | 315 | let list_api : Py.Object.t Type.Hashtbl.t = Type.Hashtbl.create 16 316 | 317 | let tuple_capsules : variable_index TypeList.Hashtbl.t = 318 | TypeList.Hashtbl.create 16 319 | 320 | let tuple_api : Py.Object.t TypeList.Hashtbl.t = TypeList.Hashtbl.create 16 321 | 322 | module IntHashtbl = Hashtbl.MakeSeeded (struct 323 | type t = int 324 | 325 | let equal = Int.equal 326 | 327 | let hash = Hashtbl.seeded_hash 328 | end) 329 | 330 | type 'a api = { 331 | api : 'a; 332 | make : Py.Object.t -> Py.Object.t; 333 | } 334 | 335 | type 'a type_def_info = { 336 | make_capsule : TypeList.t -> unit; 337 | make_api : TypeList.t -> unit; 338 | api_table : 'a api TypeList.Hashtbl.t; 339 | } 340 | 341 | let type_def_table : Py.Object.t type_def_info IntHashtbl.t = IntHashtbl.create 16 342 | 343 | let api_for_type type_def_info tuple = 344 | let types = Py.Tuple.get tuple 0 in 345 | let type_list = 346 | try 347 | Py.List.to_list_map Type.of_python types 348 | with _ -> 349 | [Type.of_python types] in 350 | let api = 351 | try 352 | TypeList.Hashtbl.find type_def_info.api_table type_list 353 | with Not_found -> 354 | type_def_info.make_capsule type_list; 355 | type_def_info.make_api type_list; 356 | try 357 | TypeList.Hashtbl.find type_def_info.api_table type_list 358 | with Not_found -> 359 | failwith "api_for_type" in 360 | api.api 361 | 362 | let variant_table : Py.Object.t array type_def_info IntHashtbl.t = IntHashtbl.create 16 363 | 364 | module OpenType = struct 365 | let table : Py.Object.t array type_def_info IntHashtbl.t = IntHashtbl.create 16 366 | end 367 | 368 | let capsule_count = ref 0 369 | 370 | let get_root_python_module () = 371 | Py.Import.import_module "ocaml" 372 | 373 | external fd_of_int : int -> Unix.file_descr = "%identity" 374 | 375 | external int_of_fd : Unix.file_descr -> int = "%identity" 376 | 377 | let py_of_char c = 378 | Py.String.of_string (String.make 1 c) 379 | 380 | let char_of_py obj = 381 | let s = Py.String.to_string obj in 382 | if String.length s <> 1 then 383 | raise (Py.Err (TypeError, 384 | Printf.sprintf "char expected but \"%s\" given" s)); 385 | s.[0] 386 | 387 | let bytes_capsule : (bytes -> Py.Object.t) * (Py.Object.t -> bytes) = 388 | Py.Capsule.make "ocaml.bytes" 389 | 390 | let raise_index_out_of_bounds ~index ~length = 391 | raise (Py.Err (IndexError, Printf.sprintf "Index %d out of bounds 0<=.<%d" 392 | index length)) 393 | 394 | type generic_python_function = 395 | args_tuple:Py.Object.t -> keywords_dict:Py.Object.t -> Py.Object.t 396 | 397 | module PolymorphicFunction = struct 398 | type t = { 399 | make : TypeList.t -> generic_python_function; 400 | table : generic_python_function TypeList.Hashtbl.t; 401 | } 402 | 403 | let table : t option ExtensibleArray.t = 404 | ExtensibleArray.create None 16 405 | 406 | let get index = 407 | Option.get (ExtensibleArray.get table index) 408 | 409 | let push f = 410 | ExtensibleArray.push_f table (fun index -> Some (f index)) 411 | end 412 | 413 | let get_floatarray obj = 414 | try Py.Array.numpy_get_array obj 415 | with Not_found -> 416 | let len = Py.Sequence.length obj in 417 | let result = Array.Floatarray.create len in 418 | for i = 0 to len - 1 do 419 | Array.Floatarray.set result i 420 | (Py.Float.to_float (Py.Sequence.get_item obj i)); 421 | done; 422 | result 423 | 424 | module Extension_constructor = struct 425 | let (to_python, of_python) : (extension_constructor -> Py.Object.t) * (Py.Object.t -> extension_constructor) = 426 | Py.Capsule.make "extension_constructor" 427 | end 428 | 429 | let exception_class = ref Py.none 430 | 431 | let pending_module_table : Py.Object.t Lazy.t Path.Map.t ref = 432 | ref Path.Map.empty 433 | 434 | let pending_modules : Py.Object.t Lazy.t ExtensibleArray.t = 435 | ExtensibleArray.create (lazy (failwith "not yet available")) 16 436 | -------------------------------------------------------------------------------- /dune-project: -------------------------------------------------------------------------------- 1 | (lang dune 2.9) 2 | 3 | (generate_opam_files true) 4 | 5 | (name ocaml-in-python) 6 | (license "BSD-2-Clause") 7 | (maintainers "Thierry Martinez ") 8 | (authors "Thierry Martinez ") 9 | (source (uri "git+https://github.com/thierry-martinez/ocaml-in-python")) 10 | (homepage "https://github.com/thierry-martinez/ocaml-in-python") 11 | (bug_reports "https://github.com/thierry-martinez/ocaml-in-python") 12 | (documentation "https://github.com/thierry-martinez/ocaml-in-python") 13 | (version "0.1.0") 14 | 15 | (package 16 | (name ocaml-in-python) 17 | (synopsis "Effortless Python bindings for OCaml modules") 18 | (description "\ 19 | Effortless Python bindings for OCaml modules 20 | ") 21 | (depends 22 | (ocaml (>= 4.13.0)) 23 | (ppxlib (>= 0.26.0)) 24 | (metapp (>= 0.4.3)) 25 | (metaquot (>= 0.5.1)) 26 | (pyml (>= 20220325)) 27 | conf-python-3-7 28 | (parmap :with-test))) 29 | -------------------------------------------------------------------------------- /ocaml-in-python.opam: -------------------------------------------------------------------------------- 1 | # This file is generated by dune, edit dune-project instead 2 | opam-version: "2.0" 3 | version: "0.1.0" 4 | synopsis: "Effortless Python bindings for OCaml modules" 5 | description: """ 6 | Effortless Python bindings for OCaml modules 7 | """ 8 | maintainer: ["Thierry Martinez "] 9 | authors: ["Thierry Martinez "] 10 | license: "BSD-2-Clause" 11 | homepage: "https://github.com/thierry-martinez/ocaml-in-python" 12 | doc: "https://github.com/thierry-martinez/ocaml-in-python" 13 | bug-reports: "https://github.com/thierry-martinez/ocaml-in-python" 14 | depends: [ 15 | "dune" {>= "2.9"} 16 | "ocaml" {>= "4.13.0"} 17 | "ppxlib" {>= "0.26.0"} 18 | "metapp" {>= "0.4.3"} 19 | "metaquot" {>= "0.5.1"} 20 | "pyml" {>= "20220325"} 21 | "conf-python-3-7" 22 | "parmap" {with-test} 23 | "odoc" {with-doc} 24 | ] 25 | build: [ 26 | ["dune" "subst"] {dev} 27 | [ 28 | "dune" 29 | "build" 30 | "-p" 31 | name 32 | "-j" 33 | jobs 34 | "--promote-install-files=false" 35 | "@install" 36 | "@runtest" {with-test} 37 | "@doc" {with-doc} 38 | ] 39 | ["dune" "install" "-p" name "--create-install-files" name] 40 | ] 41 | dev-repo: "git+https://github.com/thierry-martinez/ocaml-in-python" 42 | substs: ["python3-command"] 43 | post-messages: "\ 44 | You should register the \"ocaml\" package in your Python environment. 45 | There are two options: 46 | 47 | (1) either you register the package with \"pip\" using the following 48 | command: 49 | pip install --editable \"%{lib}%/ocaml-in-python\" 50 | 51 | (2) or you add the following definition to your environment: 52 | export PYTHONPATH=\"%{share}%/python/:$PYTHONPATH\" 53 | " {success} -------------------------------------------------------------------------------- /ocaml-in-python.opam.template: -------------------------------------------------------------------------------- 1 | substs: ["python3-command"] 2 | post-messages: "\ 3 | You should register the \"ocaml\" package in your Python environment. 4 | There are two options: 5 | 6 | (1) either you register the package with \"pip\" using the following 7 | command: 8 | pip install --editable \"%{lib}%/ocaml-in-python\" 9 | 10 | (2) or you add the following definition to your environment: 11 | export PYTHONPATH=\"%{share}%/python/:$PYTHONPATH\" 12 | " {success} -------------------------------------------------------------------------------- /ocaml/__init__.py: -------------------------------------------------------------------------------- 1 | """ocaml-in-python""" 2 | 3 | import collections.abc 4 | import ctypes 5 | import os 6 | 7 | int = int 8 | float = float 9 | string = str 10 | bool = bool 11 | bytes = bytes 12 | 13 | def error_this_function_should_be_implemented_in_ocaml(): 14 | raise NotImplementedError("This function should be implemented in OCaml") 15 | 16 | class __list_api: 17 | make = None 18 | make_from_sequence = None 19 | length = None 20 | getitem = None 21 | 22 | class abstract: 23 | """ocaml.abstract""" 24 | 25 | def __init__(self, *params, **kw): 26 | try: 27 | self._capsule = kw["__capsule"] 28 | except KeyError: 29 | raise RuntimeError("abstract type cannot be constructed") 30 | 31 | def print_value(v): 32 | """double quote v if v is a string, return str(v) otherwise""" 33 | if isinstance(v, str): 34 | quoted = v.replace('"', r'\"') 35 | return f'"{quoted}"' 36 | else: 37 | return str(v) 38 | 39 | class list(collections.abc.Sequence): 40 | """ocaml.list""" 41 | 42 | def _api_for_type(self, _type): 43 | error_this_function_should_be_implemented_in_ocaml() 44 | return self 45 | 46 | _default_type = None 47 | 48 | _default_length = None 49 | 50 | _field_names = None 51 | 52 | def __init__(self, *params, **kw): 53 | try: 54 | capsule = kw["__capsule"] 55 | except KeyError: 56 | capsule = None 57 | if capsule is None: 58 | try: 59 | length = kw["len"] 60 | if self._default_length not in (None, length): 61 | raise IndexError( 62 | f"len={length} but {self._default_length} expected" 63 | ) 64 | except KeyError: 65 | length = self._default_length 66 | nb_params = len(params) 67 | if nb_params == 1: 68 | self._template_item = params[0] 69 | self._items = None 70 | self._length = length 71 | elif nb_params == 0 and self._field_names != None: 72 | self._items = [kw[field] for field in self._field_names] 73 | else: 74 | if length not in (None, nb_params): 75 | raise IndexError( 76 | f"len={length} but {nb_params} items given" 77 | ) 78 | self._template_item = None 79 | self._items = params 80 | self._length = nb_params 81 | try: 82 | type_ = kw["type"] 83 | except KeyError: 84 | type_ = self._default_type 85 | if type_ is None: 86 | self._capsule = None 87 | self._api = None 88 | else: 89 | self._api = self._api_for_type(type_) 90 | self._init_from_api() 91 | else: 92 | self._capsule = capsule 93 | try: 94 | self._api = kw["api"] 95 | except KeyError: 96 | self._api = self._api_for_type(self._default_type) 97 | 98 | def _init_from_api(self): 99 | if self._items is None: 100 | self._capsule = self._api.make( 101 | self._length, self._template_item 102 | ) 103 | del self._template_item 104 | else: 105 | self._capsule = self._api.make_from_sequence(self._items) 106 | del self._items 107 | 108 | def __len__(self): 109 | if self._capsule is None: 110 | return self._length 111 | return self._api.length(self._capsule) 112 | 113 | def __getitem__(self, index): 114 | if self._capsule is None: 115 | if self._items is None: 116 | if 0 <= index < self._length: 117 | return self._template_item 118 | raise IndexError( 119 | f"index {index} out of bounds (0<=.<{self._length})" 120 | ) 121 | return self._items[index] 122 | return self._api.getitem(self._capsule, index) 123 | 124 | def _get_type(self): 125 | if self._capsule is None: 126 | raise RuntimeError("Type is unknown yet") 127 | return self._api.get_type() 128 | 129 | def _set_api(self, api): 130 | self._api = api 131 | self._init_from_api() 132 | return self._capsule 133 | 134 | def __getattr__(self, name): 135 | if name[0:1] == "f": 136 | try: 137 | index = int(name[1:]) 138 | except ValueError: 139 | index = None 140 | if index is not None: 141 | return self[index] 142 | raise AttributeError(f"Unknown field {name}") 143 | 144 | def __repr__(self): 145 | return "[" + ",".join([repr(item) for item in self]) + "]" 146 | 147 | def __str__(self): 148 | return "[" + ";".join([print_value(item) for item in self]) + "]" 149 | 150 | class tuple(list): 151 | """ocaml.tuple""" 152 | 153 | def __repr__(self): 154 | return "(" + ",".join([repr(item) for item in self]) + ")" 155 | 156 | def __str__(self): 157 | return "(" + ",".join([print_value(item) for item in self]) + ")" 158 | 159 | class __array_api(__list_api): 160 | setitem = None 161 | 162 | class array(list): 163 | """ocaml.array""" 164 | 165 | def __setitem__(self, index, value): 166 | if self._capsule is None: 167 | if self._items is None: 168 | if self._length is None: 169 | self._items = [self._template_item] 170 | else: 171 | self._items = [self._template_item] * self._length 172 | del self._template_item 173 | self._items[index] = value 174 | else: 175 | self._api.setitem(self._capsule, index, value) 176 | 177 | def __repr__(self): 178 | return "[" + ",".join([repr(item) for item in self]) + "]" 179 | 180 | def __str__(self): 181 | return "[|" + ";".join([print_value(item) for item in self]) + "|]" 182 | 183 | class record(array): 184 | """ocaml.record""" 185 | 186 | def __repr__(self): 187 | return "{" + ",".join( 188 | [repr(field) + ":" + repr(value) 189 | for (field, value) in zip(self._field_names, self)]) + "}" 190 | 191 | def __str__(self): 192 | return "{" + ";".join( 193 | [str(field) + "=" + print_value(value) 194 | for (field, value) in zip(self._field_names, self)]) + "}" 195 | 196 | class variant(array): 197 | """ocaml.variant""" 198 | 199 | _constructor_name = None 200 | 201 | def __repr__(self): 202 | if len(self) == 0: 203 | return self._constructor_name 204 | elif self._field_names is None: 205 | return self._constructor_name + "(" + ",".join( 206 | [print_value(item) for item in self]) + ")" 207 | else: 208 | return (self._constructor_name + "(" + ",".join([ 209 | str(field) + "=" + repr(value) 210 | for (field, value) in zip(self._field_names, self)]) + ")") 211 | 212 | def __str__(self): 213 | if len(self) == 0: 214 | return self._constructor_name 215 | elif self._field_names is None: 216 | return self._constructor_name + "(" + ",".join( 217 | [print_value(item) for item in self]) + ")" 218 | else: 219 | return (self._constructor_name + " {" + ";".join([ 220 | str(field) + "=" + print_value(value) 221 | for (field, value) in zip(self._field_names, self)]) + "}") 222 | 223 | 224 | class bytes(array): 225 | """ocaml.bytes""" 226 | 227 | _default_type = [] 228 | 229 | def __repr__(self): 230 | return repr(self._api.to_string(self._capsule)) 231 | 232 | def __str__(self): 233 | return self._api.to_string(self._capsule) 234 | 235 | class option(variant): 236 | """ocaml.option""" 237 | 238 | class Some(option): 239 | """ocaml.Some""" 240 | 241 | _constructor_name = "Some" 242 | 243 | _default_length = 1 244 | 245 | class exn(variant, Exception): 246 | """ocaml.exn""" 247 | 248 | def __initialize_ocaml(): 249 | curdir = os.path.dirname(os.path.realpath(__file__)) 250 | dll = ctypes.PyDLL(f"{curdir}/ocaml_in_python.so", ctypes.RTLD_GLOBAL) 251 | argv_t = ctypes.c_char_p * 2 252 | argv = argv_t("python".encode('utf-8'), None) 253 | dll.caml_startup(argv) 254 | 255 | __initialize_ocaml() 256 | -------------------------------------------------------------------------------- /ocaml/dune: -------------------------------------------------------------------------------- 1 | (executable 2 | (name ocaml_in_python) 3 | (preprocess (pps metapp.ppx metaquot.ppx)) 4 | (modes (native shared_object)) 5 | (flags :standard -linkall) 6 | (libraries 7 | pyml findlib.dynload compiler-libs.optcomp ppxlib ocaml_in_python_api)) 8 | 9 | (install 10 | (section share_root) 11 | (files 12 | (__init__.py as python/ocaml/__init__.py) 13 | (ocaml_in_python.so as python/ocaml/ocaml_in_python.so))) 14 | 15 | (install 16 | (section lib) 17 | (files 18 | pyproject.toml setup.cfg 19 | (__init__.py as ocaml/__init__.py) 20 | (ocaml_in_python.so as ocaml/ocaml_in_python.so))) 21 | -------------------------------------------------------------------------------- /ocaml/ocaml_in_python.ml: -------------------------------------------------------------------------------- 1 | [%%metapackage metapp] 2 | 3 | [%%meta 4 | let target_minor_version = 14 in 5 | let ocaml_minor_version = 6 | int_of_string (String.sub Sys.ocaml_version 2 2) in 7 | let make_converter field_name e = 8 | let rec convert minor_version e = 9 | if minor_version = target_minor_version then 10 | e 11 | else 12 | let next_version = 13 | if minor_version < target_minor_version then 14 | minor_version + 1 15 | else 16 | minor_version - 1 in 17 | let converter_name = 18 | Format.asprintf "Migrate_4%.2d_4%.2d" 19 | next_version minor_version in 20 | let converter = 21 | Metapp.Exp.ident 22 | (Ldot (Ldot (Lident "Astlib", converter_name), 23 | field_name)) in 24 | [%e [%meta converter] [%meta convert next_version e]] in 25 | convert ocaml_minor_version e in 26 | [%stri 27 | let copy_structure s = [%meta make_converter "copy_structure" [%e s]] 28 | and copy_signature s = [%meta make_converter "copy_signature" [%e s]] 29 | and copy_expression e = [%meta make_converter "copy_expression" [%e e]] 30 | and copy_pattern p = [%meta make_converter "copy_pattern" [%e p]] 31 | and copy_core_type t = [%meta make_converter "copy_core_type" [%e t]]]] 32 | 33 | let add_dir d = 34 | let dir = Load_path.Dir.create d in 35 | Load_path.append_dir dir 36 | 37 | let debug = ref false 38 | 39 | (* BEGIN Stolen from Fl_dynload *) 40 | 41 | let in_words s = 42 | (* splits s in words separated by commas and/or whitespace *) 43 | let l = String.length s in 44 | let rec split i j = 45 | if j < l then 46 | match s.[j] with 47 | | (' '|'\t'|'\n'|'\r'|',') -> 48 | if i 51 | split i (j+1) 52 | else 53 | if i 71 | (* Legacy: use "archive" but require that the predicate 72 | "plugin" is mentioned in the definition 73 | *) 74 | try 75 | let v, fpreds = 76 | Findlib.package_property_2 ("plugin"::preds) pkg "archive" in 77 | let need_plugin = 78 | List.mem "native" preds in 79 | if need_plugin && not (List.mem (`Pred "plugin") fpreds) then 80 | "" 81 | else 82 | v 83 | with Not_found -> "" in 84 | (* Split the plugin/archive property and resolve the files: *) 85 | let files = in_words archive in 86 | if !debug then 87 | Format.eprintf "[DEBUG] Fl_dynload: files=%S\n%!" archive; 88 | List.iter 89 | (fun file -> 90 | if !debug then 91 | Format.eprintf "[DEBUG] Fl_dynload: loading %S\n%!" file; 92 | let file = Findlib.resolve_path ~base:d file in 93 | Dynlink.loadfile file 94 | ) files; 95 | Findlib.record_package Findlib.Record_load pkg 96 | ) 97 | else 98 | if !debug then 99 | Format.eprintf "[DEBUG] Fl_dynload: not loading: %s\n%!" pkg 100 | 101 | let load_packages pkgs = 102 | let preds = Findlib.recorded_predicates() in 103 | let eff_pkglist = 104 | Findlib.package_deep_ancestors preds pkgs in 105 | List.iter load_pkg eff_pkglist 106 | 107 | (* END Stolen from Fl_dynload *) 108 | 109 | let require name = 110 | try 111 | load_packages [name]; 112 | with Fl_package_base.No_such_package (name, _) -> 113 | raise (Py.Err (ImportError, Printf.sprintf "No such package: %s" name)) 114 | 115 | let python_of_longident longident = 116 | Format.asprintf "ocaml.%a" Printtyp.longident longident 117 | 118 | (* Stolen from native/topeval.ml *) 119 | module Backend = struct 120 | (* See backend_intf.mli. *) 121 | 122 | let symbol_for_global' = Compilenv.symbol_for_global' 123 | let closure_symbol = Compilenv.closure_symbol 124 | 125 | let really_import_approx = Import_approx.really_import_approx 126 | let import_symbol = Import_approx.import_symbol 127 | 128 | let size_int = Sys.word_size 129 | let big_endian = Sys.big_endian 130 | 131 | let max_sensible_number_of_arguments = 132 | (* The "-1" is to allow for a potential closure environment parameter. *) 133 | Proc.max_arguments_for_tailcalls - 1 134 | end 135 | 136 | let backend = (module Backend : Backend_intf.S) 137 | 138 | let compile_and_load_structure ocaml_env module_name structure = 139 | if structure <> [] then 140 | begin 141 | let structure = copy_structure structure in 142 | if !debug then 143 | begin 144 | prerr_endline module_name; 145 | Format.eprintf "%a@." Pprintast.structure structure; 146 | end; 147 | Compilenv.reset module_name; 148 | let impl = 149 | Typemod.type_implementation "" "" module_name ocaml_env structure in 150 | let transl_implementation = 151 | if Config.flambda then 152 | Translmod.transl_implementation_flambda 153 | else 154 | Translmod.transl_store_implementation in 155 | let program = 156 | transl_implementation module_name (impl.structure, impl.coercion) in 157 | let program = 158 | { program with code = Simplif.simplify_lambda program.code } in 159 | let filename_dll = Filename.temp_file "ocaml-in-python" Config.ext_dll in 160 | let prefixname = Filename.chop_extension filename_dll in 161 | let middle_end = 162 | if Config.flambda then 163 | Flambda_middle_end.lambda_to_clambda 164 | else 165 | Closure_middle_end.lambda_to_clambda in 166 | let ppf_dump = Format.err_formatter in 167 | Asmgen.compile_implementation ~backend ~prefixname ~middle_end ~ppf_dump 168 | program; 169 | let filename_cmx = prefixname ^ ".cmx" in 170 | Compilenv.save_unit_info filename_cmx; 171 | Asmlink.link_shared ~ppf_dump [filename_cmx] filename_dll; 172 | let filename_dll = 173 | if Filename.is_implicit filename_dll then 174 | Filename.concat (Sys.getcwd ()) filename_dll 175 | else 176 | filename_dll in 177 | Dynlink.loadfile filename_dll; 178 | (*Sys.remove filename_dll*) 179 | end 180 | 181 | let current_module_index = ref None 182 | 183 | let module_name index = 184 | Format.sprintf "Ocaml_in_python_dyn%d" index 185 | 186 | let accu_structure = ref [] 187 | 188 | let push_structure structure = 189 | assert (!current_module_index <> None); 190 | accu_structure := List.rev_append structure !accu_structure 191 | 192 | let preambles = ref [] 193 | 194 | let push_preamble structure = 195 | preambles := structure :: !preambles; 196 | push_structure structure 197 | 198 | let pop_preample () = 199 | match !preambles with 200 | | _ :: tail -> preambles := tail 201 | | [] -> assert false 202 | 203 | let count counter = 204 | let result = !counter in 205 | counter := succ result; 206 | result 207 | 208 | let prepare_compilation_unsafe () = 209 | let index = count Ocaml_in_python_api.capsule_count in 210 | current_module_index := Some index; 211 | index 212 | 213 | let prepare_compilation_opt () = 214 | match !current_module_index with 215 | | None -> Some (prepare_compilation_unsafe ()) 216 | | Some _ -> None 217 | 218 | let prepare_compilation_immediate () = 219 | assert (!current_module_index = None); 220 | prepare_compilation_unsafe () 221 | 222 | let root_ocaml_env = ref None 223 | 224 | let perform_compilation () = 225 | let index = Option.get !current_module_index in 226 | let structure = List.rev !accu_structure in 227 | let module_name = module_name index in 228 | compile_and_load_structure (Option.get !root_ocaml_env) module_name structure; 229 | accu_structure := []; 230 | current_module_index := None 231 | 232 | let cut_compilation () = 233 | if List.length !accu_structure >= 100 then 234 | begin 235 | perform_compilation (); 236 | ignore (prepare_compilation_unsafe ()); 237 | List.iter push_structure (List.rev !preambles) 238 | end 239 | 240 | let catch_compiler_errors f = 241 | try 242 | f () 243 | with 244 | | Env.Error error -> 245 | let error_msg = Format.asprintf "%a" Env.report_error error in 246 | raise (Py.Err (ImportError, error_msg)) 247 | | exn -> 248 | let error_msg = 249 | match Location.error_of_exn exn with 250 | | None -> Printexc.to_string exn 251 | | Some (`Ok error) -> Format.asprintf "%a" Location.print_report error 252 | | Some `Already_displayed -> assert false in 253 | raise (Py.Err (ImportError, error_msg)) 254 | 255 | let make_python_tuple (values : Ppxlib.expression list) : Ppxlib.expression = 256 | let length = List.length values in 257 | if length = 0 then 258 | [%expr Py.Tuple.empty] 259 | else [%expr 260 | let result = Py.Tuple.create [%e Metapp.Exp.of_int length] in 261 | [%e Metapp.sequence (values |> List.mapi (fun i v -> 262 | [%expr Py.Tuple.set_item result [%e Metapp.Exp.of_int i] [%e v]]))]; 263 | result] 264 | 265 | let make_python_dict values : Ppxlib.expression = [%expr 266 | let result = Py.Dict.create () in 267 | [%e Metapp.sequence (values |> List.map (fun (key, optional, conv, value) -> 268 | if optional then [%expr 269 | match [%e value] with 270 | | None -> () 271 | | Some value -> 272 | Py.Dict.set_item result [%e Metapp.Exp.of_string key] 273 | [%e conv [%expr value]]] 274 | else [%expr 275 | Py.Dict.set_item result [%e Metapp.Exp.of_string key] [%e conv value]]))]; 276 | result] 277 | 278 | let var_f i = Printf.sprintf "f%d" i 279 | 280 | let make_python_sequence ?setitem classname ~getitem ~len = 281 | let methods = [ 282 | [%expr "__getitem__", Py.Callable.of_function_as_tuple (fun tuple -> 283 | let (self, index) = Py.Tuple.to_tuple2 tuple in [%e 284 | getitem [%expr Py.Int.to_int index]])]; 285 | [%expr "__len__", Py.Callable.of_function_as_tuple (fun _tuple -> 286 | Py.Int.of_int [%e len])]] in 287 | let methods = 288 | match setitem with 289 | | None -> methods 290 | | Some setitem -> 291 | [%expr "__setitem__", Py.Callable.of_function_as_tuple (fun tuple -> 292 | let (self, index, value) = Py.Tuple.to_tuple3 tuple in [%e 293 | setitem [%expr Py.Int.to_int index] [%expr value]]; 294 | Py.none)] 295 | :: methods in [%expr 296 | let abc = Py.Import.import_module "collections.abc" in 297 | let sequence = Py.Module.get abc "Sequence" in 298 | Py.Class.init [%e Metapp.Exp.of_string classname] ~parents:[sequence] 299 | ~methods:[%e Metapp.Exp.list methods]] 300 | 301 | module StringHashtbl = Hashtbl.MakeSeeded (struct 302 | type t = string 303 | 304 | let equal = String.equal 305 | 306 | let hash = Hashtbl.seeded_hash 307 | end) 308 | 309 | let convert_label (label : Asttypes.arg_label) : Ppxlib.arg_label = 310 | match label with 311 | | Nolabel -> Nolabel 312 | | Labelled label -> Labelled label 313 | | Optional label -> Optional label 314 | 315 | let uid_of_type_path ocaml_env path = 316 | try 317 | (Ocaml_common.Env.find_type path ocaml_env).type_uid 318 | with Not_found -> 319 | failwith (Format.asprintf "Unbound type %a" Path.print path) 320 | 321 | let uid_of_type_lident ocaml_env (lident : Longident.t) = 322 | let _path, td = 323 | Ocaml_common.Env.lookup_type ~loc:Location.none lident ocaml_env in 324 | td.type_uid 325 | 326 | let import_ocaml_module_in_python_ref = ref (fun ?target_top_module:_ _ _ -> 327 | failwith "not available yet") 328 | 329 | let import_ocaml_module_in_python ?target_top_module ocaml_env (expansions : Path.t Path.Map.t) = 330 | !import_ocaml_module_in_python_ref ?target_top_module ocaml_env expansions 331 | 332 | module StringSet = Set.Make (String) 333 | 334 | let is_unit_type (ty : Ocaml_in_python_api.Type.t) = 335 | match ty with 336 | | Constr (path, []) when Path.same path Predef.path_unit -> true 337 | | _ -> false 338 | 339 | module VentilateParams = struct 340 | type t = { 341 | labels : string list; 342 | optional_labels : string list; 343 | no_label_count : int; 344 | } 345 | 346 | let empty = { 347 | labels = []; 348 | optional_labels = []; 349 | no_label_count = 0; 350 | } 351 | 352 | let add (accu : t) (param : Ocaml_in_python_api.Type.param) = 353 | match param.label with 354 | | Nolabel -> 355 | if is_unit_type param.ty then 356 | accu 357 | else 358 | { accu with no_label_count = succ accu.no_label_count } 359 | | Labelled label -> { accu with labels = label :: accu.labels } 360 | | Optional label -> 361 | { accu with optional_labels = label :: accu.optional_labels } 362 | 363 | let ventilate (params : Ocaml_in_python_api.Type.param list) = 364 | let result = List.fold_left add empty params in 365 | { labels = List.rev result.labels; 366 | optional_labels = List.rev result.optional_labels; 367 | no_label_count = result.no_label_count; } 368 | end 369 | 370 | let check_arguments (arity : Ocaml_in_python_api.Type.arity) = 371 | let params = VentilateParams.ventilate arity.params in 372 | [%expr 373 | let nb_args = Py.Tuple.size args_tuple in 374 | if nb_args <> [%e Metapp.Exp.of_int params.no_label_count] then 375 | raise (Py.Err (RuntimeError, 376 | Printf.sprintf "%d positional argument%s expected but %d given" 377 | [%e Metapp.Exp.of_int params.no_label_count] 378 | [%e if params.no_label_count = 1 then Metapp.Exp.of_string "" 379 | else Metapp.Exp.of_string "s"] 380 | nb_args)); 381 | [%e Metapp.sequence (params.labels |> List.map (fun label -> 382 | [%expr if keywords_dict = Py.null || Py.Dict.get_item_string keywords_dict [%e Metapp.Exp.of_string label] = None then 383 | raise (Py.Err (RuntimeError, 384 | Printf.sprintf "labelled argument '%s' expected" 385 | [%e Metapp.Exp.of_string label]))]))]; 386 | if keywords_dict <> Py.null then 387 | keywords_dict |> Py.Dict.iter (fun key _value -> 388 | let key = Py.String.to_string key in 389 | if [%e List.fold_left 390 | (fun acc label -> 391 | [%expr [%e acc] && key <> [%e Metapp.Exp.of_string label]]) 392 | [%expr key <> "type"] 393 | (params.labels @ params.optional_labels)] then 394 | raise (Py.Err (RuntimeError, 395 | Printf.sprintf "unknown labelled argument '%s'" key)))] 396 | 397 | type lident_or_variable_index = 398 | (Longident.t, Ocaml_in_python_api.variable_index) Either.t 399 | 400 | type expression_or_variable_index = 401 | (Ppxlib.Parsetree.expression, Ocaml_in_python_api.variable_index) Either.t 402 | 403 | let get_variable_ident get_local_name (variable_index : Ocaml_in_python_api.variable_index) : 404 | Longident.t = 405 | let local = get_local_name variable_index.local_index in 406 | let current = Option.get !current_module_index in 407 | if variable_index.module_index = current then 408 | Lident local 409 | else 410 | Ldot (Lident (module_name variable_index.module_index), local) 411 | 412 | let get_variable get_local_name (ident : lident_or_variable_index) = 413 | match ident with 414 | | Left ident -> [%expr ![%e Metapp.Exp.ident ident]] 415 | | Right index -> Metapp.Exp.ident (get_variable_ident get_local_name index) 416 | 417 | let get_variable_expression (ident : lident_or_variable_index) : 418 | expression_or_variable_index = 419 | match ident with 420 | | Left ident -> Left [%expr ![%e Metapp.Exp.ident ident]] 421 | | Right index -> Right index 422 | 423 | let get_variable_as_expression get_local_name (ident : expression_or_variable_index) = 424 | match ident with 425 | | Left exp -> exp 426 | | Right index -> Metapp.Exp.ident (get_variable_ident get_local_name index) 427 | 428 | type type_constr_info = { 429 | converter : Env.t -> Path.t Path.Map.t -> Ocaml_in_python_api.Type.t list -> Ocaml_in_python_api.value_converter; 430 | class_ : expression_or_variable_index; 431 | } 432 | 433 | let type_constr_converter_tbl : type_constr_info Types.Uid.Tbl.t = 434 | Types.Uid.Tbl.create 16 435 | 436 | let exn_converter_ref = ref (fun _ocaml_env _expansions : Ocaml_in_python_api.value_converter -> { 437 | python_of_ocaml = Implicit [%expr raise]; 438 | ocaml_of_python = Explicit (fun _v -> [%expr failwith "Not available"]); 439 | }) 440 | 441 | let make_python_function_call ocaml_env expansions 442 | (result_converter : Ocaml_in_python_api.value_converter) v python_args 443 | python_dict = [%expr 444 | try 445 | [%e Ocaml_in_python_api.Function.apply result_converter.ocaml_of_python 446 | [%expr Py.Callable.to_function_as_tuple_and_dict [%e v] 447 | [%e python_args] [%e python_dict]]] 448 | with (Py.E (_, obj)) as exc -> 449 | let exc' = 450 | try 451 | [%e Ocaml_in_python_api.Function.apply 452 | (!exn_converter_ref ocaml_env expansions).ocaml_of_python [%expr obj]] 453 | with _ -> 454 | raise exc in 455 | raise exc'] 456 | 457 | let make_python_string s = 458 | [%expr Py.String.of_string [%e Metapp.Exp.of_string s]] 459 | 460 | let make_python_int s = 461 | [%expr Py.Int.of_int [%e Metapp.Exp.of_int s]] 462 | 463 | let make_property ?(getter = [%expr Py.none]) ?(setter = [%expr Py.none]) () = 464 | [%expr 465 | Py.Module.get_function (Py.Module.builtins ()) "property" 466 | [%e Metapp.Exp.array [getter; setter]]] 467 | 468 | let make_ocaml_function_call ocaml_env expansions arity (result_converter : Ocaml_in_python_api.value_converter) f ocaml_exps = 469 | let ocaml_exps = 470 | ocaml_exps |> List.map (fun (label, exp) -> (label, exp ())) in [%expr 471 | [%e check_arguments arity]; 472 | try 473 | let result = [%e Ppxlib.Ast_helper.Exp.apply f ocaml_exps] in 474 | [%e Ocaml_in_python_api.Function.apply result_converter.python_of_ocaml 475 | [%expr result]] 476 | with 477 | | (Py.E _ | Py.Err _) as exc -> raise exc 478 | | exc -> 479 | let obj = 480 | [%e Ocaml_in_python_api.Function.apply 481 | (!exn_converter_ref ocaml_env expansions).python_of_ocaml [%expr exc]] in 482 | let class_ = Py.Object.find_attr_string obj "__class__" in 483 | raise (Py.E (class_, obj))] 484 | 485 | let rec wake_up_modules (p : Path.t) = 486 | match Path.Map.find p !Ocaml_in_python_api.pending_module_table with 487 | | l -> ignore (Lazy.force l) 488 | | exception Not_found -> 489 | match p with 490 | | Pdot (p, _) -> wake_up_modules p 491 | | _ -> () 492 | 493 | let type_info_of_constr ocaml_env expansions path = 494 | wake_up_modules path; 495 | let uid = uid_of_type_path ocaml_env path in 496 | try 497 | Some (Types.Uid.Tbl.find type_constr_converter_tbl uid) 498 | with Not_found -> 499 | match path with 500 | | Pident _ -> None 501 | | _ -> 502 | ignore (import_ocaml_module_in_python ocaml_env 503 | expansions (Ident.name (Path.head path))); 504 | try 505 | Some (Types.Uid.Tbl.find type_constr_converter_tbl uid) 506 | with Not_found -> 507 | None 508 | 509 | module Type = struct 510 | include Ocaml_in_python_api.Type 511 | 512 | let has_none ocaml_env (ty : t) = 513 | match ty with 514 | | Any 515 | | Var _ -> true 516 | | Arrow _ -> false 517 | | Tuple _ -> false 518 | | Constr (path, _args) -> 519 | let td = Ocaml_common.Env.find_type path ocaml_env in 520 | match td.type_kind with 521 | | Type_abstract -> false 522 | | Type_record _ -> false 523 | | Type_variant (constructors, _) -> 524 | constructors |> List.exists (fun 525 | (constructor : Types.constructor_declaration) -> 526 | Ident.name constructor.cd_id = "None") 527 | | Type_open -> true 528 | 529 | module Vars = struct 530 | type nonrec t = { 531 | names : string option Ocaml_in_python_api.ExtensibleArray.t; 532 | table : t Ocaml_in_python_api.IntHashtbl.t; 533 | } 534 | 535 | let count (vars : t) = 536 | Ocaml_in_python_api.ExtensibleArray.length vars.names 537 | 538 | let create () = { 539 | names = Ocaml_in_python_api.ExtensibleArray.create None 16; 540 | table = Ocaml_in_python_api.IntHashtbl.create 16; 541 | } 542 | 543 | let get_name (vars : t) (i : int) = 544 | Ocaml_in_python_api.ExtensibleArray.get vars.names i 545 | 546 | let fresh ?name ~id (vars : t) = 547 | let index = Ocaml_in_python_api.ExtensibleArray.push vars.names name in 548 | Ocaml_in_python_api.IntHashtbl.add vars.table id (Var index); 549 | index 550 | 551 | let bind (vars : t) (ty : Types.type_expr) ty' = 552 | Ocaml_in_python_api.IntHashtbl.add vars.table (Metapp.Types.get_id ty) ty' 553 | 554 | let find (vars : t) (ty : Types.type_expr) = 555 | let id = Metapp.Types.get_id ty in 556 | try 557 | Ocaml_in_python_api.IntHashtbl.find vars.table id 558 | with Not_found -> 559 | let name = 560 | match Metapp.Types.get_desc ty with 561 | | Tvar name -> name 562 | | _ -> assert false in 563 | let ty' = Var (fresh ?name ~id vars) in 564 | Ocaml_in_python_api.IntHashtbl.add vars.table id ty'; 565 | ty' 566 | end 567 | 568 | let value_converter_of_tuple = ref (fun (_env : Env.t) (_ : Path.t Path.Map.t) (_args : t list) : Ocaml_in_python_api.value_converter -> 569 | failwith "not available yet") 570 | 571 | let expand_path expansions path = 572 | try 573 | Path.Map.find path expansions 574 | with Not_found -> 575 | path 576 | 577 | let rec of_type_expr (vars : Vars.t) (ocaml_env : Env.t) expansions (ty : Types.type_expr) : t = 578 | match Metapp.Types.get_desc ty with 579 | | Tvar _ -> Vars.find vars ty 580 | | Tarrow (label, param, result, _) -> 581 | let param = of_type_expr vars ocaml_env expansions param in 582 | let result = of_type_expr vars ocaml_env expansions result in 583 | Arrow ({ label = convert_label label; ty = param }, result) 584 | | Ttuple args -> 585 | Tuple (List.map (of_type_expr vars ocaml_env expansions) args) 586 | | Tconstr (path, args, _) -> 587 | let args = List.map (of_type_expr vars ocaml_env expansions) args in 588 | begin match Env.find_type_expansion path ocaml_env with 589 | | params, body, _ -> 590 | let vars' = Vars.create () in 591 | List.iter2 (Vars.bind vars') params args; 592 | of_type_expr vars' ocaml_env expansions body 593 | | exception Not_found -> 594 | Constr (expand_path expansions path, args) 595 | end 596 | | _ -> 597 | failwith "Not implemented" 598 | 599 | let is_pyobject path = 600 | match Path.flatten path with 601 | | `Ok (ident, list) -> Ident.name ident = "Pytypes" && list = ["pyobject"] 602 | | `Contains_apply -> false 603 | 604 | let id : Ocaml_in_python_api.value_converter = { 605 | ocaml_of_python = Explicit Fun.id; 606 | python_of_ocaml = Explicit Fun.id } 607 | 608 | let to_value_converter_impl ?name ocaml_env expansions (ty : t) : Ocaml_in_python_api.value_converter = 609 | match ty with 610 | | Any -> id 611 | | Constr (path, []) when is_pyobject path -> id 612 | | Var _ -> assert false 613 | | Arrow _ -> 614 | value_converter_of_function ?name ocaml_env expansions (arity_of_type ty) 615 | | Tuple args -> 616 | !value_converter_of_tuple ocaml_env expansions args 617 | | Constr (path, args) -> 618 | let type_info = 619 | match type_info_of_constr ocaml_env expansions path with 620 | | None -> 621 | failwith 622 | (Format.asprintf "No conversion for %a" Path.print path) 623 | | Some type_info -> type_info in 624 | let result = type_info.converter ocaml_env expansions args in 625 | result 626 | 627 | let converters_of_arity_impl ocaml_env expansions arity : Ocaml_in_python_api.converters_of_arity = 628 | let add_arg (index, python_args, python_dict) 629 | (param : param) : 630 | _ * ((Ppxlib.arg_label * Ppxlib.pattern) 631 | * (Ppxlib.arg_label * (unit -> Ppxlib.expression))) = 632 | match param.label with 633 | | Nolabel -> 634 | let arg_converter = to_value_converter ocaml_env expansions param.ty in 635 | if is_unit_type param.ty then 636 | (index, python_args, python_dict), 637 | ((Nolabel, [%pat? ()]), (Nolabel, (fun () -> [%expr ()]))) 638 | else 639 | let var = Printf.sprintf "x%d" index in 640 | let python_args = 641 | Ocaml_in_python_api.Function.apply arg_converter.python_of_ocaml 642 | (Metapp.Exp.var var) :: python_args in 643 | (index + 1, python_args, python_dict), 644 | ((Nolabel, Metapp.Pat.var var), 645 | (Nolabel, (fun () -> Ocaml_in_python_api.Function.apply arg_converter.ocaml_of_python 646 | [%expr Py.Tuple.get args_tuple [%e Metapp.Exp.of_int index]]))) 647 | | Labelled label -> 648 | let arg_converter = to_value_converter ocaml_env expansions param.ty in 649 | let python_dict = 650 | (label, false, Ocaml_in_python_api.Function.apply arg_converter.python_of_ocaml, 651 | Metapp.Exp.var label) :: python_dict in 652 | (index, python_args, python_dict), 653 | ((Labelled label, Metapp.Pat.var label), 654 | (Labelled label, 655 | (fun () -> Ocaml_in_python_api.Function.apply arg_converter.ocaml_of_python 656 | [%expr Py.Dict.find_string keywords_dict 657 | [%e Metapp.Exp.of_string label]]))) 658 | | Optional label -> 659 | let arg_converter = 660 | match param.ty with 661 | | Constr (_option, [arg]) -> 662 | to_value_converter ocaml_env expansions arg 663 | | _ -> assert false in 664 | let python_dict = 665 | (label, true, Ocaml_in_python_api.Function.apply arg_converter.python_of_ocaml, 666 | Metapp.Exp.var label) :: python_dict in 667 | (index, python_args, python_dict), 668 | ((Optional label, Metapp.Pat.var label), 669 | (Optional label, (fun () -> [%expr Option.map 670 | [%e Ocaml_in_python_api.Function.to_expression arg_converter.ocaml_of_python] 671 | (if keywords_dict = Py.null then None 672 | else 673 | Py.Dict.find_string_opt keywords_dict 674 | [%e Metapp.Exp.of_string label])]))) in 675 | let (_, python_args, python_dict), ocaml_args = 676 | List.fold_left_map add_arg (0, [], []) arity.params in 677 | let python_args = make_python_tuple (List.rev python_args) in 678 | let python_dict = make_python_dict (List.rev python_dict) in 679 | let ocaml_pats, ocaml_exps = List.split ocaml_args in 680 | { python_args; python_dict; ocaml_pats; ocaml_exps } 681 | 682 | let value_converter_of_function_impl ?name ocaml_env expansions arity : 683 | Ocaml_in_python_api.value_converter = 684 | let ({ python_args; python_dict; ocaml_pats; ocaml_exps } : Ocaml_in_python_api.converters_of_arity) = 685 | converters_of_arity ocaml_env expansions arity in 686 | let result_converter = to_value_converter ocaml_env expansions arity.result in 687 | let ocaml_of_python : Ocaml_in_python_api.Function.t = 688 | let body v = 689 | make_python_function_call ocaml_env expansions result_converter 690 | v python_args python_dict in 691 | let func v = 692 | List.fold_left (fun body (label, pat) -> 693 | Ppxlib.Ast_helper.Exp.fun_ label None pat body) (body v) 694 | (List.rev ocaml_pats) in 695 | Explicit func in 696 | let python_of_ocaml : Ocaml_in_python_api.Function.t = 697 | let stub f = 698 | make_ocaml_function_call ocaml_env expansions arity result_converter f 699 | ocaml_exps in 700 | let f = [%expr Py.Callable.of_function_as_tuple_and_dict] in 701 | let f = 702 | match name with 703 | | None -> f 704 | | Some name -> 705 | let name_expr = Metapp.Exp.of_string name in 706 | [%expr [%e f] ~name:[%e name_expr]] in 707 | Explicit (fun v -> [%expr [%e f] (fun args_tuple keywords_dict -> [%e stub v])]) in 708 | { ocaml_of_python; python_of_ocaml } 709 | 710 | let () = 711 | to_value_converter_ref := to_value_converter_impl; 712 | converters_of_arity_ref := converters_of_arity_impl; 713 | value_converter_of_function_ref := value_converter_of_function_impl 714 | end 715 | 716 | let make_python_sequence_of_array python_of_ocaml ?ocaml_of_python classname 717 | array = 718 | make_python_sequence classname 719 | ~len:[%expr Array.length [%e array]] 720 | ~getitem:(fun index -> [%expr 721 | if 0 <= [%e index] && [%e index] < Array.length [%e array] then 722 | [%e Ocaml_in_python_api.Function.apply python_of_ocaml 723 | [%expr [%e array].([%e index])]] 724 | else 725 | Ocaml_in_python_api.raise_index_out_of_bounds ~index 726 | ~length:(Array.length [%e array])]) 727 | ?setitem:(match ocaml_of_python with 728 | | None -> None 729 | | Some ocaml_of_python -> 730 | Some (fun index value -> [%expr 731 | if 0 <= [%e index] && [%e index] < Array.length [%e array] then 732 | [%e array].([%e index]) <- 733 | [%e Ocaml_in_python_api.Function.apply ocaml_of_python value] 734 | else 735 | Ocaml_in_python_api.raise_index_out_of_bounds ~index 736 | ~length:(Array.length [%e array])])) 737 | 738 | let local_capsule_name index = 739 | Format.sprintf "capsule%d" index 740 | 741 | let fresh_variable_index counter : Ocaml_in_python_api.variable_index = 742 | let local_index = count counter in 743 | { module_index = Option.get !current_module_index; local_index } 744 | 745 | let fresh_capsule_index () = 746 | fresh_variable_index Ocaml_in_python_api.capsule_count 747 | 748 | let capsule_ident variable_index = 749 | get_variable_ident local_capsule_name variable_index 750 | 751 | let push_capsule_declaration var name ty = 752 | push_structure [%str 753 | let [%p Metapp.Pat.var var] : 754 | ([%t ty] -> Py.Object.t) * (Py.Object.t -> [%t ty]) = 755 | Py.Capsule.make [%e name]] 756 | 757 | module LabelInfo = struct 758 | type 'a t = { 759 | name : string; 760 | declaration : Types.label_declaration; 761 | ty : 'a; 762 | } 763 | 764 | let of_declaration (declaration : Types.label_declaration) = 765 | { name = Ident.name declaration.ld_id; 766 | declaration; 767 | ty = declaration.ld_type } 768 | 769 | let map f info = { info with ty = f info.ty } 770 | end 771 | 772 | module Field = struct 773 | type t = { 774 | index : int; 775 | name : string; 776 | mutable_flag : Asttypes.mutable_flag; 777 | } 778 | 779 | let of_label index (label : _ LabelInfo.t) = { 780 | index; 781 | name = label.name; 782 | mutable_flag = label.declaration.ld_mutable; 783 | } 784 | 785 | let of_index index = { 786 | index; 787 | name = Printf.sprintf "f%d" index; 788 | mutable_flag = Immutable; 789 | } 790 | 791 | let to_field field = 792 | let index_exp = Metapp.Exp.of_int field.index in 793 | field.name, make_property () 794 | ~getter:[%expr Py.Callable.of_function_as_tuple 795 | (fun tuple -> Py.Sequence.get (Py.Tuple.get tuple 0) 796 | [%e index_exp])] 797 | ?setter:(match field.mutable_flag with 798 | | Immutable -> None 799 | | Mutable -> Some [%expr Py.Callable.of_function_as_tuple 800 | (fun tuple -> Py.Sequence.set (Py.Tuple.get tuple 0) 801 | [%e index_exp] (Py.Tuple.get tuple 1); 802 | Py.none)]) 803 | 804 | let to_field_name field = 805 | make_python_string field.name 806 | end 807 | 808 | let find_tuple_capsule ocaml_env expansions (types : Type.t list) : 809 | Ocaml_in_python_api.variable_index = 810 | try 811 | Ocaml_in_python_api.TypeList.Hashtbl.find 812 | Ocaml_in_python_api.tuple_capsules types 813 | with Not_found -> 814 | let core_type = Type.to_core_type (Type.Tuple types) in 815 | let converters = List.map (Type.to_value_converter ocaml_env expansions) types in 816 | let nb_converters = List.length converters in 817 | let type_indexes = List.map Ocaml_in_python_api.Type.to_index types in 818 | let capsule_index = fresh_capsule_index () in 819 | let capsule_name = local_capsule_name capsule_index.local_index in 820 | let capsule = Metapp.Exp.var capsule_name in 821 | let types_exp = 822 | Metapp.Exp.list (type_indexes |> List.map (fun type_index -> 823 | [%expr Ocaml_in_python_api.Type.of_index 824 | [%e Metapp.Exp.of_int type_index]])) in 825 | push_capsule_declaration capsule_name 826 | [%expr Format.asprintf "%a" 827 | Ocaml_in_python_api.Type.format 828 | (Ocaml_in_python_api.Type.Tuple [%e types_exp])] core_type; 829 | let structure = [%str 830 | let () = 831 | let api = 832 | Py.Callable.to_function_as_tuple 833 | (Py.Object.find_attr_string 834 | (Ocaml_in_python_api.get_root_python_module ()) "tuple") 835 | Py.Tuple.empty in 836 | Py.Object.set_attr_string api "make" 837 | (Py.Callable.of_function_as_tuple (fun tuple -> 838 | let len = Py.Tuple.get tuple 1 in 839 | let () = 840 | if len <> Py.none && 841 | Py.Int.to_int len <> [%e Metapp.Exp.of_int nb_converters] then 842 | raise (Py.Err (RuntimeError, Printf.sprintf 843 | [%e Metapp.Exp.of_string 844 | (Printf.sprintf "Length set to %%d but tuple is of length %d" 845 | nb_converters)] (Py.Int.to_int len))) in 846 | let template_item = Py.Tuple.get tuple 2 in 847 | let tuple = [%e Ppxlib.Ast_helper.Exp.tuple (converters |> List.map 848 | (fun (converter : Ocaml_in_python_api.value_converter) -> Ocaml_in_python_api.Function.apply converter.ocaml_of_python 849 | [%expr template_item]))] in 850 | fst [%e capsule] tuple)); 851 | Py.Object.set_attr_string api "make_from_sequence" 852 | (Py.Callable.of_function_as_tuple (fun tuple -> 853 | let sequence = Py.Tuple.get tuple 0 in 854 | let tuple = [%e Ppxlib.Ast_helper.Exp.tuple (converters |> List.mapi 855 | (fun i (converter : Ocaml_in_python_api.value_converter) -> Ocaml_in_python_api.Function.apply converter.ocaml_of_python 856 | [%expr Py.Tuple.get sequence [%e Metapp.Exp.of_int i]]))] in 857 | fst [%e capsule] tuple)); 858 | Py.Object.set_attr_string api "length" 859 | (Py.Callable.of_function_as_tuple (fun tuple -> 860 | [%e make_python_int nb_converters])); 861 | Py.Object.set_attr_string api "getitem" 862 | (Py.Callable.of_function_as_tuple (fun tuple -> 863 | let [%p Ppxlib.Ast_helper.Pat.tuple (List.init nb_converters 864 | (fun i -> Metapp.Pat.var (var_f i)))] = 865 | snd [%e capsule] (Py.Tuple.get tuple 0) in [%e 866 | Ppxlib.Ast_helper.Exp.match_ 867 | [%expr Py.Int.to_int (Py.Tuple.get tuple 1)] 868 | ((converters |> List.mapi (fun i (converter : Ocaml_in_python_api.value_converter) -> 869 | Ppxlib.Ast_helper.Exp.case (Metapp.Pat.of_int i) 870 | (Ocaml_in_python_api.Function.apply converter.python_of_ocaml 871 | (Metapp.Exp.var (var_f i))))) @ 872 | [Ppxlib.Ast_helper.Exp.case [%pat? index] [%expr 873 | Ocaml_in_python_api.raise_index_out_of_bounds ~index 874 | ~length:[%e Metapp.Exp.of_int nb_converters]]])])); 875 | Ocaml_in_python_api.TypeList.Hashtbl.add 876 | Ocaml_in_python_api.tuple_api [%e types_exp] api] in 877 | push_structure structure; 878 | Ocaml_in_python_api.TypeList.Hashtbl.add 879 | Ocaml_in_python_api.tuple_capsules types capsule_index; 880 | capsule_index 881 | 882 | let find_tuple_api ocaml_env expansions (types : Type.t list) : Py.Object.t = 883 | try 884 | Ocaml_in_python_api.TypeList.Hashtbl.find Ocaml_in_python_api.tuple_api 885 | types 886 | with Not_found -> 887 | ignore (find_tuple_capsule ocaml_env expansions types); 888 | try 889 | Ocaml_in_python_api.TypeList.Hashtbl.find Ocaml_in_python_api.tuple_api 890 | types 891 | with Not_found -> 892 | assert false 893 | 894 | let make_bytes_api _ocaml_env _expansions : Py.Object.t = 895 | Py.Class.init "bytes" ~methods:[ 896 | "make", Py.Callable.of_function_as_tuple (fun tuple -> 897 | let len = Py.Tuple.get tuple 1 in 898 | let template_item = Py.Tuple.get tuple 2 in 899 | fst Ocaml_in_python_api.bytes_capsule (Bytes.make (Py.Int.to_int len) 900 | (Ocaml_in_python_api.char_of_py template_item))); 901 | "make_from_sequence", Py.Callable.of_function_as_tuple (fun tuple -> 902 | let sequence = Py.Tuple.get tuple 0 in 903 | let len = Py.Sequence.length sequence in 904 | let s = 905 | if len = 1 then 906 | Bytes.of_string (Py.String.to_string (Py.Sequence.get sequence 0)) 907 | else 908 | Bytes.init len (fun i -> 909 | Ocaml_in_python_api.char_of_py (Py.Sequence.get sequence i)) in 910 | fst Ocaml_in_python_api.bytes_capsule s); 911 | "length", Py.Callable.of_function_as_tuple (fun tuple -> 912 | let capsule = Py.Tuple.get tuple 0 in 913 | Py.Int.of_int (Bytes.length (snd Ocaml_in_python_api.bytes_capsule capsule))); 914 | "getitem", Py.Callable.of_function_as_tuple (fun tuple -> 915 | let capsule = Py.Tuple.get tuple 0 in 916 | let index = Py.Tuple.get tuple 1 in 917 | Ocaml_in_python_api.py_of_char 918 | (Bytes.get (snd Ocaml_in_python_api.bytes_capsule capsule) (Py.Int.to_int index))); 919 | "setitem", Py.Callable.of_function_as_tuple (fun tuple -> 920 | let capsule = Py.Tuple.get tuple 0 in 921 | let index = Py.Tuple.get tuple 1 in 922 | let char = Py.Tuple.get tuple 2 in 923 | Bytes.set (snd Ocaml_in_python_api.bytes_capsule capsule) (Py.Int.to_int index) 924 | (Ocaml_in_python_api.char_of_py char); 925 | Py.none); 926 | "to_string", Py.Callable.of_function_as_tuple (fun tuple -> 927 | let capsule = Py.Tuple.get tuple 0 in 928 | Py.String.of_string (Bytes.to_string 929 | (snd Ocaml_in_python_api.bytes_capsule capsule)));] 930 | 931 | let value_converter_of_tuple ocaml_env expansions (types : Type.t list) : Ocaml_in_python_api.value_converter = 932 | let arg_converters = List.map (Type.to_value_converter ocaml_env expansions) types in 933 | let capsule_index = find_tuple_capsule ocaml_env expansions types in 934 | let type_indexes = List.map Ocaml_in_python_api.Type.to_index types in 935 | let capsule = capsule_ident capsule_index in 936 | let types = 937 | Metapp.Exp.list (type_indexes |> List.map (fun type_index -> 938 | [%expr Ocaml_in_python_api.Type.of_index 939 | [%e Metapp.Exp.of_int type_index]])) in 940 | let ocaml_of_python : Ocaml_in_python_api.Function.t = 941 | Explicit (fun v -> [%expr 942 | if Py.Object.is_instance [%e v] (Py.Object.find_attr_string 943 | (Ocaml_in_python_api.get_root_python_module ()) "tuple") then 944 | begin 945 | let capsule = Py.Object.find_attr_string [%e v] "_capsule" in 946 | let capsule = 947 | if capsule = Py.none then 948 | let api = 949 | try 950 | Ocaml_in_python_api.TypeList.Hashtbl.find 951 | Ocaml_in_python_api.tuple_api [%e types] 952 | with Not_found -> 953 | failwith "tuple_api" in 954 | Py.Callable.to_function_as_tuple 955 | (Py.Object.find_attr_string [%e v] "_set_api") 956 | [%e make_python_tuple [v; [%expr api]]] 957 | else 958 | capsule in 959 | snd [%e Metapp.Exp.ident capsule] capsule 960 | end 961 | else 962 | [%e Ppxlib.Ast_helper.Exp.tuple (arg_converters |> List.mapi 963 | (fun i (converter : Ocaml_in_python_api.value_converter) -> Ocaml_in_python_api.Function.apply converter.ocaml_of_python 964 | [%expr Py.Sequence.get [%e v] [%e Metapp.Exp.of_int i]]))]]) in 965 | let python_of_ocaml : Ocaml_in_python_api.Function.t = 966 | Explicit (fun v -> [%expr 967 | let capsule = fst [%e Metapp.Exp.ident capsule] [%e v] in 968 | let api = 969 | try 970 | Ocaml_in_python_api.TypeList.Hashtbl.find 971 | Ocaml_in_python_api.tuple_api [%e types] 972 | with Not_found -> 973 | failwith "tuple_api" in 974 | Py.Callable.to_function_as_tuple_and_dict 975 | (Py.Object.find_attr_string 976 | (Ocaml_in_python_api.get_root_python_module ()) "tuple") 977 | Py.Tuple.empty 978 | (Py.Dict.of_bindings_string ["__capsule", capsule; "api", api])]) in 979 | { ocaml_of_python; python_of_ocaml } 980 | 981 | type collection_api = { 982 | classname : string; 983 | api_classname : string; 984 | capsules_table : Ocaml_in_python_api.variable_index Type.Hashtbl.t; 985 | capsules_table_name : string; 986 | api_table : Py.Object.t Type.Hashtbl.t; 987 | api_table_name : string; 988 | setitem : bool; 989 | } 990 | 991 | let list_api = { 992 | classname = "ocaml.list"; 993 | api_classname = "__list_api"; 994 | capsules_table = Ocaml_in_python_api.list_capsules; 995 | capsules_table_name = "list_capsules"; 996 | api_table = Ocaml_in_python_api.list_api; 997 | api_table_name = "list_api"; 998 | setitem = false; 999 | } 1000 | 1001 | let array_api = { 1002 | classname = "ocaml.array"; 1003 | api_classname = "__array_api"; 1004 | capsules_table = Ocaml_in_python_api.array_capsules; 1005 | capsules_table_name = "array_capsules"; 1006 | api_table = Ocaml_in_python_api.array_api; 1007 | api_table_name = "array_api"; 1008 | setitem = true; 1009 | } 1010 | 1011 | let find_collection_capsule collection_api ocaml_env expansions (ty : Type.t) : 1012 | Ocaml_in_python_api.variable_index = 1013 | try 1014 | Type.Hashtbl.find collection_api.capsules_table ty 1015 | with Not_found -> 1016 | let core_type = Type.to_core_type ty in 1017 | let converter = Type.to_value_converter ocaml_env expansions ty in 1018 | let type_index = Ocaml_in_python_api.Type.to_index ty in 1019 | let capsule_index = fresh_capsule_index () in 1020 | let capsule_name = local_capsule_name capsule_index.local_index in 1021 | let capsule = Metapp.Exp.var capsule_name in 1022 | push_capsule_declaration capsule_name [%expr 1023 | Format.asprintf [%e Metapp.Exp.of_string ( 1024 | Printf.sprintf "%s[%%a]" collection_api.classname)] 1025 | Ocaml_in_python_api.Type.format 1026 | (Ocaml_in_python_api.Type.of_index 1027 | [%e Metapp.Exp.of_int type_index])] [%type: [%t core_type] array]; 1028 | let structure = [%str 1029 | let () = 1030 | let api = 1031 | Py.Callable.to_function_as_tuple 1032 | (Py.Object.find_attr_string 1033 | (Ocaml_in_python_api.get_root_python_module ()) 1034 | [%e Metapp.Exp.of_string collection_api.api_classname]) 1035 | Py.Tuple.empty in 1036 | Py.Object.set_attr_string api "make" 1037 | (Py.Callable.of_function_as_tuple (fun tuple -> 1038 | let len = Py.Tuple.get tuple 1 in 1039 | let len = 1040 | if len = Py.none then 1041 | 1 1042 | else 1043 | Py.Int.to_int len in 1044 | let template_item = [%e 1045 | Ocaml_in_python_api.Function.apply converter.ocaml_of_python 1046 | [%expr Py.Tuple.get tuple 2]] in 1047 | fst [%e capsule] (Array.make len template_item))); 1048 | Py.Object.set_attr_string api "make_from_sequence" 1049 | (Py.Callable.of_function_as_tuple (fun tuple -> 1050 | let sequence = Py.Tuple.get tuple 0 in 1051 | fst [%e capsule] 1052 | (Py.Sequence.to_array_map [%e Ocaml_in_python_api.Function.to_expression 1053 | converter.ocaml_of_python] sequence))); 1054 | Py.Object.set_attr_string api "length" 1055 | (Py.Callable.of_function_as_tuple (fun tuple -> 1056 | let capsule = Py.Tuple.get tuple 0 in 1057 | assert (capsule != Py.null); 1058 | Py.Int.of_int (Array.length (snd [%e capsule] capsule)))); 1059 | Py.Object.set_attr_string api "getitem" 1060 | (Py.Callable.of_function_as_tuple (fun tuple -> 1061 | let array = snd [%e capsule] (Py.Tuple.get tuple 0) in 1062 | let index = Py.Int.to_int (Py.Tuple.get tuple 1) in 1063 | let value = 1064 | try array.(index) 1065 | with Invalid_argument _ -> 1066 | Ocaml_in_python_api.raise_index_out_of_bounds 1067 | ~index ~length:(Array.length array) in 1068 | [%e Ocaml_in_python_api.Function.apply converter.python_of_ocaml [%expr value]])); 1069 | [%e if collection_api.setitem then [%expr 1070 | Py.Object.set_attr_string api "setitem" 1071 | (Py.Callable.of_function_as_tuple (fun tuple -> 1072 | let array = snd [%e capsule] (Py.Tuple.get tuple 0) in 1073 | let index = Py.Int.to_int (Py.Tuple.get tuple 1) in 1074 | let value = 1075 | [%e Ocaml_in_python_api.Function.apply converter.ocaml_of_python [%expr 1076 | Py.Tuple.get tuple 2]] in 1077 | begin try 1078 | array.(index) <- value; 1079 | with Invalid_argument _ -> 1080 | Ocaml_in_python_api.raise_index_out_of_bounds 1081 | ~index ~length:(Array.length array) 1082 | end; 1083 | Py.none))] 1084 | else [%expr ()]]; 1085 | Ocaml_in_python_api.Type.Hashtbl.add 1086 | [%e Metapp.Exp.ident (Ldot (Lident "Ocaml_in_python_api", 1087 | collection_api.api_table_name))] 1088 | (Ocaml_in_python_api.Type.of_index [%e Metapp.Exp.of_int type_index]) 1089 | api] in 1090 | push_structure structure; 1091 | Type.Hashtbl.add collection_api.capsules_table ty capsule_index; 1092 | capsule_index 1093 | 1094 | let find_collection_api collection_api ocaml_env expansions (ty : Type.t) : Py.Object.t = 1095 | try 1096 | Type.Hashtbl.find collection_api.api_table ty 1097 | with Not_found -> 1098 | ignore (find_collection_capsule collection_api ocaml_env expansions ty); 1099 | try 1100 | Type.Hashtbl.find collection_api.api_table ty 1101 | with Not_found -> 1102 | failwith "find_collection_api" 1103 | 1104 | let value_converter_of_array ocaml_env expansions (arg : Type.t) : Ocaml_in_python_api.value_converter = 1105 | let arg_converter = Type.to_value_converter ocaml_env expansions arg in 1106 | let capsule_index = find_collection_capsule array_api ocaml_env expansions arg in 1107 | let type_index = Ocaml_in_python_api.Type.to_index arg in 1108 | let capsule = capsule_ident capsule_index in 1109 | let ocaml_of_python : Ocaml_in_python_api.Function.t = 1110 | Explicit (fun v -> [%expr 1111 | if Py.Object.is_instance [%e v] (Py.Object.find_attr_string 1112 | (Ocaml_in_python_api.get_root_python_module ()) "array") then 1113 | begin 1114 | let capsule = Py.Object.find_attr_string [%e v] "_capsule" in 1115 | let capsule = 1116 | if capsule = Py.none then 1117 | let api = 1118 | try 1119 | Ocaml_in_python_api.Type.Hashtbl.find 1120 | Ocaml_in_python_api.array_api 1121 | (Ocaml_in_python_api.Type.of_index 1122 | [%e Metapp.Exp.of_int type_index]) 1123 | with Not_found -> 1124 | failwith "value_converter_of_array" in 1125 | Py.Callable.to_function_as_tuple 1126 | (Py.Object.find_attr_string [%e v] "_set_api") 1127 | [%e make_python_tuple [v; [%expr api]]] 1128 | else 1129 | capsule in 1130 | snd [%e Metapp.Exp.ident capsule] capsule 1131 | end 1132 | else 1133 | Py.Sequence.to_array_map 1134 | [%e Ocaml_in_python_api.Function.to_expression arg_converter.ocaml_of_python] [%e v]]) in 1135 | let python_of_ocaml : Ocaml_in_python_api.Function.t = 1136 | Explicit (fun v -> [%expr 1137 | let array = [%e v] in 1138 | let capsule = fst [%e Metapp.Exp.ident capsule] array in 1139 | let api = 1140 | try 1141 | Ocaml_in_python_api.Type.Hashtbl.find 1142 | Ocaml_in_python_api.array_api 1143 | (Ocaml_in_python_api.Type.of_index 1144 | [%e Metapp.Exp.of_int type_index]) 1145 | with Not_found -> 1146 | failwith "value_converter_of_array" in 1147 | let result = Py.Callable.to_function_as_tuple_and_dict 1148 | (Py.Object.find_attr_string 1149 | (Ocaml_in_python_api.get_root_python_module ()) "array") 1150 | Py.Tuple.empty 1151 | (Py.Dict.of_bindings_string ["__capsule", capsule; "api", api]) in 1152 | Py.Object.set_attr_string result "__match_args__" 1153 | (Py.List.init (Array.length array) (fun i -> 1154 | Py.String.of_string (Format.sprintf "f%d" i))); 1155 | result ]) in 1156 | { ocaml_of_python; python_of_ocaml } 1157 | 1158 | let value_converter_of_list ocaml_env expansions (arg : Type.t) : Ocaml_in_python_api.value_converter = 1159 | let arg_converter = Type.to_value_converter ocaml_env expansions arg in 1160 | let capsule_index = find_collection_capsule list_api ocaml_env expansions arg in 1161 | let type_index = Ocaml_in_python_api.Type.to_index arg in 1162 | let capsule = capsule_ident capsule_index in 1163 | let ocaml_of_python : Ocaml_in_python_api.Function.t = 1164 | Implicit 1165 | [%expr Py.Sequence.to_list_map 1166 | [%e Ocaml_in_python_api.Function.to_expression arg_converter.ocaml_of_python]] in 1167 | let python_of_ocaml : Ocaml_in_python_api.Function.t = 1168 | Explicit (fun v -> [%expr 1169 | let array = Array.of_list [%e v] in 1170 | let capsule = fst [%e Metapp.Exp.ident capsule ] array in 1171 | let api = 1172 | try 1173 | Ocaml_in_python_api.Type.Hashtbl.find 1174 | Ocaml_in_python_api.list_api 1175 | (Ocaml_in_python_api.Type.of_index 1176 | [%e Metapp.Exp.of_int type_index]) 1177 | with Not_found -> 1178 | failwith "value_converter_of_list" in 1179 | let result = Py.Callable.to_function_as_tuple_and_dict 1180 | (Py.Object.find_attr_string 1181 | (Ocaml_in_python_api.get_root_python_module ()) "list") 1182 | Py.Tuple.empty 1183 | (Py.Dict.of_bindings_string ["__capsule", capsule; "api", api]) in 1184 | Py.Object.set_attr_string result "__match_args__" 1185 | (Py.List.init (Array.length array) (fun i -> 1186 | Py.String.of_string (Format.sprintf "f%d" i))); 1187 | result]) in 1188 | { ocaml_of_python; python_of_ocaml } 1189 | 1190 | let rec chop_other_type_declarations accu (list : Types.signature_item list) = 1191 | match list with 1192 | | Sig_type (ident, type_declaration, Trec_next, _visibility) :: tail -> 1193 | chop_other_type_declarations ((ident, type_declaration) :: accu) tail 1194 | | _ -> List.rev accu, list 1195 | 1196 | let class_count = ref 0 1197 | 1198 | module ConstructorArgs = struct 1199 | type 'a t = 1200 | | Tuple of 'a list 1201 | | Record of 'a LabelInfo.t list 1202 | 1203 | let of_constructor_arguments (args : Types.constructor_arguments) = 1204 | match args with 1205 | | Cstr_tuple list -> Tuple list 1206 | | Cstr_record labels -> 1207 | Record (List.map LabelInfo.of_declaration labels) 1208 | 1209 | let length args = 1210 | match args with 1211 | | Tuple list -> List.length list 1212 | | Record labels -> List.length labels 1213 | 1214 | let map f args = 1215 | match args with 1216 | | Tuple list -> Tuple (List.map f list) 1217 | | Record labels -> Record (List.map (LabelInfo.map f) labels) 1218 | 1219 | let to_list_mapi f args = 1220 | match args with 1221 | | Tuple list -> List.mapi f list 1222 | | Record labels -> List.mapi (fun i (info : _ LabelInfo.t) -> f i info.ty) labels 1223 | end 1224 | 1225 | module Constructor = struct 1226 | type ('ty, 'name) t = { 1227 | name : 'name; 1228 | class_var : Ocaml_in_python_api.variable_index; 1229 | args : 'ty ConstructorArgs.t; 1230 | result : 'ty option 1231 | } 1232 | 1233 | let map f cstr = { cstr with 1234 | args = ConstructorArgs.map f cstr.args; result = Option.map f cstr.result } 1235 | 1236 | let of_constructor_declaration (cstr : Types.constructor_declaration) = 1237 | { name = Ident.name cstr.cd_id; 1238 | class_var = fresh_variable_index class_count; 1239 | args = ConstructorArgs.of_constructor_arguments cstr.cd_args; 1240 | result = cstr.cd_res; 1241 | } 1242 | 1243 | let of_extension_constructor (name : Longident.t) (cstr : Types.extension_constructor) = 1244 | { name; 1245 | class_var = fresh_variable_index class_count; 1246 | args = ConstructorArgs.of_constructor_arguments cstr.ext_args; 1247 | result = cstr.ext_ret_type; 1248 | } 1249 | end 1250 | 1251 | type open_type_constructors = 1252 | (Type.t, Longident.t) Constructor.t option Ocaml_in_python_api.ExtensibleArray.t 1253 | 1254 | type 'a type_kind = 1255 | | Abstract 1256 | | Record of 'a LabelInfo.t list 1257 | | Variant of ('a, string) Constructor.t list 1258 | | Open of open_type_constructors 1259 | 1260 | type type_info = { 1261 | index : int; 1262 | name : string; 1263 | longident : Longident.t; 1264 | class_var : lident_or_variable_index; 1265 | mutable capsule_var : Ocaml_in_python_api.TypeList.t -> Ocaml_in_python_api.variable_index; 1266 | kind : Types.type_expr type_kind; 1267 | type_declaration : Types.type_declaration; 1268 | } 1269 | 1270 | type open_type = { 1271 | index : int; 1272 | name : string; 1273 | constructors : open_type_constructors; 1274 | class_var : lident_or_variable_index; 1275 | } 1276 | 1277 | let open_types_tbl : open_type Types.Uid.Tbl.t = Types.Uid.Tbl.create 16 1278 | 1279 | let type_count = ref 0 1280 | 1281 | let get_local_class_var class_index = 1282 | Format.asprintf "class%d" class_index 1283 | 1284 | let make_class parents fields classname = [%expr 1285 | Py.Class.init ~parents:[%e Metapp.Exp.list parents] 1286 | ~fields:[%e Metapp.Exp.list (fields |> 1287 | List.map (fun (field_name, value) -> 1288 | [%expr ([%e Metapp.Exp.of_string field_name], [%e value])]))] 1289 | [%e Metapp.Exp.of_string classname]] 1290 | 1291 | let get_module_name (ident : Longident.t) = 1292 | match ident with 1293 | | Ldot (module_name, _str) -> 1294 | Format.asprintf "%a" Pprintast.longident module_name 1295 | | _ -> 1296 | "" 1297 | 1298 | let push_constructor_class longident class_var_exp get_cstr_name i (cstr : _ Constructor.t) = 1299 | let cstr_name = get_cstr_name cstr.name in 1300 | let length = ConstructorArgs.length cstr.args in 1301 | let field_list = 1302 | match cstr.args with 1303 | | Tuple args -> 1304 | List.mapi (fun i _ -> Field.of_index i) args 1305 | | Record labels -> 1306 | List.mapi Field.of_label labels in 1307 | let field_names = 1308 | make_python_tuple (field_list |> List.map Field.to_field_name) in 1309 | let fields = 1310 | ("__module__", make_python_string ("ocaml." ^ get_module_name longident)) :: 1311 | ("_constructor_name", make_python_string cstr_name) :: 1312 | ("_constructor_index", make_python_int i) :: 1313 | ("_default_length", make_python_int length) :: 1314 | ("_field_names", 1315 | match cstr.args with 1316 | | Tuple _ -> [%expr Py.none] 1317 | | Record _ -> field_names) :: 1318 | ("__match_args__", field_names) :: 1319 | List.map Field.to_field field_list in 1320 | push_structure [%str 1321 | let [%p Metapp.Pat.var (get_local_class_var cstr.class_var.local_index)] = [%e 1322 | make_class [class_var_exp] fields cstr_name] 1323 | let () = 1324 | Py.Object.set_attr_string [%e class_var_exp] 1325 | [%e Metapp.Exp.of_string cstr_name] 1326 | [%e Metapp.Exp.var (get_local_class_var cstr.class_var.local_index)]] 1327 | 1328 | let variant_class = [%expr 1329 | Py.Module.get (Ocaml_in_python_api.get_root_python_module ()) 1330 | "variant"] 1331 | 1332 | let add_class_prototype (longident : Longident.t) 1333 | ((ident : Ident.t), (type_declaration : Types.type_declaration)) = 1334 | let index = count type_count in 1335 | let name = Ident.name ident in 1336 | let longident = Longident.Ldot (longident, name) in 1337 | let class_var = fresh_variable_index class_count in 1338 | let nb_params = List.length type_declaration.type_params in 1339 | let monomorphic = nb_params = 0 in 1340 | let capsule_var _ = failwith "Not yet available capsule_var" in 1341 | let kind = 1342 | match type_declaration.type_kind with 1343 | | Type_abstract -> 1344 | let abstract_class = [%expr 1345 | Py.Module.get (Ocaml_in_python_api.get_root_python_module ()) 1346 | "abstract"] in 1347 | push_structure [%str let [%p Metapp.Pat.var (get_local_class_var class_var.local_index)] = 1348 | [%e make_class [abstract_class] [] name]]; 1349 | Abstract 1350 | | Type_record (labels, _) -> 1351 | let labels = List.map LabelInfo.of_declaration labels in 1352 | let record_class = [%expr 1353 | Py.Module.get (Ocaml_in_python_api.get_root_python_module ()) 1354 | "record"] in 1355 | let field_list = List.mapi Field.of_label labels in 1356 | let field_names = 1357 | make_python_tuple (field_list |> List.map Field.to_field_name) in 1358 | let fields = 1359 | ("__module__", make_python_string ("ocaml." ^ get_module_name longident)) :: 1360 | ("_default_length", make_python_int (List.length labels)) :: 1361 | ("_api_for_type", [%expr Py.none]) :: 1362 | ("_field_names", field_names) :: 1363 | ("__match_args__", field_names) :: 1364 | List.map Field.to_field field_list in 1365 | let fields = 1366 | if monomorphic then 1367 | ("_default_type", [%expr Py.Tuple.empty ]) :: fields 1368 | else 1369 | fields in 1370 | push_structure 1371 | [%str let [%p Metapp.Pat.var (get_local_class_var class_var.local_index)] = 1372 | [%e make_class [record_class] fields name]]; 1373 | Record labels 1374 | | Type_variant (constructors, _) -> 1375 | let constructors = 1376 | List.map Constructor.of_constructor_declaration constructors in 1377 | let fields = 1378 | ("__module__", make_python_string ("ocaml." ^ get_module_name longident)) :: 1379 | (constructors |> 1380 | List.map (fun (cstr : _ Constructor.t) -> 1381 | cstr.name, [%expr Py.none])) in 1382 | push_structure [%str let [%p Metapp.Pat.var (get_local_class_var class_var.local_index)] = 1383 | [%e make_class [variant_class] fields name]]; 1384 | let class_var_exp = Metapp.Exp.var (get_local_class_var class_var.local_index) in 1385 | List.iteri (push_constructor_class longident class_var_exp Fun.id) constructors; 1386 | Variant constructors 1387 | | Type_open -> 1388 | push_structure [%str let [%p Metapp.Pat.var (get_local_class_var class_var.local_index)] = 1389 | [%e make_class [variant_class] [] name]]; 1390 | let constructors = 1391 | Ocaml_in_python_api.ExtensibleArray.create None 16 in 1392 | Types.Uid.Tbl.add open_types_tbl type_declaration.type_uid { 1393 | constructors; name; class_var = Right class_var; index }; 1394 | Open constructors in 1395 | { index; name; longident; class_var = Right class_var; capsule_var; kind; type_declaration } 1396 | 1397 | let get_local_capsule_var index = 1398 | Format.asprintf "capsule%d" index 1399 | 1400 | let converter_cache = Ocaml_in_python_api.IntHashtbl.create 16 1401 | 1402 | let converter_counter = ref 0 1403 | 1404 | let python_of_ocaml index = 1405 | Printf.sprintf "python_of_ocaml%d" index 1406 | 1407 | let ocaml_of_python index = 1408 | Printf.sprintf "ocaml_of_python%d" index 1409 | 1410 | let check_arity (type_info : type_info) params = 1411 | let nb_args = List.length params in 1412 | if nb_args <> type_info.type_declaration.type_arity then 1413 | raise (Py.Err (TypeError, 1414 | Format.asprintf "%a expect %d argument(s) but %d given" 1415 | Pprintast.longident type_info.longident 1416 | type_info.type_declaration.type_arity 1417 | nb_args)) 1418 | 1419 | let make_type_converter (type_info : type_info) ocaml_env expansions params : 1420 | Ocaml_in_python_api.value_converter = 1421 | let params_indexes = 1422 | List.map Ocaml_in_python_api.Type.to_index params in 1423 | let capsule_var = type_info.capsule_var params in 1424 | let capsule_var = 1425 | Metapp.Exp.ident (get_variable_ident get_local_capsule_var capsule_var) in 1426 | let table = 1427 | try 1428 | Ocaml_in_python_api.IntHashtbl.find converter_cache type_info.index 1429 | with Not_found -> 1430 | let table = Ocaml_in_python_api.TypeList.Hashtbl.create 16 in 1431 | Ocaml_in_python_api.IntHashtbl.add converter_cache type_info.index 1432 | table; 1433 | table in 1434 | let converter_index = 1435 | try 1436 | Ocaml_in_python_api.TypeList.Hashtbl.find table params 1437 | with Not_found -> 1438 | let index = fresh_variable_index converter_counter in 1439 | Ocaml_in_python_api.TypeList.Hashtbl.add table params index; 1440 | let class_var = get_variable get_local_class_var type_info.class_var in 1441 | push_structure [%str 1442 | let rec [%p Metapp.Pat.var (python_of_ocaml index.local_index)] = fun v -> 1443 | let make = 1444 | [%e match type_info.kind with 1445 | | Abstract -> [%expr fun capsule -> 1446 | Py.Callable.to_function_as_tuple_and_dict 1447 | [%e class_var] 1448 | Py.Tuple.empty (Py.Dict.singleton_string "__capsule" capsule)] 1449 | | Record _ -> [%expr 1450 | let type_def_info = 1451 | try 1452 | Ocaml_in_python_api.IntHashtbl.find 1453 | Ocaml_in_python_api.type_def_table 1454 | [%e Metapp.Exp.of_int type_info.index] 1455 | with Not_found -> 1456 | failwith "make_type_converter" in 1457 | let types = 1458 | List.map Ocaml_in_python_api.Type.of_index 1459 | [%e Metapp.Exp.list 1460 | (List.map Metapp.Exp.of_int params_indexes)] in 1461 | type_def_info.make_api types; 1462 | let api = 1463 | try 1464 | Ocaml_in_python_api.TypeList.Hashtbl.find 1465 | type_def_info.api_table types 1466 | with Not_found -> 1467 | failwith "make_type_converter" in 1468 | api.make] 1469 | | Variant _ -> [%expr 1470 | let type_def_info = 1471 | Ocaml_in_python_api.IntHashtbl.find 1472 | Ocaml_in_python_api.variant_table 1473 | [%e Metapp.Exp.of_int type_info.index] in 1474 | let types = 1475 | List.map Ocaml_in_python_api.Type.of_index 1476 | [%e Metapp.Exp.list 1477 | (List.map Metapp.Exp.of_int params_indexes)] in 1478 | type_def_info.make_api types; 1479 | let api = 1480 | try 1481 | Ocaml_in_python_api.TypeList.Hashtbl.find 1482 | type_def_info.api_table types 1483 | with Not_found -> 1484 | failwith "make_type_converter" in 1485 | api.make] 1486 | | Open _ -> [%expr 1487 | let type_def_info = 1488 | Ocaml_in_python_api.IntHashtbl.find 1489 | Ocaml_in_python_api.OpenType.table 1490 | [%e Metapp.Exp.of_int type_info.index] in 1491 | let types = 1492 | List.map Ocaml_in_python_api.Type.of_index 1493 | [%e Metapp.Exp.list 1494 | (List.map Metapp.Exp.of_int params_indexes)] in 1495 | type_def_info.make_api types; 1496 | let api = 1497 | try 1498 | Ocaml_in_python_api.TypeList.Hashtbl.find 1499 | type_def_info.api_table types 1500 | with Not_found -> 1501 | failwith "make_type_converter" in 1502 | api.make]] in 1503 | make (fst [%e capsule_var] v) 1504 | and [%p Metapp.Pat.var (ocaml_of_python index.local_index)] = fun v -> 1505 | if Py.Object.is_instance v 1506 | [%e class_var] then 1507 | let capsule = Py.Object.find_attr_string v "_capsule" in 1508 | let capsule = 1509 | if capsule = Py.none then 1510 | [%e match type_info.kind with 1511 | | Abstract -> [%expr failwith "Abstract type cannot be constructed"] 1512 | | Open _ -> [%expr 1513 | let type_def_info = 1514 | try 1515 | Ocaml_in_python_api.IntHashtbl.find 1516 | Ocaml_in_python_api.OpenType.table 1517 | [%e Metapp.Exp.of_int type_info.index] 1518 | with Not_found -> 1519 | failwith "make_type_converter" in 1520 | let types = 1521 | List.map Ocaml_in_python_api.Type.of_index 1522 | [%e Metapp.Exp.list 1523 | (List.map Metapp.Exp.of_int params_indexes)] in 1524 | type_def_info.make_api types; 1525 | let api_var = 1526 | try 1527 | Ocaml_in_python_api.TypeList.Hashtbl.find type_def_info.api_table 1528 | types 1529 | with Not_found -> 1530 | failwith "make_type_converter" in 1531 | Py.Callable.to_function_as_tuple 1532 | (Py.Object.find_attr_string v "_set_api") 1533 | (Py.Tuple.singleton 1534 | (api_var.api.(Py.Int.to_int (Py.Object.find_attr_string v "_constructor_index"))))] 1535 | | Record _ -> [%expr 1536 | let type_def_info = 1537 | try 1538 | Ocaml_in_python_api.IntHashtbl.find 1539 | Ocaml_in_python_api.type_def_table 1540 | [%e Metapp.Exp.of_int type_info.index] 1541 | with Not_found -> 1542 | failwith "make_type_converter" in 1543 | let types = 1544 | List.map Ocaml_in_python_api.Type.of_index 1545 | [%e Metapp.Exp.list 1546 | (List.map Metapp.Exp.of_int params_indexes)] in 1547 | let api_var = 1548 | try 1549 | Ocaml_in_python_api.TypeList.Hashtbl.find type_def_info.api_table 1550 | types 1551 | with Not_found -> 1552 | failwith "make_type_converter" in 1553 | Py.Callable.to_function_as_tuple 1554 | (Py.Object.find_attr_string v "_set_api") 1555 | (Py.Tuple.singleton api_var.api)] 1556 | | Variant _ -> [%expr 1557 | let type_def_info = 1558 | try 1559 | Ocaml_in_python_api.IntHashtbl.find 1560 | Ocaml_in_python_api.variant_table 1561 | [%e Metapp.Exp.of_int type_info.index] 1562 | with Not_found -> 1563 | failwith "make_type_converter" in 1564 | let types = 1565 | List.map Ocaml_in_python_api.Type.of_index 1566 | [%e Metapp.Exp.list 1567 | (List.map Metapp.Exp.of_int params_indexes)] in 1568 | type_def_info.make_api types; 1569 | let api_var = 1570 | try 1571 | Ocaml_in_python_api.TypeList.Hashtbl.find type_def_info.api_table 1572 | types 1573 | with Not_found -> 1574 | failwith "make_type_converter" in 1575 | Py.Callable.to_function_as_tuple 1576 | (Py.Object.find_attr_string v "_set_api") 1577 | (Py.Tuple.singleton 1578 | (api_var.api.(Py.Int.to_int (Py.Object.find_attr_string v "_constructor_index"))))]] 1579 | else 1580 | capsule in 1581 | snd [%e capsule_var] capsule 1582 | else [%e 1583 | let raise_error = [%expr 1584 | let given = 1585 | match Py.Object.get_attr_string v "_capsule" with 1586 | | Some capsule -> 1587 | if capsule = Py.none then 1588 | let c = Py.Object.find_attr_string v "__class__" in 1589 | Format.asprintf "%s.%s" 1590 | (Py.Object.to_string (Py.Object.find_attr_string c "__module__")) 1591 | (Py.Object.to_string (Py.Object.find_attr_string c "__name__")) 1592 | else 1593 | Py.Capsule.type_of capsule 1594 | | None -> Py.Type.name (Py.Type.get v) in 1595 | raise (Py.Err (TypeError, 1596 | Format.asprintf "%s expected but %s given" 1597 | [%e Metapp.Exp.of_string (Format.asprintf "%a" Ppxlib.Pprintast.core_type 1598 | (Ppxlib.Ast_helper.Typ.constr (Metapp.mkloc type_info.longident) 1599 | (List.map Ocaml_in_python_api.Type.to_core_type params)))] 1600 | given))] in 1601 | match type_info.kind with 1602 | | Record labels -> [%expr 1603 | if Py.Type.get v = Dict then [%e 1604 | let vars = Type.Vars.create () in 1605 | List.iter2 (Type.Vars.bind vars) 1606 | type_info.type_declaration.type_params params; 1607 | Metapp.Exp.record (labels |> List.map (fun (label : _ LabelInfo.t) -> 1608 | let ty = Type.of_type_expr vars ocaml_env expansions label.ty in 1609 | let converter = Type.to_value_converter ocaml_env expansions ty in 1610 | Longident.Lident label.name, 1611 | Ocaml_in_python_api.Function.apply converter.ocaml_of_python 1612 | [%expr Py.Dict.find_string v [%e Metapp.Exp.of_string label.name]]))] 1613 | else 1614 | [%e raise_error]] 1615 | | _ -> raise_error]]; 1616 | index in { 1617 | python_of_ocaml = Ocaml_in_python_api.Function.ImplicitDelayed (fun () -> 1618 | let python_of_ocaml = get_variable_ident python_of_ocaml converter_index in 1619 | Metapp.Exp.ident python_of_ocaml); 1620 | ocaml_of_python = Ocaml_in_python_api.Function.ImplicitDelayed (fun () -> 1621 | let ocaml_of_python = get_variable_ident ocaml_of_python converter_index in 1622 | Metapp.Exp.ident ocaml_of_python)} 1623 | 1624 | let add_type_converter (type_info : type_info) = 1625 | let class_ = get_variable_expression type_info.class_var in 1626 | Types.Uid.Tbl.add type_constr_converter_tbl 1627 | type_info.type_declaration.type_uid { 1628 | converter = make_type_converter type_info; 1629 | class_; 1630 | } 1631 | 1632 | let with_compile_env f = 1633 | let root = prepare_compilation_opt () in 1634 | f (); 1635 | catch_compiler_errors (fun () -> 1636 | Option.iter (fun _ -> perform_compilation ()) root) 1637 | 1638 | let constr_name longident params = 1639 | Format.asprintf "%a" Ppxlib.Pprintast.core_type (Ppxlib.Ast_helper.Typ.constr 1640 | (Metapp.mkloc longident) (List.map Type.to_core_type params)) 1641 | 1642 | let add_abstract_type_info _ocaml_env _expansions _python_module (type_info : type_info) = 1643 | let table = Ocaml_in_python_api.TypeList.Hashtbl.create 16 in 1644 | let type_of_params params = 1645 | Ppxlib.Ast_helper.Typ.constr 1646 | (Metapp.mkloc type_info.longident) 1647 | (List.map Ocaml_in_python_api.Type.to_core_type params) in 1648 | let capsule_var params = 1649 | try 1650 | Ocaml_in_python_api.TypeList.Hashtbl.find table params 1651 | with Not_found -> 1652 | let capsule_var = fresh_capsule_index () in 1653 | let ty = type_of_params params in 1654 | push_capsule_declaration (get_local_capsule_var capsule_var.local_index) 1655 | (Metapp.Exp.of_string (constr_name type_info.longident params)) ty; 1656 | Ocaml_in_python_api.TypeList.Hashtbl.add table params capsule_var; 1657 | capsule_var in 1658 | Ocaml_in_python_api.IntHashtbl.add Ocaml_in_python_api.type_def_table 1659 | type_info.index { 1660 | make_capsule = (fun params -> with_compile_env (fun () -> 1661 | ignore (capsule_var params))); 1662 | make_api = (fun _params -> ()); 1663 | api_table = Ocaml_in_python_api.TypeList.Hashtbl.create 16; }; 1664 | type_info.capsule_var <- capsule_var 1665 | 1666 | let check_public (type_info : type_info) f = 1667 | match type_info.type_declaration.type_private with 1668 | | Public -> f () 1669 | | Private -> 1670 | [%expr raise (Py.Err (RuntimeError, 1671 | (Printf.sprintf "Cannot create values of the private type %s" 1672 | [%e Metapp.Exp.of_string type_info.name])))] 1673 | 1674 | let add_record_type_info ocaml_env expansions _python_module (type_info : type_info) 1675 | labels = 1676 | let table = Ocaml_in_python_api.TypeList.Hashtbl.create 16 in 1677 | let type_of_params params = 1678 | Ppxlib.Ast_helper.Typ.constr 1679 | (Metapp.mkloc type_info.longident) 1680 | (List.map Ocaml_in_python_api.Type.to_core_type params) in 1681 | let capsule_var params = 1682 | check_arity type_info params; 1683 | try 1684 | Ocaml_in_python_api.TypeList.Hashtbl.find table params 1685 | with Not_found -> 1686 | let capsule_var = fresh_capsule_index () in 1687 | Ocaml_in_python_api.TypeList.Hashtbl.add table params capsule_var; 1688 | let ty = type_of_params params in 1689 | push_capsule_declaration (get_local_capsule_var capsule_var.local_index) 1690 | (Metapp.Exp.of_string (constr_name type_info.longident params)) ty; 1691 | capsule_var in 1692 | let api_table : Py.Object.t Ocaml_in_python_api.api Ocaml_in_python_api.TypeList.Hashtbl.t = 1693 | Ocaml_in_python_api.TypeList.Hashtbl.create 16 in 1694 | let make_api params = 1695 | try 1696 | ignore (Ocaml_in_python_api.TypeList.Hashtbl.find api_table params); 1697 | () 1698 | with Not_found -> 1699 | let _index = prepare_compilation_immediate () in 1700 | let capsule_var = 1701 | try 1702 | Ocaml_in_python_api.TypeList.Hashtbl.find table params 1703 | with Not_found -> 1704 | failwith "add_record_type_info" in 1705 | let class_index = count class_count in 1706 | let vars = Type.Vars.create () in 1707 | let add_var (var_name : Types.type_expr) arg = 1708 | Type.Vars.bind vars var_name arg in 1709 | List.iter2 add_var type_info.type_declaration.type_params params; 1710 | let api_var = Format.asprintf "api%d" class_index in 1711 | let labels = labels |> List.map 1712 | (fun (info : _ LabelInfo.t) -> 1713 | let ty = Type.of_type_expr vars ocaml_env expansions info.declaration.ld_type in 1714 | info, ty, Type.to_value_converter ocaml_env expansions ty) in 1715 | let access_field (info : _ LabelInfo.t) (converter : Ocaml_in_python_api.value_converter) = 1716 | Ocaml_in_python_api.Function.apply converter.python_of_ocaml 1717 | (Ppxlib.Ast_helper.Exp.field [%expr capsule] 1718 | (Metapp.mklid info.name)) in 1719 | let capsule_var' = 1720 | Metapp.Exp.ident (get_variable_ident get_local_capsule_var capsule_var) in 1721 | let make_record f = 1722 | check_public type_info (fun () -> f (fun get_item -> [%expr 1723 | fst [%e capsule_var'] 1724 | [%e Metapp.Exp.record (labels |> List.mapi (fun i 1725 | ((info : _ LabelInfo.t), _ty, (converter : Ocaml_in_python_api.value_converter)) -> 1726 | Longident.Lident info.name, 1727 | Ocaml_in_python_api.Function.apply converter.ocaml_of_python 1728 | (get_item i)))]])) in 1729 | push_structure [%str 1730 | let [%p Metapp.Pat.var api_var] = 1731 | Py.Class.init [%e Metapp.Exp.of_string type_info.name] 1732 | ~fields:[ 1733 | "make", 1734 | Py.Callable.of_function_as_tuple (fun tuple -> 1735 | [%e make_record (fun f -> [%expr 1736 | let template_item = Py.Tuple.get tuple 1 in 1737 | [%e f (fun _ -> [%expr template_item])]])]); 1738 | "make_from_sequence", 1739 | Py.Callable.of_function_as_tuple (fun tuple -> 1740 | [%e make_record (fun f -> [%expr 1741 | let sequence = Py.Tuple.get tuple 0 in 1742 | [%e f (fun i -> [%expr 1743 | Py.Tuple.get sequence [%e Metapp.Exp.of_int i]])]])]); 1744 | "length", Py.Callable.of_function_as_tuple (fun _tuple -> 1745 | [%e make_python_int (List.length labels)]); 1746 | "getitem", Py.Callable.of_function_as_tuple (fun tuple -> 1747 | let capsule = snd [%e capsule_var'] 1748 | (Py.Tuple.get tuple 0) in [%e 1749 | Ppxlib.Ast_helper.Exp.match_ 1750 | [%expr Py.Int.to_int (Py.Tuple.get tuple 1)] 1751 | ((labels |> List.mapi (fun i 1752 | ((info : _ LabelInfo.t), _ty, converter) -> 1753 | Ppxlib.Ast_helper.Exp.case (Metapp.Pat.of_int i) 1754 | (access_field info converter))) @ 1755 | [Ppxlib.Ast_helper.Exp.case [%pat? index] [%expr 1756 | Ocaml_in_python_api.raise_index_out_of_bounds ~index 1757 | ~length:[%e Metapp.Exp.of_int 1758 | (List.length labels)]]])]); 1759 | "setitem", Py.Callable.of_function_as_tuple (fun tuple -> [%e 1760 | Ppxlib.Ast_helper.Exp.match_ 1761 | [%expr Py.Int.to_int (Py.Tuple.get tuple 1)] 1762 | ((labels |> List.mapi (fun i 1763 | ((info : _ LabelInfo.t), _ty, (converter : Ocaml_in_python_api.value_converter)) -> 1764 | Ppxlib.Ast_helper.Exp.case (Metapp.Pat.of_int i) 1765 | (match info.declaration.ld_mutable with 1766 | | Immutable -> 1767 | [%expr raise (Py.Err (AttributeError, [%e 1768 | Metapp.Exp.of_string (Printf.sprintf 1769 | "The record field %s is not mutable" 1770 | info.name)]))] 1771 | | Mutable -> 1772 | [%expr 1773 | let capsule = snd [%e capsule_var'] 1774 | (Py.Tuple.get tuple 0) in [%e 1775 | Ppxlib.Ast_helper.Exp.setfield [%expr capsule] 1776 | (Metapp.mklid info.name) 1777 | (Ocaml_in_python_api.Function.apply converter.ocaml_of_python 1778 | [%expr Py.Tuple.get tuple 2])]; 1779 | Py.none]))) @ 1780 | [Ppxlib.Ast_helper.Exp.case [%pat? index] [%expr 1781 | Ocaml_in_python_api.raise_index_out_of_bounds ~index 1782 | ~length:[%e Metapp.Exp.of_int 1783 | (List.length labels)]]])])]]; 1784 | let params_indexes = 1785 | List.map Ocaml_in_python_api.Type.to_index params in 1786 | let class_var = get_variable get_local_class_var type_info.class_var in 1787 | push_structure [%str 1788 | let type_def_info = 1789 | try 1790 | Ocaml_in_python_api.IntHashtbl.find 1791 | Ocaml_in_python_api.type_def_table 1792 | [%e Metapp.Exp.of_int type_info.index] 1793 | with Not_found -> 1794 | failwith "add_record_type_info" in 1795 | let make capsule = 1796 | Py.Callable.to_function_as_tuple_and_dict 1797 | [%e class_var] Py.Tuple.empty 1798 | (Py.Dict.of_bindings_string [ 1799 | ("__capsule", capsule); 1800 | ("api", [%e Metapp.Exp.var api_var])]) in 1801 | Ocaml_in_python_api.TypeList.Hashtbl.add type_def_info.api_table 1802 | (List.map Ocaml_in_python_api.Type.of_index 1803 | [%e Metapp.Exp.list 1804 | (List.map Metapp.Exp.of_int params_indexes)]) 1805 | { api = [%e Metapp.Exp.var api_var]; make }]; 1806 | catch_compiler_errors (fun () -> perform_compilation ()) in 1807 | Ocaml_in_python_api.IntHashtbl.add Ocaml_in_python_api.type_def_table 1808 | type_info.index { 1809 | make_capsule = (fun params -> with_compile_env (fun () -> 1810 | ignore (capsule_var params))); 1811 | make_api; 1812 | api_table; }; 1813 | type_info.capsule_var <- capsule_var; 1814 | let class_var = get_variable get_local_class_var type_info.class_var in 1815 | push_structure [%str 1816 | let type_def_info = 1817 | try 1818 | Ocaml_in_python_api.IntHashtbl.find Ocaml_in_python_api.type_def_table 1819 | [%e Metapp.Exp.of_int type_info.index] 1820 | with Not_found -> 1821 | failwith "add_record_type_info" in 1822 | Py.Object.set_attr_string [%e class_var] "_api_for_type" 1823 | (Py.Callable.of_function_as_tuple 1824 | (Ocaml_in_python_api.api_for_type type_def_info))] 1825 | 1826 | let set_python_module ~target_top_module python_module key value = 1827 | let key_str = Metapp.Exp.of_string key in 1828 | push_structure [%str 1829 | Py.Module.set [%e python_module] [%e key_str] [%e value]; 1830 | [%e if target_top_module then [%expr 1831 | Py.Module.set (Ocaml_in_python_api.get_root_python_module ()) 1832 | [%e key_str] [%e value]] 1833 | else [%expr ()]]] 1834 | 1835 | let add_variant_type_info ~target_top_module ocaml_env expansions python_module (type_info : type_info) 1836 | (constructors : _ Constructor.t list) = 1837 | constructors |> List.iter (fun (info : _ Constructor.t) -> 1838 | set_python_module ~target_top_module python_module info.name 1839 | (Metapp.Exp.ident (get_variable_ident get_local_class_var info.class_var))); 1840 | let table = Ocaml_in_python_api.TypeList.Hashtbl.create 16 in 1841 | let type_of_params params = 1842 | Ppxlib.Ast_helper.Typ.constr 1843 | (Metapp.mkloc type_info.longident) 1844 | (List.map Ocaml_in_python_api.Type.to_core_type params) in 1845 | let capsule_var params = 1846 | check_arity type_info params; 1847 | try 1848 | Ocaml_in_python_api.TypeList.Hashtbl.find table params 1849 | with Not_found -> 1850 | let capsule_var = fresh_capsule_index () in 1851 | Ocaml_in_python_api.TypeList.Hashtbl.add table params capsule_var; 1852 | let ty = type_of_params params in 1853 | push_capsule_declaration (get_local_capsule_var capsule_var.local_index) 1854 | (Metapp.Exp.of_string (constr_name type_info.longident params)) ty; 1855 | capsule_var in 1856 | let api_table : Py.Object.t array Ocaml_in_python_api.api Ocaml_in_python_api.TypeList.Hashtbl.t = 1857 | Ocaml_in_python_api.TypeList.Hashtbl.create 16 in 1858 | let make_api params = 1859 | try 1860 | ignore (Ocaml_in_python_api.TypeList.Hashtbl.find api_table params); 1861 | () 1862 | with Not_found -> 1863 | with_compile_env (fun () -> 1864 | let capsule_var = 1865 | try 1866 | Ocaml_in_python_api.TypeList.Hashtbl.find table params 1867 | with Not_found -> 1868 | failwith "add_variant_type_info" in 1869 | let ty = type_of_params params in 1870 | let class_index = count class_count in 1871 | let vars = Type.Vars.create () in 1872 | let add_var (var_name : Types.type_expr) arg = 1873 | Type.Vars.bind vars var_name arg in 1874 | List.iter2 add_var type_info.type_declaration.type_params params; 1875 | let api_var = Format.asprintf "api%d" class_index in 1876 | let constructors = constructors |> 1877 | List.map (Constructor.map (fun ty -> 1878 | let ty = Type.of_type_expr vars ocaml_env expansions ty in 1879 | ty, Type.to_value_converter ocaml_env expansions ty)) in 1880 | let capsule_var = 1881 | Metapp.Exp.ident (get_variable_ident get_local_capsule_var capsule_var) in 1882 | push_structure [%str 1883 | let [%p Metapp.Pat.var api_var] = [%e 1884 | Ppxlib.Ast_helper.Exp.array (constructors |> List.map 1885 | (fun (cstr : _ Constructor.t) -> 1886 | match cstr.result with 1887 | | Some (Ocaml_in_python_api.Type.Constr (_, result_params), _) when not (List.equal Ocaml_in_python_api.Type.equal result_params params) -> [%expr Py.none] 1888 | | _ -> 1889 | let make f = 1890 | check_public type_info (fun () -> 1891 | f (fun f -> 1892 | let args = 1893 | match cstr.args with 1894 | | Tuple args -> 1895 | let make_arg i (ty, converter) = 1896 | f i None ty converter in 1897 | List.mapi make_arg args 1898 | | Record labels -> 1899 | let labels = 1900 | labels |> List.mapi (fun i (info : _ LabelInfo.t) : 1901 | (Longident.t * Ppxlib.expression) -> 1902 | let ty, converter = info.ty in 1903 | Lident info.name, 1904 | f i (Some info.name) ty converter) in 1905 | [Metapp.Exp.record labels] in 1906 | [%expr 1907 | fst [%e capsule_var] ([%e Metapp.Exp.construct 1908 | (Lident cstr.name) args] : [%t ty])])) in 1909 | let destruct_args = 1910 | match cstr.args with 1911 | | Tuple args -> 1912 | args |> List.mapi (fun i _ -> 1913 | Metapp.Pat.var (Printf.sprintf "f%d" i)) 1914 | | Record labels -> 1915 | [Metapp.Pat.record ( 1916 | labels |> List.mapi (fun i (info : _ LabelInfo.t) : 1917 | (Longident.t * Ppxlib.pattern) -> 1918 | Lident info.name, 1919 | Metapp.Pat.var (Printf.sprintf "f%d" i)))] in 1920 | let destruct_pat = 1921 | Metapp.Pat.construct (Lident cstr.name) destruct_args in 1922 | let destruct destruct_pat body = 1923 | match constructors with 1924 | | [_] -> [%expr 1925 | match capsule with [%p destruct_pat] -> [%e body]] 1926 | | _ -> [%expr 1927 | match capsule with 1928 | | [%p destruct_pat] -> [%e body] 1929 | | _ -> failwith "destruct"] in [%expr 1930 | Py.Class.init [%e Metapp.Exp.of_string 1931 | (Printf.sprintf "%s.%s" type_info.name cstr.name)] 1932 | ~fields:[ 1933 | "make", 1934 | Py.Callable.of_function_as_tuple (fun tuple -> 1935 | [%e 1936 | (make (fun f -> (fun e -> 1937 | if cstr.args = Tuple [] then 1938 | e 1939 | else 1940 | [%expr let template_item = Py.Tuple.get tuple 1 in [%e e]]) 1941 | (f (fun _i _label _ty (converter : Ocaml_in_python_api.value_converter) -> 1942 | Ocaml_in_python_api.Function.apply converter.ocaml_of_python 1943 | [%expr template_item]))))]); 1944 | "make_from_sequence", 1945 | Py.Callable.of_function_as_tuple (fun tuple -> 1946 | [%e (make (fun f -> (fun e -> 1947 | if cstr.args = Tuple [] then 1948 | e 1949 | else 1950 | [%expr let sequence = Py.Tuple.get tuple 0 in [%e e]]) 1951 | (f (fun i _label _ty (converter : Ocaml_in_python_api.value_converter) -> 1952 | Ocaml_in_python_api.Function.apply converter.ocaml_of_python 1953 | [%expr Py.Tuple.get sequence [%e Metapp.Exp.of_int i]]))))]); 1954 | "length", Py.Callable.of_function_as_tuple (fun _tuple -> 1955 | [%e make_python_int (ConstructorArgs.length cstr.args)]); 1956 | "getitem", Py.Callable.of_function_as_tuple (fun tuple -> 1957 | let capsule = snd [%e capsule_var] 1958 | (Py.Tuple.get tuple 0) in 1959 | [%e destruct destruct_pat ( 1960 | Ppxlib.Ast_helper.Exp.match_ 1961 | [%expr Py.Int.to_int (Py.Tuple.get tuple 1)] 1962 | ((cstr.args |> ConstructorArgs.to_list_mapi (fun i (_ty, (converter : Ocaml_in_python_api.value_converter)) -> 1963 | Ppxlib.Ast_helper.Exp.case (Metapp.Pat.of_int i) [%expr 1964 | [%e (Ocaml_in_python_api.Function.apply 1965 | converter.python_of_ocaml 1966 | (Metapp.Exp.var (Printf.sprintf "f%d" i)))]])) @ 1967 | [Ppxlib.Ast_helper.Exp.case [%pat? index] [%expr 1968 | Ocaml_in_python_api.raise_index_out_of_bounds ~index 1969 | ~length:[%e Metapp.Exp.of_int 1970 | (ConstructorArgs.length cstr.args)]]]))]); 1971 | "setitem", Py.Callable.of_function_as_tuple (fun tuple -> [%e 1972 | match cstr.args with 1973 | | Tuple _ -> [%expr 1974 | raise (Py.Err (AttributeError, [%e 1975 | Metapp.Exp.of_string (Printf.sprintf 1976 | "The arguments of constructor %s are not mutable" 1977 | cstr.name)]))] 1978 | | Record labels -> [%expr 1979 | let capsule = snd [%e capsule_var] 1980 | (Py.Tuple.get tuple 0) in 1981 | [%e destruct (Metapp.Pat.construct (Lident cstr.name) 1982 | [[%pat? r]]) ( 1983 | Ppxlib.Ast_helper.Exp.match_ 1984 | [%expr Py.Int.to_int (Py.Tuple.get tuple 1)] 1985 | ((labels |> List.mapi (fun i (info : _ LabelInfo.t) -> 1986 | let _, (converter : Ocaml_in_python_api.value_converter) = info.ty in 1987 | Ppxlib.Ast_helper.Exp.case (Metapp.Pat.of_int i) 1988 | (match info.declaration.ld_mutable with 1989 | | Immutable -> 1990 | [%expr raise (Py.Err (AttributeError, [%e 1991 | Metapp.Exp.of_string (Printf.sprintf 1992 | "The record field %s is not mutable" 1993 | info.name)]))] 1994 | | Mutable -> 1995 | [%expr [%e 1996 | Ppxlib.Ast_helper.Exp.setfield [%expr r] 1997 | (Metapp.mklid info.name) 1998 | (Ocaml_in_python_api.Function.apply converter.ocaml_of_python 1999 | [%expr Py.Tuple.get tuple 2])]; 2000 | Py.none]))) @ 2001 | [Ppxlib.Ast_helper.Exp.case [%pat? index] [%expr 2002 | Ocaml_in_python_api.raise_index_out_of_bounds ~index 2003 | ~length:[%e Metapp.Exp.of_int 2004 | (List.length labels)]]]))]]])]]))]]; 2005 | let params_indexes = 2006 | List.map Ocaml_in_python_api.Type.to_index params in 2007 | push_structure [%str 2008 | let type_def_info = 2009 | try 2010 | Ocaml_in_python_api.IntHashtbl.find 2011 | Ocaml_in_python_api.variant_table 2012 | [%e Metapp.Exp.of_int type_info.index] 2013 | with Not_found -> failwith "type_def_info: variant_table" in 2014 | let make capsule = [%e 2015 | Ppxlib.Ast_helper.Exp.match_ 2016 | [%expr snd [%e capsule_var] capsule] 2017 | (constructors |> List.mapi 2018 | (fun i (cstr : _ Constructor.t) -> 2019 | match cstr.result with 2020 | | Some (Ocaml_in_python_api.Type.Constr (_, result_params), _) when not (List.equal Ocaml_in_python_api.Type.equal result_params params) -> None 2021 | | _ -> Some ( 2022 | Ppxlib.Ast_helper.Exp.case 2023 | (Metapp.Pat.construct (Lident cstr.name) 2024 | (if cstr.args = Tuple [] then [] else [[%pat? _]])) 2025 | [%expr Py.Callable.to_function_as_tuple_and_dict 2026 | [%e Metapp.Exp.ident (get_variable_ident get_local_class_var cstr.class_var)] Py.Tuple.empty 2027 | (Py.Dict.of_bindings_string [ 2028 | ("__capsule", capsule); 2029 | ("api", [%e Metapp.Exp.var api_var]. 2030 | ([%e Metapp.Exp.of_int i]))])])) |> List.filter_map Fun.id)] in 2031 | let params = 2032 | List.map Ocaml_in_python_api.Type.of_index 2033 | [%e Metapp.Exp.list 2034 | (List.map Metapp.Exp.of_int params_indexes)] in 2035 | Ocaml_in_python_api.TypeList.Hashtbl.add type_def_info.api_table 2036 | params 2037 | { api = [%e Metapp.Exp.var api_var]; make }]) in 2038 | Ocaml_in_python_api.IntHashtbl.add Ocaml_in_python_api.variant_table 2039 | type_info.index { 2040 | make_capsule = (fun params -> with_compile_env (fun () -> 2041 | ignore (capsule_var params))); 2042 | make_api; 2043 | api_table }; 2044 | type_info.capsule_var <- capsule_var; 2045 | push_structure [%str 2046 | let type_def_info = 2047 | try 2048 | Ocaml_in_python_api.IntHashtbl.find Ocaml_in_python_api.variant_table 2049 | [%e Metapp.Exp.of_int type_info.index] 2050 | with Not_found -> failwith "type_def_info: variant_table2" in 2051 | [%e Metapp.sequence ( 2052 | constructors |> List.mapi (fun i (cstr : _ Constructor.t) -> [%expr 2053 | Py.Object.set_attr_string [%e Metapp.Exp.ident (get_variable_ident get_local_class_var cstr.class_var)] 2054 | "_api_for_type" 2055 | (Py.Callable.of_function_as_tuple (fun tuple -> 2056 | let api = Ocaml_in_python_api.api_for_type type_def_info tuple in 2057 | api.([%e Metapp.Exp.of_int i])))]))]] 2058 | 2059 | let add_open_type_info ocaml_env expansions _python_module (type_info : type_info) constructors = 2060 | let table = Ocaml_in_python_api.TypeList.Hashtbl.create 16 in 2061 | let type_of_params params = 2062 | Ppxlib.Ast_helper.Typ.constr 2063 | (Metapp.mkloc type_info.longident) 2064 | (List.map Ocaml_in_python_api.Type.to_core_type params) in 2065 | let capsule_var params = 2066 | check_arity type_info params; 2067 | try 2068 | Ocaml_in_python_api.TypeList.Hashtbl.find table params 2069 | with Not_found -> 2070 | let capsule_var = fresh_capsule_index () in 2071 | let ty = type_of_params params in 2072 | push_capsule_declaration (get_local_capsule_var capsule_var.local_index) 2073 | (Metapp.Exp.of_string (constr_name type_info.longident params)) ty; 2074 | Ocaml_in_python_api.TypeList.Hashtbl.add table params capsule_var; 2075 | capsule_var in 2076 | let api_table : Py.Object.t array Ocaml_in_python_api.api Ocaml_in_python_api.TypeList.Hashtbl.t = 2077 | Ocaml_in_python_api.TypeList.Hashtbl.create 16 in 2078 | let make_api params = 2079 | try 2080 | ignore (Ocaml_in_python_api.TypeList.Hashtbl.find api_table params); 2081 | () 2082 | with Not_found -> 2083 | let _index = prepare_compilation_immediate () in 2084 | let capsule_var = 2085 | try 2086 | Ocaml_in_python_api.TypeList.Hashtbl.find table params 2087 | with Not_found -> 2088 | failwith "add_open_type_info" in 2089 | let ty = type_of_params params in 2090 | let class_index = count class_count in 2091 | let vars = Type.Vars.create () in 2092 | let add_var (var_name : Types.type_expr) arg = 2093 | Type.Vars.bind vars var_name arg in 2094 | List.iter2 add_var type_info.type_declaration.type_params params; 2095 | let api_var = Format.asprintf "api%d" class_index in 2096 | let constructors = 2097 | constructors |> Ocaml_in_python_api.ExtensibleArray.to_list_map (fun cstr -> 2098 | cstr |> Option.get |> 2099 | Constructor.map (fun ty -> 2100 | ty, Type.to_value_converter ocaml_env expansions ty)) in 2101 | let capsule_var = 2102 | Metapp.Exp.ident (get_variable_ident get_local_capsule_var capsule_var) in 2103 | push_structure [%str 2104 | let [%p Metapp.Pat.var api_var] = [%e 2105 | Ppxlib.Ast_helper.Exp.array (constructors |> List.map (fun (cstr : _ Constructor.t) -> 2106 | match cstr.result with 2107 | | Some (Ocaml_in_python_api.Type.Constr (_, result_params), _) when not (List.equal Ocaml_in_python_api.Type.equal result_params params) -> [%expr Py.none] 2108 | | _ -> 2109 | let make f = 2110 | let args = 2111 | match cstr.args with 2112 | | Tuple args -> 2113 | let make_arg i (ty, converter) = 2114 | f i None ty converter in 2115 | List.mapi make_arg args 2116 | | Record labels -> 2117 | let labels = 2118 | labels |> List.mapi (fun i (info : _ LabelInfo.t) : 2119 | (Longident.t * Ppxlib.expression) -> 2120 | let ty, converter = info.ty in 2121 | Lident info.name, 2122 | f i (Some info.name) ty converter) in 2123 | [Metapp.Exp.record labels] in 2124 | [%expr 2125 | fst [%e capsule_var] ([%e Metapp.Exp.construct 2126 | cstr.name args] : [%t ty])] in 2127 | let destruct_args = 2128 | match cstr.args with 2129 | | Tuple args -> 2130 | args |> List.mapi (fun i _ -> 2131 | Metapp.Pat.var (Printf.sprintf "f%d" i)) 2132 | | Record labels -> 2133 | [Metapp.Pat.record ( 2134 | labels |> List.mapi (fun i (info : _ LabelInfo.t) : 2135 | (Longident.t * Ppxlib.pattern) -> 2136 | Lident info.name, 2137 | Metapp.Pat.var (Printf.sprintf "f%d" i)))] in 2138 | let destruct_pat = 2139 | Metapp.Pat.construct cstr.name destruct_args in [%expr 2140 | Py.Class.init [%e Metapp.Exp.of_string 2141 | (Format.asprintf "%s.%a" type_info.name Pprintast.longident cstr.name)] 2142 | ~fields:[ 2143 | "make", 2144 | Py.Callable.of_function_as_tuple (fun tuple -> 2145 | [%e (fun e -> 2146 | if cstr.args = Tuple [] then 2147 | e 2148 | else 2149 | [%expr let template_item = Py.Tuple.get tuple 1 in [%e e]]) 2150 | (make (fun _i _label _ty (converter : Ocaml_in_python_api.value_converter) -> 2151 | Ocaml_in_python_api.Function.apply converter.ocaml_of_python 2152 | [%expr template_item]))]); 2153 | "make_from_sequence", 2154 | Py.Callable.of_function_as_tuple (fun tuple -> 2155 | [%e (fun e -> 2156 | if cstr.args = Tuple [] then 2157 | e 2158 | else 2159 | [%expr let sequence = Py.Tuple.get tuple 0 in [%e e]]) 2160 | (make (fun i _label _ty (converter : Ocaml_in_python_api.value_converter) -> 2161 | Ocaml_in_python_api.Function.apply converter.ocaml_of_python 2162 | [%expr Py.Tuple.get sequence [%e Metapp.Exp.of_int i]]))]); 2163 | "length", Py.Callable.of_function_as_tuple (fun _tuple -> 2164 | [%e make_python_int (ConstructorArgs.length cstr.args)]); 2165 | "getitem", Py.Callable.of_function_as_tuple (fun tuple -> 2166 | let capsule = snd [%e capsule_var] 2167 | (Py.Tuple.get tuple 0) in 2168 | match capsule with 2169 | | [%p destruct_pat ] -> [%e 2170 | Ppxlib.Ast_helper.Exp.match_ 2171 | [%expr Py.Int.to_int (Py.Tuple.get tuple 1)] 2172 | ((cstr.args |> ConstructorArgs.to_list_mapi (fun i (_ty, (converter : Ocaml_in_python_api.value_converter)) -> 2173 | Ppxlib.Ast_helper.Exp.case (Metapp.Pat.of_int i) [%expr 2174 | [%e (Ocaml_in_python_api.Function.apply 2175 | converter.python_of_ocaml 2176 | (Metapp.Exp.var (Printf.sprintf "f%d" i)))]])) @ 2177 | [Ppxlib.Ast_helper.Exp.case [%pat? index] [%expr 2178 | Ocaml_in_python_api.raise_index_out_of_bounds ~index 2179 | ~length:[%e Metapp.Exp.of_int 2180 | (ConstructorArgs.length cstr.args)]]])] 2181 | | _ -> failwith "getitem"); 2182 | "setitem", Py.Callable.of_function_as_tuple (fun tuple -> [%e 2183 | match cstr.args with 2184 | | Tuple _ -> [%expr 2185 | raise (Py.Err (AttributeError, [%e 2186 | Metapp.Exp.of_string (Format.asprintf 2187 | "The arguments of constructor %a are not mutable" 2188 | Pprintast.longident cstr.name)]))] 2189 | | Record labels -> [%expr 2190 | let capsule = snd [%e capsule_var] 2191 | (Py.Tuple.get tuple 0) in 2192 | match capsule with 2193 | | [%p Metapp.Pat.construct cstr.name 2194 | [[%pat? r]]] -> [%e 2195 | Ppxlib.Ast_helper.Exp.match_ 2196 | [%expr Py.Int.to_int (Py.Tuple.get tuple 1)] 2197 | ((labels |> List.mapi (fun i (info : _ LabelInfo.t) -> 2198 | let _, (converter : Ocaml_in_python_api.value_converter) = info.ty in 2199 | Ppxlib.Ast_helper.Exp.case (Metapp.Pat.of_int i) 2200 | (match info.declaration.ld_mutable with 2201 | | Immutable -> 2202 | [%expr raise (Py.Err (AttributeError, [%e 2203 | Metapp.Exp.of_string (Printf.sprintf 2204 | "The record field %s is not mutable" 2205 | info.name)]))] 2206 | | Mutable -> 2207 | [%expr [%e 2208 | Ppxlib.Ast_helper.Exp.setfield [%expr r] 2209 | (Metapp.mklid info.name) 2210 | (Ocaml_in_python_api.Function.apply converter.ocaml_of_python 2211 | [%expr Py.Tuple.get tuple 2])]; 2212 | Py.none]))) @ 2213 | [Ppxlib.Ast_helper.Exp.case [%pat? index] [%expr 2214 | Ocaml_in_python_api.raise_index_out_of_bounds ~index 2215 | ~length:[%e Metapp.Exp.of_int 2216 | (List.length labels)]]])] 2217 | | _ -> failwith "setitem"]])]]))]]; 2218 | let params_indexes = 2219 | List.map Ocaml_in_python_api.Type.to_index params in 2220 | push_structure [%str 2221 | let type_def_info = 2222 | try 2223 | Ocaml_in_python_api.IntHashtbl.find 2224 | Ocaml_in_python_api.OpenType.table 2225 | [%e Metapp.Exp.of_int type_info.index] 2226 | with Not_found -> failwith "type_def_info" in 2227 | let make capsule = [%e 2228 | Ppxlib.Ast_helper.Exp.match_ 2229 | [%expr snd [%e capsule_var] capsule] 2230 | ((constructors |> List.mapi 2231 | (fun i (cstr : _ Constructor.t) -> 2232 | match cstr.result with 2233 | | Some (Ocaml_in_python_api.Type.Constr (_, result_params), _) when not (List.equal Ocaml_in_python_api.Type.equal result_params params) -> None 2234 | | _ -> Some ( 2235 | Ppxlib.Ast_helper.Exp.case 2236 | (Metapp.Pat.construct cstr.name 2237 | (if cstr.args = Tuple [] then [] else [[%pat? _]])) 2238 | [%expr Py.Callable.to_function_as_tuple_and_dict 2239 | [%e Metapp.Exp.ident (get_variable_ident get_local_class_var cstr.class_var)] Py.Tuple.empty 2240 | (Py.Dict.of_bindings_string [ 2241 | ("__capsule", capsule); 2242 | ("api", [%e Metapp.Exp.var api_var]. 2243 | ([%e Metapp.Exp.of_int i]))])])) |> List.filter_map Fun.id) @ 2244 | [Ppxlib.Ast_helper.Exp.case [%pat? obj] 2245 | [%expr failwith ("make " ^ 2246 | Obj.Extension_constructor.(name (of_val obj)))]])] in 2247 | let params = 2248 | List.map Ocaml_in_python_api.Type.of_index 2249 | [%e Metapp.Exp.list 2250 | (List.map Metapp.Exp.of_int params_indexes)] in 2251 | Ocaml_in_python_api.TypeList.Hashtbl.add type_def_info.api_table 2252 | params 2253 | { api = [%e Metapp.Exp.var api_var]; make }]; 2254 | catch_compiler_errors (fun () -> perform_compilation ()) in 2255 | Ocaml_in_python_api.IntHashtbl.add Ocaml_in_python_api.OpenType.table 2256 | type_info.index { 2257 | make_capsule = (fun params -> with_compile_env (fun () -> 2258 | ignore (capsule_var params))); 2259 | make_api; 2260 | api_table }; 2261 | type_info.capsule_var <- capsule_var 2262 | 2263 | let add_type_info ?(target_top_module=false) ocaml_env expansions python_module (type_info : type_info) = 2264 | let class_var = get_variable get_local_class_var type_info.class_var in 2265 | set_python_module ~target_top_module python_module type_info.name class_var; 2266 | match type_info.kind with 2267 | | Abstract -> 2268 | add_abstract_type_info ocaml_env expansions python_module type_info 2269 | | Record labels -> 2270 | add_record_type_info ocaml_env expansions python_module type_info labels 2271 | | Variant cstrs -> 2272 | add_variant_type_info ~target_top_module ocaml_env expansions python_module type_info cstrs 2273 | | Open cstrs -> 2274 | add_open_type_info ocaml_env expansions python_module type_info cstrs 2275 | 2276 | let table_count = ref 0 2277 | 2278 | let polymorphic_function_converter ~name ocaml_env expansions (vars : Type.Vars.t) ty ident : Ppxlib.expression = 2279 | let arity = Type.arity_of_type ty in 2280 | let concrete_type_names = 2281 | String.concat ", " (vars.names |> 2282 | Ocaml_in_python_api.ExtensibleArray.to_list_map (fun name -> 2283 | Option.value ~default:"_" name)) in 2284 | let type_names = 2285 | List.init vars.names.length (fun i -> Printf.sprintf "type%d" i) in 2286 | let pat_type_names = 2287 | type_names |> List.map (fun s -> Metapp.Pat.var s) in 2288 | let exp_type_names = 2289 | type_names |> List.map (fun s -> Metapp.Exp.var s) in 2290 | let type_none_tuple = 2291 | Metapp.Exp.tuple (type_names |> List.map (fun _ -> [%expr None])) in 2292 | let table = Ocaml_in_python_api.TypeList.Hashtbl.create 16 in 2293 | let index = Ocaml_in_python_api.PolymorphicFunction.push (fun index -> 2294 | let make types = 2295 | try 2296 | Ocaml_in_python_api.TypeList.Hashtbl.find table types 2297 | with Not_found -> 2298 | let types_array = Array.of_list types in 2299 | let subst_vars index = 2300 | types_array.(index) in 2301 | let arity = Type.map_arity (Type.subst subst_vars) arity in 2302 | let _compile_index = prepare_compilation_immediate () in 2303 | let ({ ocaml_exps; _ } : Ocaml_in_python_api.converters_of_arity) = 2304 | Type.converters_of_arity ocaml_env expansions arity in 2305 | let result_converter = Type.to_value_converter ocaml_env expansions arity.result in 2306 | push_structure [%str 2307 | let table = 2308 | (Ocaml_in_python_api.PolymorphicFunction.get 2309 | [%e Metapp.Exp.of_int index]).table in 2310 | let types = List.map Ocaml_in_python_api.Type.of_index 2311 | [%e Metapp.Exp.list (List.map (fun ty -> 2312 | Metapp.Exp.of_int (Ocaml_in_python_api.Type.to_index ty)) 2313 | types)] in 2314 | Ocaml_in_python_api.TypeList.Hashtbl.add table types 2315 | (fun ~args_tuple ~keywords_dict -> [%e 2316 | make_ocaml_function_call ocaml_env expansions arity result_converter 2317 | ident ocaml_exps])]; 2318 | catch_compiler_errors (fun () -> 2319 | perform_compilation ()); 2320 | try 2321 | Ocaml_in_python_api.TypeList.Hashtbl.find table types 2322 | with Not_found -> 2323 | failwith "polymorphic_function_converter" in 2324 | { make; table }) in 2325 | let vars_count = Type.Vars.count vars in 2326 | let vars_count_exp = Metapp.Exp.of_int vars_count in 2327 | [%expr 2328 | let make = 2329 | (Ocaml_in_python_api.PolymorphicFunction.get 2330 | [%e Metapp.Exp.of_int index]).make in 2331 | Py.Callable.of_function_as_tuple_and_dict 2332 | ~name:[%e Metapp.Exp.of_string name] (fun args_tuple keywords_dict -> 2333 | let [%p Metapp.Pat.tuple pat_type_names] = 2334 | match 2335 | if keywords_dict = Py.null then 2336 | None 2337 | else 2338 | Py.Dict.get_item_string keywords_dict "type" with 2339 | | None -> [%e type_none_tuple] 2340 | | Some type_ -> 2341 | begin match Py.Type.get type_ with 2342 | | Tuple -> 2343 | if Py.Tuple.size type_ <> [%e vars_count_exp] then 2344 | raise (Py.Err (RuntimeError, Printf.sprintf 2345 | "%d types given but %d expected: %s" 2346 | (Py.Tuple.size type_) [%e vars_count_exp] 2347 | [%e Metapp.Exp.of_string concrete_type_names])); 2348 | [%e Metapp.Exp.tuple (type_names |> List.mapi (fun i _ -> 2349 | [%expr Some (Py.Tuple.get type_ [%e Metapp.Exp.of_int i])]))] 2350 | | Dict -> 2351 | let add_key key value 2352 | [%p Metapp.Pat.tuple pat_type_names] = 2353 | [%e Ppxlib.Ast_helper.Exp.match_ 2354 | [%expr Py.String.to_string key] 2355 | ((List.filter_map Fun.id (List.init vars_count (fun i -> 2356 | match Type.Vars.get_name vars i with 2357 | | None -> None 2358 | | Some var -> Some ( 2359 | Ppxlib.Ast_helper.Exp.case 2360 | (Metapp.Pat.of_string var) 2361 | (Metapp.Exp.tuple (exp_type_names |> List.mapi 2362 | (fun j var -> 2363 | if i = j then 2364 | [%expr Some value] 2365 | else 2366 | var))))))) @ 2367 | [Ppxlib.Ast_helper.Exp.case [%pat? s] [%expr 2368 | raise (Py.Err (RuntimeError, Printf.sprintf 2369 | "Unknown type variable '%s' (variables are: %s)" s 2370 | [%e Metapp.Exp.of_string concrete_type_names]))]])] in 2371 | Py.Dict.fold add_key type_ [%e type_none_tuple] 2372 | | _ -> [%e 2373 | if vars_count = 1 then 2374 | [%expr Some type_] 2375 | else 2376 | [%expr 2377 | raise (Py.Err (RuntimeError, Printf.sprintf 2378 | "One type given but %d expected: %s" 2379 | [%e vars_count_exp] 2380 | [%e Metapp.Exp.of_string concrete_type_names]))]] 2381 | end in 2382 | let [%p Metapp.Pat.tuple pat_type_names] = 2383 | [%e Metapp.Exp.tuple (exp_type_names |> List.map (fun var -> [%expr 2384 | match [%e var] with 2385 | | None -> Ocaml_in_python_api.Type.Any 2386 | | Some ty -> Ocaml_in_python_api.Type.of_python ty]))] in 2387 | let f = make [%e Metapp.Exp.list exp_type_names] in 2388 | f ~args_tuple ~keywords_dict)] 2389 | 2390 | let python_module_count = ref 0 2391 | 2392 | (* 2393 | let postpone value = [%expr 2394 | Py.Callable.to_function_as_tuple (Py.Class.init "postponed" 2395 | ~fields:["computed", Py.Bool.f; "value", Py.none] 2396 | ~methods:["__get__", Py.Callable.of_function_as_tuple 2397 | (fun tuple -> 2398 | let self = Py.Tuple.get tuple 0 in 2399 | if Py.Bool.to_bool (Py.Object.find_attr_string self "computed") 2400 | then 2401 | Py.Object.find_attr_string self "value" 2402 | else 2403 | begin 2404 | let value = [%e value] in 2405 | Py.Object.set_attr_string self "value" value; 2406 | value 2407 | end)]) Py.Tuple.empty] 2408 | *) 2409 | 2410 | let postpone value = 2411 | make_property ~getter:[%expr Py.Callable.of_function_as_tuple (fun _ -> 2412 | [%e value])] () 2413 | 2414 | let add_type_declaration_expansion ?orig_path path expansions (ident, _) = 2415 | let name = Ident.name ident in 2416 | let prefixed_path = 2417 | match orig_path with 2418 | | None -> Path.Pident ident 2419 | | Some orig_path -> Path.Pdot (orig_path, name) in 2420 | Path.Map.add prefixed_path (Path.Pdot (path, name)) expansions 2421 | 2422 | let rec add_module_declaration_expansions orig_path path expansions 2423 | (moddecl : Types.module_declaration) = 2424 | match moddecl.md_type with 2425 | | Mty_ident _ -> expansions 2426 | | Mty_signature signature -> 2427 | List.fold_left (add_signature_item_expansions orig_path path) expansions 2428 | signature 2429 | | Mty_functor _ -> expansions 2430 | | Mty_alias _path -> expansions 2431 | 2432 | and add_signature_item_expansions orig_path path expansions 2433 | (item : Types.signature_item) = 2434 | match item with 2435 | | Sig_type (ident, type_declaration, _rec_status, _visibility) -> 2436 | add_type_declaration_expansion ~orig_path path expansions 2437 | (ident, type_declaration) 2438 | | Sig_module (ident, _presence, decl, _rec, _visibility) -> 2439 | let orig_path' = Path.Pdot (orig_path, Ident.name ident) in 2440 | let path' = Path.Pdot (path, Ident.name ident) in 2441 | add_module_declaration_expansions orig_path' path' expansions decl 2442 | | _ -> expansions 2443 | 2444 | let add_type_manifest ~target_top_module ocaml_env expansions python_module (ident, (decl : Types.type_declaration), (manifest : Types.type_expr)) = 2445 | match Metapp.Types.get_desc manifest with 2446 | | Tconstr (path, _args, _) -> 2447 | begin match type_info_of_constr ocaml_env expansions path with 2448 | | None -> () 2449 | | Some type_info -> 2450 | set_python_module ~target_top_module python_module (Ident.name ident) 2451 | (get_variable_as_expression get_local_class_var type_info.class_); 2452 | match decl.type_kind with 2453 | | Type_variant (constructors, _) -> 2454 | constructors |> List.iter (fun (cstr : Types.constructor_declaration) -> 2455 | let name = Ident.name cstr.cd_id in 2456 | let s = Metapp.Exp.of_string name in 2457 | set_python_module ~target_top_module python_module name 2458 | [%expr Py.Object.find_attr_string [%e get_variable_as_expression get_local_class_var type_info.class_] [%e s]]) 2459 | | _ -> () 2460 | end 2461 | | _ -> () 2462 | 2463 | let rec convert_signature_items ~target_top_module ocaml_env expansions longident path python_module 2464 | (list : Types.signature_item list) = 2465 | match list with 2466 | | [] -> () 2467 | | Sig_value (ident, value_description, _visibility) :: tail -> 2468 | let name = Ident.name ident in 2469 | let longident' = Longident.Ldot (longident, name) in 2470 | begin try 2471 | let vars = Type.Vars.create () in 2472 | let ty = Type.of_type_expr vars ocaml_env expansions value_description.val_type in 2473 | let ident = 2474 | Ppxlib.Ast_helper.Exp.ident (Metapp.mkloc longident') in 2475 | let expr = 2476 | if Type.Vars.count vars = 0 then 2477 | begin 2478 | let converter = 2479 | Type.to_value_converter ocaml_env expansions ~name ty in 2480 | let value = 2481 | Ocaml_in_python_api.Function.apply converter.python_of_ocaml 2482 | ident in 2483 | match ty with 2484 | | Arrow _ -> value 2485 | | _ -> postpone value 2486 | end 2487 | else 2488 | match ty with 2489 | | Arrow _ -> 2490 | polymorphic_function_converter ~name ocaml_env expansions vars ty ident 2491 | | _ -> 2492 | failwith "Polymorphic values are not supported" in 2493 | set_python_module ~target_top_module python_module name expr 2494 | with exc -> 2495 | if !debug then 2496 | let format_exc fmt exc = 2497 | match exc with 2498 | | Env.Error error -> Env.report_error fmt error 2499 | | _ -> Format.pp_print_string fmt (Printexc.to_string exc) in 2500 | Format.eprintf "Warning: %a not available: %a@." 2501 | Pprintast.longident longident' format_exc exc 2502 | end; 2503 | convert_signature_items ~target_top_module ocaml_env expansions longident path python_module tail 2504 | | Sig_type (ident, type_declaration, rec_status, _visibility) :: tail -> 2505 | let type_declarations = [ident, type_declaration] in 2506 | let type_declarations, tail = 2507 | match rec_status with 2508 | | Trec_not -> type_declarations, tail 2509 | | Trec_first -> 2510 | chop_other_type_declarations type_declarations tail 2511 | | Trec_next -> assert false in 2512 | let expansions' = 2513 | List.fold_left (add_type_declaration_expansion path) expansions 2514 | type_declarations in 2515 | let expansions = 2516 | match rec_status with 2517 | | Trec_first -> expansions' 2518 | | _ -> expansions in 2519 | begin 2520 | let name = Ident.name ident in 2521 | if name = "t" && longident = Ldot (Lident "Stdlib", "List") then 2522 | set_python_module ~target_top_module python_module "t" 2523 | [%expr Py.Object.find_attr_string 2524 | (Ocaml_in_python_api.get_root_python_module ()) "list"] 2525 | else if name = "t" && longident = Ldot (Lident "Stdlib", "Option") then 2526 | begin 2527 | set_python_module ~target_top_module python_module "t" 2528 | [%expr Py.Object.find_attr_string 2529 | (Ocaml_in_python_api.get_root_python_module ()) "option"]; 2530 | set_python_module ~target_top_module python_module "None" 2531 | [%expr Py.none]; 2532 | set_python_module ~target_top_module python_module "Some" 2533 | [%expr Py.Object.find_attr_string 2534 | (Ocaml_in_python_api.get_root_python_module ()) "Some"] 2535 | end 2536 | else 2537 | let type_declarations = 2538 | List.filter (fun (_ident, (declaration : Types.type_declaration)) -> 2539 | let () = 2540 | try 2541 | ignore (Ocaml_common.Env.find_type (Path.Pident ident) ocaml_env) 2542 | with Not_found -> prerr_endline "Not found!" in 2543 | not (Types.Uid.Tbl.mem type_constr_converter_tbl 2544 | declaration.type_uid)) 2545 | type_declarations in 2546 | let type_declarations, type_manifests = 2547 | List.partition_map (fun (ident, (decl : Types.type_declaration)) -> 2548 | match decl.type_manifest with 2549 | | None -> Left (ident, decl) 2550 | | Some manifest -> Right (ident, decl, manifest)) type_declarations in 2551 | let type_infos = 2552 | List.map (add_class_prototype longident) type_declarations in 2553 | List.iter add_type_converter type_infos; 2554 | List.iter (add_type_info ~target_top_module ocaml_env expansions python_module) type_infos; 2555 | List.iter (add_type_manifest ~target_top_module ocaml_env expansions python_module) type_manifests; 2556 | end; 2557 | convert_signature_items ~target_top_module ocaml_env expansions' longident path python_module tail 2558 | | Sig_typext (ident, ext, _status, _visibility) :: tail -> 2559 | let name = Ident.name ident in 2560 | let longident' : Longident.t = Ldot (longident, name) in 2561 | let cstr = Constructor.of_extension_constructor longident' ext in 2562 | let type_path = Type.expand_path expansions ext.ext_type_path in 2563 | let uid = uid_of_type_path ocaml_env type_path in 2564 | let open_type = Types.Uid.Tbl.find open_types_tbl uid in 2565 | let class_var = get_variable get_local_class_var open_type.class_var in 2566 | let vars = Type.Vars.create () in 2567 | let cstr = cstr |> Constructor.map (fun ty -> 2568 | Type.of_type_expr vars ocaml_env expansions ty) in 2569 | let index = Ocaml_in_python_api.ExtensibleArray.push open_type.constructors (Some cstr) in 2570 | push_constructor_class longident' class_var (fun (longident : Longident.t) -> Format.asprintf "%a" Pprintast.longident longident) index cstr; 2571 | set_python_module ~target_top_module python_module name 2572 | (Metapp.Exp.var (get_local_class_var cstr.class_var.local_index)); 2573 | push_structure [%str 2574 | let type_def_info = 2575 | Ocaml_in_python_api.IntHashtbl.find Ocaml_in_python_api.OpenType.table 2576 | [%e Metapp.Exp.of_int open_type.index] in 2577 | Ocaml_in_python_api.TypeList.Hashtbl.clear type_def_info.api_table; 2578 | Py.Object.set_attr_string [%e Metapp.Exp.ident (get_variable_ident get_local_class_var cstr.class_var)] 2579 | "_api_for_type" 2580 | (Py.Callable.of_function_as_tuple (fun tuple -> 2581 | let api = 2582 | Ocaml_in_python_api.api_for_type type_def_info tuple in 2583 | api.([%e Metapp.Exp.of_int index])))]; 2584 | convert_signature_items ~target_top_module ocaml_env expansions longident path python_module tail 2585 | | Sig_module (ident, _presence, decl, _rec, _visibility) :: tail -> 2586 | let name = Ident.name ident in 2587 | let longident' = Longident.Ldot (longident, name) in 2588 | let path' = Path.Pdot (path, name) in 2589 | (* We don't reflect the internal module Stdlib.Oo since it contains 2590 | internals that interact wierdly with code generation. *) 2591 | if longident' <> Ldot (Lident "Stdlib", "Oo") then 2592 | begin 2593 | let l = 2594 | lazy (match 2595 | (python_of_module_declaration ocaml_env expansions 2596 | longident' path' decl : Ocaml_in_python_api.Paths.index_cell 2597 | option) 2598 | with 2599 | | Some { index = _; class_ } -> class_ 2600 | | None -> Py.none) in 2601 | Ocaml_in_python_api.pending_module_table := 2602 | Path.Map.add path' l !Ocaml_in_python_api.pending_module_table; 2603 | let index = 2604 | Ocaml_in_python_api.ExtensibleArray.push 2605 | Ocaml_in_python_api.pending_modules l in 2606 | let value = 2607 | [%expr Lazy.force (Ocaml_in_python_api.ExtensibleArray.get 2608 | Ocaml_in_python_api.pending_modules [%e Metapp.Exp.of_int index])] in 2609 | let value = postpone value in 2610 | set_python_module ~target_top_module:false python_module name value 2611 | end; 2612 | let expansions' = 2613 | add_module_declaration_expansions (Path.Pident ident) path' expansions decl in 2614 | convert_signature_items ~target_top_module ocaml_env expansions' longident path python_module tail 2615 | | _ :: tail -> 2616 | convert_signature_items ~target_top_module ocaml_env expansions longident path python_module tail 2617 | 2618 | and convert_signature ~target_top_module ocaml_env expansions longident path path_index signature = 2619 | let python_module_index = count python_module_count in 2620 | let python_module_var = 2621 | Printf.sprintf "python_module%d" python_module_index in 2622 | push_preamble [%str 2623 | let { class_ = [%p Metapp.Pat.var python_module_var]; path = _ } : 2624 | Ocaml_in_python_api.Paths.path_cell = 2625 | Ocaml_in_python_api.Paths.get [%e Metapp.Exp.of_int path_index]]; 2626 | let python_module = Metapp.Exp.var python_module_var in 2627 | convert_signature_items ~target_top_module ocaml_env expansions longident path 2628 | python_module signature; 2629 | pop_preample (); 2630 | cut_compilation () 2631 | 2632 | and python_of_module_declaration ?(target_top_module = false) ocaml_env expansions longident path 2633 | (moddecl : Types.module_declaration) = 2634 | match Ocaml_in_python_api.Paths.find_opt path with 2635 | | Some _ as result -> result 2636 | | None -> 2637 | match moddecl.md_type with 2638 | | Mty_ident _ -> 2639 | None 2640 | | Mty_signature signature -> 2641 | let root = prepare_compilation_opt () in 2642 | let ocaml_env' = Ocaml_common.Env.add_signature signature ocaml_env in 2643 | let class_ = Py.Class.init (Path.name path) in 2644 | let instance_ = Py.Callable.to_function class_ [| |] in 2645 | let index = Ocaml_in_python_api.Paths.register path class_ in 2646 | convert_signature ~target_top_module ocaml_env' expansions longident path index 2647 | signature; 2648 | catch_compiler_errors (fun () -> 2649 | Option.iter (fun _ -> perform_compilation ()) root); 2650 | Some { index; class_ = instance_ } 2651 | | Mty_functor _ -> 2652 | None 2653 | | Mty_alias path -> 2654 | python_of_module_path ~target_top_module ocaml_env expansions longident path 2655 | 2656 | and python_of_module_path ?target_top_module ocaml_env expansions longident path = 2657 | let moddecl = Ocaml_common.Env.find_module path ocaml_env in 2658 | python_of_module_declaration ?target_top_module ocaml_env expansions longident path moddecl 2659 | 2660 | let python_of_module_name ?target_top_module ocaml_env expansions name = 2661 | if name = "Stdlib__Lexing" || name = "CamlinternalOO" then 2662 | None 2663 | else 2664 | let longident : Longident.t = Lident name in 2665 | let path, moddecl = 2666 | Ocaml_common.Env.lookup_module ~loc:!Ppxlib.Ast_helper.default_loc 2667 | longident ocaml_env in 2668 | python_of_module_declaration ?target_top_module ocaml_env expansions longident path moddecl 2669 | 2670 | let value_converter_of_bytes : Ocaml_in_python_api.value_converter = { 2671 | ocaml_of_python = Explicit (fun v -> [%expr 2672 | if Py.Object.is_instance [%e v] (Py.Object.find_attr_string 2673 | (Ocaml_in_python_api.get_root_python_module ()) "bytes") then 2674 | begin 2675 | let capsule = Py.Object.find_attr_string [%e v] "_capsule" in 2676 | snd Ocaml_in_python_api.bytes_capsule capsule 2677 | end 2678 | else 2679 | Bytes.of_string (Py.String.to_string [%e v])]); 2680 | python_of_ocaml = Explicit (fun v -> [%expr 2681 | let ocaml = Ocaml_in_python_api.get_root_python_module () in 2682 | let bytes_class = Py.Module.get ocaml "bytes" in 2683 | Py.Callable.to_function_as_tuple_and_dict bytes_class 2684 | Py.Tuple.empty (Py.Dict.of_bindings_string [ 2685 | "__capsule", fst Ocaml_in_python_api.bytes_capsule [%e v];])]); } 2686 | 2687 | let () = 2688 | import_ocaml_module_in_python_ref := (fun ?target_top_module ocaml_env (expansions : Path.t Path.Map.t) name -> 2689 | catch_compiler_errors (fun () -> 2690 | let ({ class_; index = _ } : Ocaml_in_python_api.Paths.index_cell) = 2691 | Option.get (python_of_module_name ?target_top_module ocaml_env expansions name) in 2692 | let ocaml = Ocaml_in_python_api.get_root_python_module () in 2693 | Py.Module.set ocaml name class_; 2694 | class_)) 2695 | 2696 | let initialize_python ocaml_env = 2697 | let ocaml = Ocaml_in_python_api.get_root_python_module () in 2698 | let register_primitive name f = 2699 | Py.Module.set ocaml name (Py.Callable.of_function_as_tuple (fun tuple -> 2700 | catch_compiler_errors (fun () -> f tuple))) in 2701 | let register_string_primitive name f = 2702 | register_primitive name (fun tuple -> 2703 | f (Py.String.to_string (Py.Tuple.get tuple 0)); 2704 | Py.none) in 2705 | register_string_primitive "require" require; 2706 | register_primitive "compile" (fun tuple -> 2707 | let code = Py.String.to_string (Py.Tuple.get tuple 0) in 2708 | let module_name = module_name (count Ocaml_in_python_api.capsule_count) in 2709 | let lexbuf = Lexing.from_string code in 2710 | let structure = Ppxlib.Parse.implementation lexbuf in 2711 | compile_and_load_structure ocaml_env module_name structure; 2712 | import_ocaml_module_in_python ocaml_env Path.Map.empty module_name); 2713 | register_string_primitive "add_dir" add_dir; 2714 | register_string_primitive "loadfile" Dynlink.loadfile; 2715 | register_primitive "debug" (fun _tuple -> 2716 | debug := true; 2717 | Py.none); 2718 | let list = Py.Module.get ocaml "list" in 2719 | Py.Object.set_attr_string list "_api_for_type" 2720 | (Py.Callable.of_function_as_tuple (fun tuple -> 2721 | find_collection_api list_api ocaml_env Path.Map.empty 2722 | (Type.of_python (Py.Tuple.get tuple 0)))); 2723 | let array = Py.Module.get ocaml "array" in 2724 | Py.Object.set_attr_string array "_api_for_type" 2725 | (Py.Callable.of_function_as_tuple (fun tuple -> 2726 | find_collection_api array_api ocaml_env Path.Map.empty 2727 | (Type.of_python (Py.Tuple.get tuple 0)))); 2728 | let tuple = Py.Module.get ocaml "tuple" in 2729 | Py.Object.set_attr_string tuple "_api_for_type" 2730 | (Py.Callable.of_function_as_tuple (fun tuple -> 2731 | find_tuple_api ocaml_env Path.Map.empty 2732 | (Py.Tuple.to_list_map Type.of_python (Py.Tuple.get tuple 0)))); 2733 | let bytes_class = Py.Module.get ocaml "bytes" in 2734 | let api_for_bytes = make_bytes_api ocaml_env Path.Map.empty in 2735 | Py.Object.set_attr_string bytes_class "_api_for_type" 2736 | (Py.Callable.of_function_as_tuple (fun _tuple -> api_for_bytes)); 2737 | let register_path path converter = 2738 | let uid = uid_of_type_path ocaml_env path in 2739 | Types.Uid.Tbl.add type_constr_converter_tbl uid converter in 2740 | let register_lident lident converter = 2741 | let uid = uid_of_type_lident ocaml_env lident in 2742 | Types.Uid.Tbl.add type_constr_converter_tbl uid converter in 2743 | register_path Predef.path_unit { 2744 | converter = 2745 | (fun _env _expansions _args -> { 2746 | python_of_ocaml = Explicit (fun v -> [%expr [%e v]; Py.none]); 2747 | ocaml_of_python = Explicit (fun v -> [%expr ignore [%e v]; ()]);}); 2748 | class_ = Left [%expr Py.Object.find_attr_string Py.none "__class__"]}; 2749 | register_path Predef.path_int { 2750 | converter = 2751 | (fun _env _expansions _args -> { 2752 | python_of_ocaml = Implicit [%expr Py.Int.of_int]; 2753 | ocaml_of_python = Implicit [%expr Py.Int.to_int] }); 2754 | class_ = Left [%expr Py.Object.find_attr_string (Ocaml_in_python_api.get_root_python_module ()) "int"]}; 2755 | register_path Predef.path_int64 { 2756 | converter = 2757 | (fun _env _expansions _args -> { 2758 | python_of_ocaml = Implicit [%expr Py.Int.of_int64]; 2759 | ocaml_of_python = Implicit [%expr Py.Int.to_int64] }); 2760 | class_ = Left [%expr Py.Object.find_attr_string (Ocaml_in_python_api.get_root_python_module ()) "int"]}; 2761 | register_path Predef.path_int32 { 2762 | converter = 2763 | (fun _env _expansions _args -> { 2764 | python_of_ocaml = Explicit (fun v -> [%expr 2765 | Py.Int.of_int64 (Int64.of_int32 [%e v])]); 2766 | ocaml_of_python = Explicit (fun v -> [%expr 2767 | Int64.to_int32 (Py.Int.to_int64 [%e v])]); }); 2768 | class_ = Left [%expr Py.Object.find_attr_string (Ocaml_in_python_api.get_root_python_module ()) "int"]}; 2769 | register_path Predef.path_nativeint { 2770 | converter = 2771 | (fun _env _expansions _args -> { 2772 | python_of_ocaml = Explicit (fun v -> [%expr 2773 | Py.Int.of_int64 (Int64.of_nativeint [%e v])]); 2774 | ocaml_of_python = Explicit (fun v -> [%expr 2775 | Int64.to_nativeint (Py.Int.to_int64 [%e v])]); }); 2776 | class_ = Left [%expr Py.Object.find_attr_string (Ocaml_in_python_api.get_root_python_module ()) "int"]}; 2777 | register_path Predef.path_char { 2778 | converter = 2779 | (fun _env _expansions _args -> { 2780 | python_of_ocaml = Implicit [%expr Ocaml_in_python_api.py_of_char]; 2781 | ocaml_of_python = Implicit [%expr Ocaml_in_python_api.char_of_py] }); 2782 | class_ = Left [%expr Py.Object.find_attr_string (Ocaml_in_python_api.get_root_python_module ()) "string"]}; 2783 | register_path Predef.path_string { 2784 | converter = (fun _env _expansions _args -> { 2785 | python_of_ocaml = Implicit [%expr Py.String.of_string]; 2786 | ocaml_of_python = Implicit [%expr Py.String.to_string] }); 2787 | class_ = Left [%expr Py.Object.find_attr_string (Ocaml_in_python_api.get_root_python_module ()) "string"]}; 2788 | register_path Predef.path_bool { 2789 | converter = (fun _env _expansions _args -> { 2790 | python_of_ocaml = Implicit [%expr Py.Bool.of_bool]; 2791 | ocaml_of_python = Implicit [%expr Py.Bool.to_bool] }); 2792 | class_ = Left [%expr Py.Object.find_attr_string (Ocaml_in_python_api.get_root_python_module ()) "bool"]}; 2793 | register_path Predef.path_float { 2794 | converter = (fun _env _expansions _args -> { 2795 | python_of_ocaml = Implicit [%expr Py.Float.of_float]; 2796 | ocaml_of_python = Implicit [%expr Py.Float.to_float] }); 2797 | class_ = Left [%expr Py.Object.find_attr_string (Ocaml_in_python_api.get_root_python_module ()) "float"]}; 2798 | register_path Predef.path_array { 2799 | converter = (fun ocaml_env expansions args -> 2800 | match args with 2801 | | [arg] -> value_converter_of_array ocaml_env expansions arg 2802 | | _ -> assert false); 2803 | class_ = Left [%expr Py.Object.find_attr_string (Ocaml_in_python_api.get_root_python_module ()) "array"]}; 2804 | register_path Predef.path_list { 2805 | converter = (fun ocaml_env expansions args -> 2806 | match args with 2807 | | [arg] -> value_converter_of_list ocaml_env expansions arg 2808 | | _ -> assert false); 2809 | class_ = Left [%expr Py.Object.find_attr_string (Ocaml_in_python_api.get_root_python_module ()) "list"]}; 2810 | register_path Predef.path_bytes { 2811 | converter = (fun _env _expansions _args -> value_converter_of_bytes); 2812 | class_ = Left [%expr Py.Object.find_attr_string (Ocaml_in_python_api.get_root_python_module ()) "bytes"]}; 2813 | register_path Predef.path_option { 2814 | converter = (fun ocaml_env expansions args -> 2815 | let arg = match args with [arg] -> arg | _ -> assert false in 2816 | let converter = Type.to_value_converter ocaml_env expansions arg in 2817 | if Type.has_none ocaml_env arg then { 2818 | python_of_ocaml = Explicit (fun v -> [%expr 2819 | match [%e v] with 2820 | | None -> Py.none 2821 | | Some v -> 2822 | let ocaml = Ocaml_in_python_api.get_root_python_module () in 2823 | let some = Py.Module.get ocaml "Some" in 2824 | Py.Callable.to_function_as_tuple some (Py.Tuple.singleton 2825 | ([%e Ocaml_in_python_api.Function.to_expression converter.python_of_ocaml] v))]); 2826 | ocaml_of_python = Explicit (fun v -> [%expr 2827 | let v = [%e v] in 2828 | if v = Py.none then 2829 | None 2830 | else 2831 | let ocaml = Ocaml_in_python_api.get_root_python_module () in 2832 | let some = Py.Module.get ocaml "Some" in 2833 | let destructed = 2834 | if Py.Object.is_instance v some then 2835 | Py.Sequence.get v 0 2836 | else 2837 | v in 2838 | Some ([%e 2839 | Ocaml_in_python_api.Function.to_expression 2840 | converter.ocaml_of_python] destructed)])} 2841 | else { 2842 | python_of_ocaml = Explicit (fun v -> [%expr 2843 | match [%e v] with 2844 | | None -> Py.none 2845 | | Some v -> [%e Ocaml_in_python_api.Function.to_expression converter.python_of_ocaml] v]); 2846 | ocaml_of_python = Explicit (fun v -> [%expr 2847 | let v = [%e v] in 2848 | if v = Py.none then 2849 | None 2850 | else 2851 | Some ([%e Ocaml_in_python_api.Function.to_expression converter.ocaml_of_python] v)])}); 2852 | class_ = Left [%expr Py.Object.find_attr_string Py.none "__class__"]}; 2853 | register_path Predef.path_extension_constructor { 2854 | converter = 2855 | (fun _env _expansions _args -> { 2856 | python_of_ocaml = Implicit [%expr Ocaml_in_python_api.Extension_constructor.to_python]; 2857 | ocaml_of_python = Implicit [%expr Ocaml_in_python_api.Extension_constructor.of_python] }); 2858 | class_ = Left [%expr Py.Object.find_attr_string Py.none "__class__"]}; 2859 | register_path Predef.path_floatarray { 2860 | converter = 2861 | (fun _env _expansions _args -> { 2862 | python_of_ocaml = Implicit [%expr Py.Array.numpy]; 2863 | ocaml_of_python = Implicit [%expr Ocaml_in_python_api.get_floatarray] }); 2864 | class_ = Left [%expr Py.Object.find_attr_string (Ocaml_in_python_api.get_root_python_module ()) "array"]}; 2865 | let index = count type_count in 2866 | let constructors = Ocaml_in_python_api.ExtensibleArray.create None 16 in 2867 | Ocaml_in_python_api.exception_class := Py.Object.find_attr_string ocaml "exn"; 2868 | let class_var : lident_or_variable_index = Left (Ldot (Lident "Ocaml_in_python_api", "exception_class")) in 2869 | let name = "exn" in 2870 | let type_info = { 2871 | index; 2872 | name; 2873 | longident = Lident name; 2874 | class_var; 2875 | capsule_var = (fun _ -> failwith "Not implemented"); 2876 | type_declaration = Env.find_type Predef.path_exn ocaml_env; 2877 | kind = Open constructors; 2878 | } in 2879 | Types.Uid.Tbl.add open_types_tbl type_info.type_declaration.type_uid { 2880 | constructors; name; class_var; index }; 2881 | let exn_converter = make_type_converter type_info in 2882 | exn_converter_ref := (fun ocaml_env expansions -> 2883 | (exn_converter ocaml_env expansions [])); 2884 | Types.Uid.Tbl.add type_constr_converter_tbl 2885 | type_info.type_declaration.type_uid { 2886 | converter = exn_converter; 2887 | class_ = Left [%expr Metapp.Exp.ident class_var]}; 2888 | ignore (prepare_compilation_immediate ()); 2889 | let python_module = [%expr Ocaml_in_python_api.get_root_python_module ()] in 2890 | add_type_info ocaml_env Path.Map.empty python_module type_info; 2891 | catch_compiler_errors (fun () -> 2892 | perform_compilation ()); 2893 | let wrap_channel of_descr to_descr mode _env _expansions _args 2894 | : Ocaml_in_python_api.value_converter = { 2895 | python_of_ocaml = Explicit (fun v -> [%expr 2896 | let fd = Ocaml_in_python_api.int_of_fd ([%e to_descr] [%e v]) in 2897 | Py.Module.get_function_with_keywords (Py.Module.builtins ()) "open" 2898 | [| Py.Int.of_int fd |] [ 2899 | "mode", [%e make_python_string mode]; 2900 | "buffering", Py.Bool.f;]]); 2901 | ocaml_of_python = Explicit (fun v -> [%expr 2902 | let fd = Py.Int.to_int (Py.Callable.to_function_as_tuple 2903 | (Py.Object.find_attr_string [%e v] "fileno") Py.Tuple.empty) in 2904 | [%e of_descr] (Ocaml_in_python_api.fd_of_int fd)])} in 2905 | register_lident (Lident "in_channel") { 2906 | converter = (wrap_channel [%expr Unix.in_channel_of_descr] 2907 | [%expr Unix.descr_of_in_channel] "rb"); 2908 | class_ = Left [%expr Py.Object.find_attr_string Py.none "__class__"]}; 2909 | register_lident (Lident "out_channel") { 2910 | converter = (wrap_channel [%expr Unix.out_channel_of_descr] 2911 | [%expr Unix.descr_of_out_channel] "ab"); 2912 | class_ = Left [%expr Py.Object.find_attr_string Py.none "__class__"]}; 2913 | Type.value_converter_of_tuple := value_converter_of_tuple; 2914 | let stdlib = 2915 | import_ocaml_module_in_python ~target_top_module:true ocaml_env 2916 | Path.Map.empty "Stdlib" in 2917 | register_primitive "__getattr__" (fun tuple -> 2918 | let name = Py.String.to_string (Py.Tuple.get tuple 0) in 2919 | try Py.Object.find_attr_string stdlib name 2920 | with Not_found | Py.E _ -> 2921 | import_ocaml_module_in_python ocaml_env Path.Map.empty name) 2922 | 2923 | let initialize_ocaml_env () = 2924 | ignore (Warnings.parse_options false "-3-58"); (* deprecated, no-cmx-file *) 2925 | Clflags.native_code := true; 2926 | Ocaml_common.Compmisc.init_path (); 2927 | Ocaml_common.Compmisc.initial_env () 2928 | 2929 | let initialize_findlib () = 2930 | Findlib.init (); 2931 | add_dir (Findlib.package_directory "stdcompat"); 2932 | add_dir (Findlib.package_directory "pyml"); 2933 | let local_api_dir = "../../api/.ocaml_in_python_api.objs/byte/" in 2934 | if Sys.file_exists local_api_dir then 2935 | add_dir local_api_dir 2936 | else 2937 | add_dir (catch_compiler_errors (fun () -> 2938 | Findlib.package_directory "ocaml-in-python.api")) 2939 | 2940 | let () = 2941 | Py.initialize (); 2942 | ignore (Py.Callable.handle_errors (fun () -> 2943 | if (Py.version_major (), Py.version_minor ()) < (3, 7) then 2944 | raise (Py.Err (ImportError, "Python >=3.7 is required")); 2945 | let ocaml_env = initialize_ocaml_env () in 2946 | root_ocaml_env := Some ocaml_env; 2947 | initialize_findlib (); 2948 | initialize_python ocaml_env; 2949 | Py.none) ()); 2950 | () 2951 | -------------------------------------------------------------------------------- /ocaml/pyproject.toml: -------------------------------------------------------------------------------- 1 | [build-system] 2 | requires = ["setuptools"] 3 | build-backend = "setuptools.build_meta" 4 | -------------------------------------------------------------------------------- /ocaml/setup.cfg: -------------------------------------------------------------------------------- 1 | [metadata] 2 | name = ocaml 3 | version = 0.1.0 4 | 5 | [options] 6 | packages = ocaml 7 | -------------------------------------------------------------------------------- /python3-command: -------------------------------------------------------------------------------- 1 | python3 2 | -------------------------------------------------------------------------------- /python3-command.in: -------------------------------------------------------------------------------- 1 | %{conf-python-3-7:python3}% -------------------------------------------------------------------------------- /tests/aliases/aliases.py: -------------------------------------------------------------------------------- 1 | import ocaml 2 | assert(ocaml.Result.get_ok(ocaml.Result.Ok(True)) == True) 3 | -------------------------------------------------------------------------------- /tests/aliases/dune: -------------------------------------------------------------------------------- 1 | (rule 2 | (alias runtest) 3 | (deps 4 | aliases.py 5 | ../../ocaml/ocaml_in_python.so 6 | ../../ocaml/__init__.py) 7 | (action 8 | (setenv PYTHONPATH %{workspace_root}:%{env:PYTHONPATH=} 9 | (run %{read-lines:../../python3-command} aliases.py)))) 10 | -------------------------------------------------------------------------------- /tests/dict/dict.ml: -------------------------------------------------------------------------------- 1 | type t = { 2 | mutable x : int; 3 | mutable y : int; 4 | } 5 | 6 | let of_pair (x, y) = { x; y } 7 | 8 | let to_pair {x; y} = (x, y) 9 | -------------------------------------------------------------------------------- /tests/dict/dict.py: -------------------------------------------------------------------------------- 1 | import ocaml 2 | ocaml.add_dir("../../api/.ocaml_in_python_api.objs/byte/") 3 | ocaml.add_dir(".dict.objs/byte/") 4 | ocaml.Dynlink.loadfile("dict.cmxs") 5 | from ocaml import Dict 6 | p = Dict.of_pair((1, 2)) 7 | assert p.x == 1 and p.y == 2 8 | p.x = 3 9 | assert tuple(Dict.to_pair(p)) == (3, 2) 10 | assert tuple(Dict.to_pair({ "x": 4, "y": 5 })) == (4, 5) 11 | -------------------------------------------------------------------------------- /tests/dict/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name dict)) 3 | 4 | (rule 5 | (alias runtest) 6 | (deps dict.py dict.cmxs 7 | ../../ocaml/ocaml_in_python.so 8 | ../../ocaml/__init__.py) 9 | (action 10 | (setenv PYTHONPATH %{workspace_root}:%{env:PYTHONPATH=} 11 | (run %{read-lines:../../python3-command} dict.py)))) 12 | -------------------------------------------------------------------------------- /tests/examples/dune: -------------------------------------------------------------------------------- 1 | ;(library 2 | ; (name examples) 3 | ; (libraries parmap pyml)) 4 | 5 | 6 | (rule 7 | (alias runtest) 8 | (deps 9 | examples.py 10 | ; examples.cmxs 11 | ../../ocaml/ocaml_in_python.so 12 | ../../ocaml/__init__.py) 13 | (action 14 | (setenv PYTHONPATH %{workspace_root}:%{env:PYTHONPATH=} 15 | (run %{read-lines:../../python3-command} examples.py)))) 16 | -------------------------------------------------------------------------------- /tests/examples/examples.ml: -------------------------------------------------------------------------------- 1 | (* 2 | let test f (l : Py.Object.t Parmap.sequence) = 3 | let l = Parmap.parmap f l in 4 | prerr_endline (Py.Object.to_string (Py.List.of_list l)) 5 | *) 6 | 7 | let test () = 8 | let m = Py.Import.exec_code_module_from_string ~name:"test" {| 9 | def f(x): 10 | return x + 1 11 | |} in 12 | let f = Py.Module.get_function m "f" in 13 | let l = Parmap.parmap (fun item -> f [| item |]) 14 | (A (Array.of_list (List.map Py.Int.of_int [1; 2; 3]))) in 15 | prerr_endline (Py.Object.to_string (Py.List.of_list l)); 16 | let m = Py.Import.exec_code_module_from_string ~name:"test" {| 17 | def f(x): 18 | return x + 1 19 | |} in 20 | let f = Py.Module.get_function m "f" in 21 | let l = Parmap.parmap (fun item -> f [| item |]) 22 | (A (Array.of_list (List.map Py.Int.of_int [1; 2; 3]))) in 23 | prerr_endline (Py.Object.to_string (Py.List.of_list l)) 24 | -------------------------------------------------------------------------------- /tests/examples/examples.py: -------------------------------------------------------------------------------- 1 | import ocaml 2 | #ocaml.add_dir("../../api/.ocaml_in_python_api.objs/byte/") 3 | #ocaml.add_dir(".examples.objs/byte/") 4 | #try: 5 | # ocaml.Dynlink.loadfile("examples.cmxs") 6 | #except ocaml.Dynlink.Error as e: 7 | # print(ocaml.Dynlink.error_message(e[0])) 8 | 9 | m = ocaml.compile(r''' 10 | let hello x = Printf.printf "Hello, %s!\n%!" x 11 | 12 | type 'a tree = Node of { label : 'a; children : 'a tree list } 13 | 14 | let rec height (Node { label = _; children }) = 15 | 1 + List.fold_left (fun accu tree -> max accu (height tree)) 0 children 16 | 17 | let rec of_list nodes = 18 | match nodes with 19 | | [] -> invalid_arg "of_list" 20 | | [last] -> Node { label = last; children = [] } 21 | | hd :: tl -> Node { label = hd; children = [of_list tl] } 22 | ''') 23 | 24 | m.hello("world") 25 | # => output: Hello, world! 26 | 27 | print(m.height( 28 | m.Node(label=1, children=[m.Node(label=2, children=[])]))) 29 | # => output: 2 30 | 31 | print(m.of_list(["a", "b", "c"])) 32 | # => output: Node {label=a;children=[Node {label=b;children=[Node {label=c;children=[]}]}]} 33 | 34 | try: 35 | print(m.of_list([])) 36 | except ocaml.Invalid_argument as e: 37 | print(e) 38 | # => output: Stdlib.Invalid_argument("of_list") 39 | 40 | ocaml.require("parmap") 41 | from ocaml import Parmap 42 | print(Parmap.parmap((lambda x : x + 1), Parmap.A([1, 2, 3]), ncores=2)) 43 | -------------------------------------------------------------------------------- /tests/exceptions/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name exceptions)) 3 | 4 | (rule 5 | (alias runtest) 6 | (deps exceptions.py exceptions.cmxs 7 | ../../ocaml/ocaml_in_python.so 8 | ../../ocaml/__init__.py) 9 | (action 10 | (setenv PYTHONPATH %{workspace_root}:%{env:PYTHONPATH=} 11 | (run %{read-lines:../../python3-command} exceptions.py)))) 12 | -------------------------------------------------------------------------------- /tests/exceptions/exceptions.ml: -------------------------------------------------------------------------------- 1 | exception E of int 2 | 3 | let catch f = 4 | try 5 | f (); 6 | assert false 7 | with E i -> i 8 | -------------------------------------------------------------------------------- /tests/exceptions/exceptions.py: -------------------------------------------------------------------------------- 1 | import ocaml 2 | ocaml.add_dir("../../api/.ocaml_in_python_api.objs/byte/") 3 | ocaml.add_dir(".exceptions.objs/byte/") 4 | ocaml.loadfile("exceptions.cmxs") 5 | try: 6 | ocaml.Stdlib.failwith("Test") 7 | assert(False) 8 | except ocaml.Stdlib.Failure as e: 9 | assert(e[0] == "Test") 10 | def f(): 11 | raise ocaml.Exceptions.E(1) 12 | assert(ocaml.Exceptions.catch(f) == 1) 13 | -------------------------------------------------------------------------------- /tests/extension_constructors/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name extension_constructors)) 3 | 4 | (rule 5 | (alias runtest) 6 | (deps extension_constructors.py extension_constructors_3_10.py 7 | extension_constructors.cmxs 8 | ../../ocaml/ocaml_in_python.so 9 | ../../ocaml/__init__.py) 10 | (action 11 | (setenv PYTHONPATH %{workspace_root}:%{env:PYTHONPATH=} 12 | (run %{read-lines:../../python3-command} extension_constructors.py)))) 13 | -------------------------------------------------------------------------------- /tests/extension_constructors/extension_constructors.ml: -------------------------------------------------------------------------------- 1 | type t = .. 2 | 3 | type t += A | B of int 4 | 5 | let a = A 6 | 7 | let b i = B i 8 | 9 | let get_b b = 10 | match b with 11 | | B i -> i 12 | | _ -> assert false 13 | -------------------------------------------------------------------------------- /tests/extension_constructors/extension_constructors.py: -------------------------------------------------------------------------------- 1 | import ocaml 2 | ocaml.add_dir("../../api/.ocaml_in_python_api.objs/byte/") 3 | ocaml.add_dir(".extension_constructors.objs/byte/") 4 | ocaml.loadfile("extension_constructors.cmxs") 5 | 6 | from ocaml import Extension_constructors 7 | 8 | assert(Extension_constructors.get_b(Extension_constructors.B(1)) == 1) 9 | 10 | import sys 11 | 12 | if sys.hexversion >= 0x03100000: 13 | import extension_constructors_3_10 14 | -------------------------------------------------------------------------------- /tests/extension_constructors/extension_constructors_3_10.py: -------------------------------------------------------------------------------- 1 | import ocaml 2 | ocaml.add_dir("../../api/.ocaml_in_python_api.objs/byte/") 3 | ocaml.add_dir(".extension_constructors.objs/byte/") 4 | ocaml.loadfile("extension_constructors.cmxs") 5 | 6 | from ocaml import Extension_constructors 7 | 8 | match Extension_constructors.a: 9 | case Extension_constructors.B(_): 10 | assert(False) 11 | case Extension_constructors.A(): 12 | pass 13 | case _: 14 | assert(False) 15 | 16 | match Extension_constructors.b(2): 17 | case Extension_constructors.B(1): 18 | assert(False) 19 | case Extension_constructors.B(2): 20 | pass 21 | case _: 22 | assert(False) 23 | -------------------------------------------------------------------------------- /tests/irregular/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name irregular)) 3 | 4 | (rule 5 | (alias runtest) 6 | (deps irregular.py irregular.cmxs 7 | ../../ocaml/ocaml_in_python.so 8 | ../../ocaml/__init__.py) 9 | (action 10 | (setenv PYTHONPATH %{workspace_root}:%{env:PYTHONPATH=} 11 | (run %{read-lines:../../python3-command} irregular.py)))) 12 | -------------------------------------------------------------------------------- /tests/irregular/irregular.ml: -------------------------------------------------------------------------------- 1 | module CompleteBinaryTree = struct 2 | type 'a t = 3 | | Leaf of 'a 4 | | Node of ('a * 'a) t 5 | 6 | let rec make : 'a . int -> 'a -> 'a t = fun depth value -> 7 | if depth > 0 then 8 | Node (make (depth - 1) (value, value)) 9 | else 10 | Leaf value 11 | 12 | let rec iter : 'a . ('a -> unit) -> 'a t -> unit = fun f tree -> 13 | match tree with 14 | | Leaf value -> f value 15 | | Node tree -> 16 | iter (fun (a, b) -> f a; f b) tree 17 | end 18 | -------------------------------------------------------------------------------- /tests/irregular/irregular.py: -------------------------------------------------------------------------------- 1 | import ocaml 2 | ocaml.add_dir("../../api/.ocaml_in_python_api.objs/byte/") 3 | ocaml.add_dir(".irregular.objs/byte/") 4 | ocaml.Dynlink.loadfile("irregular.cmxs") 5 | from ocaml import Irregular 6 | tree = Irregular.CompleteBinaryTree.make(3, "a") 7 | accu = [] 8 | Irregular.CompleteBinaryTree.iter((lambda x: accu.append(x)), tree) 9 | assert len(accu) == 8 10 | tree = Irregular.CompleteBinaryTree.Node(Irregular.CompleteBinaryTree.Node(Irregular.CompleteBinaryTree.Leaf(((1, 2), (3, 4))))) 11 | accu = [] 12 | Irregular.CompleteBinaryTree.iter((lambda x: accu.append(x)), tree) 13 | assert accu == [1, 2, 3, 4] 14 | -------------------------------------------------------------------------------- /tests/nested_modules/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name nested_modules)) 3 | 4 | (rule 5 | (alias runtest) 6 | (deps nested_modules.py nested_modules.cmxs 7 | ../../ocaml/ocaml_in_python.so 8 | ../../ocaml/__init__.py) 9 | (action 10 | (setenv PYTHONPATH %{workspace_root}:%{env:PYTHONPATH=} 11 | (run %{read-lines:../../python3-command} nested_modules.py)))) 12 | -------------------------------------------------------------------------------- /tests/nested_modules/nested_modules.ml: -------------------------------------------------------------------------------- 1 | module A = struct 2 | module B = struct 3 | type t = C 4 | end 5 | 6 | let c = B.C 7 | 8 | let f x = 9 | match x with 10 | | B.C -> () 11 | end 12 | -------------------------------------------------------------------------------- /tests/nested_modules/nested_modules.py: -------------------------------------------------------------------------------- 1 | import ocaml 2 | ocaml.add_dir("../../api/.ocaml_in_python_api.objs/byte/") 3 | ocaml.add_dir(".nested_modules.objs/byte/") 4 | ocaml.Dynlink.loadfile("nested_modules.cmxs") 5 | from ocaml import Nested_modules 6 | print(Nested_modules.A.c) 7 | Nested_modules.A.f(Nested_modules.A.c) 8 | -------------------------------------------------------------------------------- /tests/simple/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name simple)) 3 | 4 | (rule 5 | (alias runtest) 6 | (deps simple.py simple_3_10.py simple.cmxs 7 | ../../ocaml/ocaml_in_python.so 8 | ../../ocaml/__init__.py) 9 | (action 10 | (setenv PYTHONPATH %{workspace_root}:%{env:PYTHONPATH=} 11 | (run %{read-lines:../../python3-command} simple.py)))) 12 | -------------------------------------------------------------------------------- /tests/simple/simple.ml: -------------------------------------------------------------------------------- 1 | type t = A | B of int 2 | 3 | let a = A 4 | 5 | let b i = B i 6 | -------------------------------------------------------------------------------- /tests/simple/simple.py: -------------------------------------------------------------------------------- 1 | import ocaml 2 | ocaml.add_dir("../../api/.ocaml_in_python_api.objs/byte/") 3 | ocaml.add_dir(".simple.objs/byte/") 4 | ocaml.loadfile("simple.cmxs") 5 | from ocaml import Simple 6 | assert(not(isinstance(Simple.a, Simple.B))) 7 | assert(isinstance(Simple.a, Simple.A)) 8 | assert(not(isinstance(Simple.b(2), Simple.A))) 9 | assert(isinstance(Simple.b(2), Simple.B)) 10 | assert(Simple.b(2)[0] == 2) 11 | 12 | import sys 13 | 14 | if sys.hexversion >= 0x03100000: 15 | import simple_3_10 16 | -------------------------------------------------------------------------------- /tests/simple/simple_3_10.py: -------------------------------------------------------------------------------- 1 | import ocaml 2 | ocaml.add_dir("../../api/.ocaml_in_python_api.objs/byte/") 3 | ocaml.add_dir(".simple.objs/byte/") 4 | ocaml.loadfile("simple.cmxs") 5 | from ocaml import Simple 6 | match Simple.a: 7 | case Simple.B(1): 8 | assert(False) 9 | case Simple.A(): 10 | pass 11 | case _: 12 | assert(False) 13 | 14 | match Simple.b(2): 15 | case Simple.B(1): 16 | assert(False) 17 | case Simple.B(2): 18 | pass 19 | case _: 20 | assert(False) 21 | -------------------------------------------------------------------------------- /tests/stdlib/dune: -------------------------------------------------------------------------------- 1 | (rule 2 | (alias runtest) 3 | (deps stdlib.py 4 | ../../ocaml/ocaml_in_python.so 5 | ../../ocaml/__init__.py) 6 | (action 7 | (setenv PYTHONPATH %{workspace_root}:%{env:PYTHONPATH=} 8 | (run %{read-lines:../../python3-command} stdlib.py)))) 9 | -------------------------------------------------------------------------------- /tests/stdlib/stdlib.py: -------------------------------------------------------------------------------- 1 | import ocaml 2 | ocaml.add_dir("../../api/.ocaml_in_python_api.objs/byte/") 3 | ocaml.Stdlib.flush(ocaml.Stdlib.stdout) 4 | --------------------------------------------------------------------------------