├── .gitignore ├── .ocamlformat ├── CONTRIBUTING.md ├── LICENSE.md ├── Makefile ├── README.md ├── dune-project ├── ppx_python.opam ├── runtime ├── dune ├── ppx_python_runtime.ml └── ppx_python_runtime.mli ├── src ├── dune ├── ppx_python_conv.ml └── ppx_python_conv.mli └── test ├── dune ├── ppx_test.ml ├── ppx_test.mli ├── ppx_test_py_string.ml ├── ppx_test_py_string.mli └── test-ppx-py-string.t /.gitignore: -------------------------------------------------------------------------------- 1 | _build 2 | *.install 3 | *.merlin 4 | _opam 5 | 6 | -------------------------------------------------------------------------------- /.ocamlformat: -------------------------------------------------------------------------------- 1 | profile=janestreet 2 | -------------------------------------------------------------------------------- /CONTRIBUTING.md: -------------------------------------------------------------------------------- 1 | This repository contains open source software that is developed and 2 | maintained by [Jane Street][js]. 3 | 4 | Contributions to this project are welcome and should be submitted via 5 | GitHub pull requests. 6 | 7 | Signing contributions 8 | --------------------- 9 | 10 | We require that you sign your contributions. Your signature certifies 11 | that you wrote the patch or otherwise have the right to pass it on as 12 | an open-source patch. The rules are pretty simple: if you can certify 13 | the below (from [developercertificate.org][dco]): 14 | 15 | ``` 16 | Developer Certificate of Origin 17 | Version 1.1 18 | 19 | Copyright (C) 2004, 2006 The Linux Foundation and its contributors. 20 | 1 Letterman Drive 21 | Suite D4700 22 | San Francisco, CA, 94129 23 | 24 | Everyone is permitted to copy and distribute verbatim copies of this 25 | license document, but changing it is not allowed. 26 | 27 | 28 | Developer's Certificate of Origin 1.1 29 | 30 | By making a contribution to this project, I certify that: 31 | 32 | (a) The contribution was created in whole or in part by me and I 33 | have the right to submit it under the open source license 34 | indicated in the file; or 35 | 36 | (b) The contribution is based upon previous work that, to the best 37 | of my knowledge, is covered under an appropriate open source 38 | license and I have the right under that license to submit that 39 | work with modifications, whether created in whole or in part 40 | by me, under the same open source license (unless I am 41 | permitted to submit under a different license), as indicated 42 | in the file; or 43 | 44 | (c) The contribution was provided directly to me by some other 45 | person who certified (a), (b) or (c) and I have not modified 46 | it. 47 | 48 | (d) I understand and agree that this project and the contribution 49 | are public and that a record of the contribution (including all 50 | personal information I submit with it, including my sign-off) is 51 | maintained indefinitely and may be redistributed consistent with 52 | this project or the open source license(s) involved. 53 | ``` 54 | 55 | Then you just add a line to every git commit message: 56 | 57 | ``` 58 | Signed-off-by: Joe Smith 59 | ``` 60 | 61 | Use your real name (sorry, no pseudonyms or anonymous contributions.) 62 | 63 | If you set your `user.name` and `user.email` git configs, you can sign 64 | your commit automatically with git commit -s. 65 | 66 | [dco]: http://developercertificate.org/ 67 | [js]: https://opensource.janestreet.com/ 68 | -------------------------------------------------------------------------------- /LICENSE.md: -------------------------------------------------------------------------------- 1 | The MIT License 2 | 3 | Copyright (c) 2019--2024 Jane Street Group, LLC 4 | 5 | Permission is hereby granted, free of charge, to any person obtaining a copy 6 | of this software and associated documentation files (the "Software"), to deal 7 | in the Software without restriction, including without limitation the rights 8 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 9 | copies of the Software, and to permit persons to whom the Software is 10 | furnished to do so, subject to the following conditions: 11 | 12 | The above copyright notice and this permission notice shall be included in all 13 | copies or substantial portions of the Software. 14 | 15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 16 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 17 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 18 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 19 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 20 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 21 | SOFTWARE. 22 | -------------------------------------------------------------------------------- /Makefile: -------------------------------------------------------------------------------- 1 | INSTALL_ARGS := $(if $(PREFIX),--prefix $(PREFIX),) 2 | 3 | default: 4 | dune build 5 | 6 | install: 7 | dune install $(INSTALL_ARGS) 8 | 9 | uninstall: 10 | dune uninstall $(INSTALL_ARGS) 11 | 12 | reinstall: uninstall install 13 | 14 | clean: 15 | dune clean 16 | 17 | .PHONY: default install uninstall reinstall clean 18 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | ppx_python 2 | ========== 3 | 4 | Generate functions to convert OCaml values to/from Python values. 5 | 6 | `ppx_python` is a PPX syntax extension that generates code for 7 | converting OCaml types to and from Python. This uses 8 | the [pyml OCaml bindings for Python](https://github.com/thierry-martinez/pyml/) 9 | to start a Python runtime, create the Python objects or analyze 10 | them. 11 | 12 | Usage 13 | ----- 14 | 15 | Annotate the type with `[@@deriving python]` as in the following example. 16 | 17 | ```ocaml 18 | let () = 19 | if not (Pyml.Py.is_initialized ()) 20 | then Pyml.Py.initialize ~version:3 () 21 | ;; 22 | 23 | type int_pair = (int * int) [@@deriving python];; 24 | ``` 25 | 26 | This results in two functions being created automatically, `python_of_int_pair` and `int_pair_of_python` 27 | with the following types. 28 | 29 | ```ocaml 30 | val python_of_int_pair: int_pair -> pyobject 31 | val int_pair_of_python: pyobject -> int_pair 32 | ``` 33 | 34 | If only one direction is needed it is possible to write one of the following. 35 | 36 | ```ocaml 37 | type int_pair = (int * int) [@@deriving python_of] 38 | type int_pair = (int * int) [@@deriving of_python] 39 | ``` 40 | 41 | Python converters for primitive types such as `int`, `float`, `bool`, 42 | or `string` can be brought into scope by opening `Python_lib`. 43 | 44 | It is also possible to construct converters based on type expressions 45 | as in the following example. 46 | 47 | ```ocaml 48 | let pyobject = [%python_of: (int * string) list] [ 1, "one"; 2, "two" ];; 49 | 50 | Stdio.printf "pyobject: %s\n" (Pyml.Py.Object.to_string pyobject);; 51 | 52 | let list = [%of_python: (int * string) list] pyobject;; 53 | ``` 54 | 55 | Conversions 56 | ----------- 57 | 58 | The conversion is straightforward for basic types such as `int`, `float`, `bool`, or `string`. 59 | `unit` is converted to `None`. 60 | 61 | OCaml tuples are converted into Python tuples. OCaml lists and arrays are converted in Python lists. 62 | 63 | For options, `None` is used on the Python side to represent the `None` case. Otherwise the value is 64 | directly available. Note that this makes ocaml values `Some None` and `None` indistinguishable on the 65 | Python side. 66 | 67 | Records are represented using Python dictionaries which keys are strings. The `[@python.default]` 68 | attribute can be used on some of the fields: these fields are then optional on the Python side 69 | and if not present the default value gets used. 70 | 71 | ```ocaml 72 | type t = 73 | { foo : int [@python.default 42] 74 | ; bar : float 75 | } [@@deriving python] 76 | ``` 77 | 78 | Variants don't have an idiomatic Python representation. They get converted to a pair where the first 79 | element is the constructor as a string and the second element is the content of the variant or `None` 80 | if this variant case does not embed any data. 81 | 82 | Below are some more involved usage examples taken from the test suite. 83 | 84 | ```ocaml 85 | type t = 86 | { field_a : int 87 | ; field_b : string 88 | } 89 | [@@deriving python] 90 | 91 | type u = 92 | { foo : int * int 93 | ; bar : t 94 | } 95 | [@@deriving python] 96 | 97 | type v = 98 | | A 99 | | B of string 100 | | C of int 101 | | D of t * string 102 | | E of 103 | { x : int 104 | ; y : string 105 | } 106 | [@@deriving python] 107 | 108 | type 'a w = 109 | | One of 'a 110 | | Multi of 'a list 111 | [@@deriving python] 112 | 113 | type 'a tree = 114 | | Leaf of 'a 115 | | Node of 'a tree * 'a tree 116 | [@@deriving python] 117 | ``` 118 | -------------------------------------------------------------------------------- /dune-project: -------------------------------------------------------------------------------- 1 | (lang dune 3.11) 2 | -------------------------------------------------------------------------------- /ppx_python.opam: -------------------------------------------------------------------------------- 1 | opam-version: "2.0" 2 | maintainer: "Jane Street developers" 3 | authors: ["Jane Street Group, LLC"] 4 | homepage: "https://github.com/janestreet/ppx_python" 5 | bug-reports: "https://github.com/janestreet/ppx_python/issues" 6 | dev-repo: "git+https://github.com/janestreet/ppx_python.git" 7 | doc: "https://ocaml.janestreet.com/ocaml-core/latest/doc/ppx_python/index.html" 8 | license: "MIT" 9 | build: [ 10 | ["dune" "build" "-p" name "-j" jobs] 11 | ] 12 | depends: [ 13 | "ocaml" {>= "5.1.0"} 14 | "base" 15 | "ppx_base" 16 | "ppxlib_jane" 17 | "dune" {>= "3.11.0"} 18 | "ppxlib" {>= "0.33.0"} 19 | "pyml" {>= "20211015"} 20 | ] 21 | available: arch != "arm32" & arch != "x86_32" 22 | synopsis: "[@@deriving] plugin to generate Python conversion functions" 23 | description: " 24 | Part of the Jane Street's PPX rewriters collection. 25 | " 26 | -------------------------------------------------------------------------------- /runtime/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name ppx_python_runtime) 3 | (public_name ppx_python.runtime) 4 | (libraries base pyml) 5 | (preprocess 6 | (pps ppx_base))) 7 | -------------------------------------------------------------------------------- /runtime/ppx_python_runtime.ml: -------------------------------------------------------------------------------- 1 | open! Base 2 | 3 | let python_of_bool = Py.Bool.of_bool 4 | let bool_of_python = Py.Bool.to_bool 5 | let python_of_int = Py.Int.of_int 6 | let int_of_python = Py.Int.to_int 7 | let python_of_float = Py.Float.of_float 8 | let float_of_python = Py.Float.to_float 9 | let python_of_string = Py.String.of_string 10 | let string_of_python = Py.String.to_string 11 | let python_of_array = Py.List.of_array_map 12 | let array_of_python = Py.List.to_array_map 13 | let python_of_list = Py.List.of_list_map 14 | let list_of_python = Py.List.to_list_map 15 | 16 | let python_of_option f = function 17 | | None -> Py.none 18 | | Some v -> f v 19 | ;; 20 | 21 | let option_of_python f pyobject = 22 | if Stdlib.( = ) pyobject Py.none then None else Some (f pyobject) 23 | ;; 24 | 25 | let python_of_char char = Char.to_string char |> Py.String.of_string 26 | let char_of_python py_str = Py.String.to_string py_str |> Char.of_string 27 | 28 | module Dict_str_keys = struct 29 | type t = Pytypes.pyobject 30 | 31 | let internalized_keys = Hashtbl.create (module String) 32 | 33 | let internalized_key key = 34 | Hashtbl.findi_or_add internalized_keys key ~default:python_of_string 35 | ;; 36 | 37 | let set t key value = 38 | let key = internalized_key key in 39 | Py.Dict.set_item t key value 40 | ;; 41 | 42 | let find t key = 43 | let key = internalized_key key in 44 | Py.Dict.find t key 45 | ;; 46 | 47 | let create assoc = 48 | let t = Py.Dict.create () in 49 | List.iter assoc ~f:(fun (key, value) -> set t key value); 50 | t 51 | ;; 52 | 53 | let fail_on_extra_fields dict ~expected_field_names = 54 | let expected_field_names = Set.of_list (module String) expected_field_names in 55 | Py.Dict.to_bindings_string dict 56 | |> List.filter ~f:(fun (dict_field_name, _) -> 57 | not (Set.mem expected_field_names dict_field_name)) 58 | |> List.map ~f:(fun (field_name, _) -> "'" ^ field_name ^ "'") 59 | |> String.concat ~sep:"," 60 | |> Printf.sprintf "unexpected extra field names %s" 61 | |> failwith 62 | ;; 63 | end 64 | 65 | exception Not_found_s = Not_found_s 66 | -------------------------------------------------------------------------------- /runtime/ppx_python_runtime.mli: -------------------------------------------------------------------------------- 1 | open Pytypes 2 | 3 | val python_of_bool : bool -> pyobject 4 | val bool_of_python : pyobject -> bool 5 | val python_of_int : int -> pyobject 6 | val int_of_python : pyobject -> int 7 | val python_of_float : float -> pyobject 8 | val float_of_python : pyobject -> float 9 | val python_of_string : string -> pyobject 10 | val string_of_python : pyobject -> string 11 | val python_of_array : ('a -> pyobject) -> 'a array -> pyobject 12 | val array_of_python : (pyobject -> 'a) -> pyobject -> 'a array 13 | val python_of_list : ('a -> pyobject) -> 'a list -> pyobject 14 | val list_of_python : (pyobject -> 'a) -> pyobject -> 'a list 15 | val python_of_option : ('a -> pyobject) -> 'a option -> pyobject 16 | val option_of_python : (pyobject -> 'a) -> pyobject -> 'a option 17 | val python_of_char : char -> pyobject 18 | val char_of_python : pyobject -> char 19 | 20 | module Dict_str_keys : sig 21 | type t = pyobject 22 | 23 | val create : (string * pyobject) list -> t 24 | val set : t -> string -> pyobject -> unit 25 | val find : t -> string -> pyobject 26 | val fail_on_extra_fields : t -> expected_field_names:string list -> unit 27 | end 28 | 29 | exception Not_found_s of Base.Sexp.t 30 | -------------------------------------------------------------------------------- /src/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name ppx_python_conv) 3 | (public_name ppx_python) 4 | (kind ppx_deriver) 5 | (ppx_runtime_libraries ppx_python.runtime pyml) 6 | (libraries base ppxlib ppxlib_jane) 7 | (preprocess 8 | (pps ppxlib.metaquot))) 9 | -------------------------------------------------------------------------------- /src/ppx_python_conv.ml: -------------------------------------------------------------------------------- 1 | open Base 2 | open Ppxlib 3 | open Ast_builder.Default 4 | 5 | let default = 6 | Attribute.declare 7 | "python.default" 8 | Attribute.Context.label_declaration 9 | Ast_pattern.(pstr (pstr_eval __ nil ^:: nil)) 10 | (fun x -> x) 11 | ;; 12 | 13 | let option = 14 | Attribute.declare 15 | "python.option" 16 | Attribute.Context.label_declaration 17 | Ast_pattern.(pstr nil) 18 | (fun x -> x) 19 | ;; 20 | 21 | let disallow_extra_fields = 22 | Attribute.declare 23 | "python.disallow_extra_fields" 24 | Attribute.Context.type_declaration 25 | Ast_pattern.(pstr nil) 26 | () 27 | ;; 28 | 29 | let lident ~loc str = Loc.make ~loc (Lident str) 30 | 31 | let fresh_label = 32 | let counter = ref 0 in 33 | fun ~loc -> 34 | Int.incr counter; 35 | let label = Printf.sprintf "_lbl_%d" !counter in 36 | ppat_var (Loc.make ~loc label) ~loc, pexp_ident (lident ~loc label) ~loc 37 | ;; 38 | 39 | let raise_errorf ~loc fmt = Location.raise_errorf ~loc (Stdlib.( ^^ ) "ppx_python: " fmt) 40 | 41 | (* Generated function names. *) 42 | let python_of tname = "python_of_" ^ tname 43 | let of_python tname = tname ^ "_of_python" 44 | 45 | (* For parameterized types, use these function names as arguments. *) 46 | let python_of_arg tname = "__python_of_" ^ tname 47 | let of_python_arg tname = "__" ^ tname ^ "_of_python" 48 | 49 | let app_list ~loc (func : expression) (args : expression list) = 50 | [%expr [%e func] [%e elist ~loc args]] 51 | ;; 52 | 53 | let curry_app_list ~loc (func : expression) (args : expression list) = 54 | List.fold_left args ~init:func ~f:(fun acc arg -> [%expr [%e acc] [%e arg]]) 55 | ;; 56 | 57 | let fun_multi ~loc (args : label list) (body : expression) = 58 | List.fold_right args ~init:body ~f:(fun arg acc -> 59 | pexp_fun Nolabel ~loc None (ppat_var (Loc.make ~loc arg) ~loc) acc) 60 | ;; 61 | 62 | let closure_of_fn (fn : expression -> expression) ~loc : expression = 63 | let loc = { loc with loc_ghost = true } in 64 | let arg_pat, arg_expr = fresh_label ~loc in 65 | pexp_fun Nolabel ~loc None arg_pat (fn arg_expr) 66 | ;; 67 | 68 | module Signature : sig 69 | val gen 70 | : [ `to_ | `of_ | `both ] 71 | -> (signature_item list, rec_flag * type_declaration list) Deriving.Generator.t 72 | end = struct 73 | let of_td ~kind td : signature_item list = 74 | let { Location.loc; txt = tname } = td.ptype_name in 75 | let to_python_type = 76 | List.fold_left 77 | (List.rev td.ptype_params) 78 | ~init:[%type: [%t Ppxlib.core_type_of_type_declaration td] -> Pytypes.pyobject] 79 | ~f:(fun acc (tvar, _variance) -> 80 | [%type: ([%t tvar] -> Pytypes.pyobject) -> [%t acc]]) 81 | in 82 | let of_python_type = 83 | List.fold_left 84 | (List.rev td.ptype_params) 85 | ~init:[%type: Pytypes.pyobject -> [%t Ppxlib.core_type_of_type_declaration td]] 86 | ~f:(fun acc (tvar, _variance) -> 87 | [%type: (Pytypes.pyobject -> [%t tvar]) -> [%t acc]]) 88 | in 89 | let psig_value ~name ~type_ = 90 | psig_value ~loc (value_description ~loc ~name:(Loc.make name ~loc) ~type_ ~prim:[]) 91 | in 92 | match kind with 93 | | `both -> 94 | [ psig_value ~name:(python_of tname) ~type_:to_python_type 95 | ; psig_value ~name:(of_python tname) ~type_:of_python_type 96 | ] 97 | | `to_ -> [ psig_value ~name:(python_of tname) ~type_:to_python_type ] 98 | | `of_ -> [ psig_value ~name:(of_python tname) ~type_:of_python_type ] 99 | ;; 100 | 101 | let gen kind = 102 | Deriving.Generator.make_noarg (fun ~loc:_ ~path:_ (_rec_flag, tds) -> 103 | List.concat_map tds ~f:(of_td ~kind)) 104 | ;; 105 | end 106 | 107 | module Structure : sig 108 | val of_python_ty : core_type -> expression -> expression 109 | val to_python_ty : core_type -> expression -> expression 110 | 111 | val gen 112 | : [ `to_ | `of_ | `both ] 113 | -> (structure, rec_flag * type_declaration list) Deriving.Generator.t 114 | end = struct 115 | let change_lidloc_suffix ~f lid = 116 | Located.map 117 | (function 118 | | Lident str -> Lident (f str) 119 | | Ldot (m, str) -> Ldot (m, f str) 120 | | Lapply _ -> raise_errorf ~loc:lid.loc "lapply not supported") 121 | lid 122 | ;; 123 | 124 | let rec handle_core_type ~tuple ~var ~constr ~polymorphic_variant ct v = 125 | let loc = { ct.ptyp_loc with loc_ghost = true } in 126 | match Ppxlib_jane.Shim.Core_type_desc.of_parsetree ct.ptyp_desc with 127 | | Ptyp_tuple labeled_core_types -> 128 | (match Ppxlib_jane.as_unlabeled_tuple labeled_core_types with 129 | | Some core_types -> tuple ~loc core_types v 130 | | None -> raise_errorf ~loc "labeled tuples not supported") 131 | | Ptyp_var (tv, _) -> [%expr [%e pexp_ident ~loc (lident (var tv) ~loc)] [%e v]] 132 | | Ptyp_constr (longident_loc, args) -> 133 | let lid_loc = change_lidloc_suffix ~f:constr longident_loc in 134 | let args = 135 | List.map args ~f:(fun arg -> 136 | let arg_fn = handle_core_type ~tuple ~var ~constr ~polymorphic_variant arg in 137 | closure_of_fn ~loc arg_fn) 138 | @ [ v ] 139 | in 140 | curry_app_list (pexp_ident lid_loc ~loc) args ~loc 141 | | Ptyp_alias (alias, _, _) -> 142 | handle_core_type ~tuple ~var ~constr ~polymorphic_variant alias v 143 | | Ptyp_variant (row_fields, Closed, None) -> polymorphic_variant row_fields ~loc v 144 | | Ptyp_variant (_, _, _) -> 145 | raise_errorf 146 | ~loc 147 | "'%a' not supported, only closed variants with no labels are supported" 148 | Pprintast.core_type 149 | ct 150 | | _ -> raise_errorf ~loc "'%a' not supported" Pprintast.core_type ct 151 | ;; 152 | 153 | let rec of_python_ty core_type v = 154 | handle_core_type 155 | ~tuple:(of_python_tuple ~wrap:Fn.id) 156 | ~var:of_python_arg 157 | ~constr:of_python 158 | ~polymorphic_variant:of_python_polymorphic_variant 159 | core_type 160 | v 161 | 162 | and of_python_tuple ~wrap ~loc core_types v = 163 | let list = 164 | List.mapi core_types ~f:(fun i core_type -> 165 | [%expr 166 | let t = Py.Tuple.get_item [%e v] [%e eint i ~loc] in 167 | [%e of_python_ty core_type [%expr t]]]) 168 | in 169 | let tuple_len = eint (List.length core_types) ~loc in 170 | [%expr 171 | if not (Py.Tuple.check [%e v]) 172 | then Printf.sprintf "not a python tuple %s" (Py.Object.to_string [%e v]) |> failwith; 173 | let p_len = Py.Tuple.size [%e v] in 174 | if p_len <> [%e tuple_len] 175 | then Printf.sprintf "tuple size mismatch %d <> %d" [%e tuple_len] p_len |> failwith; 176 | [%e wrap (pexp_tuple ~loc list)]] 177 | 178 | and of_python_polymorphic_variant row_fields ~loc v = 179 | let match_cases ~args = 180 | List.map row_fields ~f:(fun { prf_desc; prf_loc = loc; prf_attributes = _ } -> 181 | match prf_desc with 182 | | Rinherit _ -> raise_errorf ~loc "inherited polymorphic variant not supported" 183 | | Rtag (label, has_constant_constructor, ctors) -> 184 | let rhs args = pexp_variant ~loc label.txt args in 185 | let rhs = 186 | match ctors, has_constant_constructor with 187 | | [], _ -> rhs None 188 | | [ core_type ], false -> rhs (Some (of_python_ty core_type args)) 189 | | [ _ ], true -> 190 | raise_errorf ~loc "cannot have both a constant and non-constant constructor" 191 | | _, _ -> raise_errorf ~loc "multiple constructors are not supported" 192 | in 193 | case 194 | ~lhs:(ppat_constant ~loc (Pconst_string (label.txt, loc, None))) 195 | ~guard:None 196 | ~rhs) 197 | @ [ case 198 | ~lhs:[%pat? cstor] 199 | ~guard:None 200 | ~rhs:[%expr failwith (Printf.sprintf "unexpected constructor %s" cstor)] 201 | ] 202 | in 203 | [%expr 204 | if not (Py.Tuple.check [%e v]) 205 | then Printf.sprintf "not a python tuple %s" (Py.Object.to_string [%e v]) |> failwith; 206 | let p_len = Py.Tuple.size [%e v] in 207 | if p_len <> 2 208 | then Printf.sprintf "not a python pair %s" (Py.Object.to_string [%e v]) |> failwith; 209 | let cstor, _args = Py.Tuple.to_pair [%e v] in 210 | let cstor = Py.String.to_string cstor in 211 | [%e pexp_match ~loc [%expr cstor] (match_cases ~args:[%expr _args])]] 212 | ;; 213 | 214 | let of_python_fields fields ~wrap ~loc ~allow_extra_fields v = 215 | let record_fields = 216 | List.map fields ~f:(fun field -> 217 | let name_as_string = estring ~loc field.pld_name.txt in 218 | let default_branch = 219 | match Attribute.get default field with 220 | | Some default -> default 221 | | None -> 222 | (match Attribute.get option field with 223 | | Some _ -> [%expr None] 224 | | None -> 225 | [%expr 226 | Printf.sprintf "cannot find field %s in dict" [%e name_as_string] 227 | |> failwith]) 228 | in 229 | let expr = 230 | [%expr 231 | match Ppx_python_runtime.Dict_str_keys.find [%e v] [%e name_as_string] with 232 | | exception (Stdlib.Not_found | Not_found_s _) -> [%e default_branch] 233 | | v -> 234 | __pyocaml_field_read := !__pyocaml_field_read + 1; 235 | [%e of_python_ty field.pld_type [%expr v]]] 236 | in 237 | lident field.pld_name.txt ~loc, expr) 238 | in 239 | let check_extra_fields = 240 | if allow_extra_fields 241 | then [%expr ()] 242 | else ( 243 | (* The [fail_on_extra_fields] bit is slow but this is ok as it's only used 244 | when an error is generated so outside of the path that we're optimizing 245 | for. *) 246 | let field_names = 247 | List.map fields ~f:(fun field -> estring ~loc field.pld_name.txt) |> elist ~loc 248 | in 249 | [%expr 250 | if !__pyocaml_field_read <> Py.Dict.size [%e v] 251 | then 252 | Ppx_python_runtime.Dict_str_keys.fail_on_extra_fields 253 | [%e v] 254 | ~expected_field_names:[%e field_names]]) 255 | in 256 | [%expr 257 | if not (Py.Dict.check [%e v]) 258 | then Printf.sprintf "not a python dict %s" (Py.Object.to_string [%e v]) |> failwith; 259 | let __pyocaml_field_read = ref 0 in 260 | let __pyocaml_res = [%e wrap (pexp_record record_fields ~loc None)] in 261 | [%e check_extra_fields]; 262 | __pyocaml_res] 263 | ;; 264 | 265 | let of_python_variant variant ~loc ~allow_extra_fields v = 266 | let match_cases ~args = 267 | List.map variant ~f:(fun variant -> 268 | let rhs args = pexp_construct ~loc (lident ~loc variant.pcd_name.txt) args in 269 | let rhs = 270 | match variant.pcd_args with 271 | | Pcstr_tuple [] -> rhs None 272 | | Pcstr_tuple tuple_args -> 273 | let core_types = 274 | List.map tuple_args ~f:Ppxlib_jane.Shim.Pcstr_tuple_arg.to_core_type 275 | in 276 | of_python_tuple core_types args ~loc ~wrap:(fun v -> rhs (Some v)) 277 | | Pcstr_record fields -> 278 | of_python_fields 279 | fields 280 | ~loc 281 | args 282 | ~wrap:(fun record -> rhs (Some record)) 283 | ~allow_extra_fields 284 | in 285 | case 286 | ~lhs:(ppat_constant ~loc (Pconst_string (variant.pcd_name.txt, loc, None))) 287 | ~guard:None 288 | ~rhs) 289 | @ [ case 290 | ~lhs:[%pat? cstor] 291 | ~guard:None 292 | ~rhs:[%expr failwith (Printf.sprintf "unexpected constructor %s" cstor)] 293 | ] 294 | in 295 | [%expr 296 | if not (Py.Tuple.check [%e v]) 297 | then Printf.sprintf "not a python tuple %s" (Py.Object.to_string [%e v]) |> failwith; 298 | let p_len = Py.Tuple.size [%e v] in 299 | if p_len <> 2 300 | then Printf.sprintf "not a python pair %s" (Py.Object.to_string [%e v]) |> failwith; 301 | let cstor, _args = Py.Tuple.to_pair [%e v] in 302 | let cstor = Py.String.to_string cstor in 303 | [%e pexp_match ~loc [%expr cstor] (match_cases ~args:[%expr _args])]] 304 | ;; 305 | 306 | let rec to_python_ty core_type v = 307 | let tuple ~loc core_types v = 308 | let pat, expr = to_python_tuple ~loc core_types in 309 | pexp_let ~loc Nonrecursive [ value_binding ~loc ~pat ~expr:v ] expr 310 | in 311 | handle_core_type 312 | ~tuple 313 | ~var:python_of_arg 314 | ~constr:python_of 315 | ~polymorphic_variant:to_polymorphic_variant 316 | core_type 317 | v 318 | 319 | and to_python_tuple ~loc core_types = 320 | let var_name i = "t" ^ Int.to_string i in 321 | let pat = 322 | List.mapi core_types ~f:(fun i _ -> ppat_var ~loc (Loc.make (var_name i) ~loc)) 323 | |> ppat_tuple ~loc 324 | in 325 | let list = 326 | List.mapi core_types ~f:(fun i core_type -> 327 | to_python_ty core_type (pexp_ident (lident (var_name i) ~loc) ~loc)) 328 | in 329 | pat, app_list [%expr Py.Tuple.of_list] ~loc list 330 | 331 | and to_polymorphic_variant row_fields ~loc v = 332 | let match_cases = 333 | List.map row_fields ~f:(fun { prf_desc; prf_loc = loc; prf_attributes = _ } -> 334 | match prf_desc with 335 | | Rinherit _ -> raise_errorf ~loc "inherited polymorphic variant not supported" 336 | | Rtag (label, has_constant_constructor, ctors) -> 337 | let constructor = estring ~loc label.txt in 338 | let args_lhs, args_rhs = 339 | match ctors, has_constant_constructor with 340 | | [], _ -> None, [%expr Py.none] 341 | | [ core_type ], false -> Some [%pat? t], to_python_ty core_type [%expr t] 342 | | [ _ ], true -> 343 | raise_errorf ~loc "cannot have both a constant and non-constant constructor" 344 | | _, _ -> raise_errorf ~loc "multiple constructors are not supported" 345 | in 346 | case 347 | ~lhs:(ppat_variant ~loc label.txt args_lhs) 348 | ~guard:None 349 | ~rhs: 350 | [%expr 351 | Py.Tuple.of_pair (Py.String.of_string [%e constructor], [%e args_rhs])]) 352 | in 353 | pexp_match ~loc v match_cases 354 | ;; 355 | 356 | let to_python_fields fields ~loc v = 357 | let mandatory_fields, optional_fields = 358 | List.partition_tf fields ~f:(fun field -> 359 | Attribute.get option field |> Option.is_none) 360 | in 361 | let mandatory_fields = 362 | List.map mandatory_fields ~f:(fun field -> 363 | let name_as_string = estring ~loc field.pld_name.txt in 364 | let value = pexp_field v (lident ~loc field.pld_name.txt) ~loc in 365 | [%expr [%e name_as_string], [%e to_python_ty field.pld_type value]]) 366 | in 367 | let mandatory_dict = 368 | app_list ~loc [%expr Ppx_python_runtime.Dict_str_keys.create] mandatory_fields 369 | in 370 | if List.is_empty optional_fields 371 | then mandatory_dict 372 | else ( 373 | let optional_setters = 374 | List.map optional_fields ~f:(fun field -> 375 | let name_as_string = estring ~loc field.pld_name.txt in 376 | let value = pexp_field v (lident ~loc field.pld_name.txt) ~loc in 377 | let pat_ident = lident ~loc "pat_value" |> pexp_ident ~loc in 378 | [%expr 379 | match [%e value] with 380 | | None -> () 381 | | Some _ as pat_value -> 382 | Ppx_python_runtime.Dict_str_keys.set 383 | dict 384 | [%e name_as_string] 385 | [%e to_python_ty field.pld_type pat_ident]]) 386 | in 387 | [%expr 388 | let dict = [%e mandatory_dict] in 389 | [%e esequence ~loc optional_setters]; 390 | dict]) 391 | ;; 392 | 393 | let to_python_variant variant ~loc v = 394 | let match_cases = 395 | List.map variant ~f:(fun variant -> 396 | let constructor = estring ~loc variant.pcd_name.txt in 397 | let args_lhs, args_rhs = 398 | match variant.pcd_args with 399 | | Pcstr_tuple [] -> None, [%expr Py.none] 400 | | Pcstr_tuple args -> 401 | let core_types = 402 | List.map args ~f:Ppxlib_jane.Shim.Pcstr_tuple_arg.to_core_type 403 | in 404 | let pat, expr = to_python_tuple ~loc core_types in 405 | Some pat, expr 406 | | Pcstr_record fields -> Some [%pat? t], to_python_fields fields ~loc [%expr t] 407 | in 408 | case 409 | ~lhs:(ppat_construct ~loc (lident ~loc variant.pcd_name.txt) args_lhs) 410 | ~guard:None 411 | ~rhs: 412 | [%expr Py.Tuple.of_pair (Py.String.of_string [%e constructor], [%e args_rhs])]) 413 | in 414 | pexp_match ~loc v match_cases 415 | ;; 416 | 417 | let expr_of_td ~tvar_wrapper ~type_expr ~variant ~record td = 418 | let { Location.loc; txt = _ } = td.ptype_name in 419 | let tvars = 420 | List.map td.ptype_params ~f:(fun (te, _variance) -> 421 | match Ppxlib_jane.Shim.Core_type_desc.of_parsetree te.ptyp_desc with 422 | | Ptyp_var (lbl, _) -> tvar_wrapper lbl 423 | | _ -> 424 | (* we've called [name_type_params_in_td] *) 425 | assert false) 426 | in 427 | let expr arg_t = 428 | match td.ptype_kind with 429 | | Ptype_abstract -> 430 | (match td.ptype_manifest with 431 | | None -> raise_errorf ~loc "abstract types not yet supported" 432 | | Some ty -> type_expr ty arg_t) 433 | | Ptype_variant cstrs -> variant cstrs ~loc arg_t 434 | | Ptype_record fields -> record fields ~loc arg_t 435 | | Ptype_open -> raise_errorf ~loc "open types not yet supported" 436 | in 437 | fun_multi ~loc tvars (closure_of_fn expr ~loc) 438 | ;; 439 | 440 | let gen kind = 441 | let attributes = 442 | match kind with 443 | | `both | `of_ -> 444 | [ Attribute.T default; Attribute.T option; Attribute.T disallow_extra_fields ] 445 | | `to_ -> [] 446 | in 447 | Deriving.Generator.make_noarg ~attributes (fun ~loc ~path:_ (rec_flag, tds) -> 448 | let tds = List.map tds ~f:name_type_params_in_td in 449 | let of_python_bindings () = 450 | List.map tds ~f:(fun td -> 451 | let pat = 452 | let { Location.loc; txt = tname } = td.ptype_name in 453 | let name = of_python tname in 454 | ppat_var ~loc (Loc.make name ~loc) 455 | in 456 | let expr = 457 | let allow_extra_fields = 458 | Option.is_none (Attribute.get disallow_extra_fields td) 459 | in 460 | expr_of_td 461 | ~tvar_wrapper:of_python_arg 462 | ~type_expr:of_python_ty 463 | ~variant:(of_python_variant ~allow_extra_fields) 464 | ~record:(of_python_fields ~wrap:Fn.id ~allow_extra_fields) 465 | td 466 | in 467 | value_binding ~loc ~pat ~expr) 468 | in 469 | let to_python_bindings () = 470 | List.map tds ~f:(fun td -> 471 | let pat = 472 | let { Location.loc; txt = tname } = td.ptype_name in 473 | let name = python_of tname in 474 | ppat_var ~loc (Loc.make name ~loc) 475 | in 476 | let expr = 477 | expr_of_td 478 | ~tvar_wrapper:python_of_arg 479 | ~type_expr:to_python_ty 480 | ~variant:to_python_variant 481 | ~record:to_python_fields 482 | td 483 | in 484 | value_binding ~loc ~pat ~expr) 485 | in 486 | let bindings = 487 | match kind with 488 | | `both -> to_python_bindings () @ of_python_bindings () 489 | | `to_ -> to_python_bindings () 490 | | `of_ -> of_python_bindings () 491 | in 492 | [ pstr_value ~loc (really_recursive rec_flag tds) bindings ]) 493 | ;; 494 | end 495 | 496 | let python = 497 | Deriving.add 498 | "python" 499 | ~str_type_decl:(Structure.gen `both) 500 | ~sig_type_decl:(Signature.gen `both) 501 | ;; 502 | 503 | module Python_of = struct 504 | let name = "python_of" 505 | let extension ~loc ~path:_ ctyp = closure_of_fn (Structure.to_python_ty ctyp) ~loc 506 | 507 | let deriver = 508 | Deriving.add 509 | name 510 | ~str_type_decl:(Structure.gen `to_) 511 | ~sig_type_decl:(Signature.gen `to_) 512 | ~extension 513 | ;; 514 | end 515 | 516 | module Of_python = struct 517 | let name = "of_python" 518 | let extension ~loc ~path:_ ctyp = closure_of_fn (Structure.of_python_ty ctyp) ~loc 519 | 520 | let deriver = 521 | Deriving.add 522 | name 523 | ~str_type_decl:(Structure.gen `of_) 524 | ~sig_type_decl:(Signature.gen `of_) 525 | ~extension 526 | ;; 527 | end 528 | 529 | (* [py_string_expressions] maps from the string literal to the expression binding *) 530 | let py_string_expressions = Hashtbl.create (module String) 531 | 532 | let expand ~expr_loc ~string_loc ~string = 533 | let loc = { string_loc with loc_ghost = true } in 534 | let expr_var, _expr = 535 | Hashtbl.find_or_add py_string_expressions string ~default:(fun () -> 536 | let expr = [%expr lazy (Py.String.of_string [%e estring string ~loc])] in 537 | let len = Hashtbl.length py_string_expressions in 538 | let expr_var = Printf.sprintf "py_string_%d" len in 539 | expr_var, expr) 540 | in 541 | [%expr Lazy.force [%e evar expr_var ~loc:expr_loc]] 542 | ;; 543 | 544 | let () = 545 | Ppxlib.Driver.register_transformation 546 | "ppx_python_conv" 547 | ~rules: 548 | [ Context_free.Rule.extension 549 | (Extension.declare 550 | "ppx_python_conv.py_string" 551 | Extension.Context.expression 552 | Ast_pattern.( 553 | pstr (pstr_eval (pexp_constant (pconst_string __ __ drop)) nil ^:: nil)) 554 | (* [delimiter] can be things like "\n". This comes up if we use a multi-line 555 | string. *) 556 | (fun ~loc:expr_loc ~path:_ string string_loc -> 557 | Merlin_helpers.hide_expression (expand ~expr_loc ~string_loc ~string))) 558 | ] 559 | ~impl:(fun structure -> 560 | let loc = Location.none in 561 | let header = 562 | Hashtbl.data py_string_expressions 563 | |> List.map ~f:(fun (key, value) -> [%stri let [%p pvar key ~loc] = [%e value]]) 564 | in 565 | Hashtbl.clear py_string_expressions; 566 | header @ structure) 567 | ;; 568 | -------------------------------------------------------------------------------- /src/ppx_python_conv.mli: -------------------------------------------------------------------------------- 1 | open Ppxlib 2 | 3 | val python : Deriving.t 4 | 5 | module Python_of : sig 6 | val deriver : Deriving.t 7 | end 8 | 9 | module Of_python : sig 10 | val deriver : Deriving.t 11 | end 12 | -------------------------------------------------------------------------------- /test/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name ppx_python_test) 3 | (libraries core) 4 | (preprocess 5 | (pps ppx_jane ppx_python_conv))) 6 | -------------------------------------------------------------------------------- /test/ppx_test.ml: -------------------------------------------------------------------------------- 1 | open Core 2 | open Ppx_python_runtime 3 | 4 | module type S = sig 5 | type _t = { field_a : int } [@@deriving python] 6 | end 7 | 8 | type t = 9 | { field_a : int 10 | ; field_b : string 11 | } 12 | [@@deriving python, sexp] 13 | 14 | type u = 15 | { foo : int * int 16 | ; bar : t 17 | } 18 | [@@deriving python] 19 | 20 | type v = 21 | | A 22 | | B of string 23 | | C of int 24 | | D of t * string 25 | | E of 26 | { x : int 27 | ; y : string 28 | } 29 | [@@deriving python, sexp] 30 | 31 | let%expect_test "t" = 32 | if not (Py.is_initialized ()) then Py.initialize ~version:3 (); 33 | let t = { field_a = 42; field_b = "foobar" } in 34 | let pyobject = python_of_t t in 35 | let items = Py.Dict.to_bindings_string pyobject |> List.sort ~compare:Stdlib.compare in 36 | List.iter items ~f:(fun (key, value) -> 37 | printf "%s: %s\n%!" key (Py.Object.to_string value)); 38 | [%expect 39 | {| 40 | field_a: 42 41 | field_b: foobar 42 | |}]; 43 | let t = t_of_python pyobject in 44 | printf !"%{Sexp}\n%!" (sexp_of_t t); 45 | [%expect {| ((field_a 42)(field_b foobar)) |}] 46 | ;; 47 | 48 | let%expect_test "v" = 49 | if not (Py.is_initialized ()) then Py.initialize ~version:3 (); 50 | let v = D ({ field_a = 42; field_b = "foobar" }, "pi") in 51 | let pyobject = python_of_v v in 52 | let v = v_of_python pyobject in 53 | printf !"%{Sexp}\n%!" (sexp_of_v v); 54 | [%expect {| (D((field_a 42)(field_b foobar))pi) |}]; 55 | let v = E { x = 42; y = "foobar" } in 56 | let pyobject = python_of_v v in 57 | let v = v_of_python pyobject in 58 | printf !"%{Sexp}\n%!" (sexp_of_v v); 59 | [%expect {| (E(x 42)(y foobar)) |}] 60 | ;; 61 | 62 | module M : sig 63 | type t = int [@@deriving python, sexp] 64 | 65 | type 'a u = 66 | | A of int 67 | | B of 'a 68 | [@@deriving python, sexp] 69 | end = struct 70 | type t = int [@@deriving python, sexp] 71 | 72 | type 'a u = 73 | | A of int 74 | | B of 'a 75 | [@@deriving python, sexp] 76 | end 77 | 78 | let%expect_test "M.u" = 79 | if not (Py.is_initialized ()) then Py.initialize ~version:3 (); 80 | let v = M.B 12 in 81 | let pyobject = M.python_of_u python_of_int v in 82 | let v = M.u_of_python int_of_python pyobject in 83 | printf !"%{sexp:int M.u}\n%!" v; 84 | [%expect {| (B 12) |}] 85 | ;; 86 | 87 | type 'a w = 88 | | One of 'a 89 | | Multi of 'a list 90 | [@@deriving python, sexp] 91 | 92 | let%expect_test "w" = 93 | if not (Py.is_initialized ()) then Py.initialize ~version:3 (); 94 | let v = Multi [ 1; 2; 3; 4 ] in 95 | let pyobject = python_of_w python_of_int v in 96 | let v = w_of_python int_of_python pyobject in 97 | printf !"%{sexp:int w}\n%!" v; 98 | [%expect {| (Multi (1 2 3 4)) |}] 99 | ;; 100 | 101 | type 'a tree = 102 | | Leaf of 'a 103 | | Node of 'a tree * 'a tree 104 | [@@deriving python, sexp] 105 | 106 | let%expect_test "tree" = 107 | if not (Py.is_initialized ()) then Py.initialize ~version:3 (); 108 | let v = Node (Leaf "test", Node (Leaf "foo", Leaf "bar")) in 109 | let pyobject = python_of_tree python_of_string v in 110 | let v = tree_of_python string_of_python pyobject in 111 | printf !"%{sexp:string tree}\n%!" v; 112 | [%expect {| (Node (Leaf test) (Node (Leaf foo) (Leaf bar))) |}] 113 | ;; 114 | 115 | (* Check that unused type variables are not an issue. *) 116 | type 'a z1 = int [@@deriving python] 117 | 118 | (* Check that underscores are not an issue neither. *) 119 | type _ z2 = int [@@deriving python] 120 | 121 | let%expect_test "type-var" = 122 | if not (Py.is_initialized ()) then Py.initialize ~version:3 (); 123 | let round_trip1 v = 124 | let pyobject = python_of_z1 (fun _ -> assert false) v in 125 | z1_of_python (fun _ -> assert false) pyobject 126 | in 127 | let round_trip2 v = 128 | let pyobject = python_of_z2 (fun _ -> assert false) v in 129 | z2_of_python (fun _ -> assert false) pyobject 130 | in 131 | printf !"%d %d\n%!" (round_trip1 42) (round_trip2 42); 132 | [%expect {| 42 42 |}] 133 | ;; 134 | 135 | module type Test = sig 136 | type 'a t1 = int [@@deriving python] 137 | type _ t2 = int [@@deriving python] 138 | type u1 = int t1 [@@deriving python] 139 | type u2 = int t2 [@@deriving python] 140 | end 141 | 142 | type runtime_types = 143 | { bool : bool 144 | ; int : int 145 | ; float : float 146 | ; string : string 147 | ; array : (float * string) array 148 | ; list : (string list * bool) list 149 | ; option : int option option 150 | } 151 | [@@deriving python, sexp] 152 | 153 | let%expect_test "runtime-types" = 154 | if not (Py.is_initialized ()) then Py.initialize ~version:3 (); 155 | List.iter 156 | ~f:(fun v -> 157 | printf 158 | !"%{sexp:runtime_types}\n%!" 159 | (python_of_runtime_types v |> runtime_types_of_python)) 160 | [ { bool = true 161 | ; int = 42 162 | ; float = 3.1415 163 | ; string = "foobar" 164 | ; array = [| 1., "one" |] 165 | ; list = [] 166 | ; option = None 167 | } 168 | ; { bool = true 169 | ; int = 1337 170 | ; float = 2.71828 171 | ; string = "another-string" 172 | ; array = [||] 173 | ; list = [ [ "a"; "b" ], true; [], false ] 174 | ; option = Some None 175 | } 176 | ]; 177 | [%expect 178 | {| 179 | ((bool true) (int 42) (float 3.1415) (string foobar) (array ((1 one))) 180 | (list ()) (option ())) 181 | ((bool true) (int 1337) (float 2.71828) (string another-string) (array ()) 182 | (list (((a b) true) (() false))) (option ())) 183 | |}] 184 | ;; 185 | 186 | let%expect_test "of-python-errors" = 187 | if not (Py.is_initialized ()) then Py.initialize ~version:3 (); 188 | let expect_exn f = 189 | let success = 190 | try 191 | f (); 192 | true 193 | with 194 | | exn -> 195 | printf !"ocaml exn: %{Exn}" exn; 196 | false 197 | in 198 | if success then failwith "an exception was expected" 199 | in 200 | expect_exn (fun () -> ignore (t_of_python (Py.String.of_string "test") : t)); 201 | [%expect {| ocaml exn: (Failure "not a python dict test") |}]; 202 | expect_exn (fun () -> ignore (t_of_python (python_of_v A))); 203 | [%expect {| ocaml exn: (Failure "not a python dict ('A', None)") |}]; 204 | expect_exn (fun () -> 205 | ignore 206 | (t_of_python (python_of_u { foo = 1, 2; bar = { field_a = 1; field_b = "test" } }))); 207 | [%expect {| ocaml exn: (Failure "cannot find field field_b in dict") |}] 208 | ;; 209 | 210 | let%expect_test "python_of-of_python" = 211 | if not (Py.is_initialized ()) then Py.initialize ~version:3 (); 212 | let pyobject = [%python_of: int * float] (42, 1.337) in 213 | print_endline (Py.Object.to_string pyobject); 214 | [%expect {| (42, 1.337) |}]; 215 | let forty_two, pi = [%of_python: int * float] pyobject in 216 | printf "%d %.3f\n%!" forty_two pi; 217 | [%expect {| 42 1.337 |}]; 218 | let pyobject = 219 | [%python_of: int list * t] ([ 3; 1; 4; 1; 5 ], { field_a = 42; field_b = "foo" }) 220 | in 221 | print_endline (Py.Object.to_string pyobject); 222 | [%expect {| ([3, 1, 4, 1, 5], {'field_a': 42, 'field_b': 'foo'}) |}]; 223 | let list, t = [%of_python: int list * t] pyobject in 224 | printf !"%{sexp:int list} %{sexp:t}\n%!" list t; 225 | [%expect {| (3 1 4 1 5) ((field_a 42) (field_b foo)) |}] 226 | ;; 227 | 228 | type t_with_default = 229 | { field_a : int 230 | ; field_b : string [@python.default "foo"] 231 | } 232 | [@@deriving python, sexp] 233 | 234 | let%expect_test "default" = 235 | if not (Py.is_initialized ()) then Py.initialize ~version:3 (); 236 | let t_with_default = { field_a = 42; field_b = "bar" } in 237 | let pyobject = python_of_t_with_default t_with_default in 238 | print_endline (Py.Object.to_string pyobject); 239 | [%expect {| {'field_a': 42, 'field_b': 'bar'} |}]; 240 | let t_with_default = t_with_default_of_python pyobject in 241 | printf !"%{sexp:t_with_default}\n%!" t_with_default; 242 | [%expect {| ((field_a 42) (field_b bar)) |}]; 243 | let pyobject = Py.Dict.create () in 244 | Py.Dict.set_item_string pyobject "field_a" (python_of_int 1337); 245 | let t_with_default = t_with_default_of_python pyobject in 246 | printf !"%{sexp:t_with_default}\n%!" t_with_default; 247 | [%expect {| ((field_a 1337) (field_b foo)) |}] 248 | ;; 249 | 250 | type t_with_option = 251 | { field_a : int 252 | ; field_b : (string * float) option [@python.option] 253 | ; field_c : int option [@python.option] 254 | } 255 | [@@deriving python, sexp] 256 | 257 | let%expect_test "option" = 258 | if not (Py.is_initialized ()) then Py.initialize ~version:3 (); 259 | let t_with_option = { field_a = 42; field_b = Some ("foo", 3.14); field_c = None } in 260 | let pyobject = python_of_t_with_option t_with_option in 261 | print_endline (Py.Object.to_string pyobject); 262 | [%expect {| {'field_a': 42, 'field_b': ('foo', 3.14)} |}]; 263 | let t_with_option = t_with_option_of_python pyobject in 264 | printf !"%{sexp:t_with_option}\n%!" t_with_option; 265 | [%expect {| ((field_a 42) (field_b ((foo 3.14))) (field_c ())) |}]; 266 | let pyobject = Py.Dict.create () in 267 | Py.Dict.set_item_string pyobject "field_a" (python_of_int 1337); 268 | Py.Dict.set_item_string pyobject "field_c" (python_of_int 42); 269 | let t_with_option = t_with_option_of_python pyobject in 270 | printf !"%{sexp:t_with_option}\n%!" t_with_option; 271 | [%expect {| ((field_a 1337) (field_b ()) (field_c (42))) |}] 272 | ;; 273 | 274 | type t_python_of = 275 | { foo : int 276 | ; bar : float option 277 | } 278 | [@@deriving python_of] 279 | 280 | let%expect_test "python-of" = 281 | if not (Py.is_initialized ()) then Py.initialize ~version:3 (); 282 | let t = { foo = 42; bar = Some 3.1415 } in 283 | let pyobject = python_of_t_python_of t in 284 | print_endline (Py.Object.to_string pyobject); 285 | [%expect {| {'foo': 42, 'bar': 3.1415} |}] 286 | ;; 287 | 288 | type t_of_python = 289 | { foo : int 290 | ; bar : float option 291 | } 292 | [@@deriving of_python, sexp] 293 | 294 | let%expect_test "python-of" = 295 | if not (Py.is_initialized ()) then Py.initialize ~version:3 (); 296 | let pyobject = Py.Dict.create () in 297 | Py.Dict.set_item_string pyobject "foo" (python_of_int 1337); 298 | Py.Dict.set_item_string pyobject "bar" (python_of_float 2.71828182846); 299 | let t = t_of_python_of_python pyobject in 300 | printf !"%{sexp:t_of_python}\n%!" t; 301 | [%expect {| ((foo 1337) (bar (2.71828182846))) |}] 302 | ;; 303 | 304 | module _ : sig 305 | (* Export the type to check the mli generation too. *) 306 | type 'a l = 307 | | Empty 308 | | Cons of 'a * 'a l 309 | [@@deriving python] 310 | 311 | type int_tree = 312 | | Leaf of int 313 | | Node of int tree * int tree 314 | [@@deriving python] 315 | end = struct 316 | type 'a l = 317 | | Empty 318 | | Cons of 'a * 'a l 319 | [@@deriving python, sexp] 320 | 321 | let%expect_test "rec" = 322 | if not (Py.is_initialized ()) then Py.initialize ~version:3 (); 323 | List.iter 324 | [ Empty; Cons ("foo", Empty); Cons ("foo", Cons ("bar", Empty)) ] 325 | ~f:(fun l -> 326 | printf !"%{sexp:string l}\n%!" l; 327 | let pyobject = python_of_l python_of_string l in 328 | print_endline (Py.Object.to_string pyobject); 329 | printf !"%{sexp:string l}\n%!" (l_of_python string_of_python pyobject)); 330 | [%expect 331 | {| 332 | Empty 333 | ('Empty', None) 334 | Empty 335 | (Cons foo Empty) 336 | ('Cons', ('foo', ('Empty', None))) 337 | (Cons foo Empty) 338 | (Cons foo (Cons bar Empty)) 339 | ('Cons', ('foo', ('Cons', ('bar', ('Empty', None))))) 340 | (Cons foo (Cons bar Empty)) 341 | |}] 342 | ;; 343 | 344 | type int_tree = 345 | | Leaf of int 346 | | Node of int tree * int tree 347 | [@@deriving python, sexp] 348 | 349 | let%expect_test "rec" = 350 | if not (Py.is_initialized ()) then Py.initialize ~version:3 (); 351 | List.iter 352 | [ Leaf 42 353 | ; Node (Leaf 1, Leaf 2) 354 | ; Node (Node (Leaf 1, Node (Leaf 2, Leaf 3)), Leaf 4) 355 | ] 356 | ~f:(fun tree -> 357 | printf !"%{sexp:int_tree}\n%!" tree; 358 | let pyobject = python_of_int_tree tree in 359 | print_endline (Py.Object.to_string pyobject); 360 | printf !"%{sexp:int_tree}\n%!" (int_tree_of_python pyobject)); 361 | [%expect 362 | {| 363 | (Leaf 42) 364 | ('Leaf', (42,)) 365 | (Leaf 42) 366 | (Node (Leaf 1) (Leaf 2)) 367 | ('Node', (('Leaf', (1,)), ('Leaf', (2,)))) 368 | (Node (Leaf 1) (Leaf 2)) 369 | (Node (Node (Leaf 1) (Node (Leaf 2) (Leaf 3))) (Leaf 4)) 370 | ('Node', (('Node', (('Leaf', (1,)), ('Node', (('Leaf', (2,)), ('Leaf', (3,)))))), ('Leaf', (4,)))) 371 | (Node (Node (Leaf 1) (Node (Leaf 2) (Leaf 3))) (Leaf 4)) 372 | |}] 373 | ;; 374 | end 375 | 376 | module _ : sig 377 | type t = 378 | | Base of int 379 | | App of t * u 380 | 381 | and u = Lam of t [@@deriving python, sexp] 382 | end = struct 383 | type t = 384 | | Base of int 385 | | App of t * u 386 | 387 | and u = Lam of t [@@deriving python, sexp] 388 | 389 | let%expect_test "mut-rec" = 390 | if not (Py.is_initialized ()) then Py.initialize ~version:3 (); 391 | let t = App (Base 42, Lam (App (Base 299792458, Lam (Base 1337)))) in 392 | printf !"%{sexp:t}\n%!" t; 393 | let pyobject = python_of_t t in 394 | print_endline (Py.Object.to_string pyobject); 395 | printf !"%{sexp:t}\n%!" (t_of_python pyobject); 396 | [%expect 397 | {| 398 | (App (Base 42) (Lam (App (Base 299792458) (Lam (Base 1337))))) 399 | ('App', (('Base', (42,)), ('Lam', (('App', (('Base', (299792458,)), ('Lam', (('Base', (1337,)),)))),)))) 400 | (App (Base 42) (Lam (App (Base 299792458) (Lam (Base 1337))))) 401 | |}] 402 | ;; 403 | end 404 | 405 | module _ : sig 406 | type tree = [ `Node of int * tree list ] [@@deriving python] 407 | end = struct 408 | type t = 409 | [ `A 410 | | `B of int 411 | | `C of int * string * string 412 | | `D 413 | ] 414 | [@@deriving python, sexp] 415 | 416 | let%expect_test "polymorphic-variant" = 417 | if not (Py.is_initialized ()) then Py.initialize ~version:3 (); 418 | let all = [ `A; `B 42; `C (1337, "alan", "turing"); `D ] in 419 | List.iter all ~f:(fun t -> 420 | printf !"%{sexp:t}\n%!" t; 421 | let pyobject = python_of_t t in 422 | print_endline (Py.Object.to_string pyobject); 423 | printf !"%{sexp:t}\n%!" (t_of_python pyobject)); 424 | [%expect 425 | {| 426 | A 427 | ('A', None) 428 | A 429 | (B 42) 430 | ('B', 42) 431 | (B 42) 432 | (C (1337 alan turing)) 433 | ('C', (1337, 'alan', 'turing')) 434 | (C (1337 alan turing)) 435 | D 436 | ('D', None) 437 | D 438 | |}] 439 | ;; 440 | 441 | type u = 442 | { foo : t 443 | ; bar : [ `c | `A | `d of [ `c | `d of string ] ] 444 | } 445 | [@@deriving python, sexp] 446 | 447 | let%expect_test "polymorphic-variant-2" = 448 | if not (Py.is_initialized ()) then Py.initialize ~version:3 (); 449 | let all = [ { foo = `A; bar = `c }; { foo = `B 42; bar = `d (`d "foobar") } ] in 450 | List.iter all ~f:(fun u -> 451 | printf !"%{sexp:u}\n%!" u; 452 | let pyobject = python_of_u u in 453 | print_endline (Py.Object.to_string pyobject); 454 | printf !"%{sexp:u}\n%!" (u_of_python pyobject)); 455 | [%expect 456 | {| 457 | ((foo A) (bar c)) 458 | {'foo': ('A', None), 'bar': ('c', None)} 459 | ((foo A) (bar c)) 460 | ((foo (B 42)) (bar (d (d foobar)))) 461 | {'foo': ('B', 42), 'bar': ('d', ('d', 'foobar'))} 462 | ((foo (B 42)) (bar (d (d foobar)))) 463 | |}] 464 | ;; 465 | 466 | type tree = [ `Node of int * tree list ] [@@deriving python, sexp] 467 | 468 | let%expect_test "polymorphic-variant-tree" = 469 | if not (Py.is_initialized ()) then Py.initialize ~version:3 (); 470 | let t : tree = 471 | `Node (1, [ `Node (2, []); `Node (3, []); `Node (4, [ `Node (5, []) ]) ]) 472 | in 473 | printf !"%{sexp:tree}\n%!" t; 474 | let pyobject = python_of_tree t in 475 | print_endline (Py.Object.to_string pyobject); 476 | printf !"%{sexp:tree}\n%!" (tree_of_python pyobject); 477 | [%expect 478 | {| 479 | (Node (1 ((Node (2 ())) (Node (3 ())) (Node (4 ((Node (5 ())))))))) 480 | ('Node', (1, [('Node', (2, [])), ('Node', (3, [])), ('Node', (4, [('Node', (5, []))]))])) 481 | (Node (1 ((Node (2 ())) (Node (3 ())) (Node (4 ((Node (5 ())))))))) 482 | |}]; 483 | let t2 = `Node (42, [ t; t; t; t ]) in 484 | let t = `Node (1337, [ t; t2; t ]) in 485 | printf !"%d" (Stdlib.compare (tree_of_python (python_of_tree t)) t); 486 | [%expect {| 0 |}] 487 | ;; 488 | end 489 | 490 | module _ = struct 491 | type t = 492 | { field_a : int 493 | ; field_b : string 494 | ; field_c : float 495 | } 496 | [@@deriving python, sexp] [@@python.disallow_extra_fields] 497 | 498 | type t_allow = 499 | { field_a : int 500 | ; field_b : string 501 | } 502 | [@@deriving python, sexp] 503 | 504 | type t_disallow = 505 | { field_a : int 506 | ; field_b : string 507 | } 508 | [@@deriving python, sexp] [@@python.disallow_extra_fields] 509 | 510 | let%expect_test "extra-field-test" = 511 | if not (Py.is_initialized ()) then Py.initialize ~version:3 (); 512 | let t = { field_a = 42; field_b = "aturing"; field_c = 3.141592653589 } in 513 | let pyobject = python_of_t t in 514 | let try_extract f = Or_error.try_with (fun () -> f pyobject) in 515 | printf !"%{sexp:t_allow Or_error.t}\n%!" (try_extract t_allow_of_python); 516 | printf !"%{sexp:t_disallow Or_error.t}\n%!" (try_extract t_disallow_of_python); 517 | Py.Dict.set_item_string pyobject "another_extra_field" Py.none; 518 | printf !"%{sexp:t_allow Or_error.t}\n%!" (try_extract t_allow_of_python); 519 | printf !"%{sexp:t_disallow Or_error.t}\n%!" (try_extract t_disallow_of_python); 520 | Py.Dict.del_item_string pyobject "another_extra_field"; 521 | Py.Dict.del_item_string pyobject "field_c"; 522 | printf !"%{sexp:t_allow Or_error.t}\n%!" (try_extract t_allow_of_python); 523 | printf !"%{sexp:t_disallow Or_error.t}\n%!" (try_extract t_disallow_of_python); 524 | Py.Dict.del_item_string pyobject "field_b"; 525 | printf !"%{sexp:t_allow Or_error.t}\n%!" (try_extract t_allow_of_python); 526 | printf !"%{sexp:t_disallow Or_error.t}\n%!" (try_extract t_disallow_of_python); 527 | [%expect 528 | {| 529 | (Ok ((field_a 42) (field_b aturing))) 530 | (Error (Failure "unexpected extra field names 'field_c'")) 531 | (Ok ((field_a 42) (field_b aturing))) 532 | (Error 533 | (Failure "unexpected extra field names 'field_c','another_extra_field'")) 534 | (Ok ((field_a 42) (field_b aturing))) 535 | (Ok ((field_a 42) (field_b aturing))) 536 | (Error (Failure "cannot find field field_b in dict")) 537 | (Error (Failure "cannot find field field_b in dict")) 538 | |}] 539 | ;; 540 | 541 | type t_with_default = 542 | { f_a : int 543 | ; f_b : string [@python.default "foobar"] 544 | ; f_c : float 545 | } 546 | [@@deriving python, sexp] [@@python.disallow_extra_fields] 547 | 548 | let%expect_test "extra-field-with-default-test" = 549 | if not (Py.is_initialized ()) then Py.initialize ~version:3 (); 550 | let extract_and_print bindings = 551 | let pyobject = Py.Dict.of_bindings_string bindings in 552 | printf 553 | !"%{sexp:t_with_default Or_error.t}\n%!" 554 | (Or_error.try_with (fun () -> t_with_default_of_python pyobject)) 555 | in 556 | extract_and_print 557 | [ "f_a", python_of_int 1 558 | ; "f_b", python_of_string "barfoo" 559 | ; "f_c", python_of_float 3.141592 560 | ]; 561 | extract_and_print 562 | [ "f_a", python_of_int 1 563 | ; "f_bb", python_of_string "barfoo" 564 | ; "f_b", python_of_string "barfoo" 565 | ; "f_c", python_of_float 3.141592 566 | ]; 567 | extract_and_print 568 | [ "f_a", python_of_int 1 569 | ; "f_bb", python_of_string "barfoo" 570 | ; "f_c", python_of_float 3.141592 571 | ]; 572 | extract_and_print [ "f_a", python_of_int 1; "f_c", python_of_float 3.141592 ]; 573 | [%expect 574 | {| 575 | (Ok ((f_a 1) (f_b barfoo) (f_c 3.141592))) 576 | (Error (Failure "unexpected extra field names 'f_bb'")) 577 | (Error (Failure "unexpected extra field names 'f_bb'")) 578 | (Ok ((f_a 1) (f_b foobar) (f_c 3.141592))) 579 | |}] 580 | ;; 581 | end 582 | 583 | module _ : sig 584 | type ('a, 'b, 'c) template = 585 | | A of 'a 586 | | B of 'b 587 | | C of 'c 588 | [@@deriving python] 589 | end = struct 590 | type ('a, 'b, 'c) template = 591 | | A of 'a 592 | | B of 'b 593 | | C of 'c 594 | [@@deriving python, sexp] 595 | 596 | module Custom = struct 597 | type t = int [@@deriving python, sexp] 598 | end 599 | 600 | type int_template = (int, int, int) template [@@deriving python, sexp] 601 | type float_template = (float, float, float) template [@@deriving python, sexp] 602 | type bool_template = (bool, bool, bool) template [@@deriving python, sexp] 603 | 604 | let%expect_test "multi-polymorphic-type" = 605 | (* Test python_of_t conversions *) 606 | let i = python_of_int_template (A 1) in 607 | let f = python_of_float_template (B 1.) in 608 | let b = python_of_bool_template (C false) in 609 | let custom : (Custom.t, float, bool) template = A 5 in 610 | let custom_python = 611 | python_of_template Custom.python_of_t python_of_float python_of_bool custom 612 | in 613 | print_endline (Py.Object.to_string i); 614 | print_endline (Py.Object.to_string f); 615 | print_endline (Py.Object.to_string b); 616 | print_endline (Py.Object.to_string custom_python); 617 | [%expect 618 | {| 619 | ('A', (1,)) 620 | ('B', (1.0,)) 621 | ('C', (False,)) 622 | ('A', (5,)) 623 | |}]; 624 | (* Test t_of_python conversions *) 625 | let i = int_template_of_python i in 626 | let f = float_template_of_python f in 627 | let b = bool_template_of_python b in 628 | let custom = 629 | template_of_python Custom.t_of_python float_of_python bool_of_python custom_python 630 | in 631 | printf !"%{Sexp}\n%!" (sexp_of_int_template i); 632 | printf !"%{Sexp}\n%!" (sexp_of_float_template f); 633 | printf !"%{Sexp}\n%!" (sexp_of_bool_template b); 634 | printf 635 | !"%{Sexp}\n%!" 636 | (sexp_of_template Custom.sexp_of_t sexp_of_float sexp_of_bool custom); 637 | [%expect 638 | {| 639 | (A 1) 640 | (B 1) 641 | (C false) 642 | (A 5) 643 | |}] 644 | ;; 645 | end 646 | 647 | let%expect_test "py_string literal tests" = 648 | if not (Py.is_initialized ()) then Py.initialize (); 649 | let (some_python_string : Py.Object.t) = [%py_string "python_string!\n"] in 650 | let (_ : Py.Object.t) = [%py_string "another python string!\n"] in 651 | let sys = Py.Import.import_module "sys" in 652 | let sys_stdout = Py.Object.get_attr_string sys "stdout" |> Option.value_exn in 653 | let python_stdout_write = 654 | Py.Object.get_attr_string sys_stdout "write" |> Option.value_exn 655 | in 656 | let python_stdout_flush = 657 | Py.Object.get_attr_string sys_stdout "flush" |> Option.value_exn 658 | in 659 | let _none = Py.Callable.to_function python_stdout_write [| some_python_string |] in 660 | let _none = Py.Callable.to_function python_stdout_flush [||] in 661 | (* let's print the second python string using the lazy cached value from the py_string 662 | ppx extension *) 663 | let _none = Py.Callable.to_function python_stdout_write [| Lazy.force py_string_1 |] in 664 | let _none = Py.Callable.to_function python_stdout_flush [||] in 665 | [%expect 666 | {| 667 | python_string! 668 | another python string! 669 | |}] 670 | ;; 671 | -------------------------------------------------------------------------------- /test/ppx_test.mli: -------------------------------------------------------------------------------- 1 | (*_ This signature is deliberately empty. *) 2 | -------------------------------------------------------------------------------- /test/ppx_test_py_string.ml: -------------------------------------------------------------------------------- 1 | let _py_string () = [%py_string "single-line-py-string"] 2 | 3 | let _multi_line_py_string () = 4 | [%py_string 5 | {| 6 | 7 | fizz 8 | 9 | buzz 10 | 11 | 15 12 | 13 | 14 | |}] 15 | ;; 16 | 17 | let _py_string_dup () = [%py_string "single-line-py-string"] 18 | -------------------------------------------------------------------------------- /test/ppx_test_py_string.mli: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/janestreet/ppx_python/18413ba05503d7c49b55c6487a2a0a61907352f3/test/ppx_test_py_string.mli -------------------------------------------------------------------------------- /test/test-ppx-py-string.t: -------------------------------------------------------------------------------- 1 | $ cd $TESTDIR 2 | $ cat ppx_test_py_string.ml.pp 3 | let py_string_1 = 4 | lazy (Pyml.Py.String.of_string "\n\n fizz\n\n buzz\n\n 15\n\n\n") 5 | let py_string_0 = lazy (Pyml.Py.String.of_string "single-line-py-string") 6 | let () = 7 | Ppx_bench_lib.Benchmark_accumulator.Current_libname.set "ppx_python_test" 8 | let () = 9 | Ppx_expect_runtime.Current_file.set 10 | ~filename_rel_to_project_root:"ppx/ppx_python/test/ppx_test_py_string.ml" 11 | let () = 12 | Ppx_inline_test_lib.set_lib_and_partition "ppx_python_test" 13 | "ppx_test_py_string" 14 | let _py_string () = ((Lazy.force py_string_0)[@merlin.hide ]) 15 | let _multi_line_py_string () = ((Lazy.force py_string_1)[@merlin.hide ]) 16 | let _py_string_dup () = ((Lazy.force py_string_0)[@merlin.hide ]) 17 | let () = Ppx_inline_test_lib.unset_lib "ppx_python_test" 18 | let () = Ppx_expect_runtime.Current_file.unset () 19 | let () = Ppx_bench_lib.Benchmark_accumulator.Current_libname.unset () 20 | --------------------------------------------------------------------------------