From 6e3ebc4c49ed690daa41ab5df580faeb6bab3181 Mon Sep 17 00:00:00 2001
From: Alan Schmitt <alan.schmitt@polytechnique.org>
Date: Mon, 14 Mar 2016 09:55:13 +0100
Subject: [PATCH] getting rid of JsNumber
---
generator/Makefile | 5 +-
generator/tests/jsref/JsNumber.js | 31 +++++
generator/tests/jsref/JsNumber.ml | 206 -----------------------------
generator/tests/jsref/JsNumber.mli | 35 +++++
4 files changed, 70 insertions(+), 207 deletions(-)
create mode 100644 generator/tests/jsref/JsNumber.js
delete mode 100644 generator/tests/jsref/JsNumber.ml
create mode 100644 generator/tests/jsref/JsNumber.mli
diff --git a/generator/Makefile b/generator/Makefile
index 1f4d783..aa23952 100644
--- a/generator/Makefile
+++ b/generator/Makefile
@@ -36,7 +36,7 @@ ASSEMBLY_JS := \
Shared.log.js \
LibString.log.js \
LibOption.log.js \
- JsNumber.log.js \
+ JsNumber.js \
JsSyntax.log.js \
JsSyntaxAux.log.js \
Translate_syntax.js \
@@ -119,6 +119,9 @@ tests/%.cmi: tests/%.ml main.byte stdlib
##### Custome cmi rules for compilation of mli files without ml source
+$(JSREF_PATH)/JsNumber.cmi: $(JSREF_PATH)/JsNumber.mli
+ ocamlc -I $(JSREF_PATH) $<
+
$(JSREF_PATH)/Translate_syntax.cmi: $(JSREF_PATH)/Translate_syntax.mli $(JSREF_PATH)/JsSyntax.cmi stdlib
ocamlc -I $(JSREF_PATH) -I stdlib_ml -open Stdlib $<
diff --git a/generator/tests/jsref/JsNumber.js b/generator/tests/jsref/JsNumber.js
new file mode 100644
index 0000000..3b618ce
--- /dev/null
+++ b/generator/tests/jsref/JsNumber.js
@@ -0,0 +1,31 @@
+var JsNumber = {
+ /* Alternative approach to the int32 and uint32 conversions
+ source: http://www.2ality.com/2012/02/js-integers.html
+ function modulo(a, b) {
+ return a - Math.floor(a/b)*b;
+ }
+ function ToUint32(x) {
+ return modulo(ToInteger(x), Math.pow(2, 32));
+ }
+
+ function ToInt32(x) {
+ var uint32 = ToUint32(x);
+ if (uint32 >= Math.pow(2, 31)) {
+ return uint32 - Math.pow(2, 32)
+ } else {
+ return uint32;
+ }
+ }
+ */
+
+ // this works because the >>> operator first converts its first argument to uint32
+ to_uint32 : function (x) {
+ return x >>> 0;
+ },
+
+ // this works because the >> operator first converts its first argument to int32
+ to_int32 : function (x) {
+ return x >> 0;
+ }
+};
+
diff --git a/generator/tests/jsref/JsNumber.ml b/generator/tests/jsref/JsNumber.ml
deleted file mode 100644
index 29383d1..0000000
--- a/generator/tests/jsref/JsNumber.ml
+++ /dev/null
@@ -1,206 +0,0 @@
-open Fappli_IEEE_bits
-open LibReflect
-
-type number = binary64
-
-(** val nan : number **)
-
-let nan = nan
-
-(** val zero : number **)
-
-let zero = 0.
-
-(** val neg_zero : number **)
-
-let neg_zero = (-0.)
-
-(** val one : float **)
-
-let one = 1.
-
-(** val infinity : number **)
-
-let infinity = infinity
-
-(** val neg_infinity : number **)
-
-let neg_infinity = neg_infinity
-
-(** val max_value : number **)
-
-let max_value = max_float
-
-(** val min_value : number **)
-
-let min_value = min_float (* (Int64.float_of_bits Int64.one) *)
-
-
-(** val pi : number **)
-
-let pi = 3.141592654 (* (4. *. atan 1.) *)
-
-(** val e : number **)
-
-let e = 2.718281828 (* (exp 1.) *)
-
-(** val ln2 : number **)
-
-let ln2 = 0.693147181 (* (log 2.) *)
-
-
-(** val from_string : string -> number **)
-
-let from_string = (fun s ->
- (*try*)
- (* let s = (String.concat "" (List.map (String.make 1) s)) in ARTHUR hack*)
- if string_eq s "" then 0. else float_of_string s
- (* FIXME: with Failure "float_of_string" -> nan *) )
- (* Note that we're using `float_of_string' there, which does not have the same
- behavior than JavaScript. For instance it will read "022" as 22 instead of
- 18, which should be the JavaScript result for it. *)
-
-(** val to_string : number -> string **)
-
-let to_string = (fun f ->
- prerr_string ("Warning: JsNumber.to_string called. This might be responsible for errors. Argument value: " ^ string_of_float f ^ ".");
- prerr_newline();
- let string_of_number n =
- let sfn = string_of_float n in
- (if (string_eq sfn "inf") then "Infinity" else
- if (string_eq sfn "-inf") then "-Infinity" else
- if (string_eq sfn "nan") then "NaN" else
- let inum = int_of_float n in
- if (float_of_int inum = n) then (string_of_int inum) else (string_of_float n)) in
- string_of_number f
-
- (* ARTHUR hack
- let ret = ref [] in (* Ugly, but the API for OCaml string is not very functional... *)
- String.iter (fun c -> ret := c :: !ret) (string_of_number f);
- List.rev !ret
- *)
- )
- (* Note that this is ugly, we should use the spec of JsNumber.to_string here (9.8.1). *)
-
-
-(** val neg : number -> number **)
-
-let neg x = float_neg x
-
-(** val floor : number -> number **)
-
-let floor x = floor x
-
-(** val absolute : number -> number **)
-
-let absolute x = abs_float x
-
-(** val sign : number -> number **)
-
-let sign = (fun x -> float_of_int (float_compare x 0.))
-
-(*
- (** val lt_bool : number -> number -> bool **)
-
- let lt_bool = (<)
-
- (** val add : number -> number -> number **)
-
- let add = (+.)
-
- (** val sub : number -> number -> number **)
-
- let sub = (-.)
-
- (** val fmod : number -> number -> number **)
-
- let fmod = mod_float
-
- (** val mult : number -> number -> number **)
-
- let mult = ( *. )
-
- (** val div : number -> number -> number **)
-
- let div = (/.)
-
-*)
-
-
-
-
-(** val to_int32 : number -> float **)
-
-
-(* ARTHUR hacked this in *)
-let classify_float n =
- let x = classify_float n in
- match x with
- | FP_normal -> FP_normal
- | FP_subnormal -> FP_normal
- | _ -> x
-
-let to_int32 = fun n ->
- match classify_float n with
- | FP_normal -> (* ARTHUR hacked this from | FP_normal | FP_subnormal *)
- let i32 = float_exp 2. 32. in
- let i31 = float_exp 2. 31. in
- let posint = (if n < 0. then (-1.) else 1.) *. (floor (abs_float n)) in
- let int32bit =
- let smod = mod_float posint i32 in
- if smod < 0. then smod +. i32 else smod
- in
- (if int32bit >= i31 then int32bit -. i32 else int32bit)
- | _ -> 0.
-
-(** val to_uint32 : number -> float **)
-
-let to_uint32 = fun n ->
- match classify_float n with
- | FP_normal -> (* ARTHUR hacked this from | FP_normal | FP_subnormal *)
- let i32 = float_exp 2. 32. in
- let posint = (if n < 0. then (-1.) else 1.) *. (floor (abs_float n)) in
- let int32bit =
- let smod = mod_float posint i32 in
- if smod < 0. then smod +. i32 else smod
- in
- int32bit
- | _ -> 0.
-
-(** val modulo_32 : float -> float **)
-
-let modulo_32 = (fun x -> let r = mod_float x 32. in if x < 0. then r +. 32. else r)
-
-(** val int32_bitwise_not : float -> float **)
-
-let int32_bitwise_not = fun x -> Int32.to_float (Int32.lognot (Int32.of_float x))
-
-(** val int32_bitwise_and : float -> float -> float **)
-
-let int32_bitwise_and = fun x y -> Int32.to_float (Int32.logand (Int32.of_float x) (Int32.of_float y))
-
-(** val int32_bitwise_or : float -> float -> float **)
-
-let int32_bitwise_or = fun x y -> Int32.to_float (Int32.logor (Int32.of_float x) (Int32.of_float y))
-
-(** val int32_bitwise_xor : float -> float -> float **)
-
-let int32_bitwise_xor = fun x y -> Int32.to_float (Int32.logxor (Int32.of_float x) (Int32.of_float y))
-
-(** val int32_left_shift : float -> float -> float **)
-
-let int32_left_shift = (fun x y -> Int32.to_float (Int32.shift_left (Int32.of_float x) (int_of_float y)))
-
-(** val int32_right_shift : float -> float -> float **)
-
-let int32_right_shift = (fun x y -> Int32.to_float (Int32.shift_right (Int32.of_float x) (int_of_float y)))
-
-(** val uint32_right_shift : float -> float -> float **)
-
-let uint32_right_shift = (fun x y ->
- let i31 = float_exp 2. 31. in
- let i32 = float_exp 2. 32. in
- let newx = if x >= i31 then x -. i32 else x in
- let r = Int32.to_float (Int32.shift_right_logical (Int32.of_float newx) (int_of_float y)) in
- if r < 0. then r +. i32 else r)
-
diff --git a/generator/tests/jsref/JsNumber.mli b/generator/tests/jsref/JsNumber.mli
new file mode 100644
index 0000000..7d0a7cd
--- /dev/null
+++ b/generator/tests/jsref/JsNumber.mli
@@ -0,0 +1,35 @@
+type number = float
+
+val zero: number
+val neg_zero : number
+val one : number
+val infinity : number
+val neg_infinity : number
+val max_value : number
+val min_value : number
+val nan : number
+val pi : number
+val e : number
+val ln2 : number
+
+val from_string : string -> number
+val to_string : number -> string
+
+val to_int32 : number -> number
+val to_uint32 : number -> number
+
+val int32_left_shift : number -> number -> number
+val int32_right_shift : number -> number -> number
+
+val int32_bitwise_and : number -> number -> number
+val int32_bitwise_or : number -> number -> number
+val int32_bitwise_xor : number -> number -> number
+val int32_bitwise_not : number -> number
+
+val uint32_right_shift : number -> number -> number
+
+val neg : number -> number
+val sign : number -> number
+val absolute : number -> number
+
+val modulo_32 : number -> number
--
GitLab