Add `Storable` instances for `Complex` and `Ratio`
authorCarter Tazio Schonwald <carter.schonwald@gmail.com>
Sun, 23 Nov 2014 21:08:21 +0000 (22:08 +0100)
committerHerbert Valerio Riedel <hvr@gnu.org>
Sun, 23 Nov 2014 21:21:54 +0000 (22:21 +0100)
The actual type-signatures of the new instances are:

  instance Storable a => Storable (Complex a)

  instance (Storable a, Integral a) => Storable (Ratio a)

See also

  https://groups.google.com/d/msg/haskell-core-libraries/mjBSo2CQ3LU/0gwg0QvviOIJ

Addresses #9826

Reviewed By: ekmett

Differential Revision: https://phabricator.haskell.org/D519

libraries/base/Data/Complex.hs
libraries/base/Foreign/Storable.hs
libraries/base/changelog.md
libraries/base/tests/T9826.hs [new file with mode: 0644]
libraries/base/tests/T9826.stdout [new file with mode: 0644]
libraries/base/tests/all.T

index 2baa60b..1c06d46 100644 (file)
@@ -36,6 +36,8 @@ module Data.Complex
 
 import Data.Typeable
 import Data.Data (Data)
+import Foreign (Storable, castPtr, peek, poke, pokeElemOff, peekElemOff, sizeOf,
+                alignment)
 
 infix  6  :+
 
@@ -171,3 +173,16 @@ instance  (RealFloat a) => Floating (Complex a) where
     asinh z        =  log (z + sqrt (1+z*z))
     acosh z        =  log (z + (z+1) * sqrt ((z-1)/(z+1)))
     atanh z        =  0.5 * log ((1.0+z) / (1.0-z))
+
+instance Storable a => Storable (Complex a) where
+    sizeOf a       = 2 * sizeOf (realPart a)
+    alignment a    = alignment (realPart a)
+    peek p           = do
+                        q <- return $ castPtr p
+                        r <- peek q
+                        i <- peekElemOff q 1
+                        return (r :+ i)
+    poke p (r :+ i)  = do
+                        q <-return $  (castPtr p)
+                        poke q r
+                        pokeElemOff q 1 i
index 35b1b49..52f3eda 100644 (file)
@@ -208,6 +208,19 @@ STORABLE(Int32,SIZEOF_INT32,ALIGNMENT_INT32,
 STORABLE(Int64,SIZEOF_INT64,ALIGNMENT_INT64,
          readInt64OffPtr,writeInt64OffPtr)
 
+instance (Storable a, Integral a) => Storable (Ratio a) where
+    sizeOf _    = 2 * sizeOf (undefined :: a)
+    alignment _ = alignment (undefined :: a )
+    peek p           = do
+                        q <- return $ castPtr p
+                        r <- peek q
+                        i <- peekElemOff q 1
+                        return (r % i)
+    poke p (r :% i)  = do
+                        q <-return $  (castPtr p)
+                        poke q r
+                        pokeElemOff q 1 i
+
 -- XXX: here to avoid orphan instance in GHC.Fingerprint
 instance Storable Fingerprint where
   sizeOf _ = 16
index 881532f..c7de12e 100644 (file)
     representing non-negative arbitrary-precision integers.  The `GHC.Natural`
     module exposes additional GHC-specific primitives. (#9818)
 
+  * Add `(Storable a, Integeral a) => Storable (Ratio a)` instance (#9826)
+
+  * Add `Storable a => Storable (Complex a)` instance (#9826)
+
 ## 4.7.0.1  *Jul 2014*
 
   * Bundled with GHC 7.8.3
diff --git a/libraries/base/tests/T9826.hs b/libraries/base/tests/T9826.hs
new file mode 100644 (file)
index 0000000..b35ada4
--- /dev/null
@@ -0,0 +1,24 @@
+{-# LANGUAGE BangPatterns #-}
+
+module Main where
+--import qualified Data.Vector.Storable as V
+import Foreign
+import Data.Ratio
+import Data.Complex
+
+complexZI :: Complex Int
+complexZI = 1 :+ 1
+
+ratio23 :: Ratio Int
+ratio23 =  1 % 1
+
+putter :: Storable a => a -> Ptr a -> IO a
+putter v !ptr = do poke ptr v ; peek ptr
+
+main =
+  do
+      !vComplex <- alloca (putter complexZI)
+      !vRatio <- alloca (putter ratio23)
+      if vComplex  == complexZI &&  vRatio  == ratio23
+        then putStrLn "success"
+        else putStrLn "uh oh, something is wrong with storable"
diff --git a/libraries/base/tests/T9826.stdout b/libraries/base/tests/T9826.stdout
new file mode 100644 (file)
index 0000000..2e9ba47
--- /dev/null
@@ -0,0 +1 @@
+success
index fa8ecd3..d4686e5 100644 (file)
@@ -178,3 +178,4 @@ test('T9532', normal, compile_and_run, [''])
 test('T9586', normal, compile, [''])
 test('T9681', normal, compile_fail, [''])
 test('T8089', normal, compile_and_run, [''])
+test('T9826',normal, compile_and_run,[''])