summaryrefslogtreecommitdiff
path: root/testsuite/tests/profiling/should_compile/T19894/Array.hs
diff options
context:
space:
mode:
authorMatthew Pickering <matthewtpickering@gmail.com>2021-06-03 23:04:13 +0100
committerMatthew Pickering <matthewtpickering@gmail.com>2021-06-03 23:40:34 +0100
commit95c57dd21b885f253de0b68d6c8349dd34e6471b (patch)
treecc5bc42bc828441bc6bf5872d85593639f91e192 /testsuite/tests/profiling/should_compile/T19894/Array.hs
parent7a05185a2b73c1f1c37e003178ea49667f66a462 (diff)
downloadhaskell-wip/t19894.tar.gz
profiling: Look in RHS of rules for cost centre tickswip/t19894
There are some obscure situations where the RHS of a rule can contain a tick which is not mentioned anywhere else in the program. If this happens you end up with an obscure linker error. The solution is quite simple, traverse the RHS of rules to also look for ticks. It turned out to be easier to implement if the traversal was moved into CoreTidy rather than at the start of code generation because there we still had easy access to the rules. ./StreamD.o(.text+0x1b9f2): error: undefined reference to 'StreamK_mkStreamFromStream_HPC_cc' ./MArray.o(.text+0xbe83): error: undefined reference to 'StreamK_mkStreamFromStream_HPC_cc' Main.o(.text+0x6fdb): error: undefined reference to 'StreamK_mkStreamFromStream_HPC_cc'
Diffstat (limited to 'testsuite/tests/profiling/should_compile/T19894/Array.hs')
-rw-r--r--testsuite/tests/profiling/should_compile/T19894/Array.hs74
1 files changed, 74 insertions, 0 deletions
diff --git a/testsuite/tests/profiling/should_compile/T19894/Array.hs b/testsuite/tests/profiling/should_compile/T19894/Array.hs
new file mode 100644
index 0000000000..75cad1fcef
--- /dev/null
+++ b/testsuite/tests/profiling/should_compile/T19894/Array.hs
@@ -0,0 +1,74 @@
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE RecordWildCards #-}
+module Array
+ (
+ Array(..)
+ , fromList
+ , read
+ , length
+ , writeNUnsafe
+ , MA.unsafeInlineIO
+ , MA.memcmp
+ , unsafeFreezeWithShrink
+ , foldl'
+ , unsafeIndexIO
+ )
+
+where
+
+import Control.Monad.IO.Class (MonadIO(..))
+import Foreign.Storable (Storable(..))
+import GHC.ForeignPtr (ForeignPtr(..))
+import GHC.IO (unsafePerformIO)
+import GHC.Ptr (Ptr(..))
+import Unfold (Unfold(..))
+import Fold (Fold(..))
+import qualified MArray as MA
+import qualified Unfold as UF
+import Prelude hiding (length, read)
+
+data Array a =
+ Array
+ { aStart :: {-# UNPACK #-} !(ForeignPtr a) -- first address
+ , aEnd :: {-# UNPACK #-} !(Ptr a) -- first unused addres
+ }
+
+{-# INLINE unsafeFreeze #-}
+unsafeFreeze :: MA.Array a -> Array a
+unsafeFreeze (MA.Array as ae _) = Array as ae
+
+{-# INLINABLE fromList #-}
+fromList :: Storable a => [a] -> Array a
+fromList xs = unsafeFreeze $ MA.fromList xs
+
+{-# INLINE [1] writeNUnsafe #-}
+writeNUnsafe :: forall m a. (MonadIO m, Storable a)
+ => Int -> Fold m a (Array a)
+writeNUnsafe n = unsafeFreeze <$> MA.writeNUnsafe n
+
+{-# INLINE unsafeThaw #-}
+unsafeThaw :: Array a -> MA.Array a
+unsafeThaw (Array as ae) = MA.Array as ae ae
+
+{-# INLINE length #-}
+length :: forall a. Storable a => Array a -> Int
+length arr = MA.length (unsafeThaw arr)
+
+{-# INLINE [1] read #-}
+read :: forall m a. (Monad m, Storable a) => Unfold m (Array a) a
+read = UF.lmap unsafeThaw MA.read
+
+{-# INLINE unsafeFreezeWithShrink #-}
+unsafeFreezeWithShrink :: Storable a => MA.Array a -> Array a
+unsafeFreezeWithShrink arr = unsafePerformIO $ do
+ MA.Array as ae _ <- MA.shrinkToFit arr
+ return $ Array as ae
+
+{-# INLINE [1] foldl' #-}
+foldl' :: forall a b. Storable a => (b -> a -> b) -> b -> Array a -> b
+foldl' f z arr = MA.foldl' f z (unsafeThaw arr)
+
+{-# INLINE [1] unsafeIndexIO #-}
+unsafeIndexIO :: forall a. Storable a => Array a -> Int -> IO a
+unsafeIndexIO arr = MA.unsafeIndexIO (unsafeThaw arr)
+