implement missing JSString read functions and fix existing ones

Author: luite

Data/JSString/Read.hs

@@ -6,12 +6,20 @@ module Data.JSString.Read ( isInteger
                           , isNatural
                           , readInt
                           , readIntMaybe
+                          , lenientReadInt
+                          , readInt64
+                          , readInt64Maybe
+                          , readWord64
+                          , readWord64Maybe
                           , readDouble
                           , readDoubleMaybe
                           , readInteger
                           , readIntegerMaybe
                           ) where
-import GHC.Exts (Any, ByteArray#, Int#, Int64#, Word64#, Int(..))
+
+import GHCJS.Types
+
+import GHC.Exts (Any, Int#, Int64#, Word64#, Int(..))
 import GHC.Int (Int64(..))
 import GHC.Word (Word64(..))
 import Unsafe.Coerce
@@ -128,10 +136,10 @@ readIntegerMaybe j = convertNullMaybe js_readInteger j
 
 -- ----------------------------------------------------------------------------
 
-convertNullMaybe :: (JSString -> ByteArray#) -> JSString -> Maybe a
+convertNullMaybe :: (JSString -> JSRef) -> JSString -> Maybe a
 convertNullMaybe f j
   | js_isNull r = Nothing
-  | otherwise   = unsafeCoerce (js_toHeapObject r)
+  | otherwise   = Just (unsafeCoerce (js_toHeapObject r))
   where
     r = f j
 {-# INLINE convertNullMaybe #-}
@@ -142,21 +150,21 @@ readError xs = error ("Data.JSString.Read." ++ xs)
 -- ----------------------------------------------------------------------------
 
 foreign import javascript unsafe
-  "$1===null" js_isNull :: ByteArray# -> Bool
+  "$r = $1===null;" js_isNull :: JSRef -> Bool
 foreign import javascript unsafe
-  "$r=$1;" js_toHeapObject :: ByteArray# -> Any
+  "$r=$1;" js_toHeapObject :: JSRef -> Any
 foreign import javascript unsafe
-  "h$jsstringReadInteger" js_readInteger :: JSString -> ByteArray#
+  "h$jsstringReadInteger" js_readInteger :: JSString -> JSRef
 foreign import javascript unsafe
-  "h$jsstringReadInt" js_readInt :: JSString -> ByteArray#
+  "h$jsstringReadInt" js_readInt :: JSString -> JSRef
 foreign import javascript unsafe
-  "h$jsstringLenientReadInt" js_lenientReadInt :: JSString -> ByteArray#
+  "h$jsstringLenientReadInt" js_lenientReadInt :: JSString -> JSRef
 foreign import javascript unsafe
   "h$jsstringReadInt64" js_readInt64 :: JSString -> (# Int#, Int64# #)
 foreign import javascript unsafe
   "h$jsstringReadWord64" js_readWord64 :: JSString -> (# Int#, Word64# #)
 foreign import javascript unsafe
-  "h$jsstringReadDouble" js_readDouble :: JSString -> ByteArray#
+  "h$jsstringReadDouble" js_readDouble :: JSString -> JSRef
 foreign import javascript unsafe
   "h$jsstringIsInteger" js_isInteger :: JSString -> Bool
 foreign import javascript unsafe

jsbits/jsstring.js

@@ -958,49 +958,80 @@ function h$jsstringLenientReadInt(str) {
 }
 
 function h$jsstringReadWord(str) {
-    if(!/^\d+/.test(str)) return null;
-    var x = parseInt(str, 10);
-    var x0 = x|0;
-    if(x0<0) return (x===x0+2147483648) ? x0 : null;
-    else     return (x===x0) ? x0 : null;
+  if(!/^\d+/.test(str)) return null;
+  var x = parseInt(str, 10);
+  var x0 = x|0;
+  if(x0<0) return (x===x0+2147483648) ? x0 : null;
+  else     return (x===x0) ? x0 : null;
 }
 
 function h$jsstringReadDouble(str) {
-
+    return parseFloat(str, 10);
 }
 
 function h$jsstringLenientReadDouble(str) {
     return parseFloat(str, 10);
 }
 
 function h$jsstringReadInteger(str) {
-     throw "h$jsstringReadInteger not implemented";
+  TRACE_JSSTRING("readInteger: " + str);
+  if(!/^(-)?\d+$/.test(str)) {
+    return null;
+  } else if(str.length <= 9) {
+    return MK_INTEGER_S(parseInt(str, 10));
+  } else {
+    return MK_INTEGER_J(new BigInteger(str, 10));
+  }
 }
 
 function h$jsstringReadInt64(str) {
-    throw "h4JsstringReadInt64 not implemented";
+  if(!/^(-)?\d+$/.test(str)) {
+      RETURN_UBX_TUP3(0, 0, 0);
+  }
+  if(str.charCodeAt(0) === 45) { // '-'
+    return h$jsstringReadValue64(str, 1, true);
+  } else {
+    return h$jsstringReadValue64(str, 0, false);
+  }
 }
 
 function h$jsstringReadWord64(str) {
-    if(!/^\d+$/.test(str)) return 0;
-    var l = str.length, i = 0;
-    while(i < l) {
-	if(str.charCodeAt(i) !== 48) break;
-	i++;
-    }
-    if(i >= l) RETURN_UBX_TUP3(1, 0, 0); // only zeroes
-    var li = l-i;
-    if(li > 20) return 0; // too big
-    if(li < 10) RETURN_UBX_TUP3(1, 0, parseInt(str.substr(i), 10));
-    if(li < 18) {
-	var x1 = parseInt(str.substr(i+9), 10);
-	var x2 = parseInt(str.substr(i,9), 10);
-	var x3 = ((x2 % 10) * 1000000000 + x1)|0;
-	// var x4 = throw "jsstringReadWord64";
-        throw "jsstringReadWord64"; // fixme
-	RETURN_UBX_TUP3(1, x4, x3);
-    }
-    
+  if(!/^\d+$/.test(str)) {
+    RETURN_UBX_TUP3(0, 0, 0);
+  }
+  return h$jsstringReadValue64(str, 0, false);
+}
+
+var h$jsstringLongs = null;
+
+function h$jsstringReadValue64(str, start, negate) {
+  var l = str.length, i = start;
+  while(i < l) {
+    if(str.charCodeAt(i) !== 48) break;
+    i++;
+  }
+  if(i >= l) RETURN_UBX_TUP3(1, 0, 0); // only zeroes
+  if(h$jsstringLongs === null) {
+    h$jsstringLongs = [];
+    for(var t=10; t<=1000000000; t*=10) {
+      h$jsstringLongs.push(goog.math.Long.fromInt(t));
+    }
+  }
+  var li = l-i;
+  if(li < 10 && !negate) {
+    RETURN_UBX_TUP3(1, 0, parseInt(str.substr(i), 10));
+  }
+  var r = goog.math.Long.fromInt(parseInt(str.substr(li,9),10));
+  li += 9;
+  while(li < l) {
+    r = r.multiply(h$jsstringLongs[Math.min(l-li-1,8)])
+         .add(goog.math.Long.fromInt(parseInt(str.substr(li,9), 10)));
+    li += 9;
+  }
+  if(negate) {
+    r = r.negate();
+  }
+  RETURN_UBX_TUP3(1, r.getHighBits(), r.getLowBits());
 }
 
 function h$jsstringExecRE(i, str, re) {