From 14856043fddcf8f30660ddf34f16795eb38f7299 Mon Sep 17 00:00:00 2001
From: simonmar <unknown>
Date: Mon, 17 Sep 2001 16:21:41 +0000
Subject: [PATCH] [project @ 2001-09-17 16:21:41 by simonmar] Subvert GHC's
 full-laziness optimisation by explicitly lambda-lifting a
 local lambda expression to the top level, and exporting it
 to ensure it doesn't get inlined.  Without this hack,
 full-laziness will float out several subexpressions, which
 turns out to be a pessimisation in this case.

This is worth about 20% in hPutStr performance, so we now beat the old
I/O library on 'cat' ;-)

I'd like to MERGE TO STABLE this, but 5.02 is imminent so it might
have to wait until 5.02.1.
---
 ghc/lib/std/PrelIO.hsc |   25 +++++++++++++++++++------
 1 file changed, 19 insertions(+), 6 deletions(-)

diff --git a/ghc/lib/std/PrelIO.hsc b/ghc/lib/std/PrelIO.hsc
index d3646e3..b4da0af 100644
--- a/ghc/lib/std/PrelIO.hsc
+++ b/ghc/lib/std/PrelIO.hsc
@@ -3,7 +3,7 @@
 #undef DEBUG_DUMP
 
 -- -----------------------------------------------------------------------------
--- $Id: PrelIO.hsc,v 1.13 2001/09/17 14:58:09 simonmar Exp $
+-- $Id: PrelIO.hsc,v 1.14 2001/09/17 16:21:41 simonmar Exp $
 --
 -- (c) The University of Glasgow, 1992-2001
 --
@@ -18,7 +18,8 @@ module PrelIO (
    putChar, putStr, putStrLn, print, getChar, getLine, getContents,
    interact, readFile, writeFile, appendFile, readLn, readIO, hReady,
    hWaitForInput, hGetChar, hGetLine, hGetContents, hPutChar, hPutStr,
-   hPutStrLn, hPrint
+   hPutStrLn, hPrint,
+   commitBuffer, commitBuffer'
  ) where
 
 #include "HsStd.h"
@@ -553,13 +554,25 @@ commitBuffer
 	:: Handle			-- handle to commit to
 	-> RawBuffer -> Int		-- address and size (in bytes) of buffer
 	-> Int				-- number of bytes of data in buffer
-	-> Bool				-- flush the handle afterward?
+	-> Bool				-- True <=> flush the handle afterward
 	-> Bool 			-- release the buffer?
 	-> IO Buffer
 
-commitBuffer hdl raw sz count flush release = do
-  wantWritableHandle "commitAndReleaseBuffer" hdl $ 
-    \ handle_@Handle__{ haFD=fd, haBuffer=ref, haBuffers=spare_buf_ref } -> do
+commitBuffer hdl raw sz@(I## _) count@(I## _) flush release = do
+  wantWritableHandle "commitAndReleaseBuffer" hdl $
+     commitBuffer' hdl raw sz count flush release
+
+-- Explicitly lambda-lift this function to subvert GHC's full laziness
+-- optimisations, which otherwise tends to float out subexpressions
+-- past the \handle, which is really a pessimisation in this case because
+-- that lambda is a one-shot lambda.
+--
+-- Don't forget to export the function, to stop it being inlined too.
+--
+-- This hack is a fairly big win for hPutStr performance.
+--
+commitBuffer' hdl raw sz@(I## _) count@(I## _) flush release
+  handle_@Handle__{ haFD=fd, haBuffer=ref, haBuffers=spare_buf_ref } = do
 
 #ifdef DEBUG_DUMP
       puts ("commitBuffer: sz=" ++ show sz ++ ", count=" ++ show count
-- 
1.7.10.4