updates for adjusted calling convention

Author: luite

Data/JSString.hs

@@ -241,7 +241,7 @@ unpack = S.unstreamList . stream
 {-# INLINE [1] unpack #-}
 
 unpack' :: JSString -> String
-unpack' x = case js_unpack x of (# z #) -> z
+unpack' x = unsafeCoerce (js_unpack x)
 {-# INLINE unpack' #-}
 
 -- | /O(n)/ Convert a literal string into a JSString.  Subject to fusion.
@@ -1181,7 +1181,7 @@ group x = group' x -- fixme, implement lazier version
 {-# INLINE group #-}
 
 group' :: JSString -> [JSString]
-group' x = case js_group x of (# z #) -> z
+group' x = unsafeCoerce (js_group x)
 {-# INLINE group' #-}
 
 -- | /O(n^2)/ Return all initial segments of the given 'JSString', shortest
@@ -1266,7 +1266,7 @@ splitOn' :: JSString
          -> [JSString]
 splitOn' pat src
   | null pat  = emptyError "splitOn'"
-  | otherwise = case js_splitOn pat src of (# z #) -> z
+  | otherwise = unsafeCoerce (js_splitOn pat src)
 {-# NOINLINE splitOn' #-}
 --- {-# INLINE [1] splitOn' #-}
 
@@ -1314,7 +1314,7 @@ chunksOf (I# k) p = go 0#
 -- > chunksOf 3 "foobarbaz"   == ["foo","bar","baz"]
 -- > chunksOf 4 "haskell.org" == ["hask","ell.","org"]
 chunksOf' :: Int -> JSString -> [JSString]
-chunksOf' (I# k) p = case js_chunksOf k p of (# z #) -> z
+chunksOf' (I# k) p = unsafeCoerce (js_chunksOf k p)
 {-# INLINE chunksOf' #-}
 
 -- ----------------------------------------------------------------------------
@@ -1423,7 +1423,7 @@ breakOnAll' :: JSString              -- ^ @needle@ to search for
             -> [(JSString, JSString)]
 breakOnAll' pat src
     | null pat  = emptyError "breakOnAll'"
-    | otherwise = case js_breakOnAll pat src of (# z #) -> z
+    | otherwise = unsafeCoerce (js_breakOnAll pat src)
 {-# INLINE breakOnAll' #-}
 
 -------------------------------------------------------------------------------
@@ -1512,7 +1512,7 @@ words x = loop 0# -- js_words x {- t@(Text arr off len) = loop 0 0
 
 -- fixme: strict words' that allocates the whole list in one go
 words' :: JSString -> [JSString]
-words' x = case js_words x of (# z #) -> z
+words' x = unsafeCoerce (js_words x)
 {-# INLINE words' #-}
 
 -- | /O(n)/ Breaks a 'JSString' up into a list of 'JSString's at
@@ -1527,7 +1527,7 @@ lines ps = loop 0#
 {-# INLINE lines #-}
 
 lines' :: JSString -> [JSString]
-lines' ps = case js_lines ps of (# z #) -> z
+lines' ps = unsafeCoerce (js_lines ps)
 {-# INLINE lines' #-}
 
 {-
@@ -1619,7 +1619,7 @@ isInfixOf needle haystack = js_isInfixOf needle haystack
 -- > fnordLength (stripPrefix "fnord" -> Just suf) = T.length suf
 -- > fnordLength _                                 = -1
 stripPrefix :: JSString -> JSString -> Maybe JSString
-stripPrefix x y = case js_stripPrefix x y of (# z #) -> z
+stripPrefix x y = unsafeCoerce (js_stripPrefix x y)
 {-# INLINE stripPrefix #-}
 
 -- | /O(n)/ Find the longest non-empty common prefix of two strings
@@ -1635,7 +1635,7 @@ stripPrefix x y = case js_stripPrefix x y of (# z #) -> z
 -- > commonPrefixes "veeble" "fetzer"  == Nothing
 -- > commonPrefixes "" "baz"           == Nothing
 commonPrefixes :: JSString -> JSString -> Maybe (JSString,JSString,JSString)
-commonPrefixes x y = case js_commonPrefixes x y of (# z #) -> z
+commonPrefixes x y = unsafeCoerce (js_commonPrefixes x y)
 {-# INLINE commonPrefixes #-}
 
 -- | /O(n)/ Return the prefix of the second string if its suffix
@@ -1657,7 +1657,7 @@ commonPrefixes x y = case js_commonPrefixes x y of (# z #) -> z
 -- > quuxLength (stripSuffix "quux" -> Just pre) = T.length pre
 -- > quuxLength _                                = -1
 stripSuffix :: JSString -> JSString -> Maybe JSString
-stripSuffix x y = case js_stripSuffix x y of (# z #) -> z
+stripSuffix x y = unsafeCoerce (js_stripSuffix x y)
 {-# INLINE stripSuffix #-}
 
 -- | Add a list of non-negative numbers.  Errors out on overflow.
@@ -1699,7 +1699,7 @@ foreign import javascript unsafe
 foreign import javascript unsafe
   "h$jsstringSingleton" js_singleton :: Char -> JSString
 foreign import javascript unsafe
-  "h$jsstringUnpack" js_unpack :: JSString -> (# String #)
+  "h$jsstringUnpack" js_unpack :: JSString -> Exts.Any -- String
 foreign import javascript unsafe
   "h$jsstringCons" js_cons :: Char -> JSString -> JSString
 foreign import javascript unsafe
@@ -1737,7 +1737,7 @@ foreign import javascript unsafe
 foreign import javascript unsafe
   "h$jsstringReverse" js_reverse :: JSString -> JSString
 foreign import javascript unsafe
-  "h$jsstringGroup"  js_group :: JSString -> (# [JSString] #) -- Exts.Any {- [JSString] -}
+  "h$jsstringGroup"  js_group :: JSString -> Exts.Any {- [JSString] -}
 --foreign import javascript unsafe
 --  "h$jsstringGroup1" js_group1
 --  :: Int# -> Bool -> JSString -> (# Int#, JSString #)
@@ -1751,11 +1751,11 @@ foreign import javascript unsafe
 foreign import javascript unsafe
   "h$jsstringWords1" js_words1 :: Int# -> JSString -> (# Int#, JSString #)
 foreign import javascript unsafe
-  "h$jsstringWords" js_words :: JSString -> (# [JSString] #) -- Exts.Any {- [JSString] -}
+  "h$jsstringWords" js_words :: JSString -> Exts.Any -- [JSString]
 foreign import javascript unsafe
   "h$jsstringLines1" js_lines1 :: Int# -> JSString -> (# Int#, JSString #)
 foreign import javascript unsafe
-  "h$jsstringLines" js_lines :: JSString -> (# [JSString] #) -- Exts.Any {- [JSString] -}
+  "h$jsstringLines" js_lines :: JSString -> Exts.Any -- [JSString]
 foreign import javascript unsafe
   "h$jsstringUnlines" js_unlines :: Exts.Any {- [JSString] -} -> JSString
 foreign import javascript unsafe
@@ -1768,16 +1768,16 @@ foreign import javascript unsafe
   "h$jsstringIsInfixOf" js_isInfixOf :: JSString -> JSString -> Bool
 foreign import javascript unsafe
   "h$jsstringStripPrefix" js_stripPrefix
-  :: JSString -> JSString -> (# Maybe JSString #)
+  :: JSString -> JSString -> Exts.Any -- Maybe JSString
 foreign import javascript unsafe
   "h$jsstringStripSuffix" js_stripSuffix
-  :: JSString -> JSString -> (# Maybe JSString #)
+  :: JSString -> JSString -> Exts.Any -- Maybe JSString
 foreign import javascript unsafe
   "h$jsstringCommonPrefixes" js_commonPrefixes
-  :: JSString -> JSString -> (# Maybe (JSString, JSString, JSString) #)
+  :: JSString -> JSString -> Exts.Any -- Maybe (JSString, JSString, JSString)
 foreign import javascript unsafe
   "h$jsstringChunksOf" js_chunksOf
-  :: Int# -> JSString -> (# [JSString] #)
+  :: Int# -> JSString -> Exts.Any -- [JSString]
 foreign import javascript unsafe
   "h$jsstringChunksOf1" js_chunksOf1
   :: Int# -> Int# -> JSString -> (# Int#, JSString #)
@@ -1786,7 +1786,7 @@ foreign import javascript unsafe
   :: Int# -> JSString -> (# JSString, JSString #)
 foreign import javascript unsafe
   "h$jsstringSplitOn" js_splitOn
-  :: JSString -> JSString -> (# [JSString] #)
+  :: JSString -> JSString -> Exts.Any -- [JSString]
 foreign import javascript unsafe
   "h$jsstringSplitOn1" js_splitOn1
   :: Int# -> JSString -> JSString -> (# Int#, JSString #)
@@ -1798,7 +1798,7 @@ foreign import javascript unsafe
   :: JSString -> JSString -> (# JSString, JSString #)
 foreign import javascript unsafe
   "h$jsstringBreakOnAll" js_breakOnAll
-  :: JSString -> JSString -> (# [(JSString, JSString)] #)
+  :: JSString -> JSString -> Exts.Any -- [(JSString, JSString)]
 foreign import javascript unsafe
   "h$jsstringBreakOnAll1" js_breakOnAll1
   :: Int# -> JSString -> JSString -> (# Int#, JSString, JSString #)

Data/JSString/Raw.hs

@@ -1,5 +1,5 @@
 {-# LANGUAGE ForeignFunctionInterface, JavaScriptFFI,
-             MagicHash, UnboxedTuples, UnliftedFFITypes
+             MagicHash, UnboxedTuples, UnliftedFFITypes, GHCForeignImportPrim
   #-}
 
 {-
@@ -110,7 +110,7 @@ rawChunksOf (I# k) x =
 {-# INLINE rawChunksOf #-}
 
 rawChunksOf' :: Int -> JSString -> [JSString]
-rawChunksOf' (I# k) x = case js_rawChunksOf k x of (# z #) -> z
+rawChunksOf' (I# k) x = unsafeCoerce (js_rawChunksOf k x)
 {-# INLINE rawChunksOf' #-}
 
 rawSplitAt :: Int -> JSString -> (JSString, JSString)
@@ -144,5 +144,5 @@ foreign import javascript unsafe
 foreign import javascript unsafe
   "$2.charCodeAt($1)" js_charCodeAt :: Int# -> JSString -> Int#
 foreign import javascript unsafe
-  "$hsRawChunksOf" js_rawChunksOf :: Int# -> JSString -> (# [JSString] #)
+  "$hsRawChunksOf" js_rawChunksOf :: Int# -> JSString -> Exts.Any -- [JSString]
 

Data/JSString/Read.hs

@@ -11,9 +11,10 @@ module Data.JSString.Read ( isInteger
                           , readInteger
                           , readIntegerMaybe
                           ) where
-import GHC.Exts (ByteArray#, Int#, Int64#, Word64#, Int(..))
+import GHC.Exts (Any, ByteArray#, Int#, Int64#, Word64#, Int(..))
 import GHC.Int (Int64(..))
 import GHC.Word (Word64(..))
+import Unsafe.Coerce
 import Data.Maybe
 import Data.JSString
 
@@ -130,7 +131,7 @@ readIntegerMaybe j = convertNullMaybe js_readInteger j
 convertNullMaybe :: (JSString -> ByteArray#) -> JSString -> Maybe a
 convertNullMaybe f j
   | js_isNull r = Nothing
-  | otherwise   = case js_toHeapObject r of (# h #) -> Just h
+  | otherwise   = unsafeCoerce (js_toHeapObject r)
   where
     r = f j
 {-# INLINE convertNullMaybe #-}
@@ -143,7 +144,7 @@ readError xs = error ("Data.JSString.Read." ++ xs)
 foreign import javascript unsafe
   "$1===null" js_isNull :: ByteArray# -> Bool
 foreign import javascript unsafe
-  "$r=$1;" js_toHeapObject :: ByteArray# -> (# a #)
+  "$r=$1;" js_toHeapObject :: ByteArray# -> Any
 foreign import javascript unsafe
   "h$jsstringReadInteger" js_readInteger :: JSString -> ByteArray#
 foreign import javascript unsafe

Data/JSString/RegExp.hs

@@ -18,7 +18,9 @@ module Data.JSString.RegExp ( RegExp
                             ) where
 
 import GHCJS.Prim
-import GHC.Exts (Int#, Int(..))
+import GHC.Exts (Any, Int#, Int(..))
+
+import Unsafe.Coerce (unsafeCoerce)
 
 import Data.JSString
 import Data.Typeable
@@ -67,7 +69,7 @@ execNext m re = case matchRawIndex m of
 exec' :: Int# -> JSString -> RegExp -> Maybe Match
 exec' i x re = case js_exec i x re of
                  (# -1#, _, _ #) -> Nothing
-                 (# i',  y, z #) -> Just (Match y z (I# i) x)
+                 (# i',  y, z #) -> Just (Match y (unsafeCoerce z) (I# i) x)
 {-# INLINE exec' #-}
 
 matches :: JSString -> RegExp -> [Match]
@@ -77,15 +79,15 @@ matches x r = maybe [] go (exec x r)
 {-# INLINE matches #-}
 
 replace :: RegExp -> JSString -> JSString -> JSString
-replace x r = undefined
+replace x r = error "Data.JSString.RegExp.replace not implemented"
 {-# INLINE replace #-}
 
 split :: JSString -> RegExp -> [JSString]
-split x r = case js_split -1# x r of (# y #) -> y
+split x r = unsafeCoerce (js_split -1# x r)
 {-# INLINE split #-}
 
 splitN :: Int -> JSString -> RegExp -> [JSString]
-splitN (I# k) x r = case js_split k x r of (# y #) -> y
+splitN (I# k) x r = unsafeCoerce (js_split k x r)
 {-# INLINE splitN #-}
 
 -- ----------------------------------------------------------------------------
@@ -96,11 +98,11 @@ foreign import javascript unsafe
   "$2.test($1)" js_test :: JSString -> RegExp -> Bool
 foreign import javascript unsafe
   "h$jsstringExecRE" js_exec
-  :: Int# -> JSString -> RegExp -> (# Int#, JSString, [JSString] #)
+  :: Int# -> JSString -> RegExp -> (# Int#, JSString, Any {- [JSString] -} #)
 foreign import javascript unsafe
   "h$jsstringReplaceRE" js_replace :: RegExp -> JSString -> JSString -> JSString
 foreign import javascript unsafe
-  "h$jsstringSplitRE" js_split :: Int# -> JSString -> RegExp -> (# [JSString] #)
+  "h$jsstringSplitRE" js_split :: Int# -> JSString -> RegExp -> Any -- [JSString]
 foreign import javascript unsafe
   "$1.multiline" js_isMultiline :: RegExp -> Bool
 foreign import javascript unsafe

GHCJS/Foreign/Export.hs

@@ -27,6 +27,7 @@ import Data.Typeable
 import Data.Typeable.Internal (TypeRep(..))
 import Data.Word
 import Unsafe.Coerce
+import qualified GHC.Exts as Exts
 
 import GHCJS.Prim
 
@@ -65,8 +66,7 @@ derefExport e = do
   r <- js_derefExport w1 w2 e
   if isNull r
     then return Nothing
-    else case js_toHeapObject r of
-                (# x #) -> return (Just x)
+    else unsafeCoerce (js_toHeapObject r)
 
 {- |
      Release all memory associated with the export. Subsequent calls to
@@ -84,7 +84,7 @@ foreign import javascript unsafe
   "h$derefExport"
   js_derefExport :: Word64 -> Word64 -> JSRef -> IO JSRef
 foreign import javascript unsafe
-  "$r = $1;" js_toHeapObject :: JSRef -> (# b #)
+  "$r = $1;" js_toHeapObject :: JSRef -> Exts.Any
 
 foreign import javascript unsafe
   "h$releaseExport"

JavaScript/Array.hs

@@ -10,7 +10,6 @@ module JavaScript.Array
     , fromListIO
     , toList
     , toListIO
-    , length
     , index, (!)
     , read
     , write

JavaScript/Array/Internal.hs

@@ -57,11 +57,12 @@ fromListIO xs = IO (\s -> rnf xs `seq` js_toJSArray (unsafeCoerce xs) s)
 {-# INLINE fromListIO #-}
 
 toList :: JSArray -> [JSRef]
-toList x = case js_fromJSArrayPure x of (# xs #) -> xs
+toList x = unsafeCoerce (js_fromJSArrayPure x)
 {-# INLINE toList #-}
 
 toListIO :: SomeJSArray m -> IO [JSRef]
-toListIO x = IO (js_fromJSArray x)
+toListIO x = IO $ \s -> case js_fromJSArray x s of
+                          (# s', xs #) -> (# s', unsafeCoerce xs #)
 {-# INLINE toListIO #-}
 
 index :: Int -> JSArray -> JSRef
@@ -180,11 +181,10 @@ foreign import javascript unsafe "$1.shift()"
 foreign import javascript unsafe "$1.reverse()"
   js_reverse  :: SomeJSArray m -> State# s -> (# State# s, () #)
 
-
 foreign import javascript unsafe "h$toHsListJSRef($1)"
-  js_fromJSArray :: SomeJSArray m -> State# s -> (# State# s, [JSRef] #)
+  js_fromJSArray :: SomeJSArray m -> State# s -> (# State# s, Exts.Any #)
 foreign import javascript unsafe "h$toHsListJSRef($1)"
-  js_fromJSArrayPure :: JSArray -> (# [JSRef] #)
+  js_fromJSArrayPure :: JSArray -> Exts.Any -- [JSRef]
 
 foreign import javascript unsafe "h$fromHsListJSRef($1)"
   js_toJSArray :: Exts.Any -> State# s -> (# State# s, SomeJSArray m #)

JavaScript/Array/ST.hs

@@ -60,7 +60,7 @@ fromList xs = ST (\s -> rnf xs `seq` I.js_toJSArray (unsafeCoerce xs) s)
 {-# INLINE fromList #-}
 
 toList :: STJSArray s -> ST s [JSRef]
-toList x = ST (I.js_fromJSArray x)
+toList x = ST (unsafeCoerce (I.js_fromJSArray x))
 {-# INLINE toList #-}
 
 read :: Int -> STJSArray s -> ST s (JSRef)

JavaScript/JSON/Types/Internal.hs

@@ -77,6 +77,8 @@ import qualified GHCJS.Prim.Internal.Build as IB
 import qualified JavaScript.Array          as A
 import qualified JavaScript.Array.Internal as AI
 
+import           Unsafe.Coerce
+
 data JSONException = UnknownKey
   deriving (Show, Typeable)
 
@@ -113,11 +115,12 @@ objectPropertiesIO o = js_objectProperties o
 {-# INLINE objectPropertiesIO #-}
 
 objectAssocs :: Object -> [(JSString, Value)]
-objectAssocs o = case js_listAssocsPure o of (# x #) -> x
+objectAssocs o = unsafeCoerce (js_listAssocsPure o)
 {-# INLINE objectAssocs #-}
 
 objectAssocsIO :: SomeObject m -> IO [(JSString, Value)]
-objectAssocsIO o = IO (js_listAssocs o)
+objectAssocsIO o = IO $ \s -> case js_listAssocs o s of
+                                (# s', r #) -> (# s', unsafeCoerce r #)
 {-# INLINE objectAssocsIO #-}
 
 type Pair        = (JSString, Value)
@@ -315,10 +318,10 @@ foreign import javascript unsafe
 
 foreign import javascript unsafe
   "h$listAssocs"
-  js_listAssocsPure :: Object -> (# [(JSString, Value)] #)
+  js_listAssocsPure :: Object -> Exts.Any -- [(JSString, Value)]
 foreign import javascript unsafe
   "h$listAssocs"
-  js_listAssocs :: SomeObject m -> Exts.State# s -> (# Exts.State# s, [(JSString, Value)] #)
+  js_listAssocs :: SomeObject m -> Exts.State# s -> (# Exts.State# s, Exts.Any {- [(JSString, Value)] -} #)
 
 foreign import javascript unsafe
   "JSON.stringify($1)"