[commit: ghc] master: Add `Storable` instances for `Complex` and `Ratio` (fb061c1)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/ghc

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/fb061c193947a7096471486faade1d0db30bc588/ghc

>---------------------------------------------------------------

commit fb061c193947a7096471486faade1d0db30bc588
Author: Carter Tazio Schonwald <carter.schonwald at gmail.com>
Date:   Sun Nov 23 22:08:21 2014 +0100

    Add `Storable` instances for `Complex` and `Ratio`
    
    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


>---------------------------------------------------------------

fb061c193947a7096471486faade1d0db30bc588
 libraries/base/Data/Complex.hs                     | 15 ++++++++++++++
 libraries/base/Foreign/Storable.hs                 | 13 ++++++++++++
 libraries/base/changelog.md                        |  4 ++++
 libraries/base/tests/T9826.hs                      | 24 ++++++++++++++++++++++
 .../base/tests/T9826.stdout                        |  0
 libraries/base/tests/all.T                         |  1 +
 6 files changed, 57 insertions(+)

diff --git a/libraries/base/Data/Complex.hs b/libraries/base/Data/Complex.hs
index 2baa60b..1c06d46 100644
--- a/libraries/base/Data/Complex.hs
+++ b/libraries/base/Data/Complex.hs
@@ -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
diff --git a/libraries/base/Foreign/Storable.hs b/libraries/base/Foreign/Storable.hs
index 35b1b49..52f3eda 100644
--- a/libraries/base/Foreign/Storable.hs
+++ b/libraries/base/Foreign/Storable.hs
@@ -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
diff --git a/libraries/base/changelog.md b/libraries/base/changelog.md
index 881532f..c7de12e 100644
--- a/libraries/base/changelog.md
+++ b/libraries/base/changelog.md
@@ -113,6 +113,10 @@
     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
index 0000000..b35ada4
--- /dev/null
+++ b/libraries/base/tests/T9826.hs
@@ -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/testsuite/tests/codeGen/should_run/StaticArraySize.stdout b/libraries/base/tests/T9826.stdout
similarity index 100%
copy from testsuite/tests/codeGen/should_run/StaticArraySize.stdout
copy to libraries/base/tests/T9826.stdout
diff --git a/libraries/base/tests/all.T b/libraries/base/tests/all.T
index fa8ecd3..d4686e5 100644
--- a/libraries/base/tests/all.T
+++ b/libraries/base/tests/all.T
@@ -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,[''])