Closure Compiler support

Makefile

@@ -25,6 +25,8 @@ uninstall:
 	done
 	rm -f $(BINDIR)/ocamlfindjs
 
+reinstall: uninstall install
+
 clean:
 	for pkg in $(PKGLIST); do \
 		$(MAKE) -C src/$$pkg clean || exit; \

src/jslib/jslib_pp.ml

@@ -51,7 +51,7 @@ let pPrimary = 36
 
 module JSString =
 struct
-  external is_printable: char -> bool = "caml_is_printable"
+  let is_printable_ascii c = let cc = Char.code c in cc > 31 && cc < 127
 
   let escaped s =
     let buf = Buffer.create 0 in
@@ -67,7 +67,7 @@ struct
           | '\r' -> Buffer.add_string buf "\\r"
           | '\b' -> Buffer.add_string buf "\\b"
           | c ->
-              if is_printable c
+              if is_printable_ascii c
               then Buffer.add_char buf c
               else Printf.bprintf buf "\\x%02X" (Char.code c) in
     Array.iter escaped (Utf8.to_int_array s 0 (String.length s));

src/stdlib/patches/3.11.0/pervasives.ml

@@ -94,8 +94,8 @@ external (lsl) : int -> int -> int = "%lslint"
 external (lsr) : int -> int -> int = "%lsrint"
 external (asr) : int -> int -> int = "%asrint"
 
-let min_int = 1 lsl (if 1 lsl 31 = 0 then 30 else 62)
-let max_int = min_int - 1
+let min_int = 2 lsl (if 2 lsl 31 = 0 then 30 else 62)
+let max_int = min_int lxor (-1)
 
 (* Floating-point operations *)
 

src/stdlib/patches/3.11.0/pervasives.ml.patch

@@ -1,5 +1,5 @@
---- pervasives.ml.orig	2010-08-18 14:53:57.000000000 -0400
-+++ pervasives.ml	2010-08-19 15:43:56.000000000 -0400
+--- pervasives.ml.orig	2010-08-09 17:18:05.000000000 -0700
++++ pervasives.ml	2010-12-18 20:22:08.000000000 -0800
 @@ -1,3 +1,26 @@
 +(*
 + * This file is part of ocamljs, OCaml to Javascript compiler
@@ -27,6 +27,17 @@
  (***********************************************************************)
  (*                                                                     *)
  (*                           Objective Caml                            *)
+@@ -71,8 +94,8 @@
+ external (lsr) : int -> int -> int = "%lsrint"
+ external (asr) : int -> int -> int = "%asrint"
+
+-let min_int = 1 lsl (if 1 lsl 31 = 0 then 30 else 62)
+-let max_int = min_int - 1
++let min_int = 2 lsl (if 2 lsl 31 = 0 then 30 else 62)
++let max_int = min_int lxor (-1)
+
+ (* Floating-point operations *)
+
 @@ -137,11 +160,15 @@
                       = "caml_blit_string" "noalloc"
 

src/stdlib/patches/3.11.1/pervasives.ml

@@ -94,8 +94,8 @@ external (lsl) : int -> int -> int = "%lslint"
 external (lsr) : int -> int -> int = "%lsrint"
 external (asr) : int -> int -> int = "%asrint"
 
-let min_int = 1 lsl (if 1 lsl 31 = 0 then 30 else 62)
-let max_int = min_int - 1
+let min_int = 2 lsl (if 2 lsl 31 = 0 then 30 else 62)
+let max_int = min_int lxor (-1)
 
 (* Floating-point operations *)
 

src/stdlib/patches/3.11.1/pervasives.ml.patch

@@ -1,5 +1,5 @@
---- pervasives.ml.orig	2010-08-18 14:53:57.000000000 -0400
-+++ pervasives.ml	2010-08-19 15:43:12.000000000 -0400
+--- pervasives.ml.orig	2010-08-09 17:18:05.000000000 -0700
++++ pervasives.ml	2010-12-18 20:27:49.000000000 -0800
 @@ -1,3 +1,26 @@
 +(*
 + * This file is part of ocamljs, OCaml to Javascript compiler
@@ -27,6 +27,17 @@
  (***********************************************************************)
  (*                                                                     *)
  (*                           Objective Caml                            *)
+@@ -71,8 +94,8 @@
+ external (lsr) : int -> int -> int = "%lsrint"
+ external (asr) : int -> int -> int = "%asrint"
+
+-let min_int = 1 lsl (if 1 lsl 31 = 0 then 30 else 62)
+-let max_int = min_int - 1
++let min_int = 2 lsl (if 2 lsl 31 = 0 then 30 else 62)
++let max_int = min_int lxor (-1)
+
+ (* Floating-point operations *)
+
 @@ -137,11 +160,15 @@
                       = "caml_blit_string" "noalloc"
 

src/stdlib/patches/3.11.2/pervasives.ml

@@ -94,8 +94,8 @@ external (lsl) : int -> int -> int = "%lslint"
 external (lsr) : int -> int -> int = "%lsrint"
 external (asr) : int -> int -> int = "%asrint"
 
-let min_int = 1 lsl (if 1 lsl 31 = 0 then 30 else 62)
-let max_int = min_int - 1
+let min_int = 2 lsl (if 2 lsl 31 = 0 then 30 else 62)
+let max_int = min_int lxor (-1)
 
 (* Floating-point operations *)
 

src/stdlib/patches/3.11.2/pervasives.ml.patch

@@ -1,5 +1,5 @@
---- pervasives.ml.orig	2010-08-18 14:53:57.000000000 -0400
-+++ pervasives.ml	2010-08-19 15:43:36.000000000 -0400
+--- pervasives.ml.orig	2010-08-09 17:18:05.000000000 -0700
++++ pervasives.ml	2010-09-09 15:12:32.000000000 -0700
 @@ -1,3 +1,26 @@
 +(*
 + * This file is part of ocamljs, OCaml to Javascript compiler
@@ -27,6 +27,17 @@
  (***********************************************************************)
  (*                                                                     *)
  (*                           Objective Caml                            *)
+@@ -71,8 +94,8 @@
+ external (lsr) : int -> int -> int = "%lsrint"
+ external (asr) : int -> int -> int = "%asrint"
+
+-let min_int = 1 lsl (if 1 lsl 31 = 0 then 30 else 62)
+-let max_int = min_int - 1
++let min_int = 2 lsl (if 2 lsl 31 = 0 then 30 else 62)
++let max_int = min_int lxor (-1)
+
+ (* Floating-point operations *)
+
 @@ -137,11 +160,15 @@
                       = "caml_blit_string" "noalloc"
 

src/stdlib/patches/3.12.0/pervasives.ml

@@ -95,8 +95,8 @@ external (lsl) : int -> int -> int = "%lslint"
 external (lsr) : int -> int -> int = "%lsrint"
 external (asr) : int -> int -> int = "%asrint"
 
-let min_int = 1 lsl (if 1 lsl 31 = 0 then 30 else 62)
-let max_int = min_int - 1
+let min_int = 2 lsl (if 2 lsl 31 = 0 then 30 else 62)
+let max_int = min_int lxor (-1)
 
 (* Floating-point operations *)
 

src/stdlib/patches/3.12.0/pervasives.ml.patch

@@ -1,5 +1,5 @@
---- pervasives.ml.orig	2010-08-18 14:54:59.000000000 -0400
-+++ pervasives.ml	2010-08-19 15:44:19.000000000 -0400
+--- pervasives.ml.orig	2010-08-09 17:18:05.000000000 -0700
++++ pervasives.ml	2010-12-18 20:28:40.000000000 -0800
 @@ -1,3 +1,26 @@
 +(*
 + * This file is part of ocamljs, OCaml to Javascript compiler
@@ -27,6 +27,17 @@
  (***********************************************************************)
  (*                                                                     *)
  (*                           Objective Caml                            *)
+@@ -72,8 +95,8 @@
+ external (lsr) : int -> int -> int = "%lsrint"
+ external (asr) : int -> int -> int = "%asrint"
+
+-let min_int = 1 lsl (if 1 lsl 31 = 0 then 30 else 62)
+-let max_int = min_int - 1
++let min_int = 2 lsl (if 2 lsl 31 = 0 then 30 else 62)
++let max_int = min_int lxor (-1)
+
+ (* Floating-point operations *)
+
 @@ -141,11 +164,15 @@
                       = "caml_blit_string" "noalloc"
 

src/stdlib/primitives.js

@@ -75,10 +75,10 @@ var compare_val = function (v1, v2, total) {
       // XXX is there a way to get the class of an object as a value?
       // XXX is it worth special casing various JS objects?
       if (v1 instanceof Date) {
-	var t1 = v1.getTime();
-	var t2 = v2.getTime();
-	if (t1 < t2) return LESS;
-	if (t1 > t2) return GREATER;
+	var t_1 = v1.getTime();
+	var t_2 = v2.getTime();
+	if (t_1 < t_2) return LESS;
+	if (t_1 > t_2) return GREATER;
 	return EQUAL;
       }
       if (v1 instanceof Array) {
@@ -175,14 +175,17 @@ var caml_classify_float = function (f) {
   // can't determine subnormal from js afaik
   else return 0; // FP_normal
 }
+var caml_modf_float = function (f) {
+  var r = f % 1.0;
+  return [r,f-r];
+}
 
 var caml_greaterthan = function (v1, v2) { return compare_val(v1, v2, 0) > 0; }
 var caml_greaterequal = function (v1, v2) { return compare_val(v1, v2, 0) >= 0; }
 var caml_hash_univ_param = function (count, limit, obj) {
-  // globals
-  hash_univ_limit = limit;
-  hash_univ_count = count;
-  hash_accu = 0;
+  var hash_univ_limit = limit;
+  var hash_univ_count = count;
+  var hash_accu = 0;
 
   // XXX needs work
   function hash_aux(obj) {
@@ -771,18 +774,18 @@ function caml_finish_formatting(f, rawbuffer) {
   /* Do the formatting */
   var buffer = "";
   if (f.justify == '+' && f.filler == ' ')
-    for (i = len; i < f.width; i++) buffer += ' ';
+    for (var i = len; i < f.width; i++) buffer += ' ';
   if (f.signedconv) {
     if (f.sign < 0) buffer += '-';
     else if (f.signstyle != '-') buffer += f.signstyle;
   }
   if (f.alternate && f.base == 8) buffer += '0';
   if (f.alternate && f.base == 16) buffer += "0x";
   if (f.justify == '+' && f.filler == '0')
-    for (i = len; i < f.width; i++) buffer += '0';
+    for (var i = len; i < f.width; i++) buffer += '0';
   buffer += rawbuffer;
   if (f.justify == '-')
-    for (i = len; i < f.width; i++) buffer += ' ';
+    for (var i = len; i < f.width; i++) buffer += ' ';
   return buffer;
 }
 
@@ -806,7 +809,7 @@ function caml_format_float (fmt, x) {
   else
     switch (f.conv) {
     case 'e':
-      var s = x.toExponential(f.prec);
+      s = x.toExponential(f.prec);
       // exponent should be at least two digits
       var i = s.length;
       if (s.charAt(i - 3) == 'e')

src/stdlib/support.js

@@ -68,18 +68,7 @@ function ___m(m, t, a)
     var ml = m.$oc;
 
     if (al < ml)
-    {
-      switch (ml - al) {
-      case 1: return _f(1, function (z) { return m.apply(t, ap(a, arguments)) });
-      case 2: return _f(2, function (z,y) { return m.apply(t, ap(a, arguments)) });
-      case 3: return _f(3, function (z,y,x) { return m.apply(t, ap(a, arguments)) });
-      case 4: return _f(4, function (z,y,x,w) { return m.apply(t, ap(a, arguments)) });
-      case 5: return _f(5, function (z,y,x,w,v) { return m.apply(t, ap(a, arguments)) });
-      case 6: return _f(6, function (z,y,x,w,v,u) { return m.apply(t, ap(a, arguments)) });
-      case 7: return _f(7, function (z,y,x,w,v,u,s) { return m.apply(t, ap(a, arguments)) });
-      default: throw "unimplemented";
-      }
-    }
+      return _f(ml - al, function () { return m.apply(t, ap(a, arguments)) });
     else if (al == ml)
       return m.apply(t, a);
     else // al > ml
@@ -96,7 +85,7 @@ var $in_tail = false;
 // tail call
 function __m(m, t, args)
 {
-  if ('$oc' in m) {
+  if (m.$oc >= 0) {
     if ($in_tail) {
       args.$m = m;
       args.$t = t;
@@ -118,7 +107,7 @@ function __(t, args) { return __m(t, t, args); }
 // non tail call
 function _m(m, t, args)
 {
-  if ('$oc' in m) {
+  if (m.$oc >= 0) {
     var old_in_tail = $in_tail;
     $in_tail = true;
     try {
@@ -175,7 +164,7 @@ function oc$$asets(o, i, v) {
 }
 
 // mutable strings, argh
-
+/** @constructor */
 function oc$$ms(a) {
   this.a = a;
   this.length = a.length;