diff options
author | Matthew Pickering <matthewtpickering@gmail.com> | 2021-06-03 23:04:13 +0100 |
---|---|---|
committer | Matthew Pickering <matthewtpickering@gmail.com> | 2021-06-03 23:40:34 +0100 |
commit | 95c57dd21b885f253de0b68d6c8349dd34e6471b (patch) | |
tree | cc5bc42bc828441bc6bf5872d85593639f91e192 /testsuite/tests/profiling/should_compile/T19894/Array.hs | |
parent | 7a05185a2b73c1f1c37e003178ea49667f66a462 (diff) | |
download | haskell-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.hs | 74 |
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) + |