diff --git a/lib/js.ml b/lib/js.ml index 63e5fb97b2..fa725a93b3 100644 --- a/lib/js.ml +++ b/lib/js.ml @@ -24,6 +24,7 @@ type (-'a, +'b) meth_callback module Unsafe = struct type any + type any_js_array = any external inject : 'a -> any = "%identity" external coerce : _ t -> _ t = "%identity" @@ -34,6 +35,7 @@ module Unsafe = struct external fun_call : 'a -> any array -> 'b = "caml_js_fun_call" external meth_call : 'a -> string -> any array -> 'b = "caml_js_meth_call" external new_obj : 'a -> any array -> 'b = "caml_js_new" + external new_obj_arr : 'a -> any_js_array -> 'b = "caml_ojs_new_arr" external obj : (string * any) array -> 'a = "caml_js_object" @@ -50,7 +52,12 @@ module Unsafe = struct let global = pure_js_expr "joo_global_object" external callback : ('a -> 'b) -> ('c, 'a -> 'b) meth_callback = "%identity" + external callback_with_arguments : (any_js_array -> 'b) -> ('c, any_js_array -> 'b) meth_callback = "caml_js_wrap_callback_arguments" + external callback_with_arity : int -> ('a -> 'b) -> ('c, 'a -> 'b) meth_callback = "caml_js_wrap_callback_strict" + external meth_callback : ('b -> 'a) -> ('b, 'a) meth_callback = "caml_js_wrap_meth_callback_unsafe" + external meth_callback_with_arity : int -> ('b -> 'a) -> ('b, 'a) meth_callback = "caml_js_wrap_meth_callback_strict" + external meth_callback_with_arguments : ('b -> any_js_array -> 'a) -> ('b, any_js_array -> 'a) meth_callback = "caml_js_wrap_meth_callback_arguments" (* DEPRECATED *) external variable : string -> 'a = "caml_js_var" diff --git a/lib/js.mli b/lib/js.mli index 5c3acdfc4c..681ea15cfa 100644 --- a/lib/js.mli +++ b/lib/js.mli @@ -660,6 +660,8 @@ module Unsafe : sig (** Top type. Used for putting values of different types in a same array. *) + type any_js_array = any + external inject : 'a -> any = "%identity" (** Coercion to top type. *) @@ -698,6 +700,11 @@ module Unsafe : sig creates a Javascript object with constructor [c] using the arguments given by the array [a]. *) + external new_obj_arr : 'a -> any_js_array -> 'b = "caml_ojs_new_arr" + (** Same Create a Javascript object. The expression [new_obj_arr c a] + creates a Javascript object with constructor [c] using the + arguments given by the Javascript array [a]. *) + external obj : (string * any) array -> 'a = "caml_js_object" (** Creates a Javascript literal object. The expression [obj a] creates a Javascript object whose fields are given by @@ -728,15 +735,33 @@ module Unsafe : sig arguments will be set to [undefined] and extra arguments are lost. *) + external callback_with_arguments : (any_js_array -> 'b) -> ('c, any_js_array -> 'b) meth_callback = + "caml_js_wrap_callback_arguments" + (** Wrap an OCaml function so that it can be invoked from + Javascript. The first parameter of the function will be bound + to the [arguments] JavaScript *) + + external callback_with_arity : int -> ('a -> 'b) -> ('c, 'a -> 'b) meth_callback = + "caml_js_wrap_callback_strict" + external meth_callback : ('b -> 'a) -> ('b, 'a) meth_callback = "caml_js_wrap_meth_callback_unsafe" (** Wrap an OCaml function so that it can be invoked from - Javascript. The first parameter of the function will be bound + Javascript. The first parameter of the function will be bound to the value of the [this] implicit parameter. Contrary to [Js.wrap_meth_callback], partial application and over-application is not supported: missing arguments will be set to [undefined] and extra arguments are lost. *) + external meth_callback_with_arguments : ('b -> any_js_array -> 'a) -> ('b, any_js_array -> 'a) meth_callback = + "caml_js_wrap_meth_callback_arguments" + (** Wrap an OCaml function so that it can be invoked from Javascript. + The first parameter of the function will be bound to the value of the [this] implicit parameter. + The second parameter of the function with be bound to the value of the [arguments]. *) + + external meth_callback_with_arity : int -> ('b -> 'a) -> ('b, 'a) meth_callback = + "caml_js_wrap_meth_callback_strict" + (** {3 Deprecated functions.} *) external variable : string -> 'a = "caml_js_var" diff --git a/runtime/jslib_js_of_ocaml.js b/runtime/jslib_js_of_ocaml.js index d3aa0472c0..5b89f81d77 100644 --- a/runtime/jslib_js_of_ocaml.js +++ b/runtime/jslib_js_of_ocaml.js @@ -54,7 +54,19 @@ function caml_js_var(x) { function caml_js_call(f, o, args) { return f.apply(o, caml_js_from_array(args)); } //Provides: caml_js_fun_call (const, shallow) //Requires: caml_js_from_array -function caml_js_fun_call(f, args) { return f.apply(null, caml_js_from_array(args)); } +function caml_js_fun_call(f, a) { + switch (a.length) { + case 1: return f(); + case 2: return f (a[1]); + case 3: return f (a[1],a[2]); + case 4: return f (a[1],a[2],a[3]); + case 5: return f (a[1],a[2],a[3],a[4]); + case 6: return f (a[1],a[2],a[3],a[4],a[5]); + case 7: return f (a[1],a[2],a[3],a[4],a[5],a[6]); + case 8: return f (a[1],a[2],a[3],a[4],a[5],a[6],a[7]); + } + return f.apply(null, caml_js_from_array(a)); +} //Provides: caml_js_meth_call (mutable, const, shallow) //Requires: MlString //Requires: caml_js_from_array @@ -72,23 +84,59 @@ function caml_js_new(c, a) { case 5: return new c (a[1],a[2],a[3],a[4]); case 6: return new c (a[1],a[2],a[3],a[4],a[5]); case 7: return new c (a[1],a[2],a[3],a[4],a[5],a[6]); - case 8: return new c (a[1],a[2],a[3],a[4],a[5],a[6], a[7]); + case 8: return new c (a[1],a[2],a[3],a[4],a[5],a[6],a[7]); } function F() { return c.apply(this, caml_js_from_array(a)); } F.prototype = c.prototype; return new F; } +//Provides: caml_ojs_new_arr (const, shallow) +//Requires: caml_js_from_array +function caml_ojs_new_arr(c, a) { + switch (a.length) { + case 1: return new c; + case 2: return new c (a[0]); + case 3: return new c (a[0],a[1]); + case 4: return new c (a[0],a[1],a[2]); + case 5: return new c (a[0],a[1],a[2],a[3]); + case 6: return new c (a[0],a[1],a[2],a[3],a[4]); + case 7: return new c (a[0],a[1],a[2],a[3],a[4],a[5]); + case 8: return new c (a[0],a[1],a[2],a[3],a[4],a[5],a[6]); + } + function F() { return c.apply(this, a); } + F.prototype = c.prototype; + return new F; +} //Provides: caml_js_wrap_callback const (const) -//Requires: caml_call_gen,raw_array_copy +//Requires: caml_call_gen function caml_js_wrap_callback(f) { return function () { if(arguments.length > 0){ - return caml_call_gen(f, raw_array_copy(arguments)); + return caml_call_gen(f, arguments); } else { return caml_call_gen(f, [undefined]); } } } + +//Provides: caml_js_wrap_callback_arguments +//Requires: caml_js_wrap_callback +function caml_js_wrap_callback_arguments(f) { + return function() { + return caml_js_wrap_callback(f)(arguments); + } +} +//Provides: caml_js_wrap_callback_strict const +//Requires: caml_call_gen +function caml_js_wrap_callback_strict(arity, f) { + return function () { + var n = arguments.length; + if(n == arity) return caml_call_gen(f, arguments); + var args = new Array(arity); + for (var i = 0; i < n && i < arity; i++) args[i] = arguments[i]; + return caml_call_gen(f, args); + }; +} //Provides: caml_js_wrap_meth_callback const (const) //Requires: caml_call_gen,raw_array_cons function caml_js_wrap_meth_callback(f) { @@ -96,6 +144,25 @@ function caml_js_wrap_meth_callback(f) { return caml_call_gen(f,raw_array_cons(arguments,this)); } } +//Provides: caml_js_wrap_meth_callback_arguments const (const) +//Requires: caml_call_gen,raw_array_cons +function caml_js_wrap_meth_callback_arguments(f) { + return function () { + return caml_call_gen(f,[this,arguments]); + } +} +//Provides: caml_js_wrap_meth_callback_strict const +//Requires: caml_call_gen, raw_array_cons +function caml_js_wrap_meth_callback_strict(arity, f) { + return function () { + var n = arguments.length; + if(n == arity) return caml_call_gen(f, raw_array_cons(arguments,this)); + var args = new Array(arity + 1); + args[0] = this; + for (var i = 1; i < n && i <= arity; i++) args[i] = arguments[i]; + return caml_call_gen(f, args); + }; +} //Provides: caml_js_wrap_meth_callback_unsafe const (const) //Requires: caml_call_gen,raw_array_cons function caml_js_wrap_meth_callback_unsafe(f) {