Runtime: misc

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"

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"

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,30 +84,85 @@ 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) {
   return function () {
     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) {