summaryrefslogtreecommitdiff
path: root/testsuite/tests/printer/Ppr019.hs
diff options
context:
space:
mode:
Diffstat (limited to 'testsuite/tests/printer/Ppr019.hs')
-rw-r--r--testsuite/tests/printer/Ppr019.hs427
1 files changed, 427 insertions, 0 deletions
diff --git a/testsuite/tests/printer/Ppr019.hs b/testsuite/tests/printer/Ppr019.hs
new file mode 100644
index 0000000000..c934cc5ccc
--- /dev/null
+++ b/testsuite/tests/printer/Ppr019.hs
@@ -0,0 +1,427 @@
+{-# LANGUAGE DeriveDataTypeable, FlexibleInstances, MultiParamTypeClasses,
+ CPP #-}
+#if __GLASGOW_HASKELL__ >= 708
+{-# LANGUAGE RoleAnnotations #-}
+#endif
+
+{-# OPTIONS_HADDOCK hide #-}
+-----------------------------------------------------------------------------
+-- |
+-- Module : Data.Array.IO.Internal
+-- Copyright : (c) The University of Glasgow 2001-2012
+-- License : BSD-style (see the file libraries/base/LICENSE)
+--
+-- Maintainer : libraries@haskell.org
+-- Stability : experimental
+-- Portability : non-portable (uses Data.Array.Base)
+--
+-- Mutable boxed and unboxed arrays in the IO monad.
+--
+-----------------------------------------------------------------------------
+
+module Data.Array.IO.Internals (
+ IOArray(..), -- instance of: Eq, Typeable
+ IOUArray(..), -- instance of: Eq, Typeable
+ castIOUArray, -- :: IOUArray ix a -> IO (IOUArray ix b)
+ unsafeThawIOUArray,
+ ) where
+
+import Data.Int
+import Data.Word
+import Data.Typeable
+
+import Control.Monad.ST ( RealWorld, stToIO )
+import Foreign.Ptr ( Ptr, FunPtr )
+import Foreign.StablePtr ( StablePtr )
+
+#if __GLASGOW_HASKELL__ < 711
+import Data.Ix
+#endif
+import Data.Array.Base
+
+import GHC.IOArray (IOArray(..))
+
+-----------------------------------------------------------------------------
+-- Flat unboxed mutable arrays (IO monad)
+
+-- | Mutable, unboxed, strict arrays in the 'IO' monad. The type
+-- arguments are as follows:
+--
+-- * @i@: the index type of the array (should be an instance of 'Ix')
+--
+-- * @e@: the element type of the array. Only certain element types
+-- are supported: see "Data.Array.MArray" for a list of instances.
+--
+newtype IOUArray i e = IOUArray (STUArray RealWorld i e)
+ deriving Typeable
+#if __GLASGOW_HASKELL__ >= 708
+-- Both parameters have class-based invariants. See also #9220.
+type role IOUArray nominal nominal
+#endif
+
+instance Eq (IOUArray i e) where
+ IOUArray s1 == IOUArray s2 = s1 == s2
+
+instance MArray IOUArray Bool IO where
+ {-# INLINE getBounds #-}
+ getBounds (IOUArray arr) = stToIO $ getBounds arr
+ {-# INLINE getNumElements #-}
+ getNumElements (IOUArray arr) = stToIO $ getNumElements arr
+ {-# INLINE newArray #-}
+ newArray lu initialValue = stToIO $ do
+ marr <- newArray lu initialValue; return (IOUArray marr)
+ {-# INLINE unsafeNewArray_ #-}
+ unsafeNewArray_ lu = stToIO $ do
+ marr <- unsafeNewArray_ lu; return (IOUArray marr)
+ {-# INLINE newArray_ #-}
+ newArray_ = unsafeNewArray_
+ {-# INLINE unsafeRead #-}
+ unsafeRead (IOUArray marr) i = stToIO (unsafeRead marr i)
+ {-# INLINE unsafeWrite #-}
+ unsafeWrite (IOUArray marr) i e = stToIO (unsafeWrite marr i e)
+
+instance MArray IOUArray Char IO where
+ {-# INLINE getBounds #-}
+ getBounds (IOUArray arr) = stToIO $ getBounds arr
+ {-# INLINE getNumElements #-}
+ getNumElements (IOUArray arr) = stToIO $ getNumElements arr
+ {-# INLINE newArray #-}
+ newArray lu initialValue = stToIO $ do
+ marr <- newArray lu initialValue; return (IOUArray marr)
+ {-# INLINE unsafeNewArray_ #-}
+ unsafeNewArray_ lu = stToIO $ do
+ marr <- unsafeNewArray_ lu; return (IOUArray marr)
+ {-# INLINE newArray_ #-}
+ newArray_ = unsafeNewArray_
+ {-# INLINE unsafeRead #-}
+ unsafeRead (IOUArray marr) i = stToIO (unsafeRead marr i)
+ {-# INLINE unsafeWrite #-}
+ unsafeWrite (IOUArray marr) i e = stToIO (unsafeWrite marr i e)
+
+instance MArray IOUArray Int IO where
+ {-# INLINE getBounds #-}
+ getBounds (IOUArray arr) = stToIO $ getBounds arr
+ {-# INLINE getNumElements #-}
+ getNumElements (IOUArray arr) = stToIO $ getNumElements arr
+ {-# INLINE newArray #-}
+ newArray lu initialValue = stToIO $ do
+ marr <- newArray lu initialValue; return (IOUArray marr)
+ {-# INLINE unsafeNewArray_ #-}
+ unsafeNewArray_ lu = stToIO $ do
+ marr <- unsafeNewArray_ lu; return (IOUArray marr)
+ {-# INLINE newArray_ #-}
+ newArray_ = unsafeNewArray_
+ {-# INLINE unsafeRead #-}
+ unsafeRead (IOUArray marr) i = stToIO (unsafeRead marr i)
+ {-# INLINE unsafeWrite #-}
+ unsafeWrite (IOUArray marr) i e = stToIO (unsafeWrite marr i e)
+
+instance MArray IOUArray Word IO where
+ {-# INLINE getBounds #-}
+ getBounds (IOUArray arr) = stToIO $ getBounds arr
+ {-# INLINE getNumElements #-}
+ getNumElements (IOUArray arr) = stToIO $ getNumElements arr
+ {-# INLINE newArray #-}
+ newArray lu initialValue = stToIO $ do
+ marr <- newArray lu initialValue; return (IOUArray marr)
+ {-# INLINE unsafeNewArray_ #-}
+ unsafeNewArray_ lu = stToIO $ do
+ marr <- unsafeNewArray_ lu; return (IOUArray marr)
+ {-# INLINE newArray_ #-}
+ newArray_ = unsafeNewArray_
+ {-# INLINE unsafeRead #-}
+ unsafeRead (IOUArray marr) i = stToIO (unsafeRead marr i)
+ {-# INLINE unsafeWrite #-}
+ unsafeWrite (IOUArray marr) i e = stToIO (unsafeWrite marr i e)
+
+instance MArray IOUArray (Ptr a) IO where
+ {-# INLINE getBounds #-}
+ getBounds (IOUArray arr) = stToIO $ getBounds arr
+ {-# INLINE getNumElements #-}
+ getNumElements (IOUArray arr) = stToIO $ getNumElements arr
+ {-# INLINE newArray #-}
+ newArray lu initialValue = stToIO $ do
+ marr <- newArray lu initialValue; return (IOUArray marr)
+ {-# INLINE unsafeNewArray_ #-}
+ unsafeNewArray_ lu = stToIO $ do
+ marr <- unsafeNewArray_ lu; return (IOUArray marr)
+ {-# INLINE newArray_ #-}
+ newArray_ = unsafeNewArray_
+ {-# INLINE unsafeRead #-}
+ unsafeRead (IOUArray marr) i = stToIO (unsafeRead marr i)
+ {-# INLINE unsafeWrite #-}
+ unsafeWrite (IOUArray marr) i e = stToIO (unsafeWrite marr i e)
+
+instance MArray IOUArray (FunPtr a) IO where
+ {-# INLINE getBounds #-}
+ getBounds (IOUArray arr) = stToIO $ getBounds arr
+ {-# INLINE getNumElements #-}
+ getNumElements (IOUArray arr) = stToIO $ getNumElements arr
+ {-# INLINE newArray #-}
+ newArray lu initialValue = stToIO $ do
+ marr <- newArray lu initialValue; return (IOUArray marr)
+ {-# INLINE unsafeNewArray_ #-}
+ unsafeNewArray_ lu = stToIO $ do
+ marr <- unsafeNewArray_ lu; return (IOUArray marr)
+ {-# INLINE newArray_ #-}
+ newArray_ = unsafeNewArray_
+ {-# INLINE unsafeRead #-}
+ unsafeRead (IOUArray marr) i = stToIO (unsafeRead marr i)
+ {-# INLINE unsafeWrite #-}
+ unsafeWrite (IOUArray marr) i e = stToIO (unsafeWrite marr i e)
+
+instance MArray IOUArray Float IO where
+ {-# INLINE getBounds #-}
+ getBounds (IOUArray arr) = stToIO $ getBounds arr
+ {-# INLINE getNumElements #-}
+ getNumElements (IOUArray arr) = stToIO $ getNumElements arr
+ {-# INLINE newArray #-}
+ newArray lu initialValue = stToIO $ do
+ marr <- newArray lu initialValue; return (IOUArray marr)
+ {-# INLINE unsafeNewArray_ #-}
+ unsafeNewArray_ lu = stToIO $ do
+ marr <- unsafeNewArray_ lu; return (IOUArray marr)
+ {-# INLINE newArray_ #-}
+ newArray_ = unsafeNewArray_
+ {-# INLINE unsafeRead #-}
+ unsafeRead (IOUArray marr) i = stToIO (unsafeRead marr i)
+ {-# INLINE unsafeWrite #-}
+ unsafeWrite (IOUArray marr) i e = stToIO (unsafeWrite marr i e)
+
+instance MArray IOUArray Double IO where
+ {-# INLINE getBounds #-}
+ getBounds (IOUArray arr) = stToIO $ getBounds arr
+ {-# INLINE getNumElements #-}
+ getNumElements (IOUArray arr) = stToIO $ getNumElements arr
+ {-# INLINE newArray #-}
+ newArray lu initialValue = stToIO $ do
+ marr <- newArray lu initialValue; return (IOUArray marr)
+ {-# INLINE unsafeNewArray_ #-}
+ unsafeNewArray_ lu = stToIO $ do
+ marr <- unsafeNewArray_ lu; return (IOUArray marr)
+ {-# INLINE newArray_ #-}
+ newArray_ = unsafeNewArray_
+ {-# INLINE unsafeRead #-}
+ unsafeRead (IOUArray marr) i = stToIO (unsafeRead marr i)
+ {-# INLINE unsafeWrite #-}
+ unsafeWrite (IOUArray marr) i e = stToIO (unsafeWrite marr i e)
+
+instance MArray IOUArray (StablePtr a) IO where
+ {-# INLINE getBounds #-}
+ getBounds (IOUArray arr) = stToIO $ getBounds arr
+ {-# INLINE getNumElements #-}
+ getNumElements (IOUArray arr) = stToIO $ getNumElements arr
+ {-# INLINE newArray #-}
+ newArray lu initialValue = stToIO $ do
+ marr <- newArray lu initialValue; return (IOUArray marr)
+ {-# INLINE unsafeNewArray_ #-}
+ unsafeNewArray_ lu = stToIO $ do
+ marr <- unsafeNewArray_ lu; return (IOUArray marr)
+ {-# INLINE newArray_ #-}
+ newArray_ = unsafeNewArray_
+ {-# INLINE unsafeRead #-}
+ unsafeRead (IOUArray marr) i = stToIO (unsafeRead marr i)
+ {-# INLINE unsafeWrite #-}
+ unsafeWrite (IOUArray marr) i e = stToIO (unsafeWrite marr i e)
+
+instance MArray IOUArray Int8 IO where
+ {-# INLINE getBounds #-}
+ getBounds (IOUArray arr) = stToIO $ getBounds arr
+ {-# INLINE getNumElements #-}
+ getNumElements (IOUArray arr) = stToIO $ getNumElements arr
+ {-# INLINE newArray #-}
+ newArray lu initialValue = stToIO $ do
+ marr <- newArray lu initialValue; return (IOUArray marr)
+ {-# INLINE unsafeNewArray_ #-}
+ unsafeNewArray_ lu = stToIO $ do
+ marr <- unsafeNewArray_ lu; return (IOUArray marr)
+ {-# INLINE newArray_ #-}
+ newArray_ = unsafeNewArray_
+ {-# INLINE unsafeRead #-}
+ unsafeRead (IOUArray marr) i = stToIO (unsafeRead marr i)
+ {-# INLINE unsafeWrite #-}
+ unsafeWrite (IOUArray marr) i e = stToIO (unsafeWrite marr i e)
+
+instance MArray IOUArray Int16 IO where
+ {-# INLINE getBounds #-}
+ getBounds (IOUArray arr) = stToIO $ getBounds arr
+ {-# INLINE getNumElements #-}
+ getNumElements (IOUArray arr) = stToIO $ getNumElements arr
+ {-# INLINE newArray #-}
+ newArray lu initialValue = stToIO $ do
+ marr <- newArray lu initialValue; return (IOUArray marr)
+ {-# INLINE unsafeNewArray_ #-}
+ unsafeNewArray_ lu = stToIO $ do
+ marr <- unsafeNewArray_ lu; return (IOUArray marr)
+ {-# INLINE newArray_ #-}
+ newArray_ = unsafeNewArray_
+ {-# INLINE unsafeRead #-}
+ unsafeRead (IOUArray marr) i = stToIO (unsafeRead marr i)
+ {-# INLINE unsafeWrite #-}
+ unsafeWrite (IOUArray marr) i e = stToIO (unsafeWrite marr i e)
+
+instance MArray IOUArray Int32 IO where
+ {-# INLINE getBounds #-}
+ getBounds (IOUArray arr) = stToIO $ getBounds arr
+ {-# INLINE getNumElements #-}
+ getNumElements (IOUArray arr) = stToIO $ getNumElements arr
+ {-# INLINE newArray #-}
+ newArray lu initialValue = stToIO $ do
+ marr <- newArray lu initialValue; return (IOUArray marr)
+ {-# INLINE unsafeNewArray_ #-}
+ unsafeNewArray_ lu = stToIO $ do
+ marr <- unsafeNewArray_ lu; return (IOUArray marr)
+ {-# INLINE newArray_ #-}
+ newArray_ = unsafeNewArray_
+ {-# INLINE unsafeRead #-}
+ unsafeRead (IOUArray marr) i = stToIO (unsafeRead marr i)
+ {-# INLINE unsafeWrite #-}
+ unsafeWrite (IOUArray marr) i e = stToIO (unsafeWrite marr i e)
+
+instance MArray IOUArray Int64 IO where
+ {-# INLINE getBounds #-}
+ getBounds (IOUArray arr) = stToIO $ getBounds arr
+ {-# INLINE getNumElements #-}
+ getNumElements (IOUArray arr) = stToIO $ getNumElements arr
+ {-# INLINE newArray #-}
+ newArray lu initialValue = stToIO $ do
+ marr <- newArray lu initialValue; return (IOUArray marr)
+ {-# INLINE unsafeNewArray_ #-}
+ unsafeNewArray_ lu = stToIO $ do
+ marr <- unsafeNewArray_ lu; return (IOUArray marr)
+ {-# INLINE newArray_ #-}
+ newArray_ = unsafeNewArray_
+ {-# INLINE unsafeRead #-}
+ unsafeRead (IOUArray marr) i = stToIO (unsafeRead marr i)
+ {-# INLINE unsafeWrite #-}
+ unsafeWrite (IOUArray marr) i e = stToIO (unsafeWrite marr i e)
+
+instance MArray IOUArray Word8 IO where
+ {-# INLINE getBounds #-}
+ getBounds (IOUArray arr) = stToIO $ getBounds arr
+ {-# INLINE getNumElements #-}
+ getNumElements (IOUArray arr) = stToIO $ getNumElements arr
+ {-# INLINE newArray #-}
+ newArray lu initialValue = stToIO $ do
+ marr <- newArray lu initialValue; return (IOUArray marr)
+ {-# INLINE unsafeNewArray_ #-}
+ unsafeNewArray_ lu = stToIO $ do
+ marr <- unsafeNewArray_ lu; return (IOUArray marr)
+ {-# INLINE newArray_ #-}
+ newArray_ = unsafeNewArray_
+ {-# INLINE unsafeRead #-}
+ unsafeRead (IOUArray marr) i = stToIO (unsafeRead marr i)
+ {-# INLINE unsafeWrite #-}
+ unsafeWrite (IOUArray marr) i e = stToIO (unsafeWrite marr i e)
+
+instance MArray IOUArray Word16 IO where
+ {-# INLINE getBounds #-}
+ getBounds (IOUArray arr) = stToIO $ getBounds arr
+ {-# INLINE getNumElements #-}
+ getNumElements (IOUArray arr) = stToIO $ getNumElements arr
+ {-# INLINE newArray #-}
+ newArray lu initialValue = stToIO $ do
+ marr <- newArray lu initialValue; return (IOUArray marr)
+ {-# INLINE unsafeNewArray_ #-}
+ unsafeNewArray_ lu = stToIO $ do
+ marr <- unsafeNewArray_ lu; return (IOUArray marr)
+ {-# INLINE newArray_ #-}
+ newArray_ = unsafeNewArray_
+ {-# INLINE unsafeRead #-}
+ unsafeRead (IOUArray marr) i = stToIO (unsafeRead marr i)
+ {-# INLINE unsafeWrite #-}
+ unsafeWrite (IOUArray marr) i e = stToIO (unsafeWrite marr i e)
+
+instance MArray IOUArray Word32 IO where
+ {-# INLINE getBounds #-}
+ getBounds (IOUArray arr) = stToIO $ getBounds arr
+ {-# INLINE getNumElements #-}
+ getNumElements (IOUArray arr) = stToIO $ getNumElements arr
+ {-# INLINE newArray #-}
+ newArray lu initialValue = stToIO $ do
+ marr <- newArray lu initialValue; return (IOUArray marr)
+ {-# INLINE unsafeNewArray_ #-}
+ unsafeNewArray_ lu = stToIO $ do
+ marr <- unsafeNewArray_ lu; return (IOUArray marr)
+ {-# INLINE newArray_ #-}
+ newArray_ = unsafeNewArray_
+ {-# INLINE unsafeRead #-}
+ unsafeRead (IOUArray marr) i = stToIO (unsafeRead marr i)
+ {-# INLINE unsafeWrite #-}
+ unsafeWrite (IOUArray marr) i e = stToIO (unsafeWrite marr i e)
+
+instance MArray IOUArray Word64 IO where
+ {-# INLINE getBounds #-}
+ getBounds (IOUArray arr) = stToIO $ getBounds arr
+ {-# INLINE getNumElements #-}
+ getNumElements (IOUArray arr) = stToIO $ getNumElements arr
+ {-# INLINE newArray #-}
+ newArray lu initialValue = stToIO $ do
+ marr <- newArray lu initialValue; return (IOUArray marr)
+ {-# INLINE unsafeNewArray_ #-}
+ unsafeNewArray_ lu = stToIO $ do
+ marr <- unsafeNewArray_ lu; return (IOUArray marr)
+ {-# INLINE newArray_ #-}
+ newArray_ = unsafeNewArray_
+ {-# INLINE unsafeRead #-}
+ unsafeRead (IOUArray marr) i = stToIO (unsafeRead marr i)
+ {-# INLINE unsafeWrite #-}
+ unsafeWrite (IOUArray marr) i e = stToIO (unsafeWrite marr i e)
+
+-- | Casts an 'IOUArray' with one element type into one with a
+-- different element type. All the elements of the resulting array
+-- are undefined (unless you know what you\'re doing...).
+castIOUArray :: IOUArray ix a -> IO (IOUArray ix b)
+castIOUArray (IOUArray marr) = stToIO $ do
+ marr' <- castSTUArray marr
+ return (IOUArray marr')
+
+{-# INLINE unsafeThawIOUArray #-}
+#if __GLASGOW_HASKELL__ >= 711
+unsafeThawIOUArray :: UArray ix e -> IO (IOUArray ix e)
+#else
+unsafeThawIOUArray :: Ix ix => UArray ix e -> IO (IOUArray ix e)
+#endif
+unsafeThawIOUArray arr = stToIO $ do
+ marr <- unsafeThawSTUArray arr
+ return (IOUArray marr)
+
+{-# RULES
+"unsafeThaw/IOUArray" unsafeThaw = unsafeThawIOUArray
+ #-}
+
+#if __GLASGOW_HASKELL__ >= 711
+thawIOUArray :: UArray ix e -> IO (IOUArray ix e)
+#else
+thawIOUArray :: Ix ix => UArray ix e -> IO (IOUArray ix e)
+#endif
+thawIOUArray arr = stToIO $ do
+ marr <- thawSTUArray arr
+ return (IOUArray marr)
+
+{-# RULES
+"thaw/IOUArray" thaw = thawIOUArray
+ #-}
+
+{-# INLINE unsafeFreezeIOUArray #-}
+#if __GLASGOW_HASKELL__ >= 711
+unsafeFreezeIOUArray :: IOUArray ix e -> IO (UArray ix e)
+#else
+unsafeFreezeIOUArray :: Ix ix => IOUArray ix e -> IO (UArray ix e)
+#endif
+unsafeFreezeIOUArray (IOUArray marr) = stToIO (unsafeFreezeSTUArray marr)
+
+{-# RULES
+"unsafeFreeze/IOUArray" unsafeFreeze = unsafeFreezeIOUArray
+ #-}
+
+#if __GLASGOW_HASKELL__ >= 711
+freezeIOUArray :: IOUArray ix e -> IO (UArray ix e)
+#else
+freezeIOUArray :: Ix ix => IOUArray ix e -> IO (UArray ix e)
+#endif
+freezeIOUArray (IOUArray marr) = stToIO (freezeSTUArray marr)
+
+{-# RULES
+"freeze/IOUArray" freeze = freezeIOUArray
+ #-}