diff --git a/REQUIRE.md b/REQUIRE.md new file mode 100644 index 0000000..87be443 --- /dev/null +++ b/REQUIRE.md @@ -0,0 +1,124 @@ +Value bindings using required object in gen_js_api +========================================================= + +It happens sometime that, when writing bindings of js library, there +is a need to require some modules before using it. + +```js +const myModule = require('myModule') +/* ... */ +``` + +There is a support to automatically write bindings and to use the +required object instead of using the global object. + +The _require_ attribute +-------------------------- + +### Global ### + +The attribute `[@@@js.require "myModule"]` indicate to subsequents +declarations to use the require module **myModule** during the +generation phase. This global attribute requires the module name, it +cannot be inferred. + +### Local to a module ### + +It's also permitted to attach the require attribute to modules. + +```ocaml +module MyModule : sig + ... +end [@@js.require] +``` + +By default, the name of the module is used as the name of the js +module to require. + +### Associated to a variable ### + +To use bindings rules describe in [Value section](VALUES.md), it's +possible to put the annotation to a simple variable. + +```ocaml +type t = private Ojs.t + +val module_t : t Lazy.t [@@js.require "myModule"] + +val get_x : t -> int +``` + +###### Nested requires ###### + +Actually, it's not possible to nest requires. + +How is it translated ? +------------------------- + +First, it creates a definition which call lazily the requires +function: + +```ocaml +let (_require : Ojs.t Lazy.t) = lazy (Ojs.require "...") +``` + +Then, wherever the normal binding starts the access from the global +object, the require annotation modifies by forcing the lazy value. +For example, a method: `val foo: int -> string [@@js.call]`, is +translated to: + +```ocaml +let (foo : int -> string) = + fun x13 -> + Ojs.string_of_js + (Ojs.call (Lazy.force _require) "foo" [|(Ojs.int_to_js x13)|]) +``` + + +Automatic binding +------------------- + +A declaration under a require context also follow conventions as +explain in the [Value section](VALUES.md). The rules are quite +similar except that the explicit type `t` is not required anymore. +Here are the rules: + +- If the type has the form `t -> Ojs.t` and the value name is + `t_to_js`, it's still assumed to be a `[@@js.cast]`. + +- If the type has the form `Ojs.t -> t` and the value name is + `t_of_js`, it's still assumed to be a `[@@js.cast]`. + +- If the value is a function with a unit argument `unit -> t` + (and `t` is not `unit`), then the declaration is assumed to be + a `[@@js.get]` property getter. + +- If the value is a function with a single argument (named typed) + `t -> unit` and its name starts with `set_`, then the declaration is + assumed to be a `[@@js.set]` property setter (on the property whose + name is obtained by dropping the `set_` prefix). + +- Otherwise, the declaration is assumed to be a `[@@js.call]` value. + + +The scope attribute +---------------------- + +When js static objects are nested, there is a need to write nested +modules in the ocaml code. To indicate when it is necessary to access +a sub-object, the `[@@js.scope]` attribute is required. + +``` +module MyObject : sig + val my_method : a -> b -> c + module MySubObject : sig + val my_other_method : a -> b -> c + end [@@js.scope "mySubObject"] +end [@@js.require] +``` + +Without the scope attribute, the method `my_other_method` in module +`MySubObject` would be translated as if it were +`require('MyObject').myOtherMethod(a, b);`. The scope attribute change +this behaviour, by translating the same method as if it were following +javascript call: `require('MyObject').mySubObject.myOtherMethod(a, b);` diff --git a/VALUES.md b/VALUES.md index fd73cf2..9b83e8b 100644 --- a/VALUES.md +++ b/VALUES.md @@ -241,8 +241,8 @@ declarations in most cases. Here are the rules, applied in order: for a type declaration. - Similarly, if the type has the form `Ojs.t -> t` (for a local named - type `t`) and the value name is `t_to_js` (i.e. the type name - followed by `_to_js`), then the function is assumed to be a + type `t`) and the value name is `t_of_js` (i.e. the type name + followed by `_of_js`), then the function is assumed to be a `[@@js.cast]`. - If the value is a function with a single argument `t1 -> unit` and diff --git a/examples/require/Makefile b/examples/require/Makefile new file mode 100644 index 0000000..293f619 --- /dev/null +++ b/examples/require/Makefile @@ -0,0 +1,18 @@ +# The package gen_js_api is released under the terms of an MIT-like license. +# See the attached LICENSE file. +# Copyright 2015, 2016 by LexiFi. + +ROOT = ../.. +include $(ROOT)/Makefile.common + +.PHONY: all clean + +all: + $(GENJSAPI) test.mli + $(OCAMLC) -c -I $(OJSDIR) test.mli test.ml + $(OCAMLC) -c -I $(OJSDIR) -ppx "$(GENJSAPI) -ppx" main.ml + $(OCAMLC) -no-check-prims -o main.exe $(OJSDIR)/gen_js_api.cma test.cmo main.cmo + $(JSOO) $(OJSDIR)/ojs_runtime.js main.exe + +clean: + rm -f test_bindings.ml *.cm* main.exe main.js *~ diff --git a/examples/require/main.ml b/examples/require/main.ml new file mode 100644 index 0000000..6bc2546 --- /dev/null +++ b/examples/require/main.ml @@ -0,0 +1,39 @@ + +let test_show_int () = + Format.printf "a.show_int: %!"; + Test.A.show_int 42 + +let get_prop () = + Format.printf "a.get_prop: %s@." (Test.A.prop ()) + +let set_prop () = + Format.printf "a.set_prop; "; + Test.A.set_prop "Hello sweet world!"; + get_prop () + +let add () = + Format.printf "a.add 20 22: %d@." (Test.A.add 20 22) + +let test_b () = + let b = Test.B.new_b () in + Format.printf "b.incr: %d; " (b#incr ()); + Format.printf "b.decr: %d; " (b#decr ()); + Format.printf "b.incr: %d; " (b#incr ()); + Format.printf "b.incr: %d; " (b#incr ()); + Format.printf "b.incr: %d;@." (b#incr ()) + +let test_c () = + let c = Lazy.force Test.module_c in + Format.printf "c.incr(41): %d@." (Test.C.incr c 41); + Format.printf "c.show_string: %!"; + Test.C.show_string c "This is a C!"; + Format.printf "c.prop: %d@." (Test.C.prop c); + Format.printf "c.set_prop;"; + Test.C.set_prop c 1337; + Format.printf "c.prop: %d@." (Test.C.prop c) + +let functions = + [ test_show_int; get_prop; set_prop; add; + test_b; test_c ] + +let () = List.iter (fun f -> f ()) functions diff --git a/examples/require/test.mli b/examples/require/test.mli new file mode 100644 index 0000000..dcc29f9 --- /dev/null +++ b/examples/require/test.mli @@ -0,0 +1,28 @@ + +module A : sig + val show_int : int -> unit + val prop : unit -> string + val set_prop : string -> unit + val add : int -> int -> int +end [@@js.require "./a"] + +module B : sig + class b : Ojs.t -> + object + inherit Ojs.obj + method incr : unit -> int + method decr : unit -> int + end + + val new_b : unit -> b +end [@@js.require "./b"] + +module C : sig + type t = private Ojs.t + val incr : t -> int -> int + val show_string : t -> string -> unit + val prop : t -> int + val set_prop : t -> int -> unit +end + +val module_c : C.t Lazy.t [@@js.require "./c"] diff --git a/src/gen_js_api.ml b/src/gen_js_api.ml index ec369c5..5b22117 100644 --- a/src/gen_js_api.ml +++ b/src/gen_js_api.ml @@ -267,13 +267,16 @@ type classdecl = | Declaration of { class_name: string; class_fields: class_field list } | Constructor of { class_name: string; js_class_name: string; class_arrow: arrow_params } +type require = string option + type decl = - | Module of string * attributes * decl list + | Module of string * require * attributes * decl list | Type of rec_flag * Parsetree.type_declaration list | Val of string * typ * valdef * Location.t | Class of classdecl list | Implem of Parsetree.structure | Open of Parsetree.open_description + | JsRequire of string * typ option * string (** Parsing *) @@ -378,10 +381,14 @@ let in_global_scope ~global_attrs js = | [] -> js | (_ :: _) as revpath -> String.concat "." (List.rev (js :: revpath)) -let auto ~global_attrs s ty = +let auto ~require_ctx ~global_attrs s ty = let methcall s = let js = js_name ~global_attrs s in - if has_attribute "js.scope" global_attrs then Global (in_global_scope ~global_attrs js) + if has_attribute "js.scope" global_attrs + then + let js_scope = in_global_scope ~global_attrs js in + if require_ctx then MethCall js_scope + else Global js_scope else MethCall js in match ty with @@ -389,12 +396,17 @@ let auto ~global_attrs s ty = | Arrow {ty_args = [{lab=Arg; att=_; typ=Js}]; ty_vararg = None; unit_arg = false; ty_res = Name (t, [])} when check_suffix ~suffix:"_of_js" s = Some t -> Cast | Arrow {ty_args = [_]; ty_vararg = None; unit_arg = false; ty_res = Unit _} when has_prefix ~prefix:"set_" s -> PropSet (in_global_scope ~global_attrs (js_name ~global_attrs (drop_prefix ~prefix:"set_" s))) | Arrow {ty_args = [{lab=Arg; att=_; typ=Name _}]; ty_vararg = None; unit_arg = false; ty_res = Unit _} -> methcall s - | Arrow {ty_args = [{lab=Arg; att=_; typ=Name _}]; ty_vararg = None; unit_arg = false; ty_res = _} -> PropGet (js_name ~global_attrs s) - | Arrow {ty_args = []; ty_vararg = None; unit_arg = true; ty_res = _} -> PropGet (in_global_scope ~global_attrs (js_name ~global_attrs s)) + | Arrow {ty_args = [{lab=Arg; att=_; typ=Name _}]; ty_vararg = None; unit_arg = false; ty_res = _} -> if require_ctx then methcall s else PropGet (js_name ~global_attrs s) + | Arrow {ty_args = []; ty_vararg = None; unit_arg = true; ty_res = _} when not (has_prefix ~prefix:"new_" s) -> PropGet (in_global_scope ~global_attrs (js_name ~global_attrs s)) | Arrow {ty_args = [{lab=Arg; att=_; typ=Name _}; _]; ty_vararg = None; unit_arg = false; ty_res = Unit _} when has_prefix ~prefix:"set_" s -> PropSet (js_name ~global_attrs (drop_prefix ~prefix:"set_" s)) - | Arrow {ty_args = _; ty_vararg = None; unit_arg = false; ty_res = Name _} when has_prefix ~prefix:"new_" s -> New (in_global_scope ~global_attrs (js_name ~global_attrs (drop_prefix ~prefix:"new_" s))) + | Arrow {ty_args = _; ty_vararg = None; unit_arg; ty_res = Name _} when unit_arg = require_ctx && has_prefix ~prefix:"new_" s -> + (* When req_ctx is set, allow an automatic binding of a new_X function with type `unit -> ... -> T'. *) + New (in_global_scope ~global_attrs (js_name ~global_attrs (drop_prefix ~prefix:"new_" s))) | Arrow {ty_args = {lab=Arg; att=_; typ=Name _} :: _; ty_vararg = _; unit_arg = _; ty_res = _} -> methcall s - | _ -> Global (in_global_scope ~global_attrs (js_name ~global_attrs s)) + | _ -> + let js_name = in_global_scope ~global_attrs (js_name ~global_attrs s) in + if require_ctx then MethCall js_name + else Global js_name let auto_in_object ~global_attrs s = function | Arrow {ty_args = [{lab=Arg; att=_; typ=_}]; ty_vararg = None; unit_arg = false; ty_res = Unit _} when has_prefix ~prefix:"set_" s -> PropSet (js_name ~global_attrs (drop_prefix ~prefix:"set_" s)) @@ -444,32 +456,63 @@ let parse_attr ~global_attrs ?ty (s, loc, auto) (k, v) = | exception Not_found -> None | _, f -> Some (f ()) -let parse_valdecl ~global_attrs ~in_sig vd = +let parse_require_attribute ~require_ctx ~default attributes = + let require = + match get_attribute "js.require" attributes with + | None -> None + | Some (k, v) -> + if require_ctx then error k.loc (Not_supported_here "nested requires") + else + match v with + | PStr [] -> Some default + | _ -> Some (id_of_expr (expr_of_payload k.loc v)) + in + require, require_ctx || require <> None + +let parse_valdecl ~require_ctx ~global_attrs ~in_sig vd = let attributes = vd.pval_attributes in let global_attrs = attributes @ global_attrs in - let s = vd.pval_name.txt in - let loc = vd.pval_loc in - let ty = parse_typ ~global_attrs vd.pval_type in - let auto () = auto ~global_attrs s ty in - let defs = choose (parse_attr ~global_attrs ~ty (s, loc, auto)) attributes in - let r = - match defs with - | [x] -> x - | [] when in_sig -> auto () - | [] -> raise Exit - | _ -> error loc Multiple_binding_declarations + let require_res = + parse_require_attribute ~require_ctx + ~default:vd.pval_name.txt attributes in - Val (s, ty, r, loc) + match require_res with + | None, _ -> + let s = vd.pval_name.txt in + let loc = vd.pval_loc in + let ty = parse_typ ~global_attrs vd.pval_type in + let auto () = auto ~require_ctx ~global_attrs s ty in + let defs = choose (parse_attr ~global_attrs ~ty (s, loc, auto)) attributes in + let r = + match defs with + | [x] -> x + | [] when in_sig -> auto () + | [] -> raise Exit + | _ -> error loc Multiple_binding_declarations + in + Val (s, ty, r, loc) + | Some req_name, _ -> + let ty = parse_typ ~global_attrs vd.pval_type in + let require_type = + match ty with + | Name ("Lazy.t", [t]) -> t + | _ -> assert false + in + JsRequire (vd.pval_name.txt, Some require_type, req_name) -let rec parse_sig_item ~global_attrs rest s = +let rec parse_sig_item ~require_ctx ~global_attrs rest s = match s.psig_desc with | Psig_value vd when vd.pval_prim = [] -> - parse_valdecl ~global_attrs ~in_sig:true vd :: rest + parse_valdecl ~require_ctx ~global_attrs ~in_sig:true vd :: rest | Psig_type (rec_flag, decls) -> Type (rec_flag, decls) :: rest - | Psig_module {pmd_name; pmd_type = {pmty_desc = Pmty_signature si; pmty_attributes; pmty_loc = _}; pmd_loc = _; pmd_attributes = _} -> + | Psig_module {pmd_name; pmd_type = {pmty_desc = Pmty_signature si; pmty_attributes; pmty_loc = _}; pmd_loc = _; pmd_attributes} -> let global_attrs = pmty_attributes @ global_attrs in - Module (pmd_name.txt, pmty_attributes, parse_sig ~global_attrs si) :: rest + let require, require_ctx = + parse_require_attribute ~require_ctx ~default:pmd_name.txt + pmd_attributes + in + Module (pmd_name.txt, require, global_attrs, parse_sig ~require_ctx ~global_attrs si) :: rest | Psig_class cs -> Class (List.map (parse_class_decl ~global_attrs) cs) :: rest | Psig_attribute (attr, PStr str) when filter_attr_name "js.implem" attr -> Implem str :: rest | Psig_attribute _ -> rest @@ -477,22 +520,27 @@ let rec parse_sig_item ~global_attrs rest s = | _ -> error s.psig_loc Cannot_parse_sigitem -and parse_sig ~global_attrs = function +and parse_sig ~require_ctx ~global_attrs = function | [] -> [] | {psig_desc = Psig_attribute (attr, _); _} :: rest when filter_attr_name "js.stop" attr -> - parse_sig_verbatim ~global_attrs rest + parse_sig_verbatim ~require_ctx ~global_attrs rest + | {psig_desc = Psig_attribute (attr, payload); _} :: rest when + filter_attr_name "js.require" attr -> + let req_name = id_of_expr (expr_of_payload attr.loc payload) in + JsRequire ("_require", None, req_name) :: + parse_sig ~require_ctx:true ~global_attrs rest | {psig_desc = Psig_value vd; _} :: rest when has_attribute "js.custom" vd.pval_attributes -> let (k, v) = unoption (get_attribute "js.custom" vd.pval_attributes) in let str = str_of_payload k.loc v in - Implem str :: parse_sig ~global_attrs rest + Implem str :: parse_sig ~require_ctx ~global_attrs rest | s :: rest -> - parse_sig_item ~global_attrs (parse_sig ~global_attrs rest) s + parse_sig_item ~require_ctx ~global_attrs (parse_sig ~require_ctx ~global_attrs rest) s -and parse_sig_verbatim ~global_attrs = function +and parse_sig_verbatim ~require_ctx ~global_attrs = function | [] -> [] - | {psig_desc = Psig_attribute (attr, _); _} :: rest when filter_attr_name "js.start" attr -> parse_sig ~global_attrs rest - | _ :: rest -> parse_sig_verbatim ~global_attrs rest + | {psig_desc = Psig_attribute (attr, _); _} :: rest when filter_attr_name "js.start" attr -> parse_sig ~require_ctx ~global_attrs rest + | _ :: rest -> parse_sig_verbatim ~require_ctx ~global_attrs rest and parse_class_decl ~global_attrs = function | {pci_virt = Concrete; pci_params = []; pci_name; pci_expr = {pcty_desc = Pcty_arrow (Nolabel, {ptyp_desc = Ptyp_constr ({txt = Longident.Ldot (Lident "Ojs", "t"); loc = _}, []); ptyp_loc = _; ptyp_attributes = _}, {pcty_desc = Pcty_signature {pcsig_self = {ptyp_desc = Ptyp_any; _}; pcsig_fields}; pcty_loc = _; pcty_attributes = _}); _}; pci_attributes; pci_loc = _} -> @@ -658,21 +706,25 @@ let rec select_path o = function | [x] -> o, x | x :: xs -> select_path (ojs "get" [o; str x]) xs -let qualified_path s = +let qualified_path o s = let path = split '.' s in - select_path ojs_global path + select_path o path -let ojs_get_global s = - let o, x = qualified_path s in +let ojs_get o s = + let o, x = qualified_path o s in ojs "get" [o; str x] +let ojs_get_global = ojs_get ojs_global + let ojs_variable s = ojs_get_global s -let ojs_set_global s v = +let ojs_set o s v = let path = split '.' s in - match select_path ojs_global path with + match select_path o path with | o, x -> ojs "set" [o; str x; v] +let ojs_set_global = ojs_set ojs_global + let def s ty body = Str.value Nonrecursive [ Vb.mk (Pat.constraint_ (Pat.var (mknoloc s)) ty) body ] @@ -687,6 +739,11 @@ let let_exp_in exp f = let pat = Pat.var (mknoloc x) in Exp.let_ Nonrecursive [Vb.mk pat exp] (f (var x)) +let lazy_force vname = + apply + (Exp.ident (mknoloc (Longident.parse "Lazy.force"))) + [Nolabel, Exp.ident (mknoloc (Lident vname))] + let ojs_apply_arr o = function | `Simple arr -> ojs "apply" [o; arr] | `Push arr -> @@ -1182,8 +1239,9 @@ let process_fields ~global_attrs l = jsname, (* JS name *) parse_typ ~global_attrs typ -let rec gen_decls ~global_attrs si = - List.concat (List.map (gen_decl ~global_attrs) si) + +let rec gen_decls ~require_ctx ~global_attrs si = + List.concat (List.map (gen_decl ~require_ctx ~global_attrs) si) and gen_funs ~global_attrs p = let name = p.ptype_name.txt in @@ -1261,17 +1319,40 @@ and gen_funs ~global_attrs p = choose f [ name ^ "_of_js", Js, Name (name, []), of_js; name ^ "_to_js", Name (name, []), Js, to_js ] -and gen_decl ~global_attrs = function +and gen_decl ~require_ctx ~global_attrs = function | Type (rec_flag, decls) -> let decls = List.map rewrite_typ_decl decls in let funs = List.concat (List.map (gen_funs ~global_attrs) decls) in [ Str.type_ rec_flag decls; Str.value rec_flag funs ] - | Module (s, attrs, decls) -> + | Module (s, req, attrs, decls) -> let global_attrs = attrs @ global_attrs in - [ Str.module_ (Mb.mk (mknoloc s) (Mod.structure (gen_decls ~global_attrs decls))) ] + let decls, require_ctx = + match req with + | None -> + decls, require_ctx + | Some req -> + (JsRequire ("_require", None, js_name ~global_attrs req)) :: + decls, true + in + let module_structure = gen_decls ~require_ctx ~global_attrs decls in + [ Str.module_ (Mb.mk (mknoloc s) (Mod.structure module_structure)) ] + + | JsRequire (var_name, ty, req_name) -> + let ty = + match ty with + | None -> Js + | Some ty -> ty + in + let lazy_ty = + let ty = gen_typ ty in + Typ.constr (mknoloc (Longident.parse "Lazy.t")) [ty] + in + let req_name = js_name ~global_attrs req_name in + let call = Exp.lazy_ (apply (ojs_var "require") [Nolabel, str req_name]) in + [ def var_name lazy_ty call ] | Val (s, ty, decl, loc) -> - let d = gen_def loc decl ty in + let d = gen_def ~require_ctx loc decl ty in [ def s (gen_typ ty) d ] | Class decls -> @@ -1349,21 +1430,25 @@ and gen_class_cast = function [to_js; of_js] | Constructor {class_name = _; js_class_name = _; class_arrow = _} -> [] -and gen_def loc decl ty = +and gen_def ~require_ctx loc decl ty = match decl, ty with | Cast, Arrow {ty_args = [{lab=Arg; att=_; typ}]; ty_vararg = None; unit_arg = false; ty_res} -> mkfun (fun this -> js2ml ty_res (ml2js typ this)) | PropGet s, Arrow {ty_args = [{lab=Arg; att=_; typ}]; ty_vararg = None; unit_arg = false; ty_res} -> - mkfun (fun this -> js2ml ty_res (ojs "get" [ml2js typ this; str s])) + if require_ctx then error loc (Not_supported_here "property getter") + else mkfun (fun this -> js2ml ty_res (ojs "get" [ml2js typ this; str s])) | PropGet s, Arrow {ty_args = []; ty_vararg = None; unit_arg = true; ty_res} -> - fun_unit (gen_def loc (Global s) ty_res) + fun_unit + (if require_ctx + then js2ml ty_res (ojs_get (lazy_force "_require") s) + else gen_def ~require_ctx loc (Global s) ty_res) | Global s, ty_res -> begin match ty_res with | Arrow {ty_args; ty_vararg; unit_arg; ty_res} -> - let this, s = qualified_path s in + let this, s = qualified_path ojs_global s in let formal_args, concrete_args = prepare_args ty_args ty_vararg in let res this = ojs_call_arr (ml2js Js this) (str s) concrete_args in begin match ty_args, ty_vararg, unit_arg with @@ -1389,7 +1474,20 @@ and gen_def loc decl ty = mkfun (fun this -> mkfun (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 (fun arg -> ojs_set_global s (ml2js ty_arg arg)) + mkfun (fun arg -> + if require_ctx then ojs_set (lazy_force "_require") s (ml2js ty_arg arg) + else ojs_set_global s (ml2js ty_arg arg)) + + | MethCall s, + Arrow {ty_args; ty_vararg; unit_arg; ty_res} when require_ctx -> + let formal_args, concrete_args = prepare_args ty_args ty_vararg in + let path, fn = qualified_path (lazy_force "_require") s in + let res = ojs_call_arr path (str fn) concrete_args in + begin match ty_args, ty_vararg, unit_arg with + | [], None, false -> js2ml_unit ty_res res + | [], _, _ + | _ :: _, _, _ -> func formal_args unit_arg (js2ml_unit ty_res res) + end | MethCall s, Arrow {ty_args = {lab=Arg; att=_; typ} :: ty_args; ty_vararg; unit_arg; ty_res} -> @@ -1405,7 +1503,11 @@ and gen_def loc decl ty = | New name, Arrow {ty_args; ty_vararg; unit_arg; ty_res} -> let formal_args, concrete_args = prepare_args ty_args ty_vararg in - let res = ojs_new_obj_arr (ojs_variable name) concrete_args in + let constructor = + if require_ctx then ojs_get (lazy_force "_require") name + else ojs_variable name + in + let res = ojs_new_obj_arr constructor concrete_args in func formal_args unit_arg (js2ml ty_res res) | Builder global_attrs, Arrow {ty_args; ty_vararg = None; unit_arg; ty_res} -> @@ -1447,10 +1549,10 @@ and gen_def loc decl ty = (** ppx mapper *) and str_of_sg ~global_attrs sg = - let decls = parse_sig ~global_attrs sg in + let decls = parse_sig ~require_ctx:false ~global_attrs sg in attr "comment" (str "!! This code has been generated by gen_js_api !!") :: disable_warnings :: - gen_decls ~global_attrs decls + gen_decls ~require_ctx:false ~global_attrs decls and mapper = let open Ast_mapper in @@ -1466,9 +1568,9 @@ and mapper = let global_attrs = [] in match str.pstr_desc with | Pstr_primitive vd when vd.pval_prim = [] -> - begin match parse_valdecl ~global_attrs ~in_sig:false vd with + begin match parse_valdecl ~require_ctx:false ~global_attrs ~in_sig:false vd with | exception Exit -> str - | d -> incl (gen_decls ~global_attrs [d]) + | d -> incl (gen_decls ~require_ctx:false ~global_attrs [d]) end | Pstr_type (rec_flag, decls) -> let js_decls = List.filter (fun d -> has_attribute "js" d.ptype_attributes) decls in diff --git a/src/ojs.ml b/src/ojs.ml index 0c2d4df..228495f 100644 --- a/src/ojs.ml +++ b/src/ojs.ml @@ -107,3 +107,6 @@ let call_arr o s arr = call (get o s) "apply" [| o; arr |] external new_obj_arr: t -> t -> t = "caml_ojs_new_arr" external delete: t -> string -> unit = "caml_js_delete" + +let internal_require = pure_js_expr "require" +let require name = apply internal_require [| string_to_js name |] diff --git a/src/ojs.mli b/src/ojs.mli index e77a428..f673ca8 100644 --- a/src/ojs.mli +++ b/src/ojs.mli @@ -111,3 +111,5 @@ class obj: t -> end external delete: t -> string -> unit = "caml_js_delete" + +val require : string -> t