[commit: ghc] master: testsuite: AMPify T3001-2 (29e50da)

[git at git.haskell.org]

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

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

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

commit 29e50da4c274eba0e444ce4b95294a76832908f2
Author: Joachim Breitner <mail at joachim-breitner.de>
Date:   Wed Sep 10 11:26:10 2014 +0200

    testsuite: AMPify T3001-2


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

29e50da4c274eba0e444ce4b95294a76832908f2
 testsuite/tests/profiling/should_run/T3001-2.hs | 18 ++++++++++++++----
 1 file changed, 14 insertions(+), 4 deletions(-)

diff --git a/testsuite/tests/profiling/should_run/T3001-2.hs b/testsuite/tests/profiling/should_run/T3001-2.hs
index 5c0cb3e..5a84dcc 100644
--- a/testsuite/tests/profiling/should_run/T3001-2.hs
+++ b/testsuite/tests/profiling/should_run/T3001-2.hs
@@ -26,6 +26,8 @@ import System.IO
 
 import Data.Char    (chr,ord)
 
+import Control.Applicative
+
 main :: IO ()
 main = do
   encodeFile "test.bin" $ replicate 10000 'x'
@@ -96,6 +98,10 @@ instance Monad PutM where
             PairS b w' = unPut k
         in PairS b (w `mappend` w')
 
+instance Applicative PutM where
+    pure  = return
+    (<*>) = ap
+
 tell :: Builder -> Put
 tell b = Put $ PairS () b
 
@@ -188,6 +194,10 @@ instance Monad Get where
 
     fail      = error "failDesc"
 
+instance Applicative Get where
+    pure  = return
+    (<*>) = ap
+
 getZ :: Get S
 getZ   = Get (\s -> (s, s))
 
@@ -238,7 +248,7 @@ toLazyByteString m = L.fromChunks $ unsafePerformIO $ do
 
 ensureFree :: Int -> Builder
 ensureFree n = n `seq` withSize $ \ l ->
-    if n <= l then empty else
+    if n <= l then emptyBuilder else
         flush `append` unsafeLiftIO (const (newBuffer (max n defaultSize)))
 
 withSize :: (Int -> Builder) -> Builder
@@ -271,10 +281,10 @@ flush = Builder $ \ k buf@(Buffer p o u l) ->
       then k buf
       else S.PS p o u : k (Buffer p (o+u) 0 l)
 
-empty :: Builder
-empty = Builder id
+emptyBuilder :: Builder
+emptyBuilder = Builder id
 
 instance Monoid Builder where
-    mempty  = empty
+    mempty  = emptyBuilder
     mappend = append