From b2c7eeb371924a04346e4dea14a596b3accb9d3c Mon Sep 17 00:00:00 2001 From: mlasson Date: Wed, 27 Aug 2025 18:17:52 +0200 Subject: [PATCH 1/4] Experimental support for primitves bindings --- node-test/bindings/expected/fs.ml | 23 ++++++++---- node-test/bindings/expected/imports.ml | 7 +--- node-test/bindings/fs.mli | 2 +- node-test/bindings/imports.js | 9 +++-- node-test/bindings/imports.mli | 5 +-- ppx-lib/gen_js_api_ppx.ml | 52 +++++++++++++++++++------- 6 files changed, 61 insertions(+), 37 deletions(-) diff --git a/node-test/bindings/expected/fs.ml b/node-test/bindings/expected/fs.ml index 8fba8202..232f0faa 100644 --- a/node-test/bindings/expected/fs.ml +++ b/node-test/bindings/expected/fs.ml @@ -93,27 +93,34 @@ let (readdir : string -> string list Promise.t) = fun (x39 : string) -> Promise.t_of_js (fun (x40 : Ojs.t) -> Ojs.list_of_js Ojs.string_of_js x40) - (Ojs.call (Ojs.get_prop_ascii Imports.fs "promises") "readdir" - [|(Ojs.string_to_js x39)|]) + (Ojs.call + (Ojs.get_prop_ascii (Jsoo_runtime.Sys.external_ "node_fs") + "promises") "readdir" [|(Ojs.string_to_js x39)|]) let (open_ : string -> flag:string -> FileHandle.t Promise.t) = fun (x42 : string) -> fun ~flag:(x43 : string) -> Promise.t_of_js FileHandle.t_of_js - (Ojs.call (Ojs.get_prop_ascii Imports.fs "promises") "open" + (Ojs.call + (Ojs.get_prop_ascii (Jsoo_runtime.Sys.external_ "node_fs") + "promises") "open" [|(Ojs.string_to_js x42);(Ojs.string_to_js x43)|]) let (rmdir : string -> unit Promise.t) = fun (x45 : string) -> Promise.t_of_js Ojs.unit_of_js - (Ojs.call (Ojs.get_prop_ascii Imports.fs "promises") "rmdir" - [|(Ojs.string_to_js x45)|]) + (Ojs.call + (Ojs.get_prop_ascii (Jsoo_runtime.Sys.external_ "node_fs") + "promises") "rmdir" [|(Ojs.string_to_js x45)|]) let (rename : string -> string -> unit Promise.t) = fun (x47 : string) -> fun (x48 : string) -> Promise.t_of_js Ojs.unit_of_js - (Ojs.call (Ojs.get_prop_ascii Imports.fs "promises") "rename" + (Ojs.call + (Ojs.get_prop_ascii (Jsoo_runtime.Sys.external_ "node_fs") + "promises") "rename" [|(Ojs.string_to_js x47);(Ojs.string_to_js x48)|]) let (unlink : string -> unit Promise.t) = fun (x50 : string) -> Promise.t_of_js Ojs.unit_of_js - (Ojs.call (Ojs.get_prop_ascii Imports.fs "promises") "unlink" - [|(Ojs.string_to_js x50)|]) + (Ojs.call + (Ojs.get_prop_ascii (Jsoo_runtime.Sys.external_ "node_fs") + "promises") "unlink" [|(Ojs.string_to_js x50)|]) diff --git a/node-test/bindings/expected/imports.ml b/node-test/bindings/expected/imports.ml index ec5d3f67..6421f4fe 100644 --- a/node-test/bindings/expected/imports.ml +++ b/node-test/bindings/expected/imports.ml @@ -1,8 +1,3 @@ [@@@js.dummy "!! This code has been generated by gen_js_api !!"] [@@@ocaml.warning "-7-32-39"] -let (path : Ojs.t) = - Ojs.get_prop_ascii (Ojs.get_prop_ascii Ojs.global "__LIB__NODE__IMPORTS") - "path" -let (fs : Ojs.t) = - Ojs.get_prop_ascii (Ojs.get_prop_ascii Ojs.global "__LIB__NODE__IMPORTS") - "fs" +let (path : Ojs.t) = Jsoo_runtime.Sys.external_ "node_path" diff --git a/node-test/bindings/fs.mli b/node-test/bindings/fs.mli index 67b4b17c..a23fe677 100644 --- a/node-test/bindings/fs.mli +++ b/node-test/bindings/fs.mli @@ -1,4 +1,4 @@ -[@@@js.scope (Imports.fs, "promises")] +[@@@js.scope "@node_fs.promises"] module Dirent : sig type t = Ojs.t diff --git a/node-test/bindings/imports.js b/node-test/bindings/imports.js index 5f63e5a7..904d9516 100644 --- a/node-test/bindings/imports.js +++ b/node-test/bindings/imports.js @@ -1,4 +1,5 @@ -globalThis.__LIB__NODE__IMPORTS = { - path: require('path'), - fs: require('fs'), -}; +//Provides: node_path +var node_path = require('path'); + +//Provides: node_fs +var node_fs = require('fs'); diff --git a/node-test/bindings/imports.mli b/node-test/bindings/imports.mli index 9438019a..cf443b8c 100644 --- a/node-test/bindings/imports.mli +++ b/node-test/bindings/imports.mli @@ -1,4 +1 @@ -[@@@js.scope "__LIB__NODE__IMPORTS"] - -val path: Ojs.t [@@js.global] -val fs: Ojs.t [@@js.global] +val path: Ojs.t [@@js.runtime "node_path"] diff --git a/ppx-lib/gen_js_api_ppx.ml b/ppx-lib/gen_js_api_ppx.ml index 222d5153..8f6aad3a 100644 --- a/ppx-lib/gen_js_api_ppx.ml +++ b/ppx-lib/gen_js_api_ppx.ml @@ -296,6 +296,7 @@ type apply_type = | NewableFunction (* new f(..) *) type valdef = + | Runtime of string | Cast | Ignore | PropGet of string @@ -311,6 +312,7 @@ type valdef = | Auto of valdef let rec string_of_valdef = function + | Runtime _ -> "js.runtime" | Cast -> "js.cast" | Ignore -> "js.ignore" | PropGet _ -> "js.get" @@ -569,6 +571,7 @@ let parse_attr ~global_attrs (s, loc, auto) attribute = in let actions = [ "js.cast", (fun () -> Cast); + "js.runtime", (fun () -> Runtime (opt_name ())); "js.get", (fun () -> PropGet (opt_name ())); "js.set", (fun () -> PropSet (opt_name ~prefix:"set_" ())); "js.index_get", (fun () -> IndexGet); @@ -892,18 +895,31 @@ let ojs_set o s v = else ojs "set_prop" [o; ojs "string_to_js" [str s]; v] +let rec select_split_path o = function + | [] -> assert false + | [x] -> o, x + | x :: xs -> select_split_path (ojs_get o x) xs + let select_path o s = - let rec select_path o = function - | [] -> assert false - | [x] -> o, x - | x :: xs -> select_path (ojs_get o x) xs - in - select_path o (split '.' s) + select_split_path o (split '.' s) let get_path global_object s = let o, x = select_path global_object s in ojs_get o x +let runtime s = + let external_ = Exp.ident (mknoloc (longident_parse "Jsoo_runtime.Sys.external_")) in + match split '.' s with + | s :: tl -> + let root = Exp.apply external_ (nolabel [Exp.constant (Pconst_string (s, Location.none, None))]) in + begin match tl with + | [] -> root + | _ -> + let o, x = select_split_path root tl in + ojs_get o x + end + | [] -> assert false + let ojs_variable s = get_path ojs_global s @@ -1602,15 +1618,20 @@ let global_object ~global_attrs = | hd :: tl -> begin match get_expr_attribute "js.scope" [hd] with | None -> traverse tl - | Some {pexp_desc=Pexp_constant (Pconst_string (prop, _, _)); _} -> ojs_get (traverse tl) prop + | Some {pexp_desc=Pexp_constant (Pconst_string (prop, _, _)); _} -> + if String.length prop > 0 && prop.[0] = '@' then + runtime (String.sub prop 1 (String.length prop - 1)) + else + get_path (traverse tl) prop + | Some {pexp_desc=Pexp_tuple path; _} -> - let init = traverse tl in - let folder state pexp = - match pexp.pexp_desc with - | Pexp_constant (Pconst_string (prop, _, _)) -> ojs_get state prop - | _ -> pexp (* global object *) - in - List.fold_left folder init path + let init = traverse tl in + let folder state pexp = + match pexp.pexp_desc with + | Pexp_constant (Pconst_string (prop, _, _)) -> get_path state prop + | _ -> pexp (* global object *) + in + List.fold_left folder init path | Some global_object -> global_object end in @@ -1908,6 +1929,9 @@ and gen_class_cast = function and gen_def ~global_object loc decl ty = match decl, ty with + | Runtime s, _ -> + js2ml ty (runtime s) + | Cast, Arrow {ty_args = [{lab=Arg; att=_; typ}]; ty_vararg = None; unit_arg = false; ty_res} -> mkfun ~typ (fun this -> js2ml ty_res (ml2js typ this)) From edd13ffc97bff762508d149b93f281b529e9a5e4 Mon Sep 17 00:00:00 2001 From: Hugo Heuzard Date: Mon, 3 Nov 2025 13:07:08 +0100 Subject: [PATCH 2/4] Adapt PR @hhugo --- dune-project | 2 +- gen_js_api.opam | 2 +- lib/ojs.mli | 2 +- node-test/bindings/dune | 4 +- node-test/bindings/expected/arrays.ml | 27 ++-- node-test/bindings/expected/buffer.ml | 24 ++-- node-test/bindings/expected/console.ml | 8 +- node-test/bindings/expected/errors.ml | 16 +-- node-test/bindings/expected/fs.ml | 62 ++++----- node-test/bindings/expected/global.ml | 16 +-- node-test/bindings/expected/imports.ml | 2 +- node-test/bindings/expected/number.ml | 53 ++++---- node-test/bindings/expected/path.ml | 18 +-- node-test/bindings/expected/process.ml | 4 +- node-test/bindings/expected/promise.ml | 23 ++-- node-test/bindings/imports.wat | 3 + node-test/bindings/number.mli | 2 +- node-test/test1/dune | 10 +- node-test/test1/recursive.js | 2 + node-test/test1/test.ml | 37 +++--- ojs.opam | 2 +- ppx-lib/gen_js_api_ppx.ml | 4 +- ppx-test/expected/binding.ml | 46 +++---- ppx-test/expected/binding_automatic.ml | 40 +++--- ppx-test/expected/first_class_modules.ml | 42 +++--- ppx-test/expected/issues.ml | 68 +++++----- ppx-test/expected/issues_mli.ml | 6 +- ppx-test/expected/modules.ml | 8 +- ppx-test/expected/recursive_modules.ml | 20 +-- ppx-test/expected/scoped.ml | 32 ++--- ppx-test/expected/types.ml | 159 +++++++++++------------ ppx-test/expected/union_and_enum.ml | 102 +++++++-------- 32 files changed, 428 insertions(+), 418 deletions(-) create mode 100644 node-test/bindings/imports.wat diff --git a/dune-project b/dune-project index 0d5217b6..c11a68c2 100644 --- a/dune-project +++ b/dune-project @@ -1,4 +1,4 @@ -(lang dune 3.0) +(lang dune 3.17) (name gen_js_api) (version 1.1.5) diff --git a/gen_js_api.opam b/gen_js_api.opam index 797ad294..07d329a3 100644 --- a/gen_js_api.opam +++ b/gen_js_api.opam @@ -20,7 +20,7 @@ license: "MIT" homepage: "https://github.com/LexiFi/gen_js_api" bug-reports: "https://github.com/LexiFi/gen_js_api/issues" depends: [ - "dune" {>= "3.0"} + "dune" {>= "3.17"} "ocaml" {>= "4.08"} "ppxlib" {>= "0.26"} "js_of_ocaml-compiler" {with-test} diff --git a/lib/ojs.mli b/lib/ojs.mli index 817d743d..85b413da 100644 --- a/lib/ojs.mli +++ b/lib/ojs.mli @@ -163,4 +163,4 @@ module Bool : T with type t = bool module Float : T with type t = float module Array (A: T) : T with type t = A.t array module List (A: T) : T with type t = A.t list -module Option (A: T) : T with type t = A.t option \ No newline at end of file +module Option (A: T) : T with type t = A.t option diff --git a/node-test/bindings/dune b/node-test/bindings/dune index ef8c2e97..949cd381 100644 --- a/node-test/bindings/dune +++ b/node-test/bindings/dune @@ -6,7 +6,9 @@ (pps gen_js_api.ppx)) (modes byte) (js_of_ocaml - (javascript_files imports.js))) + (javascript_files imports.js)) + (wasm_of_ocaml + (javascript_files imports.js imports.wat))) (rule (targets imports.ml) diff --git a/node-test/bindings/expected/arrays.ml b/node-test/bindings/expected/arrays.ml index 74827241..b6335500 100644 --- a/node-test/bindings/expected/arrays.ml +++ b/node-test/bindings/expected/arrays.ml @@ -3,16 +3,16 @@ module JsArray(E:Ojs.T) = struct type t = Ojs.t - let rec (t_of_js : Ojs.t -> t) = fun (x2 : Ojs.t) -> x2 - and (t_to_js : t -> Ojs.t) = fun (x1 : Ojs.t) -> x1 - let (create : unit -> t) = + let rec t_of_js : Ojs.t -> t = fun (x2 : Ojs.t) -> x2 + and t_to_js : t -> Ojs.t = fun (x1 : Ojs.t) -> x1 + let create : unit -> t = fun () -> t_of_js (Ojs.new_obj (Ojs.get_prop_ascii Ojs.global "Array") [||]) - let (push : t -> E.t -> unit) = + let push : t -> E.t -> unit = fun (x4 : t) -> fun (x3 : E.t) -> ignore (Ojs.call (t_to_js x4) "push" [|(E.t_to_js x3)|]) - let (pop : t -> E.t option) = + let pop : t -> E.t option = fun (x5 : t) -> Ojs.option_of_js E.t_of_js (Ojs.call (t_to_js x5) "pop" [||]) end @@ -20,7 +20,7 @@ module UntypedArray = struct include (JsArray)(Ojs) end module StringArray = struct include (JsArray)(Ojs.String) - let (join : t -> string -> string) = + let join : t -> string -> string = fun (x8 : t) -> fun (x7 : string) -> Ojs.string_of_js @@ -35,11 +35,11 @@ module JsArray2 = and t_to_js : 'a . ('a -> Ojs.t) -> 'a t -> Ojs.t = fun (type __a) -> fun (__a_to_js : __a -> Ojs.t) -> fun (x9 : Ojs.t) -> x9 - let (create : unit -> 'a t) = + let create : unit -> 'a t = fun () -> t_of_js Obj.magic (Ojs.new_obj (Ojs.get_prop_ascii Ojs.global "Array") [||]) - let (create' : (module Ojs.T with type t = 'a) -> 'a list -> 'a t) = + let create' : (module Ojs.T with type t = 'a) -> 'a list -> 'a t = fun (type a) -> fun ((module A) : (module Ojs.T with type t = a)) -> fun (x12 : a list) -> @@ -51,35 +51,34 @@ module JsArray2 = (fun (x14 : a) -> ignore (Ojs.call x13 "push" [|(A.t_to_js x14)|])) x12; x13)) - let (push : (module Ojs.T with type t = 'a) -> 'a t -> 'a -> unit) = + let push : (module Ojs.T with type t = 'a) -> 'a t -> 'a -> unit = fun (type a) -> fun ((module A) : (module Ojs.T with type t = a)) -> fun (x17 : a t) -> fun (x16 : a) -> ignore (Ojs.call (t_to_js A.t_to_js x17) "push" [|(A.t_to_js x16)|]) - let (pop : (module Ojs.T with type t = 'a) -> 'a t -> 'a option) = + let pop : (module Ojs.T with type t = 'a) -> 'a t -> 'a option = fun (type a) -> fun ((module A) : (module Ojs.T with type t = a)) -> fun (x19 : a t) -> Ojs.option_of_js A.t_of_js (Ojs.call (t_to_js A.t_to_js x19) "pop" [||]) - let (get : (module Ojs.T with type t = 'a) -> 'a t -> int -> 'a option) = + let get : (module Ojs.T with type t = 'a) -> 'a t -> int -> 'a option = fun (type a) -> fun ((module A) : (module Ojs.T with type t = a)) -> fun (x22 : a t) -> fun (x24 : int) -> Ojs.option_of_js A.t_of_js (Ojs.array_get (t_to_js A.t_to_js x22) x24) - let (set : (module Ojs.T with type t = 'a) -> 'a t -> int -> 'a -> unit) - = + let set : (module Ojs.T with type t = 'a) -> 'a t -> int -> 'a -> unit = fun (type a) -> fun ((module A) : (module Ojs.T with type t = a)) -> fun (x26 : a t) -> fun (x28 : int) -> fun (x29 : a) -> Ojs.array_set (t_to_js A.t_to_js x26) x28 (A.t_to_js x29) - let (join : string t -> string -> string) = + let join : string t -> string -> string = fun (x31 : string t) -> fun (x30 : string) -> Ojs.string_of_js diff --git a/node-test/bindings/expected/buffer.ml b/node-test/bindings/expected/buffer.ml index 4b39fbea..00ad086c 100644 --- a/node-test/bindings/expected/buffer.ml +++ b/node-test/bindings/expected/buffer.ml @@ -1,48 +1,48 @@ [@@@js.dummy "!! This code has been generated by gen_js_api !!"] [@@@ocaml.warning "-7-32-39"] type t = Ojs.t -let rec (t_of_js : Ojs.t -> t) = fun (x2 : Ojs.t) -> x2 -and (t_to_js : t -> Ojs.t) = fun (x1 : Ojs.t) -> x1 -let (alloc : int -> t) = +let rec t_of_js : Ojs.t -> t = fun (x2 : Ojs.t) -> x2 +and t_to_js : t -> Ojs.t = fun (x1 : Ojs.t) -> x1 +let alloc : int -> t = fun (x3 : int) -> t_of_js (Ojs.call (Ojs.get_prop_ascii Ojs.global "Buffer") "alloc" [|(Ojs.int_to_js x3)|]) -let (from : string -> t) = +let from : string -> t = fun (x4 : string) -> t_of_js (Ojs.call (Ojs.get_prop_ascii Ojs.global "Buffer") "from" [|(Ojs.string_to_js x4)|]) -let (concat : t list -> t) = +let concat : t list -> t = fun (x5 : t list) -> t_of_js (Ojs.call (Ojs.get_prop_ascii Ojs.global "Buffer") "concat" [|(Ojs.list_to_js t_to_js x5)|]) -let (length : t -> int) = +let length : t -> int = fun (x7 : t) -> Ojs.int_of_js (Ojs.get_prop_ascii (t_to_js x7) "length") -let (get : t -> int -> int option) = +let get : t -> int -> int option = fun (x8 : t) -> fun (x9 : int) -> Ojs.option_of_js Ojs.int_of_js (Ojs.array_get (t_to_js x8) x9) -let (set : t -> int -> int -> unit) = +let set : t -> int -> int -> unit = fun (x11 : t) -> fun (x12 : int) -> fun (x13 : int) -> Ojs.array_set (t_to_js x11) x12 (Ojs.int_to_js x13) -let (write : t -> string -> int) = +let write : t -> string -> int = fun (x15 : t) -> fun (x14 : string) -> Ojs.int_of_js (Ojs.call (t_to_js x15) "write" [|(Ojs.string_to_js x14)|]) -let (slice : t -> int -> int -> t) = +let slice : t -> int -> int -> t = fun (x18 : t) -> fun (x16 : int) -> fun (x17 : int) -> t_of_js (Ojs.call (t_to_js x18) "slice" [|(Ojs.int_to_js x16);(Ojs.int_to_js x17)|]) -let (to_string : t -> string) = +let to_string : t -> string = fun (x19 : t) -> Ojs.string_of_js (Ojs.call (t_to_js x19) "toString" [||]) -let (copy : t -> dst:t -> start:int -> dst_start:int -> dst_end:int -> int) = +let copy : t -> dst:t -> start:int -> dst_start:int -> dst_end:int -> int = fun (x24 : t) -> fun ~dst:(x20 : t) -> fun ~start:(x21 : int) -> diff --git a/node-test/bindings/expected/console.ml b/node-test/bindings/expected/console.ml index d8bd3f15..c974d20f 100644 --- a/node-test/bindings/expected/console.ml +++ b/node-test/bindings/expected/console.ml @@ -1,25 +1,25 @@ [@@@js.dummy "!! This code has been generated by gen_js_api !!"] [@@@ocaml.warning "-7-32-39"] -let (log : 'a -> unit) = +let log : 'a -> unit = fun (x1 : 'a) -> ignore (Ojs.call (Ojs.get_prop_ascii Ojs.global "console") "log" [|(Obj.magic x1)|]) -let (error : 'a -> unit) = +let error : 'a -> unit = fun (x2 : 'a) -> ignore (Ojs.call (Ojs.get_prop_ascii Ojs.global "console") "error" [|(Obj.magic x2)|]) module T = struct - let (log : (module Ojs.T with type t = 'a) -> 'a -> unit) = + let log : (module Ojs.T with type t = 'a) -> 'a -> unit = fun (type a) -> fun ((module A) : (module Ojs.T with type t = a)) -> fun (x3 : a) -> ignore (Ojs.call (Ojs.get_prop_ascii Ojs.global "console") "log" [|(A.t_to_js x3)|]) - let (error : (module Ojs.T with type t = 'a) -> 'a -> unit) = + let error : (module Ojs.T with type t = 'a) -> 'a -> unit = fun (type a) -> fun ((module A) : (module Ojs.T with type t = a)) -> fun (x4 : a) -> diff --git a/node-test/bindings/expected/errors.ml b/node-test/bindings/expected/errors.ml index 130ca343..851688a2 100644 --- a/node-test/bindings/expected/errors.ml +++ b/node-test/bindings/expected/errors.ml @@ -3,28 +3,28 @@ module Error = struct type t = Ojs.t - let rec (t_of_js : Ojs.t -> t) = fun (x2 : Ojs.t) -> x2 - and (t_to_js : t -> Ojs.t) = fun (x1 : Ojs.t) -> x1 - let (create : string -> t) = + let rec t_of_js : Ojs.t -> t = fun (x2 : Ojs.t) -> x2 + and t_to_js : t -> Ojs.t = fun (x1 : Ojs.t) -> x1 + let create : string -> t = fun (x3 : string) -> t_of_js (Ojs.new_obj (Ojs.get_prop_ascii Ojs.global "Error") [|(Ojs.string_to_js x3)|]) - let (stack_trace_limit : int) = + let stack_trace_limit : int = Ojs.int_of_js (Ojs.get_prop_ascii (Ojs.get_prop_ascii Ojs.global "Error") "stackTraceLimit") - let (set_stack_trace_limit : int -> unit) = + let set_stack_trace_limit : int -> unit = fun (x4 : int) -> Ojs.set_prop_ascii (Ojs.get_prop_ascii Ojs.global "Error") "stackTraceLimit" (Ojs.int_to_js x4) - let (code : t -> string) = + let code : t -> string = fun (x5 : t) -> Ojs.string_of_js (Ojs.get_prop_ascii (t_to_js x5) "code") - let (message : t -> string) = + let message : t -> string = fun (x6 : t) -> Ojs.string_of_js (Ojs.get_prop_ascii (t_to_js x6) "message") - let (stack : t -> string) = + let stack : t -> string = fun (x7 : t) -> Ojs.string_of_js (Ojs.get_prop_ascii (t_to_js x7) "stack") end diff --git a/node-test/bindings/expected/fs.ml b/node-test/bindings/expected/fs.ml index 232f0faa..513421c2 100644 --- a/node-test/bindings/expected/fs.ml +++ b/node-test/bindings/expected/fs.ml @@ -3,29 +3,29 @@ module Dirent = struct type t = Ojs.t - let rec (t_of_js : Ojs.t -> t) = fun (x2 : Ojs.t) -> x2 - and (t_to_js : t -> Ojs.t) = fun (x1 : Ojs.t) -> x1 - let (name : t -> string) = + let rec t_of_js : Ojs.t -> t = fun (x2 : Ojs.t) -> x2 + and t_to_js : t -> Ojs.t = fun (x1 : Ojs.t) -> x1 + let name : t -> string = fun (x3 : t) -> Ojs.string_of_js (Ojs.get_prop_ascii (t_to_js x3) "name") - let (is_file : t -> bool) = + let is_file : t -> bool = fun (x4 : t) -> Ojs.bool_of_js (Ojs.call (t_to_js x4) "isFile" [||]) - let (is_directory : t -> bool) = + let is_directory : t -> bool = fun (x5 : t) -> Ojs.bool_of_js (Ojs.call (t_to_js x5) "isDirectory" [||]) end module Dir = struct type t = Ojs.t - let rec (t_of_js : Ojs.t -> t) = fun (x7 : Ojs.t) -> x7 - and (t_to_js : t -> Ojs.t) = fun (x6 : Ojs.t) -> x6 - let (path : t -> string) = + let rec t_of_js : Ojs.t -> t = fun (x7 : Ojs.t) -> x7 + and t_to_js : t -> Ojs.t = fun (x6 : Ojs.t) -> x6 + let path : t -> string = fun (x8 : t) -> Ojs.string_of_js (Ojs.get_prop_ascii (t_to_js x8) "path") - let (close : t -> unit Promise.t) = + let close : t -> unit Promise.t = fun (x9 : t) -> Promise.t_of_js Ojs.unit_of_js (Ojs.call (t_to_js x9) "close" [||]) - let (read : t -> Dirent.t option Promise.t) = + let read : t -> Dirent.t option Promise.t = fun (x11 : t) -> Promise.t_of_js (fun (x12 : Ojs.t) -> Ojs.option_of_js Dirent.t_of_js x12) @@ -34,29 +34,29 @@ module Dir = module FileHandle = struct type t = Ojs.t - let rec (t_of_js : Ojs.t -> t) = fun (x15 : Ojs.t) -> x15 - and (t_to_js : t -> Ojs.t) = fun (x14 : Ojs.t) -> x14 + let rec t_of_js : Ojs.t -> t = fun (x15 : Ojs.t) -> x15 + and t_to_js : t -> Ojs.t = fun (x14 : Ojs.t) -> x14 type read = { bytes_read: int ; buffer: Buffer.t } - let rec (read_of_js : Ojs.t -> read) = + let rec read_of_js : Ojs.t -> read = fun (x17 : Ojs.t) -> { bytes_read = (Ojs.int_of_js (Ojs.get_prop_ascii x17 "bytesRead")); buffer = (Buffer.t_of_js (Ojs.get_prop_ascii x17 "buffer")) } - and (read_to_js : read -> Ojs.t) = + and read_to_js : read -> Ojs.t = fun (x16 : read) -> Ojs.obj [|("bytesRead", (Ojs.int_to_js x16.bytes_read));("buffer", (Buffer.t_to_js x16.buffer))|] - let (append_file : t -> Buffer.t -> unit Promise.t) = + let append_file : t -> Buffer.t -> unit Promise.t = fun (x19 : t) -> fun (x18 : Buffer.t) -> Promise.t_of_js Ojs.unit_of_js (Ojs.call (t_to_js x19) "appendFile" [|(Buffer.t_to_js x18)|]) - let (read : t -> Buffer.t -> int -> int -> int -> read Promise.t) = + let read : t -> Buffer.t -> int -> int -> int -> read Promise.t = fun (x25 : t) -> fun (x21 : Buffer.t) -> fun (x22 : int) -> @@ -67,60 +67,60 @@ module FileHandle = [|(Buffer.t_to_js x21);(Ojs.int_to_js x22);(Ojs.int_to_js x23);( Ojs.int_to_js x24)|]) - let (chmod : t -> int -> unit Promise.t) = + let chmod : t -> int -> unit Promise.t = fun (x28 : t) -> fun (x27 : int) -> Promise.t_of_js Ojs.unit_of_js (Ojs.call (t_to_js x28) "chmod" [|(Ojs.int_to_js x27)|]) - let (chmown : t -> uid:int -> gid:int -> unit Promise.t) = + let chmown : t -> uid:int -> gid:int -> unit Promise.t = fun (x32 : t) -> fun ~uid:(x30 : int) -> fun ~gid:(x31 : int) -> Promise.t_of_js Ojs.unit_of_js (Ojs.call (t_to_js x32) "chmown" [|(Ojs.int_to_js x30);(Ojs.int_to_js x31)|]) - let (close : t -> unit Promise.t) = + let close : t -> unit Promise.t = fun (x34 : t) -> Promise.t_of_js Ojs.unit_of_js (Ojs.call (t_to_js x34) "close" [||]) - let (datasync : t -> unit Promise.t) = + let datasync : t -> unit Promise.t = fun (x36 : t) -> Promise.t_of_js Ojs.unit_of_js (Ojs.call (t_to_js x36) "datasync" [||]) - let (fd : t -> int) = + let fd : t -> int = fun (x38 : t) -> Ojs.int_of_js (Ojs.get_prop_ascii (t_to_js x38) "fd") end -let (readdir : string -> string list Promise.t) = +let readdir : string -> string list Promise.t = fun (x39 : string) -> Promise.t_of_js (fun (x40 : Ojs.t) -> Ojs.list_of_js Ojs.string_of_js x40) (Ojs.call - (Ojs.get_prop_ascii (Jsoo_runtime.Sys.external_ "node_fs") + (Ojs.get_prop_ascii (Jsoo_runtime.Js.runtime_value "node_fs") "promises") "readdir" [|(Ojs.string_to_js x39)|]) -let (open_ : string -> flag:string -> FileHandle.t Promise.t) = +let open_ : string -> flag:string -> FileHandle.t Promise.t = fun (x42 : string) -> fun ~flag:(x43 : string) -> Promise.t_of_js FileHandle.t_of_js (Ojs.call - (Ojs.get_prop_ascii (Jsoo_runtime.Sys.external_ "node_fs") + (Ojs.get_prop_ascii (Jsoo_runtime.Js.runtime_value "node_fs") "promises") "open" [|(Ojs.string_to_js x42);(Ojs.string_to_js x43)|]) -let (rmdir : string -> unit Promise.t) = +let rmdir : string -> unit Promise.t = fun (x45 : string) -> Promise.t_of_js Ojs.unit_of_js (Ojs.call - (Ojs.get_prop_ascii (Jsoo_runtime.Sys.external_ "node_fs") + (Ojs.get_prop_ascii (Jsoo_runtime.Js.runtime_value "node_fs") "promises") "rmdir" [|(Ojs.string_to_js x45)|]) -let (rename : string -> string -> unit Promise.t) = +let rename : string -> string -> unit Promise.t = fun (x47 : string) -> fun (x48 : string) -> Promise.t_of_js Ojs.unit_of_js (Ojs.call - (Ojs.get_prop_ascii (Jsoo_runtime.Sys.external_ "node_fs") + (Ojs.get_prop_ascii (Jsoo_runtime.Js.runtime_value "node_fs") "promises") "rename" [|(Ojs.string_to_js x47);(Ojs.string_to_js x48)|]) -let (unlink : string -> unit Promise.t) = +let unlink : string -> unit Promise.t = fun (x50 : string) -> Promise.t_of_js Ojs.unit_of_js (Ojs.call - (Ojs.get_prop_ascii (Jsoo_runtime.Sys.external_ "node_fs") + (Ojs.get_prop_ascii (Jsoo_runtime.Js.runtime_value "node_fs") "promises") "unlink" [|(Ojs.string_to_js x50)|]) diff --git a/node-test/bindings/expected/global.ml b/node-test/bindings/expected/global.ml index 75712063..aea93498 100644 --- a/node-test/bindings/expected/global.ml +++ b/node-test/bindings/expected/global.ml @@ -1,26 +1,26 @@ [@@@js.dummy "!! This code has been generated by gen_js_api !!"] [@@@ocaml.warning "-7-32-39"] type timeout_id = Ojs.t -let rec (timeout_id_of_js : Ojs.t -> timeout_id) = fun (x2 : Ojs.t) -> x2 -and (timeout_id_to_js : timeout_id -> Ojs.t) = fun (x1 : Ojs.t) -> x1 +let rec timeout_id_of_js : Ojs.t -> timeout_id = fun (x2 : Ojs.t) -> x2 +and timeout_id_to_js : timeout_id -> Ojs.t = fun (x1 : Ojs.t) -> x1 type interval_id = Ojs.t -let rec (interval_id_of_js : Ojs.t -> interval_id) = fun (x4 : Ojs.t) -> x4 -and (interval_id_to_js : interval_id -> Ojs.t) = fun (x3 : Ojs.t) -> x3 -let (set_interval : (unit -> unit) -> int -> interval_id) = +let rec interval_id_of_js : Ojs.t -> interval_id = fun (x4 : Ojs.t) -> x4 +and interval_id_to_js : interval_id -> Ojs.t = fun (x3 : Ojs.t) -> x3 +let set_interval : (unit -> unit) -> int -> interval_id = fun (x5 : unit -> unit) -> fun (x6 : int) -> interval_id_of_js (Ojs.call Ojs.global "setInterval" [|(Ojs.fun_to_js 1 (fun _ -> x5 ()));(Ojs.int_to_js x6)|]) -let (set_timeout : (unit -> unit) -> int -> timeout_id) = +let set_timeout : (unit -> unit) -> int -> timeout_id = fun (x7 : unit -> unit) -> fun (x8 : int) -> timeout_id_of_js (Ojs.call Ojs.global "setTimeout" [|(Ojs.fun_to_js 1 (fun _ -> x7 ()));(Ojs.int_to_js x8)|]) -let (clear_timeout : timeout_id -> unit) = +let clear_timeout : timeout_id -> unit = fun (x9 : timeout_id) -> ignore (Ojs.call Ojs.global "clearTimeout" [|(timeout_id_to_js x9)|]) -let (clear_interval : interval_id -> unit) = +let clear_interval : interval_id -> unit = fun (x10 : interval_id) -> ignore (Ojs.call Ojs.global "clearInterval" [|(interval_id_to_js x10)|]) diff --git a/node-test/bindings/expected/imports.ml b/node-test/bindings/expected/imports.ml index 6421f4fe..d0d4aba3 100644 --- a/node-test/bindings/expected/imports.ml +++ b/node-test/bindings/expected/imports.ml @@ -1,3 +1,3 @@ [@@@js.dummy "!! This code has been generated by gen_js_api !!"] [@@@ocaml.warning "-7-32-39"] -let (path : Ojs.t) = Jsoo_runtime.Sys.external_ "node_path" +let path : Ojs.t = Jsoo_runtime.Js.runtime_value "node_path" diff --git a/node-test/bindings/expected/number.ml b/node-test/bindings/expected/number.ml index e901532c..ab9b4c06 100644 --- a/node-test/bindings/expected/number.ml +++ b/node-test/bindings/expected/number.ml @@ -1,9 +1,9 @@ [@@@js.dummy "!! This code has been generated by gen_js_api !!"] [@@@ocaml.warning "-7-32-39"] type t = Ojs.t -let rec (t_of_js : Ojs.t -> t) = fun (x2 : Ojs.t) -> x2 -and (t_to_js : t -> Ojs.t) = fun (x1 : Ojs.t) -> x1 -let (toString : t -> ?radix:int -> unit -> float) = +let rec t_of_js : Ojs.t -> t = fun (x2 : Ojs.t) -> x2 +and t_to_js : t -> Ojs.t = fun (x1 : Ojs.t) -> x1 +let toString : t -> ?radix:int -> unit -> float = fun (x6 : t) -> fun ?radix:(x3 : int option) -> fun () -> @@ -18,7 +18,7 @@ let (toString : t -> ?radix:int -> unit -> float) = ignore (Ojs.call x4 "push" [|(Ojs.int_to_js x5)|]) | None -> ()); x4))|]) -let (toFixed : t -> ?fractionDigits:int -> unit -> float) = +let toFixed : t -> ?fractionDigits:int -> unit -> float = fun (x11 : t) -> fun ?fractionDigits:(x8 : int option) -> fun () -> @@ -33,7 +33,7 @@ let (toFixed : t -> ?fractionDigits:int -> unit -> float) = ignore (Ojs.call x9 "push" [|(Ojs.int_to_js x10)|]) | None -> ()); x9))|]) -let (toExponential : t -> ?fractionDigits:int -> unit -> float) = +let toExponential : t -> ?fractionDigits:int -> unit -> float = fun (x16 : t) -> fun ?fractionDigits:(x13 : int option) -> fun () -> @@ -49,7 +49,7 @@ let (toExponential : t -> ?fractionDigits:int -> unit -> float) = (Ojs.call x14 "push" [|(Ojs.int_to_js x15)|]) | None -> ()); x14))|]) -let (toPrecision : t -> ?precision:int -> unit -> float) = +let toPrecision : t -> ?precision:int -> unit -> float = fun (x21 : t) -> fun ?precision:(x18 : int option) -> fun () -> @@ -65,36 +65,36 @@ let (toPrecision : t -> ?precision:int -> unit -> float) = (Ojs.call x19 "push" [|(Ojs.int_to_js x20)|]) | None -> ()); x19))|]) -let (valueOf : t -> float) = +let valueOf : t -> float = fun (x23 : t) -> Ojs.float_of_js (Ojs.call (t_to_js x23) "valueOf" [||]) module Scoped = struct - let (create : 'any -> t) = + let create : 'any -> t = fun (x24 : 'any) -> t_of_js (Ojs.new_obj (Ojs.get_prop_ascii Ojs.global "Number") [|(Obj.magic x24)|]) - let (invoke : 'any -> float) = + let invoke : 'any -> float = fun (x25 : 'any) -> Ojs.float_of_js (Ojs.apply (Ojs.get_prop_ascii Ojs.global "Number") [|(Obj.magic x25)|]) - let (min_value : float) = + let min_value : float = Ojs.float_of_js (Ojs.get_prop_ascii (Ojs.get_prop_ascii Ojs.global "Number") "MIN_VALUE") - let (max_value : float) = + let max_value : float = Ojs.float_of_js (Ojs.get_prop_ascii (Ojs.get_prop_ascii Ojs.global "Number") "MAX_VALUE") - let (nan : float) = + let nan : float = Ojs.float_of_js (Ojs.get_prop_ascii (Ojs.get_prop_ascii Ojs.global "Number") "NaN") - let (negative_infinity : float) = + let negative_infinity : float = Ojs.float_of_js (Ojs.get_prop_ascii (Ojs.get_prop_ascii Ojs.global "Number") "NEGATIVE_INFINITY") - let (positive_infinity : float) = + let positive_infinity : float = Ojs.float_of_js (Ojs.get_prop_ascii (Ojs.get_prop_ascii Ojs.global "Number") "POSITIVE_INFINITY") @@ -102,37 +102,36 @@ module Scoped = module Static = struct type number = t - let rec (number_of_js : Ojs.t -> number) = - fun (x27 : Ojs.t) -> t_of_js x27 - and (number_to_js : number -> Ojs.t) = fun (x26 : t) -> t_to_js x26 + let rec number_of_js : Ojs.t -> number = fun (x27 : Ojs.t) -> t_of_js x27 + and number_to_js : number -> Ojs.t = fun (x26 : t) -> t_to_js x26 type t = Ojs.t - let rec (t_of_js : Ojs.t -> t) = fun (x29 : Ojs.t) -> x29 - and (t_to_js : t -> Ojs.t) = fun (x28 : Ojs.t) -> x28 - let (create : t -> 'any -> number) = + let rec t_of_js : Ojs.t -> t = fun (x29 : Ojs.t) -> x29 + and t_to_js : t -> Ojs.t = fun (x28 : Ojs.t) -> x28 + let create : t -> 'any -> number = fun (x31 : t) -> fun (x30 : 'any) -> number_of_js (Ojs.new_obj (t_to_js x31) [|(Obj.magic x30)|]) - let (apply : t -> 'any -> float) = + let apply : t -> 'any -> float = fun (x33 : t) -> fun (x32 : 'any) -> Ojs.float_of_js (Ojs.apply (t_to_js x33) [|(Obj.magic x32)|]) - let (min_value : t -> float) = + let min_value : t -> float = fun (x34 : t) -> Ojs.float_of_js (Ojs.get_prop_ascii (t_to_js x34) "MIN_VALUE") - let (max_value : t -> float) = + let max_value : t -> float = fun (x35 : t) -> Ojs.float_of_js (Ojs.get_prop_ascii (t_to_js x35) "MAX_VALUE") - let (nan : t -> float) = + let nan : t -> float = fun (x36 : t) -> Ojs.float_of_js (Ojs.get_prop_ascii (t_to_js x36) "NaN") - let (negative_infinity : t -> float) = + let negative_infinity : t -> float = fun (x37 : t) -> Ojs.float_of_js (Ojs.get_prop_ascii (t_to_js x37) "NEGATIVE_INFINITY") - let (positive_infinity : t -> float) = + let positive_infinity : t -> float = fun (x38 : t) -> Ojs.float_of_js (Ojs.get_prop_ascii (t_to_js x38) "POSITIVE_INFINITY") end -let (number : Static.t) = +let number : Static.t = Static.t_of_js (Ojs.get_prop_ascii Ojs.global "Number") diff --git a/node-test/bindings/expected/path.ml b/node-test/bindings/expected/path.ml index 9fe36714..d150a216 100644 --- a/node-test/bindings/expected/path.ml +++ b/node-test/bindings/expected/path.ml @@ -1,19 +1,19 @@ [@@@js.dummy "!! This code has been generated by gen_js_api !!"] [@@@ocaml.warning "-7-32-39"] -let (sep : string) = Ojs.string_of_js (Ojs.get_prop_ascii Imports.path "sep") -let (dirname : string -> string) = +let sep : string = Ojs.string_of_js (Ojs.get_prop_ascii Imports.path "sep") +let dirname : string -> string = fun (x1 : string) -> Ojs.string_of_js (Ojs.call Imports.path "dirname" [|(Ojs.string_to_js x1)|]) -let (extname : string -> string) = +let extname : string -> string = fun (x2 : string) -> Ojs.string_of_js (Ojs.call Imports.path "extname" [|(Ojs.string_to_js x2)|]) -let (is_absolute : string -> bool) = +let is_absolute : string -> bool = fun (x3 : string) -> Ojs.bool_of_js (Ojs.call Imports.path "isAbsolute" [|(Ojs.string_to_js x3)|]) -let (join : string list -> string) = +let join : string list -> string = fun (x4 : string list) -> Ojs.string_of_js (let x7 = Imports.path in @@ -25,7 +25,7 @@ let (join : string list -> string) = ignore (Ojs.call x5 "push" [|(Ojs.string_to_js x6)|])) x4; x5))|]) -let (normalize : string -> string) = +let normalize : string -> string = fun (x8 : string) -> Ojs.string_of_js (Ojs.call Imports.path "normalize" [|(Ojs.string_to_js x8)|]) @@ -36,7 +36,7 @@ type parse_result = base: string ; name: string ; ext: string } -let rec (parse_result_of_js : Ojs.t -> parse_result) = +let rec parse_result_of_js : Ojs.t -> parse_result = fun (x10 : Ojs.t) -> { dir = (Ojs.string_of_js (Ojs.get_prop_ascii x10 "dir")); @@ -45,7 +45,7 @@ let rec (parse_result_of_js : Ojs.t -> parse_result) = name = (Ojs.string_of_js (Ojs.get_prop_ascii x10 "name")); ext = (Ojs.string_of_js (Ojs.get_prop_ascii x10 "ext")) } -and (parse_result_to_js : parse_result -> Ojs.t) = +and parse_result_to_js : parse_result -> Ojs.t = fun (x9 : parse_result) -> Ojs.obj [|("dir", (Ojs.string_to_js x9.dir));("root", @@ -53,7 +53,7 @@ and (parse_result_to_js : parse_result -> Ojs.t) = ("base", (Ojs.string_to_js x9.base));("name", (Ojs.string_to_js x9.name)); ("ext", (Ojs.string_to_js x9.ext))|] -let (parse : string -> parse_result) = +let parse : string -> parse_result = fun (x11 : string) -> parse_result_of_js (Ojs.call Imports.path "parse" [|(Ojs.string_to_js x11)|]) diff --git a/node-test/bindings/expected/process.ml b/node-test/bindings/expected/process.ml index 1848acff..51838f5c 100644 --- a/node-test/bindings/expected/process.ml +++ b/node-test/bindings/expected/process.ml @@ -1,8 +1,8 @@ [@@@js.dummy "!! This code has been generated by gen_js_api !!"] [@@@ocaml.warning "-7-32-39"] -let (env : string Container.StringMap.t) = +let env : string Container.StringMap.t = Container.StringMap.t_of_js Ojs.string_of_js (Ojs.get_prop_ascii (Ojs.get_prop_ascii Ojs.global "process") "env") -let (version : string option) = +let version : string option = Ojs.option_of_js Ojs.string_of_js (Ojs.get_prop_ascii (Ojs.get_prop_ascii Ojs.global "process") "version") diff --git a/node-test/bindings/expected/promise.ml b/node-test/bindings/expected/promise.ml index 67a08010..b2d1e5f8 100644 --- a/node-test/bindings/expected/promise.ml +++ b/node-test/bindings/expected/promise.ml @@ -3,21 +3,21 @@ module UntypedPromise = struct type t = Ojs.t - let rec (t_of_js : Ojs.t -> t) = fun (x2 : Ojs.t) -> x2 - and (t_to_js : t -> Ojs.t) = fun (x1 : Ojs.t) -> x1 - let (resolve : Ojs.t -> Ojs.t) = + let rec t_of_js : Ojs.t -> t = fun (x2 : Ojs.t) -> x2 + and t_to_js : t -> Ojs.t = fun (x1 : Ojs.t) -> x1 + let resolve : Ojs.t -> Ojs.t = fun (x3 : Ojs.t) -> Ojs.call (Ojs.get_prop_ascii Ojs.global "Promise") "resolve" [|x3|] - let (reject : Ojs.t -> Ojs.t) = + let reject : Ojs.t -> Ojs.t = fun (x4 : Ojs.t) -> Ojs.call (Ojs.get_prop_ascii Ojs.global "Promise") "reject" [|x4|] - let (then_ : - Ojs.t -> success:(Ojs.t -> Ojs.t) -> error:(Ojs.t -> Ojs.t) -> Ojs.t) = + let then_ : + Ojs.t -> success:(Ojs.t -> Ojs.t) -> error:(Ojs.t -> Ojs.t) -> Ojs.t = fun (x9 : Ojs.t) -> fun ~success:(x5 : Ojs.t -> Ojs.t) -> fun ~error:(x7 : Ojs.t -> Ojs.t) -> Ojs.call x9 "then" [|(Ojs.fun_to_js 1 x5);(Ojs.fun_to_js 1 x7)|] - let (all : Ojs.t list -> Ojs.t) = + let all : Ojs.t list -> Ojs.t = fun (x10 : Ojs.t list) -> Ojs.call (Ojs.get_prop_ascii Ojs.global "Promise") "all" [|(Ojs.list_to_js (fun (x11 : Ojs.t) -> x11) x10)|] @@ -26,10 +26,10 @@ module UntypedPromise = type wrap = { content: Ojs.t } [@@@ocaml.warning "-7-32-39"] - let rec (wrap_of_js : Ojs.t -> wrap) = + let rec wrap_of_js : Ojs.t -> wrap = fun (x13 : Ojs.t) -> { content = (Ojs.get_prop_ascii x13 "content") } - and (wrap_to_js : wrap -> Ojs.t) = + and wrap_to_js : wrap -> Ojs.t = fun (x12 : wrap) -> Ojs.obj [|("content", (x12.content))|] end let is_promise o = (resolve o) == o @@ -40,7 +40,7 @@ module UntypedPromise = else o let return x = resolve (wrap x) let fail err = reject (wrap err) - let bind ?(error= fail) p f = + let bind ?(error= fail) p f = then_ p ~success:(fun x -> f (unwrap x)) ~error:(fun x -> error (unwrap x)) end @@ -48,8 +48,7 @@ type 'a t = UntypedPromise.t type error = Ojs.t let fail error = UntypedPromise.fail error let return x = UntypedPromise.return (Obj.magic x) -let bind ?error p f = - UntypedPromise.bind ?error p (fun x -> f (Obj.magic x)) +let bind ?error p f = UntypedPromise.bind ?error p (fun x -> f (Obj.magic x)) let prod p1 p2 = bind (UntypedPromise.all [p1; p2]) (fun ojs -> diff --git a/node-test/bindings/imports.wat b/node-test/bindings/imports.wat new file mode 100644 index 00000000..ba7e3d0e --- /dev/null +++ b/node-test/bindings/imports.wat @@ -0,0 +1,3 @@ + +(global (export "_node_path") (import "js" "node_path") anyref) +(global (export "_node_fs") (import "js" "node_fs") anyref) diff --git a/node-test/bindings/number.mli b/node-test/bindings/number.mli index f6126dea..d2caa78c 100644 --- a/node-test/bindings/number.mli +++ b/node-test/bindings/number.mli @@ -34,4 +34,4 @@ module Static : sig val negative_infinity: t -> float [@@js.get "NEGATIVE_INFINITY"] val positive_infinity: t -> float [@@js.get "POSITIVE_INFINITY"] end -val number: Static.t [@@js.global "Number"] \ No newline at end of file +val number: Static.t [@@js.global "Number"] diff --git a/node-test/test1/dune b/node-test/test1/dune index cf831ffb..b2bfbabb 100644 --- a/node-test/test1/dune +++ b/node-test/test1/dune @@ -3,8 +3,10 @@ (libraries ojs node) (preprocess (pps gen_js_api.ppx)) - (modes js) + (modes js wasm) (js_of_ocaml + (javascript_files recursive.js)) + (wasm_of_ocaml (javascript_files recursive.js))) (rule @@ -18,3 +20,9 @@ (enabled_if %{bin-available:node}) (action (run node %{dep:./test.bc.js}))) + +(rule + (alias runtest-wasm) + (enabled_if %{bin-available:node}) + (action + (run node %{dep:./test.bc.wasm.js}))) diff --git a/node-test/test1/recursive.js b/node-test/test1/recursive.js index 62086283..2a218aa1 100644 --- a/node-test/test1/recursive.js +++ b/node-test/test1/recursive.js @@ -1,3 +1,4 @@ + var Foo = /*#__PURE__*/function () { "use strict"; @@ -18,6 +19,7 @@ var Foo = /*#__PURE__*/function () { return Foo; }(); + var Bar = /*#__PURE__*/function () { "use strict"; diff --git a/node-test/test1/test.ml b/node-test/test1/test.ml index 7dadaa2b..f63996ed 100644 --- a/node-test/test1/test.ml +++ b/node-test/test1/test.ml @@ -232,29 +232,30 @@ let () = (** Arrays **) let () = - let open Arrays.StringArray in - let a = create () in - for k = 0 to 10 do - push a (string_of_int k); - done; - let s = join a "," in - List.iteri (fun k x -> + let open Arrays.StringArray in + let a = create () in + for k = 0 to 10 do + push a (string_of_int k); + done; + let s = join a "," in + List.iteri (fun k x -> assert (string_of_int k = x) ) (String.split_on_char ',' s) (** Invoking a global object **) (** https://developer.mozilla.org/ja/docs/Web/JavaScript/Reference/Global_Objects/Number/Number **) let () = - let check (a: Number.t) (b: float) = - assert (Ojs.instance_of (a :> Ojs.t) ~constr:(Number.number :> Ojs.t)); - assert (not (Ojs.instance_of (Ojs.float_to_js b) ~constr:(Number.number :> Ojs.t))); - assert (Number.valueOf a = b); - () - in - check (Number.Scoped.create "123") (Number.Scoped.invoke "123"); - check (Number.Static.create Number.number "123") (Number.Static.apply Number.number "123"); - assert (Number.Scoped.max_value = Number.Static.max_value Number.number); + let check (a: Number.t) (b: float) = + assert (Ojs.instance_of (a :> Ojs.t) ~constr:(Number.number :> Ojs.t)); + assert (not (Ojs.instance_of (Ojs.float_to_js b) ~constr:(Number.number :> Ojs.t))); + assert (Number.valueOf a = b); () + in + let s = Ojs.string_to_js "123" in + check (Number.Scoped.create s) (Number.Scoped.invoke s); + check (Number.Static.create Number.number s) (Number.Static.apply Number.number s); + assert (Number.Scoped.max_value = Number.Static.max_value Number.number); + () (** Using recursive modules **) let () = @@ -291,8 +292,8 @@ let () = let sa = join a "," in List.iteri (fun k x -> - assert (string_of_int k = x) - ) (String.split_on_char ',' sa); + assert (string_of_int k = x) + ) (String.split_on_char ',' sa); let b = let orig = List.init 11 string_of_int in diff --git a/ojs.opam b/ojs.opam index cc175f7e..9cbb329f 100644 --- a/ojs.opam +++ b/ojs.opam @@ -12,7 +12,7 @@ license: "MIT" homepage: "https://github.com/LexiFi/gen_js_api" bug-reports: "https://github.com/LexiFi/gen_js_api/issues" depends: [ - "dune" {>= "3.0"} + "dune" {>= "3.17"} "ocaml" {>= "4.08"} "js_of_ocaml-compiler" {>= "4.0.0"} "odoc" {with-doc} diff --git a/ppx-lib/gen_js_api_ppx.ml b/ppx-lib/gen_js_api_ppx.ml index 8f6aad3a..633038d2 100644 --- a/ppx-lib/gen_js_api_ppx.ml +++ b/ppx-lib/gen_js_api_ppx.ml @@ -908,10 +908,10 @@ let get_path global_object s = ojs_get o x let runtime s = - let external_ = Exp.ident (mknoloc (longident_parse "Jsoo_runtime.Sys.external_")) in + let runtime_value = Exp.ident (mknoloc (longident_parse "Jsoo_runtime.Js.runtime_value")) in match split '.' s with | s :: tl -> - let root = Exp.apply external_ (nolabel [Exp.constant (Pconst_string (s, Location.none, None))]) in + let root = Exp.apply runtime_value (nolabel [Exp.constant (Pconst_string (s, Location.none, None))]) in begin match tl with | [] -> root | _ -> diff --git a/ppx-test/expected/binding.ml b/ppx-test/expected/binding.ml index b54fa062..2aedb79b 100644 --- a/ppx-test/expected/binding.ml +++ b/ppx-test/expected/binding.ml @@ -3,49 +3,49 @@ module M = struct type t = Ojs.t - let rec (t_of_js : Ojs.t -> t) = fun (x2 : Ojs.t) -> x2 - and (t_to_js : t -> Ojs.t) = fun (x1 : Ojs.t) -> x1 - let (cast : t -> string) = fun (x3 : t) -> Ojs.string_of_js (t_to_js x3) - let (prop_get_arg : t -> int) = + let rec t_of_js : Ojs.t -> t = fun (x2 : Ojs.t) -> x2 + and t_to_js : t -> Ojs.t = fun (x1 : Ojs.t) -> x1 + let cast : t -> string = fun (x3 : t) -> Ojs.string_of_js (t_to_js x3) + let prop_get_arg : t -> int = fun (x4 : t) -> Ojs.int_of_js (Ojs.get_prop_ascii (t_to_js x4) "getter") - let (prop_get : unit -> int) = + let prop_get : unit -> int = fun () -> Ojs.int_of_js (Ojs.get_prop_ascii Ojs.global "getter") - let (global : t) = t_of_js (Ojs.get_prop_ascii Ojs.global "global") - let (global_arrow : int -> int) = + let global : t = t_of_js (Ojs.get_prop_ascii Ojs.global "global") + let global_arrow : int -> int = fun (x5 : int) -> Ojs.int_of_js (Ojs.call Ojs.global "global" [|(Ojs.int_to_js x5)|]) - let (prop_set : t -> int -> unit) = + let prop_set : t -> int -> unit = fun (x6 : t) -> fun (x7 : int) -> Ojs.set_prop_ascii (t_to_js x6) "setter" (Ojs.int_to_js x7) - let (prop_set_global : t -> unit) = + let prop_set_global : t -> unit = fun (x8 : t) -> Ojs.set_prop_ascii Ojs.global "setter" (t_to_js x8) - let (method_call_global : t -> int) = + let method_call_global : t -> int = fun (x9 : t) -> Ojs.int_of_js (Ojs.call (t_to_js x9) "method" [||]) - let (method_call_global_unit : t -> unit) = + let method_call_global_unit : t -> unit = fun (x10 : t) -> ignore (Ojs.call (t_to_js x10) "method" [||]) - let (method_call_unit : t -> unit -> int) = + let method_call_unit : t -> unit -> int = fun (x11 : t) -> fun () -> Ojs.int_of_js (Ojs.call (t_to_js x11) "method" [||]) - let (method_call_args : t -> int -> int) = + let method_call_args : t -> int -> int = fun (x13 : t) -> fun (x12 : int) -> Ojs.int_of_js (Ojs.call (t_to_js x13) "method" [|(Ojs.int_to_js x12)|]) - let (method_call_unit_unit : t -> unit -> unit) = + let method_call_unit_unit : t -> unit -> unit = fun (x14 : t) -> fun () -> ignore (Ojs.call (t_to_js x14) "method" [||]) - let (method_call_args_unit : t -> int -> unit) = + let method_call_args_unit : t -> int -> unit = fun (x16 : t) -> fun (x15 : int) -> ignore (Ojs.call (t_to_js x16) "method" [|(Ojs.int_to_js x15)|]) - let (new_thing : int -> t) = + let new_thing : int -> t = fun (x17 : int) -> t_of_js (Ojs.new_obj (Ojs.get_prop_ascii Ojs.global "Thing") [|(Ojs.int_to_js x17)|]) - let (builder : ?x:int -> int -> z:int -> t) = + let builder : ?x:int -> int -> z:int -> t = fun ?x:(x18 : int option) -> fun (x19 : int) -> fun ~z:(x20 : int) -> @@ -56,31 +56,31 @@ module M = Ojs.set_prop_ascii x21 "y" (Ojs.int_to_js x19); Ojs.set_prop_ascii x21 "z" (Ojs.int_to_js x20); t_of_js x21 - let (index_get_int : t -> int -> string option) = + let index_get_int : t -> int -> string option = fun (x23 : t) -> fun (x24 : int) -> Ojs.option_of_js Ojs.string_of_js (Ojs.array_get (t_to_js x23) x24) - let (index_get_string : t -> string -> string option) = + let index_get_string : t -> string -> string option = fun (x26 : t) -> fun (x27 : string) -> Ojs.option_of_js Ojs.string_of_js (Ojs.get_prop (t_to_js x26) (Ojs.string_to_js x27)) - let (index_get_generic : t -> Ojs.t -> string option) = + let index_get_generic : t -> Ojs.t -> string option = fun (x29 : t) -> fun (x30 : Ojs.t) -> Ojs.option_of_js Ojs.string_of_js (Ojs.get_prop (t_to_js x29) x30) - let (index_set_int : t -> int -> string -> unit) = + let index_set_int : t -> int -> string -> unit = fun (x32 : t) -> fun (x33 : int) -> fun (x34 : string) -> Ojs.array_set (t_to_js x32) x33 (Ojs.string_to_js x34) - let (index_set_string : t -> string -> string -> unit) = + let index_set_string : t -> string -> string -> unit = fun (x35 : t) -> fun (x36 : string) -> fun (x37 : string) -> Ojs.set_prop (t_to_js x35) (Ojs.string_to_js x36) (Ojs.string_to_js x37) - let (index_set_generic : t -> Ojs.t -> string -> unit) = + let index_set_generic : t -> Ojs.t -> string -> unit = fun (x38 : t) -> fun (x39 : Ojs.t) -> fun (x40 : string) -> diff --git a/ppx-test/expected/binding_automatic.ml b/ppx-test/expected/binding_automatic.ml index 06f373cf..ecc7c951 100644 --- a/ppx-test/expected/binding_automatic.ml +++ b/ppx-test/expected/binding_automatic.ml @@ -4,53 +4,53 @@ module M = struct type t = Ojs.t - let rec (t_of_js : Ojs.t -> t) = fun (x2 : Ojs.t) -> x2 - and (t_to_js : t -> Ojs.t) = fun (x1 : Ojs.t) -> x1 - let (prop_get_arg : t -> int) = + let rec t_of_js : Ojs.t -> t = fun (x2 : Ojs.t) -> x2 + and t_to_js : t -> Ojs.t = fun (x1 : Ojs.t) -> x1 + let prop_get_arg : t -> int = ((fun (x3 : t) -> Ojs.int_of_js (Ojs.get_prop_ascii (t_to_js x3) "propGetArg")) [@ocaml.ppwarning "Heuristic for automatic binding is deprecated; please add the '@js.get' attribute."]) - let (prop_get : unit -> int) = + let prop_get : unit -> int = ((fun () -> Ojs.int_of_js (Ojs.get_prop_ascii Ojs.global "propGet")) [@ocaml.ppwarning "Heuristic for automatic binding is deprecated; please add the '@js.get' attribute."]) - let (set_prop : t -> int -> unit) = + let set_prop : t -> int -> unit = ((fun (x4 : t) -> fun (x5 : int) -> Ojs.set_prop_ascii (t_to_js x4) "prop" (Ojs.int_to_js x5)) [@ocaml.ppwarning "Heuristic for automatic binding is deprecated; please add the '@js.set' attribute."]) - let (set_global : int -> unit) = + let set_global : int -> unit = ((fun (x6 : int) -> Ojs.set_prop_ascii Ojs.global "global" (Ojs.int_to_js x6)) [@ocaml.ppwarning "Heuristic for automatic binding is deprecated; please add the '@js.set' attribute."]) - let (new_thing_unit : unit -> t) = + let new_thing_unit : unit -> t = ((fun () -> t_of_js (Ojs.new_obj (Ojs.get_prop_ascii Ojs.global "ThingUnit") [||])) [@ocaml.ppwarning "Heuristic for automatic binding is deprecated; please add the '@js.new' attribute."]) - let (new_thing_args : int -> t) = + let new_thing_args : int -> t = ((fun (x7 : int) -> t_of_js (Ojs.new_obj (Ojs.get_prop_ascii Ojs.global "ThingArgs") [|(Ojs.int_to_js x7)|])) [@ocaml.ppwarning "Heuristic for automatic binding is deprecated; please add the '@js.new' attribute."]) - let (method_call_global : t -> unit) = + let method_call_global : t -> unit = ((fun (x8 : t) -> ignore (Ojs.call (t_to_js x8) "methodCallGlobal" [||])) [@ocaml.ppwarning "Heuristic for automatic binding is deprecated; please add the '@js.call' attribute."]) - let (method_call_unit : t -> unit -> int) = + let method_call_unit : t -> unit -> int = ((fun (x9 : t) -> fun () -> Ojs.int_of_js (Ojs.call (t_to_js x9) "methodCallUnit" [||])) [@ocaml.ppwarning "Heuristic for automatic binding is deprecated; please add the '@js.call' attribute."]) - let (method_call_args : t -> int -> int) = + let method_call_args : t -> int -> int = ((fun (x11 : t) -> fun (x10 : int) -> Ojs.int_of_js @@ -58,12 +58,12 @@ module M = [|(Ojs.int_to_js x10)|])) [@ocaml.ppwarning "Heuristic for automatic binding is deprecated; please add the '@js.call' attribute."]) - let (method_call_unit_unit : t -> unit -> unit) = + let method_call_unit_unit : t -> unit -> unit = ((fun (x12 : t) -> fun () -> ignore (Ojs.call (t_to_js x12) "methodCallUnitUnit" [||])) [@ocaml.ppwarning "Heuristic for automatic binding is deprecated; please add the '@js.call' attribute."]) - let (method_call_args_unit : t -> int -> unit) = + let method_call_args_unit : t -> int -> unit = ((fun (x14 : t) -> fun (x13 : int) -> ignore @@ -71,31 +71,31 @@ module M = [|(Ojs.int_to_js x13)|])) [@ocaml.ppwarning "Heuristic for automatic binding is deprecated; please add the '@js.call' attribute."]) - let (global : t) = ((t_of_js (Ojs.get_prop_ascii Ojs.global "global")) + let global : t = ((t_of_js (Ojs.get_prop_ascii Ojs.global "global")) [@ocaml.ppwarning "Heuristic for automatic binding is deprecated; please add the '@js.global' attribute."]) - let (get : t -> int -> string option) = + let get : t -> int -> string option = ((fun (x15 : t) -> fun (x16 : int) -> Ojs.option_of_js Ojs.string_of_js (Ojs.array_get (t_to_js x15) x16)) [@ocaml.ppwarning "Heuristic for automatic binding is deprecated; please add the '@js.index_get' attribute."]) - let (set : t -> int -> string -> unit) = + let set : t -> int -> string -> unit = ((fun (x18 : t) -> fun (x19 : int) -> fun (x20 : string) -> Ojs.array_set (t_to_js x18) x19 (Ojs.string_to_js x20)) [@ocaml.ppwarning "Heuristic for automatic binding is deprecated; please add the '@js.index_set' attribute."]) - let (get : t -> string -> string option) = + let get : t -> string -> string option = ((fun (x21 : t) -> fun (x22 : string) -> Ojs.option_of_js Ojs.string_of_js (Ojs.get_prop (t_to_js x21) (Ojs.string_to_js x22))) [@ocaml.ppwarning "Heuristic for automatic binding is deprecated; please add the '@js.index_get' attribute."]) - let (set : t -> string -> string -> unit) = + let set : t -> string -> string -> unit = ((fun (x24 : t) -> fun (x25 : string) -> fun (x26 : string) -> @@ -103,14 +103,14 @@ module M = (Ojs.string_to_js x26)) [@ocaml.ppwarning "Heuristic for automatic binding is deprecated; please add the '@js.index_set' attribute."]) - let (get : t -> Ojs.t -> string option) = + let get : t -> Ojs.t -> string option = ((fun (x27 : t) -> fun (x28 : Ojs.t) -> Ojs.option_of_js Ojs.string_of_js (Ojs.get_prop (t_to_js x27) x28)) [@ocaml.ppwarning "Heuristic for automatic binding is deprecated; please add the '@js.index_get' attribute."]) - let (set : t -> Ojs.t -> string -> unit) = + let set : t -> Ojs.t -> string -> unit = ((fun (x30 : t) -> fun (x31 : Ojs.t) -> fun (x32 : string) -> diff --git a/ppx-test/expected/first_class_modules.ml b/ppx-test/expected/first_class_modules.ml index 2a918d81..b734b95a 100644 --- a/ppx-test/expected/first_class_modules.ml +++ b/ppx-test/expected/first_class_modules.ml @@ -2,16 +2,16 @@ [@@@ocaml.warning "-7-32-39"] module Console = struct - let (log : (module Ojs.T with type t = 'a) -> 'a -> unit) = + let log : (module Ojs.T with type t = 'a) -> 'a -> unit = fun (type a) -> fun ((module A) : (module Ojs.T with type t = a)) -> fun (x1 : a) -> ignore (Ojs.call (Ojs.get_prop_ascii Ojs.global "console") "log" [|(A.t_to_js x1)|]) - let (log2 : + let log2 : (module Ojs.T with type t = 'a) -> - (module Ojs.T with type t = 'b) -> 'a -> 'b -> unit) + (module Ojs.T with type t = 'b) -> 'a -> 'b -> unit = fun (type a) -> fun (type b) -> @@ -22,10 +22,10 @@ module Console = ignore (Ojs.call (Ojs.get_prop_ascii Ojs.global "console") "log" [|(A.t_to_js x2);(B.t_to_js x3)|]) - let (log3 : + let log3 : (module Ojs.T with type t = 'a) -> (module Ojs.T with type t = 'b) -> - (module Ojs.T with type t = 'c) -> 'a -> 'b -> 'c -> unit) + (module Ojs.T with type t = 'c) -> 'a -> 'b -> 'c -> unit = fun (type a) -> fun (type b) -> @@ -44,17 +44,17 @@ module Console = module Console2 = struct type t = Ojs.t - let rec (t_of_js : Ojs.t -> t) = fun (x8 : Ojs.t) -> x8 - and (t_to_js : t -> Ojs.t) = fun (x7 : Ojs.t) -> x7 - let (log : (module Ojs.T with type t = 'a) -> t -> 'a -> unit) = + let rec t_of_js : Ojs.t -> t = fun (x8 : Ojs.t) -> x8 + and t_to_js : t -> Ojs.t = fun (x7 : Ojs.t) -> x7 + let log : (module Ojs.T with type t = 'a) -> t -> 'a -> unit = fun (type a) -> fun ((module A) : (module Ojs.T with type t = a)) -> fun (x10 : t) -> fun (x9 : a) -> ignore (Ojs.call (t_to_js x10) "log" [|(A.t_to_js x9)|]) - let (log2 : + let log2 : (module Ojs.T with type t = 'a) -> - (module Ojs.T with type t = 'b) -> t -> 'a -> 'b -> unit) + (module Ojs.T with type t = 'b) -> t -> 'a -> 'b -> unit = fun (type a) -> fun (type b) -> @@ -66,10 +66,10 @@ module Console2 = ignore (Ojs.call (t_to_js x13) "log" [|(A.t_to_js x11);(B.t_to_js x12)|]) - let (log3 : + let log3 : (module Ojs.T with type t = 'a) -> (module Ojs.T with type t = 'b) -> - (module Ojs.T with type t = 'c) -> t -> 'a -> 'b -> 'c -> unit) + (module Ojs.T with type t = 'c) -> t -> 'a -> 'b -> 'c -> unit = fun (type a) -> fun (type b) -> @@ -90,7 +90,7 @@ module Console3 = struct module Log = struct - let (_1 : (module Ojs.T with type t = 'a) -> 'a -> unit) = + let _1 : (module Ojs.T with type t = 'a) -> 'a -> unit = fun (type a) -> fun ((module A) : (module Ojs.T with type t = a)) -> fun (x18 : a) -> @@ -99,9 +99,9 @@ module Console3 = (Ojs.get_prop_ascii (Ojs.get_prop_ascii Ojs.global "console") "log") [|(A.t_to_js x18)|]) - let (_2 : + let _2 : (module Ojs.T with type t = 'a) -> - (module Ojs.T with type t = 'b) -> 'a -> 'b -> unit) + (module Ojs.T with type t = 'b) -> 'a -> 'b -> unit = fun (type a) -> fun (type b) -> @@ -114,10 +114,10 @@ module Console3 = (Ojs.get_prop_ascii (Ojs.get_prop_ascii Ojs.global "console") "log") [|(A.t_to_js x19);(B.t_to_js x20)|]) - let (_3 : + let _3 : (module Ojs.T with type t = 'a) -> (module Ojs.T with type t = 'b) -> - (module Ojs.T with type t = 'c) -> 'a -> 'b -> 'c -> unit) + (module Ojs.T with type t = 'c) -> 'a -> 'b -> 'c -> unit = fun (type a) -> fun (type b) -> @@ -146,7 +146,7 @@ module Array = and t_to_js : 'a . ('a -> Ojs.t) -> 'a t -> Ojs.t = fun (type __a) -> fun (__a_to_js : __a -> Ojs.t) -> fun (x24 : Ojs.t) -> x24 - let (create : (module Ojs.T with type t = 'a) -> 'a list -> 'a t) = + let create : (module Ojs.T with type t = 'a) -> 'a list -> 'a t = fun (type a) -> fun ((module A) : (module Ojs.T with type t = a)) -> fun (x26 : a list) -> @@ -158,7 +158,7 @@ module Array = (fun (x28 : a) -> ignore (Ojs.call x27 "push" [|(A.t_to_js x28)|])) x26; x27)) - let (create' : (module Ojs.T with type t = 'a) -> 'a list -> 'a t) = + let create' : (module Ojs.T with type t = 'a) -> 'a list -> 'a t = fun (type a) -> fun ((module A) : (module Ojs.T with type t = a)) -> fun (x30 : a list) -> @@ -174,14 +174,14 @@ module Array = (Ojs.call x31 "push" [|(A.t_to_js x32)|])) x30; x31))|]) - let (push : (module Ojs.T with type t = 'a) -> 'a t -> 'a -> unit) = + let push : (module Ojs.T with type t = 'a) -> 'a t -> 'a -> unit = fun (type a) -> fun ((module A) : (module Ojs.T with type t = a)) -> fun (x35 : a t) -> fun (x34 : a) -> ignore (Ojs.call (t_to_js A.t_to_js x35) "push" [|(A.t_to_js x34)|]) - let (pop : (module Ojs.T with type t = 'a) -> 'a t -> 'a option) = + let pop : (module Ojs.T with type t = 'a) -> 'a t -> 'a option = fun (type a) -> fun ((module A) : (module Ojs.T with type t = a)) -> fun (x37 : a t) -> diff --git a/ppx-test/expected/issues.ml b/ppx-test/expected/issues.ml index 5b33cd6a..e3c21c36 100644 --- a/ppx-test/expected/issues.ml +++ b/ppx-test/expected/issues.ml @@ -3,8 +3,8 @@ module Issue116 : sig type t end = [@@@js.dummy "!! This code has been generated by gen_js_api !!"] [@@@ocaml.warning "-7-32-39"] type t = Ojs.t - let rec (t_of_js : Ojs.t -> t) = fun (x2 : Ojs.t) -> x2 - and (t_to_js : t -> Ojs.t) = fun (x1 : Ojs.t) -> x1 + let rec t_of_js : Ojs.t -> t = fun (x2 : Ojs.t) -> x2 + and t_to_js : t -> Ojs.t = fun (x1 : Ojs.t) -> x1 end)[@merlin.hide ]) module Issue117 : sig module T : sig val log : 'a -> unit val log2 : 'a -> 'b -> unit end end @@ -14,12 +14,12 @@ module Issue117 : [@@@ocaml.warning "-7-32-39"] module T = struct - let (log : 'a -> unit) = + let log : 'a -> unit = fun (x3 : 'a) -> ignore (Ojs.call (Ojs.get_prop_ascii Ojs.global "console") "log" [|(Obj.magic x3)|]) - let (log2 : 'a -> 'b -> unit) = + let log2 : 'a -> 'b -> unit = fun (x4 : 'a) -> fun (x5 : 'b) -> ignore @@ -50,10 +50,10 @@ module Issue124 : type a = Ojs.t and b = { a: a } - let rec (a_of_js : Ojs.t -> a) = fun (x7 : Ojs.t) -> x7 - and (a_to_js : a -> Ojs.t) = fun (x6 : Ojs.t) -> x6 - and (b_of_js : Ojs.t -> b) = fun js -> { a = (a_of_js js) } - and (b_to_js : b -> Ojs.t) = fun { a } -> a_to_js a + let rec a_of_js : Ojs.t -> a = fun (x7 : Ojs.t) -> x7 + and a_to_js : a -> Ojs.t = fun (x6 : Ojs.t) -> x6 + and b_of_js : Ojs.t -> b = fun js -> { a = (a_of_js js) } + and b_to_js : b -> Ojs.t = fun { a } -> a_to_js a type 'a dummy = Ojs.t let rec dummy_of_js : 'a . (Ojs.t -> 'a) -> Ojs.t -> 'a dummy = fun (type __a) -> @@ -72,7 +72,7 @@ module Issue124 : | T of t | WrappedT of t wrapped and t = [ `U of u ] dummy - let rec (u_of_js : Ojs.t -> u) = + let rec u_of_js : Ojs.t -> u = fun (x15 : Ojs.t) -> let x16 = x15 in match Ojs.type_of (Ojs.get_prop_ascii x16 "type") with @@ -84,31 +84,31 @@ module Issue124 : | _ -> Unknown x16) | "boolean" -> Unknown x16 | _ -> Unknown x16 - and (u_to_js : u -> Ojs.t) = + and u_to_js : u -> Ojs.t = fun (x10 : u) -> match x10 with | Unknown x11 -> x11 | T x12 -> t_to_js x12 | WrappedT x13 -> wrapped_to_js t_to_js x13 - and (t_of_js : Ojs.t -> t) = Obj.magic - and (t_to_js : t -> Ojs.t) = Obj.magic + and t_of_js : Ojs.t -> t = Obj.magic + and t_to_js : t -> Ojs.t = Obj.magic type ('a, 'b) base = [ `BaseA of 'a | `BaseB of 'b ] dummy and base1 = (int, string) base and base2 = (string, int) base let rec base_of_js : 'a 'b . (Ojs.t -> 'a) -> (Ojs.t -> 'b) -> Ojs.t -> ('a, 'b) base = - fun _ -> fun _ -> Obj.magic + fun _ _ -> Obj.magic and base_to_js : 'a 'b . ('a -> Ojs.t) -> ('b -> Ojs.t) -> ('a, 'b) base -> Ojs.t = - fun _ -> fun _ -> Obj.magic - and (base1_of_js : Ojs.t -> base1) = + fun _ _ -> Obj.magic + and base1_of_js : Ojs.t -> base1 = fun (x21 : Ojs.t) -> base_of_js Ojs.int_of_js Ojs.string_of_js x21 - and (base1_to_js : base1 -> Ojs.t) = + and base1_to_js : base1 -> Ojs.t = fun (x18 : (int, string) base) -> base_to_js Ojs.int_to_js Ojs.string_to_js x18 - and (base2_of_js : Ojs.t -> base2) = + and base2_of_js : Ojs.t -> base2 = fun (x27 : Ojs.t) -> base_of_js Ojs.string_of_js Ojs.int_of_js x27 - and (base2_to_js : base2 -> Ojs.t) = + and base2_to_js : base2 -> Ojs.t = fun (x24 : (string, int) base) -> base_to_js Ojs.string_to_js Ojs.int_to_js x24 end)[@merlin.hide ]) @@ -117,14 +117,14 @@ module Issue109 : sig type t = [ `S of string | `I of int ] end = [@@@js.dummy "!! This code has been generated by gen_js_api !!"] [@@@ocaml.warning "-7-32-39"] type t = [ `S of string | `I of int ] - let rec (t_of_js : Ojs.t -> t) = + let rec t_of_js : Ojs.t -> t = fun (x35 : Ojs.t) -> let x36 = x35 in match Ojs.type_of x36 with | "number" -> (match Ojs.int_of_js x36 with | x38 -> `I x38) | "string" -> (match Ojs.string_of_js x36 with | x37 -> `S x37) | _ -> assert false - and (t_to_js : t -> Ojs.t) = + and t_to_js : t -> Ojs.t = fun (x32 : [ `S of string | `I of int ]) -> match x32 with | `S x33 -> Ojs.string_to_js x33 @@ -137,23 +137,23 @@ module Issue142 : sig type t = [ `Foo ] [@@@ocaml.warning "-7-32-39"] type t = [ `Foo ] and u = t - let rec (t_of_js : Ojs.t -> t) = + let rec t_of_js : Ojs.t -> t = fun (x40 : Ojs.t) -> let x41 = x40 in match Ojs.int_of_js x41 with | 42 -> `Foo | _ -> assert false - and (t_to_js : t -> Ojs.t) = + and t_to_js : t -> Ojs.t = fun (x39 : [ `Foo ]) -> match x39 with | `Foo -> Ojs.int_to_js 42 - and (u_of_js : Ojs.t -> u) = fun (x43 : Ojs.t) -> t_of_js x43 - and (u_to_js : u -> Ojs.t) = fun (x42 : t) -> t_to_js x42 + and u_of_js : Ojs.t -> u = fun (x43 : Ojs.t) -> t_of_js x43 + and u_to_js : u -> Ojs.t = fun (x42 : t) -> t_to_js x42 end)[@merlin.hide ]) module Issue144 : sig type t val f : t -> args:int -> int end = ((struct [@@@js.dummy "!! This code has been generated by gen_js_api !!"] [@@@ocaml.warning "-7-32-39"] type t = Ojs.t - let rec (t_of_js : Ojs.t -> t) = fun (x45 : Ojs.t) -> x45 - and (t_to_js : t -> Ojs.t) = fun (x44 : Ojs.t) -> x44 - let (f : t -> args:int -> int) = + let rec t_of_js : Ojs.t -> t = fun (x45 : Ojs.t) -> x45 + and t_to_js : t -> Ojs.t = fun (x44 : Ojs.t) -> x44 + let f : t -> args:int -> int = fun (x46 : t) -> fun ~args:(x47 : int) -> Ojs.int_of_js @@ -164,7 +164,7 @@ module Issue146 : sig val f : ?arg:[ `Foo ] -> unit -> int end = ((struct [@@@js.dummy "!! This code has been generated by gen_js_api !!"] [@@@ocaml.warning "-7-32-39"] - let (f : ?arg:[ `Foo ] -> unit -> int) = + let f : ?arg:[ `Foo ] -> unit -> int = fun ?arg:(x48 : [ `Foo ] option) -> fun () -> Ojs.int_of_js @@ -201,18 +201,18 @@ module PR165 : module Markdown = struct type t = Ojs.t - let rec (t_of_js : Ojs.t -> t) = fun (x53 : Ojs.t) -> x53 - and (t_to_js : t -> Ojs.t) = fun (x52 : Ojs.t) -> x52 + let rec t_of_js : Ojs.t -> t = fun (x53 : Ojs.t) -> x53 + and t_to_js : t -> Ojs.t = fun (x52 : Ojs.t) -> x52 end module ParameterInformation = struct type t = Ojs.t - let rec (t_of_js : Ojs.t -> t) = fun (x55 : Ojs.t) -> x55 - and (t_to_js : t -> Ojs.t) = fun (x54 : Ojs.t) -> x54 - let (create : + let rec t_of_js : Ojs.t -> t = fun (x55 : Ojs.t) -> x55 + and t_to_js : t -> Ojs.t = fun (x54 : Ojs.t) -> x54 + let create : label:[ `String of string | `Tuple of (int * int) ] -> ?documentation:[ `String of string | `Markdown of Markdown.t ] - -> unit -> t) + -> unit -> t = fun ~label:(x56 : [ `String of string | `Tuple of (int * int) ]) -> diff --git a/ppx-test/expected/issues_mli.ml b/ppx-test/expected/issues_mli.ml index b305bed0..b71e941f 100644 --- a/ppx-test/expected/issues_mli.ml +++ b/ppx-test/expected/issues_mli.ml @@ -3,9 +3,9 @@ module Issue144 = struct type t = Ojs.t - let rec (t_of_js : Ojs.t -> t) = fun (x2 : Ojs.t) -> x2 - and (t_to_js : t -> Ojs.t) = fun (x1 : Ojs.t) -> x1 - let (f : t -> args:int -> int) = + let rec t_of_js : Ojs.t -> t = fun (x2 : Ojs.t) -> x2 + and t_to_js : t -> Ojs.t = fun (x1 : Ojs.t) -> x1 + let f : t -> args:int -> int = fun (x3 : t) -> fun ~args:(x4 : int) -> Ojs.int_of_js diff --git a/ppx-test/expected/modules.ml b/ppx-test/expected/modules.ml index 4a9db261..2e228e9c 100644 --- a/ppx-test/expected/modules.ml +++ b/ppx-test/expected/modules.ml @@ -3,13 +3,13 @@ module Event = struct type t = Ojs.t - let rec (t_of_js : Ojs.t -> t) = fun (x2 : Ojs.t) -> x2 - and (t_to_js : t -> Ojs.t) = fun (x1 : Ojs.t) -> x1 + let rec t_of_js : Ojs.t -> t = fun (x2 : Ojs.t) -> x2 + and t_to_js : t -> Ojs.t = fun (x1 : Ojs.t) -> x1 end module Foo = struct module E = Event - let (foo : E.t -> string -> unit) = + let foo : E.t -> string -> unit = fun (x4 : E.t) -> fun (x3 : string) -> ignore (Ojs.call (E.t_to_js x4) "foo" [|(Ojs.string_to_js x3)|]) @@ -17,7 +17,7 @@ module Foo = module Bar = struct include Event - let (bar : t -> string -> unit) = + let bar : t -> string -> unit = fun (x6 : t) -> fun (x5 : string) -> ignore (Ojs.call (t_to_js x6) "bar" [|(Ojs.string_to_js x5)|]) diff --git a/ppx-test/expected/recursive_modules.ml b/ppx-test/expected/recursive_modules.ml index bcc59a6a..ae89407a 100644 --- a/ppx-test/expected/recursive_modules.ml +++ b/ppx-test/expected/recursive_modules.ml @@ -11,17 +11,17 @@ module rec end = struct type t = Ojs.t - let rec (t_of_js : Ojs.t -> t) = fun (x2 : Ojs.t) -> x2 - and (t_to_js : t -> Ojs.t) = fun (x1 : Ojs.t) -> x1 - let (create : string -> t) = + let rec t_of_js : Ojs.t -> t = fun (x2 : Ojs.t) -> x2 + and t_to_js : t -> Ojs.t = fun (x1 : Ojs.t) -> x1 + let create : string -> t = fun (x3 : string) -> t_of_js (Ojs.new_obj (Ojs.get_prop_ascii Ojs.global "Foo") [|(Ojs.string_to_js x3)|]) - let (describe : t -> string) = + let describe : t -> string = fun (x4 : t) -> Ojs.string_of_js (Ojs.call (t_to_js x4) "describe" [||]) - let (to_bar : t -> Bar.t) = + let to_bar : t -> Bar.t = fun (x5 : t) -> Bar.t_of_js (Ojs.call (t_to_js x5) "toBar" [||]) end and @@ -35,16 +35,16 @@ module rec end = struct type t = Ojs.t - let rec (t_of_js : Ojs.t -> t) = fun (x7 : Ojs.t) -> x7 - and (t_to_js : t -> Ojs.t) = fun (x6 : Ojs.t) -> x6 - let (create : string -> t) = + let rec t_of_js : Ojs.t -> t = fun (x7 : Ojs.t) -> x7 + and t_to_js : t -> Ojs.t = fun (x6 : Ojs.t) -> x6 + let create : string -> t = fun (x8 : string) -> t_of_js (Ojs.new_obj (Ojs.get_prop_ascii Ojs.global "Bar") [|(Ojs.string_to_js x8)|]) - let (describe : t -> string) = + let describe : t -> string = fun (x9 : t) -> Ojs.string_of_js (Ojs.call (t_to_js x9) "describe" [||]) - let (to_foo : t -> Foo.t) = + let to_foo : t -> Foo.t = fun (x10 : t) -> Foo.t_of_js (Ojs.call (t_to_js x10) "toFoo" [||]) end diff --git a/ppx-test/expected/scoped.ml b/ppx-test/expected/scoped.ml index 9c96f282..59ebeac6 100644 --- a/ppx-test/expected/scoped.ml +++ b/ppx-test/expected/scoped.ml @@ -4,33 +4,33 @@ module M = struct type t = Ojs.t - let rec (t_of_js : Ojs.t -> t) = fun (x2 : Ojs.t) -> x2 - and (t_to_js : t -> Ojs.t) = fun (x1 : Ojs.t) -> x1 - let (prop_get_arg : t -> int) = + let rec t_of_js : Ojs.t -> t = fun (x2 : Ojs.t) -> x2 + and t_to_js : t -> Ojs.t = fun (x1 : Ojs.t) -> x1 + let prop_get_arg : t -> int = ((fun (x3 : t) -> Ojs.int_of_js (Ojs.get_prop_ascii (t_to_js x3) "propGetArg")) [@ocaml.ppwarning "Heuristic for automatic binding is deprecated; please add the '@js.get' attribute."]) - let (prop_get : unit -> int) = + let prop_get : unit -> int = ((fun () -> Ojs.int_of_js (Ojs.get_prop_ascii (Ojs.get_prop_ascii Ojs.global "scope") "propGet")) [@ocaml.ppwarning "Heuristic for automatic binding is deprecated; please add the '@js.get' attribute."]) - let (set_prop : t -> int -> unit) = + let set_prop : t -> int -> unit = ((fun (x4 : t) -> fun (x5 : int) -> Ojs.set_prop_ascii (t_to_js x4) "prop" (Ojs.int_to_js x5)) [@ocaml.ppwarning "Heuristic for automatic binding is deprecated; please add the '@js.set' attribute."]) - let (set_global : int -> unit) = + let set_global : int -> unit = ((fun (x6 : int) -> Ojs.set_prop_ascii (Ojs.get_prop_ascii Ojs.global "scope") "global" (Ojs.int_to_js x6)) [@ocaml.ppwarning "Heuristic for automatic binding is deprecated; please add the '@js.set' attribute."]) - let (new_thing_unit : unit -> t) = + let new_thing_unit : unit -> t = ((fun () -> t_of_js (Ojs.new_obj @@ -38,7 +38,7 @@ module M = "ThingUnit") [||])) [@ocaml.ppwarning "Heuristic for automatic binding is deprecated; please add the '@js.new' attribute."]) - let (new_thing_args : int -> t) = + let new_thing_args : int -> t = ((fun (x7 : int) -> t_of_js (Ojs.new_obj @@ -46,18 +46,18 @@ module M = "ThingArgs") [|(Ojs.int_to_js x7)|])) [@ocaml.ppwarning "Heuristic for automatic binding is deprecated; please add the '@js.new' attribute."]) - let (method_call_global : t -> unit) = + let method_call_global : t -> unit = ((fun (x8 : t) -> ignore (Ojs.call (t_to_js x8) "methodCallGlobal" [||])) [@ocaml.ppwarning "Heuristic for automatic binding is deprecated; please add the '@js.call' attribute."]) - let (method_call_unit : t -> unit -> int) = + let method_call_unit : t -> unit -> int = ((fun (x9 : t) -> fun () -> Ojs.int_of_js (Ojs.call (t_to_js x9) "methodCallUnit" [||])) [@ocaml.ppwarning "Heuristic for automatic binding is deprecated; please add the '@js.call' attribute."]) - let (method_call_args : t -> int -> int) = + let method_call_args : t -> int -> int = ((fun (x11 : t) -> fun (x10 : int) -> Ojs.int_of_js @@ -65,12 +65,12 @@ module M = [|(Ojs.int_to_js x10)|])) [@ocaml.ppwarning "Heuristic for automatic binding is deprecated; please add the '@js.call' attribute."]) - let (method_call_unit_unit : t -> unit -> unit) = + let method_call_unit_unit : t -> unit -> unit = ((fun (x12 : t) -> fun () -> ignore (Ojs.call (t_to_js x12) "methodCallUnitUnit" [||])) [@ocaml.ppwarning "Heuristic for automatic binding is deprecated; please add the '@js.call' attribute."]) - let (method_call_args_unit : t -> int -> unit) = + let method_call_args_unit : t -> int -> unit = ((fun (x14 : t) -> fun (x13 : int) -> ignore @@ -78,18 +78,18 @@ module M = [|(Ojs.int_to_js x13)|])) [@ocaml.ppwarning "Heuristic for automatic binding is deprecated; please add the '@js.call' attribute."]) - let (global : t) = + let global : t = ((t_of_js (Ojs.get_prop_ascii (Ojs.get_prop_ascii Ojs.global "scope") "global")) [@ocaml.ppwarning "Heuristic for automatic binding is deprecated; please add the '@js.global' attribute."]) - let (invoke : unit -> unit) = + let invoke : unit -> unit = fun () -> Ojs.unit_of_js (Ojs.apply (Ojs.get_prop_ascii Ojs.global "scope") [||]) end -let (d : unit -> unit) = +let d : unit -> unit = fun () -> ignore (Ojs.call diff --git a/ppx-test/expected/types.ml b/ppx-test/expected/types.ml index 2e28cc44..cf872ec0 100644 --- a/ppx-test/expected/types.ml +++ b/ppx-test/expected/types.ml @@ -1,35 +1,35 @@ type 'a of_js = Ojs.t -> 'a type 'a to_js = 'a -> Ojs.t [@@@ocaml.text " JS-able types "] -let (_ : string of_js) = Ojs.string_of_js -let (_ : string to_js) = Ojs.string_to_js -let (_ : int of_js) = Ojs.int_of_js -let (_ : int to_js) = Ojs.int_to_js -let (_ : bool of_js) = Ojs.bool_of_js -let (_ : bool to_js) = Ojs.bool_to_js -let (_ : float of_js) = Ojs.float_of_js -let (_ : float to_js) = Ojs.float_to_js -let (_ : Ojs.t of_js) = fun (x9 : Ojs.t) -> x9 -let (_ : Ojs.t to_js) = fun (x10 : Ojs.t) -> x10 -let (_ : (string * int) of_js) = +let _ : string of_js = Ojs.string_of_js +let _ : string to_js = Ojs.string_to_js +let _ : int of_js = Ojs.int_of_js +let _ : int to_js = Ojs.int_to_js +let _ : bool of_js = Ojs.bool_of_js +let _ : bool to_js = Ojs.bool_to_js +let _ : float of_js = Ojs.float_of_js +let _ : float to_js = Ojs.float_to_js +let _ : Ojs.t of_js = fun (x9 : Ojs.t) -> x9 +let _ : Ojs.t to_js = fun (x10 : Ojs.t) -> x10 +let _ : (string * int) of_js = fun (x11 : Ojs.t) -> let x12 = x11 in ((Ojs.string_of_js (Ojs.array_get x12 0)), (Ojs.int_of_js (Ojs.array_get x12 1))) -let (_ : (string * int) to_js) = +let _ : (string * int) to_js = fun (x13 : (string * int)) -> let (x14, x15) = x13 in let x16 = Ojs.array_make 2 in Ojs.array_set x16 0 (Ojs.string_to_js x14); Ojs.array_set x16 1 (Ojs.int_to_js x15); x16 -let (_ : (string * int * bool) of_js) = +let _ : (string * int * bool) of_js = fun (x17 : Ojs.t) -> let x18 = x17 in ((Ojs.string_of_js (Ojs.array_get x18 0)), (Ojs.int_of_js (Ojs.array_get x18 1)), (Ojs.bool_of_js (Ojs.array_get x18 2))) -let (_ : (string * int * bool) to_js) = +let _ : (string * int * bool) to_js = fun (x19 : (string * int * bool)) -> let (x20, x21, x22) = x19 in let x23 = Ojs.array_make 3 in @@ -37,15 +37,15 @@ let (_ : (string * int * bool) to_js) = Ojs.array_set x23 1 (Ojs.int_to_js x21); Ojs.array_set x23 2 (Ojs.bool_to_js x22); x23 -let (_ : (string -> int) of_js) = +let _ : (string -> int) of_js = fun (x24 : Ojs.t) -> fun (x25 : string) -> Ojs.int_of_js (Ojs.apply x24 [|(Ojs.string_to_js x25)|]) -let (_ : (string -> int) to_js) = +let _ : (string -> int) to_js = fun (x26 : string -> int) -> Ojs.fun_to_js 1 (fun (x27 : Ojs.t) -> Ojs.int_to_js (x26 (Ojs.string_of_js x27))) -let (_ : ((string -> int) -> bool -> unit) of_js) = +let _ : ((string -> int) -> bool -> unit) of_js = fun (x28 : Ojs.t) -> fun (x29 : string -> int) -> fun (x31 : bool) -> @@ -55,7 +55,7 @@ let (_ : ((string -> int) -> bool -> unit) of_js) = (fun (x30 : Ojs.t) -> Ojs.int_to_js (x29 (Ojs.string_of_js x30))));(Ojs.bool_to_js x31)|]) -let (_ : ((string -> int) -> bool -> unit) to_js) = +let _ : ((string -> int) -> bool -> unit) to_js = fun (x32 : (string -> int) -> bool -> unit) -> Ojs.fun_to_js 2 (fun (x33 : Ojs.t) -> @@ -64,25 +64,25 @@ let (_ : ((string -> int) -> bool -> unit) to_js) = (fun (x34 : string) -> Ojs.int_of_js (Ojs.apply x33 [|(Ojs.string_to_js x34)|])) (Ojs.bool_of_js x35)) -let (_ : string array of_js) = +let _ : string array of_js = fun (x36 : Ojs.t) -> Ojs.array_of_js Ojs.string_of_js x36 -let (_ : string array to_js) = +let _ : string array to_js = fun (x38 : string array) -> Ojs.array_to_js Ojs.string_to_js x38 -let (_ : string list of_js) = +let _ : string list of_js = fun (x40 : Ojs.t) -> Ojs.list_of_js Ojs.string_of_js x40 -let (_ : string list to_js) = +let _ : string list to_js = fun (x42 : string list) -> Ojs.list_to_js Ojs.string_to_js x42 -let (_ : string option of_js) = +let _ : string option of_js = fun (x44 : Ojs.t) -> Ojs.option_of_js Ojs.string_of_js x44 -let (_ : string option to_js) = +let _ : string option to_js = fun (x46 : string option) -> Ojs.option_to_js Ojs.string_to_js x46 -let (_ : (_ -> _) of_js) = +let _ : (_ -> _) of_js = fun (x48 : Ojs.t) -> fun (x49 : 'a) -> Obj.magic (Ojs.apply x48 [|(Obj.magic x49)|]) -let (_ : (_ -> _) to_js) = +let _ : (_ -> _) to_js = fun (x50 : 'a -> 'b) -> Ojs.fun_to_js 1 (fun (x51 : Ojs.t) -> Obj.magic (x50 (Obj.magic x51))) -let (_ : [ `foo | `bar | `Baz | `I of int | `S of string ] of_js) = +let _ : [ `foo | `bar | `Baz | `I of int | `S of string ] of_js = fun (x52 : Ojs.t) -> let x53 = x52 in match Ojs.type_of x53 with @@ -93,7 +93,7 @@ let (_ : [ `foo | `bar | `Baz | `I of int | `S of string ] of_js) = | "Baz" -> `Baz | x55 -> `S x55) | _ -> assert false -let (_ : [ `foo | `bar | `Baz | `I of int | `S of string ] to_js) = +let _ : [ `foo | `bar | `Baz | `I of int | `S of string ] to_js = fun (x56 : [ `foo | `bar | `Baz | `I of int | `S of string ]) -> match x56 with | `foo -> Ojs.string_to_js "foo" @@ -102,7 +102,7 @@ let (_ : [ `foo | `bar | `Baz | `I of int | `S of string ] to_js) = | `I x57 -> Ojs.int_to_js x57 | `S x58 -> Ojs.string_to_js x58 [@@@ocaml.text " Label & Options Value "] -let (_ : (label:int -> ?opt:int -> unit -> unit) of_js) = +let _ : (label:int -> ?opt:int -> unit -> unit) of_js = fun (x59 : Ojs.t) -> fun ~label:(x60 : int) -> fun ?opt:(x61 : int option) -> @@ -122,14 +122,14 @@ let (_ : (label:int -> ?opt:int -> unit -> unit) of_js) = [|(Ojs.int_to_js x63)|]) | None -> ()); x62))|]) -let (_ : (label:int -> ?opt:int -> unit -> unit) to_js) = +let _ : (label:int -> ?opt:int -> unit -> unit) to_js = fun (x64 : label:int -> ?opt:int -> unit -> unit) -> Ojs.fun_to_js 2 (fun (x65 : Ojs.t) -> fun (x66 : Ojs.t) -> x64 ~label:(Ojs.int_of_js x65) ?opt:(Ojs.option_of_js Ojs.int_of_js x66) ()) -let (_ : (label:int -> ?opt:int -> unit -> unit) of_js) = +let _ : (label:int -> ?opt:int -> unit -> unit) of_js = fun (x68 : Ojs.t) -> fun ~label:(x69 : int) -> fun ?opt:(x70 : int option) -> @@ -149,7 +149,7 @@ let (_ : (label:int -> ?opt:int -> unit -> unit) of_js) = [|(Ojs.int_to_js x72)|]) | None -> ()); x71))|]) -let (_ : (label:int -> ?opt:int -> unit -> unit) to_js) = +let _ : (label:int -> ?opt:int -> unit -> unit) to_js = fun (x73 : label:int -> ?opt:int -> unit -> unit) -> Ojs.fun_to_js 2 (fun (x74 : Ojs.t) -> @@ -173,7 +173,7 @@ module B : ((struct [@@@js.dummy "!! This code has been generated by gen_js_api !!"] [@@@ocaml.warning "-7-32-39"] - let (default0 : ?x:int -> unit -> unit) = + let default0 : ?x:int -> unit -> unit = fun ?x:(x77 : int option) -> fun () -> ignore @@ -189,20 +189,20 @@ module B : (Ojs.call x78 "push" [|(Ojs.int_to_js x79)|]) | None -> ()); x78))|]) - let (default1 : ?x:int -> unit -> unit) = + let default1 : ?x:int -> unit -> unit = fun ?x:(x81 : int option) -> fun () -> ignore (Ojs.call Ojs.global "default1" [|(Ojs.int_to_js (match x81 with | Some x82 -> x82 | None -> 42))|]) - let (builder0 : unit -> Ojs.t) = + let builder0 : unit -> Ojs.t = fun () -> let x83 = Ojs.empty_obj () in x83 - let (builder1 : x:int -> Ojs.t) = + let builder1 : x:int -> Ojs.t = fun ~x:(x84 : int) -> let x85 = Ojs.empty_obj () in Ojs.set_prop_ascii x85 "x" (Ojs.int_to_js x84); x85 - let (builder2 : ?x:int -> ?y:string -> unit -> Ojs.t) = + let builder2 : ?x:int -> ?y:string -> unit -> Ojs.t = fun ?x:(x86 : int option) -> fun ?y:(x87 : string option) -> fun () -> @@ -215,7 +215,7 @@ module B : Ojs.set_prop_ascii x88 "y" (Ojs.string_to_js x89) | None -> ()); x88 - let (builder3 : x:int -> y:string -> unit -> Ojs.t) = + let builder3 : x:int -> y:string -> unit -> Ojs.t = fun ~x:(x91 : int) -> fun ~y:(x92 : string) -> fun () -> @@ -223,7 +223,7 @@ module B : Ojs.set_prop_ascii x93 "x" (Ojs.int_to_js x91); Ojs.set_prop_ascii x93 "y" (Ojs.string_to_js x92); x93 - let (builder4 : x:int -> y:string -> z:unit -> Ojs.t) = + let builder4 : x:int -> y:string -> z:unit -> Ojs.t = fun ~x:(x94 : int) -> fun ~y:(x95 : string) -> fun ~z:(x96 : unit) -> @@ -232,7 +232,7 @@ module B : Ojs.set_prop_ascii x97 "y" (Ojs.string_to_js x95); Ojs.set_prop_ascii x97 "z" (Ojs.unit_to_js x96); x97 - let (builder5 : ?x:int -> ?y:string -> unit -> Ojs.t) = + let builder5 : ?x:int -> ?y:string -> unit -> Ojs.t = fun ?x:(x98 : int option) -> fun ?y:(x99 : string option) -> fun () -> @@ -246,7 +246,7 @@ module B : Ojs.set_prop_ascii x100 "y" (Ojs.string_to_js x101) | None -> ()); x100 - let (builder6 : ?x:int -> ?y:string -> ?z:int -> unit -> Ojs.t) = + let builder6 : ?x:int -> ?y:string -> ?z:int -> unit -> Ojs.t = fun ?x:(x103 : int option) -> fun ?y:(x104 : string option) -> fun ?z:(x105 : int option) -> @@ -263,7 +263,7 @@ module B : Ojs.set_prop_ascii x106 "z" (Ojs.int_to_js x107) | None -> ()); x106 - let (sep : string -> string list -> string) = + let sep : string -> string list -> string = fun (x110 : string) -> fun (x111 : string list) -> Ojs.string_of_js @@ -356,55 +356,54 @@ module T : [@@@js.dummy "!! This code has been generated by gen_js_api !!"] [@@@ocaml.warning "-7-32-39"] type js = Ojs.t - let rec (js_of_js : Ojs.t -> js) = fun (x116 : Ojs.t) -> x116 - and (js_to_js : js -> Ojs.t) = fun (x115 : Ojs.t) -> x115 + let rec js_of_js : Ojs.t -> js = fun (x116 : Ojs.t) -> x116 + and js_to_js : js -> Ojs.t = fun (x115 : Ojs.t) -> x115 type abstract = Ojs.t - let rec (abstract_of_js : Ojs.t -> abstract) = - fun (x118 : Ojs.t) -> x118 - and (abstract_to_js : abstract -> Ojs.t) = fun (x117 : Ojs.t) -> x117 + let rec abstract_of_js : Ojs.t -> abstract = fun (x118 : Ojs.t) -> x118 + and abstract_to_js : abstract -> Ojs.t = fun (x117 : Ojs.t) -> x117 type alias = js - let rec (alias_of_js : Ojs.t -> alias) = + let rec alias_of_js : Ojs.t -> alias = fun (x120 : Ojs.t) -> js_of_js x120 - and (alias_to_js : alias -> Ojs.t) = fun (x119 : js) -> js_to_js x119 + and alias_to_js : alias -> Ojs.t = fun (x119 : js) -> js_to_js x119 type private_alias = alias - let rec (private_alias_of_js : Ojs.t -> private_alias) = + let rec private_alias_of_js : Ojs.t -> private_alias = fun (x122 : Ojs.t) -> alias_of_js x122 - and (private_alias_to_js : private_alias -> Ojs.t) = + and private_alias_to_js : private_alias -> Ojs.t = fun (x121 : alias) -> alias_to_js x121 type record = { x: js ; y: js } - let rec (record_of_js : Ojs.t -> record) = + let rec record_of_js : Ojs.t -> record = fun (x124 : Ojs.t) -> { x = (js_of_js (Ojs.get_prop_ascii x124 "x")); y = (js_of_js (Ojs.get_prop_ascii x124 "y")) } - and (record_to_js : record -> Ojs.t) = + and record_to_js : record -> Ojs.t = fun (x123 : record) -> Ojs.obj [|("x", (js_to_js x123.x));("y", (js_to_js x123.y))|] type mutable_record = { mutable x: js ; y: js } - let rec (mutable_record_of_js : Ojs.t -> mutable_record) = + let rec mutable_record_of_js : Ojs.t -> mutable_record = fun (x126 : Ojs.t) -> { x = (js_of_js (Ojs.get_prop_ascii x126 "x")); y = (js_of_js (Ojs.get_prop_ascii x126 "y")) } - and (mutable_record_to_js : mutable_record -> Ojs.t) = + and mutable_record_to_js : mutable_record -> Ojs.t = fun (x125 : mutable_record) -> Ojs.obj [|("x", (js_to_js x125.x));("y", (js_to_js x125.y))|] type record_relabel = { x: int ; y: int } - let rec (record_relabel_of_js : Ojs.t -> record_relabel) = + let rec record_relabel_of_js : Ojs.t -> record_relabel = fun (x128 : Ojs.t) -> { x = (Ojs.int_of_js (Ojs.get_prop_ascii x128 "x")); y = (Ojs.int_of_js (Ojs.get_prop_ascii x128 "Y")) } - and (record_relabel_to_js : record_relabel -> Ojs.t) = + and record_relabel_to_js : record_relabel -> Ojs.t = fun (x127 : record_relabel) -> Ojs.obj [|("x", (Ojs.int_to_js x127.x));("Y", (Ojs.int_to_js x127.y))|] @@ -456,10 +455,10 @@ module T : (fun (x133 : __a) -> Ojs.int_of_js (Ojs.apply x132 [|(__a_to_js x133)|]))) type specialized = (int, int) parametrized - let rec (specialized_of_js : Ojs.t -> specialized) = + let rec specialized_of_js : Ojs.t -> specialized = fun (x140 : Ojs.t) -> parametrized_of_js Ojs.int_of_js Ojs.int_of_js x140 - and (specialized_to_js : specialized -> Ojs.t) = + and specialized_to_js : specialized -> Ojs.t = fun (x137 : (int, int) parametrized) -> parametrized_to_js Ojs.int_to_js Ojs.int_to_js x137 type enum = @@ -467,7 +466,7 @@ module T : | Bar | Baz | Qux - let rec (enum_of_js : Ojs.t -> enum) = + let rec enum_of_js : Ojs.t -> enum = fun (x144 : Ojs.t) -> let x145 = x144 in match Ojs.type_of x145 with @@ -484,7 +483,7 @@ module T : | "Qux" -> Qux | _ -> assert false) | _ -> assert false - and (enum_to_js : enum -> Ojs.t) = + and enum_to_js : enum -> Ojs.t = fun (x143 : enum) -> match x143 with | Foo -> Ojs.string_to_js "foo" @@ -497,7 +496,7 @@ module T : | OO | OtherS of string | OtherI of int - let rec (status_of_js : Ojs.t -> status) = + let rec status_of_js : Ojs.t -> status = fun (x149 : Ojs.t) -> let x150 = x149 in match Ojs.type_of x150 with @@ -512,7 +511,7 @@ module T : | "string" -> (match Ojs.string_of_js x150 with | x151 -> OtherS x151) | _ -> assert false - and (status_to_js : status -> Ojs.t) = + and status_to_js : status -> Ojs.t = fun (x146 : status) -> match x146 with | OK -> Ojs.int_to_js 1 @@ -522,7 +521,7 @@ module T : | OtherI x148 -> Ojs.int_to_js x148 type poly = [ `foo | `bar | `baz | `Qux | `I of int | `S of string ] - let rec (poly_of_js : Ojs.t -> poly) = + let rec poly_of_js : Ojs.t -> poly = fun (x156 : Ojs.t) -> let x157 = x156 in match Ojs.type_of x157 with @@ -539,7 +538,7 @@ module T : | "Qux" -> `Qux | x159 -> `S x159) | _ -> assert false - and (poly_to_js : poly -> Ojs.t) = + and poly_to_js : poly -> Ojs.t = fun (x153 : [ `foo | `bar | `baz | `Qux | `I of int | `S of string ]) @@ -559,7 +558,7 @@ module T : age: int ; name: string } | Unknown of Ojs.t - let rec (sum_of_js : Ojs.t -> sum) = + let rec sum_of_js : Ojs.t -> sum = fun (x167 : Ojs.t) -> let x168 = x167 in match Ojs.type_of (Ojs.get_prop_ascii x168 "kind") with @@ -584,7 +583,7 @@ module T : | _ -> Unknown x168) | "boolean" -> Unknown x168 | _ -> Unknown x168 - and (sum_to_js : sum -> Ojs.t) = + and sum_to_js : sum -> Ojs.t = fun (x160 : sum) -> match x160 with | A -> Ojs.obj [|("kind", (Ojs.string_to_js "A"))|] @@ -614,7 +613,7 @@ module T : name: string } | E of int | Unknown of Ojs.t - let rec (t_of_js : Ojs.t -> t) = + let rec t_of_js : Ojs.t -> t = fun (x177 : Ojs.t) -> let x178 = x177 in match Ojs.type_of (Ojs.get_prop_ascii x178 "kind") with @@ -640,7 +639,7 @@ module T : | _ -> Unknown x178) | "boolean" -> Unknown x178 | _ -> Unknown x178 - and (t_to_js : t -> Ojs.t) = + and t_to_js : t -> Ojs.t = fun (x169 : t) -> match x169 with | A -> Ojs.obj [|("kind", (Ojs.string_to_js "A"))|] @@ -670,7 +669,7 @@ module T : | B of int | C of int | D of Ojs.t - let rec (union_to_js : union -> Ojs.t) = + let rec union_to_js : union -> Ojs.t = fun (x179 : union) -> match x179 with | A -> Ojs.null @@ -678,7 +677,7 @@ module T : | C x181 -> Ojs.int_to_js x181 | D x182 -> x182 type poly_union = [ `A | `B of int | `C of int | `D of Ojs.t ] - let rec (poly_union_to_js : poly_union -> Ojs.t) = + let rec poly_union_to_js : poly_union -> Ojs.t = fun (x185 : [ `A | `B of int | `C of int | `D of Ojs.t ]) -> match x185 with | `A -> Ojs.null @@ -690,7 +689,7 @@ module T : | B of int | C of int | D of Ojs.t - let rec (discr_union_of_js : Ojs.t -> discr_union) = + let rec discr_union_of_js : Ojs.t -> discr_union = fun (x195 : Ojs.t) -> let x196 = x195 in match Ojs.type_of (Ojs.get_prop_ascii x196 "discr") with @@ -703,7 +702,7 @@ module T : | _ -> D x196) | "boolean" -> D x196 | _ -> D x196 - and (discr_union_to_js : discr_union -> Ojs.t) = + and discr_union_to_js : discr_union -> Ojs.t = fun (x191 : discr_union) -> match x191 with | A -> Ojs.null @@ -711,7 +710,7 @@ module T : | C x193 -> Ojs.int_to_js x193 | D x194 -> x194 type discr_poly_union = [ `A | `B of int | `C of int | `D of Ojs.t ] - let rec (discr_poly_union_of_js : Ojs.t -> discr_poly_union) = + let rec discr_poly_union_of_js : Ojs.t -> discr_poly_union = fun (x201 : Ojs.t) -> let x202 = x201 in match Ojs.type_of (Ojs.get_prop_ascii x202 "discr") with @@ -724,7 +723,7 @@ module T : | _ -> `D x202) | "boolean" -> `D x202 | _ -> `D x202 - and (discr_poly_union_to_js : discr_poly_union -> Ojs.t) = + and discr_poly_union_to_js : discr_poly_union -> Ojs.t = fun (x197 : [ `A | `B of int | `C of int | `D of Ojs.t ]) -> match x197 with | `A -> Ojs.null @@ -736,7 +735,7 @@ module T : | B of int | C of int | D of Ojs.t - let rec (discr_union_value_of_js : Ojs.t -> discr_union_value) = + let rec discr_union_value_of_js : Ojs.t -> discr_union_value = fun (x207 : Ojs.t) -> let x208 = x207 in match Ojs.type_of (Ojs.get_prop_ascii x208 "discr") with @@ -751,7 +750,7 @@ module T : | _ -> D x208) | "boolean" -> D x208 | _ -> D x208 - and (discr_union_value_to_js : discr_union_value -> Ojs.t) = + and discr_union_value_to_js : discr_union_value -> Ojs.t = fun (x203 : discr_union_value) -> match x203 with | A -> Ojs.null @@ -760,7 +759,7 @@ module T : | D x206 -> x206 module NestedScope0 = struct - let (f : string -> unit) = + let f : string -> unit = fun (x209 : string) -> ignore (Ojs.call @@ -770,7 +769,7 @@ module T : end module NestedScope1 = struct - let (f : string -> unit) = + let f : string -> unit = fun (x210 : string) -> ignore (Ojs.call @@ -780,7 +779,7 @@ module T : end module NestedScope2 = struct - let (f : string -> unit) = + let f : string -> unit = fun (x211 : string) -> ignore (Ojs.call diff --git a/ppx-test/expected/union_and_enum.ml b/ppx-test/expected/union_and_enum.ml index 1942682a..d7fbb8e6 100644 --- a/ppx-test/expected/union_and_enum.ml +++ b/ppx-test/expected/union_and_enum.ml @@ -4,14 +4,14 @@ type enum_int = | Enum_int_0 | Enum_int_1 | Enum_int_other of int -let rec (enum_int_of_js : Ojs.t -> enum_int) = +let rec enum_int_of_js : Ojs.t -> enum_int = fun (x3 : Ojs.t) -> let x4 = x3 in match Ojs.int_of_js x4 with | 0 -> Enum_int_0 | 1 -> Enum_int_1 | x5 -> Enum_int_other x5 -and (enum_int_to_js : enum_int -> Ojs.t) = +and enum_int_to_js : enum_int -> Ojs.t = fun (x1 : enum_int) -> match x1 with | Enum_int_0 -> Ojs.int_to_js 0 @@ -21,14 +21,14 @@ type enum_float = | Enum_float_0_1 | Enum_float_1_1 | Enum_float_other of float -let rec (enum_float_of_js : Ojs.t -> enum_float) = +let rec enum_float_of_js : Ojs.t -> enum_float = fun (x8 : Ojs.t) -> let x9 = x8 in match Ojs.float_of_js x9 with | 0.1 -> Enum_float_0_1 | 1.1 -> Enum_float_1_1 | x10 -> Enum_float_other x10 -and (enum_float_to_js : enum_float -> Ojs.t) = +and enum_float_to_js : enum_float -> Ojs.t = fun (x6 : enum_float) -> match x6 with | Enum_float_0_1 -> Ojs.float_to_js 0.1 @@ -40,7 +40,7 @@ type enum_number_1 = | Enum_number_0_1 | Enum_number_1_1 | Enum_number_other of int -let rec (enum_number_1_of_js : Ojs.t -> enum_number_1) = +let rec enum_number_1_of_js : Ojs.t -> enum_number_1 = fun (x13 : Ojs.t) -> let x14 = x13 in match Ojs.float_of_js x14 with @@ -51,7 +51,7 @@ let rec (enum_number_1_of_js : Ojs.t -> enum_number_1) = | 0 -> Enum_number_0 | 1 -> Enum_number_1 | x15 -> Enum_number_other x15) -and (enum_number_1_to_js : enum_number_1 -> Ojs.t) = +and enum_number_1_to_js : enum_number_1 -> Ojs.t = fun (x11 : enum_number_1) -> match x11 with | Enum_number_0 -> Ojs.int_to_js 0 @@ -65,7 +65,7 @@ type enum_number_2 = | Enum_number_0_1 | Enum_number_1_1 | Enum_number_other of float -let rec (enum_number_2_of_js : Ojs.t -> enum_number_2) = +let rec enum_number_2_of_js : Ojs.t -> enum_number_2 = fun (x18 : Ojs.t) -> let x19 = x18 in match Ojs.float_of_js x19 with @@ -76,7 +76,7 @@ let rec (enum_number_2_of_js : Ojs.t -> enum_number_2) = | 0 -> Enum_number_0 | 1 -> Enum_number_1 | _ -> Enum_number_other x20) -and (enum_number_2_to_js : enum_number_2 -> Ojs.t) = +and enum_number_2_to_js : enum_number_2 -> Ojs.t = fun (x16 : enum_number_2) -> match x16 with | Enum_number_0 -> Ojs.int_to_js 0 @@ -88,14 +88,14 @@ type enum_string = | Enum_string_foo | Enum_string_bar | Enum_string_other of string -let rec (enum_string_of_js : Ojs.t -> enum_string) = +let rec enum_string_of_js : Ojs.t -> enum_string = fun (x23 : Ojs.t) -> let x24 = x23 in match Ojs.string_of_js x24 with | "foo" -> Enum_string_foo | "bar" -> Enum_string_bar | x25 -> Enum_string_other x25 -and (enum_string_to_js : enum_string -> Ojs.t) = +and enum_string_to_js : enum_string -> Ojs.t = fun (x21 : enum_string) -> match x21 with | Enum_string_foo -> Ojs.string_to_js "foo" @@ -104,38 +104,38 @@ and (enum_string_to_js : enum_string -> Ojs.t) = type enum_bool = | Enum_bool_true | Enum_bool_false -let rec (enum_bool_of_js : Ojs.t -> enum_bool) = +let rec enum_bool_of_js : Ojs.t -> enum_bool = fun (x27 : Ojs.t) -> let x28 = x27 in match Ojs.bool_of_js x28 with | true -> Enum_bool_true | false -> Enum_bool_false -and (enum_bool_to_js : enum_bool -> Ojs.t) = +and enum_bool_to_js : enum_bool -> Ojs.t = fun (x26 : enum_bool) -> match x26 with | Enum_bool_true -> Ojs.bool_to_js true | Enum_bool_false -> Ojs.bool_to_js false type enum_bool_partial = | Enum_bool_true -let rec (enum_bool_partial_of_js : Ojs.t -> enum_bool_partial) = +let rec enum_bool_partial_of_js : Ojs.t -> enum_bool_partial = fun (x30 : Ojs.t) -> let x31 = x30 in match Ojs.bool_of_js x31 with | true -> Enum_bool_true | _ -> assert false -and (enum_bool_partial_to_js : enum_bool_partial -> Ojs.t) = +and enum_bool_partial_to_js : enum_bool_partial -> Ojs.t = fun (x29 : enum_bool_partial) -> match x29 with | Enum_bool_true -> Ojs.bool_to_js true type enum_bool_partial2 = | Enum_bool_true | Enum_bool_other of bool -let rec (enum_bool_partial2_of_js : Ojs.t -> enum_bool_partial2) = +let rec enum_bool_partial2_of_js : Ojs.t -> enum_bool_partial2 = fun (x34 : Ojs.t) -> let x35 = x34 in match Ojs.bool_of_js x35 with | true -> Enum_bool_true | x36 -> Enum_bool_other x36 -and (enum_bool_partial2_to_js : enum_bool_partial2 -> Ojs.t) = +and enum_bool_partial2_to_js : enum_bool_partial2 -> Ojs.t = fun (x32 : enum_bool_partial2) -> match x32 with | Enum_bool_true -> Ojs.bool_to_js true @@ -151,7 +151,7 @@ type enum_mixed = | Enum_string_other of string | Enum_bool_true | Enum_bool_false -let rec (enum_mixed_of_js : Ojs.t -> enum_mixed) = +let rec enum_mixed_of_js : Ojs.t -> enum_mixed = fun (x40 : Ojs.t) -> let x41 = x40 in match Ojs.type_of x41 with @@ -174,7 +174,7 @@ let rec (enum_mixed_of_js : Ojs.t -> enum_mixed) = | true -> Enum_bool_true | false -> Enum_bool_false) | _ -> assert false -and (enum_mixed_to_js : enum_mixed -> Ojs.t) = +and enum_mixed_to_js : enum_mixed -> Ojs.t = fun (x37 : enum_mixed) -> match x37 with | Enum_int_0 -> Ojs.int_to_js 0 @@ -197,7 +197,7 @@ type enum_mixed_partial_bool = | Enum_string_bar | Enum_string_other of string | Enum_bool_true -let rec (enum_mixed_partial_bool_of_js : Ojs.t -> enum_mixed_partial_bool) = +let rec enum_mixed_partial_bool_of_js : Ojs.t -> enum_mixed_partial_bool = fun (x47 : Ojs.t) -> let x48 = x47 in match Ojs.type_of x48 with @@ -220,7 +220,7 @@ let rec (enum_mixed_partial_bool_of_js : Ojs.t -> enum_mixed_partial_bool) = | true -> Enum_bool_true | _ -> assert false) | _ -> assert false -and (enum_mixed_partial_bool_to_js : enum_mixed_partial_bool -> Ojs.t) = +and enum_mixed_partial_bool_to_js : enum_mixed_partial_bool -> Ojs.t = fun (x44 : enum_mixed_partial_bool) -> match x44 with | Enum_int_0 -> Ojs.int_to_js 0 @@ -243,8 +243,7 @@ type enum_mixed_partial_bool2 = | Enum_string_other of string | Enum_bool_true | Enum_bool_other of bool -let rec (enum_mixed_partial_bool2_of_js : Ojs.t -> enum_mixed_partial_bool2) - = +let rec enum_mixed_partial_bool2_of_js : Ojs.t -> enum_mixed_partial_bool2 = fun (x55 : Ojs.t) -> let x56 = x55 in match Ojs.type_of x56 with @@ -267,7 +266,7 @@ let rec (enum_mixed_partial_bool2_of_js : Ojs.t -> enum_mixed_partial_bool2) | true -> Enum_bool_true | x59 -> Enum_bool_other x59) | _ -> assert false -and (enum_mixed_partial_bool2_to_js : enum_mixed_partial_bool2 -> Ojs.t) = +and enum_mixed_partial_bool2_to_js : enum_mixed_partial_bool2 -> Ojs.t = fun (x51 : enum_mixed_partial_bool2) -> match x51 with | Enum_int_0 -> Ojs.int_to_js 0 @@ -281,28 +280,28 @@ and (enum_mixed_partial_bool2_to_js : enum_mixed_partial_bool2 -> Ojs.t) = | Enum_bool_true -> Ojs.bool_to_js true | Enum_bool_other x54 -> Ojs.bool_to_js x54 type dummy1 = Ojs.t -let rec (dummy1_of_js : Ojs.t -> dummy1) = fun (x61 : Ojs.t) -> x61 -and (dummy1_to_js : dummy1 -> Ojs.t) = fun (x60 : Ojs.t) -> x60 +let rec dummy1_of_js : Ojs.t -> dummy1 = fun (x61 : Ojs.t) -> x61 +and dummy1_to_js : dummy1 -> Ojs.t = fun (x60 : Ojs.t) -> x60 type dummy2 = Ojs.t -let rec (dummy2_of_js : Ojs.t -> dummy2) = fun (x63 : Ojs.t) -> x63 -and (dummy2_to_js : dummy2 -> Ojs.t) = fun (x62 : Ojs.t) -> x62 +let rec dummy2_of_js : Ojs.t -> dummy2 = fun (x63 : Ojs.t) -> x63 +and dummy2_to_js : dummy2 -> Ojs.t = fun (x62 : Ojs.t) -> x62 type dummy3 = Ojs.t -let rec (dummy3_of_js : Ojs.t -> dummy3) = fun (x65 : Ojs.t) -> x65 -and (dummy3_to_js : dummy3 -> Ojs.t) = fun (x64 : Ojs.t) -> x64 +let rec dummy3_of_js : Ojs.t -> dummy3 = fun (x65 : Ojs.t) -> x65 +and dummy3_to_js : dummy3 -> Ojs.t = fun (x64 : Ojs.t) -> x64 type dummy4 = Ojs.t -let rec (dummy4_of_js : Ojs.t -> dummy4) = fun (x67 : Ojs.t) -> x67 -and (dummy4_to_js : dummy4 -> Ojs.t) = fun (x66 : Ojs.t) -> x66 +let rec dummy4_of_js : Ojs.t -> dummy4 = fun (x67 : Ojs.t) -> x67 +and dummy4_to_js : dummy4 -> Ojs.t = fun (x66 : Ojs.t) -> x66 type dummy5 = Ojs.t -let rec (dummy5_of_js : Ojs.t -> dummy5) = fun (x69 : Ojs.t) -> x69 -and (dummy5_to_js : dummy5 -> Ojs.t) = fun (x68 : Ojs.t) -> x68 +let rec dummy5_of_js : Ojs.t -> dummy5 = fun (x69 : Ojs.t) -> x69 +and dummy5_to_js : dummy5 -> Ojs.t = fun (x68 : Ojs.t) -> x68 type dummy6 = Ojs.t -let rec (dummy6_of_js : Ojs.t -> dummy6) = fun (x71 : Ojs.t) -> x71 -and (dummy6_to_js : dummy6 -> Ojs.t) = fun (x70 : Ojs.t) -> x70 +let rec dummy6_of_js : Ojs.t -> dummy6 = fun (x71 : Ojs.t) -> x71 +and dummy6_to_js : dummy6 -> Ojs.t = fun (x70 : Ojs.t) -> x70 type union_int = | Union_int_0 of dummy1 | Union_int_1 of dummy2 | Unknown of Ojs.t -let rec (union_int_of_js : Ojs.t -> union_int) = +let rec union_int_of_js : Ojs.t -> union_int = fun (x76 : Ojs.t) -> let x77 = x76 in match Ojs.type_of (Ojs.get_prop_ascii x77 "tag") with @@ -314,7 +313,7 @@ let rec (union_int_of_js : Ojs.t -> union_int) = | "string" -> Unknown x77 | "boolean" -> Unknown x77 | _ -> Unknown x77 -and (union_int_to_js : union_int -> Ojs.t) = +and union_int_to_js : union_int -> Ojs.t = fun (x72 : union_int) -> match x72 with | Union_int_0 x73 -> dummy1_to_js x73 @@ -324,7 +323,7 @@ type union_float = | Union_float_0_1 of dummy1 | Union_float_1_1 of dummy2 | Unknown of Ojs.t -let rec (union_float_of_js : Ojs.t -> union_float) = +let rec union_float_of_js : Ojs.t -> union_float = fun (x82 : Ojs.t) -> let x83 = x82 in match Ojs.type_of (Ojs.get_prop_ascii x83 "tag") with @@ -336,7 +335,7 @@ let rec (union_float_of_js : Ojs.t -> union_float) = | "string" -> Unknown x83 | "boolean" -> Unknown x83 | _ -> Unknown x83 -and (union_float_to_js : union_float -> Ojs.t) = +and union_float_to_js : union_float -> Ojs.t = fun (x78 : union_float) -> match x78 with | Union_float_0_1 x79 -> dummy1_to_js x79 @@ -346,7 +345,7 @@ type union_string = | Union_string_foo of dummy3 | Union_string_bar of dummy4 | Unknown of Ojs.t -let rec (union_string_of_js : Ojs.t -> union_string) = +let rec union_string_of_js : Ojs.t -> union_string = fun (x88 : Ojs.t) -> let x89 = x88 in match Ojs.type_of (Ojs.get_prop_ascii x89 "tag") with @@ -358,7 +357,7 @@ let rec (union_string_of_js : Ojs.t -> union_string) = | _ -> Unknown x89) | "boolean" -> Unknown x89 | _ -> Unknown x89 -and (union_string_to_js : union_string -> Ojs.t) = +and union_string_to_js : union_string -> Ojs.t = fun (x84 : union_string) -> match x84 with | Union_string_foo x85 -> dummy3_to_js x85 @@ -367,32 +366,32 @@ and (union_string_to_js : union_string -> Ojs.t) = type union_bool = | Union_bool_true of dummy5 | Union_bool_false of dummy6 -let rec (union_bool_of_js : Ojs.t -> union_bool) = +let rec union_bool_of_js : Ojs.t -> union_bool = fun (x93 : Ojs.t) -> let x94 = x93 in match Ojs.bool_of_js (Ojs.get_prop_ascii x94 "tag") with | true -> Union_bool_true (dummy5_of_js x94) | false -> Union_bool_false (dummy6_of_js x94) -and (union_bool_to_js : union_bool -> Ojs.t) = +and union_bool_to_js : union_bool -> Ojs.t = fun (x90 : union_bool) -> match x90 with | Union_bool_true x91 -> dummy5_to_js x91 | Union_bool_false x92 -> dummy6_to_js x92 type union_bool_partial = | Union_bool_true of dummy5 -let rec (union_bool_partial_of_js : Ojs.t -> union_bool_partial) = +let rec union_bool_partial_of_js : Ojs.t -> union_bool_partial = fun (x97 : Ojs.t) -> let x98 = x97 in match Ojs.bool_of_js (Ojs.get_prop_ascii x98 "tag") with | true -> Union_bool_true (dummy5_of_js x98) | _ -> assert false -and (union_bool_partial_to_js : union_bool_partial -> Ojs.t) = +and union_bool_partial_to_js : union_bool_partial -> Ojs.t = fun (x95 : union_bool_partial) -> match x95 with | Union_bool_true x96 -> dummy5_to_js x96 type union_bool_partial2 = | Union_bool_true of dummy5 | Unknown of Ojs.t -let rec (union_bool_partial2_of_js : Ojs.t -> union_bool_partial2) = +let rec union_bool_partial2_of_js : Ojs.t -> union_bool_partial2 = fun (x102 : Ojs.t) -> let x103 = x102 in match Ojs.type_of (Ojs.get_prop_ascii x103 "tag") with @@ -403,7 +402,7 @@ let rec (union_bool_partial2_of_js : Ojs.t -> union_bool_partial2) = | true -> Union_bool_true (dummy5_of_js x103) | _ -> Unknown x103) | _ -> Unknown x103 -and (union_bool_partial2_to_js : union_bool_partial2 -> Ojs.t) = +and union_bool_partial2_to_js : union_bool_partial2 -> Ojs.t = fun (x99 : union_bool_partial2) -> match x99 with | Union_bool_true x100 -> dummy5_to_js x100 @@ -418,7 +417,7 @@ type union_mixed = | Union_bool_true of dummy5 | Union_bool_false of dummy6 | Unknown of Ojs.t -let rec (union_mixed_of_js : Ojs.t -> union_mixed) = +let rec union_mixed_of_js : Ojs.t -> union_mixed = fun (x114 : Ojs.t) -> let x115 = x114 in match Ojs.type_of (Ojs.get_prop_ascii x115 "tag") with @@ -441,7 +440,7 @@ let rec (union_mixed_of_js : Ojs.t -> union_mixed) = | true -> Union_bool_true (dummy5_of_js x115) | false -> Union_bool_false (dummy6_of_js x115)) | _ -> Unknown x115 -and (union_mixed_to_js : union_mixed -> Ojs.t) = +and union_mixed_to_js : union_mixed -> Ojs.t = fun (x104 : union_mixed) -> match x104 with | Union_int_0 x105 -> dummy1_to_js x105 @@ -462,8 +461,7 @@ type union_mixed_partial_bool = | Union_string_bar of dummy4 | Union_bool_true of dummy5 | Unknown of Ojs.t -let rec (union_mixed_partial_bool_of_js : Ojs.t -> union_mixed_partial_bool) - = +let rec union_mixed_partial_bool_of_js : Ojs.t -> union_mixed_partial_bool = fun (x125 : Ojs.t) -> let x126 = x125 in match Ojs.type_of (Ojs.get_prop_ascii x126 "tag") with @@ -486,7 +484,7 @@ let rec (union_mixed_partial_bool_of_js : Ojs.t -> union_mixed_partial_bool) | true -> Union_bool_true (dummy5_of_js x126) | _ -> Unknown x126) | _ -> Unknown x126 -and (union_mixed_partial_bool_to_js : union_mixed_partial_bool -> Ojs.t) = +and union_mixed_partial_bool_to_js : union_mixed_partial_bool -> Ojs.t = fun (x116 : union_mixed_partial_bool) -> match x116 with | Union_int_0 x117 -> dummy1_to_js x117 From c26380668449e46c5f6d6742a6cbf0471e24cadb Mon Sep 17 00:00:00 2001 From: mlasson Date: Wed, 19 Nov 2025 11:27:41 +0100 Subject: [PATCH 3/4] Document node runtime bindings --- CHANGES.md | 6 + NODE_RUNTIME_BINDINGS.md | 153 ++++++++++++++++++++++ node-test/runtime_primitives/bindings.mli | 14 ++ node-test/runtime_primitives/dune | 28 ++++ node-test/runtime_primitives/example.ml | 33 +++++ node-test/runtime_primitives/imports.js | 13 ++ node-test/runtime_primitives/imports.wat | 4 + 7 files changed, 251 insertions(+) create mode 100644 NODE_RUNTIME_BINDINGS.md create mode 100644 node-test/runtime_primitives/bindings.mli create mode 100644 node-test/runtime_primitives/dune create mode 100644 node-test/runtime_primitives/example.ml create mode 100644 node-test/runtime_primitives/imports.js create mode 100644 node-test/runtime_primitives/imports.wat diff --git a/CHANGES.md b/CHANGES.md index ce4d2f09..0595c6d6 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -1,6 +1,12 @@ Changelog ========= +Unreleased +---------- + +- Experimental support for binding to js_of_ocaml runtime primitives via `[@@js.runtime]` and `[@@@js.scope "@..."]`, enabling generated bindings to target values supplied by the JavaScript runtime (such as Node imports and Wasm modules). +- Test suite updates adapted for wasm_of_ocaml. + Version 1.1.5 ------------- diff --git a/NODE_RUNTIME_BINDINGS.md b/NODE_RUNTIME_BINDINGS.md new file mode 100644 index 00000000..7279601d --- /dev/null +++ b/NODE_RUNTIME_BINDINGS.md @@ -0,0 +1,153 @@ +# Binding Node.js Modules with Runtime Primitives + +This guide shows how to use the new runtime primitive support in `gen_js_api` to bind Node.js libraries that are usually obtained with `require(...)`. The feature hinges on two additions: + +- the `[@@js.runtime "primitive_name"]` attribute returns an `Ojs.t` pointing to a primitive exported by the JavaScript runtime; +- a scope string that starts with `@` (for example `[@@@js.scope "@node_fs.promises"]`) resolves the first path component through the runtime primitives before following regular properties. + +Together, those tools let you keep your bindings declarative while delegating the actual `require` calls to a tiny JavaScript stub. + +## Example layout + +``` +runtime_primitives/ + dune + imports.js + imports.wat + bindings.mli + example.ml +``` + +### Step 1 - expose the runtime primitives + +Create a JavaScript file that `require`s the Node modules you need and publishes them as js_of_ocaml runtime primitives. The js_of_ocaml linker recognises `//Provides: ` comments and registers the value under that name at startup. + +```javascript +// runtime_primitives/imports.js +'use strict'; + +//Provides: node_path +var node_path = require('path'); + +//Provides: node_fs +var node_fs = require('fs'); + +//Provides: node_version +var node_version = require('process').version; + +//Provides: node_console +var node_console = console.log; + +``` + +When targeting WebAssembly you also need to expose the primitives through a `.wat` shim so that `wasm_of_ocaml` can import them at runtime: + +```wat +;; runtime_primitives/imports.wat +(global (export "_node_path") (import "js" "node_path") anyref) +(global (export "_node_fs") (import "js" "node_fs") anyref) +(global (export "_node_version") (import "js" "node_version") anyref) +(global (export "_node_console") (import "js" "node_console") anyref) +``` + +List this file in your dune stanza so that js_of_ocaml ships it with the compiled artefacts: + +``` +; runtime_primitives/dune +(rule + (targets bindings.ml) + (deps bindings.mli) + (action (run gen_js_api %{deps}))) + +(executable + (name example) + (libraries ojs) + (preprocess (pps gen_js_api.ppx)) + (modes js wasm) + (js_of_ocaml (javascript_files imports.js)) + (wasm_of_ocaml (javascript_files imports.js imports.wat))) +``` + +Adding the file to both `js_of_ocaml` and `wasm_of_ocaml` makes the primitives available in browser and wasm builds alike. + +### Step 2 - bind module functions with `[@js.scope "@..."]` + +Use `module [@js.scope "@primitive"]` blocks to call methods on runtime primitives without manually threading the module objects. The interface below covers the synchronous filesystem API used in the reference JavaScript while keeping the underlying modules abstract. + +```ocaml +(* runtime_primitives/bindings.mli *) +module [@js.scope "@node_fs"] Fs : sig + val write_file_sync : string -> string -> unit [@@js.global "writeFileSync"] + val read_file_sync : string -> encoding:string -> string [@@js.global "readFileSync"] + val readdir_sync : string -> string array [@@js.global "readdirSync"] + val append_file_sync : string -> string -> unit [@@js.global "appendFileSync"] +end + +module [@js.scope "@node_path"] Path : sig + val separator: string [@@js.global "sep"] + val join : (string list [@js.variadic]) -> string [@@js.global "join"] +end +``` +Each module-level scope starts with `@`, so the ppx turns calls like `Fs.write_file_sync` into direct invocations on the corresponding Node module (`node_fs.writeFileSync` in this case) without requiring you to pass the module object around. + +### Step 3 - bind direct values with `[@@js.runtime]` + +When you only need the primitive itself—such as a constant exported by a Node module—use `[@@js.runtime]` to obtain it directly as an OCaml value. + +```ocaml +(* runtime_primitives/primitives_bindings.mli continued *) + +val node_version : string [@@js.runtime "node_version"] +val log : string -> unit [@@js.runtime "node_console"] +``` + +These expand to `Jsoo_runtime.Js.runtime_value ...` calls and convert the results to the requested OCaml types, so you can expose constants or functions alongside the scoped modules described above. + +### Step 4 - port the JavaScript example + +`main.ml` mirrors the original JavaScript snippet that writes, reads, appends, and re-reads a file while logging progress to the Node console. It relies on the scoped `Fs`/`Path` modules plus the direct `log`, `path_separator`, and `node_version` values. + +```ocaml +open Bindings + +let initial_content = "Hello, Node.js!" +let appended_line = "\nAppending a new line." +let encoding = "utf-8" +let filename = "example.txt" + +let run () = + let file = Path.join ["."; filename] in + + Fs.write_file_sync file initial_content; + + let content = Fs.read_file_sync file ~encoding in + if content <> initial_content then + failwith "Unexpected initial content"; + log ("File content: " ^ content); + + let files = Fs.readdir_sync "." |> Array.to_list in + if not (List.mem filename files) then + failwith "example.txt missing from directory listing"; + log ("Files in current directory: " ^ String.concat ", " files); + + Fs.append_file_sync file appended_line; + + let updated = Fs.read_file_sync file ~encoding in + if updated <> initial_content ^ appended_line then + failwith "Append failed"; + log ("Updated content: " ^ updated); + log ("Path separator reported by Node: " ^ Path.separator); + log ("Node.js version: " ^ node_version) + + +let () = run () +``` + +### Putting it together + +1. Declare each required Node module once in `imports.js` (and mirror them in `imports.wat` for wasm) using the js_of_ocaml `//Provides:` convention. +2. Export the files through dune so that the js_of_ocaml toolchain registers those primitives at runtime. +3. Map node modules in OCaml with `module [@js.scope "@primitive"]` blocks, and use `[@@js.runtime]` for direct values. +4. Consume the generated modules from OCaml exactly as you would in JavaScript, as shown in `example.ml`. + +With these pieces in place you can keep writing high-level `gen_js_api` bindings while relying on the new runtime primitive support to bridge your OCaml code to Node-specific libraries provided via `require`. diff --git a/node-test/runtime_primitives/bindings.mli b/node-test/runtime_primitives/bindings.mli new file mode 100644 index 00000000..7ffc30d0 --- /dev/null +++ b/node-test/runtime_primitives/bindings.mli @@ -0,0 +1,14 @@ +module [@js.scope "@node_fs"] Fs : sig + val write_file_sync : string -> string -> unit [@@js.global "writeFileSync"] + val read_file_sync : string -> encoding:string -> string [@@js.global "readFileSync"] + val readdir_sync : string -> string array [@@js.global "readdirSync"] + val append_file_sync : string -> string -> unit [@@js.global "appendFileSync"] +end + +module [@js.scope "@node_path"] Path : sig + val separator: string [@@js.global "sep"] + val join : (string list [@js.variadic]) -> string [@@js.global "join"] +end + +val node_version : string [@@js.runtime "node_version"] +val log : string -> unit [@@js.runtime "node_console"] diff --git a/node-test/runtime_primitives/dune b/node-test/runtime_primitives/dune new file mode 100644 index 00000000..8f008ddb --- /dev/null +++ b/node-test/runtime_primitives/dune @@ -0,0 +1,28 @@ +(rule + (targets bindings.ml) + (deps bindings.mli) + (action + (run gen_js_api %{deps}))) + +(executable + (name example) + (libraries ojs) + (preprocess + (pps gen_js_api.ppx)) + (modes js wasm) + (js_of_ocaml + (javascript_files imports.js)) + (wasm_of_ocaml + (javascript_files imports.js imports.wat))) + +(rule + (alias runtest) + (enabled_if %{bin-available:node}) + (action + (run node %{dep:./example.bc.js}))) + +(rule + (alias runtest-wasm) + (enabled_if %{bin-available:node}) + (action + (run node %{dep:./example.bc.wasm.js}))) diff --git a/node-test/runtime_primitives/example.ml b/node-test/runtime_primitives/example.ml new file mode 100644 index 00000000..3ddd96ab --- /dev/null +++ b/node-test/runtime_primitives/example.ml @@ -0,0 +1,33 @@ +open Bindings + +let initial_content = "Hello, Node.js!" +let appended_line = "\nAppending a new line." +let encoding = "utf-8" +let filename = "example.txt" + +let run () = + let file = Path.join ["."; filename] in + + Fs.write_file_sync file initial_content; + + let content = Fs.read_file_sync file ~encoding in + if content <> initial_content then + failwith "Unexpected initial content"; + log ("File content: " ^ content); + + let files = Fs.readdir_sync "." |> Array.to_list in + if not (List.mem filename files) then + failwith "example.txt missing from directory listing"; + log ("Files in current directory: " ^ String.concat ", " files); + + Fs.append_file_sync file appended_line; + + let updated = Fs.read_file_sync file ~encoding in + if updated <> initial_content ^ appended_line then + failwith "Append failed"; + log ("Updated content: " ^ updated); + log ("Path separator reported by Node: " ^ Path.separator); + log ("Node.js version: " ^ node_version) + + +let () = run () diff --git a/node-test/runtime_primitives/imports.js b/node-test/runtime_primitives/imports.js new file mode 100644 index 00000000..f5878c0f --- /dev/null +++ b/node-test/runtime_primitives/imports.js @@ -0,0 +1,13 @@ +'use strict'; + +//Provides: node_path +var node_path = require('path'); + +//Provides: node_fs +var node_fs = require('fs'); + +//Provides: node_version +var node_version = require('process').version; + +//Provides: node_console +var node_console = console.log; diff --git a/node-test/runtime_primitives/imports.wat b/node-test/runtime_primitives/imports.wat new file mode 100644 index 00000000..c70c39d2 --- /dev/null +++ b/node-test/runtime_primitives/imports.wat @@ -0,0 +1,4 @@ +(global (export "_node_path") (import "js" "node_path") anyref) +(global (export "_node_fs") (import "js" "node_fs") anyref) +(global (export "_node_version") (import "js" "node_version") anyref) +(global (export "_node_console") (import "js" "node_console") anyref) From 7f3ef04792a787dea29b20ffebf9f198de459512 Mon Sep 17 00:00:00 2001 From: mlasson Date: Tue, 25 Nov 2025 16:46:08 +0100 Subject: [PATCH 4/4] Replace js.runtime by the support for '@' in js.global --- CHANGES.md | 2 +- NODE_RUNTIME_BINDINGS.md | 12 +- node-test/bindings/imports.mli | 2 +- node-test/runtime_primitives/bindings.mli | 4 +- ppx-lib/gen_js_api_ppx.ml | 248 +++++++++++----------- 5 files changed, 139 insertions(+), 129 deletions(-) diff --git a/CHANGES.md b/CHANGES.md index 42373a3d..d73873f2 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -4,7 +4,7 @@ Changelog Unreleased ---------- -- Experimental support for binding to js_of_ocaml runtime primitives via `[@@js.runtime]` and `[@@@js.scope "@..."]`, enabling generated bindings to target values supplied by the JavaScript runtime (such as Node imports and Wasm modules). +- Support for binding to js_of_ocaml runtime primitives via `@`-prefixed payloads on `[@@js.global]` and `[@@@js.scope "@..."]`, enabling generated bindings to target values supplied by the JavaScript runtime. - Test suite updates adapted for wasm_of_ocaml. Version 1.1.6 diff --git a/NODE_RUNTIME_BINDINGS.md b/NODE_RUNTIME_BINDINGS.md index 7279601d..cb0e46c1 100644 --- a/NODE_RUNTIME_BINDINGS.md +++ b/NODE_RUNTIME_BINDINGS.md @@ -2,7 +2,7 @@ This guide shows how to use the new runtime primitive support in `gen_js_api` to bind Node.js libraries that are usually obtained with `require(...)`. The feature hinges on two additions: -- the `[@@js.runtime "primitive_name"]` attribute returns an `Ojs.t` pointing to a primitive exported by the JavaScript runtime; +- any `[@@js.global "@primitive_name"]` binding returns an `Ojs.t` pointing to a primitive exported by the JavaScript runtime; - a scope string that starts with `@` (for example `[@@@js.scope "@node_fs.promises"]`) resolves the first path component through the runtime primitives before following regular properties. Together, those tools let you keep your bindings declarative while delegating the actual `require` calls to a tiny JavaScript stub. @@ -90,15 +90,15 @@ end ``` Each module-level scope starts with `@`, so the ppx turns calls like `Fs.write_file_sync` into direct invocations on the corresponding Node module (`node_fs.writeFileSync` in this case) without requiring you to pass the module object around. -### Step 3 - bind direct values with `[@@js.runtime]` +### Step 3 - bind direct values with `@`-prefixed `[@@js.global]` -When you only need the primitive itself—such as a constant exported by a Node module—use `[@@js.runtime]` to obtain it directly as an OCaml value. +When you only need the primitive itself—such as a constant exported by a Node module—use the `@` prefix inside `[@@js.global]` to obtain it directly as an OCaml value. ```ocaml (* runtime_primitives/primitives_bindings.mli continued *) -val node_version : string [@@js.runtime "node_version"] -val log : string -> unit [@@js.runtime "node_console"] +val node_version : string [@@js.global "@node_version"] +val log : string -> unit [@@js.global "@node_console"] ``` These expand to `Jsoo_runtime.Js.runtime_value ...` calls and convert the results to the requested OCaml types, so you can expose constants or functions alongside the scoped modules described above. @@ -147,7 +147,7 @@ let () = run () 1. Declare each required Node module once in `imports.js` (and mirror them in `imports.wat` for wasm) using the js_of_ocaml `//Provides:` convention. 2. Export the files through dune so that the js_of_ocaml toolchain registers those primitives at runtime. -3. Map node modules in OCaml with `module [@js.scope "@primitive"]` blocks, and use `[@@js.runtime]` for direct values. +3. Map node modules in OCaml with `module [@js.scope "@primitive"]` blocks, and use `@`-prefixed `[@@js.global]` bindings for direct values. 4. Consume the generated modules from OCaml exactly as you would in JavaScript, as shown in `example.ml`. With these pieces in place you can keep writing high-level `gen_js_api` bindings while relying on the new runtime primitive support to bridge your OCaml code to Node-specific libraries provided via `require`. diff --git a/node-test/bindings/imports.mli b/node-test/bindings/imports.mli index cf443b8c..8203f567 100644 --- a/node-test/bindings/imports.mli +++ b/node-test/bindings/imports.mli @@ -1 +1 @@ -val path: Ojs.t [@@js.runtime "node_path"] +val path: Ojs.t [@@js.global "@node_path"] diff --git a/node-test/runtime_primitives/bindings.mli b/node-test/runtime_primitives/bindings.mli index 7ffc30d0..c1d74f5f 100644 --- a/node-test/runtime_primitives/bindings.mli +++ b/node-test/runtime_primitives/bindings.mli @@ -10,5 +10,5 @@ module [@js.scope "@node_path"] Path : sig val join : (string list [@js.variadic]) -> string [@@js.global "join"] end -val node_version : string [@@js.runtime "node_version"] -val log : string -> unit [@@js.runtime "node_console"] +val node_version : string [@@js.global "@node_version"] +val log : string -> unit [@@js.global "@node_console"] diff --git a/ppx-lib/gen_js_api_ppx.ml b/ppx-lib/gen_js_api_ppx.ml index f387c25b..56f9ffb8 100644 --- a/ppx-lib/gen_js_api_ppx.ml +++ b/ppx-lib/gen_js_api_ppx.ml @@ -45,6 +45,7 @@ type error = | Sum_kind_args | Union_without_discriminator | Contravariant_type_parameter of string + | Cannot_set_runtime_value of string exception Error of Location.t * error @@ -181,6 +182,8 @@ let print_error ppf = function Format.fprintf ppf "Contravariant type parameter '%s is not allowed." label | Record_expected shape -> Format.fprintf ppf "Record %s expected." shape + | Cannot_set_runtime_value name -> + Format.fprintf ppf "Cannot set runtime value '%s'." name let () = Location.Error.register_error_of_exn @@ -296,7 +299,6 @@ type apply_type = | NewableFunction (* new f(..) *) type valdef = - | Runtime of string | Cast | Ignore | PropGet of string @@ -312,7 +314,6 @@ type valdef = | Auto of valdef let rec string_of_valdef = function - | Runtime _ -> "js.runtime" | Cast -> "js.cast" | Ignore -> "js.ignore" | PropGet _ -> "js.get" @@ -571,7 +572,6 @@ let parse_attr ~global_attrs (s, loc, auto) attribute = in let actions = [ "js.cast", (fun () -> Cast); - "js.runtime", (fun () -> Runtime (opt_name ())); "js.get", (fun () -> PropGet (opt_name ())); "js.set", (fun () -> PropSet (opt_name ~prefix:"set_" ())); "js.index_get", (fun () -> IndexGet); @@ -895,67 +895,76 @@ let ojs_set o s v = else ojs "set_prop" [o; ojs "string_to_js" [str s]; v] +let split_at s = + if String.length s > 0 && s.[0] = '@' then + Some (String.sub s 1 (String.length s - 1)) + else None + +let runtime s = + let runtime_value = Exp.ident (mknoloc (longident_parse "Jsoo_runtime.Js.runtime_value")) in + Exp.apply runtime_value (nolabel [Exp.constant (Pconst_string (s, Location.none, None))]) + let rec select_split_path o = function | [] -> assert false - | [x] -> o, x - | x :: xs -> select_split_path (ojs_get o x) xs + | (hd :: tl) as l -> + let o, l = + match split_at hd with + | Some s -> runtime s, tl + | None -> o, l + in + match l with + | [] -> o, None + | [x] -> o, Some x + | hd :: tl -> select_split_path (ojs_get o hd) tl let select_path o s = select_split_path o (split '.' s) let get_path global_object s = let o, x = select_path global_object s in - ojs_get o x - -let runtime s = - let runtime_value = Exp.ident (mknoloc (longident_parse "Jsoo_runtime.Js.runtime_value")) in - match split '.' s with - | s :: tl -> - let root = Exp.apply runtime_value (nolabel [Exp.constant (Pconst_string (s, Location.none, None))]) in - begin match tl with - | [] -> root - | _ -> - let o, x = select_split_path root tl in - ojs_get o x - end - | [] -> assert false + match x with + | None -> o + | Some x -> ojs_get o x let ojs_variable s = get_path ojs_global s -let set_path global_object s v = +let set_path ~loc global_object s v = let o, x = select_path global_object s in - ojs_set o x v + match x with + | None -> error loc (Cannot_set_runtime_value s) + | Some x -> + ojs_set o x v let def ?packages s ty body = let ty, body = match packages with | None | Some [] -> ty, body | Some packages -> - (* append module arguments *) - let folder1 (ty, body) (local_name, module_name) = - let package is_local = - let t = - if is_local then Typ.constr (mknoloc (Lident local_name)) [] - else Typ.var local_name - in - Typ.package (mknoloc (Ldot (Lident "Ojs", "T"))) [mknoloc (Lident "t"), t] in - let ty = Typ.arrow Nolabel (package false) ty in - let body = - let arg = - Pat.constraint_ - (Pat.unpack (mknoloc (Some module_name))) - (package true) + (* append module arguments *) + let folder1 (ty, body) (local_name, module_name) = + let package is_local = + let t = + if is_local then Typ.constr (mknoloc (Lident local_name)) [] + else Typ.var local_name + in + Typ.package (mknoloc (Ldot (Lident "Ojs", "T"))) [mknoloc (Lident "t"), t] in + let ty = Typ.arrow Nolabel (package false) ty in + let body = + let arg = + Pat.constraint_ + (Pat.unpack (mknoloc (Some module_name))) + (package true) + in + Ast_builder.Default.pexp_fun ~loc:Location.none Nolabel None arg body in - Ast_builder.Default.pexp_fun ~loc:Location.none Nolabel None arg body + ty, body in - ty, body - in - (* append locally abstract types *) - let folder2 (ty, body) (local_name, _) = - ty, Exp.newtype (mknoloc local_name) body - in - List.fold_left folder2 (List.fold_left folder1 (ty, body) packages) packages + (* append locally abstract types *) + let folder2 (ty, body) (local_name, _) = + ty, Exp.newtype (mknoloc local_name) body + in + List.fold_left folder2 (List.fold_left folder1 (ty, body) packages) packages in Str.value Nonrecursive [ Vb.mk ~value_constraint:(Pvc_constraint { locally_abstract_univars = []; typ = ty}) (Pat.var (mknoloc s)) body ] @@ -974,9 +983,16 @@ let ojs_apply_arr o = function | `Push arr -> ojs "call" [o; str "apply"; Exp.array [ ojs_null; arr ]] -let ojs_call_arr o s = function - | `Simple arr -> ojs "call" [o; str s; arr] - | `Push arr -> +let ojs_call_arr o s meth = + match s, meth with + | None, `Simple arr -> ojs "apply" [o; arr] + | Some s, `Simple arr -> ojs "call" [o; str s; arr] + | None, `Push arr -> + let_exp_in o + (fun o -> + ojs "call" [o; str "apply"; Exp.array [ ojs_null ; arr ]] + ) + | Some s, `Push arr -> let_exp_in o (fun o -> ojs "call" [ojs_get o s; str "apply"; Exp.array [ o; arr ]] @@ -1201,10 +1217,10 @@ and js2ml_of_variant ~variant loc ~global_attrs attrs constrs exp = let rec has_dup = function | [] | [ _ ] -> () | x :: ((y :: _) as l) -> - if compare_values x y = 0 then - error loc (Duplicate_case_value (x.loc, y.loc)) - else - has_dup l + if compare_values x y = 0 then + error loc (Duplicate_case_value (x.loc, y.loc)) + else + has_dup l in has_dup l in @@ -1254,18 +1270,18 @@ and js2ml_of_variant ~variant loc ~global_attrs attrs constrs exp = | Some m, None | None, Some m -> Some m | None, None -> None | Some _, Some _ -> - match int_default, float_default with - | _, None -> get_float_match (default_expr int_match) - | None, Some d -> - let case = - match get_int_match (default_expr (Some d.pc_rhs)) with - | None -> d - | Some int_match -> { d with pc_rhs = int_match } - in - get_float_match (Some case) - | Some d1, Some d2 -> - if d1 = d2 then get_float_match (default_expr int_match) - else error loc Multiple_default_case + match int_default, float_default with + | _, None -> get_float_match (default_expr int_match) + | None, Some d -> + let case = + match get_int_match (default_expr (Some d.pc_rhs)) with + | None -> d + | Some int_match -> { d with pc_rhs = int_match } + in + get_float_match (Some case) + | Some d1, Some d2 -> + if d1 = d2 then get_float_match (default_expr int_match) + else error loc Multiple_default_case in let string_match = gen_match ~fail_pattern:true (js2ml string_typ discriminator) string_default string_cases in let bool_match = gen_match ~fail_pattern:generate_fail_pattern_for_bool (js2ml bool_typ discriminator) bool_default bool_cases in @@ -1411,24 +1427,24 @@ and ml2js_of_variant ~variant loc ~global_attrs attrs constrs exp = | Nary args_typ -> begin match variant_kind with | `Enum | `Sum _ -> - let loc, args_field = get_string_attribute_default "js.arg" (location, "arg") attributes in - check_label loc args_field; - let xis = List.mapi (fun i typ -> i, typ, fresh()) args_typ in - let n_args = List.length xis in - Exp.case - (mkpat mlconstr (Some (Pat.tuple (List.map (fun (_, _, xi) -> Pat.var (mknoloc xi)) xis)))) - (let args = fresh() in - Exp.let_ Nonrecursive - [Vb.mk (Pat.var (mknoloc args)) (ojs "array_make" [int n_args])] - (List.fold_left - (fun e (i, typi, xi) -> - Exp.sequence - (ojs "array_set" [var args; int i; ml2js typi (var xi)]) e) - (mkobj [pair args_field Js (var args)]) - xis)) + let loc, args_field = get_string_attribute_default "js.arg" (location, "arg") attributes in + check_label loc args_field; + let xis = List.mapi (fun i typ -> i, typ, fresh()) args_typ in + let n_args = List.length xis in + Exp.case + (mkpat mlconstr (Some (Pat.tuple (List.map (fun (_, _, xi) -> Pat.var (mknoloc xi)) xis)))) + (let args = fresh() in + Exp.let_ Nonrecursive + [Vb.mk (Pat.var (mknoloc args)) (ojs "array_make" [int n_args])] + (List.fold_left + (fun e (i, typi, xi) -> + Exp.sequence + (ojs "array_set" [var args; int i; ml2js typi (var xi)]) e) + (mkobj [pair args_field Js (var args)]) + xis)) | `Union _ -> (* treat it as a tuple of the constructor arguments *) - let x = fresh() in - Exp.case (mkpat mlconstr (Some (Pat.var (mknoloc x)))) (ml2js (Tuple args_typ) (var x)) + let x = fresh() in + Exp.case (mkpat mlconstr (Some (Pat.var (mknoloc x)))) (ml2js (Tuple args_typ) (var x)) end | Record args -> let x = fresh() in @@ -1568,7 +1584,7 @@ and gen_typ ?(packaged_type_as_type_var = false) = function in let tl = if unit_arg then tl @ [{lab=Arg;att=[];typ=Unit none}] else tl in List.fold_right (fun {lab; att=_; typ} t2 -> - Typ.arrow (arg_label lab) (gen_typ ~packaged_type_as_type_var typ) t2) tl (gen_typ ~packaged_type_as_type_var ty_res) + Typ.arrow (arg_label lab) (gen_typ ~packaged_type_as_type_var typ) t2) tl (gen_typ ~packaged_type_as_type_var ty_res) | Variant {location = _; global_attrs = _; attributes = _; constrs} -> let f {mlconstr; arg; attributes = _; location = _} = let mlconstr = mknoloc mlconstr in @@ -1584,8 +1600,8 @@ and gen_typ ?(packaged_type_as_type_var = false) = function Typ.tuple (List.map (gen_typ ~packaged_type_as_type_var) typs) | Typ_var label -> Typ.var label | Packaged_type { local_name; _ } -> - if packaged_type_as_type_var then Typ.var local_name - else Typ.constr (mknoloc (Lident local_name)) [] + if packaged_type_as_type_var then Typ.var local_name + else Typ.constr (mknoloc (Lident local_name)) [] and mkfun ?typ ?eta f = let s = fresh () in @@ -1619,10 +1635,7 @@ let global_object ~global_attrs = begin match get_expr_attribute "js.scope" [hd] with | None -> traverse tl | Some {pexp_desc=Pexp_constant (Pconst_string (prop, _, _)); _} -> - if String.length prop > 0 && prop.[0] = '@' then - runtime (String.sub prop 1 (String.length prop - 1)) - else - get_path (traverse tl) prop + get_path (traverse tl) prop | Some {pexp_desc=Pexp_tuple path; _} -> let init = traverse tl in @@ -1759,31 +1772,31 @@ and gen_funs ~global_attrs p = match body with | None -> None | Some body -> - let params = - List.concat [ - List.map - (fun label -> + let params = + List.concat [ + List.map + (fun label -> { pparam_loc = loc; pparam_desc = Pparam_newtype - ({ label with txt = local_type_of_type_var label.txt})} - ) ctx_withloc; - List.map - (fun label -> + ({ label with txt = local_type_of_type_var label.txt})} + ) ctx_withloc; + List.map + (fun label -> let name = (local_type_of_type_var label)^suffix in let label = Name (local_type_of_type_var label, []) in { pparam_loc = loc; pparam_desc = Pparam_val (Nolabel, None, (Pat.constraint_ (Pat.var (mknoloc name)) (gen_typ (typ label))))} - ) ctx - ] - in - match params with - | [] -> Some body - | params -> - Some - ( - Ast_builder.Default.pexp_function ~loc - params - None (Pfunction_body body)) + ) ctx + ] + in + match params with + | [] -> Some body + | params -> + Some + ( + Ast_builder.Default.pexp_function ~loc + params + None (Pfunction_body body)) in let f (name, input_typs, ret_typ, code) = match code with @@ -1793,14 +1806,14 @@ and gen_funs ~global_attrs p = (Vb.mk ~loc:p.ptype_loc ~value_constraint:( Pvc_constraint { - locally_abstract_univars = []; - typ = - (poly - (gen_typ (Arrow - { - ty_args = (List.map (fun typ -> {lab=Arg; att=[]; typ}) input_typs); - ty_vararg = None; unit_arg = false; ty_res = ret_typ - })))}) + locally_abstract_univars = []; + typ = + (poly + (gen_typ (Arrow + { + ty_args = (List.map (fun typ -> {lab=Arg; att=[]; typ}) input_typs); + ty_vararg = None; unit_arg = false; ty_res = ret_typ + })))}) (Pat.var (mknoloc name)) code) in @@ -1900,7 +1913,7 @@ and gen_class_field x = function mkfun (fun arg -> ojs_set (var x) s (ml2js typ arg)) | MethodCall s, Arrow {ty_args; ty_vararg; unit_arg; ty_res} -> let formal_args, concrete_args = prepare_args ty_args ty_vararg in - let res = ojs_call_arr (var x) s concrete_args in + let res = ojs_call_arr (var x) (Some s) concrete_args in func formal_args unit_arg (js2ml_unit ty_res res) | MethodCall s, ty_res -> js2ml_unit ty_res (ojs "call" [var x; str s; Exp.array []]) @@ -1945,9 +1958,6 @@ and gen_class_cast = function and gen_def ~global_object loc decl ty = match decl, ty with - | Runtime s, _ -> - js2ml ty (runtime s) - | Cast, Arrow {ty_args = [{lab=Arg; att=_; typ}]; ty_vararg = None; unit_arg = false; ty_res} -> mkfun ~typ (fun this -> js2ml ty_res (ml2js typ this)) @@ -1977,12 +1987,12 @@ and gen_def ~global_object loc decl ty = mkfun ~typ:ty_this (fun this -> mkfun ~typ:ty_arg (fun arg -> res this arg)) | PropSet s, Arrow {ty_args = [{lab = Arg; att = _; typ = ty_arg}]; ty_vararg = None; unit_arg = false; ty_res = Unit _} -> - mkfun ~typ:ty_arg (fun arg -> set_path global_object s (ml2js ty_arg arg)) + mkfun ~typ:ty_arg (fun arg -> set_path ~loc:arg.pexp_loc global_object s (ml2js ty_arg arg)) | MethCall s, Arrow {ty_args = {lab=Arg; att=_; typ} :: ty_args; ty_vararg; unit_arg; ty_res} -> let formal_args, concrete_args = prepare_args ty_args ty_vararg in - let res this = ojs_call_arr (ml2js typ this) s concrete_args in + let res this = ojs_call_arr (ml2js typ this) (Some s) concrete_args in mkfun ~typ (fun this -> func formal_args unit_arg (js2ml_unit ty_res (res this))) | New name, Arrow {ty_args; ty_vararg; unit_arg; ty_res} ->