diff options
| author | Sergei Trofimovich <siarheit@google.com> | 2016-09-04 22:08:27 +0100 |
|---|---|---|
| committer | Sergei Trofimovich <siarheit@google.com> | 2016-09-04 22:08:27 +0100 |
| commit | cdbb9da7a1330366678c4e29d11a48e591c1ac1e (patch) | |
| tree | bcebf8dfa0eb5710e5706710d8f279bd3a88ef09 /compiler | |
| parent | 18057549ffebea244d9170377889d096ca9fdbcd (diff) | |
| download | haskell-cdbb9da7a1330366678c4e29d11a48e591c1ac1e.tar.gz | |
cleanup: drop 11 years old performance hack
The 'return () >>' hack was added in commit
commit ac88f113abdec1edbffb6d2f97323e81f82908e7
Date: Tue Jul 26 12:14:03 2005 +0000
Nowadays it has no effect on generated Core on -O1/-O2
and slightly bloats Core on -O0.
Signed-off-by: Sergei Trofimovich <siarheit@google.com>
Diffstat (limited to 'compiler')
| -rw-r--r-- | compiler/utils/Pretty.hs | 10 |
1 files changed, 2 insertions, 8 deletions
diff --git a/compiler/utils/Pretty.hs b/compiler/utils/Pretty.hs index 98490322c5..5b025d5c05 100644 --- a/compiler/utils/Pretty.hs +++ b/compiler/utils/Pretty.hs @@ -1018,9 +1018,6 @@ hPutLitString handle a l = if l == 0 -- and async exception-safe. We only have a single thread and don't -- care about exceptions, so we add a layer of fast buffering -- over the Handle interface. --- --- (3) a few hacks in layLeft below to convince GHC to generate the right --- code. printLeftRender :: Handle -> Doc -> IO () printLeftRender hdl doc = do @@ -1031,14 +1028,11 @@ printLeftRender hdl doc = do bufLeftRender :: BufHandle -> Doc -> IO () bufLeftRender b doc = layLeft b (reduceDoc doc) --- HACK ALERT! the "return () >>" below convinces GHC to eta-expand --- this function with the IO state lambda. Otherwise we end up with --- closures in all the case branches. layLeft :: BufHandle -> Doc -> IO () layLeft b _ | b `seq` False = undefined -- make it strict in b layLeft _ NoDoc = error "layLeft: NoDoc" -layLeft b (Union p q) = return () >> layLeft b (first p q) -layLeft b (Nest _ p) = return () >> layLeft b p +layLeft b (Union p q) = layLeft b (first p q) +layLeft b (Nest _ p) = layLeft b p layLeft b Empty = bPutChar b '\n' layLeft b (NilAbove p) = bPutChar b '\n' >> layLeft b p layLeft b (TextBeside s _ p) = put b s >> layLeft b p |