Closure Compiler support #4

Open
wants to merge 8 commits into
from
View
@@ -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; \
View
@@ -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));
@@ -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 *)
@@ -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"
@@ -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 *)
@@ -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"
@@ -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 *)
@@ -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"
@@ -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 *)
@@ -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"
View
@@ -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')
View
@@ -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;