November 2017 - ghc-tickets

[GHC] #8228: GHC built under Windows does not generate dyn_hi files
by GHC 04 Feb '18

04 Feb '18

#8228: GHC built under Windows does not generate dyn_hi files ------------------------------+-------------------------------------------- Reporter: ezyang | Owner: Type: bug | Status: new Priority: high | Milestone: 7.8.1 Component: Compiler | Version: 7.7 Keywords: | Operating System: Windows Architecture: | Type of failure: GHC doesn't work at all Unknown/Multiple | Test Case: cabal01 Difficulty: Unknown | Blocking: Blocked By: | Related Tickets: | ------------------------------+-------------------------------------------- I found cabal01 failing with: {{{ =====> cabal01(normal) 1 of 1 [0, 0, 0] cd . && $MAKE -s --no-print-directory cabal01 VANILLA=--enable-library- vanilla PROF=--disable-l ibrary-profiling DYN=--enable-shared </dev/null >cabal01.run.stdout 2>cabal01.run.stderr Wrong exit code (expected 0 , actual 2 ) Stdout: Stderr: Creating library file: dist\build\libHStest-1.0-ghc7.7.20130904.dll.a setup.exe: Error: Could not find module: A with any suffix: ["dyn_hi"] in the search path: ["dist\\build"] make[2]: *** [cabal01] Error 1 }}} but I bet some of the other failures are due to this. Indeed, in dist/build, there are no dyn_hi files When I look more closely at the commands being run, I see: {{{ bash.exe-3.1$ c:/Users/ezyang/Dev/ghc-validate/inplace/bin/ghc-stage2.exe --make -fbuilding-ca bal-package -O -static -dynamic-too -dynosuf dyn_o -dynhisuf dyn_hi -outputdir dist/build -odi r dist/build -hidir dist/build -stubdir dist/build -i -idist/build -i. -idist/build/autogen -I dist/build/autogen -Idist/build -optP-include -optPdist/build/autogen/cabal_macros.h -package- name test-1.0 -hide-all- packages -no-user-package-db -package-db local.db -package-db dist/pac kage.conf.inplace -package-id base-4.7.0.0-inplace -XHaskell98 -XForeignFunctionInterface A B. A -fforce-recomp -dcore-lint -dcmm-lint -dno-debug-output -no-user-package-db [1 of 2] Compiling B.A ( B\A.hs, dist\build\B\A.o ) [2 of 2] Compiling A ( A.hs, dist\build\A.o ) }}} which should result in dyn_hi files but does not. I haven't traced it any further yet. -- Ticket URL: <http://ghc.haskell.org/trac/ghc/ticket/8228> GHC <http://www.haskell.org/ghc/> The Glasgow Haskell Compiler

1 17

[GHC] #14244: ghc-prim: hs_atomicread* and hs_atomicwrite* missing barriers
by GHC 04 Feb '18

04 Feb '18

#14244: ghc-prim: hs_atomicread* and hs_atomicwrite* missing barriers -------------------------------------+------------------------------------- Reporter: trommler | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Prelude | Version: 8.2.1 Keywords: | Operating System: Unknown/Multiple Architecture: | Type of failure: Incorrect result Unknown/Multiple | at runtime Test Case: | Blocked By: Blocking: | Related Tickets: #12537 Differential Rev(s): | Wiki Page: -------------------------------------+------------------------------------- The comments in `compiler/prelude/primops.txt.pp` for both operations say "... Implies a full memory barrier." The implementation does not issue any barriers as exemplified by the 32-bit variants as can be seen in the excerpts from `libraries/ghc- prim/cbits/atomic.c`. {{{#!c StgWord hs_atomicread32(StgWord x) { return *(volatile StgWord32 *) x; } }}} and {{{#!c void hs_atomicwrite32(StgWord x, StgWord val) { *(volatile StgWord32 *) x = (StgWord32) val; } }}} The native code generator for X86/amd64 and the LLVM backend do not generate calls to these functions but generate the necessary barrier (`mfence`) directly and thus are not affected by this issue. There are no gcc `__sync_*` intrinsics for the two operations. The new `__atomic_*` intrinisics have the required operations but require gcc 4.7 or later. -- Ticket URL: <http://ghc.haskell.org/trac/ghc/ticket/14244> GHC <http://www.haskell.org/ghc/> The Glasgow Haskell Compiler

1 15

[GHC] #11706: Increase precedence of statements (if-then-else, case-of, do)
by GHC 03 Feb '18

03 Feb '18

#11706: Increase precedence of statements (if-then-else, case-of, do) -------------------------------------+------------------------------------- Reporter: YoYoYonnY | Owner: Type: feature | Status: new request | Priority: lowest | Milestone: ⊥ Component: Compiler | Version: (Parser) | Keywords: | Operating System: Unknown/Multiple Architecture: | Type of failure: None/Unknown Unknown/Multiple | Test Case: | Blocked By: Blocking: | Related Tickets: Differential Rev(s): | Wiki Page: -------------------------------------+------------------------------------- Warning: Skip to the {{{TL; DR}}}, and maybe the {{{How it works}}} section; You don't want to read this. (I've warned you.) == The problem == We do it all the time: Writing that one dollar sign just before our expressions, just because Haskell can't parse it: {{{#!hs f x = g $ if x then {- ... -} else {- ... -} f x = g $ case x of {- ... -} f x = g $ do {- ... -} }}} However, we programmers are lazy and want to type as few characters as possible. Think about the precious characters we would save if we could write code this way: {{{#!hs f x = g if x then {- ... -} else {- ... -} f x = g case x of {- ... -} f x = g do {- ... -} }}} Wow, our productivity just shot up by a whopping 6%! However, this code looks ugly, noone would ever write this... Right? There has to be some way to catagorize this feature with others people would never use... == Pragmas to the rescue! == The {{{LANGUAGE}}} pragma! Of course! We can add a syntactic extension to enable above syntax! But how should we name it... {{{InlineStatements}}}? {{{InfixStatements}}}? {{{ParenthesizedStatements}}}? {{{IncreasedStatementPrecedence}}}? {{{StatementsWithoutParenthesis}}}? I don't know. I am [1] not the parents who might one day give birth to this feature. I am merely the one who conceptualized it. [1] (probably, unless this request remains unnoticed for another 20 years or so) == How it works == * Implicit parenthesis will be put around ''all'' statements, according to the following rules: 1. Parenthesis will be opened at the start of the statement. 2. Parenthesis will be closed at the end of the statement. The end of the statement is determined by 1. The curly brackets around the statement, or; 2. The indentation of the statement Basically, these are the rule Haskell already uses. Sorry if this is obvious, but some people seemed to get confused, so here's some examples: === (Correct) Examples === Examples are in the form: {{{#!hs implicitParenthesis -- New syntax explicitParenthesis -- Old syntax }}} Call {{{idM :: Monad m => m a -> m a}}} as {{{idM :: IO String -> IO String}}}. {{{#!hs idM do putStrLn "What's my name?" getLine idM (do { putStrLn "What's my name?"; getLine; }) }}} Create function {{{whatsMyName :: Maybe String -> String}}}. {{{#!hs whatsMyName x = id case x of Just name = "My name is " ++ name Nothing = "What's my name?" whatsMyName x = id (case x of { Just name = "My name is " ++ name; Nothing = "What's my name?"; }) }}} Another example using {{{let}}} and {{{if-then-else}}}. {{{#!hs main = putStrLn (++) "I've been tryna work it out... The square root of 69 is 8 something, right? " let eight_something = 8.306623862918075 in if sqrt 69 == eight_something then "Yeah" else "Oh na na" main = putStrLn ((++) "I've been tryna work it out... The square root of 69 is 8 something, right? " (let eight_something = 8.306623862918075 in (if sqrt 69 == eight_something then "Yeah" else "Oh na na")) }}} === Incorrect examples === {{{#!hs f do putStrLn "This won't work..." True f (do { putStrLn "This won't work..."; True; }) }}} {{{#!hs f do putStrLn "This won't work..." True -- Indented by extra space f (do { putStrLn "This won't work..."; True; }) }}} == TL; DR == What there is: {{{#!hs main = when $ do putStrLn "Parenthesis..." main = when True (do putStrLn "Parenthesis...") }}} What I want: {{{#!hs when (doBlocksNeedParenthesis) do putStrLn "This code is invalid." when (doBlocksNeedParenthesis) $ do putStrLn "This code is valid." when (doBlocksNeedParenthesis) (do putStrLn "This code is valid aswell.") when (thisIsImplemented) do putStrLn "These are all equal" when (thisIsImplemented) (do putStrLn "These are all equal") when (thisIsImplemented) $ do putStrLn "These are all equal" }}} -- Ticket URL: <http://ghc.haskell.org/trac/ghc/ticket/11706> GHC <http://www.haskell.org/ghc/> The Glasgow Haskell Compiler

1 5

[GHC] #13511: ApplicativeDo incorrectly requiring Monad
by GHC 02 Feb '18

02 Feb '18

#13511: ApplicativeDo incorrectly requiring Monad -------------------------------------+------------------------------------- Reporter: mnislaih | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.0.2 Keywords: | Operating System: Unknown/Multiple Architecture: | Type of failure: None/Unknown Unknown/Multiple | Test Case: | Blocked By: Blocking: | Related Tickets: Differential Rev(s): | Wiki Page: -------------------------------------+------------------------------------- We ran into this bug in production, this is a simplified reproduction. The following program will not type check, requiring an unnecessary Monad instance: {{{ {-# LANGUAGE ApplicativeDo, GeneralizedNewtypeDeriving #-} import Data.Functor.Identity import Data.Monoid newtype A x = A (Identity x) deriving (Functor, Applicative) shouldWork :: A () shouldWork = do a <- pure () b <- pure () let ab = a <> b return ab }}} {{{ pepe:~/code/snippets$ ghci ApplicativeDoBug.hs GHCi, version 8.0.2: http://www.haskell.org/ghc/ :? for help [1 of 1] Compiling Main ( ApplicativeDoBug.hs, interpreted ) ApplicativeDoBug.hs:10:14: error: • No instance for (Monad A) arising from a do statement • In the expression: do { a <- pure (); b <- pure (); let ab = a <> b; return ab } In an equation for ‘shouldWork’: shouldWork = do { a <- pure (); b <- pure (); let ab = ...; return ab } Failed, modules loaded: none. }}} There is a simple workaround, which worked for us in production: {{{ workaround :: A () workaround = do a <- pure () b <- pure () return $ let ab = a <> b in ab }}} I asked in #ghc and it seems this is not yet fixed in HEAD. -- Ticket URL: <http://ghc.haskell.org/trac/ghc/ticket/13511> GHC <http://www.haskell.org/ghc/> The Glasgow Haskell Compiler

1 10

[GHC] #13032: Redundant forcing of Given dictionaries
by GHC 01 Feb '18

01 Feb '18

#13032: Redundant forcing of Given dictionaries -------------------------------------+------------------------------------- Reporter: simonpj | Owner: Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.0.1 Keywords: | Operating System: Unknown/Multiple Architecture: | Type of failure: None/Unknown Unknown/Multiple | Test Case: | Blocked By: Blocking: | Related Tickets: Differential Rev(s): | Wiki Page: -------------------------------------+------------------------------------- If you look at the test case for #13025 you'll see code like {{{ f :: (a~~b) => a -> b -> Bool f d x y = case HEq_sc d of (cobox :: a ~# b) -> True }}} From the Given dictionary `(a~~b)`, the contraint solver generates a given binding, just in case {{{ (cobox :: a~# b) = HEq_sc d }}} But because `cobox` is a ''coercion'' we evaluate this binding strictly, and so the desugarer produces the case expression above. Most redundant Given bindings are let-bound and hence discarded quickly by the occurrence analyser, but GHC doesn't discard cases (termination worries). So the task here is to remove the redundant Given in some way. (Of course, if the equality is actually used, we need to keep it.) NB: See `Note [The equality types story]` in `TysPrim` for the meanagerie of equality types. -- Ticket URL: <http://ghc.haskell.org/trac/ghc/ticket/13032> GHC <http://www.haskell.org/ghc/> The Glasgow Haskell Compiler

1 12

[GHC] #14443: Add a plugin phase that allows users to modify HsSyn before the desugarer
by GHC 01 Feb '18

01 Feb '18

#14443: Add a plugin phase that allows users to modify HsSyn before the desugarer -------------------------------------+------------------------------------- Reporter: ocharles | Owner: (none) Type: feature | Status: new request | Priority: normal | Milestone: Component: Compiler | Version: 8.2.1 Keywords: | Operating System: Unknown/Multiple Architecture: | Type of failure: None/Unknown Unknown/Multiple | Test Case: | Blocked By: Blocking: | Related Tickets: Differential Rev(s): | Wiki Page: -------------------------------------+------------------------------------- I'm currently playing around with a little project that attempts to replicate py.test. For context about py.test, see https://docs.pytest.org/en/latest/example/reportingdemo.html#tbreportdemo, but essentially it's a Python library that provides an `assert :: Bool -> IO ()` function, with the magic that if the assertion fails, it shows you some context about the `Bool` expression: {{{ def test_simple(self): def f(): return 42 def g(): return 43 > assert f() == g() E assert 42 == 43 }}} For example, shows that `f()` evaluated to 42. I'd like to do something like this for Haskell, and a GHC plugin seemed like the right place to do this. I first wrote a core-to-core plugin (https://github.com/ocharles/assert- explainer/blob/e6a669680cd214f23a4213e2f945f4468998fb1d/plugin/AssertExplainer.hs) which finds free variables and and attempts to `Show` them. This works, but I'd like to do more. As an example of something I'd like to do, I would like to let my users write `assert (and [x > 0 | x <- [-1, 0])`. This is a failing assertion, and I would like to show a kind of evaluation trace, something like {{{ and [x > 0 | x <- [-1, 0] = and [False, False] = False }}} To do this, I really need access to `HsSyn`, not `CoreExpr`. Template Haskell won't do, because I don't know what I can `Show` - I really need access to the type checker as well. A plugin that fires right before the desugarer would be really nice for this kind of task. -- Ticket URL: <http://ghc.haskell.org/trac/ghc/ticket/14443> GHC <http://www.haskell.org/ghc/> The Glasgow Haskell Compiler

1 3

[GHC] #13763: Performance regression (~34%) in 8.2.1, poor register allocation(?) in an inner loop over an array
by GHC 01 Feb '18

01 Feb '18

#13763: Performance regression (~34%) in 8.2.1, poor register allocation(?) in an inner loop over an array -------------------------------------+------------------------------------- Reporter: jberryman | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.1-rc2 (NCG) | Keywords: | Operating System: Unknown/Multiple Architecture: | Type of failure: Runtime Unknown/Multiple | performance bug Test Case: | Blocked By: Blocking: | Related Tickets: Differential Rev(s): | Wiki Page: -------------------------------------+------------------------------------- Testing GHC 8.0.1 against the RC 8.2.0.20170507 I've distilled a smallish test-case from a much larger case in my 'hashabler' library, and validated that the same modifications also make that regression disappear in the real case. It's probably possible to get this smaller but I don't know if I'll have time to work on it more for a while: repro3.hs: {{{#!hs {-# LANGUAGE BangPatterns #-} module Main(main) where import Criterion.Main import qualified Data.Primitive as P import Data.Bits import Data.Word import Control.DeepSeq main :: IO () main = do defaultMain [ env (newByteArr64 5) $ \ ~bs -> bench "ByteArray 5" $ nf (hashTextSip 99) bs , env (newByteArr64 8) $ \ ~bs -> bench "ByteArray 8" $ nf (hashTextSip 99) bs , env (newByteArr64 512) $ \ ~bs -> bench "ByteArray 512" $ nf (hashTextSip 99) bs , env (newByteArr64 1000000) $ \ ~bs -> bench "ByteArray 1000000" $ nf (hashTextSip 99) bs ] instance NFData P.ByteArray where rnf _ = () newByteArr64 n = P.newAlignedPinnedByteArray (8*n) 8 >>= P.unsafeFreezeByteArray sipRound :: Word64 -> Word64 -> Word64 -> Word64 -> (Word64, Word64, Word64, Word64) {-# INLINE sipRound #-} sipRound v0 v1 v2 v3 = (v3 `xor` v0, v0 `xor` v1, v1 `xor` v2, v2 `xor` v3) hashTextSip :: Word64 -> P.ByteArray -> Word64 {-# INLINE hashTextSip #-} hashTextSip h = \ ba -> let !lenWord16 = P.sizeofByteArray ba `unsafeShiftR` 1 !word16sRem = lenWord16 .&. 3 !word16sIx = lenWord16-word16sRem !ixFinal = lenWord16-1 !word16sIxWd = word16sIx `unsafeShiftR` 2 -- `div` 4 hash4Word16sLoop hAcc@(!w0,!w1,!w2,!w3) !ix | ix == word16sIxWd = hashRemainingWord16s hAcc word16sIx | otherwise = let w64Dirty = P.indexByteArray ba ix w64 = clean4xWord16ChunkLE w64Dirty in hash4Word16sLoop (sipRound (w0 `xor` w64) w1 w2 w3) (ix + 1) -- NOTE: Removing this causes regression to disappear as well. hashRemainingWord16s (!w0,!w1,!w2,!w3) !ix | ix > ixFinal = w0 | otherwise = let w16 = P.indexByteArray ba ix in hashRemainingWord16s (sipRound (w0 `xor` (fromIntegral (w16 :: Word16))) w1 w2 w3) (ix+1) in hash4Word16sLoop (h,1,2,3) 0 clean4xWord16ChunkLE :: Word64 -> Word64 {-# INLINE clean4xWord16ChunkLE #-} clean4xWord16ChunkLE w64Dirty = -- NOTE: no regression when just this (8.2 is faster) -- (((byteSwap64 w64Dirty) `unsafeShiftR` 8) .&. 0x00FF00FF00FF00FF) -- ...but this is a big regression: (((byteSwap64 w64Dirty) `unsafeShiftR` 8) .&. 0x00FF00FF00FF00FF) .|. (((byteSwap64 w64Dirty) `unsafeShiftL` 8) .&. 0xFF00FF00FF00FF00) }}} Here are the results of the benchmark above on my machine: On GHC **8.0.1**: {{{ benchmarking ByteArray 5 time 24.70 ns (24.00 ns .. 26.25 ns) 0.987 R² (0.967 R² .. 1.000 R²) mean 24.44 ns (24.13 ns .. 25.80 ns) std dev 1.859 ns (318.3 ps .. 4.227 ns) variance introduced by outliers: 86% (severely inflated) benchmarking ByteArray 8 time 32.66 ns (32.58 ns .. 32.76 ns) 1.000 R² (1.000 R² .. 1.000 R²) mean 32.79 ns (32.64 ns .. 33.09 ns) std dev 683.7 ps (365.4 ps .. 1.175 ns) variance introduced by outliers: 31% (moderately inflated) benchmarking ByteArray 512 time 1.428 μs (1.382 μs .. 1.522 μs) 0.986 R² (0.970 R² .. 1.000 R²) mean 1.398 μs (1.384 μs .. 1.454 μs) std dev 91.12 ns (4.475 ns .. 193.9 ns) variance introduced by outliers: 76% (severely inflated) benchmarking ByteArray 1000000 time 2.658 ms (2.653 ms .. 2.663 ms) 1.000 R² (1.000 R² .. 1.000 R²) mean 2.672 ms (2.665 ms .. 2.691 ms) std dev 35.00 μs (10.88 μs .. 59.58 μs) }}} And on **GHC 8.2** RC: {{{ benchmarking ByteArray 5 time 23.78 ns (23.68 ns .. 23.88 ns) 1.000 R² (1.000 R² .. 1.000 R²) mean 23.83 ns (23.76 ns .. 23.95 ns) std dev 298.8 ps (183.2 ps .. 482.5 ps) variance introduced by outliers: 14% (moderately inflated) benchmarking ByteArray 8 time 35.81 ns (35.44 ns .. 36.27 ns) 0.999 R² (0.998 R² .. 1.000 R²) mean 35.56 ns (35.45 ns .. 35.94 ns) std dev 596.8 ps (134.5 ps .. 1.184 ns) variance introduced by outliers: 22% (moderately inflated) benchmarking ByteArray 512 time 1.706 μs (1.698 μs .. 1.716 μs) 1.000 R² (1.000 R² .. 1.000 R²) mean 1.701 μs (1.698 μs .. 1.707 μs) std dev 13.27 ns (5.825 ns .. 24.41 ns) benchmarking ByteArray 1000000 time 3.322 ms (3.284 ms .. 3.377 ms) 0.999 R² (0.998 R² .. 1.000 R²) mean 3.296 ms (3.287 ms .. 3.332 ms) std dev 44.62 μs (20.55 μs .. 87.29 μs) }}} Looking at the core wasn't fruitful, but I think dumping the asm shows that this is a case of bad (or worse) register allocation. I've attached two screenshots showing the instructions added (in blue), when moving from the one-line `clean4xWord16ChunkLE` to the two-line version, for both 8.0 and 8.2 (there wasn't anything in the diff besides instances of this change). It looks in the 8.2 version like we've decided we're out of registers and need to use the stack. In my real code I'm seeing 35% regression on very long Text, as well as 21% regression on very long ByteString; the latter implementation is similarly structured to `hashTextSip`, but doesn't call `clean4xWord16ChunkLE` but does do a byteswap. -- Ticket URL: <http://ghc.haskell.org/trac/ghc/ticket/13763> GHC <http://www.haskell.org/ghc/> The Glasgow Haskell Compiler

1 16

[GHC] #11195: New pattern-match check can be non-performant
by GHC 01 Feb '18

01 Feb '18

#11195: New pattern-match check can be non-performant -------------------------------------+------------------------------------- Reporter: goldfire | Owner: Type: bug | Status: new Priority: highest | Milestone: Component: Compiler | Version: 7.11 Keywords: | Operating System: Unknown/Multiple Architecture: | Type of failure: None/Unknown Unknown/Multiple | Test Case: | Blocked By: Blocking: | Related Tickets: Differential Rev(s): | Wiki Page: -------------------------------------+------------------------------------- In my work in merging Phab:D808 (and originally pointed out by thomie), I ran into a peculiar bug: the new pattern-match check took gobs of memory (~10GB) to check !OptCoercion in the stage-2 compiler. My analysis got only as far as nailing the problem down to `pmTraverse`, which took 80% of the time, and got called roughly a gajillion times. To reproduce, simply compile !OptCoercion (with `-package ghc`) and you'll see your memory usage explode. So that you'll be able to build GHC until this is fixed, I've disable the pattern-match check in that file. There is a good chance that this is caused by an interaction between the pattern-match check and the type=kind code. I'm happy to probe further, but I'd want George's help. NB: This applies only after my patch is merged. Which should be today. For some value of today. Hopefully today's value of today. -- Ticket URL: <http://ghc.haskell.org/trac/ghc/ticket/11195> GHC <http://www.haskell.org/ghc/> The Glasgow Haskell Compiler

1 21

[GHC] #14013: Bad monads performance
by GHC 01 Feb '18

01 Feb '18

#14013: Bad monads performance -------------------------------------+------------------------------------- Reporter: danilo2 | Owner: (none) Type: bug | Status: new Priority: high | Milestone: Component: Compiler | Version: 8.2.1-rc3 Keywords: | Operating System: Unknown/Multiple Architecture: | Type of failure: None/Unknown Unknown/Multiple | Test Case: | Blocked By: Blocking: | Related Tickets: Differential Rev(s): | Wiki Page: -------------------------------------+------------------------------------- Hi! We've been struggling with a very strange GHC behavior on IRC today. Let's consider the following code (needs mtl and criterion to be compiled, not all extensions are needed): {{{ {-# LANGUAGE AllowAmbiguousTypes, ApplicativeDo, Arrows, BangPatterns, BinaryLiterals, ConstraintKinds, DataKinds, DefaultSignatures, DeriveDataTypeable, DeriveFoldable, DeriveFunctor, DeriveGeneric, DeriveTraversable, DoAndIfThenElse, DuplicateRecordFields, EmptyDataDecls, FlexibleContexts, FlexibleInstances, FunctionalDependencies, GeneralizedNewtypeDeriving, InstanceSigs, LambdaCase, MonadComprehensions, MultiWayIf, NamedWildCards, NegativeLiterals, NoImplicitPrelude, NumDecimals, OverloadedLabels, PackageImports, QuasiQuotes, RankNTypes, RecursiveDo, ScopedTypeVariables, StandaloneDeriving, TemplateHaskell, TupleSections, TypeApplications, TypeFamilies, TypeFamilyDependencies, TypeOperators, ViewPatterns, LiberalTypeSynonyms, RelaxedPolyRec #-} module Main where import Prelude import Criterion.Main import qualified Control.Monad.State.Strict as Strict import qualified Control.Monad.State.Class as State import Control.DeepSeq (NFData, rnf, force) import GHC.IO (evaluate) import Data.Monoid ----------------------------- -- === Criterion utils === -- ----------------------------- eval :: NFData a => a -> IO a eval = evaluate . force ; {-# INLINE eval #-} liftExp :: (Int -> a) -> (Int -> a) liftExp f = f . (10^) ; {-# INLINE liftExp #-} expCodeGen :: NFData a => (Int -> a) -> (Int -> IO a) expCodeGen f i = do putStrLn $ "generating input code (10e" <> show i <> " chars)" out <- eval $ liftExp f i putStrLn "code generated sucessfully" return out {-# INLINE expCodeGen #-} expCodeGenBench :: (NFData a, NFData b) => (Int -> a) -> (a -> b) -> Int -> Benchmark expCodeGenBench f p i = env (expCodeGen f i) $ bench ("10e" <> show i) . nf p ; {-# INLINE expCodeGenBench #-} ------------------------------- -- === (a*) list parsing === -- ------------------------------- genList_a :: Int -> [Char] genList_a i = replicate i 'a' ; {-# INLINE genList_a #-} pureListParser_a :: [Char] -> Bool pureListParser_a = \case 'a':s -> pureListParser_a s [] -> True _ -> False {-# INLINE pureListParser_a #-} mtlStateListParser_a :: State.MonadState [Char] m => m Bool mtlStateListParser_a = State.get >>= \case 'a':s -> State.put s >> mtlStateListParser_a [] -> return True _ -> return False {-# INLINE mtlStateListParser_a #-} mtlStateListParser_a_typed :: Strict.State [Char] Bool mtlStateListParser_a_typed = State.get >>= \case 'a':s -> State.put s >> mtlStateListParser_a_typed [] -> return True _ -> return False {-# INLINE mtlStateListParser_a_typed #-} mtlStateListParser_a_let :: Strict.MonadState [Char] m => m Bool mtlStateListParser_a_let = go where go = Strict.get >>= \case 'a':s -> Strict.put s >> go [] -> return True _ -> return False {-# INLINE mtlStateListParser_a_let #-} {-# SPECIALIZE mtlStateListParser_a :: Strict.State [Char] Bool #-} {-# SPECIALIZE mtlStateListParser_a_typed :: Strict.State [Char] Bool #-} main = do defaultMain [ bgroup "a*" $ [ bgroup "pure" $ expCodeGenBench genList_a pureListParser_a <$> [6..6] , bgroup "mtl.State.Strict" $ expCodeGenBench genList_a (Strict.evalState mtlStateListParser_a) <$> [6..6] , bgroup "mtl.State.Strict typed" $ expCodeGenBench genList_a (Strict.evalState mtlStateListParser_a_typed) <$> [6..6] , bgroup "mtl.State.Strict let" $ expCodeGenBench genList_a (Strict.evalState mtlStateListParser_a_let) <$> [6..6] ] ] }}} The code was compiled with following options (and many other variations): `-threaded -funbox-strict-fields -O2 -fconstraint-solver-iterations=100 -funfolding-use-threshold=10000 -fexpose-all-unfoldings -fsimpl-tick- factor=1000 -flate-dmd-anal` Everything in this code has `INLINE` pragma. The important part we should focus on are these two functions: {{{ pureListParser_a :: [Char] -> Bool pureListParser_a = \case 'a':s -> pureListParser_a s [] -> True _ -> False {-# INLINE pureListParser_a #-} mtlStateListParser_a :: State.MonadState [Char] m => m Bool mtlStateListParser_a = State.get >>= \case 'a':s -> State.put s >> mtlStateListParser_a [] -> return True _ -> return False {-# INLINE mtlStateListParser_a #-} }}} Which are just "parsers" accepting strings containing only 'a' characters. The former is pure one, while the later uses `State` to keep the remaining input. The following list contains performance related observations: 0. For the rest of the points, let's call the performance of `pureListParser_a` a "good" one and everything worse a "bad" one. 1. The performance of `mtlStateListParser_a` is bad, it runs 10 times slower than `pureListParser_a`. Inspecting CORE we can observe that GHC jumps between `(# a,b #)` and `(a,b)` representations all the time. 2. If we add a specialize pragma `{-# SPECIALIZE mtlStateListParser_a :: Strict.State [Char] Bool #-}`, the performance of `mtlStateListParser_a` is good (exactly the same as `pureListParser_a`). 3. If we do NOT use specialize pragma, but we use explicite, non- polymorphic type signature `mtlStateListParser_a_typed :: Strict.State [Char] Bool`, the performance is bad (!), identical to the polymorphic version without specialization. 4. If we use SPECIALIZE pragma together with explicite, non-polymorphic type, so we use BOTH `mtlStateListParser_a_typed :: Strict.State [Char] Bool` AND `{-# SPECIALIZE mtlStateListParser_a_typed :: Strict.State [Char] Bool #-}` we get the good performance. 5. If we transform `pureListParser_a` to {{{ mtlStateListParser_a_let :: Strict.MonadState [Char] m => m Bool mtlStateListParser_a_let = go where go = Strict.get >>= \case 'a':s -> Strict.put s >> go [] -> return True _ -> return False {-# INLINE mtlStateListParser_a_let #-} }}} we again get the good performance without the need to use `SPECIALIZE` pragmas. The above points raise the following questions: 1. Why GHC does not optimize `mtlStateListParser_a` the same way as `pureListParser_a` and where the jumping between `(# a,b #)` and `(a,b)` comes from? 2. Is there any way to tell GHC to automatically insert `SPECIALIZE` pragmas, especially in performance critical code? 3. Why providing very-explicite type signature `mtlStateListParser_a_typed :: Strict.State [Char] Bool` does not solve the problem unless we use `SPECIALIZE` pragma that tells the same as the signature? 4. Why the trick to alias the body of recursive function to a local variable `go` affects the performance in any way, especially when it does NOT bring any variable to the local let scope? We've been testing this behavior in GHC 8.0.2 and 8.2.1-rc3 and several people reported exactly the same observations. -- Ticket URL: <http://ghc.haskell.org/trac/ghc/ticket/14013> GHC <http://www.haskell.org/ghc/> The Glasgow Haskell Compiler

1 16

[GHC] #12665: Make Read instances faster, and make them fail fast
by GHC 01 Feb '18

01 Feb '18

#12665: Make Read instances faster, and make them fail fast -------------------------------------+------------------------------------- Reporter: dfeuer | Owner: Type: feature | Status: new request | Priority: high | Milestone: 8.2.1 Component: Core | Version: 8.0.1 Libraries | Keywords: | Operating System: Unknown/Multiple Architecture: | Type of failure: Runtime Unknown/Multiple | performance bug Test Case: | Blocked By: Blocking: | Related Tickets: Differential Rev(s): | Wiki Page: -------------------------------------+------------------------------------- At present, the `Read` instances for standard types are generally written ''as though'' `Read` were a typical parser for a programming language. However, it most assuredly is not. Specifically, we currently follow the pattern of lexing and then parsing. Lexing looks at the string and attempts to identify the next token, whatever it may be. But for `Read`, we don't need that. Thanks to the types, we have a very clear sense of what characters we expect to encounter. I've started to sketch out an improvement, which reads `Int` and `Word` around seven times as fast (9.5 times as fast with parentheses and negation), and will fail immediately on something like `read (fix ('a':)) :: Int` rather than going into an infinite loop. To begin with, modify the definition of `paren` thus: {{{#!hs expectP' :: Char -> ReadPrec () expectP' c = lift (expect c) {-# INLINE expectP' #-} paren :: ReadPrec a -> ReadPrec a -- ^ @(paren p)@ parses \"(P0)\" -- where @p@ parses \"P0\" in precedence context zero paren p = do expectP' '(' x <- reset p expectP' ')' return x }}} This allows fast failure when looking for parentheses, so we don't have to scan to the end of the first token (whatever it may be) before concluding that it is not `'('`. Now we can parse `Word` and `Int` very efficiently. I had to specialize earlier than I wanted to convince GHC that I don't want to convert through `Integer`. I'm not sure why the `fromIntegral` rule doesn't fire reliably around here. The code below (temporarily) uses the current definition for base 16, because that's a bit fussy; I'll rewrite it soon. {{{#!hs charDiff :: Char -> Char -> Word charDiff c1 c2 = fromIntegral (ord c1 - ord c2) {-# INLINE charDiff #-} readHexOct :: ReadP Word readHexOct = do _ <- ReadP.char '0' baseId <- lexBaseChar case baseId of Oct -> readBaseP 8 Hex -> L.readHexP {-# INLINE readHexOct #-} data BaseId = Oct | Hex lexBaseChar :: ReadP BaseId lexBaseChar = do { c <- ReadP.get; case c of 'o' -> pure Oct 'O' -> pure Oct 'x' -> pure Hex 'X' -> pure Hex _ -> ReadP.pfail } readWord :: ReadP Word readWord = readNumber (readHexOct ReadP.<++ readBaseP 10) readInt :: ReadP Int readInt = fromIntegral <$> readWord readBaseP :: Integral a => Word -> ReadP a readBaseP !base = do c <- ReadP.get let diff = charDiff c '0' if diff < base then readBaseP' base (fromIntegral diff) else ReadP.pfail {-# INLINE readBaseP #-} readBaseP' :: Integral a => Word -> a -> ReadP a readBaseP' !base !acc0 = ReadP.look >>= go acc0 where go !acc (c:cs) | diff < base = ReadP.get *> go (fromIntegral base * acc + fromIntegral diff) cs where diff = charDiff c '0' go !acc _ = pure acc {-# INLINE readBaseP' #-} readNumber :: Num a => ReadP.ReadP a -> ReadPrec a readNumber p = parens $ do cs <- lift skipSpaces *> look case cs of ('-': _) -> get *> lift (skipSpaces *> (negate <$> p)) _ -> lift $ skipSpaces *> p {-# INLINE readNumber #-} }}} Other `Word` and `Int`-like types can be built on top of that foundation. I haven't yet attempted to deal with other instances, but I think there are probably a lot of opportunities for similar improvements. WARNING: I know very little about parsing, and less about `ReadPrec`. It's conceivable that I've made some semantic errors here, although I don't think I have. -- Ticket URL: <http://ghc.haskell.org/trac/ghc/ticket/12665> GHC <http://www.haskell.org/ghc/> The Glasgow Haskell Compiler

1 21