diff --git a/Makefile b/Makefile index ea2910d..5fe129d 100644 --- a/Makefile +++ b/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; \ diff --git a/src/jslib/jslib_pp.ml b/src/jslib/jslib_pp.ml index 7e7879d..5468847 100644 --- a/src/jslib/jslib_pp.ml +++ b/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)); diff --git a/src/stdlib/patches/3.11.0/pervasives.ml b/src/stdlib/patches/3.11.0/pervasives.ml index 8f1661d..c66236b 100644 --- a/src/stdlib/patches/3.11.0/pervasives.ml +++ b/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 *) diff --git a/src/stdlib/patches/3.11.0/pervasives.ml.patch b/src/stdlib/patches/3.11.0/pervasives.ml.patch index ec21b9a..1422db0 100644 --- a/src/stdlib/patches/3.11.0/pervasives.ml.patch +++ b/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" diff --git a/src/stdlib/patches/3.11.1/pervasives.ml b/src/stdlib/patches/3.11.1/pervasives.ml index 8f1661d..c66236b 100644 --- a/src/stdlib/patches/3.11.1/pervasives.ml +++ b/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 *) diff --git a/src/stdlib/patches/3.11.1/pervasives.ml.patch b/src/stdlib/patches/3.11.1/pervasives.ml.patch index 2fb58b7..95a8c91 100644 --- a/src/stdlib/patches/3.11.1/pervasives.ml.patch +++ b/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" diff --git a/src/stdlib/patches/3.11.2/pervasives.ml b/src/stdlib/patches/3.11.2/pervasives.ml index ddd9143..2eaaa6d 100644 --- a/src/stdlib/patches/3.11.2/pervasives.ml +++ b/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 *) diff --git a/src/stdlib/patches/3.11.2/pervasives.ml.patch b/src/stdlib/patches/3.11.2/pervasives.ml.patch index f88a6d8..85a6c71 100644 --- a/src/stdlib/patches/3.11.2/pervasives.ml.patch +++ b/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" diff --git a/src/stdlib/patches/3.12.0/pervasives.ml b/src/stdlib/patches/3.12.0/pervasives.ml index 9294bf4..2f214b8 100644 --- a/src/stdlib/patches/3.12.0/pervasives.ml +++ b/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 *) diff --git a/src/stdlib/patches/3.12.0/pervasives.ml.patch b/src/stdlib/patches/3.12.0/pervasives.ml.patch index b2b58d0..bd29df5 100644 --- a/src/stdlib/patches/3.12.0/pervasives.ml.patch +++ b/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" diff --git a/src/stdlib/primitives.js b/src/stdlib/primitives.js index 140fedd..8246752 100644 --- a/src/stdlib/primitives.js +++ b/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,7 +774,7 @@ 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; @@ -779,10 +782,10 @@ function caml_finish_formatting(f, rawbuffer) { 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') diff --git a/src/stdlib/support.js b/src/stdlib/support.js index e1a1400..2849bbc 100644 --- a/src/stdlib/support.js +++ b/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;